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-flow] *reindent/delete-trailing-whitespace/untabify*

Browse Source
This commit is contained in:
Christopher Lam 2019-03-07 22:00:38 +08:00
parent edd87fa47c
commit 414992f8ec
1 changed files with 170 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

172
gnucash/report/standard-reports/budget-flow.scm
View File

@ -93,22 +93,19 @@
;; Set the general page as default option tab ;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
options options))
))
;; Append a row to html-table with markup and values ;; Append a row to html-table with markup and values
(define (gnc:html-table-add-budget-row! (define (gnc:html-table-add-budget-row!
html-table markup text total1 total2) html-table markup text total1 total2)
;; Cell order is text, budgeted, actual ;; Cell order is text, budgeted, actual
(gnc:html-table-append-row/markup! html-table "normal-row" (gnc:html-table-append-row/markup!
html-table "normal-row"
(list (list
(gnc:make-html-table-cell/markup "text-cell" text) (gnc:make-html-table-cell/markup "text-cell" text)
(gnc:make-html-table-cell/markup markup total1) (gnc:make-html-table-cell/markup markup total1)
(gnc:make-html-table-cell/markup markup total2) (gnc:make-html-table-cell/markup markup total2))))
)))
;; For each account in acct-table: ;; For each account in acct-table:
;; Retrieve the budgeted and actual amount ;; Retrieve the budgeted and actual amount
@ -121,11 +118,9 @@
(define (gnc:html-table-add-budget-accounts! (define (gnc:html-table-add-budget-accounts!
html-table acct-table budget period exchange-fn report-currency) html-table acct-table budget period exchange-fn report-currency)
(let* (
;; Used to sum up the budgeted and actual totals ;; Used to sum up the budgeted and actual totals
(bgt-total (gnc:make-commodity-collector)) (let* ((bgt-total (gnc:make-commodity-collector))
(act-total (gnc:make-commodity-collector)) (act-total (gnc:make-commodity-collector)))
)
;; Loop though each account ;; Loop though each account
;; ;;
@ -134,47 +129,51 @@
;; and summing a parent account cause the totals to be off. ;; and summing a parent account cause the totals to be off.
;; so we do not display parent accounts ;; so we do not display parent accounts
;; ;;
(for-each (lambda (acct) (for-each
(lambda (acct)
;; If acct has children do nto display (see above) ;; If acct has children do nto display (see above)
(if (null? (gnc-account-get-children acct)) (if (null? (gnc-account-get-children acct))
(let* ( ;; Retrieve the budgeted and actual amount and
;; Retrieve the budgeted and actual amount and convert to <gnc:monetary> ;; convert to <gnc:monetary>
(comm (xaccAccountGetCommodity acct)) (let* ((comm (xaccAccountGetCommodity acct))
(bgt-numeric (gnc-budget-get-account-period-value budget acct (- period 1))) (bgt-numeric (gnc-budget-get-account-period-value
budget acct (1- period)))
(bgt-monetary (gnc:make-gnc-monetary comm bgt-numeric)) (bgt-monetary (gnc:make-gnc-monetary comm bgt-numeric))
(act-numeric (gnc-budget-get-account-period-actual-value budget acct (- period 1))) (act-numeric (gnc-budget-get-account-period-actual-value
(act-monetary (gnc:make-gnc-monetary comm act-numeric)) budget acct (1- period)))
) (act-monetary (gnc:make-gnc-monetary comm act-numeric)))
;; Add amounts to collectors ;; Add amounts to collectors
(bgt-total 'add comm bgt-numeric) (bgt-total 'add comm bgt-numeric)
(act-total 'add comm act-numeric) (act-total 'add comm act-numeric)
;; Display row ;; Display row
(gnc:html-table-add-budget-row! html-table "number-cell" (gnc:html-table-add-budget-row!
(gnc:make-html-text (gnc:html-markup-anchor (gnc:account-anchor-text acct) (gnc-account-get-full-name acct))) html-table "number-cell"
(gnc:make-html-text
(gnc:html-markup-anchor
(gnc:account-anchor-text acct)
(gnc-account-get-full-name acct)))
bgt-monetary bgt-monetary
act-monetary act-monetary))))
))))
acct-table acct-table)
)
;; Total collectors and display ;; Total collectors and display
(let* ( (let* ((bgt-total-numeric
(bgt-total-numeric (gnc:sum-collector-commodity bgt-total report-currency exchange-fn)) (gnc:sum-collector-commodity bgt-total report-currency exchange-fn))
(act-total-numeric (gnc:sum-collector-commodity act-total report-currency exchange-fn)) (act-total-numeric
) (gnc:sum-collector-commodity act-total report-currency exchange-fn)))
(gnc:html-table-add-budget-row! html-table "total-number-cell" (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric) (gnc:html-table-add-budget-row!
html-table "total-number-cell"
(string-append (_ "Total") ":")
bgt-total-numeric act-total-numeric)
;; Display hr FIXME: kind of a hack ;; Display hr FIXME: kind of a hack
(gnc:html-table-append-row! html-table "<tr><td colspan='3'><hr></td></tr>") (gnc:html-table-append-row! html-table "<tr><td colspan='3'><hr></td></tr>")
;; Return (list budgeted-total actual-total) ;; Return (list budgeted-total actual-total)
(list bgt-total-numeric act-total-numeric) (list bgt-total-numeric act-total-numeric))))
))) ;; end of define
;; Displays account types ;; Displays account types
;; ;;
@ -184,29 +183,23 @@
;; ;;
(define (gnc:html-table-add-budget-types! (define (gnc:html-table-add-budget-types!
html-table acct-table budget period exchange-fn report-currency) html-table acct-table budget period exchange-fn report-currency)
;;Account totals is the assoc list that is returned ;;Account totals is the assoc list that is returned
(let* ((accounts-totals '())) (let* ((accounts-totals '()))
;;Display each account type ;;Display each account type
(for-each (lambda (pair) (for-each
(lambda (pair)
;; key - type ;; key - type
;; value - list of accounts ;; value - list of accounts
(let* ((key (car pair)) (value (cdr pair))) (let* ((key (car pair)) (value (cdr pair)))
;; Display and add totals ;; Display and add totals
(set! accounts-totals (assoc-set! accounts-totals key (set! accounts-totals
(gnc:html-table-add-budget-accounts! html-table value budget period exchange-fn report-currency) (assoc-set!
)) accounts-totals key
)) (gnc:html-table-add-budget-accounts!
html-table value budget period exchange-fn report-currency)))))
acct-table acct-table)
)
;; Reutrn assoc list ;; Reutrn assoc list
accounts-totals accounts-totals))
))
;; Displays type-totals ;; Displays type-totals
;; ;;
@ -215,43 +208,41 @@
(define (gnc:html-table-add-budget-totals! (define (gnc:html-table-add-budget-totals!
html-table type-totals exchange-fn report-currency) html-table type-totals exchange-fn report-currency)
(let* (
;; Collector of grand totals ;; Collector of grand totals
(bgt-total-collector (gnc:make-commodity-collector)) (let* ((bgt-total-collector (gnc:make-commodity-collector))
(act-total-collector (gnc:make-commodity-collector)) (act-total-collector (gnc:make-commodity-collector)))
)
;; Loop though each pair ;; Loop though each pair
(for-each (lambda (pair) (for-each
(let* ( (lambda (pair)
;; tuple is (type (budgeted actual)) ;; tuple is (type (budgeted actual))
(key (car pair)) (let* ((key (car pair))
(value (cdr pair)) (value (cdr pair))
(bgt-total (car value)) (bgt-total (car value))
(act-total (cadr value)) (act-total (cadr value)))
)
;; Add to collectors ;; Add to collectors
(bgt-total-collector 'add (gnc:gnc-monetary-commodity bgt-total) (gnc:gnc-monetary-amount bgt-total)) (bgt-total-collector 'add
(act-total-collector 'add (gnc:gnc-monetary-commodity act-total) (gnc:gnc-monetary-amount act-total)) (gnc:gnc-monetary-commodity bgt-total)
(gnc:gnc-monetary-amount bgt-total))
(act-total-collector 'add (gnc:gnc-monetary-commodity act-total)
(gnc:gnc-monetary-amount act-total))
;; Display row ;; Display row
(gnc:html-table-add-budget-row! html-table "number-cell" (gnc:account-get-type-string-plural key) bgt-total act-total) (gnc:html-table-add-budget-row!
)) html-table "number-cell"
(gnc:account-get-type-string-plural key) bgt-total act-total)))
type-totals type-totals)
)
(let* (
;; Sum collectors ;; Sum collectors
(bgt-total-numeric (gnc:sum-collector-commodity bgt-total-collector report-currency exchange-fn)) (let* ((bgt-total-numeric
(act-total-numeric (gnc:sum-collector-commodity act-total-collector report-currency exchange-fn)) (gnc:sum-collector-commodity
) bgt-total-collector report-currency exchange-fn))
(act-total-numeric
(gnc:sum-collector-commodity
act-total-collector report-currency exchange-fn)))
;; Display Grand Total ;; Display Grand Total
(gnc:html-table-add-budget-row! html-table "total-number-cell" (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric) (gnc:html-table-add-budget-row!
html-table "total-number-cell"
))) (string-append (_ "Total") ":") bgt-total-numeric act-total-numeric))))
;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-renderer ;; budget-renderer
@ -270,8 +261,7 @@
(gnc:report-starting reportname) (gnc:report-starting reportname)
;; get all option's values ;; get all option's values
(let* ( (let* ((budget (get-option gnc:pagename-general optname-budget))
(budget (get-option gnc:pagename-general optname-budget))
(budget-valid? (and budget (not (null? budget)))) (budget-valid? (and budget (not (null? budget))))
(accounts (get-option gnc:pagename-accounts optname-accounts)) (accounts (get-option gnc:pagename-accounts optname-accounts))
(period (inexact->exact (get-option gnc:pagename-general (period (inexact->exact (get-option gnc:pagename-general
@ -286,8 +276,7 @@
price-source report-currency #f)) price-source report-currency #f))
;; The HTML document ;; The HTML document
(doc (gnc:make-html-document)) (doc (gnc:make-html-document)))
)
(cond (cond
((null? accounts) ((null? accounts)
@ -302,30 +291,29 @@
(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 (else
(let* ( (let* ((html-table (gnc:make-html-table))
(html-table (gnc:make-html-table)) (report-name (get-option gnc:pagename-general gnc:optname-reportname))
(report-name (get-option gnc:pagename-general
gnc:optname-reportname))
;; decompose the account list ;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts)) (split-up-accounts (gnc:decompose-accountlist accounts))
(accounts-totals '()) (accounts-totals '()))
)
;; Display Title Name - Budget - Period ;; Display Title Name - Budget - Period
(gnc:html-document-set-title! (gnc:html-document-set-title!
doc (format #f (_ "~a: ~a - ~a") doc (format #f (_ "~a: ~a - ~a")
report-name (gnc-budget-get-name budget) report-name (gnc-budget-get-name budget)
(qof-print-date (gnc-budget-get-period-start-date budget (- period 1))))) (qof-print-date (gnc-budget-get-period-start-date
budget (1- period)))))
;; Display accounts and totals ;; Display accounts and totals
(set! accounts-totals (gnc:html-table-add-budget-types! html-table split-up-accounts budget period exchange-fn report-currency)) (set! accounts-totals
(gnc:html-table-add-budget-totals! html-table accounts-totals exchange-fn report-currency) (gnc:html-table-add-budget-types!
html-table split-up-accounts budget period exchange-fn report-currency))
(gnc:html-table-add-budget-totals!
html-table accounts-totals exchange-fn report-currency)
;; Display table ;; Display table
(gnc:html-document-add-object! doc html-table))))) (gnc:html-document-add-object! doc html-table))))
;; Update progress bar ;; Update progress bar
(gnc:report-finished) (gnc:report-finished)