gnucash maint: Multiple changes pushed
John Ralls
jralls at code.gnucash.org
Fri Dec 9 13:52:28 EST 2016
Updated via https://github.com/Gnucash/gnucash/commit/7b7c780a (commit)
via https://github.com/Gnucash/gnucash/commit/332bd3bb (commit)
via https://github.com/Gnucash/gnucash/commit/98697a1e (commit)
via https://github.com/Gnucash/gnucash/commit/d9dbc3de (commit)
via https://github.com/Gnucash/gnucash/commit/0829d6dc (commit)
via https://github.com/Gnucash/gnucash/commit/5803c141 (commit)
from https://github.com/Gnucash/gnucash/commit/57e7ba86 (commit)
commit 7b7c780a3615e8877af4ff5a90bb5db513701ce9
Merge: 57e7ba8 332bd3b
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Dec 9 10:34:02 2016 -0800
Bug 775368 - "Average cost" price source problem
This series of changes modifies the Average Cost report function to
finding the average amount-weighted price of all transactions recording
a "buy" of the report commodity so that the correct amount is now
reported without the need of a capital gains split--though one is still
needed to get the Trial Balance report to balance.
Since book-wide averages are not what most users expect, it also changes
the default pricing option on all reports to "Nearest in Time", which is
what most confused users have selected after asking about it in the
mailing lists. This also fixes
Bug 340991 - Default price source for reports not good.
commit 332bd3bb3efeb4c09ca686aa445df554dc656092
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Dec 9 10:33:28 2016 -0800
Change the default price-source from Average Cost to Nearest in Time.
Average cost is a counter-intuitive calculation for most users; Nearest in
Time is generally reported to produce the results that users expect.
diff --git a/src/report/standard-reports/account-piecharts.scm b/src/report/standard-reports/account-piecharts.scm
index 74fcae5..be025ea 100644
--- a/src/report/standard-reports/account-piecharts.scm
+++ b/src/report/standard-reports/account-piecharts.scm
@@ -104,7 +104,7 @@ balance at a given time"))
(gnc:options-add-price-source!
options gnc:pagename-general
- optname-price-source "c" 'average-cost)
+ optname-price-source "c" 'pricedb-nearest)
(if do-intervals?
(add-option
diff --git a/src/report/standard-reports/account-summary.scm b/src/report/standard-reports/account-summary.scm
index 53af64a..248b228 100644
--- a/src/report/standard-reports/account-summary.scm
+++ b/src/report/standard-reports/account-summary.scm
@@ -189,7 +189,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/balance-sheet.scm b/src/report/standard-reports/balance-sheet.scm
index d40bc16..ba2f5e4 100644
--- a/src/report/standard-reports/balance-sheet.scm
+++ b/src/report/standard-reports/balance-sheet.scm
@@ -205,7 +205,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/budget-balance-sheet.scm b/src/report/standard-reports/budget-balance-sheet.scm
index 266324f..d9aa5d4 100644
--- a/src/report/standard-reports/budget-balance-sheet.scm
+++ b/src/report/standard-reports/budget-balance-sheet.scm
@@ -168,7 +168,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/budget-income-statement.scm b/src/report/standard-reports/budget-income-statement.scm
index aa5052c..2042088 100644
--- a/src/report/standard-reports/budget-income-statement.scm
+++ b/src/report/standard-reports/budget-income-statement.scm
@@ -222,7 +222,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/budget.scm b/src/report/standard-reports/budget.scm
index c12a07b..b02d9e6 100644
--- a/src/report/standard-reports/budget.scm
+++ b/src/report/standard-reports/budget.scm
@@ -90,7 +90,7 @@
;; optname-from-date optname-to-date "a")
(gnc:options-add-price-source!
- options gnc:pagename-general optname-price-source "c" 'average-cost)
+ options gnc:pagename-general optname-price-source "c" 'pricedb-nearest)
;;(gnc:register-option
;; options
diff --git a/src/report/standard-reports/equity-statement.scm b/src/report/standard-reports/equity-statement.scm
index 8c1b2b3..1aae965 100644
--- a/src/report/standard-reports/equity-statement.scm
+++ b/src/report/standard-reports/equity-statement.scm
@@ -142,7 +142,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/income-statement.scm b/src/report/standard-reports/income-statement.scm
index 7c40395..5b2c352 100644
--- a/src/report/standard-reports/income-statement.scm
+++ b/src/report/standard-reports/income-statement.scm
@@ -185,7 +185,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/sx-summary.scm b/src/report/standard-reports/sx-summary.scm
index 800c4dd..f61608b 100644
--- a/src/report/standard-reports/sx-summary.scm
+++ b/src/report/standard-reports/sx-summary.scm
@@ -171,7 +171,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
diff --git a/src/report/standard-reports/trial-balance.scm b/src/report/standard-reports/trial-balance.scm
index fd7d9ad..b3d2be9 100644
--- a/src/report/standard-reports/trial-balance.scm
+++ b/src/report/standard-reports/trial-balance.scm
@@ -221,7 +221,7 @@
(gnc:options-add-price-source!
options pagename-commodities
- optname-price-source "b" 'average-cost)
+ optname-price-source "b" 'pricedb-nearest)
(add-option
(gnc:make-simple-boolean-option
commit 98697a1e23c48737e472eba6314c3d05e6e689ee
Author: John Ralls <jralls at ceridwen.us>
Date: Fri Dec 9 10:22:06 2016 -0800
Calculate rates only for buy transactions in the report commodity for cost totals.
Reverse the direction of splits with negative amounts as they represent a
sale of the transaction commodity. Accumulate buys and sells of commodities
into separate comm-lists and use only the buy-side ones for the report-commodity
in the calculation.
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index ceca9c8..d14afab 100644
--- a/src/report/report-system/commodity-utilities.scm
+++ b/src/report/report-system/commodity-utilities.scm
@@ -515,17 +515,10 @@
;; 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)))))
+ ;; 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)
@@ -537,60 +530,70 @@
;; 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
+(define (create-commodity-list inner-comm outer-comm share-amount value-amount)
+ (let ((foreignlist (list inner-comm
(cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector)))))
- ((caadr pair) 'add value-amount)
- ((cdadr pair) 'add share-amount)
- (set comm-list (list outer-comm (list pair)))))
-
-(define (create-foreign-list comm-list transaction-comm account-comm
+ (gnc:make-numeric-collector))))
+ (comm-list #f))
+ ((caadr foreignlist) 'add share-amount)
+ ((cdadr foreignlist) 'add value-amount)
+ (set! comm-list (list outer-comm (list foreignlist)))
+ (gnc:debug "New Outer entry " (gnc-commodity-get-mnemonic outer-comm)
+ (gnc-commodity-get-mnemonic inner-comm) share-amount
+ value-amount)
+ comm-list))
+
+(define (create-foreign-list comm-list inner-comm outer-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)))))
+ (if (gnc-commodity-equiv inner-comm (car comm-list))
+ (list outer-comm share-amount value-amount)
+ (list inner-comm value-amount share-amount))))
+ (gnc:debug "Add value " (gnc-commodity-get-mnemonic (car comm-list))
+ (gnc-commodity-get-mnemonic (car foreign-list))
+ (cadr foreign-list) (cddr foreign-list))
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)
+ (begin
+ (set! pair (list (car foreignlist)
(cons (gnc:make-numeric-collector)
- (gnc:make-numeric-collector)))))
+ (gnc:make-numeric-collector))))
+ (gnc:debug "New commodity "
+ (gnc-commodity-get-mnemonic (car foreignlist)))))
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.
+;; gnc:get-exchange-totals returns a sumlist, which is 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.
+;;
+
(define (gnc:get-exchange-totals report-commodity end-date cost)
+;; Finds all splits in the book whose commodity is different from the parent
+;; transaction's commodity and creates a sumlist of the amount and value for
+;; each commodity pair. If 'cost' is true then the totals represent the costs of
+;; buying one commodity with the other; if it's false then the trades in both
+;; directions are agregated. A side effect of the distinction is that changing
+;; the report currency will change the resulting exchange rate if 'cost' is true
+;; but not if it is false.
(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 '()))))
-
+ (gnc:debug "Begin Report " (gnc-commodity-get-mnemonic report-commodity)
+ " cost " cost)
(if (not (null? curr-accounts))
;; Go through all splits and add up all value-amounts
;; and share-amounts
@@ -600,33 +603,53 @@
(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)
+ (share-amount (xaccSplitGetAmount a))
+ (value-amount (xaccSplitGetValue a))
+ ;; If the share-value is negative then the transaction
+ ;; purchased something in the transaction currency; otherwise
+ ;; the purchase is in the account currency.
+ (outer-comm (if (gnc-numeric-negative-p share-amount)
+ account-comm transaction-comm))
+ (inner-comm (if (gnc-numeric-negative-p share-amount)
+ transaction-comm account-comm))
+ (tmp (assoc outer-comm sumlist))
+ ;; If cost isn't true then we want one entry for both in
+ ;; sumlist.
+ (comm-list (if (and (not tmp) (not cost))
+ (assoc inner-comm sumlist)
tmp)))
+ ;; We need to reverse and negate the values if they were negative
+ ;; because we already reversed the commodities they applied to.
+ (gnc:debug "Transaction commodity "
+ (gnc-commodity-get-mnemonic transaction-comm)
+ " Account commodity "
+ (gnc-commodity-get-mnemonic account-comm)
+ " Outer Commodity "
+ (gnc-commodity-get-mnemonic outer-comm)
+ " Inner Commodity "
+ (gnc-commodity-get-mnemonic inner-comm)
+ " Amount " share-amount " Value " value-amount)
+ (if (gnc-numeric-negative-p share-amount)
+ ;;(if cost ;; swap as well as negate
+ ;;(let* ((tmp-amount share-amount))
+ ;;(set! share-amount (gnc-numeric-neg value-amount))
+ ;;(set! value-amount (gnc-numeric-neg tmp-amount)))
+ (begin ;; we just want to make sure they're positive
+ (set! share-amount (gnc-numeric-abs share-amount))
+ (set! value-amount (gnc-numeric-abs value-amount));;)
+ ))
;; 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
+ inner-comm outer-comm
share-amount value-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)))
+ ;;yes, add the second commodity if it's not already stored
+ (let* ((foreignlist (create-foreign-list comm-list outer-comm
+ inner-comm share-amount value-amount))
(pair (create-commodity-pair foreignlist comm-list
sumlist)))
(set! comm-list (list (car comm-list)
@@ -637,7 +660,8 @@
((cdadr pair) 'add (caddr foreignlist))))))
(gnc:get-all-commodity-splits curr-accounts end-date)))
-
+ (gnc:debug "End Report\n")
+ ;; Finally resolve any indirect conversions.
(gnc:resolve-unknown-comm sumlist report-commodity)))
(define (gnc:make-exchange-alist report-commodity end-date cost)
commit d9dbc3de04eb9518a688a9846e5276c3d2a2d05c
Author: John Ralls <jralls at ceridwen.us>
Date: Sun Dec 4 15:00:51 2016 -0800
Single functions for gnc:make-exchange-alist and gnc:get-exchange-totals.
Extract helper functions and add a parameter, eliminating gnc:make-exchange-cost-alist
and gnc:get-exchange-cost-totals.
This makes it more clear the differences between the two algorithms and
makes it easier to correct the algorithm for the cost case.
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index 2d3f838..ceca9c8 100644
--- a/src/report/report-system/commodity-utilities.scm
+++ b/src/report/report-system/commodity-utilities.scm
@@ -537,29 +537,58 @@
;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform
;; this functions to use some kind of recursiveness.
-
-;; 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)
+(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
+ (let ((pair (list inner-comm
+ (cons (gnc:make-numeric-collector)
+ (gnc:make-numeric-collector)))))
+ ((caadr pair) 'add value-amount)
+ ((cdadr pair) 'add share-amount)
+ (set comm-list (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: 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))
@@ -571,159 +600,47 @@
(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)))
+ (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)
- ;; 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.
+ ;; no, create sub-alist from scratch
+ (begin
+ (set! comm-list (create-commodity-list
+ account-comm transaction-comm
+ share-amount value-amount))
(set! sumlist (cons comm-list sumlist)))
- (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))))))
+ ;;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)))
-;; 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
- (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
- (for-each
- (lambda (a)
- (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
-;; 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)
+(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.
@@ -735,11 +652,7 @@
((caadr e) 'total #f)
GNC-DENOM-AUTO
(logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
- (gnc:get-exchange-cost-totals report-commodity end-date)))
-
-
-
-
+ (gnc:get-exchange-totals report-commodity end-date cost)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Actual functions for exchanging amounts.
@@ -934,11 +847,11 @@
source-option report-currency to-date-tp)
(case source-option
((average-cost) (gnc:make-exchange-function
- (gnc:make-exchange-cost-alist
- report-currency to-date-tp)))
+ (gnc:make-exchange-alist
+ report-currency to-date-tp #t)))
((weighted-average) (gnc:make-exchange-function
(gnc:make-exchange-alist
- report-currency to-date-tp)))
+ report-currency to-date-tp #f)))
((pricedb-latest) gnc:exchange-by-pricedb-latest)
((pricedb-nearest) (lambda (foreign domestic)
(gnc:exchange-by-pricedb-nearest
@@ -970,8 +883,8 @@
(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))))
+ (gnc:make-exchange-alist
+ report-currency to-date-tp #t))))
(lambda (foreign domestic date)
(exchange-fn foreign domestic))))
((weighted-average) (let ((pricealist
commit 0829d6dc0301a40c1c12406aee75ad89275764f3
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Dec 1 16:32:41 2016 -0800
Move checks for no split amount and trading accounts to get-match-commodity-splits.
They apply to all price retrievals.
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index 6c204e9..2d3f838 100644
--- a/src/report/report-system/commodity-utilities.scm
+++ b/src/report/report-system/commodity-utilities.scm
@@ -62,16 +62,28 @@
(xaccSplitGetParent s)))
(acc-comm
(xaccAccountGetCommodity
- (xaccSplitGetAccount s))))
+ (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)
- (gnc-commodity-equiv
- commodity trans-comm)
- (gnc-commodity-equiv
- commodity acc-comm)))))
+ ;; 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))
@@ -569,62 +581,55 @@
(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))))
-
- (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)))
-
- (gnc:resolve-unknown-comm sumlist report-commodity)))
+ (if (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)))
+
+ (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
@@ -644,66 +649,62 @@
(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)))
-
- (gnc:resolve-unknown-comm sumlist report-commodity)))
+ (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
;; scheme or in C. -- cstim
commit 5803c141c18a6ff75a7f49a9142f834a596857f5
Author: John Ralls <jralls at ceridwen.us>
Date: Thu Dec 1 15:42:27 2016 -0800
Clean up whitespace in commodity-utilities.scm.
diff --git a/src/report/report-system/commodity-utilities.scm b/src/report/report-system/commodity-utilities.scm
index fbbf3c2..6c204e9 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 <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.
-;;
+;; 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:
;;
@@ -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 <gnc:numeric*> '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
;; <gnc:numeric*> '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 <gnc-numeric> 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
- ;; <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 '()))))
+ (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
- (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
- ;; <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 '()))))
+ (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-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 @@
;; <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)
+ 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 <gnc:commodity*> 'domestic' by the <gnc:Price>
;; 'price'. Returns a <gnc:monetary>.
(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 <gnc-monetary>.
-(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
;; <gnc-monetary>.
(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 <gnc-monetary>.
(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 @@
;; <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-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)
+ )
+ )
)
)
-
Summary of changes:
src/report/report-system/commodity-utilities.scm | 1305 ++++++++++----------
src/report/standard-reports/account-piecharts.scm | 2 +-
src/report/standard-reports/account-summary.scm | 2 +-
src/report/standard-reports/balance-sheet.scm | 2 +-
.../standard-reports/budget-balance-sheet.scm | 2 +-
.../standard-reports/budget-income-statement.scm | 2 +-
src/report/standard-reports/budget.scm | 2 +-
src/report/standard-reports/equity-statement.scm | 2 +-
src/report/standard-reports/income-statement.scm | 2 +-
src/report/standard-reports/sx-summary.scm | 2 +-
src/report/standard-reports/trial-balance.scm | 2 +-
11 files changed, 631 insertions(+), 694 deletions(-)
More information about the gnucash-changes
mailing list