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-add-budget-headers!

Browse Source
This commit is contained in:
Christopher Lam 2019-03-02 23:06:06 +08:00
parent 66657f466e
commit 5108accfcd
1 changed files with 47 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -483,68 +483,60 @@
;; column-list - column info list ;; column-list - column info list
(define (gnc:html-table-add-budget-headers! (define (gnc:html-table-add-budget-headers!
html-table colnum budget column-list) html-table colnum budget column-list)
(let* ((current-col (+ colnum 1)) (let* ((current-col (1+ colnum))
(col-list column-list) (col-span (max 1 (count identity
(col-span 0)) (list show-budget? show-actual? show-diff?))))
(if show-budget? (set! col-span (+ col-span 1))) (period-to-date-string (lambda (p)
(if show-actual? (set! col-span (+ col-span 1))) (qof-print-date
(if show-diff? (set! col-span (+ col-span 1))) (gnc-budget-get-period-start-date budget p)))))
(if (eqv? col-span 0) (set! col-span 1))
;; prepend 2 empty rows ;; prepend 2 empty rows
(gnc:html-table-prepend-row! html-table '()) (gnc:html-table-prepend-row! html-table '())
(gnc:html-table-prepend-row! html-table '()) (gnc:html-table-prepend-row! html-table '())
(while (not (= (length col-list) 0)) (let loop ((column-list column-list)
(let* ((col-info (car col-list)) (current-col current-col))
(tc #f) (unless (null? column-list)
(period-to-date-string (lambda (p) (gnc:html-table-set-cell!
(qof-print-date html-table 0 current-col
(gnc-budget-get-period-start-date (cond
budget p))))) ((eq? (car column-list) 'total)
(cond (_ "Total"))
((equal? col-info 'total) ((list? (car column-list))
(gnc:html-table-set-cell! html-table 0 current-col (_ "Total"))) (string-append (period-to-date-string (car (car column-list)))
((list? col-info) " – "
(gnc:html-table-set-cell! (period-to-date-string (last (car column-list)))))
html-table 0 current-col (string-append (else
(period-to-date-string (car col-info)) (period-to-date-string (car column-list)))))
" – "
(period-to-date-string (let ((tc (gnc:html-table-get-cell html-table 0 current-col)))
(car (reverse col-info)))))) (gnc:html-table-cell-set-colspan! tc col-span)
(else (gnc:html-table-cell-set-tag! tc "centered-label-cell"))
(gnc:html-table-set-cell!
html-table 0 current-col (period-to-date-string col-info)))) (loop (cdr column-list)
(set! tc (gnc:html-table-get-cell html-table 0 current-col)) (1+ current-col))))
(gnc:html-table-cell-set-colspan! tc col-span)
(gnc:html-table-cell-set-tag! tc "centered-label-cell")
(set! current-col (+ current-col 1))
(set! col-list (cdr col-list))))
;; make the column headers ;; make the column headers
(set! col-list column-list) (let loop ((column-list column-list)
(set! current-col (+ colnum 1)) (col0 current-col))
(while (not (= (length column-list) 0)) (unless (null? column-list)
(let* ((col-info (car column-list))) (let* ((col1 (+ col0 (if show-budget? 1 0)))
(if show-budget? (col2 (+ col1 (if show-actual? 1 0)))
(begin (col3 (+ col2 (if show-diff? 1 0))))
(gnc:html-table-set-cell/tag! (when show-budget?
html-table 1 current-col "centered-label-cell" (gnc:html-table-set-cell/tag!
(_ "Bgt")) ;; Translators: Abbreviation for "Budget" html-table 1 col0 "centered-label-cell"
(set! current-col (+ current-col 1)))) (_ "Bgt"))) ;; Translators: Abbreviation for "Budget"
(if show-actual? (when show-actual?
(begin (gnc:html-table-set-cell/tag!
(gnc:html-table-set-cell/tag! html-table 1 col1 "centered-label-cell"
html-table 1 current-col "centered-label-cell" (_ "Act"))) ;; Translators: Abbreviation for "Actual"
(_ "Act")) ;; Translators: Abbreviation for "Actual" (when show-diff?
(set! current-col (+ current-col 1)))) (gnc:html-table-set-cell/tag!
(if show-diff? html-table 1 col2 "centered-label-cell"
(begin (_ "Diff"))) ;; Translators: Abbreviation for "Difference"
(gnc:html-table-set-cell/tag! (loop (cdr column-list)
html-table 1 current-col "centered-label-cell" col3))))))
(_ "Diff")) ;; Translators: Abbreviation for "Difference"
(set! current-col (+ current-col 1))))
(set! column-list (cdr column-list))))))
;; Determines the budget period relative to current period. Budget ;; Determines the budget period relative to current period. Budget
;; period is current if it start time <= current time and end time ;; period is current if it start time <= current time and end time