mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[account-summary] cleanup
* shorten identifier names * compact functions * use eq? as appropriate instead of equal? when comparing symbols * omit splitting up and recombining accounts * minimise use of set! and define vars in let* formals * instead of (if pred? (begin ...)) use (when pred? ...) * use efficient gnc:accounts-and-all-descendants
This commit is contained in:
Christopher Lam
@@ -81,7 +81,6 @@
|
||||
|
||||
;; account-summary:
|
||||
(define optname-date (N_ "Date"))
|
||||
;; FIXME this needs an indent option
|
||||
|
||||
(define optname-accounts (N_ "Accounts"))
|
||||
(define opthelp-accounts
|
||||
@@ -111,16 +110,16 @@
|
||||
(define opthelp-account-links
|
||||
(N_ "Shows each account in the table as a hyperlink to its register window."))
|
||||
|
||||
(define optname-show-account-bals (N_ "Account Balance"))
|
||||
(define opthelp-show-account-bals (N_ "Show an account's balance."))
|
||||
(define optname-show-account-code (N_ "Account Code"))
|
||||
(define opthelp-show-account-code (N_ "Show an account's account code."))
|
||||
(define optname-show-account-type (N_ "Account Type"))
|
||||
(define opthelp-show-account-type (N_ "Show an account's account type."))
|
||||
(define optname-show-account-desc (N_ "Account Description"))
|
||||
(define opthelp-show-account-desc (N_ "Show an account's description."))
|
||||
(define optname-show-account-notes (N_ "Account Notes"))
|
||||
(define opthelp-show-account-notes (N_ "Show an account's notes."))
|
||||
(define optname-show-bals (N_ "Account Balance"))
|
||||
(define opthelp-show-bals (N_ "Show an account's balance."))
|
||||
(define optname-show-code (N_ "Account Code"))
|
||||
(define opthelp-show-code (N_ "Show an account's account code."))
|
||||
(define optname-show-type (N_ "Account Type"))
|
||||
(define opthelp-show-type (N_ "Show an account's account type."))
|
||||
(define optname-show-desc (N_ "Account Description"))
|
||||
(define opthelp-show-desc (N_ "Show an account's description."))
|
||||
(define optname-show-notes (N_ "Account Notes"))
|
||||
(define opthelp-show-notes (N_ "Show an account's notes."))
|
||||
|
||||
(define pagename-commodities (N_ "Commodities"))
|
||||
(define optname-report-commodity (N_ "Report's currency"))
|
||||
@@ -243,24 +242,24 @@
|
||||
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-account-bals
|
||||
"g" opthelp-show-account-bals #t))
|
||||
gnc:pagename-display optname-show-bals
|
||||
"g" opthelp-show-bals #t))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-account-code
|
||||
"h" opthelp-show-account-code #t))
|
||||
gnc:pagename-display optname-show-code
|
||||
"h" opthelp-show-code #t))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-account-desc
|
||||
"i" opthelp-show-account-desc #f))
|
||||
gnc:pagename-display optname-show-desc
|
||||
"i" opthelp-show-desc #f))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-account-type
|
||||
"j" opthelp-show-account-type #f))
|
||||
gnc:pagename-display optname-show-type
|
||||
"j" opthelp-show-type #f))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-account-notes
|
||||
"k" opthelp-show-account-notes #f))
|
||||
gnc:pagename-display optname-show-notes
|
||||
"k" opthelp-show-notes #f))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options gnc:pagename-display)
|
||||
@@ -285,63 +284,39 @@
|
||||
(from-date (and sx?
|
||||
(gnc:time64-start-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-from-date)))))
|
||||
(get-option gnc:pagename-general optname-from-date)))))
|
||||
(to-date (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
(if sx?
|
||||
optname-to-date
|
||||
optname-date)))))
|
||||
(accounts (get-option gnc:pagename-accounts
|
||||
optname-accounts))
|
||||
(depth-limit (get-option gnc:pagename-accounts
|
||||
optname-depth-limit))
|
||||
(bottom-behavior (get-option gnc:pagename-accounts
|
||||
optname-bottom-behavior))
|
||||
(report-commodity (get-option pagename-commodities
|
||||
optname-report-commodity))
|
||||
(price-source (get-option pagename-commodities
|
||||
optname-price-source))
|
||||
(show-fcur? (get-option pagename-commodities
|
||||
optname-show-foreign))
|
||||
(show-rates? (get-option pagename-commodities
|
||||
optname-show-rates))
|
||||
(parent-balance-mode (get-option gnc:pagename-display
|
||||
optname-parent-balance-mode))
|
||||
(if sx? optname-to-date optname-date)))))
|
||||
(accounts (get-option gnc:pagename-accounts optname-accounts))
|
||||
(depth-limit (get-option gnc:pagename-accounts optname-depth-limit))
|
||||
(bottom-behavior (get-option gnc:pagename-accounts optname-bottom-behavior))
|
||||
(report-commodity (get-option pagename-commodities optname-report-commodity))
|
||||
(price-source (get-option pagename-commodities optname-price-source))
|
||||
(show-fcur? (get-option pagename-commodities optname-show-foreign))
|
||||
(show-rates? (get-option pagename-commodities optname-show-rates))
|
||||
(parent-mode (get-option gnc:pagename-display optname-parent-balance-mode))
|
||||
(parent-total-mode
|
||||
(assq-ref '((t . #t) (f . #f) (canonically-tabbed . canonically-tabbed))
|
||||
(get-option gnc:pagename-display
|
||||
optname-parent-total-mode)))
|
||||
(show-zb-accts? (get-option gnc:pagename-display
|
||||
optname-show-zb-accts))
|
||||
(omit-zb-bals? (get-option gnc:pagename-display
|
||||
optname-omit-zb-bals))
|
||||
(use-links? (get-option gnc:pagename-display
|
||||
optname-account-links))
|
||||
(use-rules? (get-option gnc:pagename-display
|
||||
optname-use-rules))
|
||||
(show-account-code? (get-option gnc:pagename-display
|
||||
optname-show-account-code))
|
||||
(show-account-type? (get-option gnc:pagename-display
|
||||
optname-show-account-type))
|
||||
(show-account-desc? (get-option gnc:pagename-display
|
||||
optname-show-account-desc))
|
||||
(show-account-notes? (get-option gnc:pagename-display
|
||||
optname-show-account-notes))
|
||||
(show-account-bals? (get-option gnc:pagename-display
|
||||
optname-show-account-bals))
|
||||
(indent 0)
|
||||
(tabbing #f)
|
||||
(get-option gnc:pagename-display optname-parent-total-mode)))
|
||||
(show-zb-accts? (get-option gnc:pagename-display optname-show-zb-accts))
|
||||
(omit-zb-bals? (get-option gnc:pagename-display optname-omit-zb-bals))
|
||||
(use-links? (get-option gnc:pagename-display optname-account-links))
|
||||
(use-rules? (get-option gnc:pagename-display optname-use-rules))
|
||||
(show-code? (get-option gnc:pagename-display optname-show-code))
|
||||
(show-type? (get-option gnc:pagename-display optname-show-type))
|
||||
(show-desc? (get-option gnc:pagename-display optname-show-desc))
|
||||
(show-notes? (get-option gnc:pagename-display optname-show-notes))
|
||||
(show-bals? (get-option gnc:pagename-display optname-show-bals))
|
||||
|
||||
(doc (gnc:make-html-document))
|
||||
;; just in case we need this information...
|
||||
(tree-depth (if (equal? depth-limit 'all)
|
||||
(tree-depth (if (eq? depth-limit 'all)
|
||||
(gnc:get-current-account-tree-depth)
|
||||
depth-limit))
|
||||
;; exchange rates calculation parameters
|
||||
(exchange-fn
|
||||
(gnc:case-exchange-fn price-source report-commodity to-date)))
|
||||
(exchange-fn (gnc:case-exchange-fn price-source report-commodity to-date)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc (string-append
|
||||
@@ -358,19 +333,14 @@
|
||||
;; is this *really* necessary?? i'd be fine with an all-zero
|
||||
;; account summary that would, technically, be correct....
|
||||
(gnc:html-document-add-object!
|
||||
doc
|
||||
(gnc:html-make-no-account-warning
|
||||
reportname (gnc:report-id report-obj)))
|
||||
doc (gnc:html-make-no-account-warning reportname (gnc:report-id report-obj)))
|
||||
|
||||
;; otherwise, generate the report...
|
||||
(let* ((sx-value-hash
|
||||
(if sx?
|
||||
(gnc-sx-all-instantiate-cashflow-all from-date to-date)
|
||||
(make-hash-table)))
|
||||
(chart-table #f) ;; gnc:html-acct-table
|
||||
(and sx? (gnc-sx-all-instantiate-cashflow-all from-date to-date)))
|
||||
(hold-table (gnc:make-html-table)) ;; temporary gnc:html-table
|
||||
(build-table (gnc:make-html-table)) ;; gnc:html-table reported
|
||||
(table-env ;; parameters for :make-
|
||||
(table-env
|
||||
(list
|
||||
(list 'start-date from-date)
|
||||
(list 'end-date to-date)
|
||||
@@ -382,9 +352,7 @@
|
||||
(list 'zero-balance-mode (if show-zb-accts?
|
||||
'show-leaf-acct
|
||||
'omit-leaf-acct))
|
||||
(list 'account-label-mode (if use-links?
|
||||
'anchor
|
||||
'name))
|
||||
(list 'account-label-mode (if use-links? 'anchor 'name))
|
||||
(list 'get-balance-fn
|
||||
(and sx?
|
||||
(lambda (account start-date end-date)
|
||||
@@ -395,116 +363,83 @@
|
||||
(gnc:make-gnc-monetary
|
||||
(xaccAccountGetCommodity account) num))
|
||||
(gnc:make-commodity-collector))))))))
|
||||
(params ;; and -add-account-
|
||||
(params
|
||||
(list
|
||||
(list 'parent-account-balance-mode parent-balance-mode)
|
||||
(list 'parent-account-balance-mode parent-mode)
|
||||
(list 'zero-balance-display-mode (if omit-zb-bals?
|
||||
'omit-balance
|
||||
'show-balance))
|
||||
(list 'multicommodity-mode (if show-fcur? 'table #f))
|
||||
(list 'multicommodity-mode (and show-fcur? 'table))
|
||||
(list 'rule-mode use-rules?)))
|
||||
|
||||
;; FIXME: this filtering is trivial and could probably be
|
||||
;; greatly simplified (it just collects all selected
|
||||
;; accounts)...
|
||||
(split-up-accounts (gnc:decompose-accountlist accounts))
|
||||
(all-accounts
|
||||
(append (assoc-ref split-up-accounts ACCT-TYPE-INCOME)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-ASSET)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-LIABILITY)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EQUITY)))
|
||||
;; (all-accounts (map (lambda (X) (cadr X)) split-up-accounts))
|
||||
;; ^ will not do what we want
|
||||
|
||||
(account-cols 0)
|
||||
(table-rows 0)
|
||||
(cur-col 0)
|
||||
(foo #f) ;; a dummy variable for when i'm too lazy to type much
|
||||
(add-col #f) ;; thunk to add a column to build-table
|
||||
(chart-table (gnc:make-html-acct-table/env/accts table-env accounts))
|
||||
(table-rows (or (gnc:html-acct-table-num-rows chart-table) 0))
|
||||
(account-cols
|
||||
(cond
|
||||
((zero? table-rows) 0)
|
||||
((assq-ref (gnc:html-acct-table-get-row-env chart-table 0)
|
||||
'account-cols) => car)
|
||||
(else 0)))
|
||||
(hold-table-width 0))
|
||||
|
||||
(set! chart-table
|
||||
(gnc:make-html-acct-table/env/accts
|
||||
table-env all-accounts))
|
||||
(gnc:html-table-add-account-balances
|
||||
hold-table chart-table params)
|
||||
(set! table-rows (or (gnc:html-acct-table-num-rows chart-table) 0))
|
||||
(set! account-cols
|
||||
(if (zero? table-rows)
|
||||
0
|
||||
(or (car (assoc-ref
|
||||
(gnc:html-acct-table-get-row-env chart-table 0)
|
||||
'account-cols))
|
||||
0)))
|
||||
(define (add-col key)
|
||||
(let rowloop ((row 0))
|
||||
(when (< row table-rows)
|
||||
(gnc:html-table-set-cell!
|
||||
build-table (1+ row) cur-col
|
||||
(car
|
||||
(assq-ref (gnc:html-acct-table-get-row-env chart-table row) key)))
|
||||
(rowloop (1+ row))))
|
||||
(set! cur-col (1+ cur-col)))
|
||||
|
||||
(set! add-col
|
||||
(lambda(key)
|
||||
(let ((row 0)
|
||||
(row-env #f))
|
||||
(while (< row table-rows)
|
||||
(set! row-env
|
||||
(gnc:html-acct-table-get-row-env
|
||||
chart-table row))
|
||||
(gnc:html-table-set-cell!
|
||||
build-table (+ row 1) cur-col ;; +1 for headers
|
||||
(car (assoc-ref row-env key)))
|
||||
(set! row (+ row 1))))
|
||||
(set! cur-col (+ cur-col 1))))
|
||||
(gnc:html-table-add-account-balances hold-table chart-table params)
|
||||
|
||||
;; place the column headers
|
||||
(gnc:html-table-append-row!
|
||||
build-table
|
||||
(append
|
||||
(if show-account-code? (list (_ "Code")) '())
|
||||
(if show-account-type? (list (_ "Type")) '())
|
||||
(if show-account-desc? (list (_ "Description")) '())
|
||||
(if show-code? (list (_ "Code")) '())
|
||||
(if show-type? (list (_ "Type")) '())
|
||||
(if show-desc? (list (_ "Description")) '())
|
||||
(list (_ "Account title"))))
|
||||
;; add any fields to be displayed before the account name
|
||||
(if show-account-code? (add-col 'account-code))
|
||||
(if show-account-type? (add-col 'account-type-string))
|
||||
(if show-account-desc? (add-col 'account-description))
|
||||
(if show-code? (add-col 'account-code))
|
||||
(if show-type? (add-col 'account-type-string))
|
||||
(if show-desc? (add-col 'account-description))
|
||||
|
||||
(set! hold-table-width
|
||||
(if show-account-bals?
|
||||
(if show-bals?
|
||||
(gnc:html-table-num-columns hold-table)
|
||||
account-cols))
|
||||
(if show-account-bals?
|
||||
(gnc:html-table-set-cell/tag!
|
||||
build-table 0 (+ cur-col account-cols) "number-header"
|
||||
(_ "Balance")))
|
||||
(let ((row 0))
|
||||
(while (< row table-rows)
|
||||
(when show-bals?
|
||||
(gnc:html-table-set-cell/tag!
|
||||
build-table 0 (+ cur-col account-cols) "number-header" (_ "Balance")))
|
||||
(let rowloop ((row 0))
|
||||
(when (< row table-rows)
|
||||
(gnc:html-table-set-row-markup!
|
||||
build-table (+ row 1)
|
||||
(gnc:html-table-row-markup hold-table row))
|
||||
(let ((col 0))
|
||||
(while (< col hold-table-width)
|
||||
build-table (1+ row) (gnc:html-table-row-markup hold-table row))
|
||||
(let colloop ((col 0))
|
||||
(when (< col hold-table-width)
|
||||
(gnc:html-table-set-cell!
|
||||
build-table (+ row 1) (+ cur-col col)
|
||||
build-table (1+ row) (+ cur-col col)
|
||||
(gnc:html-table-get-cell hold-table row col))
|
||||
(set! col (+ col 1))))
|
||||
(set! row (+ row 1))))
|
||||
(colloop (1+ col))))
|
||||
(rowloop (1+ row))))
|
||||
(set! cur-col (+ cur-col hold-table-width))
|
||||
(if show-account-notes?
|
||||
(begin
|
||||
(gnc:html-table-set-cell/tag!
|
||||
build-table 0 cur-col "text-cell"
|
||||
(_ "Notes"))
|
||||
(add-col 'account-notes)))
|
||||
(when show-notes?
|
||||
(gnc:html-table-set-cell/tag!
|
||||
build-table 0 cur-col "text-cell" (_ "Notes"))
|
||||
(add-col 'account-notes))
|
||||
|
||||
(gnc:html-document-add-object! doc build-table)
|
||||
|
||||
;; add currency information
|
||||
(if show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc ;;(gnc:html-markup-p
|
||||
(gnc:html-make-exchangerates
|
||||
report-commodity exchange-fn
|
||||
(append-map
|
||||
(lambda (a)
|
||||
(gnc-account-get-descendants-sorted a))
|
||||
accounts))))))
|
||||
(when show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:html-make-exchangerates
|
||||
report-commodity exchange-fn
|
||||
(gnc:accounts-and-all-descendants accounts))))))
|
||||
|
||||
(gnc:report-finished)
|
||||
doc))
|
||||
@@ -524,4 +459,3 @@
|
||||
'renderer (lambda (obj) (accsum-renderer obj #t fsts-reportname)))
|
||||
|
||||
;; END
|
||||
|
||||
|
||||
Reference in New Issue
Block a user