gnucash maint: Multiple changes pushed

Christopher Lam clam at code.gnucash.org
Sat Aug 1 01:55:46 EDT 2020


Updated	 via  https://github.com/Gnucash/gnucash/commit/12ab85fa (commit)
	 via  https://github.com/Gnucash/gnucash/commit/6f196031 (commit)
	from  https://github.com/Gnucash/gnucash/commit/4df6493b (commit)



commit 12ab85fa6c147df2714a14c778412f930f89ed40
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Aug 1 10:12:38 2020 +0800

    [advanced-portfolio] use G_ for guile-3.0

diff --git a/gnucash/report/reports/standard/advanced-portfolio.scm b/gnucash/report/reports/standard/advanced-portfolio.scm
index 279fcb91f..192e97e63 100644
--- a/gnucash/report/reports/standard/advanced-portfolio.scm
+++ b/gnucash/report/reports/standard/advanced-portfolio.scm
@@ -1048,8 +1048,8 @@ by preventing negative stock balances.<br/>")
                    (lambda (foreign domestic date)
                     (find-price (gnc-pricedb-lookup-nearest-in-time-any-currency-t64
 		     pricedb foreign (time64CanonicalDayTime date)) domestic)))))
-	       (headercols (list (_ "Account")))
-	       (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (_ "Total"))))
+	       (headercols (list (G_ "Account")))
+	       (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total"))))
 	       (sum-total-moneyin (gnc-numeric-zero))
 	       (sum-total-income (gnc-numeric-zero))
 	       (sum-total-both-gains (gnc-numeric-zero))
@@ -1060,37 +1060,37 @@ by preventing negative stock balances.<br/>")
 
 	  ;;begin building lists for which columns to display
           (if show-symbol
-	      (begin (append! headercols (list (_ "Symbol")))
+	      (begin (append! headercols (list (G_ "Symbol")))
 		     (append! totalscols (list " "))))
 
 	  (if show-listing
-	      (begin (append! headercols (list (_ "Listing")))
+	      (begin (append! headercols (list (G_ "Listing")))
 		     (append! totalscols (list " "))))
 
 	  (if show-shares
-	      (begin (append! headercols (list (_ "Shares")))
+	      (begin (append! headercols (list (G_ "Shares")))
 		     (append! totalscols (list " "))))
 
 	  (if show-price
-	      (begin (append! headercols (list (_ "Price")))
+	      (begin (append! headercols (list (G_ "Price")))
 		     (append! totalscols (list " "))))
 
 	  (append! headercols (list " "
-				    (_ "Basis")
-				    (_ "Value")
-				    (_ "Money In")
-				    (_ "Money Out")
-				    (_ "Realized Gain")
-				    (_ "Unrealized Gain")
-				    (_ "Total Gain")
-				    (_ "Rate of Gain")
-				    (_ "Income")))
+				    (G_ "Basis")
+				    (G_ "Value")
+				    (G_ "Money In")
+				    (G_ "Money Out")
+				    (G_ "Realized Gain")
+				    (G_ "Unrealized Gain")
+				    (G_ "Total Gain")
+				    (G_ "Rate of Gain")
+				    (G_ "Income")))
 
 	  (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
-	      (append! headercols (list (_ "Brokerage Fees"))))
+	      (append! headercols (list (G_ "Brokerage Fees"))))
 
-	  (append! headercols (list (_ "Total Return")
-				    (_ "Rate of Return")))
+	  (append! headercols (list (G_ "Total Return")
+				    (G_ "Rate of Return")))
 
           (append! totalscols (list " "))
 
@@ -1187,14 +1187,14 @@ by preventing negative stock balances.<br/>")
           (gnc:html-document-add-object! document table)
           (if warn-price-dirty
               (gnc:html-document-append-objects! document
-                                                 (list (gnc:make-html-text (_ "* this commodity data was built using transaction pricing instead of the price list."))
+                                                 (list (gnc:make-html-text (G_ "* this commodity data was built using transaction pricing instead of the price list."))
 						       (gnc:make-html-text (gnc:html-markup-br))
-						       (gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
+						       (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
 
           (if warn-no-price
               (gnc:html-document-append-objects! document
                                                  (list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
-                                                       (gnc:make-html-text (_ "** this commodity has no price and a price of 1 has been used.")))))
+                                                       (gnc:make-html-text (G_ "** this commodity has no price and a price of 1 has been used.")))))
 )
 
 					;if no accounts selected.

commit 6f1960313f3f8a8b4bd7207ab07de0b5ee436582
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Sat Aug 1 10:12:17 2020 +0800

    [advanced-portfolio] restore to original 4.0 state
    
    and remove tests which cannot be run anymore

diff --git a/gnucash/report/reports/standard/advanced-portfolio.scm b/gnucash/report/reports/standard/advanced-portfolio.scm
index 92587aa91..279fcb91f 100644
--- a/gnucash/report/reports/standard/advanced-portfolio.scm
+++ b/gnucash/report/reports/standard/advanced-portfolio.scm
@@ -33,7 +33,6 @@
 (use-modules (gnucash app-utils))
 (use-modules (gnucash report))
 (use-modules (srfi srfi-1))
-(use-modules (ice-9 match))
 
 (define reportname (N_ "Advanced Portfolio"))
 
@@ -180,709 +179,6 @@ by preventing negative stock balances.<br/>")
     (gnc:options-set-default-section options gnc:pagename-general)
     options))
 
-;; helper functions for renderer
-
-(define (same-account? a1 a2)
-  (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
-
-;; Return true if either account is the parent of the other or they are siblings
-(define (parent-or-sibling? a1 a2)
-  (let ((a2parent (gnc-account-get-parent a2))
-        (a1parent (gnc-account-get-parent a1)))
-    (or (same-account? a2parent a1)
-        (same-account? a1parent a2)
-        (same-account? a1parent a2parent))))
-
-;; sum up the contents of the b-list built by basis-builder below
-(define (sum-basis b-list currency-frac)
-  (fold (lambda (a b) (+ (* (car a) (cdr a)) b)) 0 b-list))
-
-;; sum up the total number of units in the b-list built by
-;; basis-builder below
-(define (units-basis b-list)
-  (fold (lambda (a b) (+ (car a) b)) 0 b-list))
-
-;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
-(define (apply-basis-ratio b-list units-ratio value-ratio)
-  (map (lambda (a) (cons (* units-ratio (car a)) (* value-ratio (cdr a)))) b-list))
-
-;; in: b-list: an alist of pair of (num-units . price-per-unit)
-;;     b-units: units being sold - starts from first pair
-;; in:  '((4 . 2) (3 . 4)) -3     --> '((1 . 2) (3 . 4))
-;; in:  '((5 . 6) (4 . 5)) -8     --> '((1 . 5))
-(define (remove-from-head b-list b-units)
-  (match b-list
-    (() (gnc:warn "selling more than available units") '())
-    (((unit1 . value1) . rest)
-     (let ((units-left (+ b-units unit1)))
-       (cond
-        ((< 0 units-left) (cons (cons units-left value1) rest))
-        ((= 0 units-left) rest)
-        (else (remove-from-head rest units-left)))))))
-
-;; this builds a list for basis calculation and handles average, fifo
-;; and lifo methods the list is cons cells of (units-of-stock
-;; . price-per-unit)... average method produces only one cell that
-;; mutates to the new average. Need to add a date checker so that we
-;; allow for prices coming in out of order, such as a transfer with a
-;; price adjusted to carryover the basis.
-(define (basis-builder b-list b-units b-value b-method currency-frac)
-  (gnc:debug "actually in basis-builder")
-  (gnc:debug "b-list is " b-list " b-units is " b-units
-             " b-value is " b-value " b-method is " b-method)
-
-  ;; if there is no b-value, then this is a split/merger and needs
-  ;; special handling
-  (cond
-
-   ;; we have value and positive units, add units to basis
-   ((and (not (zero? b-value)) (positive? b-units))
-    (case b-method
-      ((average-basis)
-       (match b-list
-         (() (list (cons b-units (/ b-value b-units))))
-         (((unit1 . value1) . _)
-          (let ((new-units (+ b-units unit1))
-                (new-value (+ b-value (* unit1 value1))))
-            (if (zero? new-units)
-                (throw 'div/0 (format #f "buying ~0,4f share units" b-units))
-                (list (cons new-units (/ new-value new-units))))))))
-
-      (else (append b-list (list (cons b-units (/ b-value b-units)))))))
-
-   ;; we have value and negative units, remove units from basis
-   ((and (not (zero? b-value)) (negative? b-units))
-    (case b-method
-      ((fifo-basis) (remove-from-head b-list b-units))
-      ((filo-basis) (reverse (remove-from-head (reverse b-list) b-units)))
-      ((average-basis)
-       (match b-list
-         (() '())
-         (((unit1 . value1) . _) (list (cons (+ unit1 b-units) value1)))))))
-
-   ;; no value, just units, this is a split/merge...
-   ((and (zero? b-value) (not (zero? b-units)))
-    (let* ((current-units (units-basis b-list))
-           ;; If current-units is zero then so should be everything else.
-           (units-ratio (if (zero? current-units) 0
-                            (/ (+ b-units current-units) current-units)))
-           ;; If the units ratio is zero the stock is worthless and
-           ;; the value should be zero too
-           (value-ratio (if (zero? units-ratio) 0 (/ 1 units-ratio))))
-      (gnc:debug "blist is " b-list " current units is " current-units
-                 " value ratio is " value-ratio " units ratio is " units-ratio)
-      (apply-basis-ratio b-list units-ratio value-ratio)))
-
-   ;; If there are no units, just a value, then its a spin-off,
-   ;; calculate a ratio for the values, but leave the units alone
-   ((and (zero? b-units) (not (zero? b-value)))
-    (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
-           (value-ratio (if (zero? current-value) 0
-                            (/ (+ b-value current-value) current-value))))
-      (gnc:debug "spinoff: blist is " b-list " value ratio is " value-ratio)
-      (apply-basis-ratio b-list 1 value-ratio)))
-
-   ;; when all else fails, just send the b-list back
-   (else b-list)))
-
-
-(define (table-add-stock-rows
-         table accounts to-date
-         currency price-fn exchange-fn price-source
-         include-empty show-symbol show-listing show-shares show-price
-         basis-method prefer-pricelist handle-brokerage-fees
-         total-basis total-value
-         total-moneyin total-moneyout total-income total-gain
-         total-ugain total-brokerage share-print-info warnings)
-
-  (define work-to-do 0)
-
-  (define work-done 0)
-
-  (define (split-account-type? split type)
-    (eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
-
-  (define (spin-off? split current)
-     (let ((other-split (xaccSplitGetOtherSplit split)))
-          (and (gnc-numeric-zero-p (xaccSplitGetAmount split))
-               (equal? current (xaccSplitGetAccount split))
-               (not (null? other-split))
-               (not (split-account-type? other-split ACCT-TYPE-EXPENSE))
-               (not (split-account-type? other-split ACCT-TYPE-INCOME)))))
-
-  (define (table-add-stock-rows-internal accounts odd-row?)
-    (if (null? accounts) total-value
-        (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
-               (current (car accounts))
-               (rest (cdr accounts))
-               ;; commodity is the actual stock/thing we are looking at
-               (commodity (xaccAccountGetCommodity current))
-               (ticker-symbol (gnc-commodity-get-mnemonic commodity))
-               (listing (gnc-commodity-get-namespace commodity))
-               (unit-collector (gnc:account-get-comm-balance-at-date
-                                current to-date #f))
-               (units (cadr (unit-collector 'getpair commodity #f)))
-
-               ;; Counter to keep track of stuff
-               (brokeragecoll (gnc:make-commodity-collector))
-               (dividendcoll  (gnc:make-commodity-collector))
-               (moneyincoll   (gnc:make-commodity-collector))
-               (moneyoutcoll  (gnc:make-commodity-collector))
-               (gaincoll      (gnc:make-commodity-collector))
-
-
-               ;; the price of the commodity at the time of the report
-               (price (price-fn commodity currency to-date))
-               ;; the value of the commodity, expressed in terms of
-               ;; the report's currency.
-               (value (gnc:make-gnc-monetary currency (gnc-numeric-zero)))  ;; Set later
-               (currency-frac (gnc-commodity-get-fraction currency))
-
-               (pricing-txn #f)
-               (use-txn #f)
-               (basis-list '())
-               ;; setup an alist for the splits we've already seen.
-               (seen_trans '())
-               ;; Account used to hold remainders from income reinvestments and
-               ;; running total of amount moved there
-               (drp-holding-account #f)
-               (drp-holding-amount (gnc-numeric-zero))
-               )
-
-          (define (my-exchange-fn fromunits tocurrency)
-            (if (and (gnc-commodity-equiv currency tocurrency)
-                     (gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunits) commodity))
-                ;; Have a price for this commodity, but not necessarily in the report's
-                ;; currency.  Get the value in the commodity's currency and convert it to
-                ;; report currency.
-                (exchange-fn
-                 ;; This currency will usually be the same as tocurrency so the
-                 ;; call to exchange-fn below will do nothing
-                 (gnc:make-gnc-monetary
-                  (if use-txn
-                      (gnc:gnc-monetary-commodity price)
-                      (gnc-price-get-currency price))
-                  (gnc-numeric-mul (gnc:gnc-monetary-amount fromunits)
-                                   (if use-txn
-                                       (gnc:gnc-monetary-amount price)
-                                       (gnc-price-get-value price))
-                                   currency-frac GNC-RND-ROUND))
-                 tocurrency)
-                (exchange-fn fromunits tocurrency)))
-
-          (gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
-                     (and price
-                          (gnc:monetary->string
-                           (gnc:make-gnc-monetary
-                            (gnc-price-get-currency price) (gnc-price-get-value price)))))
-
-          ;; If we have a price that can't be converted to the report currency
-          ;; don't use it
-          (if (and price (zero? (gnc:gnc-monetary-amount
-                                 (exchange-fn
-                                  (gnc:make-gnc-monetary
-                                   (gnc-price-get-currency price)
-                                   100)
-                                  currency))))
-              (set! price #f))
-
-          ;; If we are told to use a pricing transaction, or if we don't have a price
-          ;; from the price DB, find a good transaction to use.
-          (if (and (not use-txn)
-                   (or (not price) (not prefer-pricelist)))
-              (let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
-                                          (list current)
-                                          (case price-source
-                                            ((pricedb-latest) (gnc:get-today))
-                                            ((pricedb-nearest) to-date)
-                                            (else (gnc:get-today)))  ;; error, but don't crash
-                                          #f))))  ;; Any currency
-                ;; Find the first (most recent) one that can be converted to report currency
-                (while (and (not use-txn) (not (eqv? split-list '())))
-                  (let ((split (car split-list)))
-                    (if (and (not (gnc-numeric-zero-p (xaccSplitGetAmount split)))
-                             (not (gnc-numeric-zero-p (xaccSplitGetValue split))))
-                        (let* ((trans (xaccSplitGetParent split))
-                               (trans-currency (xaccTransGetCurrency trans))
-                               (trans-price (exchange-fn (gnc:make-gnc-monetary
-                                                          trans-currency
-                                                          (xaccSplitGetSharePrice split))
-                                                         currency)))
-                          (if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))
-                              ;; We can exchange the price from this transaction into the report currency
-                              (begin
-                                (if price (gnc-price-unref price))
-                                (set! pricing-txn trans)
-                                (set! price trans-price)
-                                (gnc:debug "Transaction price is " (gnc:monetary->string price))
-                                (set! use-txn #t))
-                              (set! split-list (cdr split-list))))
-                        (set! split-list (cdr split-list)))
-                    ))))
-
-          ;; If we still don't have a price, use a price of 1 and complain later
-          (if (not price)
-              (begin
-                (set! price (gnc:make-gnc-monetary currency 1/1))
-                ;; If use-txn is set, but pricing-txn isn't set, it's a bogus price
-                (set! use-txn #t)
-                (set! pricing-txn #f)
-                )
-              )
-
-          ;; Now that we have a pricing transaction if needed, set the value of the asset
-          (set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
-          (gnc:debug "Value " (gnc:monetary->string value)
-                     " from " (gnc:monetary->string
-                               (gnc:make-gnc-monetary commodity units)))
-
-          (for-each
-           ;; we're looking at each split we find in the account. these splits
-           ;; could refer to the same transaction, so we have to examine each
-           ;; split, determine what kind of split it is and then act accordingly.
-           (lambda (split)
-             (set! work-done (+ 1 work-done))
-             (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
-
-             (let* ((parent (xaccSplitGetParent split))
-                    (txn-date (xaccTransGetDate parent))
-                    (commod-currency (xaccTransGetCurrency parent))
-                    (commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
-
-               (if (and (<= txn-date to-date)
-                        (not (assoc-ref seen_trans (gncTransGetGUID parent))))
-                   (let ((trans-income (gnc-numeric-zero))
-                         (trans-brokerage (gnc-numeric-zero))
-                         (trans-shares (gnc-numeric-zero))
-                         (shares-bought (gnc-numeric-zero))
-                         (trans-sold (gnc-numeric-zero))
-                         (trans-bought (gnc-numeric-zero))
-                         (trans-spinoff (gnc-numeric-zero))
-                         (trans-drp-residual (gnc-numeric-zero))
-                         (trans-drp-account #f))
-
-                     (gnc:debug "Transaction " (xaccTransGetDescription parent))
-                     ;; Add this transaction to the list of processed transactions so we don't
-                     ;; do it again if there is another split in it for this account
-                     (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
-
-                     ;; Go through all the splits in the transaction to get an overall idea of
-                     ;; what it does in terms of income, money in or out, shares bought or sold, etc.
-                     (for-each
-                      (lambda (s)
-                        (let ((split-units (xaccSplitGetAmount s))
-                              (split-value (xaccSplitGetValue s)))
-
-                          (gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
-                                     (gnc-numeric-to-string split-value) " commod-currency "
-                                     (gnc-commodity-get-printname commod-currency))
-
-                          (cond
-                           ((split-account-type? s ACCT-TYPE-EXPENSE)
-                            ;; Brokerage expense unless a two split transaction with other split
-                            ;; in the stock account in which case it's a stock donation to charity.
-                            (if (not (equal? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
-                                (set! trans-brokerage
-                                  (gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND))))
-
-                           ((split-account-type? s ACCT-TYPE-INCOME)
-                            (set! trans-income (gnc-numeric-sub trans-income split-value
-                                                                commod-currency-frac GNC-RND-ROUND)))
-
-                           ((equal? current (xaccSplitGetAccount s))
-                            (set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units)
-                                                                units-denom GNC-RND-ROUND))
-                            (if (gnc-numeric-zero-p split-units)
-                                (if (spin-off? s current)
-                                    ;; Count money used in a spin off as money out
-                                    (if (gnc-numeric-negative-p split-value)
-                                        (set! trans-spinoff (gnc-numeric-sub trans-spinoff split-value
-                                                                             commod-currency-frac GNC-RND-ROUND)))
-                                    (if (not (gnc-numeric-zero-p split-value))
-                                        ;; Gain/loss split (amount zero, value non-zero, and not spinoff).  There will be
-                                        ;; a corresponding income split that will incorrectly be added to trans-income
-                                        ;; Fix that by subtracting it here
-                                        (set! trans-income (gnc-numeric-sub trans-income split-value
-                                                                            commod-currency-frac GNC-RND-ROUND))))
-                                ;; Non-zero amount, add the value to the sale or purchase total.
-                                (if (gnc-numeric-positive-p split-value)
-                                    (begin
-                                      (set! trans-bought
-                                        (gnc-numeric-add trans-bought split-value commod-currency-frac GNC-RND-ROUND))
-                                      (set! shares-bought
-                                        (gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND)))
-                                    (set! trans-sold
-                                      (gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND)))))
-
-                           ((split-account-type? s ACCT-TYPE-ASSET)
-                            ;; If all the asset accounts mentioned in the transaction are siblings of each other
-                            ;; keep track of the money transferred to them if it is in the correct currency
-                            (if (not trans-drp-account)
-                                (begin
-                                  (set! trans-drp-account (xaccSplitGetAccount s))
-                                  (if (gnc-commodity-equiv commod-currency (xaccAccountGetCommodity trans-drp-account))
-                                      (set! trans-drp-residual split-value)
-                                      (set! trans-drp-account 'none)))
-                                (if (not (eq? trans-drp-account 'none))
-                                    (if (parent-or-sibling? trans-drp-account (xaccSplitGetAccount s))
-                                        (set! trans-drp-residual (gnc-numeric-add trans-drp-residual split-value
-                                                                                  commod-currency-frac GNC-RND-ROUND))
-                                        (set! trans-drp-account 'none))))))
-                          ))
-                      (xaccTransGetSplitList parent)
-                      )
-
-                     (gnc:debug "Income: " (gnc-numeric-to-string trans-income)
-                                " Brokerage: " (gnc-numeric-to-string trans-brokerage)
-                                " Shares traded: " (gnc-numeric-to-string trans-shares)
-                                " Shares bought: " (gnc-numeric-to-string shares-bought))
-                     (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold)
-                                " Value purchased: " (gnc-numeric-to-string trans-bought)
-                                " Spinoff value " (gnc-numeric-to-string trans-spinoff)
-                                " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
-
-                     ;; We need to calculate several things for this transaction:
-                     ;; 1. Total income: this is already in trans-income
-                     ;; 2. Change in basis: calculated by loop below that looks at every
-                     ;;    that acquires or disposes of shares
-                     ;; 3. Realized gain: also calculated below while calculating basis
-                     ;; 4. Money in to the account: this is the value of shares bought
-                     ;;    except those purchased with reinvested income
-                     ;; 5. Money out: the money received by disposing of shares.   This
-                     ;;    is in trans-sold plus trans-spinoff
-                     ;; 6. Brokerage fees: this is in trans-brokerage
-
-                     ;; Income
-                     (dividendcoll 'add commod-currency trans-income)
-
-                     ;; Brokerage fees.  May be either ignored or part of basis, but that
-                     ;; will be dealt with elsewhere.
-                     (brokeragecoll 'add commod-currency trans-brokerage)
-
-                     ;; Add brokerage fees to trans-bought if not ignoring them and there are any
-                     (if (and (not (eq? handle-brokerage-fees 'ignore-brokerage))
-                              (gnc-numeric-positive-p trans-brokerage)
-                              (gnc-numeric-positive-p trans-shares))
-                         (let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))
-                                (fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND)))
-                           (set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND))))
-
-                     ;; Update the running total of the money in the DRP residual account.  This is relevant
-                     ;; if this is a reinvestment transaction (both income and purchase) and there seems to
-                     ;; asset accounts used to hold excess income.
-                     (if (and trans-drp-account
-                              (not (eq? trans-drp-account 'none))
-                              (gnc-numeric-positive-p trans-income)
-                              (gnc-numeric-positive-p trans-bought))
-                         (if (not drp-holding-account)
-                             (begin
-                               (set! drp-holding-account trans-drp-account)
-                               (set! drp-holding-amount trans-drp-residual))
-                             (if (and (not (eq? drp-holding-account 'none))
-                                      (parent-or-sibling? trans-drp-account drp-holding-account))
-                                 (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual
-                                                                           commod-currency-frac GNC-RND-ROUND))
-                                 (begin
-                                   ;; Wrong account (or no account), assume there isn't a DRP holding account
-                                   (set! drp-holding-account 'none)
-                                   (set trans-drp-residual (gnc-numeric-zero))
-                                   (set! drp-holding-amount (gnc-numeric-zero))))))
-
-                     ;; Set trans-bought to the amount of money moved in to the account which was used to
-                     ;; purchase more shares.  If this is not a DRP transaction then all money used to purchase
-                     ;; shares is money in.
-                     (if (and (gnc-numeric-positive-p trans-income)
-                              (gnc-numeric-positive-p trans-bought))
-                         (begin
-                           (set! trans-bought (gnc-numeric-sub trans-bought trans-income
-                                                               commod-currency-frac GNC-RND-ROUND))
-                           (set! trans-bought (gnc-numeric-add trans-bought trans-drp-residual
-                                                               commod-currency-frac GNC-RND-ROUND))
-                           (set! trans-bought (gnc-numeric-sub trans-bought drp-holding-amount
-                                                               commod-currency-frac GNC-RND-ROUND))
-                           ;; If the DRP holding account balance is negative, adjust it by the amount
-                           ;; used in this transaction
-                           (if (and (gnc-numeric-negative-p drp-holding-amount)
-                                    (gnc-numeric-positive-p trans-bought))
-                               (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought
-                                                                         commod-currency-frac GNC-RND-ROUND)))
-                           ;; Money in is never more than amount spent to purchase shares
-                           (if (gnc-numeric-negative-p trans-bought)
-                               (set! trans-bought (gnc-numeric-zero)))))
-
-                     (gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought)
-                                " DRP holding account " (gnc-numeric-to-string drp-holding-amount))
-
-                     (moneyincoll 'add commod-currency trans-bought)
-                     (moneyoutcoll 'add commod-currency trans-sold)
-                     (moneyoutcoll 'add commod-currency trans-spinoff)
-
-                     ;; Look at splits again to handle changes in basis and realized gains
-                     (for-each
-                      (lambda (s)
-                        (let
-                            ;; get the split's units and value
-                            ((split-units (xaccSplitGetAmount s))
-                             (split-value (xaccSplitGetValue s)))
-
-                          (gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
-                                     (gnc-numeric-to-string split-value) " commod-currency "
-                                     (gnc-commodity-get-printname commod-currency))
-
-                          (cond
-                           ((and (not (gnc-numeric-zero-p split-units))
-                                 (equal? current (xaccSplitGetAccount s)))
-                            ;; Split into subject account with non-zero amount.  This is a purchase
-                            ;; or a sale, adjust the basis
-                            (let* ((split-value-currency (gnc:gnc-monetary-amount
-                                                          (my-exchange-fn (gnc:make-gnc-monetary
-                                                                           commod-currency split-value) currency)))
-                                   (orig-basis (sum-basis basis-list currency-frac))
-                                   ;; proportion of the fees attributable to this split
-                                   (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
-                                                               GNC-DENOM-AUTO GNC-DENOM-REDUCE))
-                                   ;; Fees for this split in report currency
-                                   (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
-                                                                            (gnc:make-gnc-monetary commod-currency
-                                                                                                   (gnc-numeric-mul fee-ratio trans-brokerage
-                                                                                                                    commod-currency-frac GNC-RND-ROUND))
-                                                                            currency)))
-                                   (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
-                                                              ;; Include brokerage fees in basis
-                                                              (gnc-numeric-add split-value-currency fees-currency
-                                                                               currency-frac GNC-RND-ROUND)
-                                                              split-value-currency)))
-                              (gnc:debug "going in to basis list " basis-list " " (gnc-numeric-to-string split-units) " "
-                                         (gnc-numeric-to-string split-value-with-fees))
-
-                              ;; adjust the basis
-                              (set! basis-list (basis-builder basis-list split-units split-value-with-fees
-                                                              basis-method currency-frac))
-                              (gnc:debug  "coming out of basis list " basis-list)
-
-                              ;; If it's a sale or the stock is worthless, calculate the gain
-                              (if (not (gnc-numeric-positive-p split-value))
-                                  ;; Split value is zero or negative.  If it's zero it's either a stock split/merge
-                                  ;; or the stock has become worthless (which looks like a merge where the number
-                                  ;; of shares goes to zero).  If the value is negative then it's a disposal of some sort.
-                                  (let ((new-basis (sum-basis basis-list currency-frac)))
-                                    (if (or (gnc-numeric-zero-p new-basis)
-                                            (gnc-numeric-negative-p split-value))
-                                        ;; Split value is negative or new basis is zero (stock is worthless),
-                                        ;; Capital gain is money out minus change in basis
-                                        (let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees)
-                                                                     (gnc-numeric-sub orig-basis new-basis
-                                                                                      currency-frac GNC-RND-ROUND)
-                                                                     currency-frac GNC-RND-ROUND)))
-                                          (gnc:debug "Old basis=" (gnc-numeric-to-string orig-basis)
-                                                     " New basis=" (gnc-numeric-to-string new-basis)
-                                                     " Gain=" (gnc-numeric-to-string gain))
-                                          (gaincoll 'add currency gain)))))))
-
-                           ;; here is where we handle a spin-off txn. This will be a no-units
-                           ;; split with only one other split. xaccSplitGetOtherSplit only
-                           ;; returns on a two-split txn.  It's not a spinoff is the other split is
-                           ;; in an income or expense account.
-                           ((spin-off? s current)
-                            (gnc:debug "before spin-off basis list " basis-list)
-                            (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
-                                                                                    (my-exchange-fn (gnc:make-gnc-monetary
-                                                                                                     commod-currency split-value)
-                                                                                                    currency))
-                                                            basis-method
-                                                            currency-frac))
-                            (gnc:debug "after spin-off basis list "  basis-list))
-                           )
-                          ))
-                      (xaccTransGetSplitList parent)
-                      )
-                     )
-                   )
-               )
-             )
-           (xaccAccountGetSplitList current)
-           )
-
-          ;; Look for income and expense transactions that don't have a split in the
-          ;; the account we're processing.  We do this as follow
-          ;; 1. Make sure the parent account is a currency-valued asset or bank account
-          ;; 2. If so go through all the splits in that account
-          ;; 3. If a split is part of a two split transaction where the other split is
-          ;;    to an income or expense account and the leaf name of that account is the
-          ;;    same as the leaf name of the account we're processing, add it to the
-          ;;    income or expense accumulator
-          ;;
-          ;; In other words with an account structure like
-          ;;
-          ;;   Assets (type ASSET)
-          ;;     Broker (type ASSET)
-          ;;       Widget Stock (type STOCK)
-          ;;   Income (type INCOME)
-          ;;     Dividends (type INCOME)
-          ;;       Widget Stock (type INCOME)
-          ;;
-          ;; If you are producing a report on "Assets:Broker:Widget Stock" a
-          ;; transaction that debits the Assets:Broker account and credits the
-          ;; "Income:Dividends:Widget Stock" account will count as income in
-          ;; the report even though it doesn't have a split in the account
-          ;; being reported on.
-
-          (let ((parent-account (gnc-account-get-parent current))
-                (account-name (xaccAccountGetName current)))
-            (if (and (not (null? parent-account))
-                     (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
-                     (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
-                (for-each
-                 (lambda (split)
-                   (let* ((other-split (xaccSplitGetOtherSplit split))
-                          ;; This is safe because xaccSplitGetAccount returns null for a null split
-                          (other-acct (xaccSplitGetAccount other-split))
-                          (parent (xaccSplitGetParent split))
-                          (txn-date (xaccTransGetDate parent)))
-                     (if (and (not (null? other-acct))
-                              (<= txn-date to-date)
-                              (string=? (xaccAccountGetName other-acct) account-name)
-                              (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
-                         ;; This is a two split transaction where the other split is to an
-                         ;; account with the same name as the current account.  If it's an
-                         ;; income or expense account accumulate the value of the transaction
-                         (let ((val (xaccSplitGetValue split))
-                               (curr (xaccAccountGetCommodity other-acct)))
-                           (cond ((split-account-type? other-split ACCT-TYPE-INCOME)
-                                  (gnc:debug "More income " (gnc-numeric-to-string val))
-                                  (dividendcoll 'add curr val))
-                                 ((split-account-type? other-split ACCT-TYPE-EXPENSE)
-                                  (gnc:debug "More expense " (gnc-numeric-to-string
-                                                              (gnc-numeric-neg val)))
-                                  (brokeragecoll 'add curr (gnc-numeric-neg val)))
-                                 )
-                           )
-                         )
-                     )
-                   )
-                 (xaccAccountGetSplitList parent-account)
-                 )
-                )
-            )
-
-          (gnc:debug "pricing txn is " pricing-txn)
-          (gnc:debug "use txn is " use-txn)
-          (gnc:debug "prefer-pricelist is " prefer-pricelist)
-          (gnc:debug "price is " price)
-
-          (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
-                                                                                             currency-frac)))
-          (gnc:debug "but the actual basis list is " basis-list)
-
-          (if (eq? handle-brokerage-fees 'include-in-gain)
-              (gaincoll 'minusmerge brokeragecoll #f))
-
-          (if (or include-empty (not (gnc-numeric-zero-p units)))
-              (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn))
-                     (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn))
-                     (brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn))
-                     (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
-                     ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
-                     (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
-                     (ugain (gnc:make-gnc-monetary currency
-                                                   (gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
-                                                                    (sum-basis basis-list (gnc-commodity-get-fraction currency))
-                                                                    currency-frac GNC-RND-ROUND)))
-                     (bothgain (gnc:make-gnc-monetary currency  (gnc-numeric-add (gnc:gnc-monetary-amount gain)
-                                                                                 (gnc:gnc-monetary-amount ugain)
-                                                                                 currency-frac GNC-RND-ROUND)))
-                     (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain)
-                                                                                   (gnc:gnc-monetary-amount income)
-                                                                                   currency-frac GNC-RND-ROUND)))
-
-                     (activecols (list (gnc:html-account-anchor current)))
-                     )
-
-                ;; If we're using the txn, warn the user
-                (if use-txn
-                    (if pricing-txn
-                        (hashq-set! warnings 'warn-price-dirty #t)
-                        (hashq-set! warnings 'warn-no-price #t)
-                        ))
-
-                (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
-                (total-moneyin 'merge moneyincoll #f)
-                (total-moneyout 'merge moneyoutcoll #f)
-                (total-brokerage 'merge brokeragecoll #f)
-                (total-income 'merge dividendcoll #f)
-                (total-gain 'merge gaincoll #f)
-                (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
-                (total-basis 'add currency (sum-basis basis-list currency-frac))
-
-                ;; build a list for the row  based on user selections
-                (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol))))
-                (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing))))
-                (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup
-                                                           "number-cell" (xaccPrintAmount units share-print-info)))))
-                (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup
-                                                          "number-cell"
-                                                          (if use-txn
-                                                              (if pricing-txn
-                                                                  (gnc:html-transaction-anchor pricing-txn price)
-                                                                  price)
-                                                              (gnc:html-price-anchor
-                                                               price (gnc:default-price-renderer
-                                                                      (gnc-price-get-currency price)
-                                                                      (gnc-price-get-value price))))))))
-                (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
-                                          (gnc:make-html-table-header-cell/markup
-                                           "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
-                                                                                                    currency-frac)))
-                                          (gnc:make-html-table-header-cell/markup "number-cell" value)
-                                          (gnc:make-html-table-header-cell/markup "number-cell" moneyin)
-                                          (gnc:make-html-table-header-cell/markup "number-cell" moneyout)
-                                          (gnc:make-html-table-header-cell/markup "number-cell" gain)
-                                          (gnc:make-html-table-header-cell/markup "number-cell" ugain)
-                                          (gnc:make-html-table-header-cell/markup "number-cell" bothgain)
-                                          (gnc:make-html-table-header-cell/markup "number-cell"
-                                                                                  (let* ((moneyinvalue (gnc-numeric-to-double
-                                                                                                        (gnc:gnc-monetary-amount moneyin)))
-                                                                                         (bothgainvalue (gnc-numeric-to-double
-                                                                                                         (gnc:gnc-monetary-amount bothgain)))
-                                                                                         )
-                                                                                    (if (= 0.0 moneyinvalue)
-                                                                                        ""
-                                                                                        (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue)))))
-                                                                                  )
-                                          (gnc:make-html-table-header-cell/markup "number-cell" income)))
-                (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
-                    (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
-                (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
-                                          (gnc:make-html-table-header-cell/markup "number-cell"
-                                                                                  (let* ((moneyinvalue (gnc-numeric-to-double
-                                                                                                        (gnc:gnc-monetary-amount moneyin)))
-                                                                                         (totalreturnvalue (gnc-numeric-to-double
-                                                                                                            (gnc:gnc-monetary-amount totalreturn)))
-                                                                                         )
-                                                                                    (if (= 0.0 moneyinvalue)
-                                                                                        ""
-                                                                                        (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue))))))
-                                          )
-                         )
-
-                (gnc:html-table-append-row/markup!
-                 table
-                 row-style
-                 activecols)
-
-                (if (and (not use-txn) price) (gnc-price-unref price))
-                (table-add-stock-rows-internal rest (not odd-row?))
-                )
-              (begin
-                (if (and (not use-txn) price) (gnc-price-unref price))
-                (table-add-stock-rows-internal rest odd-row?)
-                )
-              )
-          )))
-
-  (set! work-to-do (gnc:accounts-count-splits accounts))
-  (table-add-stock-rows-internal accounts #t))
-
 ;; This is the rendering function. It accepts a database of options
 ;; and generates an object of type <html-document>.  See the file
 ;; report-html.txt for documentation; the file report-html.scm
@@ -892,8 +188,10 @@ by preventing negative stock balances.<br/>")
 
 (define (advanced-portfolio-renderer report-obj)
 
-  ;; report-warnings hash-table.
-  (define warnings (make-hash-table))
+ (let ((work-done 0)
+       (work-to-do 0)
+       (warn-no-price #f)
+       (warn-price-dirty #f))
 
   ;; These are some helper functions for looking up option values.
   (define (get-op section name)
@@ -908,6 +206,161 @@ by preventing negative stock balances.<br/>")
   (define (same-split? s1 s2)
     (equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
 
+  (define (same-account? a1 a2)
+    (equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
+
+  ;; sum up the contents of the b-list built by basis-builder below
+  (define (sum-basis b-list currency-frac)
+    (if (not (eqv? b-list '()))
+	(gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-frac GNC-RND-ROUND)
+			 (sum-basis (cdr b-list) currency-frac) currency-frac GNC-RND-ROUND)
+	(gnc-numeric-zero)
+	)
+    )
+
+  ;; sum up the total number of units in the b-list built by basis-builder below
+  (define (units-basis b-list)
+    (if (not (eqv? b-list '()))
+	(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
+			 units-denom GNC-RND-ROUND)
+	(gnc-numeric-zero)
+	)
+    )
+
+  ;; apply a ratio to an existing basis-list, useful for splits/mergers and spinoffs
+  ;; I need to get a brain and use (map) for this.
+  (define (apply-basis-ratio b-list units-ratio value-ratio)
+    (if (not (eqv? b-list '()))
+	(cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RND-ROUND)
+		    (gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RND-ROUND))
+	      (apply-basis-ratio (cdr b-list) units-ratio value-ratio))
+	'()
+	)
+    )
+
+  ;; this builds a list for basis calculation and handles average, fifo and lifo methods
+  ;; the list is cons cells of (units-of-stock . price-per-unit)... average method produces only one
+  ;; cell that mutates to the new average. Need to add a date checker so that we allow for prices
+  ;; coming in out of order, such as a transfer with a price adjusted to carryover the basis.
+  (define (basis-builder b-list b-units b-value b-method currency-frac)
+    (gnc:debug "actually in basis-builder")
+    (gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units)
+               " b-value is " (gnc-numeric-to-string b-value) " b-method is " b-method)
+
+    ;; if there is no b-value, then this is a split/merger and needs special handling
+    (cond
+
+     ;; we have value and positive units, add units to basis
+     ((and (not (gnc-numeric-zero-p b-value))
+	   (gnc-numeric-positive-p b-units))
+      (case b-method
+	((average-basis)
+	 (if (not (eqv? b-list '()))
+	     (list (cons (gnc-numeric-add b-units
+					  (caar b-list) units-denom GNC-RND-ROUND)
+			 (gnc-numeric-div
+			  (gnc-numeric-add b-value
+					   (gnc-numeric-mul (caar b-list)
+							    (cdar b-list)
+							    GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+					   GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+			  (let ((denom (gnc-numeric-add b-units
+                                                        (caar b-list) GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
+                            (if (zero? denom)
+                                (throw 'div/0 (format #f "buying ~0,4f share units" b-units))
+                                denom))
+			  price-denom GNC-RND-ROUND)))
+	     (append b-list
+                     (list (cons b-units (gnc-numeric-div
+                                          b-value b-units price-denom GNC-RND-ROUND))))))
+	(else (append b-list
+                      (list (cons b-units (gnc-numeric-div
+                                           b-value b-units price-denom GNC-RND-ROUND)))))))
+
+     ;; we have value and negative units, remove units from basis
+     ((and (not (gnc-numeric-zero-p b-value))
+	   (gnc-numeric-negative-p b-units))
+      (if (not (eqv? b-list '()))
+          (case b-method
+            ((fifo-basis)
+             (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
+               ((-1)
+                 ;; Sold less than the first lot, create a new first lot from the remainder
+                 (let ((new-units (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)))
+                        (cons (cons new-units (cdar b-list)) (cdr b-list))))
+               ((0)
+                 ;; Sold all of the first lot
+                 (cdr b-list))
+               ((1)
+                 ;; Sold more than the first lot, delete it and recurse
+                 (basis-builder (cdr b-list) (gnc-numeric-add b-units (caar b-list) units-denom GNC-RND-ROUND)
+                                b-value  ;; Only the sign of b-value matters since the new b-units is negative
+                                b-method currency-frac))))
+            ((filo-basis)
+             (let ((rev-b-list (reverse b-list)))
+               (case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar rev-b-list))
+                 ((-1)
+                   ;; Sold less than the last lot
+                 (let ((new-units (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)))
+                        (reverse (cons (cons new-units (cdar rev-b-list)) (cdr rev-b-list)))))
+                 ((0)
+                   ;; Sold all of the last lot
+                   (reverse (cdr rev-b-list))
+                 )
+                 ((1)
+                   ;; Sold more than the last lot
+                   (basis-builder (reverse (cdr rev-b-list)) (gnc-numeric-add b-units (caar rev-b-list) units-denom GNC-RND-ROUND)
+                                           b-value b-method currency-frac)
+                 ))))
+            ((average-basis)
+             (list (cons (gnc-numeric-add
+                          (caar b-list) b-units units-denom GNC-RND-ROUND)
+                         (cdar b-list)))))
+          '()
+          ))
+
+     ;; no value, just units, this is a split/merge...
+     ((and (gnc-numeric-zero-p b-value)
+	   (not (gnc-numeric-zero-p b-units)))
+	(let* ((current-units (units-basis b-list))
+               ;; If current-units is zero then so should be everything else.
+	       (units-ratio (if (zero? current-units) (gnc-numeric-zero)
+                                (gnc-numeric-div (gnc-numeric-add b-units current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+                                                 current-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)))
+               ;; If the units ratio is zero the stock is worthless and the value should be zero too
+	       (value-ratio (if (gnc-numeric-zero-p units-ratio)
+	                        (gnc-numeric-zero)
+                                (gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
+
+	  (gnc:debug "blist is " b-list " current units is "
+	             (gnc-numeric-to-string current-units)
+	             " value ratio is " (gnc-numeric-to-string value-ratio)
+	             " units ratio is " (gnc-numeric-to-string units-ratio))
+	  (apply-basis-ratio b-list units-ratio value-ratio)
+	  ))
+
+	;; If there are no units, just a value, then its a spin-off,
+	;; calculate a ratio for the values, but leave the units alone
+	;; with a ratio of 1
+     ((and (gnc-numeric-zero-p b-units)
+	   (not (gnc-numeric-zero-p b-value)))
+      (let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
+            (value-ratio (if (zero? current-value)
+                             (throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
+                             (gnc-numeric-div (gnc-numeric-add b-value current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE)
+                                              current-value GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
+
+	(gnc:debug "this is a spinoff")
+	(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string value-ratio))
+	(apply-basis-ratio b-list 1/1 value-ratio))
+      )
+
+     ;; when all else fails, just send the b-list back
+     (else
+      b-list)
+     )
+    )
+
   ;; Given a price list and a currency find the price for that currency on the list.
   ;; If there is none for the requested currency, return the first one.
   ;; The price list is released but the price returned is ref counted.
@@ -925,6 +378,14 @@ by preventing negative stock balances.<br/>")
         (gnc-price-list-destroy price-list)
         price)))
 
+  ;; Return true if either account is the parent of the other or they are siblings
+  (define (parent-or-sibling? a1 a2)
+    (let ((a2parent (gnc-account-get-parent a2))
+          (a1parent (gnc-account-get-parent a1)))
+          (or (same-account? a2parent a1)
+              (same-account? a1parent a2)
+              (same-account? a1parent a2parent))))
+
   ;; Test whether the given split is the source of a spin off transaction
   ;; This will be a no-units split with only one other split.
   ;; xaccSplitGetOtherSplit only returns on a two-split txn.  It's not a spinoff
@@ -937,6 +398,593 @@ by preventing negative stock balances.<br/>")
                (not (split-account-type? other-split ACCT-TYPE-EXPENSE))
                (not (split-account-type? other-split ACCT-TYPE-INCOME)))))
 
+
+(define (table-add-stock-rows table accounts to-date
+                                currency price-fn exchange-fn price-source
+				include-empty show-symbol show-listing show-shares show-price
+                                basis-method prefer-pricelist handle-brokerage-fees
+                                total-basis total-value
+                                total-moneyin total-moneyout total-income total-gain
+                                total-ugain total-brokerage)
+
+   (let ((share-print-info
+	  (gnc-share-print-info-places
+	   (inexact->exact (get-option gnc:pagename-display
+      			       optname-shares-digits)))))
+
+    (define (table-add-stock-rows-internal accounts odd-row?)
+      (if (null? accounts) total-value
+          (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
+                 (current (car accounts))
+                 (rest (cdr accounts))
+		 ;; commodity is the actual stock/thing we are looking at
+                 (commodity (xaccAccountGetCommodity current))
+                 (ticker-symbol (gnc-commodity-get-mnemonic commodity))
+                 (listing (gnc-commodity-get-namespace commodity))
+                 (unit-collector (gnc:account-get-comm-balance-at-date
+                                  current to-date #f))
+                 (units (cadr (unit-collector 'getpair commodity #f)))
+
+                 ;; Counter to keep track of stuff
+                 (brokeragecoll (gnc:make-commodity-collector))
+                 (dividendcoll  (gnc:make-commodity-collector))
+                 (moneyincoll   (gnc:make-commodity-collector))
+                 (moneyoutcoll  (gnc:make-commodity-collector))
+                 (gaincoll      (gnc:make-commodity-collector))
+
+
+		 ;; the price of the commodity at the time of the report
+                 (price (price-fn commodity currency to-date))
+		 ;; the value of the commodity, expressed in terms of
+		 ;; the report's currency.
+                 (value (gnc:make-gnc-monetary currency (gnc-numeric-zero)))  ;; Set later
+                 (currency-frac (gnc-commodity-get-fraction currency))
+
+		 (pricing-txn #f)
+		 (use-txn #f)
+		 (basis-list '())
+		 ;; setup an alist for the splits we've already seen.
+		 (seen_trans '())
+		 ;; Account used to hold remainders from income reinvestments and
+		 ;; running total of amount moved there
+		 (drp-holding-account #f)
+		 (drp-holding-amount (gnc-numeric-zero))
+		 )
+
+            (define (my-exchange-fn fromunits tocurrency)
+              (if (and (gnc-commodity-equiv currency tocurrency)
+                       (gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunits) commodity))
+                    ;; Have a price for this commodity, but not necessarily in the report's
+                    ;; currency.  Get the value in the commodity's currency and convert it to
+                    ;; report currency.
+                    (exchange-fn
+                      ;; This currency will usually be the same as tocurrency so the
+                      ;; call to exchange-fn below will do nothing
+                      (gnc:make-gnc-monetary
+                        (if use-txn
+                            (gnc:gnc-monetary-commodity price)
+                            (gnc-price-get-currency price))
+                        (gnc-numeric-mul (gnc:gnc-monetary-amount fromunits)
+                                         (if use-txn
+                                             (gnc:gnc-monetary-amount price)
+                                             (gnc-price-get-value price))
+                                         currency-frac GNC-RND-ROUND))
+                      tocurrency)
+                    (exchange-fn fromunits tocurrency)))
+
+            (gnc:debug "Starting account " (xaccAccountGetName current) ", initial price: "
+                       (and price
+                            (gnc:monetary->string
+                             (gnc:make-gnc-monetary
+                              (gnc-price-get-currency price) (gnc-price-get-value price)))))
+
+            ;; If we have a price that can't be converted to the report currency
+            ;; don't use it
+            (if (and price (gnc-numeric-zero-p (gnc:gnc-monetary-amount
+                                       (exchange-fn
+                                          (gnc:make-gnc-monetary
+                                            (gnc-price-get-currency price)
+                                            100/1)
+                                          currency))))
+                (set! price #f))
+
+            ;; If we are told to use a pricing transaction, or if we don't have a price
+            ;; from the price DB, find a good transaction to use.
+            (if (and (not use-txn)
+                     (or (not price) (not prefer-pricelist)))
+                  (let ((split-list (reverse (gnc:get-match-commodity-splits-sorted
+                                                 (list current)
+                                                 (case price-source
+                                                   ((pricedb-latest) (gnc:get-today))
+                                                   ((pricedb-nearest) to-date)
+                                                   (else (gnc:get-today)))  ;; error, but don't crash
+                                                 #f))))  ;; Any currency
+                        ;; Find the first (most recent) one that can be converted to report currency
+                        (while (and (not use-txn) (not (eqv? split-list '())))
+                          (let ((split (car split-list)))
+                            (if (and (not (gnc-numeric-zero-p (xaccSplitGetAmount split)))
+                                     (not (gnc-numeric-zero-p (xaccSplitGetValue split))))
+                              (let* ((trans (xaccSplitGetParent split))
+                                     (trans-currency (xaccTransGetCurrency trans))
+                                     (trans-price (exchange-fn (gnc:make-gnc-monetary
+                                                                   trans-currency
+                                                                   (xaccSplitGetSharePrice split))
+                                                               currency)))
+                                (if (not (gnc-numeric-zero-p (gnc:gnc-monetary-amount trans-price)))
+                                  ;; We can exchange the price from this transaction into the report currency
+                                  (begin
+                                    (if price (gnc-price-unref price))
+                                    (set! pricing-txn trans)
+                                    (set! price trans-price)
+                                    (gnc:debug "Transaction price is " (gnc:monetary->string price))
+                                    (set! use-txn #t))
+                                  (set! split-list (cdr split-list))))
+                              (set! split-list (cdr split-list)))
+                            ))))
+
+            ;; If we still don't have a price, use a price of 1 and complain later
+            (if (not price)
+              (begin
+                (set! price (gnc:make-gnc-monetary currency 1/1))
+                ;; If use-txn is set, but pricing-txn isn't set, it's a bogus price
+                (set! use-txn #t)
+                (set! pricing-txn #f)
+              )
+            )
+
+            ;; Now that we have a pricing transaction if needed, set the value of the asset
+            (set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
+            (gnc:debug "Value " (gnc:monetary->string value)
+                       " from " (gnc:monetary->string
+                                 (gnc:make-gnc-monetary commodity units)))
+
+	    (for-each
+	     ;; we're looking at each split we find in the account. these splits
+	     ;; could refer to the same transaction, so we have to examine each
+	     ;; split, determine what kind of split it is and then act accordingly.
+	     (lambda (split)
+	       (set! work-done (+ 1 work-done))
+	       (gnc:report-percent-done (* 100 (/ work-done work-to-do)))
+
+	       (let* ((parent (xaccSplitGetParent split))
+		      (txn-date (xaccTransGetDate parent))
+		      (commod-currency (xaccTransGetCurrency parent))
+		      (commod-currency-frac (gnc-commodity-get-fraction commod-currency)))
+
+		 (if (and (<= txn-date to-date)
+		          (not (assoc-ref seen_trans (gncTransGetGUID parent))))
+		     (let ((trans-income (gnc-numeric-zero))
+		           (trans-brokerage (gnc-numeric-zero))
+		           (trans-shares (gnc-numeric-zero))
+		           (shares-bought (gnc-numeric-zero))
+		           (trans-sold (gnc-numeric-zero))
+		           (trans-bought (gnc-numeric-zero))
+		           (trans-spinoff (gnc-numeric-zero))
+		           (trans-drp-residual (gnc-numeric-zero))
+		           (trans-drp-account #f))
+
+		       (gnc:debug "Transaction " (xaccTransGetDescription parent))
+		       ;; Add this transaction to the list of processed transactions so we don't
+		       ;; do it again if there is another split in it for this account
+		       (set! seen_trans (acons (gncTransGetGUID parent) #t seen_trans))
+
+		       ;; Go through all the splits in the transaction to get an overall idea of
+		       ;; what it does in terms of income, money in or out, shares bought or sold, etc.
+		       (for-each
+		         (lambda (s)
+                           (let ((split-units (xaccSplitGetAmount s))
+                                 (split-value (xaccSplitGetValue s)))
+
+                             (gnc:debug "Pass 1: split units " (gnc-numeric-to-string split-units) " split-value "
+                                        (gnc-numeric-to-string split-value) " commod-currency "
+                                        (gnc-commodity-get-printname commod-currency))
+
+                             (cond
+                                ((split-account-type? s ACCT-TYPE-EXPENSE)
+                                 ;; Brokerage expense unless a two split transaction with other split
+                                 ;; in the stock account in which case it's a stock donation to charity.
+                                 (if (not (same-account? current (xaccSplitGetAccount (xaccSplitGetOtherSplit s))))
+                                   (set! trans-brokerage
+                                         (gnc-numeric-add trans-brokerage split-value commod-currency-frac GNC-RND-ROUND))))
+
+                                ((split-account-type? s ACCT-TYPE-INCOME)
+                                 (set! trans-income (gnc-numeric-sub trans-income split-value
+                                                             commod-currency-frac GNC-RND-ROUND)))
+
+                                ((same-account? current (xaccSplitGetAccount s))
+                                 (set! trans-shares (gnc-numeric-add trans-shares (gnc-numeric-abs split-units)
+                                                  units-denom GNC-RND-ROUND))
+                                 (if (gnc-numeric-zero-p split-units)
+                                     (if (spin-off? s current)
+                                         ;; Count money used in a spin off as money out
+                                         (if (gnc-numeric-negative-p split-value)
+                                             (set! trans-spinoff (gnc-numeric-sub trans-spinoff split-value
+                                                                                  commod-currency-frac GNC-RND-ROUND)))
+                                         (if (not (gnc-numeric-zero-p split-value))
+                                              ;; Gain/loss split (amount zero, value non-zero, and not spinoff).  There will be
+                                              ;; a corresponding income split that will incorrectly be added to trans-income
+                                              ;; Fix that by subtracting it here
+                                              (set! trans-income (gnc-numeric-sub trans-income split-value
+                                                                                  commod-currency-frac GNC-RND-ROUND))))
+                                     ;; Non-zero amount, add the value to the sale or purchase total.
+                                     (if (gnc-numeric-positive-p split-value)
+                                          (begin
+                                             (set! trans-bought
+                                                  (gnc-numeric-add trans-bought split-value commod-currency-frac GNC-RND-ROUND))
+                                             (set! shares-bought
+                                                  (gnc-numeric-add shares-bought split-units units-denom GNC-RND-ROUND)))
+                                          (set! trans-sold
+                                               (gnc-numeric-sub trans-sold split-value commod-currency-frac GNC-RND-ROUND)))))
+
+                                ((split-account-type? s ACCT-TYPE-ASSET)
+                                 ;; If all the asset accounts mentioned in the transaction are siblings of each other
+                                 ;; keep track of the money transferred to them if it is in the correct currency
+                                 (if (not trans-drp-account)
+                                     (begin
+                                       (set! trans-drp-account (xaccSplitGetAccount s))
+                                         (if (gnc-commodity-equiv commod-currency (xaccAccountGetCommodity trans-drp-account))
+                                             (set! trans-drp-residual split-value)
+                                             (set! trans-drp-account 'none)))
+                                     (if (not (eq? trans-drp-account 'none))
+                                       (if (parent-or-sibling? trans-drp-account (xaccSplitGetAccount s))
+                                           (set! trans-drp-residual (gnc-numeric-add trans-drp-residual split-value
+                                                                                     commod-currency-frac GNC-RND-ROUND))
+                                           (set! trans-drp-account 'none))))))
+		         ))
+		         (xaccTransGetSplitList parent)
+		       )
+
+		       (gnc:debug "Income: " (gnc-numeric-to-string trans-income)
+		                  " Brokerage: " (gnc-numeric-to-string trans-brokerage)
+		                  " Shares traded: " (gnc-numeric-to-string trans-shares)
+		                  " Shares bought: " (gnc-numeric-to-string shares-bought))
+		       (gnc:debug " Value sold: " (gnc-numeric-to-string trans-sold)
+		                  " Value purchased: " (gnc-numeric-to-string trans-bought)
+		                  " Spinoff value " (gnc-numeric-to-string trans-spinoff)
+		                  " Trans DRP residual: " (gnc-numeric-to-string trans-drp-residual))
+
+		       ;; We need to calculate several things for this transaction:
+		       ;; 1. Total income: this is already in trans-income
+		       ;; 2. Change in basis: calculated by loop below that looks at every
+		       ;;    that acquires or disposes of shares
+		       ;; 3. Realized gain: also calculated below while calculating basis
+		       ;; 4. Money in to the account: this is the value of shares bought
+		       ;;    except those purchased with reinvested income
+		       ;; 5. Money out: the money received by disposing of shares.   This
+		       ;;    is in trans-sold plus trans-spinoff
+		       ;; 6. Brokerage fees: this is in trans-brokerage
+
+		       ;; Income
+		       (dividendcoll 'add commod-currency trans-income)
+
+                       ;; Brokerage fees.  May be either ignored or part of basis, but that
+                       ;; will be dealt with elsewhere.
+                       (brokeragecoll 'add commod-currency trans-brokerage)
+
+                       ;; Add brokerage fees to trans-bought if not ignoring them and there are any
+                       (if (and (not (eq? handle-brokerage-fees 'ignore-brokerage))
+                                (gnc-numeric-positive-p trans-brokerage)
+                                (gnc-numeric-positive-p trans-shares))
+                           (let* ((fee-frac (gnc-numeric-div shares-bought trans-shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))
+                                  (fees (gnc-numeric-mul trans-brokerage fee-frac commod-currency-frac GNC-RND-ROUND)))
+                                 (set! trans-bought (gnc-numeric-add trans-bought fees commod-currency-frac GNC-RND-ROUND))))
+
+                       ;; Update the running total of the money in the DRP residual account.  This is relevant
+                       ;; if this is a reinvestment transaction (both income and purchase) and there seems to
+                       ;; asset accounts used to hold excess income.
+                       (if (and trans-drp-account
+                                (not (eq? trans-drp-account 'none))
+                                (gnc-numeric-positive-p trans-income)
+                                (gnc-numeric-positive-p trans-bought))
+                           (if (not drp-holding-account)
+                               (begin
+                                 (set! drp-holding-account trans-drp-account)
+                                 (set! drp-holding-amount trans-drp-residual))
+                               (if (and (not (eq? drp-holding-account 'none))
+                                        (parent-or-sibling? trans-drp-account drp-holding-account))
+                                   (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-drp-residual
+                                                                              commod-currency-frac GNC-RND-ROUND))
+                                   (begin
+                                     ;; Wrong account (or no account), assume there isn't a DRP holding account
+                                     (set! drp-holding-account 'none)
+                                     (set trans-drp-residual (gnc-numeric-zero))
+                                     (set! drp-holding-amount (gnc-numeric-zero))))))
+
+                       ;; Set trans-bought to the amount of money moved in to the account which was used to
+                       ;; purchase more shares.  If this is not a DRP transaction then all money used to purchase
+                       ;; shares is money in.
+                       (if (and (gnc-numeric-positive-p trans-income)
+                                (gnc-numeric-positive-p trans-bought))
+                           (begin
+                             (set! trans-bought (gnc-numeric-sub trans-bought trans-income
+                                                                 commod-currency-frac GNC-RND-ROUND))
+                             (set! trans-bought (gnc-numeric-add trans-bought trans-drp-residual
+                                                                 commod-currency-frac GNC-RND-ROUND))
+                             (set! trans-bought (gnc-numeric-sub trans-bought drp-holding-amount
+                                                                 commod-currency-frac GNC-RND-ROUND))
+                             ;; If the DRP holding account balance is negative, adjust it by the amount
+                             ;; used in this transaction
+                             (if (and (gnc-numeric-negative-p drp-holding-amount)
+                                      (gnc-numeric-positive-p trans-bought))
+                                 (set! drp-holding-amount (gnc-numeric-add drp-holding-amount trans-bought
+                                                                           commod-currency-frac GNC-RND-ROUND)))
+                             ;; Money in is never more than amount spent to purchase shares
+                             (if (gnc-numeric-negative-p trans-bought)
+                                 (set! trans-bought (gnc-numeric-zero)))))
+
+                       (gnc:debug "Adjusted trans-bought " (gnc-numeric-to-string trans-bought)
+                                  " DRP holding account " (gnc-numeric-to-string drp-holding-amount))
+
+                       (moneyincoll 'add commod-currency trans-bought)
+                       (moneyoutcoll 'add commod-currency trans-sold)
+                       (moneyoutcoll 'add commod-currency trans-spinoff)
+
+                       ;; Look at splits again to handle changes in basis and realized gains
+		       (for-each
+		         (lambda (s)
+                           (let
+                              ;; get the split's units and value
+                              ((split-units (xaccSplitGetAmount s))
+                               (split-value (xaccSplitGetValue s)))
+
+                             (gnc:debug "Pass 2: split units " (gnc-numeric-to-string split-units) " split-value "
+                                        (gnc-numeric-to-string split-value) " commod-currency "
+                                        (gnc-commodity-get-printname commod-currency))
+
+                             (cond
+                               ((and (not (gnc-numeric-zero-p split-units))
+                                     (same-account? current (xaccSplitGetAccount s)))
+                                ;; Split into subject account with non-zero amount.  This is a purchase
+                                ;; or a sale, adjust the basis
+				(let* ((split-value-currency (gnc:gnc-monetary-amount
+								(my-exchange-fn (gnc:make-gnc-monetary
+								   commod-currency split-value) currency)))
+			               (orig-basis (sum-basis basis-list currency-frac))
+			               ;; proportion of the fees attributable to this split
+			               (fee-ratio (gnc-numeric-div (gnc-numeric-abs split-units) trans-shares
+			                                           GNC-DENOM-AUTO GNC-DENOM-REDUCE))
+			               ;; Fees for this split in report currency
+			               (fees-currency (gnc:gnc-monetary-amount (my-exchange-fn
+			                               (gnc:make-gnc-monetary commod-currency
+			                                 (gnc-numeric-mul fee-ratio trans-brokerage
+			                                                commod-currency-frac GNC-RND-ROUND))
+			                                currency)))
+			               (split-value-with-fees (if (eq? handle-brokerage-fees 'include-in-basis)
+			                                          ;; Include brokerage fees in basis
+			                                          (gnc-numeric-add split-value-currency fees-currency
+			                                                        currency-frac GNC-RND-ROUND)
+			                                          split-value-currency)))
+                                  (gnc:debug "going in to basis list " basis-list " " (gnc-numeric-to-string split-units) " "
+                                             (gnc-numeric-to-string split-value-with-fees))
+
+				  ;; adjust the basis
+				  (set! basis-list (basis-builder basis-list split-units split-value-with-fees
+								  basis-method currency-frac))
+                                  (gnc:debug  "coming out of basis list " basis-list)
+
+                                  ;; If it's a sale or the stock is worthless, calculate the gain
+                                  (if (not (gnc-numeric-positive-p split-value))
+                                       ;; Split value is zero or negative.  If it's zero it's either a stock split/merge
+                                       ;; or the stock has become worthless (which looks like a merge where the number
+                                       ;; of shares goes to zero).  If the value is negative then it's a disposal of some sort.
+                                       (let ((new-basis (sum-basis basis-list currency-frac)))
+                                              (if (or (gnc-numeric-zero-p new-basis)
+                                                      (gnc-numeric-negative-p split-value))
+                                                ;; Split value is negative or new basis is zero (stock is worthless),
+                                                ;; Capital gain is money out minus change in basis
+                                                (let ((gain (gnc-numeric-sub (gnc-numeric-abs split-value-with-fees)
+                                                                          (gnc-numeric-sub orig-basis new-basis
+                                                                                           currency-frac GNC-RND-ROUND)
+                                                                          currency-frac GNC-RND-ROUND)))
+                                                       (gnc:debug "Old basis=" (gnc-numeric-to-string orig-basis)
+                                                                  " New basis=" (gnc-numeric-to-string new-basis)
+                                                                  " Gain=" (gnc-numeric-to-string gain))
+                                                       (gaincoll 'add currency gain)))))))
+
+                               ;; here is where we handle a spin-off txn. This will be a no-units
+                               ;; split with only one other split. xaccSplitGetOtherSplit only
+                               ;; returns on a two-split txn.  It's not a spinoff is the other split is
+                               ;; in an income or expense account.
+                               ((spin-off? s current)
+                                  (gnc:debug "before spin-off basis list " basis-list)
+                                  (set! basis-list (basis-builder basis-list split-units (gnc:gnc-monetary-amount
+                                                                                          (my-exchange-fn (gnc:make-gnc-monetary
+                                                                                                        commod-currency split-value)
+                                                                                                       currency))
+                                                                                                       basis-method
+                                                                                                       currency-frac))
+                                  (gnc:debug "after spin-off basis list "  basis-list))
+                             )
+		         ))
+		         (xaccTransGetSplitList parent)
+		       )
+		      )
+		   )
+		 )
+	       )
+	     (xaccAccountGetSplitList current)
+	     )
+
+	    ;; Look for income and expense transactions that don't have a split in the
+	    ;; the account we're processing.  We do this as follow
+	    ;; 1. Make sure the parent account is a currency-valued asset or bank account
+	    ;; 2. If so go through all the splits in that account
+	    ;; 3. If a split is part of a two split transaction where the other split is
+	    ;;    to an income or expense account and the leaf name of that account is the
+	    ;;    same as the leaf name of the account we're processing, add it to the
+	    ;;    income or expense accumulator
+	    ;;
+	    ;; In other words with an account structure like
+	    ;;
+	    ;;   Assets (type ASSET)
+	    ;;     Broker (type ASSET)
+	    ;;       Widget Stock (type STOCK)
+	    ;;   Income (type INCOME)
+	    ;;     Dividends (type INCOME)
+	    ;;       Widget Stock (type INCOME)
+	    ;;
+	    ;; If you are producing a report on "Assets:Broker:Widget Stock" a
+	    ;; transaction that debits the Assets:Broker account and credits the
+	    ;; "Income:Dividends:Widget Stock" account will count as income in
+	    ;; the report even though it doesn't have a split in the account
+	    ;; being reported on.
+
+	    (let ((parent-account (gnc-account-get-parent current))
+	          (account-name (xaccAccountGetName current)))
+	      (if (and (not (null? parent-account))
+	               (member (xaccAccountGetType parent-account) (list ACCT-TYPE-ASSET ACCT-TYPE-BANK))
+	               (gnc-commodity-is-currency (xaccAccountGetCommodity parent-account)))
+	        (for-each
+	          (lambda (split)
+	            (let* ((other-split (xaccSplitGetOtherSplit split))
+	                   ;; This is safe because xaccSplitGetAccount returns null for a null split
+	                   (other-acct (xaccSplitGetAccount other-split))
+	                   (parent (xaccSplitGetParent split))
+	                   (txn-date (xaccTransGetDate parent)))
+	              (if (and (not (null? other-acct))
+	                       (<= txn-date to-date)
+	                       (string=? (xaccAccountGetName other-acct) account-name)
+	                       (gnc-commodity-is-currency (xaccAccountGetCommodity other-acct)))
+	                ;; This is a two split transaction where the other split is to an
+	                ;; account with the same name as the current account.  If it's an
+	                ;; income or expense account accumulate the value of the transaction
+	                (let ((val (xaccSplitGetValue split))
+	                      (curr (xaccAccountGetCommodity other-acct)))
+                          (cond ((split-account-type? other-split ACCT-TYPE-INCOME)
+	                         (gnc:debug "More income " (gnc-numeric-to-string val))
+	                         (dividendcoll 'add curr val))
+                                ((split-account-type? other-split ACCT-TYPE-EXPENSE)
+                                 (gnc:debug "More expense " (gnc-numeric-to-string
+                                                             (gnc-numeric-neg val)))
+                                 (brokeragecoll 'add curr (gnc-numeric-neg val)))
+	                  )
+	                )
+	              )
+	            )
+	          )
+	          (xaccAccountGetSplitList parent-account)
+	        )
+	      )
+	    )
+
+	    (gnc:debug "pricing txn is " pricing-txn)
+	    (gnc:debug "use txn is " use-txn)
+	    (gnc:debug "prefer-pricelist is " prefer-pricelist)
+	    (gnc:debug "price is " price)
+
+	    (gnc:debug "basis we're using to build rows is " (gnc-numeric-to-string (sum-basis basis-list
+	                                                            currency-frac)))
+	    (gnc:debug "but the actual basis list is " basis-list)
+
+            (if (eq? handle-brokerage-fees 'include-in-gain)
+	      (gaincoll 'minusmerge brokeragecoll #f))
+
+	  (if (or include-empty (not (gnc-numeric-zero-p units)))
+	    (let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-exchange-fn))
+		  (moneyout (gnc:sum-collector-commodity moneyoutcoll currency my-exchange-fn))
+                  (brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn))
+		  (income (gnc:sum-collector-commodity dividendcoll currency my-exchange-fn))
+		  ;; just so you know, gain == realized gain, ugain == un-realized gain, bothgain, well..
+		  (gain (gnc:sum-collector-commodity gaincoll currency my-exchange-fn))
+		  (ugain (gnc:make-gnc-monetary currency
+						(gnc-numeric-sub (gnc:gnc-monetary-amount (my-exchange-fn value currency))
+								 (sum-basis basis-list (gnc-commodity-get-fraction currency))
+								 currency-frac GNC-RND-ROUND)))
+		  (bothgain (gnc:make-gnc-monetary currency  (gnc-numeric-add (gnc:gnc-monetary-amount gain)
+									      (gnc:gnc-monetary-amount ugain)
+									      currency-frac GNC-RND-ROUND)))
+		  (totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (gnc:gnc-monetary-amount bothgain)
+										    (gnc:gnc-monetary-amount income)
+										currency-frac GNC-RND-ROUND)))
+
+		  (activecols (list (gnc:html-account-anchor current)))
+		  )
+
+              ;; If we're using the txn, warn the user
+              (if use-txn
+                  (if pricing-txn
+                      (set! warn-price-dirty #t)
+                      (set! warn-no-price #t)
+                  ))
+
+	      (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
+	      (total-moneyin 'merge moneyincoll #f)
+	      (total-moneyout 'merge moneyoutcoll #f)
+              (total-brokerage 'merge brokeragecoll #f)
+	      (total-income 'merge dividendcoll #f)
+	      (total-gain 'merge gaincoll #f)
+	      (total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monetary-amount ugain))
+	      (total-basis 'add currency (sum-basis basis-list currency-frac))
+
+	      ;; build a list for the row  based on user selections
+	      (if show-symbol (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" ticker-symbol))))
+	      (if show-listing (append! activecols (list (gnc:make-html-table-header-cell/markup "text-cell" listing))))
+	      (if show-shares (append! activecols (list (gnc:make-html-table-header-cell/markup
+ 	        "number-cell" (xaccPrintAmount units share-print-info)))))
+	      (if show-price (append! activecols (list (gnc:make-html-table-header-cell/markup
+	        "number-cell"
+	        (if use-txn
+	            (if pricing-txn
+                        (gnc:html-transaction-anchor pricing-txn price)
+                        price)
+	 	    (gnc:html-price-anchor
+	 	     price (gnc:default-price-renderer
+                            (gnc-price-get-currency price)
+                            (gnc-price-get-value price))))))))
+ 	      (append! activecols (list (if use-txn (if pricing-txn "*" "**") " ")
+					(gnc:make-html-table-header-cell/markup
+					 "number-cell" (gnc:make-gnc-monetary currency (sum-basis basis-list
+					                         currency-frac)))
+					(gnc:make-html-table-header-cell/markup "number-cell" value)
+					(gnc:make-html-table-header-cell/markup "number-cell" moneyin)
+					(gnc:make-html-table-header-cell/markup "number-cell" moneyout)
+					(gnc:make-html-table-header-cell/markup "number-cell" gain)
+					(gnc:make-html-table-header-cell/markup "number-cell" ugain)
+					(gnc:make-html-table-header-cell/markup "number-cell" bothgain)
+					(gnc:make-html-table-header-cell/markup "number-cell"
+					    (let* ((moneyinvalue (gnc-numeric-to-double
+								  (gnc:gnc-monetary-amount moneyin)))
+					           (bothgainvalue (gnc-numeric-to-double
+								   (gnc:gnc-monetary-amount bothgain)))
+                                             )
+					      (if (= 0.0 moneyinvalue)
+						  ""
+						  (format #f "~,2f%" (* 100 (/ bothgainvalue moneyinvalue)))))
+					)
+					(gnc:make-html-table-header-cell/markup "number-cell" income)))
+	      (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
+		  (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" brokerage))))
+	      (append! activecols (list (gnc:make-html-table-header-cell/markup "number-cell" totalreturn)
+					(gnc:make-html-table-header-cell/markup "number-cell"
+					    (let* ((moneyinvalue (gnc-numeric-to-double
+								  (gnc:gnc-monetary-amount moneyin)))
+					           (totalreturnvalue (gnc-numeric-to-double
+								      (gnc:gnc-monetary-amount totalreturn)))
+                                             )
+					      (if (= 0.0 moneyinvalue)
+						  ""
+						  (format #f "~,2f%" (* 100 (/ totalreturnvalue moneyinvalue))))))
+					 )
+			)
+
+	      (gnc:html-table-append-row/markup!
+	       table
+	       row-style
+	       activecols)
+
+              (if (and (not use-txn) price) (gnc-price-unref price))
+	      (table-add-stock-rows-internal rest (not odd-row?))
+	      )
+	    (begin
+	      (if (and (not use-txn) price) (gnc-price-unref price))
+	      (table-add-stock-rows-internal rest odd-row?)
+	      )
+            )
+	    )))
+
+    (set! work-to-do (gnc:accounts-count-splits accounts))
+    (table-add-stock-rows-internal accounts #t)))
+
   ;; Tell the user that we're starting.
   (gnc:report-starting reportname)
 
@@ -968,12 +1016,8 @@ by preventing negative stock balances.<br/>")
 				      optname-prefer-pricelist))
 	(handle-brokerage-fees (get-option gnc:pagename-general
 				  optname-brokerage-fees))
-        (share-print-info
-         (gnc-share-print-info-places
-          (inexact->exact
-           (get-option gnc:pagename-display optname-shares-digits))))
 
-        (total-basis (gnc:make-commodity-collector))
+	(total-basis (gnc:make-commodity-collector))
         (total-value    (gnc:make-commodity-collector))
         (total-moneyin  (gnc:make-commodity-collector))
         (total-moneyout (gnc:make-commodity-collector))
@@ -1004,8 +1048,8 @@ by preventing negative stock balances.<br/>")
                    (lambda (foreign domestic date)
                     (find-price (gnc-pricedb-lookup-nearest-in-time-any-currency-t64
 		     pricedb foreign (time64CanonicalDayTime date)) domestic)))))
-	       (headercols (list (G_ "Account")))
-	       (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (G_ "Total"))))
+	       (headercols (list (_ "Account")))
+	       (totalscols (list (gnc:make-html-table-cell/markup "total-label-cell" (_ "Total"))))
 	       (sum-total-moneyin (gnc-numeric-zero))
 	       (sum-total-income (gnc-numeric-zero))
 	       (sum-total-both-gains (gnc-numeric-zero))
@@ -1016,37 +1060,37 @@ by preventing negative stock balances.<br/>")
 
 	  ;;begin building lists for which columns to display
           (if show-symbol
-	      (begin (append! headercols (list (G_ "Symbol")))
+	      (begin (append! headercols (list (_ "Symbol")))
 		     (append! totalscols (list " "))))
 
 	  (if show-listing
-	      (begin (append! headercols (list (G_ "Listing")))
+	      (begin (append! headercols (list (_ "Listing")))
 		     (append! totalscols (list " "))))
 
 	  (if show-shares
-	      (begin (append! headercols (list (G_ "Shares")))
+	      (begin (append! headercols (list (_ "Shares")))
 		     (append! totalscols (list " "))))
 
 	  (if show-price
-	      (begin (append! headercols (list (G_ "Price")))
+	      (begin (append! headercols (list (_ "Price")))
 		     (append! totalscols (list " "))))
 
 	  (append! headercols (list " "
-				    (G_ "Basis")
-				    (G_ "Value")
-				    (G_ "Money In")
-				    (G_ "Money Out")
-				    (G_ "Realized Gain")
-				    (G_ "Unrealized Gain")
-				    (G_ "Total Gain")
-				    (G_ "Rate of Gain")
-				    (G_ "Income")))
+				    (_ "Basis")
+				    (_ "Value")
+				    (_ "Money In")
+				    (_ "Money Out")
+				    (_ "Realized Gain")
+				    (_ "Unrealized Gain")
+				    (_ "Total Gain")
+				    (_ "Rate of Gain")
+				    (_ "Income")))
 
 	  (if (not (eq? handle-brokerage-fees 'ignore-brokerage))
-	      (append! headercols (list (G_ "Brokerage Fees"))))
+	      (append! headercols (list (_ "Brokerage Fees"))))
 
-	  (append! headercols (list (G_ "Total Return")
-				    (G_ "Rate of Return")))
+	  (append! headercols (list (_ "Total Return")
+				    (_ "Rate of Return")))
 
           (append! totalscols (list " "))
 
@@ -1061,8 +1105,7 @@ by preventing negative stock balances.<br/>")
                include-empty show-symbol show-listing show-shares show-price basis-method
                prefer-pricelist handle-brokerage-fees
                total-basis total-value total-moneyin total-moneyout
-               total-income total-gain total-ugain total-brokerage
-               share-print-info warnings))
+               total-income total-gain total-ugain total-brokerage))
             (lambda (k reason)
               (gnc:html-document-add-object!
                document (format #f OVERFLOW-ERROR reason))))
@@ -1142,16 +1185,16 @@ by preventing negative stock balances.<br/>")
             )
 
           (gnc:html-document-add-object! document table)
-          (if (hashq-ref warnings 'warn-price-dirty)
+          (if warn-price-dirty
               (gnc:html-document-append-objects! document
-                                                 (list (gnc:make-html-text (G_ "* this commodity data was built using transaction pricing instead of the price list."))
+                                                 (list (gnc:make-html-text (_ "* this commodity data was built using transaction pricing instead of the price list."))
 						       (gnc:make-html-text (gnc:html-markup-br))
-						       (gnc:make-html-text (G_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
+						       (gnc:make-html-text (_ "If you are in a multi-currency situation, the exchanges may not be correct.")))))
 
-          (if (hashq-ref warnings 'warn-no-price)
+          (if warn-no-price
               (gnc:html-document-append-objects! document
-                                                 (list (gnc:make-html-text (if (hashq-ref warnings 'warn-price-dirty) (gnc:html-markup-br) ""))
-                                                       (gnc:make-html-text (G_ "** this commodity has no price and a price of 1 has been used.")))))
+                                                 (list (gnc:make-html-text (if warn-price-dirty (gnc:html-markup-br) ""))
+                                                       (gnc:make-html-text (_ "** this commodity has no price and a price of 1 has been used.")))))
 )
 
 					;if no accounts selected.
@@ -1161,7 +1204,7 @@ by preventing negative stock balances.<br/>")
 	  report-title (gnc:report-id report-obj))))
 
     (gnc:report-finished)
-    document))
+    document)))
 
 (gnc:define-report
  'version 1
diff --git a/gnucash/report/reports/standard/test/test-portfolios.scm b/gnucash/report/reports/standard/test/test-portfolios.scm
index a5008983e..298d072e0 100644
--- a/gnucash/report/reports/standard/test/test-portfolios.scm
+++ b/gnucash/report/reports/standard/test/test-portfolios.scm
@@ -43,7 +43,6 @@
   (null-test "portfolio" portfolio-uuid)
   (null-test "advanced-portfolio" advanced-uuid)
   (portfolio-tests)
-  (advanced-helper-tests)
   (advanced-tests)
   (test-end "test-portfolios.scm"))
 
@@ -123,76 +122,3 @@
             "-$1.00" "-0.13%")
           (sxml->table-row-col sxml 1 1 #f))))
     (teardown)))
-
-(define (advanced-helper-tests)
-  (define sum-basis
-    (@@ (gnucash reports standard advanced-portfolio) sum-basis))
-  (define units-basis
-    (@@ (gnucash reports standard advanced-portfolio) units-basis))
-  (define apply-basis-ratio
-    (@@ (gnucash reports standard advanced-portfolio) apply-basis-ratio))
-  (define basis-builder
-    (@@ (gnucash reports standard advanced-portfolio) basis-builder))
-  (define basis1 '((3 . 4) (5 . 6) (7 . 8)))
-  (define basis2 '((3 . 4) (5 . 6) (7 . 8) (9 . 10)))
-
-  (test-equal "sum-basis"
-    98
-    (sum-basis basis1 100))
-  (test-equal "sum-basis"
-    188
-    (sum-basis basis2 100))
-
-  (test-equal "units-basis"
-    15
-    (units-basis basis1))
-  (test-equal "units-basis"
-    24
-    (units-basis basis2))
-
-  (test-equal "apply-basis-ratio"
-    '((6 . 12) (10 . 18) (14 . 24))
-    (apply-basis-ratio basis1 2 3))
-  (test-equal "apply-basis-ratio"
-    '((6 . 12) (10 . 18) (14 . 24) (18 . 30))
-    (apply-basis-ratio basis2 2 3))
-
-  (test-equal "basis-builder buy new units"
-    '((3 . 4/3))
-    (basis-builder '() 3 4 'average-basis 100))
-  (test-equal "basis-builder buy new units average"
-    '((6 . 8/3))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'average-basis 100))
-  (test-equal "basis-builder buy new units FIFO"
-    '((3 . 4) (5 . 6) (7 . 8) (3 . 4/3))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'fifo-basis 100))
-  (test-equal "basis-builder buy new units LIFO"
-    '((3 . 4) (5 . 6) (7 . 8) (3 . 4/3))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 3 4 'filo-basis 100))
-
-  (test-equal "basis-builder sell average"
-    '((0 . 4))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'average-basis 100))
-  (test-equal "basis-builder sell FIFO first"
-    '((5 . 6) (7 . 8))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'fifo-basis 100))
-  (test-equal "basis-builder sell FIFO 2 lots"
-    '((3 . 6) (7 . 8))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -5 4 'fifo-basis 100))
-  (test-equal "basis-builder sell LIFO"
-    '((3 . 4) (5 . 6) (4 . 8))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 4 'filo-basis 100))
-  (test-equal "basis-builder sell LIFO all"
-    '()
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -15 4 'filo-basis 100))
-  (test-equal "basis-builder sell LIFO more than we have"
-    '()
-    (basis-builder '() -15 4 'filo-basis 100))
-
-  (test-equal "basis-builder = no value just units = split/merge"
-    '((12/5 . 5) (4 . 15/2) (28/5 . 10))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) -3 0 'average-basis 100))
-
-  (test-equal "basis-builder = no units just value = spin-off"
-    '((3 . 8) (5 . 12) (7 . 16))
-    (basis-builder '((3 . 4) (5 . 6) (7 . 8)) 0 98 'average-basis 100)))



Summary of changes:
 .../report/reports/standard/advanced-portfolio.scm | 1477 ++++++++++----------
 .../reports/standard/test/test-portfolios.scm      |   74 -
 2 files changed, 760 insertions(+), 791 deletions(-)



More information about the gnucash-changes mailing list