"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "gnucash/report/reports/standard/advanced-portfolio.scm" between
gnucash-5.0.tar.bz2 and gnucash-5.1.tar.bz2

About: GnuCash is personal and small-business financial-accounting software.

advanced-portfolio.scm  (gnucash-5.0.tar.bz2)	:	advanced-portfolio.scm  (gnucash-5.1.tar.bz2)
skipping to change at line 100		skipping to change at line 100
(gnc-register-multichoice-option options		(gnc-register-multichoice-option options
gnc:pagename-general optname-brokerage-fees		gnc:pagename-general optname-brokerage-fees
"g" (N_ "How to report commissions and other brokerage fees.")		"g" (N_ "How to report commissions and other brokerage fees.")
"include-in-basis"		"include-in-basis"
(list (vector 'include-in-basis (N_ "Include in basis"))		(list (vector 'include-in-basis (N_ "Include in basis"))
(vector 'include-in-gain (N_ "Include in gain/loss"))		(vector 'include-in-gain (N_ "Include in gain/loss"))
(vector 'ignore-brokerage (N_ "Omit from report"))))		(vector 'ignore-brokerage (N_ "Omit from report"))))
(gnc-register-simple-boolean-option options		(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-symbol "a"		gnc:pagename-display optname-show-symbol "a"
(N_ "Display the ticker symbols.")		(N_ "Display the ticker symbols.")
#t)		#t)
(gnc-register-simple-boolean-option options		(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-listing "b"		gnc:pagename-display optname-show-listing "b"
(N_ "Display exchange listings.")		(N_ "Display exchange listings.")
#t)		#t)
(gnc-register-simple-boolean-option options		(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-shares "c"		gnc:pagename-display optname-show-shares "c"
(N_ "Display numbers of shares in accounts.")		(N_ "Display numbers of shares in accounts.")
#t)		#t)
(gnc-register-number-range-option options		(gnc-register-number-range-option options
gnc:pagename-display optname-shares-digits		gnc:pagename-display optname-shares-digits
"d" (N_ "The number of decimal places to use for share numbers.") 2		"d" (N_ "The number of decimal places to use for share numbers.") 2
0 9 1)		0 9 1)
(gnc-register-simple-boolean-option options		(gnc-register-simple-boolean-option options
gnc:pagename-display optname-show-price "e"		gnc:pagename-display optname-show-price "e"
(N_ "Display share prices.")		(N_ "Display share prices.")
#t)		#t)
;; Account tab		;; Account tab
(gnc-register-account-list-limited-option options		(gnc-register-account-list-limited-option options
gnc:pagename-accounts (N_ "Accounts")		gnc:pagename-accounts (N_ "Accounts")
"b"		"b"
(N_ "Stock Accounts to report on.")		(N_ "Stock Accounts to report on.")
(filter gnc:account-is-stock?		(filter gnc:account-is-stock?
(gnc-account-get-descendants-sorted		(gnc-account-get-descendants-sorted
(gnc-get-current-root-account)))		(gnc-get-current-root-account)))
(list ACCT-TYPE-ASSET ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL))		(list ACCT-TYPE-ASSET ACCT-TYPE-STOCK ACCT-TYPE-MUTUAL))
skipping to change at line 172		skipping to change at line 172
(define (same-split? s1 s2)		(define (same-split? s1 s2)
(equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))		(equal? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
(define (same-account? a1 a2)		(define (same-account? a1 a2)
(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))		(equal? (gncAccountGetGUID a1) (gncAccountGetGUID a2)))
;; sum up the contents of the b-list built by basis-builder below		;; sum up the contents of the b-list built by basis-builder below
(define (sum-basis b-list currency-frac)		(define (sum-basis b-list currency-frac)
(if (not (eqv? b-list '()))		(if (not (eqv? b-list '()))
(gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-fr		(gnc-numeric-add (gnc-numeric-mul (caar b-list) (cdar b-list) currency-f
ac GNC-RND-ROUND)		rac GNC-RND-ROUND)
(sum-basis (cdr b-list) currency-frac) currency-frac GNC		(sum-basis (cdr b-list) currency-frac) currency-frac GN
-RND-ROUND)		C-RND-ROUND)
(gnc-numeric-zero)		(gnc-numeric-zero)
)		)
)		)
;; sum up the total number of units in the b-list built by basis-builder below		;; sum up the total number of units in the b-list built by basis-builder below
(define (units-basis b-list)		(define (units-basis b-list)
(if (not (eqv? b-list '()))		(if (not (eqv? b-list '()))
(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))		(gnc-numeric-add (caar b-list) (units-basis (cdr b-list))
units-denom GNC-RND-ROUND)		units-denom GNC-RND-ROUND)
(gnc-numeric-zero)		(gnc-numeric-zero)
)		)
)		)
;; apply a ratio to an existing basis-list, useful for splits/mergers and spin offs		;; apply a ratio to an existing basis-list, useful for splits/mergers and spin offs
;; I need to get a brain and use (map) for this.		;; I need to get a brain and use (map) for this.
(define (apply-basis-ratio b-list units-ratio value-ratio)		(define (apply-basis-ratio b-list units-ratio value-ratio)
(if (not (eqv? b-list '()))		(if (not (eqv? b-list '()))
(cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-RN		(cons (cons (gnc-numeric-mul units-ratio (caar b-list) units-denom GNC-R
D-ROUND)		ND-ROUND)
(gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-RN		(gnc-numeric-mul value-ratio (cdar b-list) price-denom GNC-R
D-ROUND))		ND-ROUND))
(apply-basis-ratio (cdr b-list) units-ratio value-ratio))		(apply-basis-ratio (cdr b-list) units-ratio value-ratio))
'()		'()
)		)
)		)
;; this builds a list for basis calculation and handles average, fifo and lifo methods		;; 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 meth od produces only one		;; the list is cons cells of (units-of-stock . price-per-unit)... average meth od produces only one
;; cell that mutates to the new average. Need to add a date checker so that we allow for prices		;; 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 carryov er the basis.		;; coming in out of order, such as a transfer with a price adjusted to carryov er the basis.
(define (basis-builder b-list b-units b-value b-method currency-frac)		(define (basis-builder b-list b-units b-value b-method currency-frac)
(gnc:debug "actually in basis-builder")		(gnc:debug "actually in basis-builder")
(gnc:debug "b-list is " b-list " b-units is " (gnc-numeric-to-string b-units )		(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)		" 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 han dling		;; if there is no b-value, then this is a split/merger and needs special han dling
(cond		(cond
;; we have value and positive units, add units to basis		;; we have value and positive units, add units to basis
((and (not (gnc-numeric-zero-p b-value))		((and (not (gnc-numeric-zero-p b-value))
(gnc-numeric-positive-p b-units))		(gnc-numeric-positive-p b-units))
(case b-method		(case b-method
((average-basis)		((average-basis)
(if (not (eqv? b-list '()))		(if (not (eqv? b-list '()))
(list (cons (gnc-numeric-add b-units		(list (cons (gnc-numeric-add b-units
(caar b-list) units-denom GNC-RND-ROUND		(caar b-list) units-denom GNC-RND-ROUN
)		D)
(gnc-numeric-div		(gnc-numeric-div
(gnc-numeric-add b-value		(gnc-numeric-add b-value
(gnc-numeric-mul (caar b-list)		(gnc-numeric-mul (caar b-list)
(cdar b-list)		(cdar b-list)
GNC-DENOM-AUTO GNC-DE		GNC-DENOM-AUTO GNC-D
NOM-REDUCE)		ENOM-REDUCE)
GNC-DENOM-AUTO GNC-DENOM-REDUCE)		GNC-DENOM-AUTO GNC-DENOM-REDUCE)
(let ((denom (gnc-numeric-add b-units		(let ((denom (gnc-numeric-add b-units
(caar b-list) GNC-DENOM- AUTO GNC-DENOM-REDUCE)))		(caar b-list) GNC-DENOM- AUTO GNC-DENOM-REDUCE)))
(if (zero? denom)		(if (zero? denom)
(throw 'div/0 (format #f "buying ~0,4f share uni ts" b-units))		(throw 'div/0 (format #f "buying ~0,4f share uni ts" b-units))
denom))		denom))
price-denom GNC-RND-ROUND)))		price-denom GNC-RND-ROUND)))
(append b-list		(append b-list
(list (cons b-units (gnc-numeric-div		(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-RO UND))))))		b-value b-units price-denom GNC-RND-RO UND))))))
(else (append b-list		(else (append b-list
(list (cons b-units (gnc-numeric-div		(list (cons b-units (gnc-numeric-div
b-value b-units price-denom GNC-RND-R OUND)))))))		b-value b-units price-denom GNC-RND-R OUND)))))))
;; we have value and negative units, remove units from basis		;; we have value and negative units, remove units from basis
((and (not (gnc-numeric-zero-p b-value))		((and (not (gnc-numeric-zero-p b-value))
(gnc-numeric-negative-p b-units))		(gnc-numeric-negative-p b-units))
(if (not (eqv? b-list '()))		(if (not (eqv? b-list '()))
(case b-method		(case b-method
((fifo-basis)		((fifo-basis)
(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))		(case (gnc-numeric-compare (gnc-numeric-abs b-units) (caar b-list))
((-1)		((-1)
;; Sold less than the first lot, create a new first lot from th e remainder		;; Sold less than the first lot, create a new first lot from th e remainder
(let ((new-units (gnc-numeric-add b-units (caar b-list) units-d enom GNC-RND-ROUND)))		(let ((new-units (gnc-numeric-add b-units (caar b-list) units-d enom GNC-RND-ROUND)))
(cons (cons new-units (cdar b-list)) (cdr b-list))))		(cons (cons new-units (cdar b-list)) (cdr b-list))))
((0)		((0)
;; Sold all of the first lot		;; Sold all of the first lot
skipping to change at line 281		skipping to change at line 281
))))		))))
((average-basis)		((average-basis)
(list (cons (gnc-numeric-add		(list (cons (gnc-numeric-add
(caar b-list) b-units units-denom GNC-RND-ROUND)		(caar b-list) b-units units-denom GNC-RND-ROUND)
(cdar b-list)))))		(cdar b-list)))))
'()		'()
))		))
;; no value, just units, this is a split/merge...		;; no value, just units, this is a split/merge...
((and (gnc-numeric-zero-p b-value)		((and (gnc-numeric-zero-p b-value)
(not (gnc-numeric-zero-p b-units)))		(not (gnc-numeric-zero-p b-units)))
(let* ((current-units (units-basis b-list))		(let* ((current-units (units-basis b-list))
;; If current-units is zero then so should be everything else.		;; If current-units is zero then so should be everything else.
(units-ratio (if (zero? current-units) (gnc-numeric-zero)		(units-ratio (if (zero? current-units) (gnc-numeric-zero)
(gnc-numeric-div (gnc-numeric-add b-units curren t-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)		(gnc-numeric-div (gnc-numeric-add b-units curren t-units GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-units GNC-DENOM-AUTO GN C-DENOM-REDUCE)))		current-units GNC-DENOM-AUTO GN C-DENOM-REDUCE)))
;; If the units ratio is zero the stock is worthless and the valu e should be zero too		;; If the units ratio is zero the stock is worthless and the valu e should be zero too
(value-ratio (if (gnc-numeric-zero-p units-ratio)		(value-ratio (if (gnc-numeric-zero-p units-ratio)
(gnc-numeric-zero)		(gnc-numeric-zero)
(gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))		(gnc-numeric-div 1/1 units-ratio GNC-DENOM-AUTO GNC-DENOM-REDUCE))))
(gnc:debug "blist is " b-list " current units is "		(gnc:debug "blist is " b-list " current units is "
(gnc-numeric-to-string current-units)		(gnc-numeric-to-string current-units)
" value ratio is " (gnc-numeric-to-string value-ratio)		" value ratio is " (gnc-numeric-to-string value-ratio)
" units ratio is " (gnc-numeric-to-string units-ratio))		" units ratio is " (gnc-numeric-to-string units-ratio))
(apply-basis-ratio b-list units-ratio value-ratio)		(apply-basis-ratio b-list units-ratio value-ratio)
))		))
;; If there are no units, just a value, then its a spin-off,		;; If there are no units, just a value, then its a spin-off,
;; calculate a ratio for the values, but leave the units alone		;; calculate a ratio for the values, but leave the units alone
;; with a ratio of 1		;; with a ratio of 1
((and (gnc-numeric-zero-p b-units)		((and (gnc-numeric-zero-p b-units)
(not (gnc-numeric-zero-p b-value)))		(not (gnc-numeric-zero-p b-value)))
(let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))		(let* ((current-value (sum-basis b-list GNC-DENOM-AUTO))
(value-ratio (if (zero? current-value)		(value-ratio (if (zero? current-value)
(throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))		(throw 'div/0 (format #f "spinoff of ~,2f currency units" current-value))
(gnc-numeric-div (gnc-numeric-add b-value current-v alue GNC-DENOM-AUTO GNC-DENOM-REDUCE)		(gnc-numeric-div (gnc-numeric-add b-value current-v alue GNC-DENOM-AUTO GNC-DENOM-REDUCE)
current-value GNC-DENOM-AUTO GNC-D ENOM-REDUCE))))		current-value GNC-DENOM-AUTO GNC-D ENOM-REDUCE))))
(gnc:debug "this is a spinoff")		(gnc:debug "this is a spinoff")
(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string v		(gnc:debug "blist is " b-list " value ratio is " (gnc-numeric-to-string
alue-ratio))		value-ratio))
(apply-basis-ratio b-list 1/1 value-ratio))		(apply-basis-ratio b-list 1/1 value-ratio))
)		)
;; when all else fails, just send the b-list back		;; when all else fails, just send the b-list back
(else		(else
b-list)		b-list)
)		)
)		)
;; Given a price list and a currency find the price for that currency on the l ist.		;; Given a price list and a currency find the price for that currency on the l ist.
;; If there is none for the requested currency, return the first one.		;; If there is none for the requested currency, return the first one.
skipping to change at line 360		skipping to change at line 360
(define (spin-off? split current)		(define (spin-off? split current)
(let ((other-split (xaccSplitGetOtherSplit split)))		(let ((other-split (xaccSplitGetOtherSplit split)))
(and (gnc-numeric-zero-p (xaccSplitGetAmount split))		(and (gnc-numeric-zero-p (xaccSplitGetAmount split))
(same-account? current (xaccSplitGetAccount split))		(same-account? current (xaccSplitGetAccount split))
(not (null? other-split))		(not (null? other-split))
(not (split-account-type? other-split ACCT-TYPE-EXPENSE))		(not (split-account-type? other-split ACCT-TYPE-EXPENSE))
(not (split-account-type? other-split ACCT-TYPE-INCOME)))))		(not (split-account-type? other-split ACCT-TYPE-INCOME)))))
(define (table-add-stock-rows table accounts to-date		(define (table-add-stock-rows table accounts to-date
currency price-fn exchange-fn price-source		currency price-fn exchange-fn price-source
include-empty show-symbol show-listing show-share s show-price		include-empty show-symbol show-listing show-shar es show-price
basis-method prefer-pricelist handle-brokerage-f ees		basis-method prefer-pricelist handle-brokerage-f ees
total-basis total-value		total-basis total-value
total-moneyin total-moneyout total-income total- gain		total-moneyin total-moneyout total-income total- gain
total-ugain total-brokerage)		total-ugain total-brokerage)
(let ((share-print-info		(let ((share-print-info
(gnc-share-print-info-places		(gnc-share-print-info-places
(inexact->exact (get-option gnc:pagename-display		(inexact->exact (get-option gnc:pagename-display
optname-shares-digits)))))		optname-shares-digits)))))
(define (table-add-stock-rows-internal accounts odd-row?)		(define (table-add-stock-rows-internal accounts odd-row?)
(if (null? accounts) total-value		(if (null? accounts) total-value
(let* ((row-style (if odd-row? "normal-row" "alternate-row"))		(let* ((row-style (if odd-row? "normal-row" "alternate-row"))
(current (car accounts))		(current (car accounts))
(rest (cdr accounts))		(rest (cdr accounts))
;; commodity is the actual stock/thing we are looking at		;; commodity is the actual stock/thing we are looking at
(commodity (xaccAccountGetCommodity current))		(commodity (xaccAccountGetCommodity current))
(ticker-symbol (gnc-commodity-get-mnemonic commodity))		(ticker-symbol (gnc-commodity-get-mnemonic commodity))
(listing (gnc-commodity-get-namespace commodity))		(listing (gnc-commodity-get-namespace commodity))
(unit-collector (gnc:account-get-comm-balance-at-date		(unit-collector (gnc:account-get-comm-balance-at-date
current to-date #f))		current to-date #f))
(units (cadr (unit-collector 'getpair commodity #f)))		(units (cadr (unit-collector 'getpair commodity #f)))
;; Counter to keep track of stuff		;; Counter to keep track of stuff
(brokeragecoll (gnc:make-commodity-collector))		(brokeragecoll (gnc:make-commodity-collector))
(dividendcoll (gnc:make-commodity-collector))		(dividendcoll (gnc:make-commodity-collector))
(moneyincoll (gnc:make-commodity-collector))		(moneyincoll (gnc:make-commodity-collector))
(moneyoutcoll (gnc:make-commodity-collector))		(moneyoutcoll (gnc:make-commodity-collector))
(gaincoll (gnc:make-commodity-collector))		(gaincoll (gnc:make-commodity-collector))
;; the price of the commodity at the time of the report		;; the price of the commodity at the time of the report
(price (price-fn commodity currency to-date))		(price (price-fn commodity currency to-date))
;; the value of the commodity, expressed in terms of		;; the value of the commodity, expressed in terms of
;; the report's currency.		;; the report's currency.
(value (gnc:make-gnc-monetary currency (gnc-numeric-zero))) ;; Set later		(value (gnc:make-gnc-monetary currency (gnc-numeric-zero))) ;; Set later
(currency-frac (gnc-commodity-get-fraction currency))		(currency-frac (gnc-commodity-get-fraction currency))
(pricing-txn #f)		(pricing-txn #f)
(use-txn #f)		(use-txn #f)
(basis-list '())		(basis-list '())
;; setup an alist for the splits we've already seen.		;; setup an alist for the splits we've already seen.
(seen_trans '())		(seen_trans '())
;; Account used to hold remainders from income reinvestments and		;; Account used to hold remainders from income reinvestments an
;; running total of amount moved there		d
(drp-holding-account #f)		;; running total of amount moved there
(drp-holding-amount (gnc-numeric-zero))		(drp-holding-account #f)
)		(drp-holding-amount (gnc-numeric-zero))
		)
(define (my-exchange-fn fromunits tocurrency)		(define (my-exchange-fn fromunits tocurrency)
(if (and (gnc-commodity-equiv currency tocurrency)		(if (and (gnc-commodity-equiv currency tocurrency)
(gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunit s) commodity))		(gnc-commodity-equiv (gnc:gnc-monetary-commodity fromunit s) commodity))
;; Have a price for this commodity, but not necessarily in t he report's		;; Have a price for this commodity, but not necessarily in t he report's
;; currency. Get the value in the commodity's currency and convert it to		;; currency. Get the value in the commodity's currency and convert it to
;; report currency.		;; report currency.
(exchange-fn		(exchange-fn
;; This currency will usually be the same as tocurrency so the		;; This currency will usually be the same as tocurrency so the
;; call to exchange-fn below will do nothing		;; call to exchange-fn below will do nothing
skipping to change at line 496		skipping to change at line 496
(set! pricing-txn #f)		(set! pricing-txn #f)
)		)
)		)
;; Now that we have a pricing transaction if needed, set the value o f the asset		;; Now that we have a pricing transaction if needed, set the value o f the asset
(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))		(set! value (my-exchange-fn (gnc:make-gnc-monetary commodity units) currency))
(gnc:debug "Value " (gnc:monetary->string value)		(gnc:debug "Value " (gnc:monetary->string value)
" from " (gnc:monetary->string		" from " (gnc:monetary->string
(gnc:make-gnc-monetary commodity units)))		(gnc:make-gnc-monetary commodity units)))
(for-each		(for-each
;; we're looking at each split we find in the account. these splits		;; 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		;; could refer to the same transaction, so we have to examine each
;; split, determine what kind of split it is and then act accordingl		;; split, determine what kind of split it is and then act according
y.		ly.
(lambda (split)		(lambda (split)
(set! work-done (+ 1 work-done))		(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))		(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
(let* ((parent (xaccSplitGetParent split))		(let* ((parent (xaccSplitGetParent split))
(txn-date (xaccTransGetDate parent))		(txn-date (xaccTransGetDate parent))
(commod-currency (xaccTransGetCurrency parent))		(commod-currency (xaccTransGetCurrency parent))
(commod-currency-frac (gnc-commodity-get-fraction commod-cu		(commod-currency-frac (gnc-commodity-get-fraction commod-c
rrency)))		urrency)))
(if (and (<= txn-date to-date)		(if (and (<= txn-date to-date)
(not (assoc-ref seen_trans (gncTransGetGUID parent))))		(not (assoc-ref seen_trans (gncTransGetGUID parent))))
(let ((trans-income (gnc-numeric-zero))		(let ((trans-income (gnc-numeric-zero))
(trans-brokerage (gnc-numeric-zero))		(trans-brokerage (gnc-numeric-zero))
(trans-shares (gnc-numeric-zero))		(trans-shares (gnc-numeric-zero))
(shares-bought (gnc-numeric-zero))		(shares-bought (gnc-numeric-zero))
(trans-sold (gnc-numeric-zero))		(trans-sold (gnc-numeric-zero))
(trans-bought (gnc-numeric-zero))		(trans-bought (gnc-numeric-zero))
(trans-spinoff (gnc-numeric-zero))		(trans-spinoff (gnc-numeric-zero))
(trans-drp-residual (gnc-numeric-zero))		(trans-drp-residual (gnc-numeric-zero))
(trans-drp-account #f))		(trans-drp-account #f))
(gnc:debug "Transaction " (xaccTransGetDescription parent)		(gnc:debug "Transaction " (xaccTransGetDescription parent
)		))
;; Add this transaction to the list of processed transacti		;; Add this transaction to the list of processed transact
ons so we don't		ions so we don't
;; do it again if there is another split in it for this ac		;; do it again if there is another split in it for this a
count		ccount
(set! seen_trans (acons (gncTransGetGUID parent) #t seen_t		(set! seen_trans (acons (gncTransGetGUID parent) #t seen_
rans))		trans))
;; Go through all the splits in the transaction to get an		;; Go through all the splits in the transaction to get an
overall idea of		overall idea of
;; what it does in terms of income, money in or out, share		;; what it does in terms of income, money in or out, shar
s bought or sold, etc.		es bought or sold, etc.
(for-each		(for-each
(lambda (s)		(lambda (s)
(let ((split-units (xaccSplitGetAmount s))		(let ((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s)))		(split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 1: split units " (gnc-numeric-to-s tring split-units) " split-value "		(gnc:debug "Pass 1: split units " (gnc-numeric-to-s tring split-units) " split-value "
(gnc-numeric-to-string split-value) " co mmod-currency "		(gnc-numeric-to-string split-value) " co mmod-currency "
(gnc-commodity-get-printname commod-curr ency))		(gnc-commodity-get-printname commod-curr ency))
(cond		(cond
((split-account-type? s ACCT-TYPE-EXPENSE)		((split-account-type? s ACCT-TYPE-EXPENSE)
;; Brokerage expense unless a two split transac tion with other split		;; Brokerage expense unless a two split transac tion with other split
skipping to change at line 588		skipping to change at line 588
(begin		(begin
(set! trans-drp-account (xaccSplitGetAcco unt s))		(set! trans-drp-account (xaccSplitGetAcco unt s))
(if (gnc-commodity-equiv commod-currenc y (xaccAccountGetCommodity trans-drp-account))		(if (gnc-commodity-equiv commod-currenc y (xaccAccountGetCommodity trans-drp-account))
(set! trans-drp-residual split-valu e)		(set! trans-drp-residual split-valu e)
(set! trans-drp-account 'none)))		(set! trans-drp-account 'none)))
(if (not (eq? trans-drp-account 'none))		(if (not (eq? trans-drp-account 'none))
(if (parent-or-sibling? trans-drp-account (xaccSplitGetAccount s))		(if (parent-or-sibling? trans-drp-account (xaccSplitGetAccount s))
(set! trans-drp-residual (gnc-numeric -add trans-drp-residual split-value		(set! trans-drp-residual (gnc-numeric -add trans-drp-residual split-value
commod-currency-frac GNC-RND-ROUND))		commod-currency-frac GNC-RND-ROUND))
(set! trans-drp-account 'none))))))		(set! trans-drp-account 'none))))))
))		))
(xaccTransGetSplitList parent)		(xaccTransGetSplitList parent)
)		)
(gnc:debug "Income: " (gnc-numeric-to-string trans-income)		(gnc:debug "Income: " (gnc-numeric-to-string trans-income
" Brokerage: " (gnc-numeric-to-string trans-bro		)
kerage)		" Brokerage: " (gnc-numeric-to-string trans-br
" Shares traded: " (gnc-numeric-to-string trans		okerage)
-shares)		" Shares traded: " (gnc-numeric-to-string tran
" Shares bought: " (gnc-numeric-to-string share		s-shares)
s-bought))		" Shares bought: " (gnc-numeric-to-string shar
(gnc:debug " Value sold: " (gnc-numeric-to-string trans-so		es-bought))
ld)		(gnc:debug " Value sold: " (gnc-numeric-to-string trans-s
" Value purchased: " (gnc-numeric-to-string tra		old)
ns-bought)		" Value purchased: " (gnc-numeric-to-string tr
" Spinoff value " (gnc-numeric-to-string trans-		ans-bought)
spinoff)		" Spinoff value " (gnc-numeric-to-string trans
" Trans DRP residual: " (gnc-numeric-to-string		-spinoff)
trans-drp-residual))		" Trans DRP residual: " (gnc-numeric-to-string
		trans-drp-residual))
;; We need to calculate several things for this transactio
n:		;; We need to calculate several things for this transacti
;; 1. Total income: this is already in trans-income		on:
;; 2. Change in basis: calculated by loop below that looks		;; 1. Total income: this is already in trans-income
at every		;; 2. Change in basis: calculated by loop below that look
;; that acquires or disposes of shares		s at every
;; 3. Realized gain: also calculated below while calculati		;; that acquires or disposes of shares
ng basis		;; 3. Realized gain: also calculated below while calculat
;; 4. Money in to the account: this is the value of shares		ing basis
bought		;; 4. Money in to the account: this is the value of share
;; except those purchased with reinvested income		s bought
;; 5. Money out: the money received by disposing of shares		;; except those purchased with reinvested income
. This		;; 5. Money out: the money received by disposing of share
;; is in trans-sold plus trans-spinoff		s. This
;; 6. Brokerage fees: this is in trans-brokerage		;; is in trans-sold plus trans-spinoff
		;; 6. Brokerage fees: this is in trans-brokerage
;; Income		;; Income
(dividendcoll 'add commod-currency trans-income)		(dividendcoll 'add commod-currency trans-income)
;; Brokerage fees. May be either ignored or part of basi s, but that		;; Brokerage fees. May be either ignored or part of basi s, but that
;; will be dealt with elsewhere.		;; will be dealt with elsewhere.
(brokeragecoll 'add commod-currency trans-brokerage)		(brokeragecoll 'add commod-currency trans-brokerage)
;; Add brokerage fees to trans-bought if not ignoring the m and there are any		;; Add brokerage fees to trans-bought if not ignoring the m and there are any
(if (and (not (eq? handle-brokerage-fees 'ignore-brokerag e))		(if (and (not (eq? handle-brokerage-fees 'ignore-brokerag e))
(gnc-numeric-positive-p trans-brokerage)		(gnc-numeric-positive-p trans-brokerage)
(gnc-numeric-positive-p trans-shares))		(gnc-numeric-positive-p trans-shares))
(let* ((fee-frac (gnc-numeric-div shares-bought trans -shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))		(let* ((fee-frac (gnc-numeric-div shares-bought trans -shares GNC-DENOM-AUTO GNC-DENOM-REDUCE))
skipping to change at line 678		skipping to change at line 678
(set! trans-bought (gnc-numeric-zero)))))		(set! trans-bought (gnc-numeric-zero)))))
(gnc:debug "Adjusted trans-bought " (gnc-numeric-to-strin g trans-bought)		(gnc:debug "Adjusted trans-bought " (gnc-numeric-to-strin g trans-bought)
" DRP holding account " (gnc-numeric-to-string drp-holding-amount))		" DRP holding account " (gnc-numeric-to-string drp-holding-amount))
(moneyincoll 'add commod-currency trans-bought)		(moneyincoll 'add commod-currency trans-bought)
(moneyoutcoll 'add commod-currency trans-sold)		(moneyoutcoll 'add commod-currency trans-sold)
(moneyoutcoll 'add commod-currency trans-spinoff)		(moneyoutcoll 'add commod-currency trans-spinoff)
;; Look at splits again to handle changes in basis and re alized gains		;; Look at splits again to handle changes in basis and re alized gains
(for-each		(for-each
(lambda (s)		(lambda (s)
(let		(let
;; get the split's units and value		;; get the split's units and value
((split-units (xaccSplitGetAmount s))		((split-units (xaccSplitGetAmount s))
(split-value (xaccSplitGetValue s)))		(split-value (xaccSplitGetValue s)))
(gnc:debug "Pass 2: split units " (gnc-numeric-to-s tring split-units) " split-value "		(gnc:debug "Pass 2: split units " (gnc-numeric-to-s tring split-units) " split-value "
(gnc-numeric-to-string split-value) " co mmod-currency "		(gnc-numeric-to-string split-value) " co mmod-currency "
(gnc-commodity-get-printname commod-curr ency))		(gnc-commodity-get-printname commod-curr ency))
(cond		(cond
((and (not (gnc-numeric-zero-p split-units))		((and (not (gnc-numeric-zero-p split-units))
(same-account? current (xaccSplitGetAccount s)))		(same-account? current (xaccSplitGetAccount s)))
;; Split into subject account with non-zero amou nt. This is a purchase		;; Split into subject account with non-zero amou nt. This is a purchase
;; or a sale, adjust the basis		;; or a sale, adjust the basis
(let* ((split-value-currency (gnc:gnc-monetary-am		(let* ((split-value-currency (gnc:gnc-monetary-a
ount		mount
(my-exchange-fn (		(my-exchange-fn
gnc:make-gnc-monetary		(gnc:make-gnc-monetary
commod-currenc		commod-curren
y split-value) currency)))		cy split-value) currency)))
(orig-basis (sum-basis basis-list currency		(orig-basis (sum-basis basis-list currenc
-frac))		y-frac))
;; proportion of the fees attributable to		;; proportion of the fees attributable to
this split		this split
(fee-ratio (gnc-numeric-div (gnc-numeric-a		(fee-ratio (gnc-numeric-div (gnc-numeric-
bs split-units) trans-shares		abs split-units) trans-shares
GNC-DENOM-AUTO		GNC-DENOM-AUT
GNC-DENOM-REDUCE))		O GNC-DENOM-REDUCE))
;; Fees for this split in report currency		;; Fees for this split in report currency
(fees-currency (gnc:gnc-monetary-amount (m		(fees-currency (gnc:gnc-monetary-amount (
y-exchange-fn		my-exchange-fn
(gnc:make-gnc-monetary com		(gnc:make-gnc-monetary co
mod-currency		mmod-currency
(gnc-numeric-mul fee-rat		(gnc-numeric-mul fee-ra
io trans-brokerage		tio trans-brokerage
commod-cu		commod-c
rrency-frac GNC-RND-ROUND))		urrency-frac GNC-RND-ROUND))
currency)))		currency)))
(split-value-with-fees (if (eq? handle-bro		(split-value-with-fees (if (eq? handle-br
kerage-fees 'include-in-basis)		okerage-fees 'include-in-basis)
;; Include brok		;; Include bro
erage fees in basis		kerage fees in basis
(gnc-numeric-ad		(gnc-numeric-a
d split-value-currency fees-currency		dd split-value-currency fees-currency
c
urrency-frac GNC-RND-ROUND)		currency-frac GNC-RND-ROUND)
split-value-cur		split-value-cu
rency)))		rrency)))
(gnc:debug "going in to basis list " basis-lis t " " (gnc-numeric-to-string split-units) " "		(gnc:debug "going in to basis list " basis-lis t " " (gnc-numeric-to-string split-units) " "
(gnc-numeric-to-string split-value- with-fees))		(gnc-numeric-to-string split-value- with-fees))
;; adjust the basis		;; adjust the basis
(set! basis-list (basis-builder basis-list spli		(set! basis-list (basis-builder basis-list spl
t-units split-value-with-fees		it-units split-value-with-fees
basis-method cu		basis-method c
rrency-frac))		urrency-frac))
(gnc:debug "coming out of basis list " basis- list)		(gnc:debug "coming out of basis list " basis- list)
;; If it's a sale or the stock is worthless, c alculate the gain		;; If it's a sale or the stock is worthless, c alculate the gain
(if (not (gnc-numeric-positive-p split-value))		(if (not (gnc-numeric-positive-p split-value))
;; Split value is zero or negative. If i t's zero it's either a stock split/merge		;; Split value is zero or negative. If i t's zero it's either a stock split/merge
;; or the stock has become worthless (whi ch looks like a merge where the number		;; or the stock has become worthless (whi ch 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.		;; 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 cu rrency-frac)))		(let ((new-basis (sum-basis basis-list cu rrency-frac)))
(if (or (gnc-numeric-zero-p new-ba sis)		(if (or (gnc-numeric-zero-p new-ba sis)
(gnc-numeric-negative-p sp lit-value))		(gnc-numeric-negative-p sp lit-value))
skipping to change at line 753		skipping to change at line 753
((spin-off? s current)		((spin-off? s current)
(gnc:debug "before spin-off basis list " basis -list)		(gnc:debug "before spin-off basis list " basis -list)
(set! basis-list (basis-builder basis-list spl it-units (gnc:gnc-monetary-amount		(set! basis-list (basis-builder basis-list spl it-units (gnc:gnc-monetary-amount
(my-exchange-fn (gnc:make-gnc-monetary		(my-exchange-fn (gnc:make-gnc-monetary
commod-currency split-value)		commod-currency split-value)
currency))		currency))
basis-method		basis-method
currency-frac))		currency-frac))
(gnc:debug "after spin-off basis list " basis -list))		(gnc:debug "after spin-off basis list " basis -list))
)		)
))		))
(xaccTransGetSplitList parent)		(xaccTransGetSplitList parent)
)		)
)		)
)		)
)		)
)		)
(xaccAccountGetSplitList current)		(xaccAccountGetSplitList current)
)		)
;; Look for income and expense transactions that don't have a split i		;; Look for income and expense transactions that don't have a split
n the		in the
;; the account we're processing. We do this as follow		;; the account we're processing. We do this as follow
;; 1. Make sure the parent account is a currency-valued asset or bank		;; 1. Make sure the parent account is a currency-valued asset or ban
account		k account
;; 2. If so go through all the splits in that 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 s		;; 3. If a split is part of a two split transaction where the other
plit is		split is
;; to an income or expense account and the leaf name of that accou		;; to an income or expense account and the leaf name of that acco
nt is the		unt is the
;; same as the leaf name of the account we're processing, add it t		;; same as the leaf name of the account we're processing, add it
o the		to the
;; income or expense accumulator		;; income or expense accumulator
;;		;;
;; In other words with an account structure like		;; In other words with an account structure like
;;		;;
;; Assets (type ASSET)		;; Assets (type ASSET)
;; Broker (type ASSET)		;; Broker (type ASSET)
;; Widget Stock (type STOCK)		;; Widget Stock (type STOCK)
;; Income (type INCOME)		;; Income (type INCOME)
;; Dividends (type INCOME)		;; Dividends (type INCOME)
;; Widget Stock (type INCOME)		;; Widget Stock (type INCOME)
;;		;;
;; If you are producing a report on "Assets:Broker:Widget Stock" a		;; If you are producing a report on "Assets:Broker:Widget Stock" a
;; transaction that debits the Assets:Broker account and credits the		;; transaction that debits the Assets:Broker account and credits the
;; "Income:Dividends:Widget Stock" account will count as income in		;; "Income:Dividends:Widget Stock" account will count as income in
;; the report even though it doesn't have a split in the account		;; the report even though it doesn't have a split in the account
;; being reported on.		;; being reported on.
(let ((parent-account (gnc-account-get-parent current))		(let ((parent-account (gnc-account-get-parent current))
(account-name (xaccAccountGetName current)))		(account-name (xaccAccountGetName current)))
(if (and (not (null? parent-account))		(if (and (not (null? parent-account))
(member (xaccAccountGetType parent-account) (list ACCT-TYP		(member (xaccAccountGetType parent-account) (list ACCT-TY
E-ASSET ACCT-TYPE-BANK))		PE-ASSET ACCT-TYPE-BANK))
(gnc-commodity-is-currency (xaccAccountGetCommodity parent		(gnc-commodity-is-currency (xaccAccountGetCommodity paren
-account)))		t-account)))
(for-each		(for-each
(lambda (split)		(lambda (split)
(let* ((other-split (xaccSplitGetOtherSplit split))		(let* ((other-split (xaccSplitGetOtherSplit split))
;; This is safe because xaccSplitGetAccount returns nu		;; This is safe because xaccSplitGetAccount returns n
ll for a null split		ull for a null split
(other-acct (xaccSplitGetAccount other-split))		(other-acct (xaccSplitGetAccount other-split))
(parent (xaccSplitGetParent split))		(parent (xaccSplitGetParent split))
(txn-date (xaccTransGetDate parent)))		(txn-date (xaccTransGetDate parent)))
(if (and (not (null? other-acct))		(if (and (not (null? other-acct))
(<= txn-date to-date)		(<= txn-date to-date)
(string=? (xaccAccountGetName other-acct) account-		(string=? (xaccAccountGetName other-acct) account
name)		-name)
(gnc-commodity-is-currency (xaccAccountGetCommodit		(gnc-commodity-is-currency (xaccAccountGetCommodi
y other-acct)))		ty other-acct)))
;; This is a two split transaction where the other split		;; This is a two split transaction where the other split
is to an		is to an
;; account with the same name as the current account. If		;; account with the same name as the current account. I
it's an		f it's an
;; income or expense account accumulate the value of the		;; income or expense account accumulate the value of the
transaction		transaction
(let ((val (xaccSplitGetValue split))		(let ((val (xaccSplitGetValue split))
(curr (xaccAccountGetCommodity other-acct)))		(curr (xaccAccountGetCommodity other-acct)))
(cond ((split-account-type? other-split ACCT-TYPE-INCO ME)		(cond ((split-account-type? other-split ACCT-TYPE-INCO ME)
(gnc:debug "More income " (gnc-numeric-to-string		(gnc:debug "More income " (gnc-numeric-to-strin
val))		g val))
(dividendcoll 'add curr val))		(dividendcoll 'add curr val))
((split-account-type? other-split ACCT-TYPE-EXPE NSE)		((split-account-type? other-split ACCT-TYPE-EXPE NSE)
(gnc:debug "More expense " (gnc-numeric-to-stri ng		(gnc:debug "More expense " (gnc-numeric-to-stri ng
(gnc-numeric-neg va l)))		(gnc-numeric-neg va l)))
(brokeragecoll 'add curr (gnc-numeric-neg val)) )		(brokeragecoll 'add curr (gnc-numeric-neg val)) )
)		)
)		)
)		)
)		)
)		)
(xaccAccountGetSplitList parent-account)		(xaccAccountGetSplitList parent-account)
)		)
)		)
)		)
(gnc:debug "pricing txn is " pricing-txn)		(gnc:debug "pricing txn is " pricing-txn)
(gnc:debug "use txn is " use-txn)		(gnc:debug "use txn is " use-txn)
(gnc:debug "prefer-pricelist is " prefer-pricelist)		(gnc:debug "prefer-pricelist is " prefer-pricelist)
(gnc:debug "price is " price)		(gnc:debug "price is " price)
(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-stri		(gnc:debug "basis we're using to build rows is " (gnc-numeric-to-str
ng (sum-basis basis-list		ing (sum-basis basis-list
currency-frac		currency-fra
)))		c)))
(gnc:debug "but the actual basis list is " basis-list)		(gnc:debug "but the actual basis list is " basis-list)
(if (eq? handle-brokerage-fees 'include-in-gain)		(if (eq? handle-brokerage-fees 'include-in-gain)
(gaincoll 'minusmerge brokeragecoll #f))		(gaincoll 'minusmerge brokeragecoll #f))
(if (or include-empty (not (gnc-numeric-zero-p units)))		(if (or include-empty (not (gnc-numeric-zero-p units)))
(let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my-		(let* ((moneyin (gnc:sum-collector-commodity moneyincoll currency my
exchange-fn))		-exchange-fn))
(moneyout (gnc:sum-collector-commodity moneyoutcoll currency my		(moneyout (gnc:sum-collector-commodity moneyoutcoll currency m
-exchange-fn))		y-exchange-fn))
(brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn))		(brokerage (gnc:sum-collector-commodity brokeragecoll currency my-exchange-fn))
(income (gnc:sum-collector-commodity dividendcoll currency my-e		(income (gnc:sum-collector-commodity dividendcoll currency my-
xchange-fn))		exchange-fn))
;; just so you know, gain == realized gain, ugain == un-realize		;; just so you know, gain == realized gain, ugain == un-realiz
d gain, bothgain, well..		ed gain, bothgain, well..
(gain (gnc:sum-collector-commodity gaincoll currency my-exchang		(gain (gnc:sum-collector-commodity gaincoll currency my-exchan
e-fn))		ge-fn))
(ugain (gnc:make-gnc-monetary currency		(ugain (gnc:make-gnc-monetary currency
(gnc-numeric-sub (gnc:gnc-monetar		(gnc-numeric-sub (gnc:gnc-moneta
y-amount (my-exchange-fn value currency))		ry-amount (my-exchange-fn value currency))
(sum-basis basis		(sum-basis basi
-list (gnc-commodity-get-fraction currency))		s-list (gnc-commodity-get-fraction currency))
currency-frac GN		currency-frac G
C-RND-ROUND)))		NC-RND-ROUND)))
(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (gn		(bothgain (gnc:make-gnc-monetary currency (gnc-numeric-add (g
c:gnc-monetary-amount gain)		nc:gnc-monetary-amount gain)
(gn		(g
c:gnc-monetary-amount ugain)		nc:gnc-monetary-amount ugain)
cur		cu
rency-frac GNC-RND-ROUND)))		rrency-frac GNC-RND-ROUND)))
(totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add (		(totalreturn (gnc:make-gnc-monetary currency (gnc-numeric-add
gnc:gnc-monetary-amount bothgain)		(gnc:gnc-monetary-amount bothgain)
(gnc:gnc-monetary-amount income)		(gnc:gnc-monetary-amount income)
c
urrency-frac GNC-RND-ROUND)))		currency-frac GNC-RND-ROUND)))
(activecols (list (gnc:html-account-anchor current)))		(activecols (list (gnc:html-account-anchor current)))
)		)
;; If we're using the txn, warn the user		;; If we're using the txn, warn the user
(if use-txn		(if use-txn
(if pricing-txn		(if pricing-txn
(set! warn-price-dirty #t)		(set! warn-price-dirty #t)
(set! warn-no-price #t)		(set! warn-no-price #t)
))		))
(total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monet		(total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-mone
ary-amount value))		tary-amount value))
(total-moneyin 'merge moneyincoll #f)		(total-moneyin 'merge moneyincoll #f)
(total-moneyout 'merge moneyoutcoll #f)		(total-moneyout 'merge moneyoutcoll #f)
(total-brokerage 'merge brokeragecoll #f)		(total-brokerage 'merge brokeragecoll #f)
(total-income 'merge dividendcoll #f)		(total-income 'merge dividendcoll #f)
(total-gain 'merge gaincoll #f)		(total-gain 'merge gaincoll #f)
(total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-monet		(total-ugain 'add (gnc:gnc-monetary-commodity ugain) (gnc:gnc-mone
ary-amount ugain))		tary-amount ugain))
(total-basis 'add currency (sum-basis basis-list currency-frac))		(total-basis 'add currency (sum-basis basis-list currency-frac))
;; build a list for the row based on user selections		;; build a list for the row based on user selections
(if show-symbol (append! activecols (list (gnc:make-html-table-head		(if show-symbol (append! activecols (list (gnc:make-html-table-hea
er-cell/markup "text-cell" ticker-symbol))))		der-cell/markup "text-cell" ticker-symbol))))
(if show-listing (append! activecols (list (gnc:make-html-table-hea		(if show-listing (append! activecols (list (gnc:make-html-table-he
der-cell/markup "text-cell" listing))))		ader-cell/markup "text-cell" listing))))
(if show-shares (append! activecols (list (gnc:make-html-table-head		(if show-shares (append! activecols (list (gnc:make-html-table-hea
er-cell/markup		der-cell/markup
"number-cell" (xaccPrintAmount units share-print-info)))))		"number-cell" (xaccPrintAmount units share-print-info)))))
(if show-price (append! activecols (list (gnc:make-html-table-heade		(if show-price (append! activecols (list (gnc:make-html-table-head
r-cell/markup		er-cell/markup
"number-cell"		"number-cell"
(if use-txn		(if use-txn
(if pricing-txn		(if pricing-txn
(gnc:html-transaction-anchor pricing-txn price)		(gnc:html-transaction-anchor pricing-txn price)
price)		price)
(gnc:html-price-anchor		(gnc:html-price-anchor
price (gnc:default-price-renderer		price (gnc:default-price-renderer
(gnc-price-get-currency price)		(gnc-price-get-currency price)
(gnc-price-get-value price))))))))		(gnc-price-get-value price))))))))
(append! activecols (list (if use-txn (if pricing-txn "*" "**") " "		(append! activecols (list (if use-txn (if pricing-txn "*" "**") "
)		")
(gnc:make-html-table-header-cell/markup		(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:make-gnc-monetary cur		"number-cell" (gnc:make-gnc-monetary cu
rency (sum-basis basis-list		rrency (sum-basis basis-list
currency-frac)))		currency-frac))
(gnc:make-html-table-header-cell/markup "		)
number-cell" value)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" value)
number-cell" moneyin)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" moneyin)
number-cell" moneyout)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" moneyout)
number-cell" gain)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" gain)
number-cell" ugain)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" ugain)
number-cell" bothgain)		(gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "		"number-cell" bothgain)
number-cell"		(gnc:make-html-table-header-cell/markup
(let* ((moneyinvalue (gnc-numeric-to-		"number-cell"
double		(let* ((moneyinvalue (gnc-numeric-to
(gnc:gnc-moneta		-double
ry-amount moneyin)))		(gnc:gnc-monet
(bothgainvalue (gnc-numeric-to		ary-amount moneyin)))
-double		(bothgainvalue (gnc-numeric-t
(gnc:gnc-monet		o-double
ary-amount bothgain)))		(gnc:gnc-mone
		tary-amount bothgain)))
)		)
(if (= 0.0 moneyinvalue)		(if (= 0.0 moneyinvalue)
""		""
(format #f "~,2f%" (* 100 (/ bo		(format #f "~,2f%" (* 100 (/ b
thgainvalue moneyinvalue)))))		othgainvalue moneyinvalue)))))
)		)
(gnc:make-html-table-header-cell/markup "		(gnc:make-html-table-header-cell/markup
number-cell" income)))		"number-cell" income)))
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))		(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
(append! activecols (list (gnc:make-html-table-header-cell/mark		(append! activecols (list (gnc:make-html-table-header-cell/mar
up "number-cell" brokerage))))		kup "number-cell" brokerage))))
(append! activecols (list (gnc:make-html-table-header-cell/markup "		(append! activecols (list (gnc:make-html-table-header-cell/markup
number-cell" totalreturn)		"number-cell" totalreturn)
(gnc:make-html-table-header-cell/markup "		(gnc:make-html-table-header-cell/markup
number-cell"		"number-cell"
(let* ((moneyinvalue (gnc-numeric-to-		(let* ((moneyinvalue (gnc-numeric-to
double		-double
(gnc:gnc-moneta		(gnc:gnc-monet
ry-amount moneyin)))		ary-amount moneyin)))
(totalreturnvalue (gnc-numeric		(totalreturnvalue (gnc-numeri
-to-double		c-to-double
(gnc:gnc-mo		(gnc:gnc-m
netary-amount totalreturn)))		onetary-amount totalreturn)))
)		)
(if (= 0.0 moneyinvalue)		(if (= 0.0 moneyinvalue)
""		""
(format #f "~,2f%" (* 100 (/ to		(format #f "~,2f%" (* 100 (/ t
talreturnvalue moneyinvalue))))))		otalreturnvalue moneyinvalue))))))
)		)
)		)
(gnc:html-table-append-row/markup!		(gnc:html-table-append-row/markup!
table		table
row-style		row-style
activecols)		activecols)
(if (and (not use-txn) price) (gnc-price-unref price))		(if (and (not use-txn) price) (gnc-price-unref price))
(table-add-stock-rows-internal rest (not odd-row?))		(table-add-stock-rows-internal rest (not odd-row?))
)		)
(begin		(begin
(if (and (not use-txn) price) (gnc-price-unref price))		(if (and (not use-txn) price) (gnc-price-unref price))
(table-add-stock-rows-internal rest odd-row?)		(table-add-stock-rows-internal rest odd-row?)
)		)
)		)
)))		)))
(set! work-to-do (gnc:accounts-count-splits accounts))		(set! work-to-do (gnc:accounts-count-splits accounts))
(table-add-stock-rows-internal accounts #t)))		(table-add-stock-rows-internal accounts #t)))
;; Tell the user that we're starting.		;; Tell the user that we're starting.
(gnc:report-starting reportname)		(gnc:report-starting reportname)
;; The first thing we do is make local variables for all the specific		;; The first thing we do is make local variables for all the specific
;; options in the set of options given to the function. This set will		;; options in the set of options given to the function. This set will
;; be generated by the options generator above.		;; be generated by the options generator above.
skipping to change at line 960		skipping to change at line 960
(gnc:date-option-absolute-time		(gnc:date-option-absolute-time
(get-option gnc:pagename-general "Date"))))		(get-option gnc:pagename-general "Date"))))
(accounts (get-option gnc:pagename-accounts "Accounts"))		(accounts (get-option gnc:pagename-accounts "Accounts"))
(currency (get-option gnc:pagename-general "Report's currency"))		(currency (get-option gnc:pagename-general "Report's currency"))
(price-source (get-option gnc:pagename-general		(price-source (get-option gnc:pagename-general
optname-price-source))		optname-price-source))
(report-title (get-option gnc:pagename-general		(report-title (get-option gnc:pagename-general
gnc:optname-reportname))		gnc:optname-reportname))
(include-empty (get-option gnc:pagename-accounts		(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))		optname-zero-shares))
(show-symbol (get-option gnc:pagename-display		(show-symbol (get-option gnc:pagename-display
optname-show-symbol))		optname-show-symbol))
(show-listing (get-option gnc:pagename-display		(show-listing (get-option gnc:pagename-display
optname-show-listing))		optname-show-listing))
(show-shares (get-option gnc:pagename-display		(show-shares (get-option gnc:pagename-display
optname-show-shares))		optname-show-shares))
(show-price (get-option gnc:pagename-display		(show-price (get-option gnc:pagename-display
optname-show-price))		optname-show-price))
(basis-method (get-option gnc:pagename-general		(basis-method (get-option gnc:pagename-general
optname-basis-method))		optname-basis-method))
(prefer-pricelist (get-option gnc:pagename-general		(prefer-pricelist (get-option gnc:pagename-general
optname-prefer-pricelist))		optname-prefer-pricelist))
(handle-brokerage-fees (get-option gnc:pagename-general		(handle-brokerage-fees (get-option gnc:pagename-general
optname-brokerage-fees))		optname-brokerage-fees))
(total-basis (gnc:make-commodity-collector))		(total-basis (gnc:make-commodity-collector))
(total-value (gnc:make-commodity-collector))		(total-value (gnc:make-commodity-collector))
(total-moneyin (gnc:make-commodity-collector))		(total-moneyin (gnc:make-commodity-collector))
(total-moneyout (gnc:make-commodity-collector))		(total-moneyout (gnc:make-commodity-collector))
(total-income (gnc:make-commodity-collector))		(total-income (gnc:make-commodity-collector))
(total-gain (gnc:make-commodity-collector)) ;; realized gain		(total-gain (gnc:make-commodity-collector)) ;; realized gain
(total-ugain (gnc:make-commodity-collector)) ;; unrealized gain		(total-ugain (gnc:make-commodity-collector)) ;; unrealized gain
(total-brokerage (gnc:make-commodity-collector))		(total-brokerage (gnc:make-commodity-collector))
;;document will be the HTML document that we return.		;;document will be the HTML document that we return.
(table (gnc:make-html-table))		(table (gnc:make-html-table))
(document (gnc:make-html-document)))		(document (gnc:make-html-document)))
(gnc:html-document-set-title!		(gnc:html-document-set-title!
document (string-append		document (string-append
report-title		report-title
(format #f " ~a" (qof-print-date to-date))))		(format #f " ~a" (qof-print-date to-date))))
(if (not (null? accounts))		(if (not (null? accounts))
; at least 1 account selected		; at least 1 account selected
skipping to change at line 1005		skipping to change at line 1005
(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))		(pricedb (gnc-pricedb-get-db (gnc-get-current-book)))
(price-fn		(price-fn
(case price-source		(case price-source
((pricedb-latest)		((pricedb-latest)
(lambda (foreign domestic date)		(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign)		(find-price (gnc-pricedb-lookup-latest-any-currency pricedb foreign)
domestic)))		domestic)))
((pricedb-before)		((pricedb-before)
(lambda (foreign domestic date)		(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-before-any-currency- t64		(find-price (gnc-pricedb-lookup-nearest-before-any-currency- t64
pricedb foreign (time64CanonicalDayTime date))		pricedb foreign (time64CanonicalDayTime date))
domestic)))		domestic)))
((pricedb-nearest)		((pricedb-nearest)
(lambda (foreign domestic date)		(lambda (foreign domestic date)
(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency -t64		(find-price (gnc-pricedb-lookup-nearest-in-time-any-currency -t64
pricedb foreign (time64CanonicalDayTime date)) domestic)))))		pricedb foreign (time64CanonicalDayTime date)) domestic))))
(headercols (list (G_ "Account")))		)
(totalscols (list (gnc:make-html-table-cell/markup "total-label-ce		(headercols (list (G_ "Account")))
ll" (G_ "Total"))))		(totalscols (list (gnc:make-html-table-cell/markup "total-label-c
(sum-total-moneyin (gnc-numeric-zero))		ell" (G_ "Total"))))
(sum-total-income (gnc-numeric-zero))		(sum-total-moneyin (gnc-numeric-zero))
(sum-total-both-gains (gnc-numeric-zero))		(sum-total-income (gnc-numeric-zero))
(sum-total-gain (gnc-numeric-zero))		(sum-total-both-gains (gnc-numeric-zero))
(sum-total-ugain (gnc-numeric-zero))		(sum-total-gain (gnc-numeric-zero))
(sum-total-brokerage (gnc-numeric-zero))		(sum-total-ugain (gnc-numeric-zero))
(sum-total-totalreturn (gnc-numeric-zero))) ;;end of let		(sum-total-brokerage (gnc-numeric-zero))
		(sum-total-totalreturn (gnc-numeric-zero))) ;;end of let
;;begin building lists for which columns to display		;;begin building lists for which columns to display
(if show-symbol		(if show-symbol
(begin (append! headercols (list (G_ "Symbol")))		(begin (append! headercols (list (G_ "Symbol")))
(append! totalscols (list " "))))		(append! totalscols (list " "))))
(if show-listing		(if show-listing
(begin (append! headercols (list (G_ "Listing")))		(begin (append! headercols (list (G_ "Listing")))
(append! totalscols (list " "))))		(append! totalscols (list " "))))
(if show-shares		(if show-shares
(begin (append! headercols (list (G_ "Shares")))		(begin (append! headercols (list (G_ "Shares")))
(append! totalscols (list " "))))		(append! totalscols (list " "))))
(if show-price		(if show-price
(begin (append! headercols (list (G_ "Price")))		(begin (append! headercols (list (G_ "Price")))
(append! totalscols (list " "))))		(append! totalscols (list " "))))
(append! headercols (list " "		(append! headercols (list " "
(G_ "Basis")		(G_ "Basis")
(G_ "Value")		(G_ "Value")
(G_ "Money In")		(G_ "Money In")
(G_ "Money Out")		(G_ "Money Out")
(G_ "Realized Gain")		(G_ "Realized Gain")
(G_ "Unrealized Gain")		(G_ "Unrealized Gain")
(G_ "Total Gain")		(G_ "Total Gain")
(G_ "Rate of Gain")		(G_ "Rate of Gain")
(G_ "Income")))		(G_ "Income")))
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))		(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
(append! headercols (list (G_ "Brokerage Fees"))))		(append! headercols (list (G_ "Brokerage Fees"))))
(append! headercols (list (G_ "Total Return")		(append! headercols (list (G_ "Total Return")
(G_ "Rate of Return")))		(G_ "Rate of Return")))
(append! totalscols (list " "))		(append! totalscols (list " "))
(gnc:html-table-set-col-headers!		(gnc:html-table-set-col-headers!
table		table
headercols)		headercols)
(catch 'div/0		(catch 'div/0
(lambda ()		(lambda ()
(table-add-stock-rows		(table-add-stock-rows
table accounts to-date currency price-fn exchange-fn price-source		table accounts to-date currency price-fn exchange-fn price-source
include-empty show-symbol show-listing show-shares show-price bas is-method		include-empty show-symbol show-listing show-shares show-price bas is-method
prefer-pricelist handle-brokerage-fees		prefer-pricelist handle-brokerage-fees
total-basis total-value total-moneyin total-moneyout		total-basis total-value total-moneyin total-moneyout
total-income total-gain total-ugain total-brokerage))		total-income total-gain total-ugain total-brokerage))
(lambda (k reason)		(lambda (k reason)
(gnc:html-document-add-object!		(gnc:html-document-add-object!
document (format #f OVERFLOW-ERROR reason))))		document (format #f OVERFLOW-ERROR reason))))
(set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin curr		(set! sum-total-moneyin (gnc:sum-collector-commodity total-moneyin cur
ency exchange-fn))		rency exchange-fn))
(set! sum-total-income (gnc:sum-collector-commodity total-income curren		(set! sum-total-income (gnc:sum-collector-commodity total-income curre
cy exchange-fn))		ncy exchange-fn))
(set! sum-total-gain (gnc:sum-collector-commodity total-gain currency e		(set! sum-total-gain (gnc:sum-collector-commodity total-gain currency
xchange-fn))		exchange-fn))
(set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currency		(set! sum-total-ugain (gnc:sum-collector-commodity total-ugain currenc
exchange-fn))		y exchange-fn))
(set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeric		(set! sum-total-both-gains (gnc:make-gnc-monetary currency (gnc-numeri
-add (gnc:gnc-monetary-amount sum-total-gain)		c-add (gnc:gnc-monetary-amount sum-total-gain)
(gnc:gnc-monetary-amount sum-total-ugain)		(gnc:gnc-monetary-amount sum-total-ugain)
(gnc-commodity-get-fraction currency) GNC-RND-ROUND)))		(gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage		(set! sum-total-brokerage (gnc:sum-collector-commodity total-brokerage
currency exchange-fn))		currency exchange-fn))
(set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numeri		(set! sum-total-totalreturn (gnc:make-gnc-monetary currency (gnc-numer
c-add (gnc:gnc-monetary-amount sum-total-both-gains)		ic-add (gnc:gnc-monetary-amount sum-total-both-gains)
(gnc:gnc-monetary-amount sum-total-income)		(gnc:gnc-monetary-amount sum-total-income)
(gnc-commodity-get-fraction currency) GNC-RND-ROUND)))		(gnc-commodity-get-fraction currency) GNC-RND-ROUND)))
(gnc:html-table-append-row/markup!		(gnc:html-table-append-row/markup!
table		table
"grand-total"		"grand-total"
(list		(list
(gnc:make-html-table-cell/size		(gnc:make-html-table-cell/size
1 17 (gnc:make-html-text (gnc:html-markup-hr)))))		1 17 (gnc:make-html-text (gnc:html-markup-hr)))))
;; finish building the totals columns, now that totals are complete		;; finish building the totals columns, now that totals are complete
(append! totalscols (list		(append! totalscols (list
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:sum-collector-commodity		"total-number-cell" (gnc:sum-collector-commodity
total-basis currency exchange-fn))		total-basis currency exchange-fn))
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:sum-collector-commodity		"total-number-cell" (gnc:sum-collector-commodity
total-value currency exchange-fn))		total-value currency exchange-fn))
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-moneyin)		"total-number-cell" sum-total-moneyin)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:sum-collector-commodity		"total-number-cell" (gnc:sum-collector-commodity
total-moneyout currency exchange-fn))		total-moneyout currency exchange-fn))
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-gain)		"total-number-cell" sum-total-gain)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-ugain)		"total-number-cell" sum-total-ugain)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-both-gains)		"total-number-cell" sum-total-both-gains)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell"		"total-number-cell"
(let* ((totalinvalue (gnc-numeric-to-double		(let* ((totalinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount su		(gnc:gnc-monetary-amount s
m-total-moneyin)))		um-total-moneyin)))
(totalgainvalue (gnc-numeric-to-double		(totalgainvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount		(gnc:gnc-monetary-amount
sum-total-both-gains)))		sum-total-both-gains)))
)		)
(if (= 0.0 totalinvalue)		(if (= 0.0 totalinvalue)
""		""
(format #f "~,2f%" (* 100 (/ totalgainvalue		(format #f "~,2f%" (* 100 (/ totalgainvalu
totalinvalue))))))		e totalinvalue))))))
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-income)))		"total-number-cell" sum-total-income)))
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))		(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
(append! totalscols (list		(append! totalscols (list
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-brokerage))))		"total-number-cell" sum-total-brokerage))))
(append! totalscols (list		(append! totalscols (list
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-totalreturn)		"total-number-cell" sum-total-totalreturn)
(gnc:make-html-table-cell/markup		(gnc:make-html-table-cell/markup
"total-number-cell"		"total-number-cell"
(let* ((totalinvalue (gnc-numeric-to-double		(let* ((totalinvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amount su		(gnc:gnc-monetary-amount s
m-total-moneyin)))		um-total-moneyin)))
(totalreturnvalue (gnc-numeric-to-double		(totalreturnvalue (gnc-numeric-to-double
(gnc:gnc-monetary-amoun		(gnc:gnc-monetary-amou
t sum-total-totalreturn)))		nt sum-total-totalreturn)))
)		)
(if (= 0.0 totalinvalue)		(if (= 0.0 totalinvalue)
""		""
(format #f "~,2f%" (* 100 (/ totalreturnval		(format #f "~,2f%" (* 100 (/ totalreturnva
ue totalinvalue))))))		lue totalinvalue))))))
))		))
(gnc:html-table-append-row/markup!		(gnc:html-table-append-row/markup!
table		table
"grand-total"		"grand-total"
totalscols		totalscols
)		)
(gnc:html-document-add-object! document table)		(gnc:html-document-add-object! document table)
(if warn-price-dirty		(if warn-price-dirty
(gnc:html-document-append-objects! document		(gnc:html-document-append-objects! document
(list (gnc:make-html-text (G_ " * this commodity data was built using transaction pricing instead of the price l ist."))		(list (gnc:make-html-text (G_ " * this commodity data was built using transaction pricing instead of the price l ist."))
(gnc:make-html-text (gnc:h		(gnc:make-html-text (gnc:
tml-markup-br))		html-markup-br))
(gnc:make-html-text (G_ "I		(gnc:make-html-text (G_ "
f you are in a multi-currency situation, the exchanges may not be correct.")))))		If you are in a multi-currency situation, the exchanges may not be correct."))))
		)
(if warn-no-price		(if warn-no-price
(gnc:html-document-append-objects! document		(gnc:html-document-append-objects! document
(list (gnc:make-html-text (if w arn-price-dirty (gnc:html-markup-br) ""))		(list (gnc:make-html-text (if w arn-price-dirty (gnc:html-markup-br) ""))
(gnc:make-html-text (G_ " ** 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.		;if no accounts selected.
(gnc:html-document-add-object!		(gnc:html-document-add-object!
document		document
(gnc:html-make-no-account-warning		(gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj))))		report-title (gnc:report-id report-obj))))
(gnc:report-finished)		(gnc:report-finished)
document)))		document)))
(gnc:define-report		(gnc:define-report
'version 1		'version 1
'report-guid "21d7cfc59fc74f22887596ebde7e462d"		'report-guid "21d7cfc59fc74f22887596ebde7e462d"
'name reportname		'name reportname
'menu-path (list gnc:menuname-asset-liability)		'menu-path (list gnc:menuname-asset-liability)
'options-generator options-generator		'options-generator options-generator
End of changes. 64 change blocks.
563 lines changed or deleted		568 lines changed or added

---