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