diff --git a/ChangeLog b/ChangeLog index 5b03e26b67..c40dc3b23d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,23 @@ +2001-02-08 Christian Stimming + + * src/scm/html-style-info.scm: Fix bug. + + * src/scm/gnc-numeric.scm: Add more functions on gnc-monetary. + + * src/scm/html-utilities.scm: Add balance sign reversal + conditioned on gnc:account-reverse-balance? for the account + table. Add function to print exchange rates. + + * src/scm/report-utilities.scm: Modify commodity-collector to + enable more sign reversals and usage of gnc-monetary. Add option + creation functions common to several reports. + + * src/scm/report/account-summary.scm: Removed function now in + report-utilities.scm. Added variables for option names. + + * src/scm/report/pnl.scm: New Profit And Loss report, based on + account-summary report. + 2001-02-08 James LewisMoss * src/engine/sixtp.c (sixtp_parse_file): Only set parse_result if diff --git a/src/scm/gnc-numeric.scm b/src/scm/gnc-numeric.scm index e994ba9f2d..274b063eea 100644 --- a/src/scm/gnc-numeric.scm +++ b/src/scm/gnc-numeric.scm @@ -74,7 +74,7 @@ (define (gnc:make-gnc-monetary c a) (if (and (gw:wcp-is-of-type? c) (gnc:gnc-numeric? a)) ((record-constructor ) c a) - #f)) + (warn "wrong arguments for gnc:make-gnc-monetary: " c a))) (define gnc:gnc-monetary? (record-predicate )) @@ -85,3 +85,9 @@ (define gnc:gnc-monetary-amount (record-accessor 'amount)) +(define (gnc:monetary-neg a) + (if (gnc:gnc-monetary? a) + (gnc:make-gnc-monetary + (gnc:gnc-monetary-commodity a) + (gnc:numeric-neg (gnc:gnc-monetary-amount a))) + (warn "wrong arguments for gnc:monetary-neg: " a))) diff --git a/src/scm/html-style-info.scm b/src/scm/html-style-info.scm index ebbf65de86..d8d2cc691b 100644 --- a/src/scm/html-style-info.scm +++ b/src/scm/html-style-info.scm @@ -224,7 +224,7 @@ (define (gnc:default-html-gnc-monetary-renderer datum params) (gnc:amount->string-helper (gnc:gnc-monetary-amount datum) - (gnc:commodity-print-info (gnc:gnc-monetary-amount datum) #t))) + (gnc:commodity-print-info (gnc:gnc-monetary-commodity datum) #t))) (define (gnc:default-html-number-renderer datum params) (sprintf #f "%.2f" datum)) diff --git a/src/scm/html-utilities.scm b/src/scm/html-utilities.scm index 34ed9580b7..5c8158dcea 100644 --- a/src/scm/html-utilities.scm +++ b/src/scm/html-utilities.scm @@ -58,6 +58,10 @@ ;; loss reports). Returns a commodity-collector. (define (my-get-balance account) (if start-date + ;; FIXME: the get-balance-interval function uses this date + ;; rightaway, but since it calculates a difference it should + ;; rather take the end-day-time of one day before that. This + ;; needs to be fixed in report-utilities.scm. (gnc:account-get-comm-balance-interval account start-date end-date do-subtot?) (gnc:account-get-comm-balance-at-date @@ -80,6 +84,9 @@ (lambda (a b) (stringstring - ;; get the account balance, then exchange everything into - ;; the report-commodity via gnc:add-collector-commodity - (gnc:add-collector-commodity (my-get-balance acct) + ;; get the account balance, then exchange everything into the + ;; report-commodity via gnc:sum-collector-commodity. If the + ;; account-reverse-balance? returns true, then the sign gets + ;; reversed. + ((if (gnc:account-reverse-balance? acct) + gnc:monetary-neg + identity) + (gnc:sum-collector-commodity (my-get-balance acct) report-commodity exchange-fn))) (gnc:html-make-empty-cells (- current-depth 1)))) @@ -151,14 +162,16 @@ (list (car (gnc:html-make-empty-cells 1)) (gnc:commodity-value->string - (balance 'getpair report-commodity #f))) + (balance 'getpair report-commodity + (gnc:account-reverse-balance? acct)))) ;; special case if do-subtot? was false and it is in a ;; different commodity than the report: then the ;; foreign commodity gets displayed in this line ;; rather then the following lines (loop below). (let ((my-balance (balance 'getpair - (gnc:account-get-commodity acct) #f))) + (gnc:account-get-commodity acct) + (gnc:account-reverse-balance? acct)))) (list (gnc:commodity-value->string my-balance) (gnc:commodity-value->string @@ -183,9 +196,16 @@ ;; print the account balance in the respective ;; commodity (list - (gnc:commodity-value->string (list curr val)) (gnc:commodity-value->string - (exchange-fn (list curr val) report-commodity))) + (list curr + (if (gnc:account-reverse-balance? acct) + (gnc:numeric-neg val) val))) + (gnc:commodity-value->string + (exchange-fn + (list curr + (if (gnc:account-reverse-balance? acct) + (gnc:numeric-neg val) val)) + report-commodity))) (gnc:html-make-empty-cells (* 2 (- current-depth 1))))))) #f)))) @@ -214,7 +234,11 @@ (if show-total? (let ((total-collector (make-commodity-collector))) (for-each (lambda (acct) - (total-collector 'merge (my-get-balance acct) #f)) + (total-collector + (if (gnc:account-reverse-balance? acct) + 'minusmerge + 'merge) + (my-get-balance acct) #f)) (filter show-acct? topl-accounts)) (if show-other-curr? (begin @@ -252,17 +276,16 @@ report-commodity))))))) #f)) ;; Show no other currencies. Then just calculate one - ;; total via add-collector-commodity and show it. + ;; total via sum-collector-commodity and show it. (gnc:html-table-append-row! table (append (list (gnc:make-html-table-cell/size 1 tree-depth (_ "Total"))) (gnc:html-make-empty-cells (- tree-depth 1)) - (list (gnc:commodity-value->string - (gnc:add-collector-commodity - total-collector report-commodity - exchange-fn)))))))) - + (list (gnc:sum-collector-commodity + total-collector report-commodity + exchange-fn))))))) + ;; set default alignment to right, and override for the name ;; columns (gnc:html-table-set-style! @@ -285,3 +308,23 @@ (loop (+ col 1)))) table)) + +;; Print the exchangerate-alist into a given html-txt object. +(define (gnc:html-print-exchangerates! + txt-object common-commodity alist) + (for-each + (lambda (pair) + (gnc:html-text-append! + txt-object + (gnc:html-markup-p + (_ "Exchange rate ") + (gnc:commodity-value->string + (list (car pair) (gnc:numeric-create 1 1))) + " = " + (gnc:commodity-value->string + (list common-commodity + (gnc:numeric-convert + ;; FIXME: remove the constant 100000 + (cadr pair) 100000 GNC-RND-ROUND)))))) + alist)) + diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index 6b1b0e56fb..803274892e 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -49,6 +49,13 @@ #f))) (member type '(stock mutual-fund currency)))) +;; True if the account is of type income or expense +(define (gnc:account-is-inc-exp? account) + (let ((type (gw:enum--val->sym + (gnc:account-get-type account) + #f))) + (member type '(income expense)))) + ;; Returns the depth of the current account heirarchy, that is, the ;; maximum level of subaccounts in the current-group. (define (gnc:get-current-group-depth) @@ -302,9 +309,11 @@ ;; respectively. ;; 'reset #f #f: Delete everything that has been accumulated ;; (even the fact that any commodity showed up at all). -;; 'getpair #f: Returns the two-element-list with the -;; and its corresponding balance. If -;; doesn't exist, the balance will be (gnc:numeric-zero). +;; 'getpair signreverse?: Returns the two-element-list +;; with the and its corresponding balance. If +;; doesn't exist, the balance will be +;; (gnc:numeric-zero). If signreverse? is true, the result's +;; sign will be reversed. ;; (internal) 'list #f #f: get the association list of ;; commodity->numeric-collector @@ -352,14 +361,27 @@ ;; helper function which is given a commodity and returns, if ;; existing, a list (gnc:commodity gnc:numeric) - (define (getpair c) + (define (getpair c sign?) (let ((pair (assoc c commoditylist))) (cons c (cons (if (not pair) (gnc:numeric-zero) - ((cadr pair) 'total #f)) + (if sign? + (gnc:numeric-neg ((cadr pair) 'total #f)) + ((cadr pair) 'total #f))) '())))) + ;; helper function which is given a commodity and returns, if + ;; existing, a value. + (define (getmonetary c sign?) + (let ((pair (assoc c commoditylist))) + (gnc:make-gnc-monetary + c (if (not pair) + (gnc:numeric-zero) + (if sign? + (gnc:numeric-neg ((cadr pair) 'total #f)) + ((cadr pair) 'total #f)))))) + ;; Dispatch function (lambda (action commodity amount) (case action @@ -368,7 +390,8 @@ ('minusmerge (minus-commodity-clist (commodity 'list #f #f))) ('format (process-commodity-list commodity commoditylist)) ('reset (set! commoditylist '())) - ('getpair (getpair commodity)) + ('getpair (getpair commodity amount)) + ('getmonetary (getmonetary commodity amount)) ('list commoditylist) ; this one is only for internal use (else (gnc:warn "bad commodity-collector action: " action)))))) @@ -477,6 +500,10 @@ ;; this isn't quite as efficient as it could be, but it's a whole lot ;; simpler :) (define (gnc:account-get-balance-interval account from to include-children?) + ;; FIXME: the get-balance-interval function uses this date + ;; rightaway, but since it calculates a difference it should + ;; rather take the end-day-time of one day before that. This + ;; needs to be fixed in report-utilities.scm. (- (gnc:account-get-balance-at-date account to include-children?) (gnc:account-get-balance-at-date account from include-children?))) @@ -788,7 +815,7 @@ ;; exchange rates to the commodity . Returns the ;; two-element-list with the domestic commodity and its corresponding ;; balance, like (gnc:commodity* gnc:numeric). -(define (gnc:add-collector-commodity foreign domestic exchange-fn) +(define (gnc:sum-collector-commodity foreign domestic exchange-fn) (let ((balance (make-commodity-collector))) (foreign 'format @@ -798,4 +825,130 @@ (balance 'add domestic (cadr (exchange-fn (list curr val) domestic))))) #f) - (balance 'getpair domestic #f))) + (balance 'getmonetary domestic #f))) + + +;; These are just a bunch of options which were useful in several +;; reports and hence they got defined in a seperate function. + +;; This is one single end-date of a report. +(define (gnc:options-add-report-date! + options pagename optname sort-tag) + (gnc:register-option + options + (gnc:make-date-option + pagename optname + sort-tag (_ "Select a date to report on") + (lambda () + (cons 'absolute + (gnc:timepair-end-day-time + (gnc:secs->timepair + (car (mktime (localtime (current-time)))))))) + #f 'absolute #f))) + +;; This is a date-interval for a report. +(define (gnc:options-add-date-interval! + options pagename name-from name-to sort-tag) + (begin + (gnc:register-option + options + (gnc:make-date-option + pagename name-from + (string-append sort-tag "a") + (_ "Start of reporting period") + (lambda () + (cons 'absolute + (gnc:get-start-cal-year))) + #f 'absolute #f)) + (gnc:register-option + options + (gnc:make-date-option + pagename name-to + (string-append sort-tag "b") + (_ "End of reporting period") + (lambda () + (cons 'absolute + (gnc:timepair-end-day-time + (gnc:secs->timepair + (car (mktime (localtime (current-time)))))))) + #f 'absolute #f)))) + +;; These help for selecting a bunch of accounts. +(define (gnc:options-add-account-selection! + options pagename + name-display-depth name-show-subaccounts name-accounts + sort-tag default-depth default-accounts) + (begin + (gnc:register-option + options + (gnc:make-multichoice-option + pagename name-display-depth + (string-append sort-tag "a") + (_ "Show accounts to this depth, overriding any other option.") + default-depth + (list (list->vector + (list 'all (_ "All") (_ "Show all accounts"))) + (list->vector + (list 1 "1" (_ "Top-level"))) + (list->vector + (list 2 "2" (_ "Second-level"))) + (list->vector + (list 3 "3" (_ "Third-level"))) + (list->vector + (list 4 "4" (_ "Fourth-level"))) + (list->vector + (list 5 "5" (_ "Fifth-level")))))) + + (gnc:register-option + options + (gnc:make-simple-boolean-option + pagename name-show-subaccounts + (string-append sort-tag "b") + (_ "Override account-selection and show sub-accounts of all selected accounts?") + #t)) + + ;; Semantics of the account selection, as used in the + ;; gnc:html-build-acct-table: An account shows up if ( the + ;; tree-depth is large enough AND ( it is selected in the account + ;; selector OR ( always show sub-accounts is selected AND one of + ;; the parents is selected in the account selector. ))) + (gnc:register-option + options + (gnc:make-account-list-option + pagename name-accounts + (string-append sort-tag "c") + (_ "Report on these accounts, if display depth allows.") + default-accounts + #f #t)))) + +;; The single checkbox whether to include the sub-account balances +;; into the other balances. +(define (gnc:options-add-include-subaccounts! + options pagename optname sort-tag) + (gnc:register-option + options + (gnc:make-simple-boolean-option + pagename optname + sort-tag (_ "Include sub-account balances in printed balance?") #t))) + +;; These are common options for the selection of the report's +;; currency/commodity. +(define (gnc:options-add-currency-selection! + options pagename + name-show-foreign name-report-currency sort-tag) + (begin + (gnc:register-option + options + (gnc:make-simple-boolean-option + pagename name-show-foreign + (string-append sort-tag "a") + (_ "Display the account's foreign currency amount?") #f)) + + (gnc:register-option + options + (gnc:make-currency-option + pagename name-report-currency + (string-append sort-tag "b") + (_ "All other currencies will get converted to this currency.") + (gnc:locale-default-currency))))) + diff --git a/src/scm/report/Makefile.am b/src/scm/report/Makefile.am index d323d90cfc..2a8e37b9fa 100644 --- a/src/scm/report/Makefile.am +++ b/src/scm/report/Makefile.am @@ -4,6 +4,7 @@ gncscmdir = ${GNC_SCM_INSTALL_DIR}/report gncscm_DATA = \ account-summary.scm \ average-balance.scm \ + pnl.scm \ hello-world.scm \ report-list.scm \ stylesheet-plain.scm \ diff --git a/src/scm/report/account-summary.scm b/src/scm/report/account-summary.scm index ae01d25efa..57571084a4 100644 --- a/src/scm/report/account-summary.scm +++ b/src/scm/report/account-summary.scm @@ -33,7 +33,17 @@ ;; prints a table of account information with clickable ;; links to open the corresponding register window. -(let () +;; first define all option's names such that typos etc. are no longer +;; possible. +(let ((pagename-general (_ "General")) + (optname-date (_ "Date")) + (optname-display-depth (_ "Account Display Depth")) + (optname-show-subaccounts (_ "Always show sub-accounts")) + (optname-accounts (_ "Account")) + (optname-include-subbalances (_ "Include Sub-Account balances")) + (optname-show-foreign (_ "Show Foreign Currencies")) + (optname-report-currency (_ "Report's currency"))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; options generator ;; select accounts to report on, whether to show subaccounts, @@ -42,97 +52,34 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (accsum-options-generator) - (let* ((options (gnc:new-options)) - (opt-register - (lambda (opt) - (gnc:register-option options opt)))) + (let* ((options (gnc:new-options))) ;; date at which to report balance - (opt-register - (gnc:make-date-option - (_ "General") (_ "Date") - "a" (_ "Select a date to report on") - (lambda () - (cons 'absolute - (gnc:timepair-end-day-time - (gnc:secs->timepair - (car (mktime (localtime (current-time)))))))) - #f 'absolute #f)) - - (opt-register - (gnc:make-multichoice-option - (_ "General") (_ "Account Display Depth") - "b" (_ "Show accounts to this depth, overriding any other option.") 1 - (list (list->vector - (list 'all - (_ "All") - (_ "Show all accounts"))) - (list->vector - (list 1 - "1" - (_ "Top-level"))) - (list->vector - (list 2 - "2" - (_ "Second-level"))) - (list->vector - (list 3 - "3" - (_ "Third-level"))) - (list->vector - (list 4 - "4" - (_ "Fourth-level"))) - (list->vector - (list 5 - "5" - (_ "Fifth-level")))))) - - (opt-register - (gnc:make-simple-boolean-option - (_ "General") (_ "Always show sub-accounts") - "c" - (_ "Override account-selection and show sub-accounts of all selected accounts?") - #t)) + (gnc:options-add-report-date! + options pagename-general optname-date "a") - ;; Semantics of the account selection: An account shows up if ( - ;; the tree-depth is large enough AND ( it is selected in the - ;; account selector OR ( always show sub-accounts is selected - ;; AND one of the parents is selected in the account - ;; selector. ))) - (opt-register - (gnc:make-account-list-option - (_ "General") (_ "Account") - "d" (_ "Report on these accounts, if display depth allows.") - (lambda () - (let ((current-accounts (gnc:get-current-accounts))) - (cond ((not (null? current-accounts)) current-accounts) - (else - ;;(gnc:group-get-subaccounts (gnc:get-current-group)))))) - (gnc:group-get-account-list (gnc:get-current-group)))))) - #f #t)) - - (opt-register - (gnc:make-simple-boolean-option - (_ "General") (_ "Include Sub-Account balances") - "e" (_ "Include sub-account balances in printed balance?") #t)) - - (opt-register - (gnc:make-simple-boolean-option - (_ "General") (_ "Show Foreign Currencies") - "f" (_ "Display the account's foreign currency amount?") #f)) - - (opt-register - (gnc:make-currency-option - (_ "General") (_ "Report's currency") - "g" (_ "All other currencies will get converted to this currency.") - (gnc:locale-default-currency))) - - options)) + ;; accounts to work on + (gnc:options-add-account-selection! + options pagename-general + optname-display-depth optname-show-subaccounts + optname-accounts "b" 1 + (lambda () + (let ((current-accounts (gnc:get-current-accounts))) + (cond ((not (null? current-accounts)) current-accounts) + (else + (gnc:group-get-account-list (gnc:get-current-group))))))) + + ;; with or without subaccounts + (gnc:options-add-include-subaccounts! + options pagename-general optname-include-subbalances "c") - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Start of report generating code - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; all about currencies + (gnc:options-add-currency-selection! + options pagename-general + optname-show-foreign optname-report-currency + "f") + + options)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; accsum-renderer @@ -143,20 +90,20 @@ (define (get-option optname) (gnc:option-value (gnc:lookup-option - (gnc:report-options report-obj) (_ "General") optname))) + (gnc:report-options report-obj) pagename-general optname))) - (let ((display-depth (get-option (_ "Account Display Depth"))) - (show-subaccts? (get-option (_ "Always show sub-accounts"))) - (accounts (get-option (_ "Account"))) - (do-subtotals? (get-option (_ "Include Sub-Account balances"))) - (show-fcur? (get-option (_ "Show Foreign Currencies"))) - (report-currency (get-option (_ "Report's currency"))) + (let ((display-depth (get-option optname-display-depth)) + (show-subaccts? (get-option optname-show-subaccounts)) + (accounts (get-option optname-accounts)) + (do-subtotals? (get-option optname-include-subbalances)) + (show-fcur? (get-option optname-show-foreign)) + (report-currency (get-option optname-report-currency)) ;; FIXME: So which splits are actually included and which ;; are not?? Permanent repair (?): Change the semantics of ;; the date-option to return not the first but the last ;; second of the desired day. (date-tp (gnc:timepair-end-day-time - (vector-ref (get-option (_ "Date")) 1))) + (vector-ref (get-option optname-date) 1))) (doc (gnc:make-html-document)) (txt (gnc:make-html-text))) @@ -192,21 +139,8 @@ (gnc:html-document-add-object! doc table) ;; add the currency information - (for-each - (lambda (pair) - (gnc:html-text-append! - txt - (gnc:html-markup-p - (_ "Exchange rate ") - (gnc:commodity-value->string - (list (car pair) (gnc:numeric-create 1 1))) - " = " - (gnc:commodity-value->string - (list report-currency - (gnc:numeric-convert - ;; FIXME: remove the constant 100000 - (cadr pair) 100000 GNC-RND-ROUND)))))) - exchange-alist) + (gnc:html-print-exchangerates! + txt report-currency exchange-alist) ;;(if show-fcur? (gnc:html-document-add-object! doc txt)) diff --git a/src/scm/report/pnl.scm b/src/scm/report/pnl.scm new file mode 100644 index 0000000000..8c6df9b300 --- /dev/null +++ b/src/scm/report/pnl.scm @@ -0,0 +1,170 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; pnl.scm : profit-and-loss report +;; +;; By 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 +;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 +;; Boston, MA 02111-1307, USA gnu@gnu.org +;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(gnc:support "report/pnl.scm") +(gnc:depend "report-html.scm") + +;; Profit and loss report. Actually, people in finances might want +;; something different under this name, but they are welcomed to +;; contribute their changes :-) + +;; first define all option's names so that they are properly defined +;; in *one* place. +(let* ((pagename-general (_ "General")) + (optname-from-date (_ "From")) + (optname-to-date (_ "To")) + + (pagename-accounts (_ "Accounts")) + (optname-display-depth (_ "Account Display Depth")) + (optname-show-subaccounts (_ "Always show sub-accounts")) + (optname-accounts (_ "Account")) + (optname-include-subbalances (_ "Include Sub-Account balances")) + +;; (pagename-currencies (_ "Currencies")) too little options :) + (pagename-currencies pagename-general) + (optname-show-foreign (_ "Show Foreign Currencies")) + (optname-report-currency (_ "Report's currency"))) + + ;; options generator + (define (pnl-options-generator) + (let ((options (gnc:new-options))) + + ;; date at which to report balance + (gnc:options-add-date-interval! + options pagename-general + optname-from-date optname-to-date "a") + + ;; accounts to work on + (gnc:options-add-account-selection! + options pagename-accounts + optname-display-depth optname-show-subaccounts + optname-accounts "b" 2 + ;; FIXME: get income/expense accounts + (lambda () + (filter + gnc:account-is-inc-exp? + (gnc:group-get-account-list (gnc:get-current-group))))) + + ;; with or without subaccounts + (gnc:options-add-include-subaccounts! + options pagename-accounts optname-include-subbalances "c") + + ;; all about currencies + (gnc:options-add-currency-selection! + options pagename-currencies + optname-show-foreign optname-report-currency + "d") + + ;; Set the general page as default option tab + (gnc:options-set-default-section options pagename-general) + + options)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; pnl-renderer + ;; set up the document and add the table + ;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (pnl-renderer report-obj) + (define (get-option pagename optname) + (gnc:option-value + (gnc:lookup-option + (gnc:report-options report-obj) pagename optname))) + + ;; get all option's values + (let ((display-depth (get-option pagename-accounts + optname-display-depth)) + (show-subaccts? (get-option pagename-accounts + optname-show-subaccounts)) + (accounts (get-option pagename-accounts + optname-accounts)) + (do-subtotals? (get-option pagename-accounts + optname-include-subbalances)) + (show-fcur? (get-option pagename-currencies + optname-show-foreign)) + (report-currency (get-option pagename-currencies + optname-report-currency)) + (to-date-tp (gnc:timepair-end-day-time + (vector-ref (get-option pagename-general + optname-to-date) 1))) + (from-date-tp (gnc:timepair-start-day-time + (vector-ref (get-option pagename-general + optname-from-date) 1))) + (doc (gnc:make-html-document)) + (txt (gnc:make-html-text))) + + (gnc:html-document-set-title! doc "Profit And Loss") + (if (not (null? accounts)) + ;; if no max. tree depth is given we have to find the + ;; maximum existing depth + (let* ((tree-depth (if (equal? display-depth 'all) + (gnc:get-current-group-depth) + display-depth)) + ;; calculate the exchange rates + (exchange-alist (gnc:make-exchange-alist + report-currency to-date-tp)) + (exchange-fn (gnc:make-exchange-function exchange-alist)) + ;; do the processing here + (table (gnc:html-build-acct-table + from-date-tp to-date-tp + tree-depth show-subaccts? accounts + #t do-subtotals? + show-fcur? report-currency exchange-fn))) + + ;; set some column headers + (gnc:html-table-set-col-headers! + table + (list (gnc:make-html-table-header-cell/size + 1 tree-depth (_ "Account name")) + (gnc:make-html-table-header-cell/size + 1 (if show-fcur? + (* 2 tree-depth) + tree-depth) + (_ "Balance")))) + + ;; add the table + (gnc:html-document-add-object! doc table) + + ;; add the currency information + (gnc:html-print-exchangerates! + txt report-currency exchange-alist) + + ;;(if show-fcur? + (gnc:html-document-add-object! doc txt)) + + ;; error condition: no accounts specified + (let ((p (gnc:make-html-text))) + (gnc:html-text-append! + p + (gnc:html-markup-h2 (_ "No accounts selected")) + (gnc:html-markup-p + (_ "This report requires accounts to be selected."))) + (gnc:html-document-add-object! doc p))) + doc)) + + (gnc:define-report + 'version 1 + 'name (_ "Profit And Loss") + 'options-generator pnl-options-generator + 'renderer pnl-renderer)) diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm index bacd71f3b3..08fdb09f3f 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -4,6 +4,7 @@ ;; reports (gnc:depend "report/account-summary.scm") (gnc:depend "report/average-balance.scm") +(gnc:depend "report/pnl.scm") (gnc:depend "report/hello-world.scm") ;; style sheets