[register] changed do-rows-with-subtotals to named-let

this function is defined and used only once.
This commit is contained in:
Christopher Lam 2019-02-22 17:15:42 +08:00
parent 83d5c21c4b
commit 3759099e1e

View File

@ -577,25 +577,48 @@
(other-rows-driver split (xaccSplitGetParent split)
table used-columns 0))
(define (splits-leader splits)
(let ((accounts (map xaccSplitGetAccount splits)))
(if (null? accounts) '()
(begin
(set! accounts (cons (car accounts)
(delete (car accounts) (cdr accounts))))
(if (not (null? (cdr accounts))) '()
(car accounts))))))
;; ----------------------------------
;; main loop
;; make the split table
;; ----------------------------------
(define (do-rows-with-subtotals leader
splits
(let* ((table (gnc:make-html-table))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(multi-rows? (reg-report-journal?))
(ledger-type? (reg-report-ledger-type?))
(double? (reg-report-double?))
(action-for-num? (qof-book-use-split-action-for-num-field
(gnc-get-current-book))))
(gnc:html-table-set-col-headers!
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)
(make-heading-list used-columns
debit-string credit-string amount-string
multi-rows? action-for-num? ledger-type?))
(let loop ((leader (splits-leader splits))
(splits splits)
(table table)
(used-columns used-columns)
(width width)
(multi-rows? multi-rows?)
(action-for-num? action-for-num?)
(ledger-type? ledger-type?)
(double? double?)
(odd-row? #t)
(total-collector (gnc:make-commodity-collector))
(debit-collector (gnc:make-commodity-collector))
(credit-collector (gnc:make-commodity-collector))
(total-value (gnc:make-commodity-collector))
(debit-value (gnc:make-commodity-collector))
(credit-value (gnc:make-commodity-collector)))
(if (null? splits)
;; ----------------------------------
;; exit condition reached
@ -616,8 +639,7 @@
credit-value "grand-total" #t)))
(if ledger-type?
(add-subtotal-row (_ "Net Change") leader table used-columns
total-collector "grand-total" #f)
)
total-collector "grand-total" #f))
(add-subtotal-row (_ "Value Change") leader table used-columns
total-value "grand-total" #t))
@ -629,8 +651,7 @@
(if odd-row? "normal-row"
"alternate-row")))
(rest (cdr splits))
(next (if (null? rest) #f
(car rest)))
(next (and (pair? rest) (car rest)))
(valid-split? (not (null? (xaccSplitGetAccount current)))))
;; ----------------------------------------------
;; update totals, but don't add them to the table
@ -658,33 +679,18 @@
;; 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")
(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
)
)
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
)
)
(add-other-split-rows current table used-columns
"alternate-row" action-for-num?
ledger-type? total-collector))
(do-rows-with-subtotals leader
(loop leader
rest
table
used-columns
@ -700,51 +706,7 @@
total-value
debit-value
credit-value))))
;; -----------------------------------------------
;; needed for the call to (do-rows-with-subtotals)
;; -----------------------------------------------
(define (splits-leader splits)
(let ((accounts (map xaccSplitGetAccount splits)))
(if (null? accounts) '()
(begin
(set! accounts (cons (car accounts)
(delete (car accounts) (cdr accounts))))
(if (not (null? (cdr accounts))) '()
(car accounts))))))
;; ----------------------------------
;; make the split table
;; ----------------------------------
(let* ((table (gnc:make-html-table))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(multi-rows? (reg-report-journal?))
(ledger-type? (reg-report-ledger-type?))
(double? (reg-report-double?))
(action-for-num? (qof-book-use-split-action-for-num-field
(gnc-get-current-book))))
(gnc:html-table-set-col-headers!
table
(make-heading-list used-columns
debit-string credit-string amount-string
multi-rows? action-for-num? ledger-type?))
(do-rows-with-subtotals (splits-leader splits)
splits
table
used-columns
width
multi-rows?
action-for-num?
ledger-type?
double?
#t
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector))
table))
(define (reg-renderer report-obj)