mirror of
https://github.com/Gnucash/gnucash.git
synced 2026-07-30 08:08:15 -05:00
* 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. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@10434 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
@@ -1,3 +1,15 @@
|
||||
2005-01-29 Derek Atkins <derek@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@tuhh.de>
|
||||
|
||||
* configure.in, src/tax/us/gncmod-tax-us.c,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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@comcast.net>
|
||||
;; same license & restrictions apply
|
||||
;;
|
||||
;; Copyright 2001 Christian Stimming <stimming@tu-harburg.de>
|
||||
;; Copyright 2000-2001 Bill Gribble <grib@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-report-title (N_ "Report Title"))
|
||||
(define opthelp-report-title (N_ "Title for this report"))
|
||||
|
||||
(define optname-party-name (N_ "Company name"))
|
||||
(define opthelp-party-name (N_ "Name of company/individual"))
|
||||
|
||||
(define optname-date (N_ "Date"))
|
||||
(define optname-display-depth (N_ "Account Display Depth"))
|
||||
(define opthelp-date (N_ "Account summary as-of date"))
|
||||
;; FIXME this needs an indent option
|
||||
|
||||
(define optname-show-foreign (N_ "Show Foreign Currencies/Shares of Stock"))
|
||||
(define optname-report-currency (N_ "Report's currency"))
|
||||
(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 pagename-commodities (N_ "Commodities"))
|
||||
(define optname-report-commodity (N_ "Report's currency"))
|
||||
(define optname-price-source (N_ "Price Source"))
|
||||
|
||||
(define optname-show-subaccounts (N_ "Always show sub-accounts"))
|
||||
(define optname-accounts (N_ "Accounts"))
|
||||
|
||||
(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 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")
|
||||
|
||||
;; all about currencies
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general
|
||||
optname-report-currency "b")
|
||||
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "c" 'weighted-average)
|
||||
(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
|
||||
(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)
|
||||
(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"))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;; with or without grouping
|
||||
(gnc:options-add-group-accounts!
|
||||
options gnc:pagename-display optname-group-accounts "b" #t)
|
||||
;; all about currencies
|
||||
(gnc:options-add-currency!
|
||||
options pagename-commodities
|
||||
optname-report-commodity "a")
|
||||
|
||||
;; new options here
|
||||
(gnc:register-option
|
||||
options
|
||||
(gnc:options-add-price-source!
|
||||
options pagename-commodities
|
||||
optname-price-source "b" 'weighted-average)
|
||||
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-balance
|
||||
"c" (N_ "Show balances for parent accounts") #t))
|
||||
|
||||
(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-parent-total
|
||||
"d" (N_ "Show subtotals for parent accounts") #t))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
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-foreign
|
||||
"e" (N_ "Display the account's foreign currency amount?") #f))
|
||||
|
||||
(gnc:register-option
|
||||
options
|
||||
gnc:pagename-display optname-show-zb-accts
|
||||
"a" opthelp-show-zb-accts #t))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-rates
|
||||
"f" (N_ "Show the exchange rates used") #t))
|
||||
|
||||
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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user