[account-summary] *reindent/untabify/delete-trailing-whitespace*

This commit is contained in:
Christopher Lam 2019-09-21 12:56:22 +08:00
parent 594822f043
commit 67fa04adbd

View File

@ -56,7 +56,7 @@
(define-module (gnucash report standard-reports account-summary))
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
(use-modules (gnucash utilities))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@ -108,7 +108,8 @@
(N_ "Use rules beneath columns of added numbers like accountants do."))
(define optname-account-links (N_ "Display accounts as hyperlinks"))
(define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window."))
(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."))
@ -138,16 +139,16 @@
(define (accsum-options-generator sx? reportname)
(let* ((options (gnc:new-options))
(add-option
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
(add-option
(gnc:make-string-option
(gnc:make-string-option
gnc:pagename-general optname-report-title
"a" opthelp-report-title (_ reportname)))
(add-option
(gnc:make-string-option
(gnc:make-string-option
gnc:pagename-general optname-party-name
"b" opthelp-party-name ""))
;; this should default to company name in (gnc-get-current-book)
@ -168,62 +169,59 @@
"a"
opthelp-accounts
(lambda ()
(gnc:filter-accountlist-type
(gnc:filter-accountlist-type
(list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT
ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#f #t))
(gnc:options-add-account-levels!
options gnc:pagename-accounts optname-depth-limit
"b" opthelp-depth-limit 3)
(add-option
(gnc:make-multichoice-option
gnc:pagename-accounts optname-bottom-behavior
"c" opthelp-bottom-behavior
'summarize
(list (vector 'summarize
(N_ "Recursive Balance")
(N_ "Show the total balance, including balances in subaccounts, of any account at the depth limit."))
(vector 'flatten
(N_ "Raise Accounts")
(N_ "Shows accounts deeper than the depth limit at the depth limit."))
(vector 'truncate
(N_ "Omit Accounts")
(N_ "Disregard completely any accounts deeper than the depth limit."))
)
)
)
"c" opthelp-bottom-behavior 'summarize
(list
(vector 'summarize
(N_ "Recursive Balance")
(N_ "Show the total balance, including balances in subaccounts, of any account at the depth limit."))
(vector 'flatten
(N_ "Raise Accounts")
(N_ "Shows accounts deeper than the depth limit at the depth limit."))
(vector 'truncate
(N_ "Omit Accounts")
(N_ "Disregard completely any accounts deeper than the depth limit.")))))
;; all about currencies
(gnc:options-add-currency!
options pagename-commodities
optname-report-commodity "a")
(gnc:options-add-price-source!
(gnc:options-add-price-source!
options pagename-commodities
optname-price-source "b" 'pricedb-nearest)
(add-option
(add-option
(gnc:make-simple-boolean-option
pagename-commodities optname-show-foreign
pagename-commodities optname-show-foreign
"c" opthelp-show-foreign #t))
(add-option
(add-option
(gnc:make-simple-boolean-option
pagename-commodities optname-show-rates
"d" opthelp-show-rates #f))
;; what to show for zero-balance accounts
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-zb-accts
"a" opthelp-show-zb-accts #t))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-omit-zb-bals
"b" opthelp-omit-zb-bals #f))
@ -234,36 +232,36 @@
"c")
;; some detailed formatting options
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-account-links
"e" opthelp-account-links #t))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-use-rules
"f" opthelp-use-rules #f))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-account-bals
"g" opthelp-show-account-bals #t))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-account-code
"h" opthelp-show-account-code #t))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-account-desc
"i" opthelp-show-account-desc #f))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-account-type
"j" opthelp-show-account-type #f))
(add-option
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-account-notes
"k" opthelp-show-account-notes #f))
;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-display)
options))
@ -276,14 +274,14 @@
(define (accsum-renderer report-obj sx? reportname)
(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)
(let* (
(report-title (get-option gnc:pagename-general optname-report-title))
(company-name (get-option gnc:pagename-general optname-party-name))
(report-title (get-option gnc:pagename-general optname-report-title))
(company-name (get-option gnc:pagename-general optname-party-name))
(from-date (and sx?
(gnc:time64-start-day-time
(gnc:date-option-absolute-time
@ -297,12 +295,12 @@
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))
(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))
optname-report-commodity))
(price-source (get-option pagename-commodities
optname-price-source))
(show-fcur? (get-option pagename-commodities
@ -310,85 +308,84 @@
(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)))
(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))
optname-show-zb-accts))
(omit-zb-bals? (get-option gnc:pagename-display
optname-omit-zb-bals))
optname-omit-zb-bals))
(use-links? (get-option gnc:pagename-display
optname-account-links))
optname-account-links))
(use-rules? (get-option gnc:pagename-display
optname-use-rules))
optname-use-rules))
(show-account-code? (get-option gnc:pagename-display
optname-show-account-code))
optname-show-account-code))
(show-account-type? (get-option gnc:pagename-display
optname-show-account-type))
optname-show-account-type))
(show-account-desc? (get-option gnc:pagename-display
optname-show-account-desc))
optname-show-account-desc))
(show-account-notes? (get-option gnc:pagename-display
optname-show-account-notes))
optname-show-account-notes))
(show-account-bals? (get-option gnc:pagename-display
optname-show-account-bals))
(indent 0)
(tabbing #f)
optname-show-account-bals))
(indent 0)
(tabbing #f)
(doc (gnc:make-html-document))
;; just in case we need this information...
;; just in case we need this information...
(tree-depth (if (equal? depth-limit 'all)
(gnc:get-current-account-tree-depth)
depth-limit))
(gnc:get-current-account-tree-depth)
depth-limit))
;; exchange rates calculation parameters
(exchange-fn
(gnc:case-exchange-fn price-source report-commodity to-date))
)
(gnc:html-document-set-title!
doc (if sx?
(format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a"))
company-name report-title
(qof-print-date from-date)
(qof-print-date to-date))
(string-append company-name " " report-title " "
(qof-print-date to-date))))
(exchange-fn
(gnc:case-exchange-fn price-source report-commodity to-date)))
(gnc:html-document-set-title!
doc (string-append
company-name " " report-title " "
(if sx?
(format #f (_ "For Period Covering ~a to ~a")
(qof-print-date from-date)
(qof-print-date to-date))
(qof-print-date to-date))))
(if (null? accounts)
;; error condition: no accounts specified
;; 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)))
;; otherwise, generate the report...
(let* ((sx-value-hash
;; error condition: no accounts specified
;; 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)))
;; 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
(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-
(list
(list 'start-date from-date)
(list 'end-date to-date)
(list 'display-tree-depth tree-depth)
(list 'depth-limit-behavior bottom-behavior)
(list 'report-commodity report-commodity)
(list 'exchange-fn exchange-fn)
(list 'parent-account-subtotal-mode parent-total-mode)
(list 'zero-balance-mode (if show-zb-accts?
'show-leaf-acct
'omit-leaf-acct))
(list 'account-label-mode (if use-links?
'anchor
'name))
(list 'get-balance-fn
(chart-table #f) ;; gnc:html-acct-table
(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-
(list
(list 'start-date from-date)
(list 'end-date to-date)
(list 'display-tree-depth tree-depth)
(list 'depth-limit-behavior bottom-behavior)
(list 'report-commodity report-commodity)
(list 'exchange-fn exchange-fn)
(list 'parent-account-subtotal-mode parent-total-mode)
(list 'zero-balance-mode (if show-zb-accts?
'show-leaf-acct
'omit-leaf-acct))
(list 'account-label-mode (if use-links?
'anchor
'name))
(list 'get-balance-fn
(and sx?
(lambda (account start-date end-date)
(let* ((guid (gncAccountGetGUID account))
@ -398,146 +395,121 @@
(gnc:make-gnc-monetary
(xaccAccountGetCommodity account) num))
(gnc:make-commodity-collector))))))))
(params ;; and -add-account-
(list
(list 'parent-account-balance-mode parent-balance-mode)
(list 'zero-balance-display-mode (if omit-zb-bals?
'omit-balance
'show-balance))
(list 'multicommodity-mode (if show-fcur? 'table #f))
(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
(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)
)
)
(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))
)
)
(params ;; and -add-account-
(list
(list 'parent-account-balance-mode parent-balance-mode)
(list 'zero-balance-display-mode (if omit-zb-bals?
'omit-balance
'show-balance))
(list 'multicommodity-mode (if show-fcur? 'table #f))
(list 'rule-mode use-rules?)))
;; 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")) '())
(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))
(set! hold-table-width
(if show-account-bals?
(gnc:html-table-num-columns hold-table)
account-cols
)
)
;; 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
(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)))
(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))))
;; 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")) '())
(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))
(set! hold-table-width
(if show-account-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)
(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)
(gnc:html-table-set-cell!
build-table (+ row 1) (+ cur-col col)
(gnc:html-table-get-cell hold-table row col)
)
(set! col (+ col 1))
)
)
(set! row (+ row 1))
)
)
(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)
)
)
(gnc:html-document-add-object! doc build-table)
(_ "Balance")))
(let ((row 0))
(while (< 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)
(gnc:html-table-set-cell!
build-table (+ row 1) (+ cur-col col)
(gnc:html-table-get-cell hold-table row col))
(set! col (+ col 1))))
(set! row (+ row 1))))
(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)))
(gnc:html-document-add-object! doc build-table)
;; add currency information
(if show-rates?
(gnc:html-document-add-object!
(gnc:html-document-add-object!
doc ;;(gnc:html-markup-p
(gnc:html-make-exchangerates
report-commodity exchange-fn
(gnc:html-make-exchangerates
report-commodity exchange-fn
(append-map
(lambda (a)
(gnc-account-get-descendants-sorted a))
accounts))))
)
)
(gnc-account-get-descendants-sorted a))
accounts))))))
(gnc:report-finished)
doc))
(gnc:define-report
(gnc:define-report
'version 1
'name accsum-reportname
'report-guid "3298541c236b494998b236dfad6ad752"