diff --git a/AUTHORS b/AUTHORS index 49d4e21f0c..ed1121d23e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -111,6 +111,7 @@ Dennis Björklund Swedish translation Andreas Bogk Postgres backend patch Per Bojsen several core dump fixes Terry Boldt financial calculator and expression parser +Forest Bond Budget report improvements Richard Braakman xml version configure patch Simon Britnell patch to RPM spec Christopher B. Browne for perl, lots of scheme and documentation updates diff --git a/src/report/report-gnome/report-gnome.scm b/src/report/report-gnome/report-gnome.scm index 4c787441e6..20456f4b1f 100644 --- a/src/report/report-gnome/report-gnome.scm +++ b/src/report/report-gnome/report-gnome.scm @@ -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) diff --git a/src/report/report-system/html-acct-table.scm b/src/report/report-system/html-acct-table.scm index 94d82faa8d..f6ffec7d9f 100644 --- a/src/report/report-system/html-acct-table.scm +++ b/src/report/report-system/html-acct-table.scm @@ -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 diff --git a/src/report/report-system/report-system.scm b/src/report/report-system/report-system.scm index fa96a830fc..a8f061d080 100644 --- a/src/report/report-system/report-system.scm +++ b/src/report/report-system/report-system.scm @@ -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") diff --git a/src/report/report-system/report-utilities.scm b/src/report/report-system/report-utilities.scm index 543bbc1228..9c753c1710 100644 --- a/src/report/report-system/report-utilities.scm +++ b/src/report/report-system/report-utilities.scm @@ -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)) diff --git a/src/report/report-system/report.scm b/src/report/report-system/report.scm index ecedd1af0f..2c4079ab12 100644 --- a/src/report/report-system/report.scm +++ b/src/report/report-system/report.scm @@ -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")) diff --git a/src/report/standard-reports/Makefile.am b/src/report/standard-reports/Makefile.am index fe120dda80..9f625af496 100644 --- a/src/report/standard-reports/Makefile.am +++ b/src/report/standard-reports/Makefile.am @@ -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 \ diff --git a/src/report/standard-reports/budget-balance-sheet.scm b/src/report/standard-reports/budget-balance-sheet.scm new file mode 100644 index 0000000000..9f6d2b3b38 --- /dev/null +++ b/src/report/standard-reports/budget-balance-sheet.scm @@ -0,0 +1,938 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; budget-balance-sheet.scm: balance sheet from budget projections +;; Based on balance-sheet.scm. +;; +;; Copyright (c) the following: +;; +;; Forest Bond +;; Robert Merkel +;; David Montenegro +;; Christian Stimming +;; +;; 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 "     \ +     \ +     ") + )) + (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))) diff --git a/src/report/standard-reports/budget-barchart.scm b/src/report/standard-reports/budget-barchart.scm index 56b95f7e33..a2caa14170 100644 --- a/src/report/standard-reports/budget-barchart.scm +++ b/src/report/standard-reports/budget-barchart.scm @@ -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))) diff --git a/src/report/standard-reports/budget-flow.scm b/src/report/standard-reports/budget-flow.scm index 9ef5cb925a..9eb1925c10 100644 --- a/src/report/standard-reports/budget-flow.scm +++ b/src/report/standard-reports/budget-flow.scm @@ -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) diff --git a/src/report/standard-reports/budget-income-statement.scm b/src/report/standard-reports/budget-income-statement.scm new file mode 100644 index 0000000000..ea46a3c3c8 --- /dev/null +++ b/src/report/standard-reports/budget-income-statement.scm @@ -0,0 +1,678 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; budget-income-statement.scm: income statement (a.k.a. Profit & Loss) +;; +;; Copyright (c) the following: +;; +;; Forest Bond +;; David Montenegro +;; +;; * 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 "     \ +     \ +     ") + )) + (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 diff --git a/src/report/standard-reports/budget.scm b/src/report/standard-reports/budget.scm index 739d32aee5..1d7d73b09b 100644 --- a/src/report/standard-reports/budget.scm +++ b/src/report/standard-reports/budget.scm @@ -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) diff --git a/src/report/standard-reports/standard-reports.scm b/src/report/standard-reports/standard-reports.scm index 03ea9438e6..b66ad8d9a3 100644 --- a/src/report/standard-reports/standard-reports.scm +++ b/src/report/standard-reports/standard-reports.scm @@ -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)) diff --git a/src/report/utility-reports/hello-world.scm b/src/report/utility-reports/hello-world.scm index a115b1cd53..c589512bcb 100644 --- a/src/report/utility-reports/hello-world.scm +++ b/src/report/utility-reports/hello-world.scm @@ -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))))