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

[budget] compact gnc:html-table-display-budget-columns!

Browse Source
This commit is contained in:
Christopher Lam 2019-03-02 23:00:49 +08:00
parent 275119335b
commit e5495caab9
1 changed files with 54 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
gnucash/report/standard-reports/budget.scm
View File

@ -355,98 +355,83 @@
(define (gnc:html-table-add-budget-line! (define (gnc:html-table-add-budget-line!
html-table rownum colnum budget acct rollup-budget? html-table rownum colnum budget acct rollup-budget?
column-list exchange-fn) column-list exchange-fn)
(let* ((current-col (1+ colnum)) (let* ((comm (xaccAccountGetCommodity acct))
(comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct)) (reverse-balance? (gnc-reverse-balance acct))
(income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME))) (income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
;; Displays a set of budget column values ;; Displays a set of budget column values
;; ;;
;; Parameters ;; Parameters
;; html-table - html table being created ;; style-tag - cell style
;; rownum - row number ;; col - starting column to modify in html-table
;; total? - is this a set of total columns ;; bgt-val - budget value
;; bgt-numeric-val - budget value, or #f if column not to be shown ;; act-val - actual value
;; act-numeric-val - actual value, or #f if column not to be shown ;; dif-val - difference value
;; dif-numeric val - difference value, or #f if column not to be shown ;;
(define (gnc:html-table-display-budget-columns! ;; Returns
html-table rownum total? bgt-numeric-val act-numeric-val ;; col - next column
dif-numeric-val) (define (disp-cols style-tag col0
(let* ((bgt-val #f) bgt-val act-val dif-val)
(act-val #f) (let* ((style-tag-neg (string-append style-tag "-neg"))
(dif-val #f) (col1 (+ col0 (if show-budget? 1 0)))
(style-tag (if total? "total-number-cell" "number-cell")) (col2 (+ col1 (if show-actual? 1 0)))
(style-tag-neg (string-append style-tag "-neg"))) (col3 (+ col2 (if show-diff? 1 0))))
(if show-budget? (if show-budget?
(begin (gnc:html-table-set-cell/tag!
(set! bgt-val (if (zero? bgt-numeric-val) "." html-table rownum col0 style-tag
(gnc:make-gnc-monetary comm bgt-numeric-val))) (if (zero? bgt-val) "."
(gnc:html-table-set-cell/tag! (gnc:make-gnc-monetary comm bgt-val))))
html-table rownum current-col style-tag bgt-val)
(set! current-col (+ current-col 1))))
(if show-actual? (if show-actual?
(begin (gnc:html-table-set-cell/tag!
(set! act-val (gnc:make-gnc-monetary comm act-numeric-val)) html-table rownum col1
(gnc:html-table-set-cell/tag! (if (negative? act-val) style-tag-neg style-tag)
html-table rownum current-col (gnc:make-gnc-monetary comm act-val)))
(if (negative? act-numeric-val)
style-tag-neg
style-tag)
act-val)
(set! current-col (+ current-col 1))))
(if show-diff? (if show-diff?
(begin (gnc:html-table-set-cell/tag!
(set! dif-val html-table rownum col2
(if (and (zero? bgt-numeric-val) (if (negative? dif-val) style-tag-neg style-tag)
(zero? act-numeric-val)) (if (and (zero? bgt-val) (zero? act-val)) "."
"." (gnc:make-gnc-monetary comm dif-val))))
(gnc:make-gnc-monetary comm dif-numeric-val))) col3))
(gnc:html-table-set-cell/tag!
html-table rownum current-col
(if (negative? dif-numeric-val)
style-tag-neg
style-tag)
dif-val)
(set! current-col (+ current-col 1))))))
(let loop ((column-list column-list) (let loop ((column-list column-list)
(bgt-total 0) (bgt-total 0)
(act-total 0)) (act-total 0)
(current-col (1+ colnum)))
(cond (cond
((null? column-list) ((null? column-list)
#f) #f)
((eq? (car column-list) 'total) ((eq? (car column-list) 'total)
(gnc:html-table-display-budget-columns! (loop (cdr column-list)
html-table rownum #t bgt-total act-total bgt-total
(if income-acct? act-total
(- act-total bgt-total) (disp-cols "total-number-cell" current-col
(- bgt-total act-total))) bgt-total act-total
(loop (cdr column-list))) (if income-acct?
(- act-total bgt-total)
(- bgt-total act-total)))))
(else (else
(let* ((period-list (if (list? (car column-list)) (let* ((period-list (if (list? (car column-list))
(car column-list) (car column-list)
(list (car column-list)))) (list (car column-list))))
(bgt-numeric-val (gnc:get-account-periodlist-budget-value (bgt-val (gnc:get-account-periodlist-budget-value
budget acct period-list)) budget acct period-list))
(act-numeric-abs (gnc:get-account-periodlist-actual-value (act-abs (gnc:get-account-periodlist-actual-value
budget acct period-list)) budget acct period-list))
(act-numeric-val (if reverse-balance? (act-val (if reverse-balance?
(- act-numeric-abs) (- act-abs)
act-numeric-abs)) act-abs))
(dif-numeric-val (if income-acct? (dif-val (if income-acct?
(- act-numeric-val bgt-numeric-val) (- act-val bgt-val)
(- bgt-numeric-val act-numeric-val)))) (- bgt-val act-val))))
(loop (cdr column-list)
(gnc:html-table-display-budget-columns! (+ bgt-total bgt-val)
html-table rownum #f (+ act-total act-val)
bgt-numeric-val act-numeric-val dif-numeric-val)) (disp-cols "number-cell" current-col
bgt-val act-val dif-val))))))))
(loop (cdr column-list)
(+ bgt-total bgt-numeric-val)
(+ act-total act-numeric-val)))))))
;; Adds header rows to the budget report. The columns are ;; Adds header rows to the budget report. The columns are
;; specified by the column-list parameter. ;; specified by the column-list parameter.