mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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.
This commit is contained in:
John Ralls
parent
88597d0b64
commit
4464469484
@ -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))))))
|
||||
(cond ((gnc-numeric-zero-p share-amount)
|
||||
;; Without shares this is not a buy or sell; ignore it.
|
||||
#f)
|
||||
|
||||
(gnc:get-all-commodity-splits curr-accounts end-date)))
|
||||
((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))))
|
||||
|
||||
(gnc:resolve-unknown-comm sumlist report-commodity)))
|
||||
(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)))
|
||||
|
||||
(define (gnc:make-exchange-alist report-commodity end-date cost)
|
||||
(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))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user