mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-16 18:25:11 -06:00
[reports] use new API gnc:collector+ and gnc:collector-
This commit is contained in:
Christopher Lam
parent
f72df3e1bc
commit
496ca94a98
@ -262,11 +262,6 @@
|
||||
(member (xaccSplitGetAccount s) accounts))
|
||||
splits))))
|
||||
|
||||
(define (coll-minus minuend subtrahend)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(coll 'merge minuend #f)
|
||||
(coll 'minusmerge subtrahend #f)
|
||||
coll))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
@ -348,7 +343,7 @@
|
||||
(sales (gnc:commodity-collector-get-negated
|
||||
(filter-splits splits sales-accounts)))
|
||||
(expense (filter-splits splits expense-accounts))
|
||||
(profit (coll-minus sales expense)))
|
||||
(profit (gnc:collector- sales expense)))
|
||||
(list owner profit sales expense)))
|
||||
ownerlist))
|
||||
(sortingtable '()))
|
||||
@ -403,9 +398,10 @@
|
||||
|
||||
;; Add the "No Customer" lines to the sortingtable for sorting
|
||||
;; as well
|
||||
(let* ((other-sales (coll-minus toplevel-total-sales total-sales))
|
||||
(other-expense (coll-minus toplevel-total-expense total-expense))
|
||||
(other-profit (coll-minus other-sales other-expense)))
|
||||
(let* ((other-sales (gnc:collector- toplevel-total-sales total-sales))
|
||||
(other-expense (gnc:collector- toplevel-total-expense
|
||||
total-expense))
|
||||
(other-profit (gnc:collector- other-sales other-expense)))
|
||||
(for-each
|
||||
(lambda (comm)
|
||||
(let* ((profit (cadr (other-profit 'getpair comm #f)))
|
||||
@ -479,7 +475,8 @@
|
||||
(gnc:make-html-text (gnc:html-markup/attr/no-end "hr" "noshade")))))
|
||||
|
||||
;; Summary lines - 1 per currency
|
||||
(let ((total-profit (coll-minus toplevel-total-sales toplevel-total-expense)))
|
||||
(let ((total-profit (gnc:collector- toplevel-total-sales
|
||||
toplevel-total-expense)))
|
||||
(for-each
|
||||
(lambda (comm)
|
||||
(let* ((profit (cadr (total-profit 'getpair comm #f)))
|
||||
|
||||
@ -961,9 +961,8 @@ also show overall period profit & loss."))
|
||||
asset-liability
|
||||
(lambda (acc)
|
||||
(gnc:account-get-comm-value-at-date acc date #f))))
|
||||
(unrealized (gnc:make-commodity-collector)))
|
||||
(unrealized 'merge asset-liability-basis #f)
|
||||
(unrealized 'minusmerge asset-liability-balance #f)
|
||||
(unrealized (gnc:collector- asset-liability-basis
|
||||
asset-liability-balance)))
|
||||
(monetaries->exchanged
|
||||
unrealized common-currency price-source date)))))
|
||||
(retained-earnings-fn
|
||||
|
||||
@ -341,12 +341,6 @@ developing over time"))
|
||||
c report-currency
|
||||
(lambda (a b) (exchange-fn a b date)))))))
|
||||
|
||||
(define (collector-minus a b)
|
||||
(let ((coll (gnc:make-commodity-collector)))
|
||||
(coll 'merge a #f)
|
||||
(coll 'minusmerge b #f)
|
||||
coll))
|
||||
|
||||
;; copy of gnc:not-all-zeros using gnc-monetary
|
||||
(define (not-all-zeros data)
|
||||
(cond ((gnc:gnc-monetary? data) (not (zero? (gnc:gnc-monetary-amount data))))
|
||||
@ -401,8 +395,8 @@ developing over time"))
|
||||
(cdr dates-list)
|
||||
(cons (if do-intervals?
|
||||
(collector->monetary
|
||||
(collector-minus (cadr list-of-mon-collectors)
|
||||
(car list-of-mon-collectors))
|
||||
(gnc:collector- (cadr list-of-mon-collectors)
|
||||
(car list-of-mon-collectors))
|
||||
(cadr dates-list))
|
||||
(collector->monetary
|
||||
(car list-of-mon-collectors)
|
||||
|
||||
@ -267,12 +267,6 @@
|
||||
;; conversion function above. Returns a list of gnc-monetary.
|
||||
(define (process-datelist account-balances dates left-col?)
|
||||
|
||||
(define (collector-minus coll1 coll2)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(res 'merge coll1 #f)
|
||||
(res 'minusmerge coll2 #f)
|
||||
res))
|
||||
|
||||
(define accountlist
|
||||
(if inc-exp?
|
||||
(if left-col?
|
||||
@ -310,7 +304,7 @@
|
||||
(cons
|
||||
(collector->monetary
|
||||
(if inc-exp?
|
||||
(collector-minus (car acct-balances) (cadr acct-balances))
|
||||
(gnc:collector- (car acct-balances) (cadr acct-balances))
|
||||
(car acct-balances))
|
||||
(if inc-exp? (cadr dates) (car dates)))
|
||||
result)))))
|
||||
|
||||
@ -316,19 +316,6 @@
|
||||
|
||||
options))
|
||||
|
||||
;; (coll-plus collectors ...) equiv to (+ collectors ...)
|
||||
(define (coll-plus . collectors)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(for-each (lambda (coll) (res 'merge coll #f)) collectors)
|
||||
res))
|
||||
|
||||
;; (coll-minus collectors ...) equiv to (- collector0 collector1 ...)
|
||||
(define (coll-minus . collectors)
|
||||
(let ((res (gnc:make-commodity-collector)))
|
||||
(res 'merge (car collectors) #f)
|
||||
(for-each (lambda (coll) (res 'minusmerge coll #f)) (cdr collectors))
|
||||
res))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; trial-balance-renderer
|
||||
;; set up the document and add the table
|
||||
@ -531,7 +518,7 @@
|
||||
(let* ((cost-fn (gnc:case-exchange-fn
|
||||
'average-cost report-commodity end-date))
|
||||
(acct-balances (map acct->bal all-accounts))
|
||||
(book-balance (apply coll-plus acct-balances))
|
||||
(book-balance (apply gnc:collector+ acct-balances))
|
||||
(value (gnc:sum-collector-commodity
|
||||
book-balance report-commodity exchange-fn))
|
||||
(cost (gnc:sum-collector-commodity
|
||||
@ -674,17 +661,19 @@
|
||||
(pos-adjusting
|
||||
(and ga-or-is? (sum-account-splits acct adjusting-splits #t)))
|
||||
(neg-adjusting
|
||||
(and ga-or-is? (coll-minus adjusting pos-adjusting)))
|
||||
(pre-closing-bal (coll-minus curr-bal closing))
|
||||
(pre-adjusting-bal (coll-minus pre-closing-bal adjusting))
|
||||
(and ga-or-is? (gnc:collector- adjusting pos-adjusting)))
|
||||
(pre-closing-bal (gnc:collector- curr-bal closing))
|
||||
(pre-adjusting-bal (gnc:collector- pre-closing-bal
|
||||
adjusting))
|
||||
(atb (cond ((not is?) pre-closing-bal)
|
||||
((double-col 'credit-q pre-adjusting-bal
|
||||
report-commodity exchange-fn show-fcur?)
|
||||
(list (coll-plus pos-adjusting)
|
||||
(coll-plus neg-adjusting pre-adjusting-bal)))
|
||||
(list (gnc:collector+ pos-adjusting)
|
||||
(gnc:collector+ neg-adjusting
|
||||
pre-adjusting-bal)))
|
||||
(else
|
||||
(list (coll-plus pos-adjusting pre-adjusting-bal)
|
||||
(coll-plus neg-adjusting))))))
|
||||
(list (gnc:collector+ pos-adjusting pre-adjusting-bal)
|
||||
(gnc:collector+ neg-adjusting))))))
|
||||
|
||||
;; curr-bal = account-bal with closing & adj entries
|
||||
;; pre-closing-bal = account-bal with adj entries only
|
||||
@ -851,8 +840,8 @@
|
||||
(tot-abs-amt-cell bs-credits))
|
||||
'())))
|
||||
(if (eq? report-variant 'work-sheet)
|
||||
(let* ((net-is (coll-minus is-debits is-credits))
|
||||
(net-bs (coll-minus bs-debits bs-credits))
|
||||
(let* ((net-is (gnc:collector- is-debits is-credits))
|
||||
(net-bs (gnc:collector- bs-debits bs-credits))
|
||||
(tot-is (gnc:make-commodity-collector))
|
||||
(tot-bs (gnc:make-commodity-collector))
|
||||
(is-entry #f)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user