gnucash maint: Revert changes associated with Bug 775368

John Ralls jralls at code.gnucash.org
Thu Aug 16 19:16:21 EDT 2018


Updated	 via  https://github.com/Gnucash/gnucash/commit/44644694 (commit)
	from  https://github.com/Gnucash/gnucash/commit/88597d0b (commit)



commit 446446948404b4fd61846042fc93724a8fe84f95
Author: John Ralls <jralls at ceridwen.us>
Date:   Thu Aug 16 16:12:14 2018 -0700

    Revert changes associated with Bug 775368
    
    Return commodity-utilities.scm to its state at 5803c141.
    Too many changes in between to do a straight revert.

diff --git a/gnucash/report/report-system/commodity-utilities.scm b/gnucash/report/report-system/commodity-utilities.scm
index 6d7b5dc..4238d1a 100644
--- a/gnucash/report/report-system/commodity-utilities.scm
+++ b/gnucash/report/report-system/commodity-utilities.scm
@@ -63,28 +63,16 @@
                                       (xaccSplitGetParent s)))
                                     (acc-comm
                                      (xaccAccountGetCommodity
-                                      (xaccSplitGetAccount s)))
-                                    (acc-type
-                                     (xaccAccountGetType
-                                      (xaccSplitGetAccount s)))
-                                    (split-amt
-                                     (xaccSplitGetAmount s))
-                                    )
+                                      (xaccSplitGetAccount s))))
                                 (and
-                                 ;; Same commodities, so no price:
                                  (not (gnc-commodity-equiv
                                        trans-comm acc-comm))
                                  (or
-                                  ;; No commodity, bad split
                                   (not commodity)
-                                  ;; Not a price that interests us
-                                  (gnc-commodity-equiv commodity trans-comm)
-                                  (gnc-commodity-equiv commodity acc-comm))
-                                  ;; No amount, so no price:
-                                  (not (gnc-numeric-zero-p split-amt))
-                                  ;; no trading accounts so we don't count twice
-                                  (not (eq? acc-type ACCT-TYPE-TRADING))
-                                  )))
+                                  (gnc-commodity-equiv
+                                   commodity trans-comm)
+                                  (gnc-commodity-equiv
+                                   commodity acc-comm)))))
                   (qof-query-run query)))
     (qof-query-destroy query)
     splits))
@@ -98,8 +86,9 @@
   (sort (gnc:get-match-commodity-splits currency-accounts
                                         end-date commodity)
         (lambda (a b)
-          (< (xaccTransGetDate (xaccSplitGetParent a))
-             (xaccTransGetDate (xaccSplitGetParent b))))))
+          (<
+           (xaccTransGetDate (xaccSplitGetParent a))
+           (xaccTransGetDate (xaccSplitGetParent b))))))
 
 
 ;; Returns a list of all splits in the currency-accounts up to
@@ -368,8 +357,8 @@
     ;;                    (gnc-numeric-to-double (second later))))
 
     (if (and earlier later)
-        (if (< (abs (- (first earlier) date))
-               (abs (- (first later) date)))
+        (if (< (abs (- date (first earlier)))
+               (abs (- date (first later))))
             (second earlier)
             (second later))
         (or
@@ -515,10 +504,17 @@
                            ;; report-commodity ((cdadr newrate) 'total
                            ;; #f))))
                            (set! reportlist (cons newrate reportlist))))))
