[budget] compact budget-renderer

This commit is contained in:
Christopher Lam 2019-03-02 23:07:15 +08:00
parent 97bf596d31
commit 58cc7f00a5

View File

@ -684,44 +684,36 @@
(show-zb-accts? (get-option gnc:pagename-display (show-zb-accts? (get-option gnc:pagename-display
optname-show-zb-accounts)) optname-show-zb-accounts))
(use-ranges? (get-option gnc:pagename-general optname-use-budget-period-range)) (use-ranges? (get-option gnc:pagename-general optname-use-budget-period-range))
(include-collapse-before? (if use-ranges? (include-collapse-before? (and use-ranges?
(get-option gnc:pagename-general (get-option gnc:pagename-general
optname-period-collapse-before) optname-period-collapse-before)))
#f)) (include-collapse-after? (and use-ranges?
(include-collapse-after? (if use-ranges?
(get-option gnc:pagename-general (get-option gnc:pagename-general
optname-period-collapse-after) optname-period-collapse-after)))
#f))
(row-num 0)
(work-done 0)
(work-to-do 0)
(show-full-names? (get-option gnc:pagename-general (show-full-names? (get-option gnc:pagename-general
optname-show-full-names)) optname-show-full-names))
(doc (gnc:make-html-document))) (doc (gnc:make-html-document))
(accounts (append accounts
(filter (lambda (acc) (not (member acc accounts)))
(if show-subaccts?
(gnc:acccounts-get-all-subaccounts accounts)
'())))))
;; end of defines ;; end of defines
;; add subaccounts if requested
(if show-subaccts?
(let ((sub-accounts (gnc:acccounts-get-all-subaccounts accounts)))
(for-each
(lambda (sub-account)
(if (not (member sub-account accounts))
(set! accounts (cons sub-account accounts))))
sub-accounts)))
(cond (cond
((null? accounts) ((null? accounts)
;; No accounts selected. ;; No accounts selected.
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc doc (gnc:html-make-no-account-warning reportname (gnc:report-id report-obj))))
(gnc:html-make-no-account-warning reportname (gnc:report-id report-obj))))
((not budget-valid?) ((not budget-valid?)
;; No budget selected. ;; No budget selected.
(gnc:html-document-add-object! (gnc:html-document-add-object!
doc (gnc:html-make-generic-budget-warning reportname))) doc (gnc:html-make-generic-budget-warning reportname)))
(else (begin
(let* ((tree-depth (if (equal? display-depth 'all) (else
(let* ((tree-depth (if (eq? display-depth 'all)
(accounts-get-children-depth accounts) (accounts-get-children-depth accounts)
display-depth)) display-depth))
(to-period-val (lambda (v) (to-period-val (lambda (v)
@ -737,9 +729,8 @@
(list 'zero-balance-mode (list 'zero-balance-mode
(if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct)) (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
(list 'report-budget budget))) (list 'report-budget budget)))
(acct-table #f) (accounts (sort accounts account-full-name<?))
(html-table (gnc:make-html-table)) (acct-table (gnc:make-html-acct-table/env/accts env accounts))
(params '())
(paramsBudget (paramsBudget
(list (list
(list 'show-actual (list 'show-actual
@ -772,21 +763,14 @@
doc (format #f (_ "~a: ~a") doc (format #f (_ "~a: ~a")
report-name (gnc-budget-get-name budget))) report-name (gnc-budget-get-name budget)))
(set! accounts (sort accounts account-full-name<?))
(set! acct-table
(gnc:make-html-acct-table/env/accts env accounts))
;; We do this in two steps: First the account names... the ;; We do this in two steps: First the account names... the
;; add-account-balances will actually compute and add a ;; add-account-balances will actually compute and add a
;; bunch of current account balances, too, but we'll ;; bunch of current account balances, too, but we'll
;; overwrite them. ;; overwrite them.
(set! html-table (gnc:html-table-add-account-balances (let ((html-table (gnc:html-table-add-account-balances #f acct-table '())))
#f acct-table params))
;; ... then the budget values ;; ... then the budget values
(gnc:html-table-add-budget-values! (gnc:html-table-add-budget-values! html-table acct-table budget paramsBudget)
html-table acct-table budget paramsBudget)
;; hmmm... I expected that add-budget-values would have to ;; hmmm... I expected that add-budget-values would have to
;; clear out any unused columns to the right, out to the ;; clear out any unused columns to the right, out to the