[Gnucash-changes] David Montenegro's patch to fix the pnl (income
statement) #105330.
Derek Atkins
warlord at cvs.gnucash.org
Wed Jul 14 14:49:52 EDT 2004
Log Message:
-----------
David Montenegro's patch to fix the pnl (income statement) #105330.
* src/report/standard-reports/income-statement.scm:
src/report/standard-reports/pnl.scm:
src/report/standard-reports/standard-reports.scm:
src/report/standard-reports/Makefile.am:
Rewrote pnl.scm, renamed it to income-statement.scm.
Can now create a meaningful statement post-closing.
* src/report/report-system/html-acct-table.scm:
Updated to include ability to "see through" closing
and/or adjusting entries.
* Fixes #105330.
Modified Files:
--------------
gnucash:
ChangeLog
gnucash/src/report/report-system:
html-acct-table.scm
gnucash/src/report/standard-reports:
Makefile.am
standard-reports.scm
Added Files:
-----------
gnucash/src/report/standard-reports:
income-statement.scm
Removed Files:
-------------
gnucash/src/report/standard-reports:
pnl.scm
Revision Data
-------------
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1826
retrieving revision 1.1827
diff -LChangeLog -LChangeLog -u -r1.1826 -r1.1827
--- ChangeLog
+++ ChangeLog
@@ -18,6 +18,19 @@
* Fixes #144268
+ * src/report/standard-reports/income-statement.scm:
+ src/report/standard-reports/pnl.scm:
+ src/report/standard-reports/standard-reports.scm:
+ src/report/standard-reports/Makefile.am:
+ Rewrote pnl.scm, renamed it to income-statement.scm.
+ Can now create a meaningful statement post-closing.
+
+ * src/report/report-system/html-acct-table.scm:
+ Updated to include ability to "see through" closing
+ and/or adjusting entries.
+
+ * Fixes #105330.
+
2004-07-13 David Montenegro <sunrise2000 at comcast.net>
* src/report/standard-reports/trial-balance.scm:
Index: html-acct-table.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-acct-table.scm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lsrc/report/report-system/html-acct-table.scm -Lsrc/report/report-system/html-acct-table.scm -u -r1.2 -r1.3
--- src/report/report-system/html-acct-table.scm
+++ src/report/report-system/html-acct-table.scm
@@ -171,6 +171,27 @@
;; account having a balance of zero. otherwise, a row will be
;; generated for the account.
;;
+;; balance-mode: 'pre-adjusting 'pre-closing 'post-closing
+;;
+;; indicates whether or not to ignore adjusting/closing
+;; entries when computing account balances. 'pre-closing
+;; ignores only closing entries. 'pre-adjusting also ignores
+;; adjusting entries. 'post-closing counts all entries.
+;;
+;; adjusting-pattern: alist of 'str 'cased 'regexp
+;;
+;; a pattern alist, as accepted by
+;; gnc:account-get-trans-type-balance-interval, matching
+;; adjusting transactions to be ignored when balance-mode is
+;; 'pre-adjusting.
+;;
+;; closing-pattern: alist of 'str 'cased 'regexp
+;;
+;; a pattern alist, as accepted by
+;; gnc:account-get-trans-type-balance-interval, matching
+;; closing transactions to be ignored when balance-mode is
+;; 'pre-closing.
+;;
;; account-type: unimplemented
;; account-class: unimplemented
;; row-thunk: unimplemented (for gnc:html-acct-table-render)
@@ -507,6 +528,21 @@
'show-leaf-acct)
))
(label-mode (or (get-val env 'account-label-mode) 'anchor))
+ (balance-mode (or (get-val env 'balance-mode) 'post-closing))
+ (closing-pattern (or (get-val env 'closing-pattern)
+ (list
+ (list 'str (N_ "Closing Entries"))
+ (list 'cased #f)
+ (list 'regexp #f)
+ )
+ ))
+ (adjusting-pattern (or (get-val env 'adjusting-pattern)
+ (list
+ (list 'str (N_ "Adjusting Entries"))
+ (list 'cased #f)
+ (list 'regexp #f)
+ )
+ ))
;; local variables
(toplvl-accts (gnc:group-get-account-list (gnc:get-current-group)))
(acct-depth-reached 0)
@@ -522,14 +558,45 @@
)
)
- ;; the following two functions were lifted directly
- ;; from html-utilities.scm
+ ;; the following function was adapted from html-utilities.scm
(define (my-get-balance-nosub account start-date end-date)
- (if start-date
- (gnc:account-get-comm-balance-interval
- account start-date end-date #f)
- (gnc:account-get-comm-balance-at-date
- account end-date #f)))
+ (let* ((post-closing-bal
+ (if start-date
+ (gnc:account-get-comm-balance-interval
+ account start-date end-date #f)
+ (gnc:account-get-comm-balance-at-date
+ account end-date #f)))
+ (closing (lambda(a)
+ (gnc:account-get-trans-type-balance-interval
+ (list account) closing-pattern
+ start-date end-date)
+ )
+ )
+ (adjusting (lambda(a)
+ (gnc:account-get-trans-type-balance-interval
+ (list account) adjusting-pattern
+ start-date end-date)
+ )
+ )
+ )
+ (or (and (equal? balance-mode 'post-closing) post-closing-bal)
+ (and (equal? balance-mode 'pre-closing)
+ (let* ((closing-amt (closing account))
+ )
+ (post-closing-bal 'minusmerge closing-amt #f)
+ post-closing-bal)
+ )
+ (and (equal? balance-mode 'pre-adjusting)
+ (let* ((closing-amt (closing account))
+ (adjusting-amt (adjusting account))
+ )
+ (post-closing-bal 'minusmerge closing-amt #f)
+ (post-closing-bal 'minusmerge adjusting-amt #f)
+ post-closing-bal)
+ )
+ )
+ )
+ )
;; Additional function that includes the subaccounts as
;; well. Note: It is necessary to define this here (instead of
--- src/report/standard-reports/pnl.scm
+++ /dev/null
@@ -1,257 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; pnl.scm : profit-and-loss report
-;;
-;; By Christian Stimming <stimming at tu-harburg.de>
-;;
-;; 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
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
-;; Boston, MA 02111-1307, USA gnu at gnu.org
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; FIXME
-;;
-;; Note: the current P&L report must be done before closing, when
-;; there are still balances in your income/expense accounts. if run
-;; post-closing, this implementation will report zero profit. in
-;; other words, users will generally want to run this report after
-;; adjustments but before closing. this code really should filter-out
-;; closing (but not adjusting) entries and report on what is left....
-;;
-;; (see equity-statement.scm for an example of how to do this)
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(define-module (gnucash report pnl))
-
-(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
-(use-modules (srfi srfi-1))
-(use-modules (ice-9 slib))
-(use-modules (gnucash gnc-module))
-
-(require 'printf)
-
-(gnc:module-load "gnucash/report/report-system" 0)
-
-;; Profit and loss report. Actually, people in finances might want
-;; something different under this name, but they are welcomed to
-;; contribute their changes :-) (perhaps income statement)
-
-(define reportname (N_ "Profit And Loss"))
-
-;; define all option's names so that they are properly defined
-;; in *one* place.
-(define optname-from-date (N_ "From"))
-(define optname-to-date (N_ "To"))
-
-(define optname-display-depth (N_ "Account Display Depth"))
-(define optname-show-subaccounts (N_ "Always show sub-accounts"))
-(define optname-accounts (N_ "Account"))
-
-(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 optname-report-currency (N_ "Report's currency"))
-(define optname-price-source (N_ "Price Source"))
-(define optname-show-rates (N_ "Show Exchange Rates"))
-(define optname-show-zeros (N_ "Show accounts with a 0.0 total"))
-
-;; options generator
-(define (pnl-options-generator)
- (let ((options (gnc:new-options)))
-
- ;; date at which to report balance
- (gnc:options-add-date-interval!
- options gnc:pagename-general
- optname-from-date optname-to-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)
-
- ;; accounts to work on
- (gnc:options-add-account-selection!
- options gnc:pagename-accounts
- optname-display-depth optname-show-subaccounts
- optname-accounts "a" 2
- (lambda ()
- (filter
- gnc:account-is-inc-exp?
- (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)
-
- ;; what to show about non-leaf accounts
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-display 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
- gnc:pagename-display optname-show-parent-total
- "d" (N_ "Show subtotals for parent accounts") #t))
-
- (gnc:register-option
- options
- (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:make-simple-boolean-option
- gnc:pagename-display optname-show-rates
- "f" (N_ "Show the exchange rates used") #t))
-
- (gnc:register-option
- options
- (gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-zeros
- "g" (N_ "Show account with 0.0 balance") #t))
-
- ;; Set the general page as default option tab
- (gnc:options-set-default-section options gnc:pagename-general)
-
- options))
-
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; pnl-renderer
-;; set up the document and add the table
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define (pnl-renderer report-obj)
- (define (get-option pagename optname)
- (gnc:option-value
- (gnc:lookup-option
- (gnc:report-options report-obj) pagename optname)))
-
- (gnc:report-starting reportname)
-
- ;; get all option's values
- (let* ((display-depth (get-option gnc:pagename-accounts
- optname-display-depth))
- (show-subaccts? (get-option gnc:pagename-accounts
- optname-show-subaccounts))
- (accounts (filter gnc:account-is-inc-exp?
- (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))
- (show-zeros? (get-option gnc:pagename-display
- optname-show-zeros))
- (to-date-tp (gnc:timepair-end-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-to-date))))
- (from-date-tp (gnc:timepair-start-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-from-date))))
- (report-title (sprintf #f
- (_ "%s - %s to %s")
- (get-option gnc:pagename-general gnc:optname-reportname)
- (gnc:print-date from-date-tp)
- (gnc:print-date to-date-tp)))
- (doc (gnc:make-html-document)))
-
- (gnc:html-document-set-title!
- doc report-title)
- (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))
-
- ;; calculate the exchange rates
- (gnc:report-percent-done 1)
- (set! exchange-fn (gnc:case-exchange-fn
- price-source report-currency to-date-tp))
- (gnc:report-percent-done 10)
-
- ;; do the processing here
- (set! table (gnc:html-build-acct-table
- from-date-tp to-date-tp
- tree-depth show-subaccts? accounts 10 80 #f
- #t gnc:accounts-get-comm-total-profit
- (_ "Profit") do-grouping?
- show-parent-balance? show-parent-total?
- show-fcur? report-currency exchange-fn show-zeros?))
- ;; add the table
- (gnc:html-document-add-object! doc 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
- (lambda (a)
- (gnc:group-get-subaccounts
- (gnc:account-get-children a)))
- accounts))))
- (gnc:report-percent-done 100))
-
- ;; error condition: no accounts specified
-
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
- (gnc:report-finished)
- doc))
-
-(gnc:define-report
- 'version 1
- 'name reportname
- 'menu-name (N_ "Profit & Loss")
- 'menu-path (list gnc:menuname-income-expense)
- 'options-generator pnl-options-generator
- 'renderer pnl-renderer)
Index: standard-reports.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/standard-reports.scm,v
retrieving revision 1.18
retrieving revision 1.19
diff -Lsrc/report/standard-reports/standard-reports.scm -Lsrc/report/standard-reports/standard-reports.scm -u -r1.18 -r1.19
--- src/report/standard-reports/standard-reports.scm
+++ src/report/standard-reports/standard-reports.scm
@@ -77,7 +77,7 @@
(use-modules (gnucash report category-barchart))
(use-modules (gnucash report daily-reports))
(use-modules (gnucash report net-barchart))
-(use-modules (gnucash report pnl))
+(use-modules (gnucash report income-statement))
(use-modules (gnucash report portfolio))
(use-modules (gnucash report price-scatter))
(use-modules (gnucash report register))
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/Makefile.am,v
retrieving revision 1.17
retrieving revision 1.18
diff -Lsrc/report/standard-reports/Makefile.am -Lsrc/report/standard-reports/Makefile.am -u -r1.17 -r1.18
--- src/report/standard-reports/Makefile.am
+++ src/report/standard-reports/Makefile.am
@@ -32,7 +32,7 @@
daily-reports.scm \
equity-statement.scm \
net-barchart.scm \
- pnl.scm \
+ income-statement.scm \
portfolio.scm \
price-scatter.scm \
register.scm \
--- /dev/null
+++ src/report/standard-reports/income-statement.scm
@@ -0,0 +1,688 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; income-statement.scm: income statement (a.k.a. Profit & Loss)
+;;
+;; By David Montenegro <sunrise2000 at comcast.net>
+;; 2004.07.13 - 2004.07.14
+;;
+;; * BUGS:
+;;
+;; This code makes the assumption that you want your income
+;; statement to no more than daily resolution.
+;;
+;; The Company Name field does not currently default to the name
+;; in (gnc:get-current-book).
+;;
+;; Line & column alignments may still not conform with
+;; textbook accounting practice (they're close though!).
+;; The 'canonically-tabbed option is currently broken.
+;;
+;; Progress bar functionality is currently mostly broken.
+;;
+;; 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
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
+;; Boston, MA 02111-1307, USA gnu at gnu.org
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-module (gnucash report income-statement))
+(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (ice-9 slib))
+(use-modules (gnucash gnc-module))
+
+(gnc:module-load "gnucash/report/report-system" 0)
+
+(define reportname (N_ "Income Statement"))
+
+;; define all option's names and help text so that they are properly
+;; defined in *one* place.
+(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-start-date (N_ "Income Statement Start Date"))
+(define opthelp-start-date
+ (N_ "Start of the period this income statement will cover"))
+(define optname-end-date (N_ "Income Statement End Date"))
+(define opthelp-end-date
+ (N_ "End of the period this income statement will cover"))
+;; FIXME this could use an indent option
+
+(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_ "Flatten list to depth limit"))
+(define opthelp-bottom-behavior
+ (N_ "Displays accounts which exceed the depth limit at the depth limit"))
+
+(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-label-revenue (N_ "Label the revenue section"))
+(define opthelp-label-revenue
+ (N_ "Whether or not to include a label for the revenue section"))
+(define optname-total-revenue (N_ "Include revenue total"))
+(define opthelp-total-revenue
+ (N_ "Whether or not to include a line indicating total revenue"))
+(define optname-label-expense (N_ "Label the expense section"))
+(define opthelp-label-expense
+ (N_ "Whether or not to include a label for the expense section"))
+(define optname-total-expense (N_ "Include expense total"))
+(define opthelp-total-expense
+ (N_ "Whether or not to include a line indicating total expense"))
+
+(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"))
+
+(define pagename-entries (N_ "Entries"))
+(define optname-closing-pattern (N_ "Closing Entries pattern"))
+(define opthelp-closing-pattern
+ (N_ "Any text in the Description column which identifies closing entries"))
+(define optname-closing-casing
+ (N_ "Closing Entries pattern is case-sensitive"))
+(define opthelp-closing-casing
+ (N_ "Causes the Closing Entries Pattern match to be case-sensitive"))
+(define optname-closing-regexp
+ (N_ "Closing Entries Pattern is regular expression"))
+(define opthelp-closing-regexp
+ (N_ "Causes the Closing Entries Pattern to be treated as a regular expression"))
+
+;; This calculates the increase in the balance(s) of all accounts in
+;; <accountlist> over the period from <from-date> to <to-date>.
+;; Returns a commodity collector.
+;;
+;; Note: There is both a gnc:account-get-comm-balance-interval and
+;; gnc:group-get-comm-balance-interval which could replace this
+;; function....
+;;
+(define (accountlist-get-comm-balance-at-date accountlist from-date to-date)
+;; (for-each (lambda (x) (display x))
+;; (list "computing from: " (gnc:print-date from-date) " to "
+;; (gnc:print-date to-date) "\n"))
+ (let ((collector (gnc:make-commodity-collector)))
+ (for-each (lambda (account)
+ (let* (
+ (start-balance
+ (gnc:account-get-comm-balance-at-date
+ account from-date #f))
+ (sb (cadr (start-balance
+ 'getpair
+ (gnc:account-get-commodity account)
+ #f)))
+ (end-balance
+ (gnc:account-get-comm-balance-at-date
+ account to-date #f))
+ (eb (cadr (end-balance
+ 'getpair
+ (gnc:account-get-commodity account)
+ #f)))
+ )
+;; (for-each (lambda (x) (display x))
+;; (list "Start balance: " sb " : "
+;; (gnc:account-get-name account) " : end balance: "
+;; eb "\n"))
+ (collector 'merge end-balance #f)
+ (collector 'minusmerge start-balance #f)
+ ))
+ accountlist)
+ collector))
+
+;; options generator
+(define (income-statement-options-generator)
+ (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??
+ ;; (GnuCash is *so* well documented... sigh)
+
+ ;; period over which to report income
+ (gnc:options-add-date-interval!
+ options gnc:pagename-general
+ optname-start-date optname-end-date "c")
+
+ ;; accounts to work on
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "a"
+ opthelp-accounts
+ (lambda ()
+ (gnc:filter-accountlist-type
+ ;; select, by default, only income and expense accounts
+ '(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-simple-boolean-option
+ gnc:pagename-accounts optname-bottom-behavior
+ "c" opthelp-bottom-behavior #f))
+
+ ;; all about currencies
+ (gnc:options-add-currency!
+ options pagename-commodities
+ optname-report-commodity "a")
+
+ (gnc:options-add-price-source!
+ options pagename-commodities
+ optname-price-source "b" 'weighted-average)
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-foreign
+ "c" opthelp-show-foreign #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-rates
+ "d" opthelp-show-rates #f))
+
+ ;; what to show for zero-balance accounts
+ (add-option
+ (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-label-revenue
+ "g" opthelp-label-revenue #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-total-revenue
+ "h" opthelp-total-revenue #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-label-expense
+ "i" opthelp-label-expense #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-total-expense
+ "j" opthelp-total-expense #t))
+
+ ;; closing entry match criteria
+ ;;
+ ;; N.B.: transactions really should have a field where we can put
+ ;; transaction types like "Adjusting/Closing/Correcting Entries"
+ (add-option
+ (gnc:make-string-option
+ pagename-entries optname-closing-pattern
+ "a" opthelp-closing-pattern (N_ "Closing Entries")))
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-entries optname-closing-casing
+ "b" opthelp-closing-casing #f))
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-entries optname-closing-regexp
+ "c" opthelp-closing-regexp #f))
+
+ ;; Set the accounts page as default option tab
+ (gnc:options-set-default-section options gnc:pagename-accounts)
+
+ options))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; income-statement-renderer
+;; set up the document and add the table
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (income-statement-renderer report-obj)
+ (define (get-option pagename optname)
+ (gnc:option-value
+ (gnc:lookup-option
+ (gnc:report-options report-obj) pagename optname)))
+
+ (gnc:report-starting reportname)
+
+ ;; get all option's values
+ (let* (
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (get-option gnc:pagename-general optname-party-name))
+ (start-date-printable (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-start-date)))
+ (start-date-tp (gnc:timepair-start-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-start-date))))
+ (end-date-tp (gnc:timepair-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-end-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))
+ (label-revenue? (get-option gnc:pagename-display
+ optname-label-revenue))
+ (total-revenue? (get-option gnc:pagename-display
+ optname-total-revenue))
+ (label-expense? (get-option gnc:pagename-display
+ optname-label-expense))
+ (total-expense? (get-option gnc:pagename-display
+ optname-total-expense))
+ (use-links? (get-option gnc:pagename-display
+ optname-account-links))
+ (use-rules? (get-option gnc:pagename-display
+ optname-use-rules))
+ (closing-str (get-option pagename-entries
+ optname-closing-pattern))
+ (closing-cased (get-option pagename-entries
+ optname-closing-casing))
+ (closing-regexp (get-option pagename-entries
+ optname-closing-regexp))
+ (closing-pattern
+ (list (list 'str closing-str)
+ (list 'cased closing-cased)
+ (list 'regexp closing-regexp)
+ )
+ )
+ (indent 0)
+ (tabbing #f)
+
+ ;; decompose the account list
+ (split-up-accounts (gnc:decompose-accountlist accounts))
+ (revenue-accounts (assoc-ref split-up-accounts 'income))
+ (expense-accounts (assoc-ref split-up-accounts 'expense))
+ (income-expense-accounts
+ (append (assoc-ref split-up-accounts 'income)
+ (assoc-ref split-up-accounts 'expense)))
+
+ (doc (gnc:make-html-document))
+ ;; this can occasionally put extra (blank) columns in our
+ ;; table (when there is one account at the maximum depth and
+ ;; it has at least one of its ancestors deselected), but this
+ ;; is the only simple way to ensure that both tables
+ ;; (revenue, expense) have the same width.
+ (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 end-date-tp))
+ )
+
+ ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
+ ;; with the proper arguments.
+ (define (add-subtotal-line table pos-label neg-label signed-balance)
+ (define allow-same-column-totals #t)
+ (let* ((neg? (and signed-balance
+ neg-label
+ (gnc:numeric-negative-p
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ signed-balance report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (balance (if neg?
+ (let ((bal (gnc:make-commodity-collector)))
+ (bal 'minusmerge signed-balance #f)
+ bal)
+ signed-balance))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ table
+ (+ indent (* tree-depth 2)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))
+ "primary-subheading"
+ (and (not allow-same-column-totals) balance use-rules?)
+ label indent 1 "total-label-cell"
+ (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+ (+ indent (* tree-depth 2) (- 0 1)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))
+ 1 "total-number-cell")
+ )
+ )
+
+ ;; wrapper around gnc:html-table-append-ruler!
+ (define (add-rule table)
+ (gnc:html-table-append-ruler!
+ table
+ (+ (* 2 tree-depth)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))))
+
+ (gnc:html-document-set-title!
+ doc (sprintf #f
+ (string-append "%s %s "
+ (N_ "For Period Covering")
+ " %s "
+ (N_ "to")
+ " %s")
+ company-name report-title
+ (gnc:print-date start-date-printable)
+ (gnc:print-date end-date-tp)))
+
+ (if (null? accounts)
+
+ ;; error condition: no accounts specified
+ ;; is this *really* necessary??
+ ;; i'd be fine with an all-zero P&L
+ ;; that would, technically, be correct....
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj)))
+
+ ;; Get all the balances for each account group.
+ (let* ((revenue-closing #f)
+ (expense-closing #f)
+ (neg-revenue-total #f)
+ (revenue-total #f)
+ (expense-total #f)
+ (net-income #f)
+
+ ;; Create the account tables below where their
+ ;; percentage time can be tracked.
+ (build-table (gnc:make-html-table)) ;; gnc:html-table
+ (table-env #f) ;; parameters for :make-
+ (params #f) ;; and -add-account-
+ (revenue-table #f) ;; gnc:html-acct-table
+ (expense-table #f) ;; gnc:html-acct-table
+
+ (terse-period? #t)
+ (period-for (if terse-period?
+ (string-append " " (N_ "for Period"))
+ (string-append
+ ", "
+ (gnc:print-date start-date-printable) " "
+ (N_ "to") " "
+ (gnc:print-date end-date-tp)
+ )
+ )
+ )
+ )
+
+ ;; a helper to add a line to our report
+ (define (report-line
+ table pos-label neg-label amount col
+ exchange-fn rule? row-style)
+ (let* ((neg? (and amount
+ neg-label
+ (gnc:numeric-negative-p
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ amount report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (pos-bal (if neg?
+ (let ((bal (gnc:make-commodity-collector)))
+ (bal 'minusmerge amount #f)
+ bal)
+ amount))
+ (bal (gnc:sum-collector-commodity
+ pos-bal report-commodity exchange-fn))
+ (balance
+ (or (and (gnc:uniform-commodity? pos-bal report-commodity)
+ bal)
+ (and show-fucr?
+ (gnc:commodity-table
+ pos-bal report-commodity exchange-fn))
+ bal
+ ))
+ (column (or col 0))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ table (* 2 tree-depth) row-style rule?
+ label 0 1 "text-cell"
+ bal (+ col 1) 1 "number-cell")
+ )
+ )
+
+ ;; sum revenues and expenses
+ (set! revenue-closing
+ (gnc:account-get-trans-type-balance-interval
+ revenue-accounts closing-pattern
+ start-date-tp end-date-tp)
+ ) ;; this is norm positive (debit)
+ (set! expense-closing
+ (gnc:account-get-trans-type-balance-interval
+ expense-accounts closing-pattern
+ start-date-tp end-date-tp)
+ ) ;; this is norm negative (credit)
+ (set! expense-total
+ (accountlist-get-comm-balance-at-date
+ expense-accounts
+ start-date-tp end-date-tp))
+ (expense-total 'minusmerge expense-closing #f)
+ (set! neg-revenue-total
+ (accountlist-get-comm-balance-at-date
+ revenue-accounts
+ start-date-tp end-date-tp))
+ (neg-revenue-total 'minusmerge revenue-closing #f)
+ (set! revenue-total (gnc:make-commodity-collector))
+ (revenue-total 'minusmerge neg-revenue-total #f)
+ ;; calculate net income
+ (set! net-income (gnc:make-commodity-collector))
+ (net-income 'merge revenue-total #f)
+ (net-income 'minusmerge expense-total #f)
+
+ (set! table-env
+ (list
+ (list 'start-date start-date-tp)
+ (list 'end-date end-date-tp)
+ (list 'display-tree-depth tree-depth)
+ (list 'depth-limit-behavior (if bottom-behavior
+ 'flatten
+ 'summarize))
+ (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))
+ ;; we may, at some point, want to add an option to
+ ;; generate a pre-adjustment income statement...
+ (list 'balance-mode 'pre-closing)
+ (list 'closing-pattern closing-pattern)
+ )
+ )
+ (set! params
+ (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?)
+ )
+ )
+
+ ;; Workaround to force gtkhtml into displaying wide
+ ;; enough columns.
+ (let ((space
+ (make-list tree-depth " \
+ \
+ ")
+ ))
+ (gnc:html-table-append-row! build-table space)
+ )
+
+ (gnc:report-percent-done 80)
+ (if label-revenue?
+ (add-subtotal-line build-table (_ "Revenues") #f #f))
+ (set! revenue-table
+ (gnc:make-html-acct-table/env/accts
+ table-env revenue-accounts))
+ (gnc:html-table-add-account-balances
+ build-table revenue-table params)
+ (if total-revenue?
+ (add-subtotal-line
+ build-table (_ "Total Revenue") #f revenue-total))
+
+ (gnc:report-percent-done 85)
+ (if label-expense?
+ (add-subtotal-line
+ build-table (_ "Expenses") #f #f))
+ (set! expense-table
+ (gnc:make-html-acct-table/env/accts
+ table-env expense-accounts))
+ (gnc:html-table-add-account-balances
+ build-table expense-table params)
+ (if total-expense?
+ (add-subtotal-line
+ build-table (_ "Total Expenses") #f expense-total))
+
+ (report-line
+ build-table
+ (string-append (N_ "Net income") period-for)
+ (string-append (N_ "Net loss") period-for)
+ net-income
+ (* 2 (- tree-depth 1)) exchange-fn #f #f
+ )
+
+ (gnc:html-document-add-object! doc build-table)
+
+ ;; add currency information if requested
+ (gnc:report-percent-done 90)
+ (if show-rates?
+ (gnc:html-document-add-object!
+ doc ;;(gnc:html-markup-p)
+ (gnc:html-make-exchangerates
+ report-commodity exchange-fn accounts)))
+ (gnc:report-percent-done 100)
+
+ )
+ )
+
+ (gnc:report-finished)
+
+ doc
+ )
+ )
+
+(gnc:define-report
+ 'version 2 ;; but it doesn't matter... :)
+ 'name reportname
+ 'menu-path (list gnc:menuname-income-expense)
+ 'options-generator income-statement-options-generator
+ 'renderer income-statement-renderer
+ )
+
+;; END
+
More information about the gnucash-changes
mailing list