-               ;; The report-currency showed up on the wrong side, so it was a
-               ;; "sell" for that commodity. We ignore those for cost reports
-               ;; and they're already aggregated for non-cost reports.
-                 ))
+               ;; Huh, the report-currency showed up on the wrong side
+               ;; -- we will just add it to the reportlist on the
+               ;; right side.
+               (let ((newrate (list (car otherlist)
+                                    (cons (cdadr pair) (caadr pair)))))
+                 ;; (warn "created new rate: "
+                 ;; (gnc-commodity-value->string (list (car newrate)
+                 ;; ((caadr newrate) 'total #f))) " = "
+                 ;; (gnc-commodity-value->string (list
+                 ;; report-commodity ((cdadr newrate) 'total #f))))
+                 (set! reportlist (cons newrate reportlist)))))
             (cadr otherlist))))
      sumlist)
 
@@ -530,58 +526,29 @@
 ;; or more runs of gnc:resolve-unknown-comm. Maybe we could transform
 ;; this functions to use some kind of recursiveness.
 
-(define (create-commodity-list inner-comm outer-comm value-amount share-amount)
-  (let ((pair (list inner-comm
-                    (cons (gnc:make-number-collector)
-                          (gnc:make-number-collector)))))
-    ((caadr pair) 'add value-amount)
-    ((cdadr pair) 'add share-amount)
-    (list outer-comm (list pair))))
-
-(define (create-foreign-list comm-list transaction-comm account-comm
-                             share-amount value-amount)
-  (let ((foreign-list
-         (if (gnc-commodity-equiv transaction-comm (car comm-list))
-             (list account-comm share-amount value-amount)
-             (list transaction-comm value-amount share-amount))))
-    foreign-list))
-
-(define (create-foreign-cost-list comm-list transaction-comm account-comm
-                                  share-amount value-amount)
-  (let ((foreign-list
-         (if (gnc-commodity-equiv transaction-comm (car comm-list))
-             (list account-comm share-amount value-amount)
-             (list transaction-comm (gnc-numeric-neg value-amount)
-                   (gnc-numeric-neg share-amount)))))
-    foreign-list))
-
-(define (create-commodity-pair foreignlist comm-list sumlist)
-  (let ((pair (assoc (car foreignlist) (cadr comm-list))))
-    ;; no pair already, create one
-    (if (not pair)
-        (set! pair (list (car foreignlist)
-                         (cons (gnc:make-number-collector)
-                               (gnc:make-number-collector)))))
-    pair))
-
-;; sumlist: a multilevel alist. Each element has a commodity as key, and another
-;; alist as a value. The value-alist's elements consist of a commodity as a key,
-;; and a pair of two value-collectors as value, e.g. with only one (the report-)
-;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .  1000)] [FRF (300
-;; . 100)] ) } ) where DEM,USD,FRF are <gnc:commodity> and the numbers are a
-;; numeric-collector which in turn store a <gnc:numeric>. In the example, USD
-;; 400 were bought for an amount of DEM 1000, FRF 300 were bought for DEM
-;; 100. The reason for the outer alist is that there might be commodity
-;; transactions which do not involve the report-commodity, but which can still
-;; be calculated after *all* transactions are processed.  Calculate the weighted
-;; average exchange rate between all commodities and the
-;; 'report-commodity'. Uses all currency transactions up until the
-;; 'end-date'. Returns an alist, see sumlist.
-(define (gnc:get-exchange-totals report-commodity end-date cost)
+
+;; Calculate the weighted average exchange rate between all
+;; commodities and the 'report-commodity'. Uses all currency
+;; transactions up until the 'end-date'. Returns an alist, see
+;; sumlist.
+(define (gnc:get-exchange-totals report-commodity end-date)
   (let ((curr-accounts
          ;;(filter gnc:account-has-shares? ))
          ;; -- use all accounts, not only share accounts, since gnucash-1.7
          (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+        ;; sumlist: a multilevel alist. Each element has a commodity
+        ;; as key, and another alist as a value. The value-alist's
+        ;; elements consist of a commodity as a key, and a pair of two
+        ;; value-collectors as value, e.g. with only one (the report-)
+        ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
+        ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
+        ;; <gnc:commodity> and the numbers are a numeric-collector
+        ;; which in turn store a <gnc:numeric>. In the example, USD
+        ;; 400 were bought for an amount of DEM 1000, FRF 300 were
+        ;; bought for DEM 100. The reason for the outer alist is that
+        ;; there might be commodity transactions which do not involve
+        ;; the report-commodity, but which can still be calculated
+        ;; after *all* transactions are processed.
         (sumlist (list (list report-commodity '()))))
 
     (if (not (null? curr-accounts))
@@ -593,47 +560,170 @@
                                      (xaccSplitGetParent a)))
                   (account-comm (xaccAccountGetCommodity
                                  (xaccSplitGetAccount a)))
-                  (share-amount (if cost
-                                    (xaccSplitGetAmount a)
-                                    (gnc-numeric-abs (xaccSplitGetAmount a))))
-                  (value-amount (if cost
-                                    (xaccSplitGetValue a)
-                                    (gnc-numeric-abs (xaccSplitGetValue a))))
+                  ;; Always use the absolute value here.
+                  (share-amount (gnc-numeric-abs
+                                 (xaccSplitGetAmount a)))
+                  (value-amount (gnc-numeric-abs
+                                 (xaccSplitGetValue a)))
                   (tmp (assoc transaction-comm sumlist))
                   (comm-list (if (not tmp)
                                  (assoc account-comm sumlist)
                                  tmp)))
-             ;; entry exists already in comm-list?
-             (if (not comm-list)
-                 ;; no, create sub-alist from scratch
-                 (begin
-                   (set! comm-list (create-commodity-list
-                                    account-comm transaction-comm
-                                    value-amount share-amount))
-                   (set! sumlist (cons comm-list sumlist)))
-
-                 ;;yes, check for second commodity
-                 (let* ((foreignlist (if cost
-                                         (create-foreign-cost-list
-                                          comm-list transaction-comm account-comm
-                                          share-amount value-amount)
-                                         (create-foreign-list
-                                          comm-list transaction-comm account-comm
-                                          share-amount value-amount)))
-                        (pair (create-commodity-pair foreignlist comm-list
-                                                     sumlist)))
-                   (set! comm-list (list (car comm-list)
-                                         (cons pair (cadr comm-list))))
-                   (set! sumlist (cons comm-list
-                                       (alist-delete (car comm-list) sumlist)))
-                   ((caadr pair) 'add (cadr foreignlist))
-                   ((cdadr pair) 'add (caddr foreignlist))))))
-
-        (gnc:get-all-commodity-splits curr-accounts end-date)))
-
-  (gnc:resolve-unknown-comm sumlist report-commodity)))
-
-(define (gnc:make-exchange-alist report-commodity end-date cost)
+
+             (cond ((gnc-numeric-zero-p share-amount)
+                    ;; Without shares this is not a buy or sell; ignore it.
+                    #f)
+
+                   ((not comm-list)
+                    ;; entry doesn't exist in comm-list
+                    ;; create sub-alist from scratch
+                    (let ((pair (list transaction-comm
+                                      (cons (gnc:make-number-collector)
+                                            (gnc:make-number-collector)))))
+                      ((caadr pair) 'add value-amount)
+                      ((cdadr pair) 'add share-amount)
+                      (set! comm-list (list account-comm (list pair)))
+                      ;; and add the new sub-alist to sumlist.
+                      (set! sumlist (cons comm-list sumlist))))
+
+                   (else
+                    (let*
+                        ;; Put the amounts in the right place.
+                        ((foreignlist
+                          (if (gnc-commodity-equiv transaction-comm
+                                                   (car comm-list))
+                              (list account-comm
+                                    share-amount value-amount)
+                              (list transaction-comm
+                                    value-amount share-amount)))
+                         ;; second commodity already existing in comm-list?
+                         (pair (assoc (car foreignlist) (cadr comm-list))))
+                      ;; if not, create a new entry in comm-list.
+                      (if (not pair)
+                          (begin
+                            (set!
+                             pair (list (car foreignlist)
+                                        (cons (gnc:make-number-collector)
+                                              (gnc:make-number-collector))))
+                            (set!
+                             comm-list (list (car comm-list)
+                                             (cons pair (cadr comm-list))))
+                            (set!
+                             sumlist (cons comm-list
+                                           (alist-delete
+                                            (car comm-list) sumlist)))))
+                      ;; And add the balances to the comm-list entry.
+                      ((caadr pair) 'add (cadr foreignlist))
+                      ((cdadr pair) 'add (caddr foreignlist)))))))
+         (gnc:get-all-commodity-splits curr-accounts end-date)))
+
+    (gnc:resolve-unknown-comm sumlist report-commodity)))
+
+;; Calculate the volume-weighted average cost of all commodities,
+;; priced in the 'report-commodity'. Uses all transactions up until
+;; the 'end-date'. Returns an alist, see sumlist.
+(define (gnc:get-exchange-cost-totals report-commodity end-date)
+  (let ((curr-accounts
+         ;;(filter gnc:account-has-shares? ))
+         ;; -- use all accounts, not only share accounts, since gnucash-1.7
+         (gnc-account-get-descendants-sorted (gnc-get-current-root-account)))
+        ;; sumlist: a multilevel alist. Each element has a commodity
+        ;; as key, and another alist as a value. The value-alist's
+        ;; elements consist of a commodity as a key, and a pair of two
+        ;; value-collectors as value, e.g. with only one (the report-)
+        ;; commodity DEM in the outer alist: ( {DEM ( [USD (400 .
+        ;; 1000)] [FRF (300 . 100)] ) } ) where DEM,USD,FRF are
+        ;; <gnc:commodity> and the numbers are a numeric-collector
+        ;; which in turn store a <gnc:numeric>. In the example, USD
+        ;; 400 were bought for an amount of DEM 1000, FRF 300 were
+        ;; bought for DEM 100. The reason for the outer alist is that
+        ;; there might be commodity transactions which do not involve
+        ;; the report-commodity, but which can still be calculated
+        ;; after *all* transactions are processed.
+        (sumlist (list (list report-commodity '()))))
+
+    (if (not (null? curr-accounts))
+        ;; Go through all splits and add up all value-amounts
+        ;; and share-amounts
+        ;; However skip splits in trading accounts as these counterbalance
+        ;; the actual value and share amounts back to zero
+        (for-each
+         (lambda (a)
+           (if (not (eq? (xaccAccountGetType (xaccSplitGetAccount a)) ACCT-TYPE-TRADING))
+               (let* ((transaction-comm (xaccTransGetCurrency
+                                         (xaccSplitGetParent a)))
+                      (account-comm (xaccAccountGetCommodity
+                                     (xaccSplitGetAccount a)))
+                      (share-amount (xaccSplitGetAmount a))
+                      (value-amount (xaccSplitGetValue a))
+                      (tmp (assoc transaction-comm sumlist))
+                      (comm-list (if (not tmp)
+                                     (assoc account-comm sumlist)
+                                     tmp)))
+
+                 ;; entry exists already in comm-list?
+                 (if (not comm-list)
+                     ;; no, create sub-alist from scratch
+                     (let ((pair (list transaction-comm
+                                       (cons (gnc:make-number-collector)
+                                             (gnc:make-number-collector)))))
+                       ((caadr pair) 'add value-amount)
+                       ((cdadr pair) 'add share-amount)
+                       (set! comm-list (list account-comm (list pair)))
+                       ;; and add the new sub-alist to sumlist.
+                       (set! sumlist (cons comm-list sumlist)))
+                     ;; yes, check for second commodity.
+                     (let*
+                         ;; Put the amounts in the right place.
+                         ((foreignlist
+                           (if (gnc-commodity-equiv transaction-comm
+                                                    (car comm-list))
+                               (list account-comm
+                                     share-amount value-amount)
+                               (list transaction-comm
+                                     (gnc-numeric-neg value-amount)
+                                     (gnc-numeric-neg share-amount))))
+                          ;; second commodity already existing in comm-list?
+                          (pair (assoc (car foreignlist) (cadr comm-list))))
+                       ;; if not, create a new entry in comm-list.
+                       (if (not pair)
+                           (begin
+                             (set!
+                              pair (list (car foreignlist)
+                                         (cons (gnc:make-number-collector)
+                                               (gnc:make-number-collector))))
+                             (set!
+                              comm-list (list (car comm-list)
+                                              (cons pair (cadr comm-list))))
+                             (set!
+                              sumlist (cons comm-list
+                                            (alist-delete
+                                             (car comm-list) sumlist)))))
+                       ;; And add the balances to the comm-list entry.
+                       ((caadr pair) 'add (cadr foreignlist))
+                       ((cdadr pair) 'add (caddr foreignlist)))))))
+         (gnc:get-all-commodity-splits curr-accounts end-date)))
+
+    (gnc:resolve-unknown-comm sumlist report-commodity)))
+
+;; Anybody feel free to reimplement any of these functions, either in
+;; scheme or in C. -- cstim
+
+(define (gnc:make-exchange-alist report-commodity end-date)
+  ;; This returns the alist with the actual exchange rates, i.e. the
+  ;; total balances from get-exchange-totals are divided by each
+  ;; other.
+  (map
+   (lambda (e)
+     (list (car e)
+           (gnc-numeric-abs
+            (gnc-numeric-div ((cdadr e) 'total #f)
+                             ((caadr e) 'total #f)
+                             GNC-DENOM-AUTO
+                             (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))))
+   (gnc:get-exchange-totals report-commodity end-date)))
+
+(define (gnc:make-exchange-cost-alist report-commodity end-date)
   ;; This returns the alist with the actual exchange rates, i.e. the
   ;; total balances from get-exchange-totals are divided by each
   ;; other.
@@ -641,13 +731,16 @@
    (lambda (e)
      (list (car e)
            (if (zero? ((caadr e) 'total #f)) #f
-            (gnc-numeric-abs
+           (gnc-numeric-abs
             (gnc-numeric-div ((cdadr e) 'total #f)
                              ((caadr e) 'total #f)
                              GNC-DENOM-AUTO
-                             (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND)))
-            )))
-   (gnc:get-exchange-totals report-commodity end-date cost)))
+                             (logior (GNC-DENOM-SIGFIGS 8) GNC-RND-ROUND))))))
+   (gnc:get-exchange-cost-totals report-commodity end-date)))
+
+
+
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Actual functions for exchanging amounts.
@@ -839,18 +932,18 @@
 ;; the value of 'source-option', whose possible values are set in
 ;; gnc:options-add-price-source!.
 (define (gnc:case-exchange-fn
-         source-option report-currency to-date)
+         source-option report-currency to-date-tp)
   (case source-option
     ((average-cost) (gnc:make-exchange-function
-                     (gnc:make-exchange-alist
-                      report-currency to-date #t)))
+                     (gnc:make-exchange-cost-alist
+                      report-currency to-date-tp)))
     ((weighted-average) (gnc:make-exchange-function
                          (gnc:make-exchange-alist
-                          report-currency to-date #f)))
+                          report-currency to-date-tp)))
     ((pricedb-latest) gnc:exchange-by-pricedb-latest)
     ((pricedb-nearest) (lambda (foreign domestic)
                          (gnc:exchange-by-pricedb-nearest
-                          foreign domestic to-date)))
+                          foreign domestic to-date-tp)))
     (else
      (begin
        ;; FIX-ME
@@ -863,7 +956,7 @@
                  source-option " using pricedb-nearest.")
        (lambda (foreign domestic)
          (gnc:exchange-by-pricedb-nearest
-          foreign domestic to-date))))))
+          foreign domestic to-date-tp))))))
 
 ;; Return a ready-to-use function. Which one to use is determined by
 ;; the value of 'source-option', whose possible values are set in
@@ -873,25 +966,25 @@
 ;; section of the progress bar while running this function.
 ;;
 (define (gnc:case-exchange-time-fn
-         source-option report-currency commodity-list to-date
+         source-option report-currency commodity-list to-date-tp
          start-percent delta-percent)
   (case source-option
     ;; Make this the same as gnc:case-exchange-fn
     ((average-cost) (let* ((exchange-fn (gnc:make-exchange-function
-                                         (gnc:make-exchange-alist
-                                          report-currency to-date #t))))
+                                         (gnc:make-exchange-cost-alist
+                                          report-currency to-date-tp))))
                       (lambda (foreign domestic date)
                         (exchange-fn foreign domestic))))
     ((weighted-average) (let ((pricealist
                                (gnc:get-commoditylist-totalavg-prices
-                                commodity-list report-currency to-date
+                                commodity-list report-currency to-date-tp
                                 start-percent delta-percent)))
                           (lambda (foreign domestic date)
                             (gnc:exchange-by-pricealist-nearest
                              pricealist foreign domestic date))))
     ((actual-transactions) (let ((pricealist
                                   (gnc:get-commoditylist-inst-prices
-                                   commodity-list report-currency to-date)))
+                                   commodity-list report-currency to-date-tp)))
                              (lambda (foreign domestic date)
                                (gnc:exchange-by-pricealist-nearest
                                 pricealist foreign domestic date))))



Summary of changes:
 .../report/report-system/commodity-utilities.scm   | 343 +++++++++++++--------
 1 file changed, 218 insertions(+), 125 deletions(-)



More information about the gnucash-changes mailing list