From d66d8d2fc3b738bdf15097f8daae1c851a1f17b7 Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Thu, 15 Feb 2001 09:01:19 +0000 Subject: [PATCH] Christian Stimming's report patch. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3663 57a11ea4-9604-0410-9ed3-97b8803252fd --- ChangeLog | 17 ++ src/scm/commodity-utilities.scm | 48 ++-- src/scm/html-utilities.scm | 378 +++++++++++++---------------- src/scm/options-utilities.scm | 14 +- src/scm/report-utilities.scm | 71 ++++-- src/scm/report/account-summary.scm | 91 +++---- src/scm/report/pnl.scm | 50 ++-- 7 files changed, 358 insertions(+), 311 deletions(-) diff --git a/ChangeLog b/ChangeLog index 668514c6b0..cafecda4a3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2001-02-15 Christian Stimming + + * src/scm/report-utilities.scm: Added functions to filter accounts + by type, and helpers for calculating balances. + + * src/scm/commodity-utilities.scm: (gnc:make-exchange-function) + now uses . + + * src/scm/html-utilities.scm: (gnc:html-build-acct-table) major + code cleanup. Added new function to generate a of + exchange rates. + + * src/scm/options-utilities.scm: Added function for another + option. + + * src/scm/report/{pnl,account-summary}.scm: Added options. + 2001-02-15 James LewisMoss * src/engine/Account.h: Add prototype for SetSlots. diff --git a/src/scm/commodity-utilities.scm b/src/scm/commodity-utilities.scm index 28e892cb5e..c58e2f584a 100644 --- a/src/scm/commodity-utilities.scm +++ b/src/scm/commodity-utilities.scm @@ -109,7 +109,8 @@ ;; If neither the currency of otherlist nor of ;; pair was found in reportlist then we can't ;; resolve the exchange rate to this currency. - (warn "can't calculate rate for " + (warn "gnc:resolve-unknown-comm:" + "can't calculate rate for " (gnc:commodity-value->string (list (car pair) ((caadr pair) 'total #f))) " = " @@ -123,7 +124,8 @@ ;; went wrong inside ;; gnc:get-exchange-totals. FIXME: Find a ;; better thing to do in this case. - (warn "Oops - exchange rate ambiguity error: " + (warn "gnc:resolve-unknown-comm:" + "Oops - exchange rate ambiguity error: " (gnc:commodity-value->string (list (car pair) ((caadr pair) 'total #f))) " = " @@ -265,30 +267,30 @@ (gnc:get-exchange-totals report-commodity end-date))) ;; This one returns the ready-to-use function for calculation of the -;; exchange rates. The returned function in turn returns a pair -;; commodity - value which instantly can be plugged into -;; gnc:commodity-amount->string . +;; exchange rates. The returned function takes a and +;; the domestic-commodity, exchanges the amount in the domestic +;; currency and returns a . (define (gnc:make-exchange-function exchange-alist) (let ((exchangelist exchange-alist)) - (lambda (foreign-pair domestic) - (cons domestic - (cons - (let ((pair (assoc (car foreign-pair) exchangelist))) - (if (not pair) - (gnc:numeric-zero) - (gnc:numeric-mul (cadr foreign-pair) (cadr pair) - ;; FIXME: the constant 100 here is - ;; not a durable solution -- - ;; anyone has a better idea? - 100 GNC-RND-ROUND))) - '()))))) - + (lambda (foreign domestic) + (gnc:make-gnc-monetary + domestic + (let ((pair (assoc (gnc:gnc-monetary-commodity foreign) + exchangelist))) + (if (not pair) + (gnc:numeric-zero) + (gnc:numeric-mul (gnc:gnc-monetary-amount foreign) + (cadr pair) + ;; FIXME: the constant 100 here is + ;; not a durable solution -- + ;; anyone has a better idea? + 100 GNC-RND-ROUND))))))) ;; Adds all different commodities in the commodity-collector ;; by using the exchange rates of to calculate the -;; exchange rates to the commodity . Returns the -;; two-element-list with the domestic commodity and its corresponding -;; balance, like (gnc:commodity* gnc:numeric). +;; exchange rates to the commodity . Returns a +;; with the domestic commodity and its corresponding +;; balance. (define (gnc:sum-collector-commodity foreign domestic exchange-fn) (let ((balance (make-commodity-collector))) (foreign @@ -297,7 +299,9 @@ (if (gnc:commodity-equiv? domestic curr) (balance 'add domestic val) (balance 'add domestic - (cadr (exchange-fn (list curr val) domestic))))) + (gnc:gnc-monetary-amount + (exchange-fn (gnc:make-gnc-monetary curr val) + domestic))))) #f) (balance 'getmonetary domestic #f))) diff --git a/src/scm/html-utilities.scm b/src/scm/html-utilities.scm index 6bd1645055..4da5fa38be 100644 --- a/src/scm/html-utilities.scm +++ b/src/scm/html-utilities.scm @@ -120,69 +120,37 @@ (string for the foreign column or #f if to be left + ;; empty; domestic-balance is the for the + ;; domestic column. + (define (commodity-row-helper! + my-name foreign-balance domestic-balance) (gnc:html-table-append-row! table (append @@ -205,156 +177,120 @@ 1 (+ 1 (- tree-depth current-depth)) my-name)) (gnc:html-make-empty-cells (* 2 (- tree-depth current-depth))) - (if (or do-subtot? - (gnc:commodity-equiv? my-commodity report-commodity)) - ;; usual case: the account balance in terms of report - ;; commodity - (list - (car (gnc:html-make-empty-cells 1)) - (gnc:commodity-value->string - (balance 'getpair report-commodity reverse-balance?))) - ;; 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 my-commodity reverse-balance))) - (list - (gnc:commodity-value->string my-balance) - (gnc:commodity-value->string - (exchange-fn my-balance report-commodity))))) - (gnc:html-make-empty-cells (* 2 (- current-depth 1))))) - ;; The additional rows: show no name, but the foreign currency - ;; balance and its corresponding value in the - ;; report-currency. One row for each non-report-currency. Is - ;; only used when do-subtot? == #f (otherwise this balance has - ;; only one commodity). - (if do-subtot? - (balance - 'format - (lambda (curr val) - (if (gnc:commodity-equiv? curr report-commodity) - '() - (gnc:html-table-append-row! - table - (append - ;; print no account name - (gnc:html-make-empty-cells tree-depth) - (gnc:html-make-empty-cells - (* 2 (- tree-depth current-depth))) - ;; print the account balance in the respective - ;; commodity - (list - (gnc:commodity-value->string - (list curr (if reverse-balance? - (gnc:numeric-neg val) val))) - (gnc:commodity-value->string - (exchange-fn - (list curr (if reverse-balance? - (gnc:numeric-neg val) val)) - report-commodity))) - (gnc:html-make-empty-cells - (* 2 (- current-depth 1))))))) - #f)))) - - - - + (list (if (not foreign-balance) + (car (gnc:html-make-empty-cells 1)) + foreign-balance) + domestic-balance) + (gnc:html-make-empty-cells (* 2 (- current-depth 1)))))) + + ;;;;;;;;;; + ;; the first row for each account: shows the name and the + ;; balance in the report-commodity + (if (or do-subtot? + (gnc:commodity-equiv? my-commodity report-commodity)) + ;; usual case: the account balance in terms of report + ;; commodity + (commodity-row-helper! + my-name #f + (balance 'getmonetary report-commodity reverse-balance?)) + ;; 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 'getmonetary + my-commodity reverse-balance?))) + (commodity-row-helper! + my-name + my-balance + (exchange-fn my-balance report-commodity)))) + + ;; The additional rows: show no name, but the foreign currency + ;; balance and its corresponding value in the + ;; report-currency. One row for each non-report-currency. Is + ;; only used when do-subtot? == #f (otherwise this balance has + ;; only one commodity). + (if do-subtot? + (balance + 'format + (lambda (curr val) + (if (gnc:commodity-equiv? curr report-commodity) + '() + (let ((bal + (if reverse-balance? + (gnc:monetary-neg (gnc:make-gnc-monetary curr val)) + (gnc:make-gnc-monetary curr val)))) + (commodity-row-helper! + ;; print no account name + (car (gnc:html-make-empty-cells 1)) + ;; print the account balance in the respective + ;; commodity + bal + (exchange-fn bal report-commodity))))) + #f))) + ;; Adds all appropriate rows to the table which belong to one ;; account. Uses the above helper function, i.e. here the - ;; necessary values only are "extracted" from the account. Is used - ;; only if options "show foreign commodities" == #t. - (define (add-commodity-rows! acct current-depth) - (add-commodity-row-helper! current-depth - (gnc:html-account-anchor acct) - (gnc:account-get-commodity acct) - (my-get-balance acct) - (gnc:account-reverse-balance? acct))) - - ;; The same as above (traverse-accounts!), but for showing foreign - ;; currencies/commodities. - (define (traverse-accounts-fcur! accnts current-depth) + ;; necessary values only are "extracted" from the account. + (define (add-account-rows! acct current-depth) + (if show-other-curr? + (add-commodity-rows! current-depth + (gnc:html-account-anchor acct) + (gnc:account-get-commodity acct) + (my-get-balance acct) + (gnc:account-reverse-balance? acct)) + (add-row-helper! + current-depth + (gnc:html-account-anchor acct) + (gnc:sum-collector-commodity (my-get-balance acct) + report-commodity exchange-fn) + (gnc:account-reverse-balance? acct)))) + + ;; Adds rows to the table. Therefore it goes through the list of + ;; accounts, runs add-account-rows! on each account. If + ;; tree-depth and current-depth require, it will recursively call + ;; itself on the list of children accounts. + (define (traverse-accounts! accnts current-depth) (if (<= current-depth tree-depth) (for-each (lambda (acct) (begin (if (show-acct? acct) - (add-commodity-rows! acct current-depth)) - (traverse-accounts-fcur! + (add-account-rows! acct current-depth)) + (traverse-accounts! (gnc:account-get-immediate-subaccounts acct) (+ 1 current-depth)))) (sort-fn accnts)))) - - ;; First iteration -- make the case destinction for - ;; show-other-curr?. - (define (start-traverse-accounts l d) - (if show-other-curr? - (traverse-accounts-fcur! l d) - (traverse-accounts! l d))) - - - ;;;;;;;;;;;;;; - ;; Helper functions for the grouping of accounts according to their types. - - ;; Returns only those accounts out of the list l which have one of - ;; the type identifiers in typelist. - (define (filter-accountlist-type typelist l) - (filter (lambda (a) - (member (gw:enum--val->sym - (gnc:account-get-type a) #f) - typelist) ) - accounts)) - - ;; Decompose a given list of accounts accts into different lists, - ;; each with the name of that category as first element. - (define (decompose-accountlist accts) - (map (lambda (x) (cons - (car x) - (filter-accountlist-type (cdr x) accts))) - (list - (cons (_ "Assets") - '(asset bank cash checking savings money-market - stock mutual-fund currency)) - (cons (_ "Liabilities") '(liability equity credit-line)) - (cons (_ "Income") '(income)) - (cons (_ "Expense") '(expense))))) - + ;; Generalization for a subtotal or the total balance. (define (add-subtotal-row! current-depth subtotal-name balance) (if show-other-curr? - (add-commodity-row-helper! current-depth subtotal-name - report-commodity balance #f) + (add-commodity-rows! current-depth subtotal-name + report-commodity balance #f) ;; Show no other currencies. Therefore just calculate ;; one total via sum-collector-commodity and show it. - (gnc:html-table-append-row! - table - (make-row-helper current-depth subtotal-name - (gnc:sum-collector-commodity - balance report-commodity - exchange-fn))))) + (add-row-helper! current-depth subtotal-name + (gnc:sum-collector-commodity + balance report-commodity exchange-fn) + #f))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; start the recursive account processing (if group-types? - ;; do a subtotal for each group + ;; Print a subtotal for each group. (for-each (lambda (accts) (if (and (not (null? accts)) (not (null? (cdr accts)))) (begin (add-subtotal-row! 1 (car accts) - (let ((coll (make-commodity-collector))) - (for-each (lambda (x) - (coll (if (gnc:account-reverse-balance? x) - 'minusmerge 'merge) - (my-get-balance x) #f)) - (cdr accts)) - coll)) - (start-traverse-accounts (cdr accts) 2)))) - (decompose-accountlist topl-accounts)) + (gnc:accounts-get-balance-helper + (cdr accts) my-get-balance gnc:account-reverse-balance?)) + (traverse-accounts! (cdr accts) 2)))) + (gnc:decompose-accountlist (lset-intersection + equal? accounts topl-accounts))) ;; No extra grouping. - (start-traverse-accounts topl-accounts 1)) + (traverse-accounts! topl-accounts 1)) ;; Show the total sum. (if show-total? @@ -374,6 +310,17 @@ 'attribute '("align" "right") 'attribute '("valign" "top")) + ;; 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-other-curr? + (* 2 tree-depth) + tree-depth) + (_ "Balance")))) + ;; there are tree-depth account name columns. (let loop ((col 0)) (gnc:html-table-set-col-style! @@ -385,25 +332,50 @@ table)) -;; Print the exchangerate-list alist into the given html-txt object -;; txt-object, where the report's commodity is common-commodity. -(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 - ;; convert to 6 significant figures - (gnc:numeric-convert - (cadr pair) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 6) GNC-RND-ROUND))))))) - alist)) + +;; Returns a html-object which is a table of all exchange rates. +;; Where the report's commodity is common-commodity. +(define (gnc:html-make-exchangerates + common-commodity rate-alist accounts show-always?) + (let ((comm-list (delete-duplicates + (sort (map gnc:account-get-commodity accounts) + (lambda (a b) + (stringvector (list 4 "4" (_ "Fourth-level"))) (list->vector - (list 5 "5" (_ "Fifth-level")))))) + (list 5 "5" (_ "Fourth-level"))) + (list->vector + (list 6 "6" (_ "Sixth-level")))))) (gnc:register-option options @@ -128,6 +130,16 @@ pagename optname sort-tag (_ "Include sub-account balances in printed balance?") #t))) +;; The single checkbox whether to group the accounts into main +;; categories and ahow a subtotal for those. +(define (gnc:options-add-group-accounts! + options pagename optname sort-tag default?) + (gnc:register-option + options + (gnc:make-simple-boolean-option + pagename optname + sort-tag (_ "Group the accounts in main categories?") default?))) + ;; These are common options for the selection of the report's ;; currency/commodity. (define (gnc:options-add-currency-selection! diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index 237748b247..fcd8432723 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -56,6 +56,30 @@ #f))) (member type '(income expense)))) +;; Returns only those accounts out of the list which have +;; one of the type identifiers in typelist. +(define (gnc:filter-accountlist-type typelist accounts) + (filter (lambda (a) + (member (gw:enum--val->sym + (gnc:account-get-type a) #f) + typelist) ) + accounts)) + +;; Decompose a given list of accounts accts into different lists +;; according to their types, each with the name of that category as +;; first element. +(define (gnc:decompose-accountlist accounts) + (map (lambda (x) (cons + (car x) + (gnc:filter-accountlist-type (cdr x) accounts))) + (list + (cons (_ "Assets") + '(asset bank cash checking savings money-market + stock mutual-fund currency)) + (cons (_ "Liabilities") '(liability equity credit-line)) + (cons (_ "Income") '(income)) + (cons (_ "Expense") '(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) @@ -73,6 +97,7 @@ (accounts-get-children-depth (gnc:group-get-account-list (gnc:get-current-group)))) +;; (define (gnc:account-separator-char) (let ((option (gnc:lookup-option gnc:*options-entries* "General" "Account Separator"))) @@ -310,7 +335,8 @@ clist)) ;; helper function which is given a commodity and returns, if - ;; existing, a list (gnc:commodity gnc:numeric) + ;; existing, a list (gnc:commodity gnc:numeric). If the second + ;; argument was #t, the sign gets reversed. (define (getpair c sign?) (let ((pair (assoc c commoditylist))) (cons c (cons @@ -322,7 +348,8 @@ '())))) ;; helper function which is given a commodity and returns, if - ;; existing, a value. + ;; existing, a value. If the second argument was + ;; #t, the sign gets reversed. (define (getmonetary c sign?) (let ((pair (assoc c commoditylist))) (gnc:make-gnc-monetary @@ -421,19 +448,33 @@ (gnc:account-get-balance-at-date account date #f)) group))) +;; Adds all accounts' balances, where the balances are determined with +;; the get-balance-fn. The reverse-balance-fn +;; (e.g. gnc:account-reverse-balance?) should return #t if the +;; account's balance sign should get reversed. Returns a +;; commodity-collector. +(define (gnc:accounts-get-balance-helper + accounts get-balance-fn reverse-balance-fn) + (let ((collector (make-commodity-collector))) + (for-each + (lambda (acct) + (collector (if (reverse-balance-fn acct) + 'minusmerge + 'merge) + (get-balance-fn acct) #f)) + accounts) + collector)) + ;; Adds all accounts' balances, where the balances are determined with ;; the get-balance-fn. Intended for usage with a profit and loss ;; report, hence a) only the income/expense accounts are regarded, and ;; b) the result is sign reversed. Returns a commodity-collector. (define (gnc:accounts-get-comm-total-profit accounts get-balance-fn) - (let ((collector (make-commodity-collector))) - (for-each - (lambda (acct) - (collector 'minusmerge (get-balance-fn acct) #f)) - (filter gnc:account-is-inc-exp? - accounts)) - collector)) + (gnc:accounts-get-balance-helper + (gnc:filter-accountlist-type '(income expense) accounts) + get-balance-fn + (lambda(x) #t))) ;; Adds all accounts' balances, where the balances are determined with ;; the get-balance-fn. Intended for usage with a balance sheet, hence @@ -441,13 +482,11 @@ ;; reversed at all. Returns a commodity-collector. (define (gnc:accounts-get-comm-total-assets accounts get-balance-fn) - (let ((collector (make-commodity-collector))) - (for-each - (lambda (acct) - (collector 'merge (get-balance-fn acct) #f)) - (filter (lambda (a) (not (gnc:account-is-inc-exp? a))) - accounts)) - collector)) + (gnc:accounts-get-balance-helper + (filter (lambda (a) (not (gnc:account-is-inc-exp? a))) + accounts) + get-balance-fn + (lambda(x) #f))) ;; returns a commodity-collector (define (gnc:group-get-comm-balance-at-date group date) diff --git a/src/scm/report/account-summary.scm b/src/scm/report/account-summary.scm index 9d74af06c6..ae28b78028 100644 --- a/src/scm/report/account-summary.scm +++ b/src/scm/report/account-summary.scm @@ -38,11 +38,15 @@ (let ((pagename-general (N_ "General")) (optname-date (N_ "Date")) (optname-display-depth (N_ "Account Display Depth")) + + (optname-show-foreign (N_ "Show Foreign Currencies")) + (optname-report-currency (N_ "Report's currency")) + + (pagename-accounts (N_ "Accounts")) (optname-show-subaccounts (N_ "Always show sub-accounts")) (optname-accounts (N_ "Account")) - (optname-include-subbalances (N_ "Include Sub-Account balances")) - (optname-show-foreign (N_ "Show Foreign Currencies")) - (optname-report-currency (N_ "Report's currency"))) + (optname-group-accounts (N_ "Group the accouts")) + (optname-include-subbalances (N_ "Include Sub-Account balances"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; options generator @@ -58,26 +62,33 @@ (gnc:options-add-report-date! options pagename-general optname-date "a") + ;; all about currencies + (gnc:options-add-currency-selection! + options pagename-general + optname-show-foreign optname-report-currency + "b") + ;; accounts to work on (gnc:options-add-account-selection! - options pagename-general + options pagename-accounts optname-display-depth optname-show-subaccounts - optname-accounts "b" 2 + optname-accounts "a" 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 grouping + (gnc:options-add-group-accounts! + options pagename-accounts optname-group-accounts "b" #f) + ;; with or without subaccounts (gnc:options-add-include-subaccounts! - options pagename-general optname-include-subbalances "c") + options pagename-accounts optname-include-subbalances "c") - ;; all about currencies - (gnc:options-add-currency-selection! - options pagename-general - optname-show-foreign optname-report-currency - "f") + ;; Set the general page as default option tab + (gnc:options-set-default-section options pagename-general) options)) @@ -87,23 +98,26 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (accsum-renderer report-obj) - (define (get-option optname) + (define (get-option pagename optname) (gnc:option-value (gnc:lookup-option - (gnc:report-options report-obj) pagename-general optname))) + (gnc:report-options report-obj) pagename optname))) - (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. + (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-grouping? (get-option pagename-accounts + optname-group-accounts)) + (do-subtotals? (get-option pagename-accounts + optname-include-subbalances)) + (show-fcur? (get-option pagename-general optname-show-foreign)) + (report-currency (get-option pagename-general + optname-report-currency)) (date-tp (gnc:timepair-end-day-time - (vector-ref (get-option optname-date) 1))) + (vector-ref (get-option pagename-general + optname-date) 1))) (doc (gnc:make-html-document)) (txt (gnc:make-html-text))) @@ -111,9 +125,10 @@ (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)) + (let* ((tree-depth (+ (if (equal? display-depth 'all) + (gnc:get-current-group-depth) + display-depth) + (if do-grouping? 1 0))) (exchange-alist (gnc:make-exchange-alist report-currency date-tp)) (exchange-fn (gnc:make-exchange-function exchange-alist)) @@ -122,29 +137,21 @@ #f date-tp tree-depth show-subaccts? accounts #t gnc:accounts-get-comm-total-assets - (_ "Net Assets") #t do-subtotals? + (_ "Net Assets") do-grouping? 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) + ;(gnc:html-print-exchangerates! + ; txt report-currency exchange-alist) ;;(if show-fcur? - (gnc:html-document-add-object! doc txt)) + (gnc:html-document-add-object! + doc ;;(gnc:html-markup-p + (gnc:html-make-exchangerates + report-currency exchange-alist accounts #f)));;) ;; error condition: no accounts specified (let ((p (gnc:make-html-text))) diff --git a/src/scm/report/pnl.scm b/src/scm/report/pnl.scm index f86281db88..6102ac2809 100644 --- a/src/scm/report/pnl.scm +++ b/src/scm/report/pnl.scm @@ -39,6 +39,7 @@ (optname-display-depth (N_ "Account Display Depth")) (optname-show-subaccounts (N_ "Always show sub-accounts")) (optname-accounts (N_ "Account")) + (optname-group-accounts (N_ "Group the accouts")) (optname-include-subbalances (N_ "Include Sub-Account balances")) ;; (pagename-currencies (N_ "Currencies")) too little options :) @@ -55,27 +56,31 @@ options pagename-general optname-from-date optname-to-date "a") + ;; all about currencies + (gnc:options-add-currency-selection! + options pagename-currencies + optname-show-foreign optname-report-currency + "b") + ;; accounts to work on (gnc:options-add-account-selection! options pagename-accounts optname-display-depth optname-show-subaccounts - optname-accounts "b" 2 + optname-accounts "a" 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 grouping + (gnc:options-add-group-accounts! + options pagename-accounts optname-group-accounts "b" #t) + ;; 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) @@ -99,6 +104,8 @@ optname-show-subaccounts)) (accounts (get-option pagename-accounts optname-accounts)) + (do-grouping? (get-option pagename-accounts + optname-group-accounts)) (do-subtotals? (get-option pagename-accounts optname-include-subbalances)) (show-fcur? (get-option pagename-currencies @@ -123,7 +130,8 @@ ;; 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) + (+ (gnc:get-current-group-depth) + (if do-grouping? 1 0)) display-depth)) ;; calculate the exchange rates (exchange-alist (gnc:make-exchange-alist @@ -134,29 +142,17 @@ from-date-tp to-date-tp tree-depth show-subaccts? accounts #t gnc:accounts-get-comm-total-profit - (_ "Profit") #t do-subtotals? + (_ "Profit") do-grouping? 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)) + ;; add currency information + (gnc:html-document-add-object! + doc ;;(gnc:html-markup-p + (gnc:html-make-exchangerates + report-currency exchange-alist accounts #f)));;) ;; error condition: no accounts specified (let ((p (gnc:make-html-text)))