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

[TR] refactor add-subtotal-row

Browse Source 
Schemify to use (append) rather than (set!) calls to build
list-of-cells. This is (IMHO) neater and definitely favoured by
seasoned schemers.
This commit is contained in:
Christopher Lam 2018-05-21 21:56:31 +08:00
parent 333a14c0fd
commit 98964f7a6d
1 changed files with 43 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1309,8 +1309,7 @@ be excluded from periodic reporting.")
(gnc:html-table-append-row/markup! table subheading-style (reverse row-contents))))) (gnc:html-table-append-row/markup! table subheading-style (reverse row-contents)))))
(define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col) (define (add-subtotal-row subtotal-string subtotal-collectors subtotal-style level row col)
(let* ((row-contents '()) (let* ((left-indent (case level
(left-indent (case level
((total) 0) ((total) 0)
((primary) primary-indent) ((primary) primary-indent)
((secondary) (+ primary-indent secondary-indent)))) ((secondary) (+ primary-indent secondary-indent))))
@ -1321,26 +1320,26 @@ be excluded from periodic reporting.")
gnc-commodity-equal))) gnc-commodity-equal)))
(define (retrieve-commodity list-of-monetary commodity) (define (retrieve-commodity list-of-monetary commodity)
(if (null? list-of-monetary) (find (lambda (mon) (gnc-commodity-equal commodity (gnc:gnc-monetary-commodity mon)))
#f list-of-monetary))
(if (gnc-commodity-equal (gnc:gnc-monetary-commodity (car list-of-monetary)) commodity)
(car list-of-monetary)
(retrieve-commodity (cdr list-of-monetary) commodity))))
(define (add-first-column string) (define (first-column string)
(if export? (if export?
(begin (cons
(addto! row-contents (gnc:make-html-table-cell/markup "total-label-cell" string)) (gnc:make-html-table-cell/markup "total-label-cell" string)
(for-each (lambda (cell) (addto! row-contents cell)) (gnc:html-make-empty-cells (+ right-indent width-left-columns -1)))
(gnc:html-make-empty-cells (+ right-indent width-left-columns -1)))) (list
(addto! row-contents (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string)))) (gnc:make-html-table-cell/size/markup 1 (+ right-indent width-left-columns) "total-label-cell" string))))
(define (add-columns commodity) (define (data-columns commodity)
(let loop ((merging? #f) (let loop ((merging? #f)
(last-column #f) (last-column #f)
(columns columns) (columns columns)
(merge-list merge-list)) (merge-list merge-list)
(if (not (null? columns)) (result '()))
(if (null? columns)
;; we've processed all columns. return the (reversed) list of html-table-cells.
(reverse result)
(let* ((mon (retrieve-commodity (car columns) commodity)) (let* ((mon (retrieve-commodity (car columns) commodity))
(this-column (and mon (gnc:gnc-monetary-amount mon)))) (this-column (and mon (gnc:gnc-monetary-amount mon))))
(if (car merge-list) (if (car merge-list)
@ -1348,7 +1347,8 @@ be excluded from periodic reporting.")
(loop #t (loop #t
this-column this-column
(cdr columns) (cdr columns)
(cdr merge-list)) (cdr merge-list)
result)
(begin (begin
(if merging? (if merging?
;; We're completing merge. Display debit-credit in correct column. ;; We're completing merge. Display debit-credit in correct column.
@ -1360,38 +1360,37 @@ be excluded from periodic reporting.")
commodity (abs sum))))) commodity (abs sum)))))
(debit-col (and sum (positive? sum) sum-table-cell)) (debit-col (and sum (positive? sum) sum-table-cell))
(credit-col (and sum (not (positive? sum)) sum-table-cell))) (credit-col (and sum (not (positive? sum)) sum-table-cell)))
(addto! row-contents (or debit-col "")) (loop #f
(addto! row-contents (or credit-col ""))) #f
;; Default; not merging nor completed merge. Display monetary amount (cdr columns)
(addto! row-contents (gnc:make-html-table-cell/markup "total-number-cell" mon))) (cdr merge-list)
(loop #f (cons* (or credit-col "")
#f (or debit-col "")
(cdr columns) result)))
(cdr merge-list)))))))) ;; Default; not merging nor completed merge. Just add amount to result.
(loop #f
#f
(cdr columns)
(cdr merge-list)
(cons (gnc:make-html-table-cell/markup "total-number-cell" mon)
result)))))))))
;; we only wish to add the first column into the grid. ;; we only wish to add the first column into the grid.
(if (pair? columns) (if (pair? columns)
(set! grid (grid-add grid row col (car columns)))) (set! grid (grid-add grid row col (car columns))))
;;first row ;; each commodity subtotal gets a separate line in the html-table
(for-each (lambda (cell) (addto! row-contents cell)) ;; each line comprises: indenting, first-column, data-columns
(gnc:html-make-empty-cells left-indent)) (let loop ((first-column-string subtotal-string)
(add-first-column subtotal-string) (list-of-commodities list-of-commodities))
(add-columns (if (pair? list-of-commodities) (unless (null? list-of-commodities)
(car list-of-commodities) (gnc:html-table-append-row/markup!
#f)) ;to account for empty-row subtotals table subtotal-style
(gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents)) (append
(gnc:html-make-empty-cells left-indent)
;;subsequent rows (first-column first-column-string)
(if (pair? list-of-commodities) (data-columns (car list-of-commodities))))
(for-each (lambda (commodity) (loop "" (cdr list-of-commodities))))))
(set! row-contents '())
(for-each (lambda (cell) (addto! row-contents cell))
(gnc:html-make-empty-cells left-indent))
(add-first-column "")
(add-columns commodity)
(gnc:html-table-append-row/markup! table subtotal-style (reverse row-contents)))
(cdr list-of-commodities)))))
(define (total-string str) (string-append (_ "Total For ") str)) (define (total-string str) (string-append (_ "Total For ") str))