[Gnucash-changes]
David Montenegro's patch for bugs #95551, #124367.
Derek Atkins
warlord at cvs.gnucash.org
Sat Jan 29 13:54:14 EST 2005
Log Message:
-----------
David Montenegro's patch for bugs #95551, #124367.
* src/report/standard-reports/account-summary.scm:
Rewrote account summary report. Now has fields for
more account metadata. Properly handles mixed
asset/liability subaccounts.
* src/report/standard-reports/html-acct-table.scm:
Added functionality (account-type &c) and bug fixes
(lone zb subtotals, spurious 'recursive-bal, typos)
needed to make the new account-summary.scm work.
Modified Files:
--------------
gnucash:
ChangeLog
gnucash/src/report/report-system:
html-acct-table.scm
gnucash/src/report/standard-reports:
account-summary.scm
Revision Data
-------------
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1882
retrieving revision 1.1883
diff -LChangeLog -LChangeLog -u -r1.1882 -r1.1883
--- ChangeLog
+++ ChangeLog
@@ -1,3 +1,15 @@
+2005-01-29 Derek Atkins <derek at ihtfp.com>
+
+ David Montenegro's patch for bugs #95551, #124367.
+ * src/report/standard-reports/account-summary.scm:
+ Rewrote account summary report. Now has fields for
+ more account metadata. Properly handles mixed
+ asset/liability subaccounts.
+ * src/report/standard-reports/html-acct-table.scm:
+ Added functionality (account-type &c) and bug fixes
+ (lone zb subtotals, spurious 'recursive-bal, typos)
+ needed to make the new account-summary.scm work.
+
2005-01-29 Christian Stimming <stimming at tuhh.de>
* configure.in, src/tax/us/gncmod-tax-us.c,
Index: html-acct-table.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-acct-table.scm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Lsrc/report/report-system/html-acct-table.scm -Lsrc/report/report-system/html-acct-table.scm -u -r1.3 -r1.4
--- src/report/report-system/html-acct-table.scm
+++ src/report/report-system/html-acct-table.scm
@@ -63,7 +63,7 @@
;; The list of accounts which are to be placed in the
;; gnc:html-acct-table object can be controled with the
;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/env/accts,
-;; and gnc:html-table-add-accts! functions.
+;; and gnc:html-table-add-accts! functions.
;;
;; The gnc:html-acct-table parameters, set with
;; gnc:make-html-acct-table/env and gnc:make-html-acct-table/accts/env
@@ -209,6 +209,21 @@
;; the parent account of the current account, if one exists.
;; #f if the current account has no parent.
;;
+;; account-guid: guid
+;;
+;; the guid of the account in the current row, as returned by
+;; gnc:account-get-guid.
+;;
+;; account-desc: string?
+;;
+;; the account description of the account in the current row,
+;; as returned by gnc:account-get-description.
+;;
+;; account-notes: string?
+;;
+;; the account notes of the account in the current row, as
+;; returned by gnc:account-get-notes.
+;;
;; account-path: string
;;
;; the full name of the account in the current row. i.e., if
@@ -339,6 +354,15 @@
;; probably safest not to assume that an account contains only
;; its default commodity.
;;
+;; account-type: account_type
+;;
+;; returns the type of the account in the current row
+;;
+;; account-type-string: string
+;;
+;; returns the type of the account in the current row as a
+;; string
+;;
;; row-type: 'account-row 'subtotal-row
;;
;; indicates the nature of the current row. 'account-row
@@ -638,6 +662,14 @@
(account-depth acct-depth)
(logical-depth logi-depth)
(account-commodity (gnc:account-get-commodity acct))
+ (account-type (gnc:account-get-type acct))
+ ;; N.B.: gnc:account-get-type-string really should be
+ ;; called gnc:account-type-get-string
+ (account-type-string (gnc:account-get-type-string
+ (gnc:account-get-type acct)))
+ (account-guid (gnc:account-get-guid acct))
+ (account-description (gnc:account-get-description acct))
+ (account-notes (gnc:account-get-notes acct))
(account-bal (my-get-balance-nosub
acct start-date end-date))
(recursive-bal
@@ -655,6 +687,11 @@
(list 'account account)
(list 'account-name account-name)
(list 'account-code account-code)
+ (list 'account-type account-type)
+ (list 'account-type-string account-type-string)
+ (list 'account-guid account-guid)
+ (list 'account-description account-description)
+ (list 'account-notes account-notes)
(list 'account-path account-path)
(list 'account-parent account-parent)
(list 'account-children account-children)
@@ -709,8 +746,11 @@
)
(or (not (use-acct? acct))
(not subtotal-mode)
- ;; ignore use-acct for subtotals...
- ;; (not (use-acct acct))
+ ;; ditto that remark concerning zero recursive-bal...
+ (and (gnc:commodity-collector-allzero? recursive-bal)
+ (equal? zero-mode 'omit-leaf-acct))
+ ;; ignore use-acct for subtotals...?
+ ;; (not (use-acct? acct))
(null? subaccts)
(let* ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
(apply gnc:html-text-append! lbl-txt
@@ -803,7 +843,7 @@
(gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))
(define (gnc:html-acct-table-num-cols acct-table)
- (- (gnc:html-table-num-cols (gnc:_html-acct-table-matrix_ acct-table)) 1))
+ (- (gnc:html-table-num-columns (gnc:_html-acct-table-matrix_ acct-table)) 1))
(define (gnc:html-acct-table-get-cell acct-table row col)
;; we'll only ever store one object in an html-table-cell
@@ -1009,16 +1049,16 @@
'omit-bal))
(bal-method
;; figure out how to calculate our balance:
- ;; 'immediate-bal|'recursive-bal|'omit-bal
+ ;; 'immediate-bal|'recursive-bal ('omit-bal handled below)
(or (and (equal? row-type 'subtotal-row) 'recursive-bal)
(and (equal? (+ display-depth 1) display-tree-depth)
- (if (equal? limit-behavior 'truncate)
- 'immediate-bal
- ;; 'summarize, 'flatten, and unknown
- ;; depth limit behaviors yield
- ;; 'recursive-bal. this is true
- ;; whether a leaf account or not.
- 'recursive-bal)
+ (or (and (equal? limit-behavior 'summarize)
+ 'recursive-bal)
+ (and (null? children) 'immediate-bal)
+ ;; otherwise, parent account at depth limit,
+ ;; with either 'truncate or 'flatten...
+ parent-acct-bal-mode
+ )
)
(if (null? children) #f parent-acct-bal-mode)
'immediate-bal
Index: account-summary.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/account-summary.scm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Lsrc/report/standard-reports/account-summary.scm -Lsrc/report/standard-reports/account-summary.scm -u -r1.11 -r1.12
--- src/report/standard-reports/account-summary.scm
+++ src/report/standard-reports/account-summary.scm
@@ -1,5 +1,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; account-summary.scm : brief account listing
+;; account-summary.scm : account listing/chart of accounts
+;;
+;; Rewritten 2004.07.27 by David Montenegro <sunrise2000 at comcast.net>
+;; same license & restrictions apply
+;;
;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
;; Copyright 2000-2001 Bill Gribble <grib at gnumatic.com>
;;
@@ -7,7 +11,25 @@
;; Author makes no implicit or explicit guarantee of accuracy of
;; these calculations and accepts no responsibility for direct
;; or indirect losses incurred as a result of using this software.
-;;
+;;
+;; * BUGS:
+;;
+;; Does not currently provide all possible account attributes.
+;;
+;; Table does not currently use row style attributes.
+;;
+;; Progress bar functionality is currently mostly broken.
+;;
+;; This code makes the assumption that you want your account
+;; summary to no more than daily resolution.
+;;
+;; The Company Name field does not currently default to the name
+;; in (gnc:get-current-book).
+;;
+;; The variables in this code could use more consistent naming.
+;;
+;; See also all the "FIXME"s in the code.
+;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
@@ -34,101 +56,234 @@
(gnc:module-load "gnucash/report/report-system" 0)
-;; account summary report
-;; prints a table of account information with clickable
-;; links to open the corresponding register window.
+;; account summary report prints a table of account information,
+;; optionally with clickable links to open the corresponding register
+;; window.
(define reportname (N_ "Account Summary"))
-;; define all option's names such that typos etc. are no longer
-;; possible.
-(define optname-date (N_ "Date"))
-(define optname-display-depth (N_ "Account Display Depth"))
+(define optname-report-title (N_ "Report Title"))
+(define opthelp-report-title (N_ "Title for this report"))
-(define optname-show-foreign (N_ "Show Foreign Currencies/Shares of Stock"))
-(define optname-report-currency (N_ "Report's currency"))
-(define optname-price-source (N_ "Price Source"))
+(define optname-party-name (N_ "Company name"))
+(define opthelp-party-name (N_ "Name of company/individual"))
+
+(define optname-date (N_ "Date"))
+(define opthelp-date (N_ "Account summary as-of date"))
+;; FIXME this needs an indent option
-(define optname-show-subaccounts (N_ "Always show sub-accounts"))
-(define optname-accounts (N_ "Accounts"))
+(define optname-accounts (N_ "Accounts to include"))
+(define opthelp-accounts
+ (N_ "Report on these accounts, if display depth allows."))
+(define optname-depth-limit (N_ "Levels of Subaccounts"))
+(define opthelp-depth-limit
+ (N_ "Maximum number of levels in the account tree displayed"))
+(define optname-bottom-behavior (N_ "Depth limit behavior"))
+(define opthelp-bottom-behavior
+ (N_ "How to treat accounts which exceed the specified depth limit (if any)"))
+
+(define optname-parent-balance-mode (N_ "Parent account balances"))
+(define opthelp-parent-balance-mode
+ (N_ "How to show any balance in parent accounts"))
+(define optname-parent-total-mode (N_ "Parent account subtotals"))
+(define opthelp-parent-total-mode
+ (N_ "How to show account subtotals for selected accounts having children"))
+
+(define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
+(define opthelp-show-zb-accts
+ (N_ "Include accounts with zero total (recursive) balances in this report"))
+(define optname-omit-zb-bals (N_ "Omit zero balance figures"))
+(define opthelp-omit-zb-bals
+ (N_ "Show blank space in place of any zero balances which would be shown"))
+
+(define optname-use-rules (N_ "Show accounting-style rules"))
+(define opthelp-use-rules
+ (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 optname-show-account-bals (N_ "Account Balance"))
+(define opthelp-show-account-bals (N_ "Show an account's balance"))
+(define optname-show-account-code (N_ "Account Code"))
+(define opthelp-show-account-code (N_ "Show an account's account code"))
+(define optname-show-account-type (N_ "Account Type"))
+(define opthelp-show-account-type (N_ "Show an account's account type"))
+(define optname-show-account-desc (N_ "Account Description"))
+(define opthelp-show-account-desc (N_ "Show an account's description"))
+(define optname-show-account-notes (N_ "Account Notes"))
+(define opthelp-show-account-notes (N_ "Show an account's notes"))
-(define optname-group-accounts (N_ "Group the accounts"))
-(define optname-show-parent-balance (N_ "Show balances for parent accounts"))
-(define optname-show-parent-total (N_ "Show subtotals"))
+(define pagename-commodities (N_ "Commodities"))
+(define optname-report-commodity (N_ "Report's currency"))
+(define optname-price-source (N_ "Price Source"))
+(define optname-show-foreign (N_ "Show Foreign Currencies"))
+(define opthelp-show-foreign
+ (N_ "Display any foreign currency amount in an account"))
(define optname-show-rates (N_ "Show Exchange Rates"))
+(define opthelp-show-rates (N_ "Show the exchange rates used"))
+
+;; FIXME: add more account metadata options!
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; options generator
-;; select accounts to report on, whether to show subaccounts,
-;; whether to include subtotaled subaccount balances in the report,
-;; and what date to show the summary for.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (accsum-options-generator)
- (let* ((options (gnc:new-options)))
+ (let* ((options (gnc:new-options))
+ (add-option
+ (lambda (new-option)
+ (gnc:register-option options new-option))))
+
+ (add-option
+ (gnc:make-string-option
+ gnc:pagename-general optname-report-title
+ "a" opthelp-report-title reportname))
+ (add-option
+ (gnc:make-string-option
+ gnc:pagename-general optname-party-name
+ "b" opthelp-party-name (N_ "")))
+ ;; this should default to company name in (gnc:get-current-book)
+ ;; does anyone know the function to get the company name??
+
;; date at which to report balance
- (gnc:options-add-report-date!
- options gnc:pagename-general optname-date "a")
+ (add-option
+ (gnc:make-date-option
+ gnc:pagename-general optname-date
+ "c" opthelp-date
+ (lambda () (cons 'absolute (cons (current-time) 0)))
+ #f 'both '(start-cal-year start-prev-year end-prev-year) ))
+ ;; accounts to work on
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "a"
+ opthelp-accounts
+ (lambda ()
+ (gnc:filter-accountlist-type
+ '(bank cash credit asset liability stock mutual-fund currency
+ payable receivable equity income expense)
+ (gnc:group-get-subaccounts (gnc:get-current-group))))
+ #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"))
+ )
+ )
+ )
+
;; all about currencies
(gnc:options-add-currency!
- options gnc:pagename-general
- optname-report-currency "b")
-
+ options pagename-commodities
+ optname-report-commodity "a")
+
(gnc:options-add-price-source!
- options gnc:pagename-general
- optname-price-source "c" 'weighted-average)
-
- ;; accounts to work on
- (gnc:options-add-account-selection!
- options gnc:pagename-accounts
- optname-display-depth optname-show-subaccounts
- optname-accounts "a" 2
- (lambda ()
- ;; FIXME : gnc:get-current-accounts disappeared
- (let ((current-accounts '()))
- (cond ((not (null? current-accounts)) current-accounts)
- (else
- (gnc:group-get-account-list (gnc:get-current-group))))))
- #t)
-
- ;; with or without grouping
- (gnc:options-add-group-accounts!
- options gnc:pagename-display optname-group-accounts "b" #t)
-
- ;; new options here
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-parent-balance
- "c" (N_ "Show balances for parent accounts") #t))
-
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-parent-total
- "d" (N_ "Show subtotals for parent accounts") #t))
-
- (gnc:register-option
- options
+ options pagename-commodities
+ optname-price-source "b" 'weighted-average)
+
+ (add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-foreign
- "e" (N_ "Display the account's foreign currency amount?") #f))
-
- (gnc:register-option
- options
+ pagename-commodities optname-show-foreign
+ "c" opthelp-show-foreign #t))
+
+ (add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-rates
- "f" (N_ "Show the exchange rates used") #t))
-
+ pagename-commodities optname-show-rates
+ "d" opthelp-show-rates #f))
+
+ ;; what to show for zero-balance accounts
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-zb-accts
+ "a" opthelp-show-zb-accts #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-omit-zb-bals
+ "b" opthelp-omit-zb-bals #f))
+ ;; what to show for non-leaf accounts
+ (add-option
+ (gnc:make-multichoice-option
+ gnc:pagename-display optname-parent-balance-mode
+ "c" opthelp-parent-balance-mode
+ 'immediate-bal
+ (list (vector 'immediate-bal
+ (N_ "Show Immediate Balance")
+ (N_ "Show only the balance in the parent account, excluding any subaccounts"))
+ (vector 'recursive-bal
+ (N_ "Recursive Balance")
+ (N_ "Include subaccounts in balance"))
+ (vector 'omit-bal
+ (N_ "Omit Balance")
+ (N_ "Do not show parent account balances")))))
+ (add-option
+ (gnc:make-multichoice-option
+ gnc:pagename-display optname-parent-total-mode
+ "d" opthelp-parent-total-mode
+ 'f
+ (list (vector 't
+ (N_ "Show subtotals")
+ (N_ "Show subtotals for selected accounts which have subaccounts"))
+ (vector 'f
+ (N_ "Do not show subtotals")
+ (N_ "Do not subtotal selected parent accounts"))
+ (vector 'canonically-tabbed
+ ;;(N_ "Subtotals indented text book style")
+ (N_ "Text book style (experimental)")
+ (N_ "Show parent account subtotals, indented per text book practice (experimental)")))))
+
+ ;; some detailed formatting options
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-account-links
+ "e" opthelp-account-links #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-use-rules
+ "f" opthelp-use-rules #f))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-account-bals
+ "g" opthelp-show-account-bals #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-account-code
+ "h" opthelp-show-account-code #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-account-desc
+ "i" opthelp-show-account-desc #f))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-account-type
+ "j" opthelp-show-account-type #f))
+ (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-general)
-
+ (gnc:options-set-default-section options gnc:pagename-display)
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accsum-renderer
-;; set up the document and add the table
+;; set up the table and put it in an html document
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (accsum-renderer report-obj)
@@ -138,93 +293,249 @@
(gnc:report-options report-obj) pagename optname)))
(gnc:report-starting reportname)
- (let ((display-depth (get-option gnc:pagename-accounts
- optname-display-depth ))
- (show-subaccts? (get-option gnc:pagename-accounts
- optname-show-subaccounts))
- (accounts (get-option gnc:pagename-accounts optname-accounts))
- (do-grouping? (get-option gnc:pagename-display
- optname-group-accounts))
- (show-parent-balance? (get-option gnc:pagename-display
- optname-show-parent-balance))
- (show-parent-total? (get-option gnc:pagename-display
- optname-show-parent-total))
- (show-fcur? (get-option gnc:pagename-display optname-show-foreign))
- (report-currency (get-option gnc:pagename-general
- optname-report-currency))
- (price-source (get-option gnc:pagename-general
- optname-price-source))
- (show-rates? (get-option gnc:pagename-display
- optname-show-rates))
- (date-tp (gnc:timepair-end-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-date))))
- (report-title (get-option gnc:pagename-general
- gnc:optname-reportname))
- (doc (gnc:make-html-document))
- (txt (gnc:make-html-text)))
-
+
+ (let* (
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (get-option gnc:pagename-general optname-party-name))
+ (date-tp (gnc:timepair-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-date))))
+ (accounts (get-option gnc:pagename-accounts
+ optname-accounts))
+ (depth-limit (get-option gnc:pagename-accounts
+ optname-depth-limit))
+ (bottom-behavior (get-option gnc:pagename-accounts
+ optname-bottom-behavior))
+ (report-commodity (get-option pagename-commodities
+ optname-report-commodity))
+ (price-source (get-option pagename-commodities
+ optname-price-source))
+ (show-fcur? (get-option pagename-commodities
+ optname-show-foreign))
+ (show-rates? (get-option pagename-commodities
+ optname-show-rates))
+ (parent-balance-mode (get-option gnc:pagename-display
+ optname-parent-balance-mode))
+ (parent-total-mode
+ (car
+ (assoc-ref '((t #t) (f #f) (canonically-tabbed canonically-tabbed))
+ (get-option gnc:pagename-display
+ optname-parent-total-mode))))
+ (show-zb-accts? (get-option gnc:pagename-display
+ optname-show-zb-accts))
+ (omit-zb-bals? (get-option gnc:pagename-display
+ optname-omit-zb-bals))
+ (use-links? (get-option gnc:pagename-display
+ optname-account-links))
+ (use-rules? (get-option gnc:pagename-display
+ optname-use-rules))
+ (show-account-code? (get-option gnc:pagename-display
+ optname-show-account-code))
+ (show-account-type? (get-option gnc:pagename-display
+ optname-show-account-type))
+ (show-account-desc? (get-option gnc:pagename-display
+ optname-show-account-desc))
+ (show-account-notes? (get-option gnc:pagename-display
+ optname-show-account-notes))
+ (show-account-bals? (get-option gnc:pagename-display
+ optname-show-account-bals))
+ (indent 0)
+ (tabbing #f)
+
+ (doc (gnc:make-html-document))
+ ;; just in case we need this information...
+ (tree-depth (if (equal? depth-limit 'all)
+ (gnc:get-current-group-depth)
+ depth-limit))
+ ;; exchange rates calculation parameters
+ (exchange-fn
+ (gnc:case-exchange-fn price-source report-commodity date-tp))
+ )
+
(gnc:html-document-set-title!
- doc
- (string-append
- report-title
- " "
- (gnc:print-date 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)
- display-depth)
- (if do-grouping? 1 0)))
- (exchange-fn #f)
- (table #f))
-
- (gnc:report-percent-done 2)
- (set! exchange-fn (gnc:case-exchange-fn
- price-source report-currency date-tp))
- (gnc:report-percent-done 10)
-
- ;; do the processing here
- (set! table (gnc:html-build-acct-table
- #f date-tp
- tree-depth show-subaccts? accounts
- 10 80
- #t
- #t gnc:accounts-get-comm-total-assets
- (_ "Total") do-grouping?
- show-parent-balance? show-parent-total?
- show-fcur? report-currency exchange-fn #t))
-
- ;; add the table
- (gnc:report-percent-done 90)
- (gnc:html-document-add-object! doc table)
-
+ doc (string-append company-name " " report-title " "
+ (gnc:print-date date-tp))
+ )
+
+ (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* (
+ (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
+ (get-total-balance-fn
+ (lambda (account)
+ (gnc:account-get-comm-balance-at-date
+ account date-tp #f)))
+ (table-env ;; parameters for :make-
+ (list
+ (list 'start-date #f)
+ (list 'end-date date-tp)
+ (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))
+ )
+ )
+ (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 'income)
+ (assoc-ref split-up-accounts 'expense)
+ (assoc-ref split-up-accounts 'asset)
+ (assoc-ref split-up-accounts 'liability)
+ (assoc-ref split-up-accounts '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 (N_ "Code")) '())
+ (if show-account-type? (list (N_ "Type")) '())
+ (if show-account-desc? (list (N_ "Description")) '())
+ (list (N_ "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!
+ build-table 0 (+ cur-col account-cols) (N_ "Balance"))
+ )
+ (let ((row 0))
+ (while (< row table-rows)
+ (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!
+ build-table 0 cur-col (N_ "Notes"))
+ (add-col 'account-notes)
+ )
+ )
+
+ (gnc:html-document-add-object! doc build-table)
+
;; add currency information
(if show-rates?
(gnc:html-document-add-object!
doc ;;(gnc:html-markup-p
(gnc:html-make-exchangerates
- report-currency exchange-fn
- (append-map
+ report-commodity exchange-fn
+ (append-map
(lambda (a)
(gnc:group-get-subaccounts
(gnc:account-get-children a)))
- accounts)))))
-
- ;; error condition: no accounts specified
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
-
+ accounts))))
+ )
+ )
+
(gnc:report-finished)
- doc))
+ doc)
+ )
(gnc:define-report
- 'version 1
+ 'version 2
'name reportname
'options-generator accsum-options-generator
'renderer accsum-renderer)
+
+;; END
+
More information about the gnucash-changes
mailing list