IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Revert advanced-portfolio.scm r13244 because it breaks the report.

Browse Source 
* src/report/standard-reports/advanced-portfolio.scm:
	  revert r13244 in this file because it's badly formed and
	  breaks the report.  Reopened bug #314554.



git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@13252 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins 2006-02-13 05:05:55 +00:00
parent f06a206c07
commit effc0e7a9c
2 changed files with 114 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
ChangeLog
View File

@ -1,3 +1,9 @@
2006-02-13 Derek Atkins <derek@ihtfp.com>
* src/report/standard-reports/advanced-portfolio.scm:
revert r13244 in this file because it's badly formed and
breaks the report. Reopened bug #314554.
2006-02-12 Neil Williams <linux@codehelp.co.uk> 2006-02-12 Neil Williams <linux@codehelp.co.uk>
* src/calculation/fin.c : Fix Bug 107876 - financial * src/calculation/fin.c : Fix Bug 107876 - financial

226
src/report/standard-reports/advanced-portfolio.scm
View File

@ -170,123 +170,113 @@
(price-list (price-fn commodity to-date)) (price-list (price-fn commodity to-date))
(price (if (> (length price-list) 0) (price (if (> (length price-list) 0)
(car price-list) #f)) (car price-list) #f))
(commod-currency (gnc:price-get-currency price))
(value (exchange-fn (gnc:make-gnc-monetary commodity units) (value (exchange-fn (gnc:make-gnc-monetary commodity units) currency to-date))
currency)) )
)
;; (gnc:debug "---" name "---") ;; (gnc:debug "---" name "---")
(for-each (for-each
(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 (gnc:split-get-parent split))) (let ((parent (gnc:split-get-parent split)))
(if (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date) (if (gnc:timepair-le (gnc:transaction-get-date-posted parent) to-date)
(for-each (for-each
(lambda (s) (lambda (s)
(cond (cond
((same-split? s split) ((same-split? s split)
;; (gnc:debug "amount " (gnc:numeric-to-double (gnc:split-get-amount s)) ;; (gnc:debug "amount" (gnc:numeric-to-double (gnc:split-get-amount s)) )
;; " acct " (gnc:account-get-name (gnc:split-get-account s)) ) (cond
;; (gnc:debug "value " (gnc:numeric-to-double (gnc:split-get-value s)) ((or include-gains (not (gnc:numeric-zero-p (gnc:split-get-amount s))))
;; " in " (gnc:commodity-get-printname commod-currency) (unitscoll 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction?
;; " from " (gnc:transaction-get-description (gnc:split-get-parent s))) (if (< 0 (gnc:numeric-to-double
(cond (gnc:split-get-amount s)))
((or include-gains (not (gnc:numeric-zero-p (gnc:split-get-amount s)))) (set! totalunits
(unitscoll 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction? (+ totalunits
(if (< 0 (gnc:numeric-to-double (gnc:numeric-to-double (gnc:split-get-amount s)))))
(gnc:split-get-amount s))) (set! totalunityears
(set! totalunits (+ totalunityears
(+ totalunits (* (gnc:numeric-to-double (gnc:split-get-amount s))
(gnc:numeric-to-double (gnc:split-get-amount s))))) (gnc:date-year-delta
(set! totalunityears (car (gnc:transaction-get-date-posted parent))
(+ totalunityears (current-time)))))
(* (gnc:numeric-to-double (gnc:split-get-amount s)) (cond
(gnc:date-year-delta ((gnc:numeric-negative-p (gnc:split-get-value s))
(car (gnc:transaction-get-date-posted parent)) (moneyoutcoll
(current-time))))) 'add currency
(cond (gnc:numeric-neg (gnc:split-get-value s))))
((gnc:numeric-negative-p (gnc:split-get-value s)) (else (moneyincoll
(moneyoutcoll 'add currency
'add commod-currency (gnc:numeric-neg (gnc:split-get-value s))))))))
(gnc:numeric-neg (gnc:split-get-value s))))
(else (moneyincoll ((split-account-type? s 'expense)
'add commod-currency (brokeragecoll 'add currency (gnc:split-get-value s)))
(gnc:numeric-neg (gnc:split-get-value s))))))))
((split-account-type? s 'income)
((split-account-type? s 'expense) (dividendcoll 'add currency (gnc:split-get-value s)))
(brokeragecoll 'add commod-currency (gnc:split-get-value s))) )
)
((split-account-type? s 'income) (gnc:transaction-get-splits parent)
(dividendcoll 'add commod-currency (gnc:split-get-value s))) )
)
)
(gnc:transaction-get-splits parent)
)
) )
) )
) )
(gnc:account-get-split-list current) (gnc:account-get-split-list current)
) )
;; (gnc:debug "totalunits" totalunits) ;; (gnc:debug "totalunits" totalunits)
;; (gnc:debug "totalunityears" totalunityears) ;; (gnc:debug "totalunityears" totalunityears)
(moneyincoll 'minusmerge dividendcoll #f) (moneyincoll 'minusmerge dividendcoll #f)
(moneyoutcoll 'minusmerge brokeragecoll #f) (moneyoutcoll 'minusmerge brokeragecoll #f)
(gaincoll 'merge moneyoutcoll #f) (gaincoll 'merge moneyoutcoll #f)
(gaincoll 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)) (gaincoll 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
(gaincoll 'merge moneyincoll #f) (gaincoll 'merge moneyincoll #f)
(let ((moneyin (gnc:monetary-neg (if (or include-empty (not (gnc:numeric-zero-p units)))
(gnc:sum-collector-commodity moneyincoll currency exchange-fn))) (begin (total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value))
(moneyout (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn)) (total-moneyin 'merge moneyincoll #f)
(gain (gnc:sum-collector-commodity gaincoll currency exchange-fn)) (total-moneyout 'merge moneyoutcoll #f)
) (total-gain 'merge gaincoll #f)
(total-value 'add (gnc:gnc-monetary-commodity value) (gnc:gnc-monetary-amount value)) (gnc:html-table-append-row/markup!
(total-moneyin 'merge moneyincoll #f) table
(total-moneyout 'merge moneyoutcoll #f) row-style
(total-gain 'merge gaincoll #f) (list (gnc:html-account-anchor current)
(gnc:html-table-append-row/markup! ticker-symbol
table listing
row-style (gnc:make-html-table-header-cell/markup
(list (gnc:html-account-anchor current) "number-cell" (gnc:amount->string units share-print-info))
ticker-symbol (gnc:make-html-table-header-cell/markup
listing "number-cell"
(gnc:make-html-table-header-cell/markup (if price
"number-cell" (gnc:amount->string units share-print-info)) (gnc:html-price-anchor
(gnc:make-html-table-header-cell/markup price
"number-cell" (gnc:make-gnc-monetary
(if price (gnc:price-get-currency price)
(gnc:html-price-anchor (gnc:price-get-value price)))
price #f))
(gnc:make-gnc-monetary (gnc:make-html-table-header-cell/markup
(gnc:price-get-currency price) "number-cell" value)
(gnc:price-get-value price))) (gnc:make-html-table-header-cell/markup
#f)) "number-cell" (gnc:monetary-neg (gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
(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" moneyin) "number-cell" (gnc:sum-collector-commodity moneyoutcoll currency exchange-fn))
(gnc:make-html-table-header-cell/markup "number-cell" moneyout) (gnc:make-html-table-header-cell/markup
(gnc:make-html-table-header-cell/markup "number-cell" gain) "number-cell" (gnc:sum-collector-commodity gaincoll currency exchange-fn))
(gnc:make-html-table-header-cell/markup (gnc:make-html-table-header-cell/markup
"number-cell" "number-cell" (sprintf #f "%.2f%%" (* 100 (/ (gnc:numeric-to-double (cadr (gaincoll 'getpair currency #f)))
(sprintf #f "%.2f%%" (gnc:numeric-to-double (cadr (moneyincoll 'getpair currency #t)))))))
(* 100 (/ (gnc:numeric-to-double )
(gnc:gnc-monetary-amount gain)) )
(gnc:numeric-to-double (table-add-stock-rows-internal rest (not odd-row?))
(gnc:gnc-monetary-amount moneyin)))) )
)) (table-add-stock-rows-internal rest odd-row?)
)
)
(table-add-stock-rows-internal rest (not odd-row?))
)
(table-add-stock-rows-internal rest odd-row?)
) )
(gnc:price-list-destroy price-list) (gnc:price-list-destroy price-list)
))) )))
(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)
@ -319,9 +309,15 @@
report-title report-title
(sprintf #f " %s" (gnc:print-date to-date)))) (sprintf #f " %s" (gnc:print-date to-date))))
;; (gnc:debug "accounts" accounts)
(if (not (null? accounts)) (if (not (null? accounts))
; at least 1 account selected ; at least 1 account selected
(let* ((exchange-fn (gnc:case-exchange-fn price-source currency to-date)) (let* ((exchange-fn
(case price-source
('pricedb-latest
(lambda (foreign domestic date)
(gnc:exchange-by-pricedb-latest foreign domestic)))
('pricedb-nearest gnc:exchange-by-pricedb-nearest)))
(pricedb (gnc:book-get-pricedb (gnc:get-current-book))) (pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
(price-fn (price-fn
(case price-source (case price-source
@ -330,8 +326,7 @@
(gnc:pricedb-lookup-latest-any-currency pricedb foreign))) (gnc:pricedb-lookup-latest-any-currency pricedb foreign)))
('pricedb-nearest ('pricedb-nearest
(lambda (foreign date) (lambda (foreign date)
(gnc:pricedb-lookup-nearest-in-time-any-currency (gnc:pricedb-lookup-nearest-in-time-any-currency pricedb foreign date))))))
pricedb foreign (gnc:timepair-canonical-day-time date)))))))
(gnc:html-table-set-col-headers! (gnc:html-table-set-col-headers!
table table
@ -346,11 +341,6 @@
(_ "Gain") (_ "Gain")
(_ "Total Return"))) (_ "Total Return")))
(set! accounts (sort accounts
(lambda (a b)
(string<? (gnc:account-get-name a)
(gnc:account-get-name b)))))
(table-add-stock-rows (table-add-stock-rows
table accounts to-date currency price-fn exchange-fn table accounts to-date currency price-fn exchange-fn
include-empty include-gains total-value total-moneyin total-moneyout total-gain) include-empty include-gains total-value total-moneyin total-moneyout total-gain)