diff --git a/ChangeLog b/ChangeLog index 1a27a33db9..f55aded2f4 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2001-02-09 Christian Stimming + + * src/scm/commodity-utilities.scm: Functions to calculate exchange + rates (weighted average) for different commodities (moved from + report-utilities.scm). Major cleanup. + + * src/scm/options-utilities.scm: Option creation functions common + to several reports. (moved from report-utilities.scm) + + * src/scm/report-utilities.scm: Major cleanup. + 2001-02-08 Bill Gribble * src/gnome/druid-qif-import.c: restructure druid a bit to diff --git a/src/scm/Makefile.am b/src/scm/Makefile.am index edce7f14a4..2c22b2ca47 100644 --- a/src/scm/Makefile.am +++ b/src/scm/Makefile.am @@ -11,6 +11,7 @@ gnc_regular_scm_files = \ command-line.scm \ commodity-import.scm \ commodity-table.scm \ + commodity-utilities.scm \ config-var.scm \ date-utilities.scm \ depend.scm \ @@ -34,6 +35,7 @@ gnc_regular_scm_files = \ iso-4217-currencies.scm \ main.scm \ options.scm \ + options-utilities.scm \ path.scm \ prefs.scm \ report.scm \ diff --git a/src/scm/commodity-utilities.scm b/src/scm/commodity-utilities.scm new file mode 100644 index 0000000000..598e7eee02 --- /dev/null +++ b/src/scm/commodity-utilities.scm @@ -0,0 +1,299 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; commodity-utilities.scm: Functions for handling different commodities. +;; Copyright 2001 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 "commodity-utilities.scm") +(gnc:depend "report-utilities.scm") + +;; All the functions below up to gnc:make-exchange-fn are calculating +;; the exchange rate for different commodities by determining the +;; weighted average of all currency transactions. + +;; Returns a list of all splits in the currency-accounts up to +;; end-date which have two *different* commodities involved. +(define (gnc:get-all-commodity-splits + currency-accounts end-date-tp) + (let ((query (gnc:malloc-query)) + (splits #f)) + + (gnc:query-set-group query (gnc:get-current-group)) + (gnc:query-add-account-match + query (gnc:list->glist currency-accounts) + 'acct-match-any 'query-and) + (gnc:query-add-date-match-timepair + query #f end-date-tp #t end-date-tp 'query-and) + + ;; Get the query result, i.e. all splits in currency + ;; accounts. + (set! splits (filter + ;; Filter such that we get only those splits + ;; which have two *different* commodities + ;; involved. + (lambda (s) (not (gnc:commodity-equiv? + (gnc:transaction-get-commodity + (gnc:split-get-parent s)) + (gnc:account-get-commodity + (gnc:split-get-account s))))) + (gnc:glist->list + (gnc:query-get-splits query) + ))) + (gnc:free-query query) + splits)) + + +;; Go through all toplevel non-report-commodity balances in sumlist +;; and add them to report-commodity, if possible. This function takes +;; a sumlist (described below) and returns an alist similar to one +;; value of the sumlist's alist, e.g. (cadr (assoc report-commodity +;; sumlist))). This resulting alist can immediately be plugged into +;; gnc:make-exchange-alist. +(define (gnc:resolve-unknown-comm sumlist report-commodity) + ;; reportlist contains all known transactions with the + ;; report-commodity, and now the transactions with unknown + ;; currencies should be added to that list (with an appropriate + ;; exchange rate). + (let ((reportlist (cadr (assoc report-commodity sumlist)))) + + ;; Helper function to calculate (a*b)/c and create the new pair of + ;; numeric-collectors, where [abc] are numeric-collectors. See the + ;; real variable names below. + (define (make-newrate unknown-coll un->known-coll known-pair) + (let ((a (make-numeric-collector)) + (b (make-numeric-collector))) + (a 'add (unknown-coll 'total #f)) + (b 'add + (gnc:numeric-div + (gnc:numeric-mul + (un->known-coll 'total #f) + ((cdadr known-pair) 'total #f) + GNC-DENOM-AUTO GNC-DENOM-REDUCE) + ((caadr known-pair) 'total #f) + GNC-DENOM-AUTO GNC-DENOM-REDUCE)) + ;; in other words: (/ (* (caadr un->known-coll) (cdadr + ;; known-pair)) (caadr known-pair) )) + (cons a b))) + + ;; Go through sumlist. + (for-each + (lambda (otherlist) + (if (not (gnc:commodity-equiv? (car otherlist) report-commodity)) + (for-each + (lambda (pair) + ;; pair-{a,b}: Try to find either the currency of + ;; otherlist or of pair in reportlist. + (let ((pair-a (assoc (car otherlist) reportlist)) + (pair-b (assoc (car pair) reportlist)) + (rate (gnc:numeric-zero))) + (if (and (not pair-a) (not pair-b)) + ;; 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 " + (gnc:commodity-value->string + (list (car pair) (caadr pair))) + " = " + (gnc:commodity-value->string + (list (car otherlist) (cdadr pair))) + " to " + (gnc:commodity-value->string + (list report-commodity (gnc:numeric-zero)))) + (if (and pair-a pair-b) + ;; If both currencies are found then something + ;; went wrong inside + ;; gnc:get-exchange-totals. FIXME: Find a + ;; better thing to do in this case. + (warn "Oops - exchange rate ambiguity error: " + (gnc:commodity-value->string + (list (car pair) (caadr pair))) + " = " + (gnc:commodity-value->string + (list (car otherlist) (cdadr pair)))) + (let + ;; Usual case: one of pair-{a,b} was found + ;; in reportlist, i.e. this transaction + ;; can be resolved to report-commodity. + ((newrate + (if (not pair-a) + (list (car otherlist) + (make-newrate (cdadr pair) + (caadr pair) pair-b)) + (list (car pair) + (make-newrate (caadr pair) + (cdadr pair) pair-a))))) + ;; (warn "created new rate: " + ;; (gnc:commodity-value->string (list (car + ;; newrate) ((caadr newrate) 'total #f))) " + ;; = " (gnc:commodity-value->string (list + ;; report-commodity ((cdadr newrate) 'total + ;; #f)))) + (set! reportlist (cons newrate reportlist))))))) + (cadr otherlist)))) + sumlist) + + ;; Return the reportlist. + reportlist)) +;; Some thoughts: In the (and (not pair-a) (not pair-b)) case above we +;; will have unresolvable transaction exchange rates. But there might +;; be cases where we will be able to resolve this, but only after one +;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform +;; this functions to use some kind of recursiveness. + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; In progress: A suggested function to calculate the weighted average +;; exchange rate between all commodities and the +;; report-commodity. Uses all currency transactions up until the +;; end-date. Returns an alist, see sumlist. +(define (gnc:get-exchange-totals report-commodity end-date) + (let ((curr-accounts + (filter gnc:account-has-shares? (gnc:group-get-subaccounts + (gnc:get-current-group)))) + ;; sumlist: a multilevel alist. Each element has a commodity + ;; as key, and another alist as a value. The value-alist's + ;; elements consist of a commodity as a key, and a pair of two + ;; value-collectors as value, e.g. with only one (the report-) + ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 . + ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are + ;; and the numbers are a numeric-collector + ;; which in turn store a . In the example, USD + ;; 400 were bought for an amount of DEM 1000, FRF 300 were + ;; bought for DEM 100. The reason for the outer alist is that + ;; there might be commodity transactions which do not involve + ;; the report-commodity, but which can still be calculated + ;; after *all* transactions are processed. + (sumlist (list (list report-commodity '())))) + + (if (not (null? curr-accounts)) + ;; Go through all splits and add up all value-amounts + ;; and share-amounts + (for-each + (lambda (a) + (let* ((transaction-comm (gnc:transaction-get-commodity + (gnc:split-get-parent a))) + (account-comm (gnc:account-get-commodity + (gnc:split-get-account a))) + (share-amount (gnc:split-get-share-amount a)) + (value-amount (gnc:split-get-value a)) + (tmp (assoc transaction-comm sumlist)) + (comm-list (if (not tmp) + (assoc account-comm sumlist) + tmp))) + + ;; entry exists already in comm-list? + (if (not comm-list) + ;; no, create sub-alist from scratch + (let ((pair (list transaction-comm + (cons (make-numeric-collector) + (make-numeric-collector))))) + ((caadr pair) 'add value-amount) + ((cdadr pair) 'add share-amount) + (set! comm-list (list account-comm (list pair))) + ;; and add the new sub-alist to sumlist. + (set! sumlist (cons comm-list sumlist))) + ;; yes, check for second commodity. + (let* + ((foreignlist + ;; this will adjust the signs appropriately + (if (gnc:commodity-equiv? transaction-comm + (car comm-list)) + (list account-comm + (gnc:numeric-neg share-amount) + (gnc:numeric-neg value-amount)) + (list transaction-comm + value-amount + share-amount))) + ;; second commodity already existing in comm-list? + (pair (assoc (car foreignlist) (cadr comm-list)))) + ;; if not, create a new entry in comm-list. + (if (not pair) + (begin + (set! + pair (list (car foreignlist) + (cons (make-numeric-collector) + (make-numeric-collector)))) + (set! + comm-list (list (car comm-list) + (cons pair (cadr comm-list)))) + (set! + sumlist (cons comm-list + (alist-delete + (car comm-list) sumlist))))) + ;; And add the balances to the comm-list entry. + ((caadr pair) 'add (cadr foreignlist)) + ((cdadr pair) 'add (caddr foreignlist)))))) + (gnc:get-all-commodity-splits curr-accounts end-date))) + + (gnc:resolve-unknown-comm sumlist report-commodity))) + +;; Anybody feel free to reimplement any of these functions, either in +;; scheme or in C. -- cstim + +(define (gnc:make-exchange-alist report-commodity end-date) + ;; This returns the alist with the actual exchange rates, i.e. the + ;; total balances from get-exchange-totals are divided by each + ;; other. + (map + (lambda (e) + (list (car e) + (gnc:numeric-abs + (gnc:numeric-div ((cdadr e) 'total #f) + ((caadr e) 'total #f) + GNC-DENOM-AUTO + GNC-DENOM-REDUCE)))) + (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 . +(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))) + '()))))) + + +;; 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). +(define (gnc:sum-collector-commodity foreign domestic exchange-fn) + (let ((balance (make-commodity-collector))) + (foreign + 'format + (lambda (curr val) + (if (gnc:commodity-equiv? domestic curr) + (balance 'add domestic val) + (balance 'add domestic + (cadr (exchange-fn (list curr val) domestic))))) + #f) + (balance 'getmonetary domestic #f))) + diff --git a/src/scm/html-utilities.scm b/src/scm/html-utilities.scm index 299afc008c..98c0e474fd 100644 --- a/src/scm/html-utilities.scm +++ b/src/scm/html-utilities.scm @@ -24,6 +24,7 @@ (gnc:depend "report-utilities.scm") (gnc:depend "html-text.scm") +(gnc:depend "commodity-utilities.scm") ;; returns a list with n #f (empty cell) values (define (gnc:html-make-empty-cells n) diff --git a/src/scm/options-utilities.scm b/src/scm/options-utilities.scm new file mode 100644 index 0000000000..acacfc366a --- /dev/null +++ b/src/scm/options-utilities.scm @@ -0,0 +1,151 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; options-utilities.scm: Useful option helper functions. +;; +;; 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 "options-utilities.scm") + +(gnc:depend "options.scm") + +;; 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-utilities.scm b/src/scm/report-utilities.scm index c6f4de2d4e..dfe8630737 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -127,56 +127,6 @@ (let ((group (gnc:account-get-children acct))) (gnc:group-get-subaccounts group))) -;; AFAIK the following stuff exists in SRFI. 02/01/2001 -; -;;; returns a list contains elements of the-list for which predicate is true -;(define (gnc:filter-list the-list predicate) -; (let loop ((rest the-list) -; (collected '())) -; (cond ((null? rest) (reverse collected)) -; (else (loop (cdr rest) -; (if (predicate (car rest)) -; (cons (car rest) collected) -; collected)))))) -; -;; like map, but restricted to one dimension, and -;; guaranteed to have inorder semantics. -;; note: map-in-order is in a SRFI. -;(define (gnc:inorder-map the-list fn) -; (let loop ((rest the-list) -; (collected '())) -; (cond ((null? rest) (reverse collected)) -; (else (loop (cdr rest) -; (cons (fn (car rest)) collected)))))) -; -;(define (gnc:for-loop thunk first last step) -; (if (< first last) -; (begin -; (thunk first) -; (gnc:for-loop thunk (+ first step) last step)) -; #f)) -; -;(define (gnc:map-for thunk first last step) -; (if (< first last) -; (cons -; (thunk first) -; (gnc:map-for thunk (+ first step) last step)) -; '())) - -;; The following tasks shall be done with the query-api. 02/01/2001 -; -;;; applies thunk to each split in account account -;(define (gnc:for-each-split-in-account account thunk) -; (gnc:for-loop (lambda (x) -; (thunk (gnc:account-get-split account x))) -; 0 (gnc:account-get-split-count account) 1)) -; -;;; applies thunk to each split in account account -;(define (gnc:map-splits-in-account thunk account) -; (gnc:map-for (lambda (x) -; (thunk (gnc:account-get-split account x))) -; 0 (gnc:account-get-split-count account) 1)) - (define (gnc:transaction-map-splits thunk transaction) (let loop ((num-splits (gnc:transaction-get-split-count transaction)) (i 0)) @@ -395,20 +345,6 @@ ('list commoditylist) ; this one is only for internal use (else (gnc:warn "bad commodity-collector action: " action)))))) -;; Nobody uses the following functions. 02/01/2001 -;;; Add x to list lst if it is not already in there -;(define (addunique lst x) -; (if (null? lst) -; (list x) ; all checked add it -; (if (equal? x (car lst)) -; lst ; found, quit search and don't add again -; (cons (car lst) (addunique (cdr lst) x))))) ; keep searching -; -;;; get transaction date from split - needs to be done indirectly -;;; as it's stored in the parent transaction -;(define (gnc:split-get-transaction-date split) -; (gnc:transaction-get-date-posted (gnc:split-get-parent split))) - ;; get the account balance at the specified date. if include-children? ;; is true, the balances of all children (not just direct children) ;; are included in the calculation. @@ -555,405 +491,3 @@ (if (equal? (car splits) split) (loop (cdr splits)) (cons (car splits) (loop (cdr splits))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; In progress: A suggested function to calculate the weighted average -;; exchange rate between all commodities and the -;; report-commodity. Uses all currency transactions up until the -;; end-date. Returns an alist, see sumlist. -(define (gnc:get-exchange-totals report-commodity end-date) - (let ((curr-accounts - (filter gnc:account-has-shares? (gnc:group-get-subaccounts - (gnc:get-current-group)))) - (query (gnc:malloc-query)) - (splits #f) - ;; sumlist: a multilevel association list. Each element has a - ;; commodity as key, and another alist as a value. The - ;; value-alist's elements consist of a commodity as a key, and - ;; a pair of two value-collectors as value, e.g. with only the - ;; report-commodity DEM in the outer alist: ( {DEM ( [USD (400 - ;; . 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are - ;; and the numbers are a value-collector which - ;; in turn store a . In the example, USD 400 were - ;; bought for an amount of DEM 1000, FRF 300 were bought for - ;; DEM 100. The reason for the outer alist is that there might - ;; be commodity transactions which do not involve the - ;; report-commodity, but which can still be calculated after - ;; *all* transactions are processed. - (sumlist (list (list report-commodity '())))) - - (define (make-newrate unknown-coll un->known-coll known-pair) - (let ((a (make-numeric-collector)) - (b (make-numeric-collector))) - (a 'add (unknown-coll 'total #f)) - (b 'add - (gnc:numeric-div - (gnc:numeric-mul - (un->known-coll 'total #f) - ((cdadr known-pair) 'total #f) - 0 GNC-DENOM-REDUCE) - ((caadr known-pair) 'total #f) - 0 GNC-DENOM-REDUCE)) - ;; in other words: (/ (* (caadr c) (cdadr pair-b)) (caadr - ;; pair-b) )) - (cons a b))) - - (if (not (null? curr-accounts)) - (begin - (gnc:query-set-group query (gnc:get-current-group)) - (gnc:query-add-account-match - query (gnc:list->glist curr-accounts) - 'acct-match-any 'query-and) - (gnc:query-add-date-match-timepair - query #f end-date #t end-date 'query-and) - - ;; Get the query result, i.e. all splits in currency - ;; accounts. - (set! splits (filter - ;; Filter such that we get only those splits - ;; which have two *different* commodities - ;; involved. - (lambda (s) (not (gnc:commodity-equiv? - (gnc:transaction-get-commodity - (gnc:split-get-parent s)) - (gnc:account-get-commodity - (gnc:split-get-account s))))) - (gnc:glist->list - (gnc:query-get-splits query) - ))) - (gnc:free-query query) - -; (warn "report-commodity is " -; (gnc:commodity-value->string -; (list report-commodity (gnc:numeric-zero))) -; report-commodity) - - ;; Now go through all splits and add up all value-amounts - ;; and share-amounts - (for-each - (lambda (a) - (let* ((transaction-comm (gnc:transaction-get-commodity - (gnc:split-get-parent a))) - (account-comm (gnc:account-get-commodity - (gnc:split-get-account a))) - (share-amount (gnc:split-get-share-amount a)) - (value-amount (gnc:split-get-value a)) - (tmp (assoc transaction-comm sumlist)) - (comm-list - (if (not tmp) - (begin -; (warn "not found " -; (gnc:commodity-value->string -; (list account-comm share-amount)) -; ", trying " -; (gnc:commodity-value->string -; (list transaction-comm value-amount)) -; sumlist) - (assoc account-comm sumlist)) - tmp))) -; (if comm-list -; (warn "looking for toplevel comm: " -; (gnc:commodity-value->string -; (list (car comm-list) (gnc:numeric-zero)))) -; (warn "not comm-list")) - - - ;; entry exists already in comm-list? - (if (not comm-list) - ;; no, create sub-alist from scratch - (let ((pair (list transaction-comm - (cons (make-numeric-collector) - (make-numeric-collector))))) -; (warn "XX " (gnc:commodity-value->string -; (list transaction-comm value-amount)) -; (gnc:commodity-value->string -; (list account-comm share-amount))) - ((caadr pair) 'add value-amount) - ((cdadr pair) 'add share-amount) - (set! comm-list (list account-comm (list pair))) - (set! sumlist (cons comm-list sumlist))) - ;; yes, check for second currency. - (let* - ((foreignlist - ;; this will adjust the signs appropriately - (if (gnc:commodity-equiv? transaction-comm - (car comm-list)) - (list account-comm - (gnc:numeric-neg share-amount) - (gnc:numeric-neg value-amount)) - (list transaction-comm - value-amount - share-amount))) - ;; second commodity already existing in comm-list? - (pair (assoc (car foreignlist) (cadr comm-list)))) -; (warn "current transaction " -; (gnc:commodity-value->string -; (list (car foreignlist) (cadr foreignlist))) -; (gnc:commodity-value->string -; (list (car comm-list) (caddr foreignlist)))) - ;; if not, create a new entry in comm-list. - (if (not pair) - (begin - ;;(warn "ZZ ") - (set! - pair (list (car foreignlist) - (cons (make-numeric-collector) - (make-numeric-collector)))) - (set! - comm-list (list (car comm-list) - (cons pair (cadr comm-list)))) - (set! - sumlist (cons comm-list - (alist-delete - (car comm-list) sumlist))))) - ;;(display (gnc:commodity-value->string (list (car - ;;foreignlist) (cadr foreignlist))) - ;;(gnc:commodity-value->string (list report-commodity - ;;(caddr foreignlist))))))) - ((caadr pair) 'add (cadr foreignlist)) - ;;(warn "ZZ6 " sumlist) - ((cdadr pair) 'add (caddr foreignlist)))))) - splits))) - - ;; Now go through all additional toplevel non-report-commodity - ;; balances and add them to report-commodity, if possible. - (let ((reportlist (cadr (assoc report-commodity sumlist)))) - (for-each - (lambda (l) - (if (not (gnc:commodity-equiv? (car l) report-commodity)) - (for-each - (lambda (c) - (let ((pair-a (assoc (car l) reportlist)) - (pair-b (assoc (car c) reportlist)) - (rate (gnc:numeric-zero))) - (if (and (not pair-a) (not pair-b)) - (warn "can't calculate rate for" - (gnc:commodity-value->string - (list (car c) (caadr c))) - " = " - (gnc:commodity-value->string - (list (car l) (cdadr c))) - " to " - (gnc:commodity-value->string - (list report-commodity (gnc:numeric-zero)))) - (if (and pair-a pair-b) - (warn "Oops - what went wrong? Both are found:" - (gnc:commodity-value->string - (list (car c) (caadr c))) - " = " - (gnc:commodity-value->string - (list (car l) (cdadr c)))) - (let - ((newrate - (if (not pair-a) - (list (car l) - (make-newrate (cdadr c) - (caadr c) pair-b)) - (list (car c) - (make-newrate (caadr c) - (cdadr c) pair-a))))) -; (warn "created new rate" -; (gnc:commodity-value->string -; (list (car newrate) -; ((caadr newrate) 'total #f))) -; " = " -; (gnc:commodity-value->string -; (list report-commodity -; ((cdadr newrate) 'total #f)))) - (set! reportlist (cons newrate reportlist))))))) - (cadr l)))) - sumlist) - - reportlist))) - -;; Anybody feel free to reimplement any of these functions, either in -;; scheme or in C. -- cstim - -(define (gnc:make-exchange-alist report-commodity end-date) - ;; This returns the alist with the actual exchange rates, i.e. the - ;; total balances from get-exchange-totals are divided by each - ;; other. - (map - (lambda (e) - (begin - ;;(display (gnc:commodity-value->string (list (car e) ((caadr - ;;e) 'total #f))) (gnc:commodity-value->string (list - ;;report-commodity ((cdadr e) 'total #f)))) -; (warn "rate" -; (gnc:commodity-value->string -; (list (car e) -; ((caadr e) 'total #f))) -; " = " -; (gnc:commodity-value->string -; (list report-commodity -; ((cdadr e) 'total #f)))) - - (list (car e) - (gnc:numeric-abs - (gnc:numeric-div ((cdadr e) 'total #f) - ((caadr e) 'total #f) - ;; 0 stands for GNC_DENOM_AUTO - 0 - GNC-DENOM-REDUCE))))) - (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 . -(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 - 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). -(define (gnc:sum-collector-commodity foreign domestic exchange-fn) - (let ((balance (make-commodity-collector))) - (foreign - 'format - (lambda (curr val) - (if (gnc:commodity-equiv? domestic curr) - (balance 'add domestic val) - (balance 'add domestic - (cadr (exchange-fn (list curr val) 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/report-list.scm b/src/scm/report/report-list.scm index 08fdb09f3f..7aeb9ef529 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -1,6 +1,10 @@ ;; Index file to load all of the releavant reports. (gnc:support "report/report-list.scm") +;; Helper functions for reports (which haven't been included +;; elsewhere) +(gnc:depend "options-utilities.scm") + ;; reports (gnc:depend "report/account-summary.scm") (gnc:depend "report/average-balance.scm") @@ -10,7 +14,3 @@ ;; style sheets (gnc:depend "report/stylesheet-plain.scm") (gnc:depend "report/stylesheet-fancy.scm") - - - -