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

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

Browse Source 
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
1 changed files with 104 additions and 142 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
gnucash/report/standard-reports/register.scm
View File

@ -577,25 +577,48 @@
(other-rows-driver split (xaccSplitGetParent split) (other-rows-driver split (xaccSplitGetParent split)
table used-columns 0)) 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 (let* ((table (gnc:make-html-table))
splits (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 table
used-columns (make-heading-list used-columns
width debit-string credit-string amount-string
multi-rows? multi-rows? action-for-num? ledger-type?))
action-for-num?
ledger-type? (let loop ((leader (splits-leader splits))
double? (splits splits)
odd-row? (table table)
total-collector (used-columns used-columns)
debit-collector (width width)
credit-collector (multi-rows? multi-rows?)
total-value (action-for-num? action-for-num?)
debit-value (ledger-type? ledger-type?)
credit-value) (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) (if (null? splits)
;; ---------------------------------- ;; ----------------------------------
;; exit condition reached ;; exit condition reached
@ -616,8 +639,7 @@
credit-value "grand-total" #t))) credit-value "grand-total" #t)))
(if ledger-type? (if ledger-type?
(add-subtotal-row (_ "Net Change") leader table used-columns (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 (add-subtotal-row (_ "Value Change") leader table used-columns
total-value "grand-total" #t)) total-value "grand-total" #t))
@ -629,8 +651,7 @@
(if odd-row? "normal-row" (if odd-row? "normal-row"
"alternate-row"))) "alternate-row")))
(rest (cdr splits)) (rest (cdr splits))
(next (if (null? rest) #f (next (and (pair? rest) (car rest)))
(car rest)))
(valid-split? (not (null? (xaccSplitGetAccount current))))) (valid-split? (not (null? (xaccSplitGetAccount current)))))
;; ---------------------------------------------- ;; ----------------------------------------------
;; update totals, but don't add them to the table ;; update totals, but don't add them to the table
@ -658,33 +679,18 @@
;; This split should be skipped or the report errors out. ;; This split should be skipped or the report errors out.
;; See bug #639082 ;; See bug #639082
(if valid-split? (if valid-split?
(add-split-row (add-split-row table current used-columns
table current-row-style #t (not multi-rows?)
current action-for-num? ledger-type?
used-columns double? (opt-val "Display" "Memo")
current-row-style
#t
(not multi-rows?)
action-for-num?
ledger-type?
double?
(opt-val "Display" "Memo")
(opt-val "Display" "Description") (opt-val "Display" "Description")
total-collector total-collector))
)
)
(if (and multi-rows? valid-split?) (if (and multi-rows? valid-split?)
(add-other-split-rows (add-other-split-rows current table used-columns
current "alternate-row" action-for-num?
table used-columns ledger-type? total-collector))
"alternate-row"
action-for-num?
ledger-type?
total-collector
)
)
(do-rows-with-subtotals leader (loop leader
rest rest
table table
used-columns used-columns
@ -700,51 +706,7 @@
total-value total-value
debit-value debit-value
credit-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)) table))
(define (reg-renderer report-obj) (define (reg-renderer report-obj)