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

REFACTOR: simplify functions, reduce arguments

Browse Source
This commit is contained in:
Christopher Lam 2017-12-10 10:33:25 +08:00
parent a5306d0454
commit d88d503b38
1 changed files with 159 additions and 201 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

360
gnucash/report/standard-reports/transaction.scm
View File

@ -109,12 +109,6 @@ options specified in the Options panels."))
(define SUBTOTAL-ENABLED (list 'account-name 'corresponding-acc-name (define SUBTOTAL-ENABLED (list 'account-name 'corresponding-acc-name
'account-code 'corresponding-acc-code)) 'account-code 'corresponding-acc-code))
(define (add-subheading-row data table width subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell width)
(gnc:html-table-append-row/markup!
table subheading-style
(list heading-cell))))
(define (column-uses? param columns-used) (define (column-uses? param columns-used)
(cdr (assq param columns-used))) (cdr (assq param columns-used)))
@ -138,151 +132,90 @@ options specified in the Options panels."))
(xaccAccountGetName account)) (xaccAccountGetName account))
"")))) ""))))
;; render an account subheading - column-vector determines what is displayed ;; render an account subheading - column-vector determines what is displayed
(define (render-account-subheading (define (render-account-subheading split column-vector)
split table width subheading-style column-vector)
(let ((account (xaccSplitGetAccount split))) (let ((account (xaccSplitGetAccount split)))
(add-subheading-row (gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-anchor (gnc:html-markup-anchor
(gnc:account-anchor-text account) (gnc:account-anchor-text account)
(account-namestring account (account-namestring account
(column-uses? 'sort-account-code column-vector) (column-uses? 'sort-account-code column-vector)
#t #t
(column-uses? 'sort-account-full-name column-vector)))) (column-uses? 'sort-account-full-name column-vector))))))
table width subheading-style)))
(define (render-corresponding-account-subheading (define (render-corresponding-account-subheading split column-vector)
split table width subheading-style column-vector)
(let ((account (xaccSplitGetAccount (xaccSplitGetOtherSplit split)))) (let ((account (xaccSplitGetAccount (xaccSplitGetOtherSplit split))))
(add-subheading-row (gnc:make-html-text (gnc:make-html-text
(gnc:html-markup-anchor (gnc:html-markup-anchor
(if (null? account) (if (null? account)
"" ""
(gnc:account-anchor-text account)) (gnc:account-anchor-text account))
(account-namestring account (account-namestring account
(column-uses? 'sort-account-code column-vector) (column-uses? 'sort-account-code column-vector)
#t #t
(column-uses? 'sort-account-full-name column-vector)))) (column-uses? 'sort-account-full-name column-vector))))))
table width subheading-style)))
(define (render-week-subheading split table width subheading-style column-vector) (define (render-week-subheading split column-vector)
(add-subheading-row (gnc:date-get-week-year-string (gnc:date-get-week-year-string
(gnc:timepair->date (gnc:timepair->date
(gnc-transaction-get-date-posted (gnc-transaction-get-date-posted
(xaccSplitGetParent split)))) (xaccSplitGetParent split)))))
table width subheading-style))
(define (render-month-subheading split table width subheading-style column-vector) (define (render-month-subheading split column-vector)
(add-subheading-row (gnc:date-get-month-year-string (gnc:date-get-month-year-string
(gnc:timepair->date (gnc:timepair->date
(gnc-transaction-get-date-posted (gnc-transaction-get-date-posted
(xaccSplitGetParent split)))) (xaccSplitGetParent split)))))
table width subheading-style))
(define (render-quarter-subheading split table width subheading-style column-vector) (define (render-quarter-subheading split column-vector)
(add-subheading-row (gnc:date-get-quarter-year-string (gnc:date-get-quarter-year-string
(gnc:timepair->date (gnc:timepair->date
(gnc-transaction-get-date-posted (gnc-transaction-get-date-posted
(xaccSplitGetParent split)))) (xaccSplitGetParent split)))))
table width subheading-style))
(define (render-year-subheading split table width subheading-style column-vector)
(add-subheading-row (gnc:date-get-year-string
(gnc:timepair->date
(gnc-transaction-get-date-posted
(xaccSplitGetParent split))))
table width subheading-style))
(define (add-subtotal-row table width subtotal-string subtotal-collector (define (render-year-subheading split column-vector)
subtotal-style export?) (gnc:date-get-year-string
(let ((currency-totals (subtotal-collector 'format gnc:make-gnc-monetary #f))) (gnc:timepair->date
(gnc:html-table-append-row/markup! (gnc-transaction-get-date-posted
table (xaccSplitGetParent split)))))
subtotal-style
(if export?
(append! (cons (gnc:make-html-table-cell/markup "total-label-cell" subtotal-string)
(gnc:html-make-empty-cells (- width 2)))
(list (gnc:make-html-table-cell/markup
"total-number-cell"
(car currency-totals))))
(list (gnc:make-html-table-cell/size/markup 1 (- width 1) "total-label-cell"
subtotal-string)
(gnc:make-html-table-cell/markup
"total-number-cell"
(car currency-totals)))))
(for-each (lambda (currency)
(gnc:html-table-append-row/markup!
table
subtotal-style
(append!
(if export?
(gnc:html-make-empty-cells (- width 1))
(list (gnc:make-html-table-cell/size 1 (- width 1) #f)))
(list (gnc:make-html-table-cell/markup
"total-number-cell" currency)))))
(cdr currency-totals))))
(define (total-string str) (string-append (_ "Total For ") str)) (define (total-string str) (string-append (_ "Total For ") str))
(define (render-account-subtotal (define (render-account-subtotal split column-vector)
table width split total-collector subtotal-style column-vector export?) (total-string (account-namestring (xaccSplitGetAccount split)
(add-subtotal-row table width (column-uses? 'sort-account-code column-vector)
(total-string (account-namestring (xaccSplitGetAccount split) #t
(column-uses? 'sort-account-code column-vector) (column-uses? 'sort-account-full-name column-vector))))
#t
(column-uses? 'sort-account-full-name column-vector)))
total-collector subtotal-style export?))
(define (render-corresponding-account-subtotal (define (render-corresponding-account-subtotal split column-vector)
table width split total-collector subtotal-style column-vector export?) (total-string (account-namestring (xaccSplitGetAccount (xaccSplitGetOtherSplit split))
(add-subtotal-row table width (column-uses? 'sort-account-code column-vector)
(total-string (account-namestring (xaccSplitGetAccount #t
(xaccSplitGetOtherSplit split)) (column-uses? 'sort-account-full-name column-vector))))
(column-uses? 'sort-account-code column-vector)
#t
(column-uses? 'sort-account-full-name column-vector)))
total-collector subtotal-style export?))
(define (render-week-subtotal (define (render-week-subtotal split column-vector)
table width split total-collector subtotal-style column-vector export?)
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
(xaccSplitGetParent split))))) (xaccSplitGetParent split)))))
(add-subtotal-row table width (total-string (gnc:date-get-week-year-string tm))))
(total-string (gnc:date-get-week-year-string tm))
total-collector subtotal-style export?)))
(define (render-month-subtotal (define (render-month-subtotal split column-vector)
table width split total-collector subtotal-style column-vector export?)
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
(xaccSplitGetParent split))))) (xaccSplitGetParent split)))))
(add-subtotal-row table width (total-string (gnc:date-get-month-year-string tm))))
(total-string (gnc:date-get-month-year-string tm))
total-collector subtotal-style export?)))
(define (render-quarter-subtotal split column-vector)
(define (render-quarter-subtotal
table width split total-collector subtotal-style column-vector export?)
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
(xaccSplitGetParent split))))) (xaccSplitGetParent split)))))
(add-subtotal-row table width (total-string (gnc:date-get-quarter-year-string tm))))
(total-string (gnc:date-get-quarter-year-string tm))
total-collector subtotal-style export?)))
(define (render-year-subtotal (define (render-year-subtotal split column-vector)
table width split total-collector subtotal-style column-vector export?)
(let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted (let ((tm (gnc:timepair->date (gnc-transaction-get-date-posted
(xaccSplitGetParent split))))) (xaccSplitGetParent split)))))
(add-subtotal-row table width (total-string (strftime "%Y" tm))))
(total-string (strftime "%Y" tm))
total-collector subtotal-style export?)))
(define (render-grand-total (define (render-grand-total)
table width total-collector export?) (_ "Grand Total")) ; def:grand-total-style
(add-subtotal-row table width
(_ "Grand Total")
total-collector def:grand-total-style export?))
@ -464,7 +397,7 @@ options specified in the Options panels."))
(define (add-split-row table split column-vector options (define (add-split-row table split column-vector options
row-style account-types-to-reverse transaction-row?) row-style account-types-to-reverse transaction-row?)
(define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name))) (define (opt-val section name) (gnc:option-value (gnc:lookup-option options section name)))
(let* ((row-contents '()) (let* ((row-contents '())
(parent (xaccSplitGetParent split)) (parent (xaccSplitGetParent split))
@ -1093,8 +1026,54 @@ Credit Card, and Income accounts."))))))
(add-if (column-uses? 'running-balance columns-used) (add-if (column-uses? 'running-balance columns-used)
(_ "Balance")))) (_ "Balance"))))
(let ((work-to-do (length splits)) (let* ((work-to-do (length splits))
(work-done 0)) (work-done 0)
(table (gnc:make-html-table))
(used-columns (build-columns-used))
(headings (make-heading-list used-columns))
(width (length headings))
(account-types-to-reverse
(case (opt-val gnc:pagename-display (N_ "Sign Reverses"))
((none) '())
((income-expense) (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE))
((credit-accounts) (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE
ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
ACCT-TYPE-INCOME))))
(is-multiline? (eq? (opt-val gnc:pagename-display optname-detail-level) 'multi-line))
(export? (opt-val gnc:pagename-general optname-table-export)))
(define (add-subheading data subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell width)
(gnc:html-table-append-row/markup!
table subheading-style
(list heading-cell))))
(define (add-subtotal-row string collector style)
(let ((currency-totals (collector 'format gnc:make-gnc-monetary #f)))
(gnc:html-table-append-row/markup!
table style
(if export?
(append! (cons (gnc:make-html-table-cell/markup "total-label-cell" string)
(gnc:html-make-empty-cells (- width 2)))
(list (gnc:make-html-table-cell/markup
"total-number-cell"
(car currency-totals))))
(list (gnc:make-html-table-cell/size/markup 1 (- width 1) "total-label-cell"
string)
(gnc:make-html-table-cell/markup
"total-number-cell"
(car currency-totals)))))
(for-each (lambda (currency)
(gnc:html-table-append-row/markup!
table style
(append!
(if export?
(gnc:html-make-empty-cells (- width 1))
(list (gnc:make-html-table-cell/size 1 (- width 1) #f)))
(list (gnc:make-html-table-cell/markup
"total-number-cell" currency)))))
(cdr currency-totals))))
(define (do-rows-with-subtotals splits (define (do-rows-with-subtotals splits
table table
@ -1119,9 +1098,9 @@ Credit Card, and Income accounts."))))))
(set! work-done (+ 1 work-done)) (set! work-done (+ 1 work-done))
(if (null? splits) (if (null? splits)
(begin (begin
(gnc:html-table-append-row/markup! (gnc:html-table-append-row/markup!
table def:grand-total-style table def:grand-total-style
(list (list
@ -1129,12 +1108,11 @@ Credit Card, and Income accounts."))))))
1 width (gnc:make-html-text (gnc:html-markup-hr))))) 1 width (gnc:make-html-text (gnc:html-markup-hr)))))
(if (opt-val gnc:pagename-display "Totals") (if (opt-val gnc:pagename-display "Totals")
(render-grand-total table width total-collector export?))) (add-subtotal-row (render-grand-total) total-collector def:grand-total-style)))
(let* ((current (car splits)) (let* ((current (car splits))
(rest (cdr splits)) (rest (cdr splits))
(next (if (null? rest) #f (next (if (null? rest) #f (car rest))))
(car rest))))
(define split-value (add-split-row (define split-value (add-split-row
table table
@ -1147,7 +1125,7 @@ Credit Card, and Income accounts."))))))
def:alternate-row-style)) def:alternate-row-style))
account-types-to-reverse account-types-to-reverse
#t)) #t))
(if multi-rows? (if multi-rows?
(for-each (lambda (othersplits) (for-each (lambda (othersplits)
@ -1168,11 +1146,11 @@ Credit Card, and Income accounts."))))))
(secondary-subtotal-collector 'add (secondary-subtotal-collector 'add
(gnc:gnc-monetary-commodity split-value) (gnc:gnc-monetary-commodity split-value)
(gnc:gnc-monetary-amount split-value)) (gnc:gnc-monetary-amount split-value))
(total-collector 'add (total-collector 'add
(gnc:gnc-monetary-commodity split-value) (gnc:gnc-monetary-commodity split-value)
(gnc:gnc-monetary-amount split-value)) (gnc:gnc-monetary-amount split-value))
(if (and primary-subtotal-pred (if (and primary-subtotal-pred
(or (not next) (or (not next)
(and next (and next
@ -1182,53 +1160,47 @@ Credit Card, and Income accounts."))))))
(begin (begin
(if secondary-subtotal-pred (if secondary-subtotal-pred
(begin (begin
(secondary-subtotal-renderer (add-subtotal-row (secondary-subtotal-renderer current used-columns)
table width current secondary-subtotal-collector
secondary-subtotal-collector def:secondary-subtotal-style)
def:secondary-subtotal-style used-columns export?)
(secondary-subtotal-collector 'reset #f #f))) (secondary-subtotal-collector 'reset #f #f)))
(primary-subtotal-renderer table width current (add-subtotal-row (primary-subtotal-renderer current used-columns)
primary-subtotal-collector primary-subtotal-collector
def:primary-subtotal-style used-columns def:primary-subtotal-style)
export?)
(primary-subtotal-collector 'reset #f #f) (primary-subtotal-collector 'reset #f #f)
(if next (if next
(begin (begin
(primary-subheading-renderer (add-subheading (primary-subheading-renderer next used-columns)
next table width def:primary-subtotal-style used-columns) def:primary-subtotal-style)
(if secondary-subtotal-pred (if secondary-subtotal-pred
(secondary-subheading-renderer (add-subheading (secondary-subheading-renderer next used-columns)
next def:secondary-subtotal-style)))))
table
width def:secondary-subtotal-style used-columns)))))
(if (and secondary-subtotal-pred (if (and secondary-subtotal-pred
(or (not next) (or (not next)
(and next (and next
(not (equal? (secondary-subtotal-pred current) (not (equal? (secondary-subtotal-pred current)
(secondary-subtotal-pred next)))))) (secondary-subtotal-pred next))))))
(begin (secondary-subtotal-renderer (begin (add-subtotal-row (secondary-subtotal-renderer current used-columns)
table width current secondary-subtotal-collector
secondary-subtotal-collector def:secondary-subtotal-style)
def:secondary-subtotal-style used-columns export?)
(secondary-subtotal-collector 'reset #f #f) (secondary-subtotal-collector 'reset #f #f)
(if next (if next
(secondary-subheading-renderer (add-subheading (secondary-subheading-renderer next used-columns)
next table width def:secondary-subtotal-style)))))
def:secondary-subtotal-style used-columns)))))
(do-rows-with-subtotals rest (do-rows-with-subtotals rest
table table
@ -1248,45 +1220,31 @@ Credit Card, and Income accounts."))))))
secondary-subtotal-collector secondary-subtotal-collector
total-collector)))) total-collector))))
(let* ((table (gnc:make-html-table)) (gnc:html-table-set-col-headers! table headings)
(used-columns (build-columns-used))
(headings (make-heading-list used-columns))
(width (length headings))
(account-types-to-reverse
(cdr (assq (opt-val gnc:pagename-display (N_ "Sign Reverses"))
(list (cons 'none '())
(cons 'income-expense (list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE))
(cons 'credit-accounts (list ACCT-TYPE-LIABILITY ACCT-TYPE-PAYABLE
ACCT-TYPE-EQUITY ACCT-TYPE-CREDIT
ACCT-TYPE-INCOME))))))
(is-multiline? (eq? (opt-val gnc:pagename-display optname-detail-level) 'multi-line))
(export? (opt-val gnc:pagename-general optname-table-export)))
(gnc:html-table-set-col-headers! table headings) (if primary-subheading-renderer
(add-subheading (primary-subheading-renderer (car splits) used-columns)
def:primary-subtotal-style))
(if primary-subheading-renderer (if secondary-subheading-renderer
(primary-subheading-renderer (add-subheading (secondary-subheading-renderer (car splits) used-columns)
(car splits) table width def:primary-subtotal-style used-columns)) def:secondary-subtotal-style))
(if secondary-subheading-renderer (do-rows-with-subtotals splits table used-columns width
(secondary-subheading-renderer is-multiline? #t
(car splits) table width def:secondary-subtotal-style used-columns)) export?
account-types-to-reverse
primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
primary-subtotal-renderer
secondary-subtotal-renderer
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector))
(do-rows-with-subtotals splits table used-columns width table))
is-multiline? #t
export?
account-types-to-reverse
primary-subtotal-pred
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
primary-subtotal-renderer
secondary-subtotal-renderer
(gnc:make-commodity-collector)
(gnc:make-commodity-collector)
(gnc:make-commodity-collector))
table)))
;; ;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;
;; Here comes the renderer function for this report. ;; Here comes the renderer function for this report.