IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[report-utilities] commodity-collector: simplify

Browse Source
This commit is contained in:
Christopher Lam 2018-08-30 17:05:40 +08:00
parent b21874df0b
commit b85f54a287
1 changed files with 12 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
gnucash/report/report-system/report-utilities.scm
View File

@ -20,9 +20,8 @@
(use-modules (srfi srfi-13)) (use-modules (srfi srfi-13))
(define (list-ref-safe list elt) (define (list-ref-safe list elt)
(if (> (length list) elt) (and (> (length list) elt)
(list-ref list elt) (list-ref list elt)))
#f))
(define (list-set-safe! l elt val) (define (list-set-safe! l elt val)
(if (and (list? l) (> (length l) elt)) (if (and (list? l) (> (length l) elt))
@ -349,31 +348,19 @@
clist)) clist))
;; helper function which is given a commodity and returns, if ;; helper function which is given a commodity and returns, if
;; existing, a list (gnc:commodity gnc:numeric). If the second ;; existing, a list (gnc:commodity gnc:numeric).
;; argument was #t, the sign gets reversed.
(define (getpair c sign?) (define (getpair c sign?)
(let ((pair (assoc c commoditylist))) (let* ((pair (assoc c commoditylist))
(cons c (cons (total (and pair (gnc:value-collector-total (cadr pair)))))
(if (not pair) (list c (if pair (if sign? (- total) total) 0))))
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
(gnc:value-collector-total (cadr pair)))
(gnc:value-collector-total (cadr pair))))
'()))))
;; helper function which is given a commodity and returns, if ;; helper function which is given a commodity and returns, if
;; existing, a <gnc:monetary> value. If the second argument was ;; existing, a <gnc:monetary> value.
;; #t, the sign gets reversed.
(define (getmonetary c sign?) (define (getmonetary c sign?)
(let ((pair (assoc c commoditylist))) (let* ((pair (assoc c commoditylist))
(total (and pair (gnc:value-collector-total (cadr pair)))))
(gnc:make-gnc-monetary (gnc:make-gnc-monetary
c (if (not pair) c (if pair (if sign? (- total) total) 0))))
(gnc-numeric-zero)
(if sign?
(gnc-numeric-neg
(gnc:value-collector-total (cadr pair)))
(gnc:value-collector-total (cadr pair)))))))
;; Dispatch function ;; Dispatch function
(lambda (action commodity amount) (lambda (action commodity amount)
@ -391,14 +378,12 @@
(else (gnc:warn "bad commodity-collector action: " action)))))) (else (gnc:warn "bad commodity-collector action: " action))))))
(define (gnc:commodity-collector-get-negated collector) (define (gnc:commodity-collector-get-negated collector)
(let (let ((negated (gnc:make-commodity-collector)))
((negated (gnc:make-commodity-collector)))
(negated 'minusmerge collector #f) (negated 'minusmerge collector #f)
negated)) negated))
(define (gnc:commodity-collectorlist-get-merged collectorlist) (define (gnc:commodity-collectorlist-get-merged collectorlist)
(let (let ((merged (gnc:make-commodity-collector)))
((merged (gnc:make-commodity-collector)))
(for-each (lambda (collector) (merged 'merge collector #f)) collectorlist) (for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
merged)) merged))