gnucash unstable: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Thu Feb 15 14:04:29 EST 2018
Updated via https://github.com/Gnucash/gnucash/commit/04408650 (commit)
via https://github.com/Gnucash/gnucash/commit/b3b37838 (commit)
via https://github.com/Gnucash/gnucash/commit/1999d853 (commit)
via https://github.com/Gnucash/gnucash/commit/604a2d08 (commit)
from https://github.com/Gnucash/gnucash/commit/33d43459 (commit)
commit 04408650c1cf2c871a1844020f9bb68c56e8c890
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Feb 15 11:04:15 2018 -0800
Fix double free, caused test to crash on Mac.
diff --git a/libgnucash/core-utils/test/test-userdata-dir.c b/libgnucash/core-utils/test/test-userdata-dir.c
index 5a8cd5c..a702a56 100644
--- a/libgnucash/core-utils/test/test-userdata-dir.c
+++ b/libgnucash/core-utils/test/test-userdata-dir.c
@@ -338,7 +338,6 @@ main(int argc, char **argv)
/* Clean up the temporaries that were created for the GNC_DATA_HOME test run */
g_free (home_dir);
- g_free (tmp_dir);
tmp_dir = g_build_filename(gnc_data_home_dir, "data", (gchar *)NULL);
g_rmdir (tmp_dir);
g_free (tmp_dir);
commit b3b378380934958ce72ff52850a975f49d20e88d
Merge: 33d4345 1999d85
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Feb 15 10:56:43 2018 -0800
Merge branch 'maint' into unstable
diff --cc gnucash/report/report-system/commodity-utilities.scm
index 9cadf7e,0000000..a12d57d
mode 100644,000000..100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@@ -1,988 -1,0 +1,988 @@@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; commodity-utilities.scm: Functions for handling different commodities.
+;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
+;;
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation Voice: +1-617-542-5942
+;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
+;; Boston, MA 02110-1301, USA gnu at gnu.org
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(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
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to get splits with interesting data from accounts.
+
+
+;; Returns a list of all splits in the 'currency-accounts' up to
+;; 'end-date' 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 commodity)
+ (let ((query (qof-query-create-for-splits))
+ (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)
+ (xaccQueryAddDateMatchTT
+ query #f end-date #t end-date 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)))
+ (acc-type
+ (xaccAccountGetType
+ (xaccSplitGetAccount s)))
+ (split-amt
+ (xaccSplitGetAmount s))
+ )
+ (and
+ ;; Same commodities, so no price:
+ (not (gnc-commodity-equiv
+ trans-comm acc-comm))
+ (or
+ ;; No commodity, bad split
+ (not commodity)
+ ;; Not a price that interests us
+ (gnc-commodity-equiv commodity trans-comm)
+ (gnc-commodity-equiv commodity acc-comm))
+ ;; No amount, so no price:
+ (not (gnc-numeric-zero-p split-amt))
+ ;; no trading accounts so we don't count twice
+ (not (eq? acc-type ACCT-TYPE-TRADING))
+ )))
+ (qof-query-run query)))
+ (qof-query-destroy query)
+ splits))
+
+;; Returns a sorted list of all splits in the 'currency-accounts' up
+;; to 'end-date' which have the 'commodity' and one other commodity
+;; involved. The splits are sorted by date.
+(define (gnc:get-match-commodity-splits-sorted currency-accounts
+ end-date
+ commodity)
+ (sort (gnc:get-match-commodity-splits currency-accounts
+ end-date commodity)
+ (lambda (a b)
+ (< (xaccTransGetDate (xaccSplitGetParent a))
+ (xaccTransGetDate (xaccSplitGetParent b))))))
+
+
+;; 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)
+ (gnc:get-match-commodity-splits currency-accounts end-date #f))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to create some list of prices from data in transactions.
+
+
+;; Helper for warnings below.
+(define (gnc-commodity-numeric->string commodity numeric)
+ (gnc:monetary->string
+ (gnc:make-gnc-monetary commodity numeric)))
+
+;; Helper for exchange below
+(define (gnc:exchange-by-euro-numeric
+ foreign-commodity foreign-numeric domestic date)
+ (gnc:exchange-by-euro
+ (gnc:make-gnc-monetary foreign-commodity foreign-numeric)
+ domestic date))
+
+;; Returns true if the given pricealist element is a non-zero price.
+(define (gnc:price-is-not-zero? elem)
+ (not (gnc-numeric-zero-p (second elem))))
+
+;; Create a list of all prices of 'price-commodity' measured in the
+;; currency 'report-currency'. The prices are taken from all splits in
+;; 'currency-accounts' up until the date 'end-date'. Returns a list
+;; of lists. Each listelement looks like the list (time price), where
+;; 'time' is the time64 when the <gnc:numeric*> 'price' was valid.
+(define (gnc:get-commodity-totalavg-prices
+ currency-accounts end-date price-commodity report-currency)
+ (let ((total-foreign (gnc-numeric-zero))
+ (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 (xaccTransGetDate
+ (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
+ (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)))))))
+ ;; Get all the interesting splits, and sort them according to the
+ ;; date.
+ (gnc:get-match-commodity-splits-sorted
+ currency-accounts
+ end-date price-commodity)))))
+
+;; Create a list of prices for all commodities in 'commodity-list',
+;; i.e. the same thing as in get-commodity-totalavg-prices but
+;; extended to a commodity-list. Returns an alist. Each pair consists
+;; 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
+ 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 c report-currency))))
+ commodity-list)))
+
+;; Get the instantaneous prices for the 'price-commodity', measured in
+;; amounts of the 'report-currency'. The prices are taken from all
+;; splits in 'currency-accounts' up until the date
+;; 'end-date'. Returns a list of lists. Each listelement looks like
+;; the list (time price), where 'time' is the time64 when the
+;; <gnc:numeric*> 'price' was valid.
+(define (gnc:get-commodity-inst-prices
+ currency-accounts end-date price-commodity report-currency)
+ ;; go through all splits; convert all splits into a price.
+ (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 (xaccTransGetDate
+ (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
+ end-date price-commodity))))
+
+;; Get the instantaneous prices for all commodities in
+;; 'commodity-list', i.e. the same thing as get-commodity-inst-prices
+;; but extended to a commodity-list. Returns an alist. Each pair
+;; 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
+ 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 c report-currency))))
+ commodity-list)))
+
+
+;; Find the price in 'pricelist' that's nearest to 'date'. The
+;; pricelist comes from
+;; e.g. gnc:get-commodity-totalavg-prices. Returns a <gnc-numeric> or,
+;; if pricelist was empty, #f.
+(define (gnc:pricelist-price-find-nearest
+ pricelist date)
+ (let* ((later (find (lambda (p)
+ (< date (first p)))
+ pricelist))
+ (earlierlist (take-while
+ (lambda (p)
+ (>= date (first p)))
+ pricelist))
+ (earlier (and (not (null? earlierlist))
+ (last earlierlist))))
+ ;; (if earlier
+ ;; (warn "earlier"
+ ;; (qof-print-date (first earlier))
+ ;; (gnc-numeric-to-double (second earlier))))
+ ;; (if later
+ ;; (warn "later"
+ ;; (qof-print-date (first later))
+ ;; (gnc-numeric-to-double (second later))))
+
+ (if (and earlier later)
+ (if (< (abs (- (first earlier) date))
+ (abs (- (first later) date)))
+ (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)
+ (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))))
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions to get one price at a given time (i.e. not time-variant).
+
+
+;; Go through all toplevel non-'report-commodity' balances in
+;; 'sumlist' and add them to 'report-commodity', if possible. This
+;; function takes a sumlist (described in gnc:get-exchange-totals) 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 (gnc:make-number-collector))
+ (b (gnc:make-number-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-number-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))))))
+ ;; The report-currency showed up on the wrong side, so it was a
+ ;; "sell" for that commodity. We ignore those for cost reports
+ ;; and they're already aggregated for non-cost reports.
+ ))
+ (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.
+
+(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
+ (let ((pair (list inner-comm
+ (cons (gnc:make-number-collector)
+ (gnc:make-number-collector)))))
+ ((caadr pair) 'add value-amount)
+ ((cdadr pair) 'add share-amount)
- (set comm-list (list outer-comm (list pair)))))
++ (list outer-comm (list pair))))
+
+(define (create-foreign-list comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (let ((foreign-list
+ (if (gnc-commodity-equiv transaction-comm (car comm-list))
+ (list account-comm share-amount value-amount)
+ (list transaction-comm value-amount share-amount))))
+ foreign-list))
+
+(define (create-foreign-cost-list comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (let ((foreign-list
+ (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)))))
+ foreign-list))
+
+(define (create-commodity-pair foreignlist comm-list sumlist)
+ (let ((pair (assoc (car foreignlist) (cadr comm-list))))
+ ;; no pair already, create one
+ (if (not pair)
+ (set! pair (list (car foreignlist)
+ (cons (gnc:make-numeric-collector)
+ (gnc:make-numeric-collector)))))
+ pair))
+
+;; 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 <gnc:commodity> and the numbers are a
+;; numeric-collector which in turn store a <gnc:numeric>. 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. 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 cost)
+ (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 (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)))
+ (share-amount (if cost
+ (xaccSplitGetAmount a)
+ (gnc-numeric-abs (xaccSplitGetAmount a))))
+ (value-amount (if cost
+ (xaccSplitGetValue a)
+ (gnc-numeric-abs (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
+ (begin
+ (set! comm-list (create-commodity-list
+ account-comm transaction-comm
- share-amount value-amount))
++ value-amount share-amount))
+ (set! sumlist (cons comm-list sumlist)))
+
+ ;;yes, check for second commodity
+ (let* ((foreignlist (if cost
+ (create-foreign-cost-list
+ comm-list transaction-comm account-comm
+ share-amount value-amount)
+ (create-foreign-list
+ comm-list transaction-comm account-comm
+ share-amount value-amount)))
+ (pair (create-commodity-pair foreignlist comm-list
+ sumlist)))
+ (set! comm-list (list (car comm-list)
+ (cons pair (cadr comm-list))))
+ (set! sumlist (cons comm-list
+ (alist-delete (car comm-list) sumlist)))
+ ((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)))
+
+(define (gnc:make-exchange-alist report-commodity end-date cost)
+ ;; 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
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
+ (gnc:get-exchange-totals report-commodity end-date cost)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Actual functions for exchanging amounts.
+
+
+;; Exchange EURO currencies to each other, or returns #f if one of
+;; them is not an EURO currency at the given time. The function takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity, and a <gnc:time-pair> 'date'. It exchanges
+;; the amount into the domestic currency. If the 'date' is #f, it
+;; doesn't check for it. Returns a <gnc-monetary>, or #f if at least
+;; one of the currencies is not in the EURO.
+(define (gnc:exchange-by-euro foreign domestic date)
+ (and (gnc-is-euro-currency domestic)
+ (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))))))
+
+
+;; A trivial exchange function - if the "foreign" monetary amount
+;; 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
+;; will return a valid <gnc:monetary>. However, this function returns
+;; #f if the commodities don't match. Therefore, if you use this
+;; function in a mixed commodity context, stuff will probably crash.
+(define (gnc:exchange-if-same foreign domestic)
+ (if (gnc-commodity-equiv (gnc:gnc-monetary-commodity foreign) domestic)
+ foreign
+ #f))
+
+;; This one returns the ready-to-use function for calculation of the
+;; exchange rates. The returned function takes a <gnc-monetary> and
+;; the <gnc:commodity*> domestic-commodity, exchanges the amount into
+;; the domestic currency and returns a <gnc-monetary>.
+(define (gnc:make-exchange-function exchange-alist)
+ (let ((exchangelist exchange-alist))
+ (lambda (foreign domestic)
+ (gnc:debug "foreign: " (gnc:monetary->string foreign))
+ (gnc:debug "domestic: " (gnc-commodity-get-printname domestic))
+ (if foreign
+ (or (gnc:exchange-by-euro foreign domestic #f)
+ (gnc:exchange-if-same foreign domestic)
+ (gnc:make-gnc-monetary
+ domestic
+ (let ((pair (assoc (gnc:gnc-monetary-commodity foreign)
+ exchangelist))
+ (foreign-amount (gnc:gnc-monetary-amount foreign)))
+ (if (or (not pair)
+ (gnc-numeric-zero-p foreign-amount))
+ (gnc-numeric-zero)
+ (gnc-numeric-mul foreign-amount
+ (cadr pair)
+ (gnc-commodity-get-fraction domestic)
+ GNC-RND-ROUND)))))
+ #f))))
+
+;; Helper for the gnc:exchange-by-pricalist* below. Exchange the
+;; <gnc:monetary> 'foreign' into the <gnc:commodity*> 'domestic' by
+;; the <gnc:numeric> 'price-value'. Returns a <gnc:monetary>.
+(define (gnc:exchange-by-pricevalue-helper
+ foreign domestic price-value)
+ (if (gnc:gnc-monetary? foreign)
+ (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))))
+ #f))
+
+;; Helper for gnc:exchange-by-pricedb-* below. 'price' gets tested for
+;; #f here, and gets unref'd here too. Exchange the <gnc:monetary>
+;; 'foreign' into the <gnc:commodity*> 'domestic' by the <gnc:Price>
+;; 'price'. Returns a <gnc:monetary>.
+(define (gnc:exchange-by-pricedb-helper
+ foreign domestic price)
+ (if (gnc:gnc-monetary? foreign)
+ (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))))
+ #f))
+
+;; This is another ready-to-use function for calculation of exchange
+;; rates. (Note that this is already the function itself. It doesn't
+;; return a function as opposed to make-exchange-function.) It takes
+;; the <gnc-monetary> 'foreign' amount and the <gnc:commodity*>
+;; 'domestic' commodity. It exchanges the amount into the domestic
+;; currency, using the latest price from the pricedb. The function
+;; returns a <gnc-monetary>.
+(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)))
+ #f))
+
+;; Yet another ready-to-use function for calculation of exchange
+;; rates. (Note that this is already the function itself. It doesn't
+;; return a function as opposed to make-exchange-function.) It takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity *and* a <gnc:time-pair> 'date'. It exchanges
+;; the amount into the domestic currency, using a price from the
+;; pricedb according to the given date. The function returns a
+;; <gnc-monetary>.
+(define (gnc:exchange-by-pricedb-nearest
+ foreign domestic date)
+ (if (and (record? foreign) (gnc:gnc-monetary? foreign)
+ 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 (time64CanonicalDayTime date))))
+ #f))
+
+;; Exchange by the nearest price from pricelist. This function takes
+;; the <gnc-monetary> 'foreign' amount, the <gnc:commodity*>
+;; 'domestic' commodity, a <gnc:time-pair> 'date' and the
+;; 'pricelist'. It exchanges the amount into the domestic currency,
+;; using the price nearest to 'data' found in the pricelist. The
+;; function returns a <gnc-monetary>.
+(define (gnc:exchange-by-pricealist-nearest
+ 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)))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Choosing exchange functions made easy -- get the right function by
+;; the value of a multichoice option.
+
+
+;; 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)
+ (case source-option
+ ((average-cost) (gnc:make-exchange-function
+ (gnc:make-exchange-alist
+ report-currency to-date #t)))
+ ((weighted-average) (gnc:make-exchange-function
+ (gnc:make-exchange-alist
+ report-currency to-date #f)))
+ ((pricedb-latest) gnc:exchange-by-pricedb-latest)
+ ((pricedb-nearest) (lambda (foreign domestic)
+ (gnc:exchange-by-pricedb-nearest
+ foreign domestic to-date)))
+ (else
+ (begin
+ ;; 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.")
+ (lambda (foreign domestic)
+ (gnc:exchange-by-pricedb-nearest
+ foreign domestic to-date))))))
+
+;; 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!.
+;;
+;; <int> 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
+ 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-alist
+ report-currency to-date #t))))
+ (lambda (foreign domestic date)
+ (exchange-fn foreign domestic))))
+ ((weighted-average) (let ((pricealist
+ (gnc:get-commoditylist-totalavg-prices
+ commodity-list report-currency to-date
+ 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)))
+ (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)))
+ ((pricedb-nearest) gnc:exchange-by-pricedb-nearest)
+ (else
+ (begin
+ (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))))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions using the exchange-fn's above to get from a
+;; commodity-collector to one value.
+
+
+;; Adds all different commodities in the commodity-collector <foreign>
+;; by using the exchange rates of <exchange-fn> to calculate the
+;; exchange rates to the commodity <domestic>.
+;;
+;; CAS: Previously, the exchange-fn was not optional -- we would crash
+;; if it was invalid. I've changed this so that when exchange-fn is
+;; #f, #f is returned. Since #f is already returned when foreign is
+;; #f, and since any previous dependance on some behavior for the case
+;; where exchange-fn was #f would've crashed, I think this change is
+;; safe.
+;;
+;; Returns a <gnc-monetary> with the domestic commodity and its
+;; corresponding balance. If the foreign balance is #f, it returns #f.
+(define (gnc:sum-collector-commodity foreign domestic exchange-fn)
+ (cond ((and foreign exchange-fn)
+ (let ((balance (gnc:make-commodity-collector)))
+ (foreign
+ 'format
+ (lambda (curr val)
+ (if (gnc-commodity-equiv domestic curr)
+ (balance 'add domestic val)
+ (balance 'add domestic
+ (gnc:gnc-monetary-amount
+ ;; BUG?: this bombs if the exchange-fn
+ ;; returns #f instead of an actual
+ ;; <gnc:monetary>. Better to just return #f.
+ (exchange-fn (gnc:make-gnc-monetary curr val)
+ domestic)))))
+ #f)
+ (balance 'getmonetary domestic #f)))
+ (else #f)))
+
+;; As above, but adds only the commodities of other stocks and
+;; mutual-funds. Returns a commodity-collector, (not a <gnc:monetary>)
+;; which (still) may have several different commodities in it -- if
+;; there have been different *currencies*, not only stocks.
+(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)
+ #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
+ ))
+
+(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)))))
commit 1999d85343496eca0ec5f54c64468ff83ad99424
Merge: 3aba4d2 604a2d0
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Feb 15 10:30:42 2018 -0800
Merge Chris Lam's 'maint-fix-45f61a3'.
commit 604a2d0864dbdd2b82fa8b66b959e2639042d7e9
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Feb 14 17:15:26 2018 +0800
Bugfix create-commodity-list
45f61a3 had couple bugs.
- value/share was inadvertently swapped
- no need to define comm-list in
create-commodity-list to return it
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index ceca9c8..ee0eaf1 100644
--- a/src/report/report-system/commodity-utilities.scm
+++ b/src/report/report-system/commodity-utilities.scm
@@ -543,7 +543,7 @@
(gnc:make-numeric-collector)))))
((caadr pair) 'add value-amount)
((cdadr pair) 'add share-amount)
- (set comm-list (list outer-comm (list pair)))))
+ (list outer-comm (list pair))))
(define (create-foreign-list comm-list transaction-comm account-comm
share-amount value-amount)
@@ -616,7 +616,7 @@
(begin
(set! comm-list (create-commodity-list
account-comm transaction-comm
- share-amount value-amount))
+ value-amount share-amount))
(set! sumlist (cons comm-list sumlist)))
;;yes, check for second commodity
Summary of changes:
gnucash/report/report-system/commodity-utilities.scm | 4 ++--
libgnucash/core-utils/test/test-userdata-dir.c | 1 -
2 files changed, 2 insertions(+), 3 deletions(-)
More information about the gnucash-changes
mailing list