gnucash maint: Revert changes associated with Bug 775368
John Ralls
jralls at code.gnucash.org
Thu Aug 16 19:16:21 EDT 2018
Updated via https://github.com/Gnucash/gnucash/commit/44644694 (commit)
from https://github.com/Gnucash/gnucash/commit/88597d0b (commit)
commit 446446948404b4fd61846042fc93724a8fe84f95
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Aug 16 16:12:14 2018 -0700
Revert changes associated with Bug 775368
Return commodity-utilities.scm to its state at 5803c141.
Too many changes in between to do a straight revert.
diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 6d7b5dc..4238d1a 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -63,28 +63,16 @@
(xaccSplitGetParent s)))
(acc-comm
(xaccAccountGetCommodity
- (xaccSplitGetAccount s)))
- (acc-type
- (xaccAccountGetType
- (xaccSplitGetAccount s)))
- (split-amt
- (xaccSplitGetAmount s))
- )
+ (xaccSplitGetAccount 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))
- )))
+ (gnc-commodity-equiv
+ commodity trans-comm)
+ (gnc-commodity-equiv
+ commodity acc-comm)))))
(qof-query-run query)))
(qof-query-destroy query)
splits))
@@ -98,8 +86,9 @@
(sort (gnc:get-match-commodity-splits currency-accounts
end-date commodity)
(lambda (a b)
- (< (xaccTransGetDate (xaccSplitGetParent a))
- (xaccTransGetDate (xaccSplitGetParent b))))))
+ (<
+ (xaccTransGetDate (xaccSplitGetParent a))
+ (xaccTransGetDate (xaccSplitGetParent b))))))
;; Returns a list of all splits in the currency-accounts up to
@@ -368,8 +357,8 @@
;; (gnc-numeric-to-double (second later))))
(if (and earlier later)
- (if (< (abs (- (first earlier) date))
- (abs (- (first later) date)))
+ (if (< (abs (- date (first earlier)))
+ (abs (- date (first later))))
(second earlier)
(second later))
(or
@@ -515,10 +504,17 @@
;; 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.
- ))
+ ;; 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)
@@ -530,58 +526,29 @@
;; 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)
- (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-number-collector)
- (gnc:make-number-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)
+
+;; 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? ))
;; -- 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
+ ;; <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.
(sumlist (list (list report-commodity '()))))
(if (not (null? curr-accounts))
@@ -593,47 +560,170 @@
(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))))
+ ;; 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)))
- ;; 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
- 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)
+
+ (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-number-collector)
+ (gnc:make-number-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-number-collector)
+ (gnc:make-number-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
+ ;; <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.
+ (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-number-collector)
+ (gnc:make-number-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-number-collector)
+ (gnc:make-number-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
+ (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.
@@ -641,13 +731,16 @@
(lambda (e)
(list (car e)
(if (zero? ((caadr e) 'total #f)) #f
- (gnc-numeric-abs
+ (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)))
+ (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))
+ (gnc:get-exchange-cost-totals report-commodity end-date)))
+
+
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actual functions for exchanging amounts.
@@ -839,18 +932,18 @@
;; 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)
+ source-option report-currency to-date-tp)
(case source-option
((average-cost) (gnc:make-exchange-function
- (gnc:make-exchange-alist
- report-currency to-date #t)))
+ (gnc:make-exchange-cost-alist
+ report-currency to-date-tp)))
((weighted-average) (gnc:make-exchange-function
(gnc:make-exchange-alist
- report-currency to-date #f)))
+ 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)))
+ foreign domestic to-date-tp)))
(else
(begin
;; FIX-ME
@@ -863,7 +956,7 @@
source-option " using pricedb-nearest.")
(lambda (foreign domestic)
(gnc:exchange-by-pricedb-nearest
- foreign domestic to-date))))))
+ 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
@@ -873,25 +966,25 @@
;; section of the progress bar while running this function.
;;
(define (gnc:case-exchange-time-fn
- source-option report-currency commodity-list to-date
+ 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-alist
- report-currency to-date #t))))
+ (gnc:make-exchange-cost-alist
+ report-currency to-date-tp))))
(lambda (foreign domestic date)
(exchange-fn foreign domestic))))
((weighted-average) (let ((pricealist
(gnc:get-commoditylist-totalavg-prices
- commodity-list report-currency to-date
+ 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)))
+ commodity-list report-currency to-date-tp)))
(lambda (foreign domestic date)
(gnc:exchange-by-pricealist-nearest
pricealist foreign domestic date))))
Summary of changes:
.../report/report-system/commodity-utilities.scm | 343 +++++++++++++--------
1 file changed, 218 insertions(+), 125 deletions(-)
More information about the gnucash-changes
mailing list