Unfortunately cleaning up advanced-portfolio.scm is much more challenging than I expected, so, I've now reverted it to its original (as of 4.0) state, with suitable changes to support guile-3.0 only.
On Sat, 1 Aug 2020 at 05:55, Christopher Lam <c...@code.gnucash.org> wrote: > 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....@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....@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(-) > > _______________________________________________ > gnucash-changes mailing list > gnucash-chan...@gnucash.org > https://lists.gnucash.org/mailman/listinfo/gnucash-changes > _______________________________________________ gnucash-devel mailing list gnucash-devel@gnucash.org https://lists.gnucash.org/mailman/listinfo/gnucash-devel
