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:
Dave Peticolas
2001-04-06 10:14:38 +00:00
parent 0a855b597e
commit 4225dabedb
7 changed files with 344 additions and 220 deletions
+18
View File
@@ -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
View File
@@ -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
+2 -1
View File
@@ -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)))))
+21 -8
View File
@@ -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
View File
@@ -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)))
+1 -1
View File
@@ -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
View File
@@ -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