mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[balance-sheet] further compact, untabify
This commit is contained in:
Christopher Lam
parent
90d83e076c
commit
1acbc0c1ec
@ -83,7 +83,6 @@
|
||||
(define optname-report-form (N_ "Single column Balance Sheet"))
|
||||
(define opthelp-report-form
|
||||
(N_ "Print liability/equity section in the same column under the assets section as opposed to a second column right of the assets section."))
|
||||
;; FIXME this needs an indent option
|
||||
|
||||
(define optname-accounts (N_ "Accounts"))
|
||||
(define opthelp-accounts
|
||||
@ -285,145 +284,99 @@
|
||||
(define (balance-sheet-renderer report-obj)
|
||||
(define (get-option pagename optname)
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) pagename optname)))
|
||||
|
||||
|
||||
(gnc:report-starting reportname)
|
||||
|
||||
|
||||
;; get all option's values
|
||||
(let* (
|
||||
(report-title (get-option gnc:pagename-general optname-report-title))
|
||||
(company-name (get-option gnc:pagename-general optname-party-name))
|
||||
(reportdate (gnc:time64-end-day-time
|
||||
(report-title (get-option gnc:pagename-general optname-report-title))
|
||||
(company-name (get-option gnc:pagename-general optname-party-name))
|
||||
(reportdate (gnc:time64-end-day-time
|
||||
(gnc:date-option-absolute-time
|
||||
(get-option gnc:pagename-general
|
||||
optname-date))))
|
||||
(date-secs reportdate)
|
||||
(report-form? (get-option gnc:pagename-general
|
||||
optname-report-form))
|
||||
(standard-order? (get-option gnc:pagename-general
|
||||
optname-standard-order))
|
||||
(compute-unrealized-gains? (not (qof-book-use-trading-accounts
|
||||
(gnc-get-current-book))))
|
||||
(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))
|
||||
(get-option gnc:pagename-general optname-date))))
|
||||
(report-form? (get-option gnc:pagename-general optname-report-form))
|
||||
(standard-order? (get-option gnc:pagename-general optname-standard-order))
|
||||
(use-trading-accts? (qof-book-use-trading-accounts (gnc-get-current-book)))
|
||||
(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))
|
||||
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))
|
||||
(label-assets? (get-option gnc:pagename-display
|
||||
optname-label-assets))
|
||||
(total-assets? (get-option gnc:pagename-display
|
||||
optname-total-assets))
|
||||
(label-liabilities? (get-option gnc:pagename-display
|
||||
optname-label-liabilities))
|
||||
(total-liabilities? (get-option gnc:pagename-display
|
||||
optname-total-liabilities))
|
||||
(label-equity? (get-option gnc:pagename-display
|
||||
optname-label-equity))
|
||||
(total-equity? (get-option gnc:pagename-display
|
||||
optname-total-equity))
|
||||
(use-links? (get-option gnc:pagename-display
|
||||
optname-account-links))
|
||||
(use-rules? (get-option gnc:pagename-display
|
||||
optname-use-rules))
|
||||
(indent 0)
|
||||
(tabbing #f)
|
||||
|
||||
(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))
|
||||
(label-assets? (get-option gnc:pagename-display optname-label-assets))
|
||||
(total-assets? (get-option gnc:pagename-display optname-total-assets))
|
||||
(label-liabilities?
|
||||
(get-option gnc:pagename-display optname-label-liabilities))
|
||||
(total-liabilities?
|
||||
(get-option gnc:pagename-display optname-total-liabilities))
|
||||
(label-equity? (get-option gnc:pagename-display optname-label-equity))
|
||||
(total-equity? (get-option gnc:pagename-display optname-total-equity))
|
||||
(use-links? (get-option gnc:pagename-display optname-account-links))
|
||||
(use-rules? (get-option gnc:pagename-display optname-use-rules))
|
||||
|
||||
;; decompose the account list
|
||||
(split-up-accounts (gnc:decompose-accountlist accounts))
|
||||
(asset-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-ASSET))
|
||||
(liability-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
|
||||
(asset-accounts (assoc-ref split-up-accounts ACCT-TYPE-ASSET))
|
||||
(liability-accounts (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
|
||||
(income-expense-accounts
|
||||
(append (assoc-ref split-up-accounts ACCT-TYPE-INCOME)
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EXPENSE)))
|
||||
(equity-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
|
||||
(trading-accounts
|
||||
(assoc-ref split-up-accounts ACCT-TYPE-TRADING))
|
||||
|
||||
(equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
|
||||
(trading-accounts (assoc-ref split-up-accounts ACCT-TYPE-TRADING))
|
||||
|
||||
(doc (gnc:make-html-document))
|
||||
;; this can occasionally put extra (blank) columns in our
|
||||
;; table (when there is one account at the maximum depth and
|
||||
;; it has at least one of its ancestors deselected), but this
|
||||
;; is the only simple way to ensure that all three tables
|
||||
;; (asset, liability, equity) have the same width.
|
||||
(tree-depth (if (equal? depth-limit 'all)
|
||||
(gnc:get-current-account-tree-depth)
|
||||
depth-limit))
|
||||
;; this can occasionally put extra (blank) columns in our
|
||||
;; table (when there is one account at the maximum depth and
|
||||
;; it has at least one of its ancestors deselected), but this
|
||||
;; is the only simple way to ensure that all three tables
|
||||
;; (asset, liability, equity) have the same width.
|
||||
(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 reportdate)))
|
||||
|
||||
|
||||
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
|
||||
;; with the proper arguments.
|
||||
(define (add-subtotal-line table pos-label neg-label signed-balance)
|
||||
(define allow-same-column-totals #t)
|
||||
(let* ((neg? (and signed-balance
|
||||
neg-label
|
||||
(gnc-numeric-negative-p
|
||||
(gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
signed-balance report-commodity exchange-fn)))))
|
||||
(label (if neg? (or neg-label pos-label) pos-label))
|
||||
(balance (if neg?
|
||||
(let ((bal (gnc:make-commodity-collector)))
|
||||
(bal 'minusmerge signed-balance #f)
|
||||
bal)
|
||||
signed-balance))
|
||||
)
|
||||
(gnc:html-table-add-labeled-amount-line!
|
||||
table
|
||||
(+ indent (* tree-depth 2)
|
||||
(if (equal? tabbing 'canonically-tabbed) 1 0))
|
||||
"primary-subheading"
|
||||
(and (not allow-same-column-totals) balance use-rules?)
|
||||
label indent 1 "total-label-cell"
|
||||
(gnc:sum-collector-commodity balance report-commodity exchange-fn)
|
||||
(+ indent (* tree-depth 2) (- 0 1)
|
||||
(if (equal? tabbing 'canonically-tabbed) 1 0))
|
||||
1 "total-number-cell")
|
||||
)
|
||||
)
|
||||
(let* ((neg? (and signed-balance neg-label
|
||||
(negative?
|
||||
(gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
signed-balance report-commodity exchange-fn)))))
|
||||
(label (if neg? (or neg-label pos-label) pos-label))
|
||||
(balance (if neg?
|
||||
(gnc:collector- signed-balance)
|
||||
signed-balance)))
|
||||
(gnc:html-table-add-labeled-amount-line!
|
||||
table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
|
||||
(gnc:sum-collector-commodity balance report-commodity exchange-fn)
|
||||
(1- (* tree-depth 2)) 1 "total-number-cell")))
|
||||
|
||||
;; Wrapper around gnc:html-table-append-ruler! since we call it so
|
||||
;; often.
|
||||
(define (add-rule table)
|
||||
(gnc:html-table-append-ruler!
|
||||
table
|
||||
(+ (* 2 tree-depth)
|
||||
(if (equal? tabbing 'canonically-tabbed) 1 0))))
|
||||
|
||||
;; Return a commodity collector containing the sum of the balance of all of
|
||||
;; the accounts on acct-list as of the time given in date-secs
|
||||
(define (account-list-balance acct-list date-secs)
|
||||
(let ((balance-collector (gnc:make-commodity-collector)))
|
||||
(for-each
|
||||
(lambda (x)
|
||||
(balance-collector 'add (xaccAccountGetCommodity x)
|
||||
(xaccAccountGetBalanceAsOfDate x date-secs)))
|
||||
acct-list)
|
||||
balance-collector))
|
||||
(gnc:html-table-append-ruler! table (* 2 tree-depth)))
|
||||
|
||||
;; Return a commodity collector containing the sum of the balance of all of
|
||||
;; the accounts on acct-list as of the time given in reportdate
|
||||
(define (account-list-balance acct-list reportdate)
|
||||
(define (acc->balance acc)
|
||||
(gnc:make-gnc-monetary
|
||||
(xaccAccountGetCommodity acc)
|
||||
(xaccAccountGetBalanceAsOfDate acc reportdate)))
|
||||
(apply gnc:monetaries-add (map acc->balance acct-list)))
|
||||
|
||||
;; Format the liabilities section of the report
|
||||
(define (add-liability-block
|
||||
@ -431,56 +384,55 @@
|
||||
total-liabilities? liability-balance)
|
||||
(let* ((liability-table
|
||||
(gnc:make-html-acct-table/env/accts table-env liability-accounts)))
|
||||
(when label-liabilities?
|
||||
(add-subtotal-line parent-table (_ "Liabilities") #f #f))
|
||||
(gnc:html-table-add-account-balances parent-table liability-table params)
|
||||
(when total-liabilities?
|
||||
(add-subtotal-line
|
||||
(when label-liabilities?
|
||||
(add-subtotal-line parent-table (_ "Liabilities") #f #f))
|
||||
(gnc:html-table-add-account-balances parent-table liability-table params)
|
||||
(when total-liabilities?
|
||||
(add-subtotal-line
|
||||
parent-table (_ "Total Liabilities") #f liability-balance))
|
||||
(add-rule parent-table)))
|
||||
(add-rule parent-table)))
|
||||
|
||||
(define (get-total-value-fn account)
|
||||
(gnc:account-get-comm-value-at-date account reportdate #f))
|
||||
|
||||
;;(gnc:warn "account names" liability-account-names)
|
||||
(gnc:html-document-set-title!
|
||||
(gnc:html-document-set-title!
|
||||
doc (string-append company-name " " report-title " "
|
||||
(qof-print-date reportdate)))
|
||||
|
||||
|
||||
(if (null? accounts)
|
||||
|
||||
|
||||
;; error condition: no accounts specified
|
||||
;; is this *really* necessary??
|
||||
;; i'd be fine with an all-zero balance sheet
|
||||
;; that would, technically, be correct....
|
||||
(gnc:html-document-add-object!
|
||||
;; is this *really* necessary??
|
||||
;; i'd be fine with an all-zero balance sheet
|
||||
;; that would, technically, be correct....
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:html-make-no-account-warning reportname (gnc:report-id report-obj)))
|
||||
|
||||
;; Get all the balances for each of the account types.
|
||||
(let* ((asset-balance
|
||||
(account-list-balance asset-accounts date-secs))
|
||||
(account-list-balance asset-accounts reportdate))
|
||||
|
||||
(liability-balance
|
||||
(gnc:collector- (account-list-balance liability-accounts date-secs)))
|
||||
(gnc:collector- (account-list-balance liability-accounts reportdate)))
|
||||
|
||||
(equity-balance
|
||||
(gnc:collector- (account-list-balance equity-accounts date-secs)))
|
||||
(gnc:collector- (account-list-balance equity-accounts reportdate)))
|
||||
|
||||
(retained-earnings
|
||||
(gnc:collector-
|
||||
(account-list-balance income-expense-accounts date-secs)))
|
||||
(account-list-balance income-expense-accounts reportdate)))
|
||||
|
||||
(trading-balance
|
||||
(gnc:collector- (account-list-balance trading-accounts date-secs)))
|
||||
(gnc:collector- (account-list-balance trading-accounts reportdate)))
|
||||
|
||||
(unrealized-gain-collector
|
||||
(if compute-unrealized-gains?
|
||||
(if use-trading-accts?
|
||||
(gnc:collector+)
|
||||
(gnc:collector- asset-balance
|
||||
liability-balance
|
||||
(gnc:accounts-get-comm-total-assets
|
||||
(append asset-accounts liability-accounts)
|
||||
get-total-value-fn))
|
||||
(gnc:collector+)))
|
||||
get-total-value-fn))))
|
||||
|
||||
(total-equity-balance
|
||||
(gnc:collector+ equity-balance retained-earnings
|
||||
@ -527,95 +479,92 @@
|
||||
(gnc:account-get-comm-balance-at-date account reportdate #f))
|
||||
|
||||
;; Workaround to force gtkhtml into displaying wide
|
||||
;; enough columns.
|
||||
(let ((space (make-list tree-depth " \
|
||||
;; enough columns.
|
||||
(let ((space (make-list tree-depth " \
|
||||
")))
|
||||
(gnc:html-table-append-row! left-table space)
|
||||
(unless report-form?
|
||||
(gnc:html-table-append-row! right-table space)))
|
||||
(gnc:report-percent-done 80)
|
||||
(gnc:html-table-append-row! left-table space)
|
||||
(unless report-form?
|
||||
(gnc:html-table-append-row! right-table space)))
|
||||
(gnc:report-percent-done 80)
|
||||
|
||||
(when label-assets?
|
||||
(add-subtotal-line left-table (_ "Assets") #f #f))
|
||||
(gnc:html-table-add-account-balances left-table asset-table params)
|
||||
(gnc:html-table-add-account-balances left-table asset-table params)
|
||||
(when total-assets?
|
||||
(add-subtotal-line left-table (_ "Total Assets") #f asset-balance))
|
||||
|
||||
(when report-form?
|
||||
(add-subtotal-line left-table (_ "Total Assets") #f asset-balance))
|
||||
|
||||
(when report-form?
|
||||
(add-rule left-table)
|
||||
(add-rule left-table))
|
||||
(add-rule left-table))
|
||||
(gnc:report-percent-done 85)
|
||||
|
||||
(when standard-order?
|
||||
(add-liability-block label-liabilities? right-table table-env
|
||||
liability-accounts params
|
||||
(add-liability-block label-liabilities? right-table table-env
|
||||
liability-accounts params
|
||||
total-liabilities? liability-balance))
|
||||
|
||||
(gnc:report-percent-done 88)
|
||||
(when label-equity?
|
||||
(add-subtotal-line right-table (_ "Equity") #f #f))
|
||||
(gnc:report-percent-done 88)
|
||||
|
||||
(when label-equity?
|
||||
(add-subtotal-line right-table (_ "Equity") #f #f))
|
||||
(gnc:html-table-add-account-balances right-table equity-table params)
|
||||
;; we omit retained earnings & unrealized gains
|
||||
;; from the balance report, if zero, since they
|
||||
;; are not present on normal balance sheets
|
||||
(unless (gnc-commodity-collector-allzero? retained-earnings)
|
||||
(add-subtotal-line right-table
|
||||
(_ "Retained Earnings")
|
||||
(_ "Retained Losses")
|
||||
retained-earnings))
|
||||
;; from the balance report, if zero, since they
|
||||
;; are not present on normal balance sheets
|
||||
(unless (gnc-commodity-collector-allzero? retained-earnings)
|
||||
(add-subtotal-line right-table
|
||||
(_ "Retained Earnings")
|
||||
(_ "Retained Losses")
|
||||
retained-earnings))
|
||||
(unless (gnc-commodity-collector-allzero? trading-balance)
|
||||
(add-subtotal-line right-table
|
||||
(_ "Trading Gains")
|
||||
(_ "Trading Losses")
|
||||
trading-balance))
|
||||
(add-subtotal-line right-table
|
||||
(_ "Trading Gains")
|
||||
(_ "Trading Losses")
|
||||
trading-balance))
|
||||
(unless (gnc-commodity-collector-allzero? unrealized-gain-collector)
|
||||
(add-subtotal-line right-table
|
||||
(_ "Unrealized Gains")
|
||||
(_ "Unrealized Losses")
|
||||
unrealized-gain-collector))
|
||||
(when total-equity?
|
||||
(add-subtotal-line
|
||||
right-table (_ "Total Equity") #f total-equity-balance))
|
||||
(add-subtotal-line right-table
|
||||
(_ "Unrealized Gains")
|
||||
(_ "Unrealized Losses")
|
||||
unrealized-gain-collector))
|
||||
(when total-equity?
|
||||
(add-subtotal-line
|
||||
right-table (_ "Total Equity") #f total-equity-balance))
|
||||
|
||||
(add-rule right-table)
|
||||
|
||||
(unless standard-order?
|
||||
(add-liability-block label-liabilities? right-table table-env
|
||||
liability-accounts params
|
||||
(add-liability-block label-liabilities? right-table table-env
|
||||
liability-accounts params
|
||||
total-liabilities? liability-balance))
|
||||
|
||||
(add-subtotal-line
|
||||
right-table (gnc:html-string-sanitize (_ "Total Liabilities & Equity"))
|
||||
#f liability-plus-equity)
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc (if report-form?
|
||||
left-table
|
||||
(let* ((build-table (gnc:make-html-table)))
|
||||
(gnc:html-table-append-row!
|
||||
build-table
|
||||
(list
|
||||
(gnc:make-html-table-cell left-table)
|
||||
(gnc:make-html-table-cell right-table)))
|
||||
(gnc:html-table-set-style!
|
||||
build-table "td"
|
||||
'attribute '("align" "left")
|
||||
'attribute '("valign" "top"))
|
||||
build-table)))
|
||||
|
||||
#f liability-plus-equity)
|
||||
|
||||
(gnc:html-document-add-object!
|
||||
doc (if report-form?
|
||||
left-table
|
||||
(let ((build-table (gnc:make-html-table)))
|
||||
(gnc:html-table-append-row!
|
||||
build-table (list left-table right-table))
|
||||
(gnc:html-table-set-style!
|
||||
build-table "td"
|
||||
'attribute '("align" "left")
|
||||
'attribute '("valign" "top"))
|
||||
build-table)))
|
||||
|
||||
;; add currency information if requested
|
||||
(gnc:report-percent-done 90)
|
||||
(gnc:report-percent-done 90)
|
||||
(when show-rates?
|
||||
(gnc:html-document-add-object!
|
||||
doc (gnc:html-make-exchangerates report-commodity exchange-fn accounts)))
|
||||
|
||||
(gnc:report-percent-done 100)))
|
||||
|
||||
|
||||
(gnc:report-finished)
|
||||
|
||||
|
||||
doc))
|
||||
|
||||
(gnc:define-report
|
||||
(gnc:define-report
|
||||
'version 1
|
||||
'name reportname
|
||||
'report-guid "c4173ac99b2b448289bf4d11c731af13"
|
||||
@ -624,4 +573,3 @@
|
||||
'renderer balance-sheet-renderer)
|
||||
|
||||
;; END
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user