mirror of
https://github.com/Gnucash/gnucash.git
synced 2026-07-29 23:58:03 -05:00
Christian Stimming's reports patch.
* src/scm/report/balance-sheet.scm: Major overhaul. Adapted to new options in gnc:html-build-acct-table. Cleaned up code. Corrected column alignment. * src/scm/html-utilities.scm (gnc:html-table-append-ruler!): New function. (gnc:html-build-acct-table): Added new arguments for how to show non-leaf accounts: with subtotal or not, with own balance or not. Removed some empty lines in the html-table. * src/scm/report/pnl.scm, account-summary.scm: Added support for new gnc:html-build-acct-tree options. * src/scm/report-utilities.scm (gnc:decompose-accountlist): Added equity accounts. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3899 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
@@ -1,3 +1,21 @@
|
||||
2001-04-06 Christian Stimming <stimming@tuhh.de>
|
||||
|
||||
* src/scm/report/balance-sheet.scm: Major overhaul. Adapted to new
|
||||
options in gnc:html-build-acct-table. Cleaned up code. Corrected
|
||||
column alignment.
|
||||
|
||||
* src/scm/html-utilities.scm (gnc:html-table-append-ruler!): New
|
||||
function.
|
||||
(gnc:html-build-acct-table): Added new arguments for how to show
|
||||
non-leaf accounts: with subtotal or not, with own balance or
|
||||
not. Removed some empty lines in the html-table.
|
||||
|
||||
* src/scm/report/pnl.scm, account-summary.scm: Added support for
|
||||
new gnc:html-build-acct-tree options.
|
||||
|
||||
* src/scm/report-utilities.scm (gnc:decompose-accountlist): Added
|
||||
equity accounts.
|
||||
|
||||
2001-04-05 James LewisMoss <jimdres@mindspring.com>
|
||||
|
||||
* src/test/test-xml-transaction.c: guess what?
|
||||
|
||||
+111
-69
@@ -83,6 +83,16 @@
|
||||
(assign-colors (+ i 1)))))
|
||||
(assign-colors 0))
|
||||
|
||||
;; Appends a horizontal ruler to a html-table with the specified width
|
||||
;; colspan.
|
||||
(define (gnc:html-table-append-ruler! table colspan)
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(list
|
||||
(gnc:make-html-table-cell/size
|
||||
1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; gnc:html-build-acct-table
|
||||
;;
|
||||
@@ -94,7 +104,7 @@
|
||||
;; Reporting period -- start-date, end-date
|
||||
;;
|
||||
;; Selected accounts -- tree-depth, show-subaccts?, accounts,
|
||||
;; do-subtot?
|
||||
;; do-subtot? - FIXME: the last one changed.
|
||||
;;
|
||||
;; Foreign currency -- show-other-curr?, report-commodity,
|
||||
;; exchange-fn
|
||||
@@ -133,7 +143,7 @@
|
||||
;; according to their types and show a subtotal for each group.
|
||||
;;
|
||||
;; <bool> do-subtot?: Specify whether to include sub-account balances
|
||||
;; in each account's balance.
|
||||
;; in each account's balance. -- FIXME: that no longer exists.
|
||||
;;
|
||||
;; <bool> show-other-curr?, <gnc:commodity*> report-commodity,
|
||||
;; #<procedure ...> exchange-fn: The rightmost column always shows
|
||||
@@ -149,9 +159,11 @@
|
||||
tree-depth show-subaccts? accounts
|
||||
show-col-headers?
|
||||
show-total? get-total-fn
|
||||
total-name group-types? do-subtot?
|
||||
total-name group-types? show-parent-balance? show-parent-total?
|
||||
show-other-curr? report-commodity exchange-fn)
|
||||
(let ((table (gnc:make-html-table))
|
||||
(do-subtot? #t) ;; FIXME: this should go away once the
|
||||
;; variable won't be needed anymore.
|
||||
(topl-accounts (gnc:group-get-account-list
|
||||
(gnc:get-current-group))))
|
||||
|
||||
@@ -162,12 +174,20 @@
|
||||
;; If start-date == #f then balance-at-date will be used (for
|
||||
;; balance reports), otherwise balance-interval (for profit and
|
||||
;; loss reports). Returns a commodity-collector.
|
||||
(define (my-get-balance account)
|
||||
(define (my-get-balance-internal account include-subaccounts?)
|
||||
(if start-date
|
||||
(gnc:account-get-comm-balance-interval
|
||||
account start-date end-date do-subtot?)
|
||||
account start-date end-date include-subaccounts?)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
account end-date do-subtot?)))
|
||||
account end-date include-subaccounts?)))
|
||||
|
||||
;; Wrappers for the two use cases -- first with, second without
|
||||
;; the subaccount balances included.
|
||||
(define (my-get-balance account)
|
||||
(my-get-balance-internal account #t))
|
||||
|
||||
(define (my-get-balance-nosub account)
|
||||
(my-get-balance-internal account #f))
|
||||
|
||||
;; show this account? Check against the account selection and,
|
||||
;; if not selected, show-subaccts?==#t and any parent was
|
||||
@@ -191,6 +211,10 @@
|
||||
(define (identity a)
|
||||
a)
|
||||
|
||||
;; another helper -- is xor really missing?
|
||||
(define (xor a b)
|
||||
(or (and (not a) b) (and a (not b))))
|
||||
|
||||
;; Creates the table cell with given colspan (and rowspan=1), with
|
||||
;; the content content and in boldface if boldface? is
|
||||
;; true. content may be #f, or a string, or a html-text
|
||||
@@ -210,6 +234,20 @@
|
||||
(gnc:html-markup-b content)))
|
||||
content))))
|
||||
|
||||
;; Remove the last appended row iff *all* its fields are empty
|
||||
;; (==#f) or have an html-table-cell which in turn is empty
|
||||
;; (resulting from the add-group! function above). Note: This
|
||||
;; depends on the structure of html-table-data, i.e. if those are
|
||||
;; changed then this might break.
|
||||
(define (remove-last-empty-row)
|
||||
(if (not (or-map
|
||||
(lambda (e)
|
||||
(if (gnc:html-table-cell? e)
|
||||
(car (gnc:html-table-cell-data e))
|
||||
e))
|
||||
(car (gnc:html-table-data table))))
|
||||
(gnc:html-table-remove-last-row! table)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; function for table without foreign commodities
|
||||
@@ -220,21 +258,26 @@
|
||||
;; balance column, and if reverse-balance? is #t the balance will
|
||||
;; be displayed with the sign reversed.
|
||||
(define (add-row-helper!
|
||||
current-depth my-name my-balance reverse-balance? boldface?)
|
||||
current-depth my-name my-balance
|
||||
reverse-balance? boldface? group-header-line?)
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(append
|
||||
;; left half of the table
|
||||
(gnc:html-make-empty-cells (- current-depth 1))
|
||||
(list (my-table-cell (+ 1 (- tree-depth current-depth))
|
||||
my-name boldface?))
|
||||
(gnc:html-make-empty-cells (- tree-depth current-depth))
|
||||
;; right half of the table
|
||||
(gnc:html-make-empty-cells
|
||||
(- tree-depth (+ current-depth (if group-header-line? 1 0))))
|
||||
;; the account balance
|
||||
(list (and my-balance
|
||||
(gnc:make-html-text
|
||||
((if boldface? gnc:html-markup-b identity)
|
||||
((if reverse-balance? gnc:monetary-neg identity)
|
||||
my-balance)))))
|
||||
(gnc:html-make-empty-cells (- current-depth 1)))))
|
||||
(gnc:html-make-empty-cells (- current-depth
|
||||
(if group-header-line? 0 1))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; function for table with foreign commodities visible
|
||||
@@ -250,7 +293,7 @@
|
||||
;; reversed.
|
||||
(define (add-commodity-rows!
|
||||
current-depth my-name my-commodity balance
|
||||
reverse-balance? is-stock-account? boldface?)
|
||||
reverse-balance? is-stock-account? boldface? group-header-line?)
|
||||
;; Adds one row to the table. my-name is the html-object
|
||||
;; displayed in the name column; foreign-balance is the
|
||||
;; <gnc-monetary> for the foreign column or #f if to be left
|
||||
@@ -261,10 +304,13 @@
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(append
|
||||
;; left third of the table
|
||||
(gnc:html-make-empty-cells (- current-depth 1))
|
||||
(list (my-table-cell (+ 1 (- tree-depth current-depth))
|
||||
my-name boldface?))
|
||||
(gnc:html-make-empty-cells (* 2 (- tree-depth current-depth)))
|
||||
;; right two-thirds of the table
|
||||
(gnc:html-make-empty-cells
|
||||
(* 2 (- tree-depth (+ current-depth (if group-header-line? 1 0)))))
|
||||
(if boldface?
|
||||
(list
|
||||
(and foreign-balance
|
||||
@@ -272,7 +318,8 @@
|
||||
(and domestic-balance
|
||||
(gnc:make-html-text (gnc:html-markup-b domestic-balance))))
|
||||
(list foreign-balance domestic-balance))
|
||||
(gnc:html-make-empty-cells (* 2 (- current-depth 1))))))
|
||||
(gnc:html-make-empty-cells (* 2 (- current-depth
|
||||
(if group-header-line? 0 1)))))))
|
||||
|
||||
;;;;;;;;;;
|
||||
;; the first row for each account: shows the name and the
|
||||
@@ -330,36 +377,36 @@
|
||||
(define (add-account-rows! acct current-depth)
|
||||
(if show-other-curr?
|
||||
(add-commodity-rows! current-depth
|
||||
(gnc:html-account-anchor acct)
|
||||
(gnc:account-get-commodity acct)
|
||||
(my-get-balance acct)
|
||||
(gnc:account-reverse-balance? acct)
|
||||
(gnc:account-has-shares? acct)
|
||||
#f)
|
||||
(gnc:html-account-anchor acct)
|
||||
(gnc:account-get-commodity acct)
|
||||
(my-get-balance acct)
|
||||
(gnc:account-reverse-balance? acct)
|
||||
(gnc:account-has-shares? acct)
|
||||
#f #f)
|
||||
(add-row-helper!
|
||||
current-depth
|
||||
(gnc:html-account-anchor acct)
|
||||
(gnc:sum-collector-commodity (my-get-balance acct)
|
||||
report-commodity exchange-fn)
|
||||
(gnc:account-reverse-balance? acct)
|
||||
#f)))
|
||||
#f #f)))
|
||||
|
||||
;; Generalization of add-account-rows! for a subtotal or for the
|
||||
;; total balance.
|
||||
(define (add-subtotal-row!
|
||||
current-depth subtotal-name balance boldface?)
|
||||
current-depth subtotal-name balance boldface? group-header-line?)
|
||||
(if show-other-curr?
|
||||
(add-commodity-rows! current-depth subtotal-name
|
||||
report-commodity
|
||||
(gnc:sum-collector-stocks
|
||||
balance report-commodity exchange-fn)
|
||||
#f #f boldface?)
|
||||
#f #f boldface? group-header-line?)
|
||||
;; Show no other currencies. Therefore just calculate
|
||||
;; one total via sum-collector-commodity and show it.
|
||||
(add-row-helper! current-depth subtotal-name
|
||||
(gnc:sum-collector-commodity
|
||||
balance report-commodity exchange-fn)
|
||||
#f boldface?)))
|
||||
#f boldface? group-header-line?)))
|
||||
|
||||
;; This prints *all* the rows that belong to one group: the title
|
||||
;; row, the subaccount tree, and the Total row with the balance of
|
||||
@@ -367,32 +414,41 @@
|
||||
;; object. subaccounts is a list of accounts. thisbalance is the
|
||||
;; balance of this group, or it may be #f, in which case the
|
||||
;; balance is calculated from the subaccounts list.
|
||||
(define (add-group! current-depth groupname subaccounts thisbalance)
|
||||
(define (add-group! current-depth groupname subaccounts
|
||||
thisbalance group-total-line?)
|
||||
(begin
|
||||
;; first the group name
|
||||
(add-subtotal-row! current-depth groupname #f #t)
|
||||
(add-subtotal-row! current-depth groupname
|
||||
(and show-parent-balance? thisbalance)
|
||||
(not (and show-parent-balance? thisbalance)) #t)
|
||||
;; then all the subaccounts
|
||||
(traverse-accounts! subaccounts (+ 1 current-depth))
|
||||
;; and now the "total" row
|
||||
(add-subtotal-row!
|
||||
current-depth
|
||||
(let ((total-text (gnc:make-html-text (_ "Total") " ")))
|
||||
(if (gnc:html-text? groupname)
|
||||
(apply gnc:html-text-append!
|
||||
total-text
|
||||
(gnc:html-text-body groupname))
|
||||
(gnc:html-text-append! total-text groupname))
|
||||
total-text)
|
||||
;; A subbalance is only calculated if no thisbalance was
|
||||
;; given. (Because any "thisbalance" calculation already
|
||||
;; includes the appropriate subaccounts.)
|
||||
(if thisbalance
|
||||
thisbalance
|
||||
(gnc:accounts-get-balance-helper
|
||||
subaccounts my-get-balance gnc:account-reverse-balance?))
|
||||
#t)
|
||||
;; and an empty line
|
||||
(add-subtotal-row! current-depth #f #f #f)))
|
||||
(if group-total-line?
|
||||
(begin
|
||||
;; (remove-last-empty-row) FIXME: do this here or not?
|
||||
(add-subtotal-row!
|
||||
current-depth
|
||||
(let ((total-text (gnc:make-html-text (_ "Total") " ")))
|
||||
(if (gnc:html-text? groupname)
|
||||
(apply gnc:html-text-append!
|
||||
total-text
|
||||
(gnc:html-text-body groupname))
|
||||
(gnc:html-text-append! total-text groupname))
|
||||
total-text)
|
||||
;; Calculate the balance, including the subbalances.
|
||||
;; A subbalance is only calculated if no thisbalance was
|
||||
;; given. (Because any "thisbalance" calculation already
|
||||
;; includes the appropriate subaccounts.)
|
||||
(let ((subbalance (gnc:accounts-get-balance-helper
|
||||
subaccounts my-get-balance
|
||||
gnc:account-reverse-balance?)))
|
||||
(if thisbalance
|
||||
(subbalance 'merge thisbalance #f))
|
||||
subbalance)
|
||||
#t #f)
|
||||
;; and an empty line
|
||||
(add-subtotal-row! current-depth #f #f #f #f)))))
|
||||
|
||||
;; Adds rows to the table. Therefore it goes through the list of
|
||||
;; accounts, runs add-account-rows! on each account. If
|
||||
@@ -411,8 +467,9 @@
|
||||
(gnc:html-account-anchor acct)
|
||||
subaccts
|
||||
(gnc:accounts-get-balance-helper
|
||||
(list acct) my-get-balance
|
||||
gnc:account-reverse-balance?)))))
|
||||
(list acct) my-get-balance-nosub
|
||||
gnc:account-reverse-balance?)
|
||||
show-parent-total?))))
|
||||
(sort-fn accnts))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -423,40 +480,25 @@
|
||||
(for-each
|
||||
(lambda (accts)
|
||||
(if (and (not (null? accts)) (not (null? (cdr accts))))
|
||||
(add-group! 1 (car accts) (cdr accts) #f)))
|
||||
(add-group! 1 (car accts) (cdr accts) #f #t)))
|
||||
(gnc:decompose-accountlist (lset-intersection
|
||||
equal? accounts topl-accounts)))
|
||||
;; No extra grouping.
|
||||
;; No extra grouping.
|
||||
;; FIXME: go through accounts even if not
|
||||
;; shown, because the children might be shown.
|
||||
(traverse-accounts! (filter show-acct? topl-accounts) 1))
|
||||
|
||||
;; This is kind of a hack: Remove the last appended row iff it has
|
||||
;; an empty text field (resulting from the add-group! function
|
||||
;; above). Depends on the structure of html-table-data, i.e. if
|
||||
;; those are changed then this might break.
|
||||
(let ((row-head (car (car (gnc:html-table-data table)))))
|
||||
(if (gnc:html-table-cell? row-head)
|
||||
(if (car (gnc:html-table-cell-data row-head))
|
||||
'()
|
||||
;; html-table-cell-data field is #f i.e. empty.
|
||||
(gnc:html-table-remove-last-row! table))
|
||||
(if row-head
|
||||
'()
|
||||
;; html-table-data element is #f in itself.
|
||||
(gnc:html-table-remove-last-row! table))))
|
||||
|
||||
(remove-last-empty-row)
|
||||
|
||||
;; Show the total sum.
|
||||
(if show-total?
|
||||
(begin
|
||||
(gnc:html-table-append-row!
|
||||
table
|
||||
(list
|
||||
(gnc:make-html-table-cell/size
|
||||
1 (* (if show-other-curr? 3 2)
|
||||
tree-depth) (gnc:make-html-text (gnc:html-markup-hr)))))
|
||||
(gnc:html-table-append-ruler!
|
||||
table (* (if show-other-curr? 3 2) tree-depth))
|
||||
(add-subtotal-row!
|
||||
1 total-name
|
||||
(get-total-fn (filter show-acct? topl-accounts) my-get-balance)
|
||||
#t)))
|
||||
#t #f)))
|
||||
|
||||
;; set default alignment to right, and override for the name
|
||||
;; columns
|
||||
|
||||
@@ -84,7 +84,8 @@
|
||||
(cons (_ "Assets")
|
||||
'(asset bank cash checking savings money-market
|
||||
stock mutual-fund currency))
|
||||
(cons (_ "Liabilities") '(liability equity credit-line))
|
||||
(cons (_ "Liabilities") '(liability credit-line))
|
||||
(cons (_ "Equity") '(equity))
|
||||
(cons (_ "Income") '(income))
|
||||
(cons (_ "Expense") '(expense)))))
|
||||
|
||||
|
||||
@@ -46,7 +46,8 @@
|
||||
(optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(optname-accounts (N_ "Account"))
|
||||
(optname-group-accounts (N_ "Group the accounts"))
|
||||
(optname-include-subbalances (N_ "Include Sub-Account balances")))
|
||||
(optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||
(optname-show-parent-total (N_ "Show subtotals")))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; options generator
|
||||
@@ -81,11 +82,20 @@
|
||||
|
||||
;; with or without grouping
|
||||
(gnc:options-add-group-accounts!
|
||||
options pagename-accounts optname-group-accounts "b" #f)
|
||||
options pagename-accounts optname-group-accounts "b" #t)
|
||||
|
||||
;; with or without subaccounts
|
||||
(gnc:options-add-include-subaccounts!
|
||||
options pagename-accounts optname-include-subbalances "c")
|
||||
;; new options here
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #t))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options pagename-general)
|
||||
@@ -110,8 +120,10 @@
|
||||
(accounts (get-option pagename-accounts optname-accounts))
|
||||
(do-grouping? (get-option pagename-accounts
|
||||
optname-group-accounts))
|
||||
(do-subtotals? (get-option pagename-accounts
|
||||
optname-include-subbalances))
|
||||
(show-parent-balance? (get-option pagename-accounts
|
||||
optname-show-parent-balance))
|
||||
(show-parent-total? (get-option pagename-accounts
|
||||
optname-show-parent-total))
|
||||
(show-fcur? (get-option pagename-general optname-show-foreign))
|
||||
(report-currency (get-option pagename-general
|
||||
optname-report-currency))
|
||||
@@ -138,7 +150,8 @@
|
||||
tree-depth show-subaccts? accounts
|
||||
#t
|
||||
#t gnc:accounts-get-comm-total-assets
|
||||
(_ "Total") do-grouping? do-subtotals?
|
||||
(_ "Total") do-grouping?
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
|
||||
;; add the table
|
||||
|
||||
+169
-133
@@ -39,15 +39,16 @@
|
||||
(optname-display-depth (N_ "Account Display Depth"))
|
||||
(optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(optname-accounts (N_ "Account"))
|
||||
; (optname-group-accounts (N_ "Group the accounts"))
|
||||
(optname-include-subbalances (N_ "Include Sub-Account balances"))
|
||||
(optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||
(optname-show-parent-total (N_ "Show subtotals"))
|
||||
|
||||
;; (pagename-currencies (N_ "Currencies")) too little options :)
|
||||
(pagename-currencies pagename-general)
|
||||
(optname-show-foreign (N_ "Show Foreign Currencies"))
|
||||
(optname-report-currency (N_ "Report's currency")))
|
||||
|
||||
;;; FIXME: UGLY HACK OCCURRING HERE!!!!!!!
|
||||
;; Moderatly ugly hack here, i.e. this depends on the internal
|
||||
;; structure of html-table -- if that is changed, this might break.
|
||||
(define (html-table-merge t1 t2)
|
||||
(begin
|
||||
(gnc:html-table-set-data! t1
|
||||
@@ -55,8 +56,29 @@
|
||||
(gnc:html-table-data t2)
|
||||
(gnc:html-table-data t1)))
|
||||
(gnc:html-table-set-num-rows-internal!
|
||||
t1 (length (gnc:html-table-data t1)))))
|
||||
|
||||
t1 (+ (gnc:html-table-num-rows t1)
|
||||
(gnc:html-table-num-rows t2)))))
|
||||
|
||||
;; Copied from html-utilities.scm.
|
||||
;; Creates the table cell with given colspan (and rowspan=1), with
|
||||
;; the content content and in boldface if boldface? is true. content
|
||||
;; may be #f (empty cell), or a string, or a html-text
|
||||
;; object. Returns a html-table-cell object.
|
||||
(define (my-table-cell colspan content boldface?)
|
||||
(gnc:make-html-table-cell/size
|
||||
1 colspan
|
||||
(and content ;; if content == #f, just use #f
|
||||
(if boldface?
|
||||
;; Further improvement: use some other table cell
|
||||
;; style here ("grand-total") instead of the direct
|
||||
;; markup-b.
|
||||
(gnc:make-html-text
|
||||
(if (gnc:html-text? content)
|
||||
(apply gnc:html-markup-b
|
||||
(gnc:html-text-body content))
|
||||
(gnc:html-markup-b content)))
|
||||
content))))
|
||||
|
||||
(define (accountlist-get-comm-balance-at-date accountlist date)
|
||||
(let ((collector (gnc:make-commodity-collector)))
|
||||
(for-each (lambda (account)
|
||||
@@ -92,15 +114,21 @@
|
||||
'(bank cash credit asset liability stock mutual-fund currency
|
||||
equity income expense)
|
||||
(gnc:group-get-subaccounts (gnc:get-current-group)))))
|
||||
|
||||
;; with or without grouping
|
||||
; (gnc:options-add-group-accounts!
|
||||
; options pagename-accounts optname-group-accounts "b" #t)
|
||||
|
||||
;; with or without subaccounts
|
||||
(gnc:options-add-include-subaccounts!
|
||||
options pagename-accounts optname-include-subbalances "c")
|
||||
|
||||
;; what to show about non-leaf accounts
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #f))
|
||||
|
||||
;; have a subtotal for each parent account?
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #f))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options pagename-general)
|
||||
|
||||
@@ -117,54 +145,26 @@
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report-obj) pagename optname)))
|
||||
|
||||
(define (add-retained-profits-line
|
||||
table balance show-fcur? exchange-fn report-commodity)
|
||||
(if show-fcur?
|
||||
(let ((first-row #t))
|
||||
(balance 'format
|
||||
(lambda (commodity amount)
|
||||
(html-table-append-row!
|
||||
(list (if first-row
|
||||
(begin
|
||||
(set! first-row #f)
|
||||
(_ "Net Profit"))
|
||||
" ")
|
||||
(gnc:make-gnc-monetary
|
||||
commodity amount))))
|
||||
#f))
|
||||
(gnc:html-table-append-row!
|
||||
table (list (_ "Net Profit")
|
||||
(gnc:sum-collector-commodity
|
||||
balance report-commodity exchange-fn)))))
|
||||
|
||||
|
||||
(define (add-subtotal-line
|
||||
table label total show-fcur? exchange-fn report-commodity)
|
||||
(if show-fcur?
|
||||
(let ((first-row #t))
|
||||
(total 'format
|
||||
(lambda (commodity amount)
|
||||
(html-table-append-row!
|
||||
(list (if first-row
|
||||
(begin
|
||||
(set! first-row #f)
|
||||
label)
|
||||
" ")
|
||||
(gnc:make-gnc-monetary
|
||||
commodity amount))))
|
||||
#f))
|
||||
(gnc:html-table-append-row!
|
||||
table (list label
|
||||
(gnc:sum-collector-commodity
|
||||
total report-commodity exchange-fn)))))
|
||||
|
||||
;; get all option's values
|
||||
(let* ((display-depth (get-option pagename-accounts
|
||||
optname-display-depth))
|
||||
(show-subaccts? (get-option pagename-accounts
|
||||
optname-show-subaccounts))
|
||||
(accounts (get-option pagename-accounts
|
||||
optname-accounts))
|
||||
optname-accounts))
|
||||
(show-parent-balance? (get-option pagename-accounts
|
||||
optname-show-parent-balance))
|
||||
(show-parent-total? (get-option pagename-accounts
|
||||
optname-show-parent-total))
|
||||
(show-fcur? (get-option pagename-currencies
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option pagename-currencies
|
||||
optname-report-currency))
|
||||
(to-date-tp (gnc:timepair-end-day-time
|
||||
(vector-ref (get-option pagename-general
|
||||
optname-to-date) 1)))
|
||||
|
||||
;; decompose the account list
|
||||
(asset-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(bank cash asset stock mutual-fund)
|
||||
@@ -182,44 +182,68 @@
|
||||
(income-expense-accounts
|
||||
(gnc:filter-accountlist-type
|
||||
'(income expense)
|
||||
accounts))
|
||||
|
||||
; (do-grouping? (get-option pagename-accounts
|
||||
; optname-group-accounts))
|
||||
(do-subtotals? (get-option pagename-accounts
|
||||
optname-include-subbalances))
|
||||
(show-fcur? (get-option pagename-currencies
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option pagename-currencies
|
||||
optname-report-currency))
|
||||
(to-date-tp (gnc:timepair-end-day-time
|
||||
(vector-ref (get-option pagename-general
|
||||
optname-to-date) 1)))
|
||||
|
||||
accounts))
|
||||
;; goonie: I would rather use gnc:decompose-accountlist and
|
||||
;; then continue with a bunch of list processing. Saves
|
||||
;; typing and makes changes a lot easier. -- cstim.
|
||||
|
||||
(doc (gnc:make-html-document))
|
||||
(txt (gnc:make-html-text)))
|
||||
(gnc:warn "account names" liability-account-names)
|
||||
(txt (gnc:make-html-text))
|
||||
(tree-depth (if (equal? display-depth 'all)
|
||||
(gnc:get-current-group-depth)
|
||||
display-depth))
|
||||
;; calculate the exchange rates
|
||||
(exchange-alist (gnc:make-exchange-alist
|
||||
report-currency to-date-tp))
|
||||
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
||||
(totals-get-balance (lambda (account)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
account to-date-tp #f))))
|
||||
|
||||
(define (add-subtotal-line table label balance)
|
||||
(if show-fcur?
|
||||
;; FIXME: The multi-currency format is not yet adapted to
|
||||
;; take tree-depth into account. Instead of coding that
|
||||
;; here it would definitely be better to extract the
|
||||
;; necessary function out of html-build-acct-table into
|
||||
;; the global namespace.
|
||||
(let ((first-row #t))
|
||||
(balance 'format
|
||||
(lambda (commodity amount)
|
||||
(html-table-append-row!
|
||||
(list (if first-row
|
||||
(begin
|
||||
(set! first-row #f)
|
||||
label)
|
||||
#f)
|
||||
(gnc:make-gnc-monetary
|
||||
commodity amount))))
|
||||
#f))
|
||||
(gnc:html-table-append-row!
|
||||
table (append
|
||||
;; FIXME: is it possible to get rid of my private
|
||||
;; definition of my-table-cell? Maybe as another
|
||||
;; extracted funtion from html-build-acct-tree.
|
||||
(list (my-table-cell tree-depth label #t))
|
||||
(gnc:html-make-empty-cells (- tree-depth 1))
|
||||
(list (and balance
|
||||
(gnc:make-html-text
|
||||
;; FIXME: this markup-b can go away as
|
||||
;; soon as we have styles here.
|
||||
(gnc:html-markup-b
|
||||
(gnc:sum-collector-commodity
|
||||
balance report-currency exchange-fn)))))))))
|
||||
|
||||
|
||||
;;(gnc:warn "account names" liability-account-names)
|
||||
(gnc:html-document-set-title!
|
||||
;; FIXME: Use magic sprintf code.
|
||||
doc (sprintf #f (N_ "Balance sheet at %s")
|
||||
(gnc:timepair-to-datestring to-date-tp)))
|
||||
(if (not (null? accounts))
|
||||
;; if no max. tree depth is given we have to find the
|
||||
;; maximum existing depth
|
||||
(let* ((tree-depth (if (equal? display-depth 'all)
|
||||
(+ (gnc:get-current-group-depth)
|
||||
(if do-grouping? 1 0))
|
||||
display-depth))
|
||||
;; calculate the exchange rates
|
||||
|
||||
(exchange-alist (gnc:make-exchange-alist
|
||||
report-currency to-date-tp))
|
||||
(exchange-fn (gnc:make-exchange-function exchange-alist))
|
||||
(totals-get-balance (lambda (account)
|
||||
(gnc:account-get-comm-balance-at-date
|
||||
account to-date-tp #f)))
|
||||
(gnc:timepair-to-datestring to-date-tp)))
|
||||
|
||||
(asset-balance
|
||||
(if (not (null? accounts))
|
||||
;; Get all the balances for each account group.
|
||||
(let* ((asset-balance
|
||||
(gnc:accounts-get-comm-total-assets
|
||||
asset-accounts totals-get-balance))
|
||||
(liability-balance
|
||||
@@ -238,35 +262,36 @@
|
||||
(total-equity-balance (gnc:make-commodity-collector))
|
||||
(equity-plus-liability (gnc:make-commodity-collector))
|
||||
|
||||
;; do the processing here
|
||||
(asset-table (gnc:html-build-acct-table
|
||||
#f to-date-tp
|
||||
tree-depth show-subaccts? asset-accounts
|
||||
#f #f
|
||||
gnc:accounts-get-comm-total-assets
|
||||
(_ "Assets") #f do-subtotals?
|
||||
show-fcur? report-currency exchange-fn))
|
||||
;; Create the account tables here.
|
||||
(asset-table
|
||||
(gnc:html-build-acct-table
|
||||
#f to-date-tp
|
||||
tree-depth show-subaccts?
|
||||
asset-accounts
|
||||
#f #f #f #f
|
||||
;;gnc:accounts-get-comm-total-assets (_ "Assets")
|
||||
#f
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn))
|
||||
(liability-table
|
||||
(gnc:html-build-acct-table
|
||||
#f
|
||||
to-date-tp
|
||||
tree-depth
|
||||
show-subaccts?
|
||||
liability-accounts
|
||||
#f #f
|
||||
gnc:accounts-get-comm-total-assets
|
||||
(_ "Liabilities") #f do-subtotals?
|
||||
show-fcur? report-currency exchange-fn))
|
||||
#f to-date-tp
|
||||
tree-depth show-subaccts?
|
||||
liability-accounts
|
||||
#f #f #f #f
|
||||
;;gnc:accounts-get-comm-total-assets (_ "Liabilities")
|
||||
#f
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn))
|
||||
(equity-table
|
||||
(gnc:html-build-acct-table
|
||||
#f
|
||||
to-date-tp
|
||||
tree-depth
|
||||
show-subaccts?
|
||||
#f to-date-tp
|
||||
tree-depth show-subaccts?
|
||||
equity-accounts
|
||||
#f #f
|
||||
gnc:accounts-get-comm-total-assets
|
||||
(_ "Equity") #f do-subtotals?
|
||||
#f #f #f #f
|
||||
;;gnc:accounts-get-comm-total-assets (_ "Equity")
|
||||
#f
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
(retained-profit-balance 'minusmerge
|
||||
neg-retained-profit-balance
|
||||
@@ -284,33 +309,44 @@
|
||||
(equity-plus-liability 'merge
|
||||
total-equity-balance
|
||||
#f)
|
||||
|
||||
|
||||
|
||||
|
||||
;; add the tables
|
||||
(gnc:html-table-prepend-row! asset-table (list "Assets"))
|
||||
(add-subtotal-line
|
||||
asset-table "Assets"
|
||||
asset-balance show-fcur? exchange-fn
|
||||
report-currency)
|
||||
(gnc:html-table-append-row! asset-table (list "Liabilities"))
|
||||
;; Now concatenate the tables. This first prepend-row has
|
||||
;; to be written out by hand -- we can't use the function
|
||||
;; append-something because we have to prepend.
|
||||
(gnc:html-table-prepend-row!
|
||||
asset-table
|
||||
(list (my-table-cell (* (if show-fcur? 3 2)
|
||||
tree-depth)
|
||||
(_ "Assets") #t)))
|
||||
|
||||
(add-subtotal-line
|
||||
asset-table (_ "Assets") asset-balance)
|
||||
|
||||
;; add a horizontal ruler
|
||||
(gnc:html-table-append-ruler!
|
||||
asset-table (* (if show-fcur? 3 2) tree-depth))
|
||||
|
||||
(add-subtotal-line
|
||||
asset-table (_ "Liabilities") #f)
|
||||
(html-table-merge asset-table liability-table)
|
||||
(add-subtotal-line
|
||||
asset-table "Liabilities"
|
||||
sign-reversed-liability-balance show-fcur? exchange-fn
|
||||
report-currency)
|
||||
(gnc:html-table-append-row! asset-table (list "Equity"))
|
||||
asset-table (_ "Liabilities") sign-reversed-liability-balance)
|
||||
|
||||
(gnc:html-table-append-ruler!
|
||||
asset-table (* (if show-fcur? 3 2) tree-depth))
|
||||
(add-subtotal-line
|
||||
asset-table (_ "Equity") #f)
|
||||
(html-table-merge asset-table equity-table)
|
||||
(add-retained-profits-line
|
||||
asset-table retained-profit-balance
|
||||
show-fcur? exchange-fn report-currency)
|
||||
(add-subtotal-line
|
||||
asset-table "Total Equity" total-equity-balance show-fcur?
|
||||
exchange-fn report-currency)
|
||||
asset-table (_ "Net Profit") retained-profit-balance)
|
||||
(add-subtotal-line
|
||||
asset-table "Liabilities & Equity" equity-plus-liability
|
||||
show-fcur? exchange-fn report-currency)
|
||||
asset-table (_ "Total Equity") total-equity-balance)
|
||||
|
||||
(gnc:html-table-append-ruler!
|
||||
asset-table (* (if show-fcur? 3 2) tree-depth))
|
||||
(add-subtotal-line
|
||||
asset-table (_ "Liabilities & Equity") equity-plus-liability)
|
||||
(gnc:html-document-add-object! doc asset-table)
|
||||
|
||||
;; add currency information
|
||||
@@ -318,7 +354,7 @@
|
||||
; doc ;;(gnc:html-markup-p
|
||||
; (gnc:html-make-exchangerates
|
||||
; report-currency exchange-alist accounts #f)))
|
||||
)
|
||||
)
|
||||
|
||||
;; error condition: no accounts specified
|
||||
(let ((p (gnc:make-html-text)))
|
||||
|
||||
@@ -98,7 +98,7 @@
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-display optname-stacked
|
||||
"b" (N_ "Show barchart as stacked barchart?") #t))
|
||||
"b" (N_ "Show barchart as stacked barchart? (Guppi>=0.35.4 required)") #t))
|
||||
|
||||
(add-option
|
||||
(gnc:make-number-range-option
|
||||
|
||||
+22
-8
@@ -39,8 +39,10 @@
|
||||
(optname-display-depth (N_ "Account Display Depth"))
|
||||
(optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(optname-accounts (N_ "Account"))
|
||||
|
||||
(optname-group-accounts (N_ "Group the accounts"))
|
||||
(optname-include-subbalances (N_ "Include Sub-Account balances"))
|
||||
(optname-show-parent-balance (N_ "Show balances for parent accounts"))
|
||||
(optname-show-parent-total (N_ "Show subtotals"))
|
||||
|
||||
;; (pagename-currencies (N_ "Currencies")) too little options :)
|
||||
(pagename-currencies pagename-general)
|
||||
@@ -77,10 +79,19 @@
|
||||
(gnc:options-add-group-accounts!
|
||||
options pagename-accounts optname-group-accounts "b" #t)
|
||||
|
||||
;; with or without subaccounts
|
||||
(gnc:options-add-include-subaccounts!
|
||||
options pagename-accounts optname-include-subbalances "c")
|
||||
|
||||
;; FIXME: new options here
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #f))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-accounts optname-show-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
||||
|
||||
;; Set the general page as default option tab
|
||||
(gnc:options-set-default-section options pagename-general)
|
||||
|
||||
@@ -106,8 +117,10 @@
|
||||
optname-accounts))
|
||||
(do-grouping? (get-option pagename-accounts
|
||||
optname-group-accounts))
|
||||
(do-subtotals? (get-option pagename-accounts
|
||||
optname-include-subbalances))
|
||||
(show-parent-balance? (get-option pagename-accounts
|
||||
optname-show-parent-balance))
|
||||
(show-parent-total? (get-option pagename-accounts
|
||||
optname-show-parent-total))
|
||||
(show-fcur? (get-option pagename-currencies
|
||||
optname-show-foreign))
|
||||
(report-currency (get-option pagename-currencies
|
||||
@@ -141,7 +154,8 @@
|
||||
from-date-tp to-date-tp
|
||||
tree-depth show-subaccts? accounts #f
|
||||
#t gnc:accounts-get-comm-total-profit
|
||||
(_ "Profit") do-grouping? do-subtotals?
|
||||
(_ "Profit") do-grouping?
|
||||
show-parent-balance? show-parent-total?
|
||||
show-fcur? report-currency exchange-fn)))
|
||||
|
||||
;; add the table
|
||||
|
||||
Reference in New Issue
Block a user