mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[register] changed do-rows-with-subtotals to named-let
this function is defined and used only once.
This commit is contained in:
Christopher Lam
parent
83d5c21c4b
commit
3759099e1e
@ -577,132 +577,6 @@
|
|||||||
(other-rows-driver split (xaccSplitGetParent split)
|
(other-rows-driver split (xaccSplitGetParent split)
|
||||||
table used-columns 0))
|
table used-columns 0))
|
||||||
|
|
||||||
;; ----------------------------------
|
|
||||||
;; main loop
|
|
||||||
;; ----------------------------------
|
|
||||||
(define (do-rows-with-subtotals leader
|
|
||||||
splits
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
multi-rows?
|
|
||||||
action-for-num?
|
|
||||||
ledger-type?
|
|
||||||
double?
|
|
||||||
odd-row?
|
|
||||||
total-collector
|
|
||||||
debit-collector
|
|
||||||
credit-collector
|
|
||||||
total-value
|
|
||||||
debit-value
|
|
||||||
credit-value)
|
|
||||||
(if (null? splits)
|
|
||||||
;; ----------------------------------
|
|
||||||
;; exit condition reached
|
|
||||||
;; ----------------------------------
|
|
||||||
(begin
|
|
||||||
;; ------------------------------------
|
|
||||||
;; add debit/credit totals to the table
|
|
||||||
;; ------------------------------------
|
|
||||||
(if (reg-report-show-totals?)
|
|
||||||
(begin
|
|
||||||
(add-subtotal-row (_ "Total Debits") leader table used-columns
|
|
||||||
debit-collector "grand-total" #f)
|
|
||||||
(add-subtotal-row (_ "Total Credits") leader table used-columns
|
|
||||||
credit-collector "grand-total" #f)
|
|
||||||
(add-subtotal-row (_ "Total Value Debits") leader table used-columns
|
|
||||||
debit-value "grand-total" #t)
|
|
||||||
(add-subtotal-row (_ "Total Value Credits") leader table used-columns
|
|
||||||
credit-value "grand-total" #t)))
|
|
||||||
(if ledger-type?
|
|
||||||
(add-subtotal-row (_ "Net Change") leader table used-columns
|
|
||||||
total-collector "grand-total" #f)
|
|
||||||
)
|
|
||||||
(add-subtotal-row (_ "Value Change") leader table used-columns
|
|
||||||
total-value "grand-total" #t))
|
|
||||||
|
|
||||||
;; ----------------------------------
|
|
||||||
;; process the splits list
|
|
||||||
;; ----------------------------------
|
|
||||||
(let* ((current (car splits))
|
|
||||||
(current-row-style (if multi-rows? "normal-row"
|
|
||||||
(if odd-row? "normal-row"
|
|
||||||
"alternate-row")))
|
|
||||||
(rest (cdr splits))
|
|
||||||
(next (if (null? rest) #f
|
|
||||||
(car rest)))
|
|
||||||
(valid-split? (not (null? (xaccSplitGetAccount current)))))
|
|
||||||
;; ----------------------------------------------
|
|
||||||
;; update totals, but don't add them to the table
|
|
||||||
;; ----------------------------------------------
|
|
||||||
(if (and multi-rows? valid-split?)
|
|
||||||
(for-each (lambda (split)
|
|
||||||
(if (string=? (gncAccountGetGUID
|
|
||||||
(xaccSplitGetAccount current))
|
|
||||||
(gncAccountGetGUID
|
|
||||||
(xaccSplitGetAccount split)))
|
|
||||||
(accumulate-totals split
|
|
||||||
total-collector total-value
|
|
||||||
debit-collector debit-value
|
|
||||||
credit-collector credit-value)))
|
|
||||||
(xaccTransGetSplitList (xaccSplitGetParent current)))
|
|
||||||
(accumulate-totals current
|
|
||||||
total-collector total-value
|
|
||||||
debit-collector debit-value
|
|
||||||
credit-collector credit-value))
|
|
||||||
;; ----------------------------------
|
|
||||||
;; add the splits to the table
|
|
||||||
;; ----------------------------------
|
|
||||||
;; The general journal has a split that doesn't have an account
|
|
||||||
;; set yet (the new entry transaction).
|
|
||||||
;; This split should be skipped or the report errors out.
|
|
||||||
;; See bug #639082
|
|
||||||
(if valid-split?
|
|
||||||
(add-split-row
|
|
||||||
table
|
|
||||||
current
|
|
||||||
used-columns
|
|
||||||
current-row-style
|
|
||||||
#t
|
|
||||||
(not multi-rows?)
|
|
||||||
action-for-num?
|
|
||||||
ledger-type?
|
|
||||||
double?
|
|
||||||
(opt-val "Display" "Memo")
|
|
||||||
(opt-val "Display" "Description")
|
|
||||||
total-collector
|
|
||||||
)
|
|
||||||
)
|
|
||||||
(if (and multi-rows? valid-split?)
|
|
||||||
(add-other-split-rows
|
|
||||||
current
|
|
||||||
table used-columns
|
|
||||||
"alternate-row"
|
|
||||||
action-for-num?
|
|
||||||
ledger-type?
|
|
||||||
total-collector
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(do-rows-with-subtotals leader
|
|
||||||
rest
|
|
||||||
table
|
|
||||||
used-columns
|
|
||||||
width
|
|
||||||
multi-rows?
|
|
||||||
action-for-num?
|
|
||||||
ledger-type?
|
|
||||||
double?
|
|
||||||
(not odd-row?)
|
|
||||||
total-collector
|
|
||||||
debit-collector
|
|
||||||
credit-collector
|
|
||||||
total-value
|
|
||||||
debit-value
|
|
||||||
credit-value))))
|
|
||||||
;; -----------------------------------------------
|
|
||||||
;; needed for the call to (do-rows-with-subtotals)
|
|
||||||
;; -----------------------------------------------
|
|
||||||
(define (splits-leader splits)
|
(define (splits-leader splits)
|
||||||
(let ((accounts (map xaccSplitGetAccount splits)))
|
(let ((accounts (map xaccSplitGetAccount splits)))
|
||||||
(if (null? accounts) '()
|
(if (null? accounts) '()
|
||||||
@ -729,22 +603,110 @@
|
|||||||
debit-string credit-string amount-string
|
debit-string credit-string amount-string
|
||||||
multi-rows? action-for-num? ledger-type?))
|
multi-rows? action-for-num? ledger-type?))
|
||||||
|
|
||||||
(do-rows-with-subtotals (splits-leader splits)
|
(let loop ((leader (splits-leader splits))
|
||||||
splits
|
(splits splits)
|
||||||
table
|
(table table)
|
||||||
used-columns
|
(used-columns used-columns)
|
||||||
width
|
(width width)
|
||||||
multi-rows?
|
(multi-rows? multi-rows?)
|
||||||
action-for-num?
|
(action-for-num? action-for-num?)
|
||||||
ledger-type?
|
(ledger-type? ledger-type?)
|
||||||
double?
|
(double? double?)
|
||||||
#t
|
(odd-row? #t)
|
||||||
(gnc:make-commodity-collector)
|
(total-collector (gnc:make-commodity-collector))
|
||||||
(gnc:make-commodity-collector)
|
(debit-collector (gnc:make-commodity-collector))
|
||||||
(gnc:make-commodity-collector)
|
(credit-collector (gnc:make-commodity-collector))
|
||||||
(gnc:make-commodity-collector)
|
(total-value (gnc:make-commodity-collector))
|
||||||
(gnc:make-commodity-collector)
|
(debit-value (gnc:make-commodity-collector))
|
||||||
(gnc:make-commodity-collector))
|
(credit-value (gnc:make-commodity-collector)))
|
||||||
|
(if (null? splits)
|
||||||
|
;; ----------------------------------
|
||||||
|
;; exit condition reached
|
||||||
|
;; ----------------------------------
|
||||||
|
(begin
|
||||||
|
;; ------------------------------------
|
||||||
|
;; add debit/credit totals to the table
|
||||||
|
;; ------------------------------------
|
||||||
|
(if (reg-report-show-totals?)
|
||||||
|
(begin
|
||||||
|
(add-subtotal-row (_ "Total Debits") leader table used-columns
|
||||||
|
debit-collector "grand-total" #f)
|
||||||
|
(add-subtotal-row (_ "Total Credits") leader table used-columns
|
||||||
|
credit-collector "grand-total" #f)
|
||||||
|
(add-subtotal-row (_ "Total Value Debits") leader table used-columns
|
||||||
|
debit-value "grand-total" #t)
|
||||||
|
(add-subtotal-row (_ "Total Value Credits") leader table used-columns
|
||||||
|
credit-value "grand-total" #t)))
|
||||||
|
(if ledger-type?
|
||||||
|
(add-subtotal-row (_ "Net Change") leader table used-columns
|
||||||
|
total-collector "grand-total" #f))
|
||||||
|
(add-subtotal-row (_ "Value Change") leader table used-columns
|
||||||
|
total-value "grand-total" #t))
|
||||||
|
|
||||||
|
;; ----------------------------------
|
||||||
|
;; process the splits list
|
||||||
|
;; ----------------------------------
|
||||||
|
(let* ((current (car splits))
|
||||||
|
(current-row-style (if multi-rows? "normal-row"
|
||||||
|
(if odd-row? "normal-row"
|
||||||
|
"alternate-row")))
|
||||||
|
(rest (cdr splits))
|
||||||
|
(next (and (pair? rest) (car rest)))
|
||||||
|
(valid-split? (not (null? (xaccSplitGetAccount current)))))
|
||||||
|
;; ----------------------------------------------
|
||||||
|
;; update totals, but don't add them to the table
|
||||||
|
;; ----------------------------------------------
|
||||||
|
(if (and multi-rows? valid-split?)
|
||||||
|
(for-each (lambda (split)
|
||||||
|
(if (string=? (gncAccountGetGUID
|
||||||
|
(xaccSplitGetAccount current))
|
||||||
|
(gncAccountGetGUID
|
||||||
|
(xaccSplitGetAccount split)))
|
||||||
|
(accumulate-totals split
|
||||||
|
total-collector total-value
|
||||||
|
debit-collector debit-value
|
||||||
|
credit-collector credit-value)))
|
||||||
|
(xaccTransGetSplitList (xaccSplitGetParent current)))
|
||||||
|
(accumulate-totals current
|
||||||
|
total-collector total-value
|
||||||
|
debit-collector debit-value
|
||||||
|
credit-collector credit-value))
|
||||||
|
;; ----------------------------------
|
||||||
|
;; add the splits to the table
|
||||||
|
;; ----------------------------------
|
||||||
|
;; The general journal has a split that doesn't have an account
|
||||||
|
;; set yet (the new entry transaction).
|
||||||
|
;; This split should be skipped or the report errors out.
|
||||||
|
;; See bug #639082
|
||||||
|
(if valid-split?
|
||||||
|
(add-split-row table current used-columns
|
||||||
|
current-row-style #t (not multi-rows?)
|
||||||
|
action-for-num? ledger-type?
|
||||||
|
double? (opt-val "Display" "Memo")
|
||||||
|
(opt-val "Display" "Description")
|
||||||
|
total-collector))
|
||||||
|
(if (and multi-rows? valid-split?)
|
||||||
|
(add-other-split-rows current table used-columns
|
||||||
|
"alternate-row" action-for-num?
|
||||||
|
ledger-type? total-collector))
|
||||||
|
|
||||||
|
(loop leader
|
||||||
|
rest
|
||||||
|
table
|
||||||
|
used-columns
|
||||||
|
width
|
||||||
|
multi-rows?
|
||||||
|
action-for-num?
|
||||||
|
ledger-type?
|
||||||
|
double?
|
||||||
|
(not odd-row?)
|
||||||
|
total-collector
|
||||||
|
debit-collector
|
||||||
|
credit-collector
|
||||||
|
total-value
|
||||||
|
debit-value
|
||||||
|
credit-value))))
|
||||||
|
|
||||||
table))
|
table))
|
||||||
|
|
||||||
(define (reg-renderer report-obj)
|
(define (reg-renderer report-obj)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user