IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Budget report improvements.

Browse Source 
* Moves budget-related reports to a "Budget" sub-menu.
* Implements a Budget Balance Sheet report.  This is a projected future balance
  sheet using budget data.
* Adds Budget Income Statement and Budget Profit & Loss reports.  These are
  projected future IS/PNL reports using budget data.

Patch by Forest Bond.

git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@17829 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Andreas Köhler 2009-01-18 17:19:08 +00:00
parent d56a868a42
commit 3558853ed5
14 changed files with 1765 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
AUTHORS
View File

@ -111,6 +111,7 @@ Dennis Björklund <dennisb@cs.chalmers.se> Swedish translation
Andreas Bogk <andreas@andreas.org> Postgres backend patch
Per Bojsen <bojsen@worldnet.att.net> several core dump fixes
Terry Boldt <tboldt@attglobal.net> financial calculator and expression parser
Forest Bond <forest@alittletooquiet.net> Budget report improvements
Richard Braakman <dark@xs4all.nl> xml version configure patch
Simon Britnell <simon.britnell@peace.com> patch to RPM spec
Christopher B. Browne <cbbrowne@hex.net> for perl, lots of scheme and documentation updates

3
src/report/report-gnome/report-gnome.scm
View File

@ -101,6 +101,8 @@
(gnc:make-menu gnc:menuname-asset-liability (list gnc:menuname-reports)))
(define income-expense-menu
(gnc:make-menu gnc:menuname-income-expense (list gnc:menuname-reports)))
(define budget-menu
(gnc:make-menu gnc:menuname-budget (list gnc:menuname-reports)))
(define utility-menu
(gnc:make-menu gnc:menuname-utility (list gnc:menuname-reports)))
(define custom-menu
@ -111,6 +113,7 @@
;; (gnc-add-scm-extension tax-menu)
(gnc-add-scm-extension income-expense-menu)
(gnc-add-scm-extension asset-liability-menu)
(gnc-add-scm-extension budget-menu)
(gnc-add-scm-extension utility-menu)
(gnc-add-scm-extension custom-menu)

7
src/report/report-system/html-acct-table.scm
View File

@ -601,6 +601,7 @@
;; someone was thinking price-source?
(exchange-fn (or (get-val env 'exchange-fn)
#f))
(get-balance-fn (or (get-val env 'get-balance-fn) #f))
;;'weighted-average))
(column-header (let ((cell (get-val env 'column-header)))
(if (equal? cell #t)
@ -688,14 +689,14 @@
)
;; helper to calculate the balances for all required accounts
(define (calculate-balances accts start-date end-date)
(define (calculate-balances accts start-date end-date get-balance-fn)
(define (calculate-balances-helper accts start-date end-date acct-balances)
(if (not (null? accts))
(begin
;; using the existing function that cares about balance-mode
;; maybe this should get replaces at some point.
(hash-set! acct-balances (gncAccountGetGUID (car accts))
(get-balance-nosub-mode (car accts) start-date end-date))
(get-balance-fn (car accts) start-date end-date))
(calculate-balances-helper (cdr accts) start-date end-date acct-balances)
)
acct-balances)
@ -899,7 +900,7 @@
) ;; end of definition of traverse-accounts!
;; do it
(traverse-accounts! toplvl-accts 0 0 (calculate-balances accounts start-date end-date))
(traverse-accounts! toplvl-accts 0 0 (calculate-balances accounts start-date end-date (or get-balance-fn get-balance-nosub-mode)))
;; set the column-header colspan
(if gnc:colspans-are-working-right

13
src/report/report-system/report-system.scm
View File

@ -96,7 +96,8 @@
;; report.scm
(export gnc:menuname-reports)
(export gnc:menuname-asset-liability)
(export gnc:menuname-income-expense )
(export gnc:menuname-income-expense)
(export gnc:menuname-budget)
(export gnc:menuname-taxes)
(export gnc:menuname-utility)
(export gnc:menuname-custom)
@ -634,6 +635,8 @@
(export gnc:make-value-collector)
(export gnc:make-numeric-collector)
(export gnc:make-commodity-collector)
(export gnc:commodity-collector-get-negated)
(export gnc:commodity-collectorlist-get-merged)
(export gnc-commodity-collector-commodity-count)
(export gnc:account-get-balance-at-date)
(export gnc:account-get-comm-balance-at-date)
@ -660,6 +663,14 @@
(export gnc:account-get-trans-type-balance-interval)
(export gnc:account-get-pos-trans-total-interval)
(export gnc:double-col)
(export gnc:budget-get-start-date)
(export gnc:budget-account-get-net)
(export gnc:budget-accountlist-get-net)
(export gnc:budget-account-get-initial-balance)
(export gnc:budget-accountlist-get-initial-balance)
(export gnc:get-assoc-account-balances)
(export gnc:select-assoc-account-balance)
(export gnc:get-assoc-account-balances-total)
(load-from-path "commodity-utilities.scm")
(load-from-path "html-barchart.scm")

119
src/report/report-system/report-utilities.scm
View File

@ -408,6 +408,17 @@
((list) commoditylist) ; this one is only for internal use
(else (gnc:warn "bad commodity-collector action: " action))))))
(define (gnc:commodity-collector-get-negated collector)
(let
((negated (gnc:make-commodity-collector)))
(negated 'minusmerge collector #f)
negated))
(define (gnc:commodity-collectorlist-get-merged collectorlist)
(let
((merged (gnc:make-commodity-collector)))
(for-each (lambda (collector) (merged 'merge collector #f)) collectorlist)
merged))
;; Bah. Let's get back to normal data types -- this procedure thingy
;; from above makes every code almost unreadable. First step: replace
@ -855,3 +866,111 @@
)
)
;; Returns the start date of the first period (period 0) of the budget.
(define (gnc:budget-get-start-date budget)
(gnc-budget-get-period-start-date budget 0))
(define (gnc:budget-accountlist-helper accountlist get-fn)
(let
(
(net (gnc:make-commodity-collector)))
(for-each
(lambda (account)
(net 'merge
(get-fn account)
#f))
accountlist)
net))
;; Sums budget values for a single account from start-period (inclusive) to
;; end-period (exclusive).
;;
;; start-period may be #f to specify the start of the budget
;; end-period may be #f to specify the end of the budget
;;
;; Returns a commodity-collector.
(define (gnc:budget-account-get-net budget account start-period end-period)
(if (not start-period) (set! start-period 0))
(if (not end-period) (set! end-period (gnc-budget-get-num-periods budget)))
(let*
(
(period start-period)
(net (gnc:make-commodity-collector))
(acct-comm (xaccAccountGetCommodity account)))
(while (< period end-period)
(net 'add acct-comm
(gnc-budget-get-account-period-value budget account period))
(set! period (+ period 1)))
net))
;; Sums budget values for accounts in accountlist from start-period (inclusive)
;; to end-period (exclusive).
;;
;; Note that budget values are never sign-reversed, so accountlist should
;; contain only income accounts, only expense accounts, etc. It would not be
;; meaningful to include both income and expense accounts, or both asset and
;; liability accounts.
;;
;; start-period may be #f to specify the start of the budget
;; end-period may be #f to specify the end of the budget
;;
;; Returns a commodity-collector.
(define (gnc:budget-accountlist-get-net budget accountlist start-period end-period)
(gnc:budget-accountlist-helper accountlist (lambda (account)
(gnc:budget-account-get-net budget account start-period end-period))))
;; Finds the balance for an account at the start date of the budget. The
;; resulting balance is not sign-adjusted.
;;
;; Returns a commodity-collector.
(define (gnc:budget-account-get-initial-balance budget account)
(gnc:account-get-comm-balance-at-date
account
(gnc:budget-get-start-date budget)
#f))
;; Sums the balances of all accounts in accountlist at the start date of the
;; budget. The resulting balance is not sign-adjusted.
;;
;; Returns a commodity-collector.
(define (gnc:budget-accountlist-get-initial-balance budget accountlist)
(gnc:budget-accountlist-helper accountlist (lambda (account)
(gnc:budget-account-get-initial-balance budget account))))
(define (gnc:get-assoc-account-balances accounts get-balance-fn)
(let*
(
(initial-balances (list)))
(for-each
(lambda (account)
(set! initial-balances
(append initial-balances
(list (list account (get-balance-fn account))))))
accounts)
initial-balances))
(define (gnc:select-assoc-account-balance account-balances account)
(let*
(
(account-balance (car account-balances))
(result
(if
(equal? account-balance '())
#f
(if
(equal? (car account-balance) account)
(car (cdr account-balance))
(gnc:select-assoc-account-balance
(cdr account-balances)
account)))))
result))
(define (gnc:get-assoc-account-balances-total account-balances)
(let
(
(total (gnc:make-commodity-collector)))
(for-each
(lambda (account-balance)
(total 'merge (car (cdr account-balance)) #f))
account-balances)
total))

1
src/report/report-system/report.scm
View File

@ -35,6 +35,7 @@
(define gnc:menuname-reports "Reports/StandardReports")
(define gnc:menuname-asset-liability (N_ "_Assets & Liabilities"))
(define gnc:menuname-income-expense (N_ "_Income & Expense"))
(define gnc:menuname-budget (N_ "B_udget"))
(define gnc:menuname-taxes (N_ "_Taxes"))
(define gnc:menuname-utility (N_ "_Sample & Custom"))
(define gnc:menuname-custom (N_ "_Custom"))

4
src/report/standard-reports/Makefile.am
View File

@ -24,10 +24,12 @@ gncscmmod_DATA = \
advanced-portfolio.scm \
average-balance.scm \
balance-sheet.scm \
cash-flow.scm \
budget.scm \
budget-balance-sheet.scm \
budget-barchart.scm \
budget-flow.scm \
budget-income-statement.scm \
cash-flow.scm \
category-barchart.scm \
daily-reports.scm \
equity-statement.scm \

938
src/report/standard-reports/budget-balance-sheet.scm Normal file
View File

@ -0,0 +1,938 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-balance-sheet.scm: balance sheet from budget projections
;; Based on balance-sheet.scm.
;;
;; Copyright (c) the following:
;;
;; Forest Bond <forest@alittletooquiet.net>
;; Robert Merkel <rgmerk@mira.net>
;; David Montenegro <sunrise2000@comcast.net>
;; Christian Stimming <stimming@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
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report budget-balance-sheet))
(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_ "Budget Balance Sheet"))
;; 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-report-form (N_ "Single column Balance Sheet"))
(define opthelp-report-form
(N_ "Print liability/equity section in the same column under the assets section as opposed to a second column right of the assets section"))
;; FIXME this needs 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 optname-parent-total-mode (N_ "Parent account subtotals"))
(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-assets (N_ "Label the assets section"))
(define opthelp-label-assets
(N_ "Whether or not to include a label for the assets section"))
(define optname-total-assets (N_ "Include assets total"))
(define opthelp-total-assets
(N_ "Whether or not to include a line indicating total assets"))
(define optname-label-liabilities (N_ "Label the liabilities section"))
(define opthelp-label-liabilities
(N_ "Whether or not to include a label for the liabilities section"))
(define optname-total-liabilities (N_ "Include liabilities total"))
(define opthelp-total-liabilities
(N_ "Whether or not to include a line indicating total liabilities"))
(define optname-label-equity (N_ "Label the equity section"))
(define opthelp-label-equity
(N_ "Whether or not to include a label for the equity section"))
(define optname-total-equity (N_ "Include equity total"))
(define opthelp-total-equity
(N_ "Whether or not to include a line indicating total equity"))
(define optname-new-existing (N_ "Include new/existing totals"))
(define opthelp-new-existing
(N_ "Whether or not to include lines indicating change in totals introduced by budget"))
(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 optname-budget (N_ "Budget"))
(define opthelp-budget (N_ "Budget to use."))
;; options generator
(define (budget-balance-sheet-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 ""))
;; 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)
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-general optname-report-form
"c" opthelp-report-form #t))
(add-option
(gnc:make-budget-option
gnc:pagename-general optname-budget
"d" opthelp-budget))
;; accounts to work on
(add-option
(gnc:make-account-list-option
gnc:pagename-accounts optname-accounts
"a"
opthelp-accounts
(lambda ()
(gnc:filter-accountlist-type
(list ACCT-TYPE-BANK ACCT-TYPE-CASH ACCT-TYPE-CREDIT
ACCT-TYPE-ASSET ACCT-TYPE-LIABILITY
ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL ACCT-TYPE-CURRENCY
ACCT-TYPE-PAYABLE ACCT-TYPE-RECEIVABLE
ACCT-TYPE-EQUITY ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#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" 'average-cost)
(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
(gnc:options-add-subtotal-view!
options gnc:pagename-display
optname-parent-balance-mode optname-parent-total-mode
"c")
;; some detailed formatting options
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-account-links
"d" opthelp-account-links #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-use-rules
"e" opthelp-use-rules #f))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-assets
"f" opthelp-label-assets #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-assets
"g" opthelp-total-assets #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-liabilities
"h" opthelp-label-liabilities #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-liabilities
"i" opthelp-total-liabilities #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-equity
"j" opthelp-label-equity #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-equity
"k" opthelp-total-equity #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-new-existing
"l" opthelp-new-existing #t))
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-balance-sheet-renderer
;; set up the document and add the table
;; then return the document or, if
;; requested, export it to a file
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (budget-balance-sheet-renderer report-obj choice filename)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(define (get-budget-account-budget-balance budget account)
(gnc:budget-account-get-net budget account #f #f))
(define (get-budget-account-budget-balance-negated budget account)
(gnc:commodity-collector-get-negated
(get-budget-account-budget-balance budget account)))
(define (get-budget-account-initial-balance budget account)
(gnc:budget-account-get-initial-balance budget account))
(define (get-budget-account-initial-balance-negated budget account)
(gnc:commodity-collector-get-negated
(get-budget-account-initial-balance budget account)))
(define (get-budget-accountlist-budget-balance budget accountlist)
(gnc:budget-accountlist-get-net budget accountlist #f #f))
(define (get-assoc-account-balances-budget budget accountlist get-balance-fn)
(gnc:get-assoc-account-balances
accountlist
(lambda (account) (get-balance-fn budget account))))
(define (get-assoc-account-balances-total-negated account-balances)
(gnc:commodity-collector-get-negated
(gnc:get-assoc-account-balances-total account-balances)))
(define
(sum-prefetched-account-balances-for-account
initial-balances budget-balances account)
(let*
(
(initial-balance
(gnc:select-assoc-account-balance initial-balances account))
(budget-balance
(gnc:select-assoc-account-balance budget-balances account))
(total-balance
(if (or (not initial-balance) (not budget-balance))
#f
(gnc:make-commodity-collector))))
(if
total-balance
(begin
(total-balance 'merge initial-balance #f)
(total-balance 'merge budget-balance #f)))
total-balance))
(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))
(budget (get-option gnc:pagename-general optname-budget))
(date-tp (gnc:budget-get-start-date budget))
(report-form? (get-option gnc:pagename-general
optname-report-form))
(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-assets? (get-option gnc:pagename-display
optname-label-assets))
(total-assets? (get-option gnc:pagename-display
optname-total-assets))
(label-liabilities? (get-option gnc:pagename-display
optname-label-liabilities))
(total-liabilities? (get-option gnc:pagename-display
optname-total-liabilities))
(label-equity? (get-option gnc:pagename-display
optname-label-equity))
(total-equity? (get-option gnc:pagename-display
optname-total-equity))
(new-existing? (get-option gnc:pagename-display
optname-new-existing))
(use-links? (get-option gnc:pagename-display
optname-account-links))
(use-rules? (get-option gnc:pagename-display
optname-use-rules))
(indent 0)
(tabbing #f)
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(asset-accounts (assoc-ref split-up-accounts ACCT-TYPE-ASSET))
(liability-accounts (assoc-ref split-up-accounts ACCT-TYPE-LIABILITY))
(income-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
(expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-EXPENSE))
(equity-accounts (assoc-ref split-up-accounts ACCT-TYPE-EQUITY))
(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 all three tables
;; (asset, liability, equity) have the same width.
(tree-depth (if (equal? depth-limit 'all)
(gnc:get-current-account-tree-depth)
depth-limit))
;; exchange rates calculation parameters
(exchange-fn
(gnc:case-exchange-fn price-source report-commodity 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! since we call it so
;; often.
(define (add-rule table)
(gnc:html-table-append-ruler!
table
(+ (* 2 tree-depth)
(if (equal? tabbing 'canonically-tabbed) 1 0))))
;;(gnc:warn "account names" liability-account-names)
(gnc:html-document-set-title!
doc (string-append company-name " " report-title " "
(gnc-budget-get-name budget))
)
(if (null? accounts)
;; error condition: no accounts specified
;; is this *really* necessary??
;; i'd be fine with an all-zero balance sheet
;; 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 of the account types.
(let* ((asset-balance #f)
(asset-account-initial-balances #f)
(asset-account-budget-balances #f)
(liability-account-initial-balances #f)
(liability-account-budget-balances #f)
(equity-account-initial-balances #f)
(equity-account-budget-balances #f)
(existing-assets #f)
(allocated-assets #f)
(unallocated-assets #f)
(asset-get-balance-fn #f)
(existing-liabilities #f)
(new-liabilities #f)
(liability-repayments #f)
(liability-balance #f)
(liability-get-balance-fn #f)
(unrealized-gain #f)
(existing-equity #f)
(new-equity #f)
(equity-balance #f)
(equity-get-balance-fn #f)
(new-retained-earnings #f)
(existing-retained-earnings #f)
(retained-earnings #f)
(liability-plus-equity #f)
(table-env #f) ;; parameters for :make-
(params #f) ;; and -add-account-
(asset-table #f) ;; gnc:html-acct-table
(liability-table #f) ;; gnc:html-acct-table
(equity-table #f) ;; gnc:html-acct-table
;; Create the account tables below where their
;; percentage time can be tracked.
(left-table (gnc:make-html-table)) ;; gnc:html-table
(right-table (if report-form? left-table
(gnc:make-html-table)))
)
(gnc:report-percent-done 4)
;; Get asset account balances (positive).
(set! asset-account-initial-balances
(get-assoc-account-balances-budget
budget
asset-accounts
get-budget-account-initial-balance))
(set! asset-account-budget-balances
(get-assoc-account-balances-budget
budget
asset-accounts
get-budget-account-budget-balance))
(set! asset-get-balance-fn
(lambda (account start-date end-date)
(sum-prefetched-account-balances-for-account
asset-account-initial-balances
asset-account-budget-balances
account)))
(gnc:report-percent-done 6)
;; Get liability account balances (negative).
(set! liability-account-initial-balances
(get-assoc-account-balances-budget
budget
liability-accounts
get-budget-account-initial-balance))
(set! liability-account-budget-balances
(get-assoc-account-balances-budget
budget
liability-accounts
get-budget-account-budget-balance))
(set! liability-get-balance-fn
(lambda (account start-date end-date)
(sum-prefetched-account-balances-for-account
liability-account-initial-balances
liability-account-budget-balances
account)))
(gnc:report-percent-done 8)
;; Get equity account balances (negative).
(set! equity-account-initial-balances
(get-assoc-account-balances-budget
budget
equity-accounts
get-budget-account-initial-balance))
(set! equity-account-budget-balances
(get-assoc-account-balances-budget
budget
equity-accounts
get-budget-account-budget-balance))
(set! equity-get-balance-fn
(lambda (account start-date end-date)
(sum-prefetched-account-balances-for-account
equity-account-initial-balances
equity-account-budget-balances
account)))
(gnc:report-percent-done 10)
;; Existing liabilities must be negated.
(set! existing-liabilities
(get-assoc-account-balances-total-negated liability-account-initial-balances))
;; Budgeted liabilities are liability repayments (negative liabilities).
(set! liability-repayments
(gnc:get-assoc-account-balances-total liability-account-budget-balances))
;; New liabilities are then negated liability repayments.
(set! new-liabilities
(gnc:commodity-collector-get-negated liability-repayments))
;; Total liabilities.
(set! liability-balance (gnc:make-commodity-collector))
(liability-balance 'merge existing-liabilities #f)
(liability-balance 'merge new-liabilities #f)
(gnc:report-percent-done 12)
;; Total existing retained earnings.
;; existing retained earnings = initial income - initial expenses
(set! existing-retained-earnings (gnc:make-commodity-collector))
;; Income is negative; negate to add.
(existing-retained-earnings 'minusmerge
(gnc:budget-accountlist-get-initial-balance budget income-accounts)
#f)
;; Expenses are positive; negate to subtract.
(existing-retained-earnings 'minusmerge
(gnc:budget-accountlist-get-initial-balance budget expense-accounts)
#f)
(gnc:report-percent-done 14)
;; Total new retained earnings.
(set! new-retained-earnings (gnc:make-commodity-collector))
;; Budgeted income is positive; add.
(new-retained-earnings 'merge
(get-budget-accountlist-budget-balance budget income-accounts)
#f)
;; Budgeted expenses are positive; negate to subtract.
(new-retained-earnings 'minusmerge
(get-budget-accountlist-budget-balance budget expense-accounts)
#f)
;; Total retained earnings.
(set! retained-earnings (gnc:make-commodity-collector))
(retained-earnings 'merge existing-retained-earnings #f)
(retained-earnings 'merge new-retained-earnings #f)
(gnc:report-percent-done 16)
;; Total existing assets.
(set! existing-assets
(gnc:get-assoc-account-balances-total
asset-account-initial-balances))
;; Total allocated assets.
(set! allocated-assets
(gnc:get-assoc-account-balances-total
asset-account-budget-balances))
;; Total unallocated assets.
;; unallocated-assets =
;; new-retained-earnings - allocated-assets - liability-repayments
(set! unallocated-assets (gnc:make-commodity-collector))
(unallocated-assets 'merge new-retained-earnings #f)
(unallocated-assets 'minusmerge allocated-assets #f)
(unallocated-assets 'minusmerge liability-repayments #f)
;; Total assets.
(set! asset-balance (gnc:make-commodity-collector))
(asset-balance 'merge existing-assets #f)
(asset-balance 'merge allocated-assets #f)
(asset-balance 'merge unallocated-assets #f)
(gnc:report-percent-done 18)
;; Calculate unrealized gains.
(set! unrealized-gain (gnc:make-commodity-collector))
(let*
(
(get-total-value-fn
(lambda (account)
(gnc:account-get-comm-value-at-date account date-tp #f)))
(asset-basis
(gnc:accounts-get-comm-total-assets
asset-accounts get-total-value-fn))
(liability-basis
(gnc:commodity-collector-get-negated
(gnc:accounts-get-comm-total-assets
liability-accounts get-total-value-fn)))
)
;; Calculate unrealized gains from assets.
(unrealized-gain 'merge existing-assets #f)
(unrealized-gain 'minusmerge asset-basis #f)
;; Combine with unrealized gains from liabilities
(unrealized-gain 'minusmerge existing-liabilities #f)
(unrealized-gain 'merge liability-basis #f))
(gnc:report-percent-done 22)
;; Total existing equity; negative.
(set! existing-equity
(get-assoc-account-balances-total-negated
equity-account-initial-balances))
;; Include existing retained earnings.
(existing-equity 'merge existing-retained-earnings #f)
;; Include unrealized gains.
(existing-equity 'merge unrealized-gain #f)
;; Total new equity; positive.
(set! new-equity
(gnc:get-assoc-account-balances-total
equity-account-budget-balances))
;; Include new retained earnings.
(new-equity 'merge new-retained-earnings #f)
;; Total equity.
(set! equity-balance (gnc:make-commodity-collector))
(equity-balance 'merge existing-equity #f)
(equity-balance 'merge new-equity #f)
;; Total liability + equity.
(set! liability-plus-equity (gnc:make-commodity-collector))
(liability-plus-equity 'merge liability-balance #f)
(liability-plus-equity 'merge equity-balance #f)
(gnc:report-percent-done 30)
(set! table-env
(list
(list 'start-date #f)
(list 'end-date #f)
(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))
)
)
(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 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;")
))
(gnc:html-table-append-row! left-table space)
(if (not report-form?)
(gnc:html-table-append-row! right-table space))
)
(gnc:report-percent-done 80)
(if label-assets? (add-subtotal-line left-table (_ "Assets") #f #f))
(set! asset-table
(gnc:make-html-acct-table/env/accts
(append table-env (list (list 'get-balance-fn asset-get-balance-fn)))
asset-accounts))
(gnc:html-table-add-account-balances left-table asset-table params)
(if total-assets?
(begin
(if new-existing?
(begin
(add-subtotal-line
left-table (_ "Existing Assets") #f existing-assets)
(add-subtotal-line
left-table (_ "Allocated Assets") #f allocated-assets)))
(if (not (gnc-commodity-collector-allzero? unallocated-assets))
(add-subtotal-line
left-table (_ "Unallocated Assets") #f unallocated-assets))
(add-subtotal-line
left-table (_ "Total Assets") #f asset-balance)))
(if report-form?
(add-rule left-table))
(if report-form?
(add-rule left-table))
(gnc:report-percent-done 85)
(if label-liabilities?
(add-subtotal-line right-table (_ "Liabilities") #f #f))
(set! liability-table
(gnc:make-html-acct-table/env/accts
(append table-env
(list (list 'get-balance-fn liability-get-balance-fn)))
liability-accounts))
(gnc:html-table-add-account-balances
right-table liability-table params)
(if total-liabilities?
(begin
(if new-existing?
(begin
(add-subtotal-line
right-table
(_ "Existing Liabilities")
#f
existing-liabilities)
(add-subtotal-line
right-table (_ "New Liabilities") #f new-liabilities)))
(add-subtotal-line
right-table (_ "Total Liabilities") #f liability-balance)))
(add-rule right-table)
(gnc:report-percent-done 88)
(if label-equity?
(add-subtotal-line
right-table (_ "Equity") #f #f))
(set! equity-table
(gnc:make-html-acct-table/env/accts
(append table-env
(list (list 'get-balance-fn equity-get-balance-fn)))
equity-accounts))
(gnc:html-table-add-account-balances
right-table equity-table params)
;; we omit retianed earnings from the balance report, if zero, since
;; they are not present on normal balance sheets
(if (not (gnc-commodity-collector-allzero? retained-earnings))
(if new-existing?
(begin
(add-subtotal-line
right-table
(_ "Existing Retained Earnings")
(_ "Existing Retained Losses")
existing-retained-earnings)
(add-subtotal-line
right-table
(_ "New Retained Earnings")
(_ "New Retained Losses")
new-retained-earnings)))
(add-subtotal-line
right-table
(_ "Total Retained Earnings")
(_ "Total Retained Losses")
retained-earnings))
(if (not (gnc-commodity-collector-allzero? unrealized-gain))
(add-subtotal-line right-table
(_ "Unrealized Gains")
(_ "Unrealized Losses")
unrealized-gain))
(if total-equity?
(begin
(if new-existing?
(begin
(add-subtotal-line
right-table (_ "Existing Equity") #f existing-equity)
(add-subtotal-line
right-table (_ "New Equity") #f new-equity)))
(add-subtotal-line
right-table (_ "Total Equity") #f equity-balance)))
(add-rule right-table)
(add-subtotal-line
right-table
(_ "Total Liabilities & Equity")
#f
liability-plus-equity)
(gnc:html-document-add-object!
doc
(if report-form?
left-table
(let* ((build-table (gnc:make-html-table))
)
(gnc:html-table-append-row!
build-table
(list
(gnc:make-html-table-cell left-table)
(gnc:make-html-table-cell right-table)
)
)
(gnc:html-table-set-style!
build-table "td"
'attribute '("align" "left")
'attribute '("valign" "top"))
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)
;; if sending the report to a file, do so now
;; however, this still doesn't seem to get around the
;; colspan bug... cf. gnc:colspans-are-working-right
(if filename
(let* ((port (open-output-file filename))
(gnc:display-report-list-item
(list doc) port " budget-balance-sheet.scm ")
(close-output-port port)
)
)
)
)
)
(gnc:report-finished)
doc
)
)
(gnc:define-report
'version 1
'name reportname
'report-guid "ecc35ea9dbfa4e20ba389fc85d59cb69"
'menu-path (list gnc:menuname-budget)
'options-generator budget-balance-sheet-options-generator
'renderer (lambda (report-obj)
(budget-balance-sheet-renderer report-obj #f #f))
'export-types #f
'export-thunk (lambda (report-obj choice filename)
(budget-balance-sheet-renderer report-obj #f filename)))

2
src/report/standard-reports/budget-barchart.scm
View File

@ -208,6 +208,6 @@
'version 1
'name (N_ "Budget Barchart")
'report-guid "415cd38d39054d9e9c4040455290c2b1"
'menu-path (list gnc:menuname-asset-liability)
'menu-path (list gnc:menuname-budget)
'options-generator (lambda () (options-generator))
'renderer (lambda (report-obj) (net-renderer report-obj)))

2
src/report/standard-reports/budget-flow.scm
View File

@ -323,7 +323,7 @@
'version 1
'name reportname
'report-guid "e6e34fa3b6e748debde3cb3bc76d3e53"
'menu-path (list gnc:menuname-income-expense)
'menu-path (list gnc:menuname-budget)
'options-generator budget-report-options-generator
'renderer budget-renderer)

678
src/report/standard-reports/budget-income-statement.scm Normal file
View File

@ -0,0 +1,678 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss)
;;
;; Copyright (c) the following:
;;
;; Forest Bond <forest@alittletooquiet.net>
;; David Montenegro <sunrise2000@comcast.net>
;;
;; * BUGS:
;;
;; 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
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash report budget-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 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-budget (N_ "Budget"))
(define opthelp-budget (N_ "Budget to use."))
;; 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 optname-parent-total-mode (N_ "Parent account subtotals"))
(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-two-column
(N_ "Display as a two column report"))
(define opthelp-two-column
(N_ "Divides the report into an income column and an expense column"))
(define optname-standard-order
(N_ "Display in standard, income first, order"))
(define opthelp-standard-order
(N_ "Causes the report to display in the standard order, placing income before expenses"))
;; options generator
(define (budget-income-statement-options-generator-internal reportname)
(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 ""))
;; 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)
(add-option
(gnc:make-budget-option
gnc:pagename-general optname-budget
"c" opthelp-budget))
;; 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
(list ACCT-TYPE-INCOME ACCT-TYPE-EXPENSE)
(gnc-account-get-descendants-sorted (gnc-get-current-root-account))))
#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" 'average-cost)
(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
(gnc:options-add-subtotal-view!
options gnc:pagename-display
optname-parent-balance-mode optname-parent-total-mode
"c")
;; some detailed formatting options
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-account-links
"d" opthelp-account-links #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-use-rules
"e" opthelp-use-rules #f))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-revenue
"f" opthelp-label-revenue #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-revenue
"g" opthelp-total-revenue #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-expense
"h" opthelp-label-expense #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-expense
"i" opthelp-total-expense #t))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-two-column
"j" opthelp-two-column #f))
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-standard-order
"k" opthelp-standard-order #t))
;; Set the accounts page as default option tab
(gnc:options-set-default-section options gnc:pagename-accounts)
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-income-statement-renderer
;; set up the document and add the table
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (budget-income-statement-renderer-internal report-obj reportname)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
(define (get-assoc-account-balances-budget budget accountlist get-balance-fn)
(gnc:get-assoc-account-balances
accountlist
(lambda (account) (get-balance-fn budget account))))
(define (get-budget-account-budget-balance budget account)
(gnc:budget-account-get-net budget account #f #f))
(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))
(budget (get-option gnc:pagename-general optname-budget))
(date-tp (gnc:budget-get-start-date budget))
(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))
(two-column? (get-option gnc:pagename-display
optname-two-column))
(standard-order? (get-option gnc:pagename-display
optname-standard-order))
(indent 0)
(tabbing #f)
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
(expense-accounts (assoc-ref split-up-accounts ACCT-TYPE-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-account-tree-depth)
depth-limit))
;; exchange rates calculation parameters
(exchange-fn
(gnc:case-exchange-fn price-source report-commodity date-tp))
(budget-name (gnc-budget-get-name budget))
)
;; 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 "%s %s %s" company-name report-title budget-name))
(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 of the account types.
(let* (
(revenue-account-balances #f)
(expense-account-balances #f)
(revenue-total #f)
(revenue-get-balance-fn #f)
(expense-total #f)
(expense-get-balance-fn #f)
(net-income #f)
;; Create the account tables below where their
;; percentage time can be tracked.
(inc-table (gnc:make-html-table)) ;; gnc:html-table
(exp-table (gnc:make-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
(period-for (string-append " " (_ "for Budget ") budget-name))
)
;; 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-fcur?
(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")
)
)
(gnc:report-percent-done 5)
;; Pre-fetch expense account balances.
(set! expense-account-balances
(get-assoc-account-balances-budget
budget
expense-accounts
get-budget-account-budget-balance))
;; Total expenses.
(set! expense-total
(gnc:get-assoc-account-balances-total expense-account-balances))
;; Function to get individual expense account total.
(set! expense-get-balance-fn
(lambda (account start-date end-date)
(gnc:select-assoc-account-balance expense-account-balances account)))
(gnc:report-percent-done 10)
;; Pre-fetch revenue account balances.
(set! revenue-account-balances
(get-assoc-account-balances-budget
budget
revenue-accounts
get-budget-account-budget-balance))
;; Total revenue.
(set! revenue-total
(gnc:get-assoc-account-balances-total revenue-account-balances))
;; Function to get individual revenue account total.
;; Budget revenue is always positive, so this must be negated.
(set! revenue-get-balance-fn
(lambda (account start-date end-date)
(gnc:commodity-collector-get-negated
(gnc:select-assoc-account-balance revenue-account-balances account))))
(gnc:report-percent-done 20)
;; calculate net income
(set! net-income (gnc:make-commodity-collector))
(net-income 'merge revenue-total #f)
(net-income 'minusmerge expense-total #f)
(gnc:report-percent-done 30)
(set! table-env
(list
(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))
)
)
(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 "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;")
))
(gnc:html-table-append-row! inc-table space)
(gnc:html-table-append-row! exp-table space))
(gnc:report-percent-done 80)
(if label-revenue?
(add-subtotal-line inc-table (_ "Revenues") #f #f))
(set! revenue-table
(gnc:make-html-acct-table/env/accts
(append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
revenue-accounts))
(gnc:html-table-add-account-balances
inc-table revenue-table params)
(if total-revenue?
(add-subtotal-line
inc-table (_ "Total Revenue") #f revenue-total))
(gnc:report-percent-done 85)
(if label-expense?
(add-subtotal-line
exp-table (_ "Expenses") #f #f))
(set! expense-table
(gnc:make-html-acct-table/env/accts
(append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
expense-accounts))
(gnc:html-table-add-account-balances
exp-table expense-table params)
(if total-expense?
(add-subtotal-line
exp-table (_ "Total Expenses") #f expense-total))
(report-line
(if standard-order?
exp-table
inc-table)
(string-append (_ "Net income") period-for)
(string-append (_ "Net loss") period-for)
net-income
(* 2 (- tree-depth 1)) exchange-fn #f #f
)
(gnc:html-document-add-object!
doc
(let* ((build-table (gnc:make-html-table)))
(if two-column?
(gnc:html-table-append-row!
build-table
(if standard-order?
(list
(gnc:make-html-table-cell inc-table)
(gnc:make-html-table-cell exp-table)
)
(list
(gnc:make-html-table-cell exp-table)
(gnc:make-html-table-cell inc-table)
)
)
)
(if standard-order?
(begin
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell inc-table)))
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell exp-table)))
)
(begin
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell exp-table)))
(gnc:html-table-append-row!
build-table
(list (gnc:make-html-table-cell inc-table)))
)
)
)
(gnc:html-table-set-style!
build-table "td"
'attribute '("align" "left")
'attribute '("valign" "top"))
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
)
)
(define is-reportname (N_ "Budget Income Statement"))
(define pnl-reportname (N_ "Budget Profit & Loss"))
(define (budget-income-statement-options-generator)
(budget-income-statement-options-generator-internal is-reportname))
(define (budget-income-statement-renderer report-obj)
(budget-income-statement-renderer-internal report-obj is-reportname))
(define (budget-profit-and-loss-options-generator)
(budget-income-statement-options-generator-internal pnl-reportname))
(define (budget-profit-and-loss-renderer report-obj)
(budget-income-statement-renderer-internal report-obj is-reportname))
(gnc:define-report
'version 1
'name is-reportname
'report-guid "583c313fcc484efc974c4c844404f454"
'menu-path (list gnc:menuname-budget)
'options-generator budget-income-statement-options-generator
'renderer budget-income-statement-renderer
)
;; Also make a "Profit & Loss" report, even if it's the exact same one,
;; just relabeled.
(gnc:define-report
'version 1
'name pnl-reportname
'report-guid "e5fa5ce805e840ecbeca4dba3fa4ead9"
'menu-path (list gnc:menuname-budget)
'options-generator budget-profit-and-loss-options-generator
'renderer budget-profit-and-loss-renderer
)
;; END

2
src/report/standard-reports/budget.scm
View File

@ -434,7 +434,7 @@
'version 1
'name reportname
'report-guid "810ed4b25ef0486ea43bbd3dddb32b11"
'menu-path (list gnc:menuname-income-expense)
'menu-path (list gnc:menuname-budget)
'options-generator budget-report-options-generator
'renderer budget-renderer)

2
src/report/standard-reports/standard-reports.scm
View File

@ -75,8 +75,10 @@
(use-modules (gnucash report general-ledger))
(use-modules (gnucash report cash-flow))
(use-modules (gnucash report budget))
(use-modules (gnucash report budget-balance-sheet))
(use-modules (gnucash report budget-barchart))
(use-modules (gnucash report budget-flow))
(use-modules (gnucash report budget-income-statement))
(use-modules (gnucash report category-barchart))
(use-modules (gnucash report daily-reports))
(use-modules (gnucash report net-barchart))

2
src/report/utility-reports/hello-world.scm
View File

@ -20,7 +20,7 @@
(define (options-generator)
(let* ((options (gnc:new-options))
;; This is just a helper function for making options.
;; See gnucash/src/scm/options.scm for details.
;; See gnucash/src/app-utils/options.scm for details.
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))