diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm index fbbf3c2e446..6c204e9a380 100644 --- a/src/report/report-system/commodity-utilities.scm +++ b/src/report/report-system/commodity-utilities.scm @@ -1,17 +1,17 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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. -;; +;; 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: ;; @@ -22,12 +22,12 @@ (define (gnc-commodity-collector-contains-commodity? collector commodity) - (let ((ret #f)) - (gnc-commodity-collector-map - collector - (lambda (comm amt) - (set! ret (or ret (gnc-commodity-equiv comm commodity))))) - ret + (let ((ret #f)) + (gnc-commodity-collector-map + collector + (lambda (comm amt) + (set! ret (or ret (gnc-commodity-equiv comm commodity))))) + ret )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -38,41 +38,41 @@ ;; 'end-date-tp' which have two different commodities involved, one of ;; which is equivalent to 'commodity' (the latter constraint only if ;; 'commodity' != #f ). -(define (gnc:get-match-commodity-splits - currency-accounts end-date-tp commodity) +(define (gnc:get-match-commodity-splits + currency-accounts end-date-tp commodity) (let ((query (qof-query-create-for-splits)) - (splits #f)) - + (splits #f)) + (qof-query-set-book query (gnc-get-current-book)) (gnc:query-set-match-non-voids-only! query (gnc-get-current-book)) (xaccQueryAddAccountMatch query - currency-accounts - QOF-GUID-MATCH-ANY QOF-QUERY-AND) + currency-accounts + QOF-GUID-MATCH-ANY QOF-QUERY-AND) (xaccQueryAddDateMatchTS query #f end-date-tp #t end-date-tp QOF-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) (let ((trans-comm - (xaccTransGetCurrency - (xaccSplitGetParent s))) - (acc-comm - (xaccAccountGetCommodity - (xaccSplitGetAccount s)))) - (and - (not (gnc-commodity-equiv - trans-comm acc-comm)) - (or - (not commodity) - (gnc-commodity-equiv - commodity trans-comm) - (gnc-commodity-equiv - commodity acc-comm))))) - (qof-query-run query))) + (set! splits (filter + ;; Filter such that we get only those splits + ;; which have two *different* commodities + ;; involved. + (lambda (s) (let ((trans-comm + (xaccTransGetCurrency + (xaccSplitGetParent s))) + (acc-comm + (xaccAccountGetCommodity + (xaccSplitGetAccount s)))) + (and + (not (gnc-commodity-equiv + trans-comm acc-comm)) + (or + (not commodity) + (gnc-commodity-equiv + commodity trans-comm) + (gnc-commodity-equiv + commodity acc-comm))))) + (qof-query-run query))) (qof-query-destroy query) splits)) @@ -82,12 +82,12 @@ (define (gnc:get-match-commodity-splits-sorted currency-accounts end-date-tp commodity) - (sort (gnc:get-match-commodity-splits currency-accounts - end-date-tp commodity) - (lambda (a b) - (gnc:timepair-lt - (gnc-transaction-get-date-posted (xaccSplitGetParent a)) - (gnc-transaction-get-date-posted (xaccSplitGetParent b)))))) + (sort (gnc:get-match-commodity-splits currency-accounts + end-date-tp commodity) + (lambda (a b) + (gnc:timepair-lt + (gnc-transaction-get-date-posted (xaccSplitGetParent a)) + (gnc-transaction-get-date-posted (xaccSplitGetParent b)))))) ;; Returns a list of all splits in the currency-accounts up to @@ -108,7 +108,7 @@ ;; Helper for exchange below (define (gnc:exchange-by-euro-numeric - foreign-commodity foreign-numeric domestic date) + foreign-commodity foreign-numeric domestic date) (gnc:exchange-by-euro (gnc:make-gnc-monetary foreign-commodity foreign-numeric) domestic date)) @@ -123,84 +123,84 @@ ;; of lists. Each listelement looks like the list (time price), where ;; 'time' is the timepair when the 'price' was valid. (define (gnc:get-commodity-totalavg-prices - currency-accounts end-date-tp price-commodity report-currency) + currency-accounts end-date-tp price-commodity report-currency) (let ((total-foreign (gnc-numeric-zero)) - (total-domestic (gnc-numeric-zero))) - (filter + (total-domestic (gnc-numeric-zero))) + (filter gnc:price-is-not-zero? (map-in-order (lambda (a) - (let* ((transaction-comm (xaccTransGetCurrency - (xaccSplitGetParent a))) - (account-comm (xaccAccountGetCommodity - (xaccSplitGetAccount a))) - (share-amount (gnc-numeric-abs - (xaccSplitGetAmount a))) - (value-amount (gnc-numeric-abs - (xaccSplitGetValue a))) - (transaction-date (gnc-transaction-get-date-posted - (xaccSplitGetParent a))) - (foreignlist - (if (gnc-commodity-equiv transaction-comm - price-commodity) - (list account-comm - share-amount value-amount) - (list transaction-comm - value-amount share-amount)))) - - ;;(warn "gnc:get-commodity-totalavg-prices: value " - ;; (gnc-commodity-numeric->string - ;;(first foreignlist) (second foreignlist)) - ;; " bought shares " - ;; (gnc-commodity-numeric->string - ;;price-commodity (third foreignlist))) - - ;; Try EURO exchange if necessary - (if (not (gnc-commodity-equiv (first foreignlist) - report-currency)) - (let ((exchanged (gnc:exchange-by-euro-numeric - (first foreignlist) (second foreignlist) - report-currency transaction-date))) - (if exchanged - (set! foreignlist - (list report-currency - (gnc:gnc-monetary-amount exchanged) - (third foreignlist)))))) - - (list - transaction-date - (if (not (gnc-commodity-equiv (first foreignlist) - report-currency)) - (begin - (warn "gnc:get-commodity-totalavg-prices: " - "Sorry, currency exchange not yet implemented:" - (gnc-commodity-numeric->string - (first foreignlist) (second foreignlist)) - " (buying " - (gnc-commodity-numeric->string - price-commodity (third foreignlist)) - ") =? " - (gnc-commodity-numeric->string - report-currency (gnc-numeric-zero))) - (gnc-numeric-zero)) - (begin - (set! total-foreign (gnc-numeric-add total-foreign + (let* ((transaction-comm (xaccTransGetCurrency + (xaccSplitGetParent a))) + (account-comm (xaccAccountGetCommodity + (xaccSplitGetAccount a))) + (share-amount (gnc-numeric-abs + (xaccSplitGetAmount a))) + (value-amount (gnc-numeric-abs + (xaccSplitGetValue a))) + (transaction-date (gnc-transaction-get-date-posted + (xaccSplitGetParent a))) + (foreignlist + (if (gnc-commodity-equiv transaction-comm + price-commodity) + (list account-comm + share-amount value-amount) + (list transaction-comm + value-amount share-amount)))) + + ;;(warn "gnc:get-commodity-totalavg-prices: value " + ;; (gnc-commodity-numeric->string + ;;(first foreignlist) (second foreignlist)) + ;; " bought shares " + ;; (gnc-commodity-numeric->string + ;;price-commodity (third foreignlist))) + + ;; Try EURO exchange if necessary + (if (not (gnc-commodity-equiv (first foreignlist) + report-currency)) + (let ((exchanged (gnc:exchange-by-euro-numeric + (first foreignlist) (second foreignlist) + report-currency transaction-date))) + (if exchanged + (set! foreignlist + (list report-currency + (gnc:gnc-monetary-amount exchanged) + (third foreignlist)))))) + + (list + transaction-date + (if (not (gnc-commodity-equiv (first foreignlist) + report-currency)) + (begin + (warn "gnc:get-commodity-totalavg-prices: " + "Sorry, currency exchange not yet implemented:" + (gnc-commodity-numeric->string + (first foreignlist) (second foreignlist)) + " (buying " + (gnc-commodity-numeric->string + price-commodity (third foreignlist)) + ") =? " + (gnc-commodity-numeric->string + report-currency (gnc-numeric-zero))) + (gnc-numeric-zero)) + (begin + (set! total-foreign (gnc-numeric-add total-foreign (third foreignlist) GNC-DENOM-AUTO GNC-DENOM-LCD)) - (set! total-domestic (gnc-numeric-add total-domestic + (set! total-domestic (gnc-numeric-add total-domestic (second foreignlist) GNC-DENOM-AUTO GNC-DENOM-LCD)) - (gnc-numeric-div - total-domestic - total-foreign - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))) + (gnc-numeric-div + total-domestic + total-foreign + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))) ;; Get all the interesting splits, and sort them according to the ;; date. (gnc:get-match-commodity-splits-sorted - currency-accounts + currency-accounts end-date-tp price-commodity))))) ;; Create a list of prices for all commodities in 'commodity-list', @@ -209,24 +209,24 @@ ;; of the foreign-currency and the appropriate list from ;; gnc:get-commodity-totalavg-prices, see there. (define (gnc:get-commoditylist-totalavg-prices - commodity-list report-currency end-date-tp - start-percent delta-percent) - (let ((currency-accounts - ;;(filter gnc:account-has-shares? - ;; -- use all accounts, not only share accounts, since gnucash-1.7 - (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) - (work-to-do (length commodity-list)) - (work-done 0)) + commodity-list report-currency end-date-tp + start-percent delta-percent) + (let ((currency-accounts + ;;(filter gnc:account-has-shares? + ;; -- use all accounts, not only share accounts, since gnucash-1.7 + (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) + (work-to-do (length commodity-list)) + (work-done 0)) (map (lambda (c) (begin - (set! work-done (+ 1 work-done)) - (if start-percent - (gnc:report-percent-done - (+ start-percent (* delta-percent (/ work-done work-to-do))))) - (cons c - (gnc:get-commodity-totalavg-prices - currency-accounts end-date-tp c report-currency)))) + (set! work-done (+ 1 work-done)) + (if start-percent + (gnc:report-percent-done + (+ start-percent (* delta-percent (/ work-done work-to-do))))) + (cons c + (gnc:get-commodity-totalavg-prices + currency-accounts end-date-tp c report-currency)))) commodity-list))) ;; Get the instantaneous prices for the 'price-commodity', measured in @@ -236,72 +236,72 @@ ;; the list (time price), where 'time' is the timepair when the ;; 'price' was valid. (define (gnc:get-commodity-inst-prices - currency-accounts end-date-tp price-commodity report-currency) + currency-accounts end-date-tp price-commodity report-currency) ;; go through all splits; convert all splits into a price. - (filter + (filter gnc:price-is-not-zero? (map-in-order (lambda (a) (let* ((transaction-comm (xaccTransGetCurrency - (xaccSplitGetParent a))) - (account-comm (xaccAccountGetCommodity - (xaccSplitGetAccount a))) - (share-amount (gnc-numeric-abs - (xaccSplitGetAmount a))) - (value-amount (gnc-numeric-abs - (xaccSplitGetValue a))) - (transaction-date (gnc-transaction-get-date-posted - (xaccSplitGetParent a))) - (foreignlist - (if (gnc-commodity-equiv transaction-comm price-commodity) - (list account-comm - share-amount value-amount) - (list transaction-comm - value-amount share-amount)))) - - ;;(warn "get-commodity-inst-prices: value " - ;; (gnc-commodity-numeric->string - ;; (first foreignlist) (second foreignlist)) - ;; " bought shares " - ;;(gnc-commodity-numeric->string - ;; price-commodity (third foreignlist))) - - ;; Try EURO exchange if necessary - (if (not (gnc-commodity-equiv (first foreignlist) - report-currency)) - (let ((exchanged (gnc:exchange-by-euro-numeric - (first foreignlist) (second foreignlist) - report-currency transaction-date))) - (if exchanged - (set! foreignlist - (list report-currency - (gnc:gnc-monetary-amount exchanged) - (third foreignlist)))))) - - (list - transaction-date - (if (not (gnc-commodity-equiv (first foreignlist) - report-currency)) - (begin - (warn "get-commodity-inst-prices: " - "Sorry, currency exchange not yet implemented:" - (gnc-commodity-numeric->string - (first foreignlist) (second foreignlist)) - " (buying " - (gnc-commodity-numeric->string - price-commodity (third foreignlist)) - ") =? " - (gnc-commodity-numeric->string - report-currency (gnc-numeric-zero))) - (gnc-numeric-zero)) - (gnc-numeric-div - (second foreignlist) - (third foreignlist) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))) + (xaccSplitGetParent a))) + (account-comm (xaccAccountGetCommodity + (xaccSplitGetAccount a))) + (share-amount (gnc-numeric-abs + (xaccSplitGetAmount a))) + (value-amount (gnc-numeric-abs + (xaccSplitGetValue a))) + (transaction-date (gnc-transaction-get-date-posted + (xaccSplitGetParent a))) + (foreignlist + (if (gnc-commodity-equiv transaction-comm price-commodity) + (list account-comm + share-amount value-amount) + (list transaction-comm + value-amount share-amount)))) + + ;;(warn "get-commodity-inst-prices: value " + ;; (gnc-commodity-numeric->string + ;; (first foreignlist) (second foreignlist)) + ;; " bought shares " + ;;(gnc-commodity-numeric->string + ;; price-commodity (third foreignlist))) + + ;; Try EURO exchange if necessary + (if (not (gnc-commodity-equiv (first foreignlist) + report-currency)) + (let ((exchanged (gnc:exchange-by-euro-numeric + (first foreignlist) (second foreignlist) + report-currency transaction-date))) + (if exchanged + (set! foreignlist + (list report-currency + (gnc:gnc-monetary-amount exchanged) + (third foreignlist)))))) + + (list + transaction-date + (if (not (gnc-commodity-equiv (first foreignlist) + report-currency)) + (begin + (warn "get-commodity-inst-prices: " + "Sorry, currency exchange not yet implemented:" + (gnc-commodity-numeric->string + (first foreignlist) (second foreignlist)) + " (buying " + (gnc-commodity-numeric->string + price-commodity (third foreignlist)) + ") =? " + (gnc-commodity-numeric->string + report-currency (gnc-numeric-zero))) + (gnc-numeric-zero)) + (gnc-numeric-div + (second foreignlist) + (third foreignlist) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))) ;; Get all the interesting splits, sorted by date. (gnc:get-match-commodity-splits-sorted - currency-accounts + currency-accounts end-date-tp price-commodity)))) ;; Get the instantaneous prices for all commodities in @@ -310,24 +310,24 @@ ;; consists of the foreign-currency and the appropriate list from ;; gnc:get-commodity-inst-prices, see there. (define (gnc:get-commoditylist-inst-prices - commodity-list report-currency end-date-tp - start-percent delta-percent) - (let ((currency-accounts - ;;(filter gnc:account-has-shares? - ;; -- use all accounts, not only share accounts, since gnucash-1.7 - (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) - (work-to-do (length commodity-list)) - (work-done 0)) + commodity-list report-currency end-date-tp + start-percent delta-percent) + (let ((currency-accounts + ;;(filter gnc:account-has-shares? + ;; -- use all accounts, not only share accounts, since gnucash-1.7 + (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) + (work-to-do (length commodity-list)) + (work-done 0)) (map (lambda (c) (begin - (set! work-done (+ 1 work-done)) - (if start-percent - (gnc:report-percent-done - (+ start-percent (* delta-percent (/ work-done work-to-do))))) - (cons c - (gnc:get-commodity-inst-prices - currency-accounts end-date-tp c report-currency)))) + (set! work-done (+ 1 work-done)) + (if start-percent + (gnc:report-percent-done + (+ start-percent (* delta-percent (/ work-done work-to-do))))) + (cons c + (gnc:get-commodity-inst-prices + currency-accounts end-date-tp c report-currency)))) commodity-list))) @@ -336,48 +336,48 @@ ;; e.g. gnc:get-commodity-totalavg-prices. Returns a or, ;; if pricelist was empty, #f. (define (gnc:pricelist-price-find-nearest - pricelist date) - (let* ((later (find (lambda (p) - (gnc:timepair-lt date (first p))) - pricelist)) - (earlierlist (take-while - (lambda (p) - (gnc:timepair-ge date (first p))) - pricelist)) - (earlier (and (not (null? earlierlist)) - (last earlierlist)))) - ;; (if earlier - ;; (warn "earlier" - ;; (gnc-print-date (first earlier)) - ;; (gnc-numeric-to-double (second earlier)))) - ;; (if later - ;; (warn "later" - ;; (gnc-print-date (first later)) - ;; (gnc-numeric-to-double (second later)))) - + pricelist date) + (let* ((later (find (lambda (p) + (gnc:timepair-lt date (first p))) + pricelist)) + (earlierlist (take-while + (lambda (p) + (gnc:timepair-ge date (first p))) + pricelist)) + (earlier (and (not (null? earlierlist)) + (last earlierlist)))) + ;; (if earlier + ;; (warn "earlier" + ;; (gnc-print-date (first earlier)) + ;; (gnc-numeric-to-double (second earlier)))) + ;; (if later + ;; (warn "later" + ;; (gnc-print-date (first later)) + ;; (gnc-numeric-to-double (second later)))) + (if (and earlier later) - (if (< (abs (gnc:timepair-delta date (first earlier))) - (abs (gnc:timepair-delta date (first later)))) - (second earlier) - (second later)) - (or - (and earlier (second earlier)) - (and later (second later)))))) + (if (< (abs (gnc:timepair-delta date (first earlier))) + (abs (gnc:timepair-delta date (first later)))) + (second earlier) + (second later)) + (or + (and earlier (second earlier)) + (and later (second later)))))) ;; Find the price of the 'commodity' in the 'pricealist' that is ;; nearest to the 'date'. (define (gnc:pricealist-lookup-nearest-in-time - pricealist commodity date) + pricealist commodity date) (let ((plist (assoc-ref pricealist commodity))) (if (and plist (not (null? plist))) - (let ((price - (gnc:pricelist-price-find-nearest - plist date))) - (if price - price - (gnc-numeric-zero))) - (gnc-numeric-zero)))) + (let ((price + (gnc:pricelist-price-find-nearest + plist date))) + (if price + price + (gnc-numeric-zero))) + (gnc-numeric-zero)))) @@ -404,117 +404,117 @@ ;; real variable names below. (define (make-newrate unknown-coll un->known-coll known-pair) (let ((a (gnc:make-numeric-collector)) - (b (gnc:make-numeric-collector))) - (a 'add (unknown-coll 'total #f)) - (b 'add - ;; round to (at least) 8 significant digits - (gnc-numeric-div - (gnc-numeric-mul - (un->known-coll 'total #f) - ((cdadr known-pair) 'total #f) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 9) GNC-RND-ROUND)) - ((caadr known-pair) 'total #f) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))) - ;; in other words: (/ (* (caadr un->known-coll) (cdadr - ;; known-pair)) (caadr known-pair) )) - (cons a b))) + (b (gnc:make-numeric-collector))) + (a 'add (unknown-coll 'total #f)) + (b 'add + ;; round to (at least) 8 significant digits + (gnc-numeric-div + (gnc-numeric-mul + (un->known-coll 'total #f) + ((cdadr known-pair) 'total #f) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 9) GNC-RND-ROUND)) + ((caadr known-pair) 'total #f) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))) + ;; 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) - ;; Check whether by any accident the report-commodity - ;; appears here. - (if - (not (gnc-commodity-equiv (car pair) report-commodity)) - ;; pair-{a,b}: Try to find either the currency of - ;; otherlist or of pair in reportlist. - (let ((pair-a - (or - ;; Find the otherlist's currency in reportlist - (assoc (car otherlist) reportlist) - ;; Or try whether that's an Euro currency. - (let - ((euro-monetary - (gnc:exchange-by-euro (gnc:make-gnc-monetary - (car otherlist) - ((cdadr pair) 'total #f)) - report-commodity #f))) - ;; If this is an Euro currency, create the - ;; pair of appropriately exchanged amounts. - (if euro-monetary - (let ((a (gnc:make-numeric-collector))) - (a 'add - (gnc:gnc-monetary-amount euro-monetary)) - (list report-commodity - (cons (cdadr pair) a))) - #f)))) - ;; Find the pair's currency in reportlist. FIXME: - ;; Also try the Euro here. - (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 "gnc:resolve-unknown-comm:" - "can't calculate rate for " - (gnc-commodity-value->string - (list (car pair) ((caadr pair) 'total #f))) - " = " - (gnc-commodity-value->string - (list (car otherlist) ((cdadr pair) 'total #f))) - " 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 "gnc:resolve-unknown-comm:" - "Oops - exchange rate ambiguity error: " - (gnc-commodity-value->string - (list (car pair) ((caadr pair) 'total #f))) - " = " - (gnc-commodity-value->string - (list (car otherlist) - ((cdadr pair) 'total #f)))) - (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)))))) - ;; Huh, the report-currency showed up on the wrong side - ;; -- we will just add it to the reportlist on the - ;; right side. - (let ((newrate (list (car otherlist) - (cons (cdadr pair) (caadr pair))))) - ;; (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)))) + (for-each + (lambda (pair) + ;; Check whether by any accident the report-commodity + ;; appears here. + (if + (not (gnc-commodity-equiv (car pair) report-commodity)) + ;; pair-{a,b}: Try to find either the currency of + ;; otherlist or of pair in reportlist. + (let ((pair-a + (or + ;; Find the otherlist's currency in reportlist + (assoc (car otherlist) reportlist) + ;; Or try whether that's an Euro currency. + (let + ((euro-monetary + (gnc:exchange-by-euro (gnc:make-gnc-monetary + (car otherlist) + ((cdadr pair) 'total #f)) + report-commodity #f))) + ;; If this is an Euro currency, create the + ;; pair of appropriately exchanged amounts. + (if euro-monetary + (let ((a (gnc:make-numeric-collector))) + (a 'add + (gnc:gnc-monetary-amount euro-monetary)) + (list report-commodity + (cons (cdadr pair) a))) + #f)))) + ;; Find the pair's currency in reportlist. FIXME: + ;; Also try the Euro here. + (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 "gnc:resolve-unknown-comm:" + "can't calculate rate for " + (gnc-commodity-value->string + (list (car pair) ((caadr pair) 'total #f))) + " = " + (gnc-commodity-value->string + (list (car otherlist) ((cdadr pair) 'total #f))) + " 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 "gnc:resolve-unknown-comm:" + "Oops - exchange rate ambiguity error: " + (gnc-commodity-value->string + (list (car pair) ((caadr pair) 'total #f))) + " = " + (gnc-commodity-value->string + (list (car otherlist) + ((cdadr pair) 'total #f)))) + (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)))))) + ;; Huh, the report-currency showed up on the wrong side + ;; -- we will just add it to the reportlist on the + ;; right side. + (let ((newrate (list (car otherlist) + (cons (cdadr pair) (caadr pair))))) + ;; (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. @@ -531,178 +531,178 @@ ;; 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? )) - ;; -- use all accounts, not only share accounts, since gnucash-1.7 - (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) - ;; 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 '())))) + (let ((curr-accounts + ;;(filter gnc:account-has-shares? )) + ;; -- use all accounts, not only share accounts, since gnucash-1.7 + (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) + ;; 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 (xaccTransGetCurrency - (xaccSplitGetParent a))) - (account-comm (xaccAccountGetCommodity - (xaccSplitGetAccount a))) - ;; Always use the absolute value here. - (share-amount (gnc-numeric-abs - (xaccSplitGetAmount a))) - (value-amount (gnc-numeric-abs - (xaccSplitGetValue a))) - (tmp (assoc transaction-comm sumlist)) - (comm-list (if (not tmp) - (assoc account-comm sumlist) - tmp))) - + ;; Go through all splits and add up all value-amounts + ;; and share-amounts + (for-each + (lambda (a) + (let* ((transaction-comm (xaccTransGetCurrency + (xaccSplitGetParent a))) + (account-comm (xaccAccountGetCommodity + (xaccSplitGetAccount a))) + ;; Always use the absolute value here. + (share-amount (gnc-numeric-abs + (xaccSplitGetAmount a))) + (value-amount (gnc-numeric-abs + (xaccSplitGetValue a))) + (tmp (assoc transaction-comm sumlist)) + (comm-list (if (not tmp) + (assoc account-comm sumlist) + tmp))) + (cond ((gnc-numeric-zero-p share-amount) ;; Without shares this is not a buy or sell; ignore it. #f) ((not comm-list) - ;; entry doesn't exist in comm-list - ;; create sub-alist from scratch - (let ((pair (list transaction-comm - (cons (gnc:make-numeric-collector) - (gnc: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)))) + ;; entry doesn't exist in comm-list + ;; create sub-alist from scratch + (let ((pair (list transaction-comm + (cons (gnc:make-numeric-collector) + (gnc: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)))) (else - (let* - ;; Put the amounts in the right place. - ((foreignlist - (if (gnc-commodity-equiv transaction-comm - (car comm-list)) - (list account-comm - share-amount 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 (gnc:make-numeric-collector) - (gnc: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))) - + (let* + ;; Put the amounts in the right place. + ((foreignlist + (if (gnc-commodity-equiv transaction-comm + (car comm-list)) + (list account-comm + share-amount 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 (gnc:make-numeric-collector) + (gnc: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))) ;; Calculate the volume-weighted average cost of all commodities, ;; priced in the 'report-commodity'. Uses all transactions up until ;; the 'end-date'. Returns an alist, see sumlist. (define (gnc:get-exchange-cost-totals report-commodity end-date) - (let ((curr-accounts - ;;(filter gnc:account-has-shares? )) - ;; -- use all accounts, not only share accounts, since gnucash-1.7 - (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) - ;; 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 '())))) + (let ((curr-accounts + ;;(filter gnc:account-has-shares? )) + ;; -- use all accounts, not only share accounts, since gnucash-1.7 + (gnc-account-get-descendants-sorted (gnc-get-current-root-account))) + ;; 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 - ;; However skip splits in trading accounts as these counterbalance - ;; the actual value and share amounts back to zero - (for-each - (lambda (a) - (if (not (eq? (xaccAccountGetType (xaccSplitGetAccount a)) ACCT-TYPE-TRADING)) - (let* ((transaction-comm (xaccTransGetCurrency - (xaccSplitGetParent a))) - (account-comm (xaccAccountGetCommodity - (xaccSplitGetAccount a))) - (share-amount (xaccSplitGetAmount a)) - (value-amount (xaccSplitGetValue 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 (gnc:make-numeric-collector) - (gnc: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* - ;; Put the amounts in the right place. - ((foreignlist - (if (gnc-commodity-equiv transaction-comm - (car comm-list)) - (list account-comm - share-amount value-amount) - (list transaction-comm - (gnc-numeric-neg value-amount) - (gnc-numeric-neg 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 (gnc:make-numeric-collector) - (gnc: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))) - + ;; Go through all splits and add up all value-amounts + ;; and share-amounts + ;; However skip splits in trading accounts as these counterbalance + ;; the actual value and share amounts back to zero + (for-each + (lambda (a) + (if (not (eq? (xaccAccountGetType (xaccSplitGetAccount a)) ACCT-TYPE-TRADING)) + (let* ((transaction-comm (xaccTransGetCurrency + (xaccSplitGetParent a))) + (account-comm (xaccAccountGetCommodity + (xaccSplitGetAccount a))) + (share-amount (xaccSplitGetAmount a)) + (value-amount (xaccSplitGetValue 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 (gnc:make-numeric-collector) + (gnc: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* + ;; Put the amounts in the right place. + ((foreignlist + (if (gnc-commodity-equiv transaction-comm + (car comm-list)) + (list account-comm + share-amount value-amount) + (list transaction-comm + (gnc-numeric-neg value-amount) + (gnc-numeric-neg 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 (gnc:make-numeric-collector) + (gnc: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 @@ -712,28 +712,28 @@ ;; This returns the alist with the actual exchange rates, i.e. the ;; total balances from get-exchange-totals are divided by each ;; other. - (map + (map (lambda (e) - (list (car e) - (gnc-numeric-abs - (gnc-numeric-div ((cdadr e) 'total #f) - ((caadr e) 'total #f) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))) + (list (car e) + (gnc-numeric-abs + (gnc-numeric-div ((cdadr e) 'total #f) + ((caadr e) 'total #f) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))) (gnc:get-exchange-totals report-commodity end-date))) (define (gnc:make-exchange-cost-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 + (map (lambda (e) - (list (car e) - (gnc-numeric-abs - (gnc-numeric-div ((cdadr e) 'total #f) - ((caadr e) 'total #f) - GNC-DENOM-AUTO - (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))) + (list (car e) + (gnc-numeric-abs + (gnc-numeric-div ((cdadr e) 'total #f) + ((caadr e) 'total #f) + GNC-DENOM-AUTO + (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))) (gnc:get-exchange-cost-totals report-commodity end-date))) @@ -756,15 +756,15 @@ (gnc-is-euro-currency (gnc:gnc-monetary-commodity foreign)) ;; FIXME: implement the date check. (gnc:make-gnc-monetary - domestic - (gnc-convert-from-euro - domestic - (gnc-convert-to-euro (gnc:gnc-monetary-commodity foreign) - (gnc:gnc-monetary-amount foreign)))))) + domestic + (gnc-convert-from-euro + domestic + (gnc-convert-to-euro (gnc:gnc-monetary-commodity foreign) + (gnc:gnc-monetary-amount foreign)))))) ;; A trivial exchange function - if the "foreign" monetary amount -;; and the domestic currency are the same, return the foreign +;; and the domestic currency are the same, return the foreign ;; amount unchanged, otherwise return 0 ;; WARNING: many uses of exchange functions assume that the function @@ -806,21 +806,21 @@ ;; 'foreign' into the 'domestic' by ;; the 'price-value'. Returns a . (define (gnc:exchange-by-pricevalue-helper - foreign domestic price-value) + foreign domestic price-value) (if (gnc:gnc-monetary? foreign) - (gnc:make-gnc-monetary + (gnc:make-gnc-monetary domestic (if price-value - (gnc-numeric-mul (gnc:gnc-monetary-amount foreign) - price-value - (gnc-commodity-get-fraction domestic) - GNC-RND-ROUND) - (begin - (warn "gnc:exchange-by-pricevalue-helper: No price found for " - (gnc:monetary->string foreign) " into " - (gnc:monetary->string - (gnc:make-gnc-monetary domestic (gnc-numeric-zero)))) - (gnc-numeric-zero)))) + (gnc-numeric-mul (gnc:gnc-monetary-amount foreign) + price-value + (gnc-commodity-get-fraction domestic) + GNC-RND-ROUND) + (begin + (warn "gnc:exchange-by-pricevalue-helper: No price found for " + (gnc:monetary->string foreign) " into " + (gnc:monetary->string + (gnc:make-gnc-monetary domestic (gnc-numeric-zero)))) + (gnc-numeric-zero)))) #f)) ;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for @@ -828,24 +828,24 @@ ;; 'foreign' into the 'domestic' by the ;; 'price'. Returns a . (define (gnc:exchange-by-pricedb-helper - foreign domestic price) + foreign domestic price) (if (gnc:gnc-monetary? foreign) - (gnc:make-gnc-monetary + (gnc:make-gnc-monetary domestic (if price - (let ((result - (gnc-numeric-mul (gnc:gnc-monetary-amount foreign) - (gnc-price-get-value price) - (gnc-commodity-get-fraction domestic) - GNC-RND-ROUND))) - (gnc-price-unref price) - result) - (begin - (warn "gnc:exchange-by-pricedb-helper: No price found for " - (gnc:monetary->string foreign) " into " - (gnc:monetary->string - (gnc:make-gnc-monetary domestic (gnc-numeric-zero)))) - (gnc-numeric-zero)))) + (let ((result + (gnc-numeric-mul (gnc:gnc-monetary-amount foreign) + (gnc-price-get-value price) + (gnc-commodity-get-fraction domestic) + GNC-RND-ROUND))) + (gnc-price-unref price) + result) + (begin + (warn "gnc:exchange-by-pricedb-helper: No price found for " + (gnc:monetary->string foreign) " into " + (gnc:monetary->string + (gnc:make-gnc-monetary domestic (gnc-numeric-zero)))) + (gnc-numeric-zero)))) #f)) ;; This is another ready-to-use function for calculation of exchange @@ -855,18 +855,18 @@ ;; 'domestic' commodity. It exchanges the amount into the domestic ;; currency, using the latest price from the pricedb. The function ;; returns a . -(define (gnc:exchange-by-pricedb-latest - foreign domestic) +(define (gnc:exchange-by-pricedb-latest + foreign domestic) (if (and (record? foreign) (gnc:gnc-monetary? foreign)) (or (gnc:exchange-by-euro foreign domestic #f) - (gnc:exchange-if-same foreign domestic) - (gnc:make-gnc-monetary - domestic - (gnc-pricedb-convert-balance-latest-price - (gnc-pricedb-get-db (gnc-get-current-book)) - (gnc:gnc-monetary-amount foreign) - (gnc:gnc-monetary-commodity foreign) - domestic))) + (gnc:exchange-if-same foreign domestic) + (gnc:make-gnc-monetary + domestic + (gnc-pricedb-convert-balance-latest-price + (gnc-pricedb-get-db (gnc-get-current-book)) + (gnc:gnc-monetary-amount foreign) + (gnc:gnc-monetary-commodity foreign) + domestic))) #f)) ;; Yet another ready-to-use function for calculation of exchange @@ -878,18 +878,18 @@ ;; pricedb according to the given date. The function returns a ;; . (define (gnc:exchange-by-pricedb-nearest - foreign domestic date) + foreign domestic date) (if (and (record? foreign) (gnc:gnc-monetary? foreign) - date) + date) (or (gnc:exchange-by-euro foreign domestic date) - (gnc:exchange-if-same foreign domestic) - (gnc:make-gnc-monetary - domestic - (gnc-pricedb-convert-balance-nearest-price - (gnc-pricedb-get-db (gnc-get-current-book)) - (gnc:gnc-monetary-amount foreign) - (gnc:gnc-monetary-commodity foreign) - domestic (timespecCanonicalDayTime date)))) + (gnc:exchange-if-same foreign domestic) + (gnc:make-gnc-monetary + domestic + (gnc-pricedb-convert-balance-nearest-price + (gnc-pricedb-get-db (gnc-get-current-book)) + (gnc:gnc-monetary-amount foreign) + (gnc:gnc-monetary-commodity foreign) + domestic (timespecCanonicalDayTime date)))) #f)) ;; Exchange by the nearest price from pricelist. This function takes @@ -899,25 +899,25 @@ ;; using the price nearest to 'data' found in the pricelist. The ;; function returns a . (define (gnc:exchange-by-pricealist-nearest - pricealist foreign domestic date) - (begin + pricealist foreign domestic date) + (begin (gnc:debug "foreign " (gnc:monetary->string foreign)) (gnc:debug "domestic " (gnc-commodity-get-printname domestic)) (gnc:debug "pricealist " pricealist) - + (if (and (record? foreign) (gnc:gnc-monetary? foreign) - date) - (or (gnc:exchange-by-euro foreign domestic date) - (gnc:exchange-if-same foreign domestic) - (if (not (null? pricealist)) - (gnc:exchange-by-pricevalue-helper - foreign domestic - (gnc:pricealist-lookup-nearest-in-time - pricealist (gnc:gnc-monetary-commodity foreign) date)) - #f)) - #f))) + date) + (or (gnc:exchange-by-euro foreign domestic date) + (gnc:exchange-if-same foreign domestic) + (if (not (null? pricealist)) + (gnc:exchange-by-pricevalue-helper + foreign domestic + (gnc:pricealist-lookup-nearest-in-time + pricealist (gnc:gnc-monetary-commodity foreign) date)) + #f)) + #f))) + - @@ -929,32 +929,32 @@ ;; Return a ready-to-use function. Which one to use is determined by ;; the value of 'source-option', whose possible values are set in ;; gnc:options-add-price-source!. -(define (gnc:case-exchange-fn - source-option report-currency to-date-tp) +(define (gnc:case-exchange-fn + source-option report-currency to-date-tp) (case source-option - ((average-cost) (gnc:make-exchange-function + ((average-cost) (gnc:make-exchange-function (gnc:make-exchange-cost-alist report-currency to-date-tp))) - ((weighted-average) (gnc:make-exchange-function - (gnc:make-exchange-alist - report-currency to-date-tp))) + ((weighted-average) (gnc:make-exchange-function + (gnc:make-exchange-alist + report-currency to-date-tp))) ((pricedb-latest) gnc:exchange-by-pricedb-latest) ((pricedb-nearest) (lambda (foreign domestic) - (gnc:exchange-by-pricedb-nearest - foreign domestic to-date-tp))) - (else + (gnc:exchange-by-pricedb-nearest + foreign domestic to-date-tp))) + (else (begin - ;; FIX-ME + ;; FIX-ME ;; this is a hack to prevent report crashing if a report ;; implements source-options that aren't fully implemented. We ;; return a reasonably sane fallback function: nearest. ;; ;; known to be missing: pricedb-latest-before - (gnc:warn "gnc:case-exchange-fn: bad price-source value: " - source-option " using pricedb-nearest.") + (gnc:warn "gnc:case-exchange-fn: bad price-source value: " + source-option " using pricedb-nearest.") (lambda (foreign domestic) - (gnc:exchange-by-pricedb-nearest - foreign domestic to-date-tp)))))) + (gnc:exchange-by-pricedb-nearest + foreign domestic to-date-tp)))))) ;; Return a ready-to-use function. Which one to use is determined by ;; the value of 'source-option', whose possible values are set in @@ -963,36 +963,36 @@ ;; start-percent, delta-percent: Fill in the [start:start+delta] ;; section of the progress bar while running this function. ;; -(define (gnc:case-exchange-time-fn - source-option report-currency commodity-list to-date-tp - start-percent delta-percent) +(define (gnc:case-exchange-time-fn + source-option report-currency commodity-list to-date-tp + start-percent delta-percent) (case source-option ;; Make this the same as gnc:case-exchange-fn ((average-cost) (let* ((exchange-fn (gnc:make-exchange-function (gnc:make-exchange-cost-alist - report-currency to-date-tp)))) + report-currency to-date-tp)))) (lambda (foreign domestic date) - (exchange-fn foreign domestic)))) + (exchange-fn foreign domestic)))) ((weighted-average) (let ((pricealist - (gnc:get-commoditylist-totalavg-prices - commodity-list report-currency to-date-tp - start-percent delta-percent))) - (lambda (foreign domestic date) - (gnc:exchange-by-pricealist-nearest - pricealist foreign domestic date)))) + (gnc:get-commoditylist-totalavg-prices + commodity-list report-currency to-date-tp + start-percent delta-percent))) + (lambda (foreign domestic date) + (gnc:exchange-by-pricealist-nearest + pricealist foreign domestic date)))) ((actual-transactions) (let ((pricealist - (gnc:get-commoditylist-inst-prices - commodity-list report-currency to-date-tp))) - (lambda (foreign domestic date) - (gnc:exchange-by-pricealist-nearest - pricealist foreign domestic date)))) + (gnc:get-commoditylist-inst-prices + commodity-list report-currency to-date-tp))) + (lambda (foreign domestic date) + (gnc:exchange-by-pricealist-nearest + pricealist foreign domestic date)))) ((pricedb-latest) (lambda (foreign domestic date) - (gnc:exchange-by-pricedb-latest foreign domestic))) + (gnc:exchange-by-pricedb-latest foreign domestic))) ((pricedb-nearest) gnc:exchange-by-pricedb-nearest) - (else + (else (begin - (gnc:warn "gnc:case-exchange-time-fn: bad price-source value: " - source-option ". Using pricedb-nearest.") + (gnc:warn "gnc:case-exchange-time-fn: bad price-source value: " + source-option ". Using pricedb-nearest.") ;; FIX-ME another hack to prevent report crashing when an ;; unimplemented source-option comes through gnc:exchange-by-pricedb-nearest @@ -1051,44 +1051,43 @@ (define (gnc:sum-collector-stocks foreign domestic exchange-fn) (if foreign (let ((balance (gnc:make-commodity-collector))) - (foreign - 'format - (lambda (curr val) - (if (gnc-commodity-equiv domestic curr) - (balance 'add domestic val) - (if (gnc-commodity-is-currency curr) - (balance 'add curr val) - (balance 'add domestic - (gnc:gnc-monetary-amount - (exchange-fn (gnc:make-gnc-monetary curr val) - domestic)))))) - #f) - balance) + (foreign + 'format + (lambda (curr val) + (if (gnc-commodity-equiv domestic curr) + (balance 'add domestic val) + (if (gnc-commodity-is-currency curr) + (balance 'add curr val) + (balance 'add domestic + (gnc:gnc-monetary-amount + (exchange-fn (gnc:make-gnc-monetary curr val) + domestic)))))) + #f) + balance) #f)) ;; Returns the number of commodities in a commodity-collector. ;; (If this were implemented as a record, I would be able to ;; just (length ...) the alist, but....) (define (gnc-commodity-collector-commodity-count collector) - (let ((commodities 0)) - (gnc-commodity-collector-map - collector - (lambda (comm amt) - (set! commodities (+ commodities 1)))) - commodities + (let ((commodities 0)) + (gnc-commodity-collector-map + collector + (lambda (comm amt) + (set! commodities (+ commodities 1)))) + commodities )) (define (gnc:uniform-commodity? amt report-commodity) ;; function to see if the commodity-collector amt ;; contains any foreign commodities (let ((elts (gnc-commodity-collector-commodity-count amt)) - ) + ) (or (equal? elts 0) - (and (equal? elts 1) - (gnc-commodity-collector-contains-commodity? - amt report-commodity) - ) - ) + (and (equal? elts 1) + (gnc-commodity-collector-contains-commodity? + amt report-commodity) + ) + ) ) ) -