Begin doorgestuurd bericht:
Van: Johan van Oostrum <[EMAIL PROTECTED]>
Datum: 11 september 2007 22:42:35 GMT+02:00
Aan: Derek Atkins <[EMAIL PROTECTED]>
Onderwerp: Antw.: GnuCash 2.2.x and advanced-report-sorted
Op 11-sep-2007, om 15:37 heeft Derek Atkins het volgende geschreven:
Hi,
What is the difference between this report and the existing
"advanced portfolio" report?
Functional change: sortcolumn option added
Code is (more or less) restructured to allow for easy use of sort
Would it be worthwhile to combine
them into a single report where the "sorting" part is just
a report option? Or are the reports so significantly
different that merging them would be nearly impossible?
Excellent suggestion. I created a (my first :-) svn diff today.
If you can combine them into a single report with an option
to add sorting, sending in a patch (svn diff) would be a good
way to get it applied to SVN for the next release....
Attached you find the diff.
Notes
- name changed to advanced-portfolio-sorted
- it is an update of the GnuCash 1.8.x advanced report, not the new
report that is packed with GC 2.2.x.
Index:
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
===================================================================
---
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
(.../advanced-portfolio.scm) (revision 72)
+++
/Users/johan/Documents/svn/my_gnucash_reports/branches/advanced-portfolio.scm
(.../advanced-portfolio-sorted.scm) (revision 77)
@@ -1,9 +1,13 @@
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; advanced-portfolio-sorted.scm
+;; by Johan van Oostrum ([EMAIL PROTECTED]) Sept 2007,
+;; for use with GnuCash 2.2.x
+;;
+;; This is a modified version of:
;; advanced-portfolio.scm
-;; by Martijn van Oosterhout ([EMAIL PROTECTED]) Feb 2002
+;; by Martijn van Oosterhout ([EMAIL PROTECTED]) Feb 2002,
;; modified for GnuCash 1.8 by Herbert Thoma ([EMAIL PROTECTED]) Oct 2002
-;;
-;; Heavily based on portfolio.scm
+;; Which in turn is heavily based on portfolio.scm
;; by Robert Merkel ([EMAIL PROTECTED])
;;
;; This program is free software; you can redistribute it and/or
@@ -25,7 +29,7 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define-module (gnucash report advanced-portfolio))
+(define-module (gnucash report advanced-portfolio-sorted))
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
(use-modules (srfi srfi-1))
@@ -36,11 +40,12 @@
(gnc:module-load "gnucash/report/report-system" 0)
-(define reportname (N_ "Advanced Portfolio"))
+(define reportname (N_ "Advanced Portfolio Sorted"))
-(define optname-price-source (N_ "Price Source"))
+(define optname-price-source (N_ "Price Source"))
+(define optname-sort-column (N_ "Sort Column"))
(define optname-shares-digits (N_ "Share decimal places"))
-(define optname-zero-shares (N_ "Include accounts with no shares"))
+(define optname-zero-shares (N_ "Include accounts with no shares"))
(define optname-include-gains (N_ "Include gains and losses"))
(define (options-generator)
@@ -50,42 +55,56 @@
(add-option
(lambda (new-option)
(gnc:register-option options new-option))))
-
+
;; General Tab
;; date at which to report balance
(gnc:options-add-report-date!
options gnc:pagename-general
(N_ "Date") "a")
-
+
(gnc:options-add-currency!
options gnc:pagename-general (N_ "Report Currency") "c")
-
+
(add-option
(gnc:make-multichoice-option
+ gnc:pagename-general optname-sort-column
+ "d" (N_ "The column on which the report is sorted") '0
+ (list (vector '0 (N_ "Account") (N_ ""))
+ (vector '1 (N_ "Symbol") (N_ ""))
+ (vector '2 (N_ "Listing") (N_ ""))
+ (vector '3 (N_ "Shares") (N_ ""))
+ (vector '4 (N_ "Price") (N_ ""))
+ (vector '5 (N_ "Value") (N_ ""))
+ (vector '6 (N_ "Money-in") (N_ ""))
+ (vector '7 (N_ "Money-out") (N_ ""))
+ (vector '8 (N_ "Gain") (N_ ""))
+ (vector '9 (N_ "Total return") (N_ ""))
+ )))
+
+ (add-option
+ (gnc:make-multichoice-option
gnc:pagename-general optname-price-source
"d" (N_ "The source of price information") 'pricedb-nearest
(list (vector 'pricedb-latest
- (N_ "Most recent")
- (N_ "The most recent recorded price"))
- (vector 'pricedb-nearest
- (N_ "Nearest in time")
- (N_ "The price recorded nearest in time to the report
date"))
- )))
-
-
+ (N_ "Most recent")
+ (N_ "The most recent recorded price"))
+ (vector 'pricedb-nearest
+ (N_ "Nearest in time")
+ (N_ "The price recorded nearest in time to the report
date"))
+ )))
+
(add-option
(gnc:make-number-range-option
gnc:pagename-general optname-shares-digits
- "e" (N_ "The number of decimal places to use for share numbers") 2
- 0 6 0 1))
-
+ "e" (N_ "The number of decimal places to use for share numbers") 2 0 6 0
1))
+
(gnc:register-option
options
(gnc:make-simple-boolean-option
gnc:pagename-general optname-include-gains "f"
(N_ "Include splits with no shares for calculating money-in and
money-out")
#f))
-
+
;; Account tab
(add-option
(gnc:make-account-list-option
@@ -93,12 +112,12 @@
"b"
(N_ "Stock Accounts to report on")
(lambda () (filter gnc:account-is-stock?
- (gnc:group-get-subaccounts
- (gnc:get-current-group))))
+ (gnc-account-get-descendants-sorted
+ (gnc-get-current-root-account))))
(lambda (accounts) (list #t
(filter gnc:account-is-stock? accounts)))
#t))
-
+
(gnc:register-option
options
(gnc:make-simple-boolean-option
@@ -115,289 +134,357 @@
;; includes all the relevant Scheme code. The option database passed
;; to the function is one created by the options-generator function
;; defined above.
-(define (advanced-portfolio-renderer report-obj)
+(define (advanced-portfolio-sorted-renderer report-obj)
- (let ((work-done 0)
- (work-to-do 0))
-
- ;; These are some helper functions for looking up option values.
- (define (get-op section name)
- (gnc:lookup-option (gnc:report-options report-obj) section name))
-
- (define (get-option section name)
- (gnc:option-value (get-op section name)))
-
- (define (split-account-type? split type)
- (eq? type
- (gw:enum-<gnc:AccountType>-val->sym (gnc:account-get-type
(gnc:split-get-account split)) #f)))
-
- (define (same-split? s1 s2)
- (string=? (gnc:split-get-guid s1) (gnc:split-get-guid s2)))
-
- (define (table-add-stock-rows table accounts to-date
- currency price-fn exchange-fn include-empty
include-gains
- total-value total-moneyin total-moneyout
- total-gain)
-
- (let ((share-print-info
- (gnc:share-print-info-places (get-option gnc:pagename-general
- 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))
- (name (gnc:account-get-name current))
- (commodity (gnc:account-get-commodity 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)))
- (totalunits 0.0)
- (totalunityears 0.0)
-
- ;; Counter to keep track of stuff
- (unitscoll (gnc:make-commodity-collector))
- (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))
-
- (price-list (price-fn commodity to-date))
- (price (if (> (length price-list) 0)
- (car price-list) #f))
-
- (value (exchange-fn (gnc:make-gnc-monetary commodity units)
currency to-date))
- )
-
-;; (gnc:debug "---" name "---")
- (for-each
+ (let ((work-done 0)
+ (work-to-do 0))
+
+ ;; These are some helper functions for looking up option values.
+ (define (get-op section name)
+ (gnc:lookup-option (gnc:report-options report-obj) section name))
+
+ (define (get-option section name)
+ (gnc:option-value (get-op section name)))
+
+ (define (split-account-type? split type)
+ (eq? type (xaccAccountGetType (xaccSplitGetAccount split))))
+
+ (define (same-split? s1 s2)
+ (string=? (gncSplitGetGUID s1) (gncSplitGetGUID s2)))
+
+ ;; return list with computed values for all selected stocks
+ (define (table-add-stock-rows accounts to-date
+ currency price-fn exchange-fn include-empty
include-gains
+ total-value total-moneyin total-moneyout
total-gain)
+
+ (let ()
+ (define (table-add-stock-rows-internal accounts)
+ (if (null? accounts) (list) ; return empty list
+ (let* ((current (car accounts))
+ (rest (cdr accounts))
+
+ (name (xaccAccountGetName current))
+ (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)))
+ (totalunits 0.0)
+ (totalunityears 0.0)
+
+ ;; Counter to keep track of stuff
+ (unitscoll (gnc:make-commodity-collector))
+ (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))
+
+ (price-list (price-fn commodity to-date))
+ (price (if (> (length price-list) 0)
+ (car price-list)
+ #f))
+ (rate (if price
+ (gnc:make-gnc-monetary
+ (gnc-price-get-currency price)
+ (gnc-price-get-value price))
+ #f))
+ (value (exchange-fn (gnc:make-gnc-monetary commodity
units) currency to-date))
+ )
+
+ ;; (gnc:debug "---" name "---")
+ (for-each
(lambda (split)
(set! work-done (+ 1 work-done))
(gnc:report-percent-done (* 100 (/ work-done work-to-do)))
- (let ((parent (gnc:split-get-parent split)))
- (if (gnc:timepair-le (gnc:transaction-get-date-posted
parent) to-date)
- (for-each
- (lambda (s)
- (cond
- ((same-split? s split)
- ;; (gnc:debug "amount" (gnc:numeric-to-double
(gnc:split-get-amount s)) )
- (cond
- ((or include-gains (not (gnc:numeric-zero-p
(gnc:split-get-amount s))))
- (unitscoll 'add commodity
(gnc:split-get-amount s)) ;; Is the stock transaction?
- (if (< 0 (gnc:numeric-to-double
- (gnc:split-get-amount s)))
- (set! totalunits
- (+ totalunits
- (gnc:numeric-to-double
(gnc:split-get-amount s)))))
- (set! totalunityears
- (+ totalunityears
- (* (gnc:numeric-to-double
(gnc:split-get-amount s))
- (gnc:date-year-delta
- (car
(gnc:transaction-get-date-posted parent))
- (current-time)))))
- (cond
- ((gnc:numeric-negative-p
(gnc:split-get-value s))
- (moneyoutcoll
- 'add currency
- (gnc:numeric-neg (gnc:split-get-value s))))
- (else (moneyincoll
- 'add currency
- (gnc:numeric-neg (gnc:split-get-value
s))))))))
-
- ((split-account-type? s 'expense)
- (brokeragecoll 'add currency (gnc:split-get-value
s)))
-
- ((split-account-type? s 'income)
- (dividendcoll 'add currency (gnc:split-get-value
s)))
- )
+ (let ((parent (xaccSplitGetParent split)))
+ (if (gnc:timepair-le (gnc-transaction-get-date-posted
parent) to-date)
+ (for-each
+ (lambda (s)
+ (cond
+ ((same-split? s split)
+ ;; (gnc:debug "amount" (gnc-numeric-to-double
(gnc:split-get-amount s)) )
+ (cond
+ ((or include-gains (not (gnc-numeric-zero-p
(xaccSplitGetAmount s))))
+ (unitscoll 'add commodity
(xaccSplitGetAmount s)) ;; Is the stock transaction?
+ (if (< 0 (gnc-numeric-to-double
+ (xaccSplitGetAmount s)))
+ (set! totalunits
+ (+ totalunits
+ (gnc-numeric-to-double
(xaccSplitGetAmount s)))))
+ (set! totalunityears
+ (+ totalunityears
+ (* (gnc-numeric-to-double
(xaccSplitGetAmount s))
+ (gnc:date-year-delta
+ (car
(gnc-transaction-get-date-posted parent))
+ (current-time)))))
+ (cond
+ ((gnc-numeric-negative-p
(xaccSplitGetValue s))
+ (moneyoutcoll
+ 'add currency
+ (gnc-numeric-neg (xaccSplitGetValue s))))
+ (else (moneyincoll
+ 'add currency
+ (gnc-numeric-neg (xaccSplitGetValue
s))))))))
+
+ ((split-account-type? s 'expense)
+ (brokeragecoll 'add currency (xaccSplitGetValue
s)))
+
+ ((split-account-type? s 'income)
+ (dividendcoll 'add currency (xaccSplitGetValue
s)))
+ )
+ )
+ (xaccTransGetSplitList parent)
+ )
)
- (gnc:transaction-get-splits parent)
- )
)
)
+ (xaccAccountGetSplitList current)
)
- (gnc:account-get-split-list current)
- )
-;; (gnc:debug "totalunits" totalunits)
-;; (gnc:debug "totalunityears" totalunityears)
-
- (gaincoll 'merge moneyoutcoll #f)
- (gaincoll 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
- (gaincoll 'merge moneyincoll #f)
-
- (if (or include-empty (not (gnc:numeric-zero-p units)))
- (begin (total-value 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
- (total-moneyin 'merge moneyincoll #f)
- (total-moneyout 'merge moneyoutcoll #f)
- (total-gain 'merge gaincoll #f)
- (gnc:html-table-append-row/markup!
- table
- row-style
- (list (gnc:html-account-anchor current)
- ticker-symbol
- listing
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:amount->string units
share-print-info))
- (gnc:make-html-table-header-cell/markup
- "number-cell"
- (if price
- (gnc:html-price-anchor
- price
- (gnc:make-gnc-monetary
- (gnc:price-get-currency price)
- (gnc:price-get-value price)))
- #f))
- (gnc:make-html-table-header-cell/markup
- "number-cell" value)
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:monetary-neg
(gnc:sum-collector-commodity moneyincoll currency exchange-fn)))
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:sum-collector-commodity
moneyoutcoll currency exchange-fn))
- (gnc:make-html-table-header-cell/markup
- "number-cell" (gnc:sum-collector-commodity
gaincoll currency exchange-fn))
- (gnc:make-html-table-header-cell/markup
- "number-cell" (sprintf #f "%.2f%%" (* 100 (/
(gnc:numeric-to-double (cadr (gaincoll 'getpair currency #f)))
-
(gnc:numeric-to-double (cadr (moneyincoll 'getpair currency #t)))))))
- )
- )
- (table-add-stock-rows-internal rest (not odd-row?))
- )
- (table-add-stock-rows-internal rest odd-row?)
- )
- (gnc:price-list-destroy price-list)
- )))
-
- (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)
-
- ;; 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
- ;; be generated by the options generator above.
- (let ((to-date (gnc:date-option-absolute-time
- (get-option gnc:pagename-general "Date")))
- (accounts (get-option gnc:pagename-accounts "Accounts"))
- (currency (get-option gnc:pagename-general "Report Currency"))
- (price-source (get-option gnc:pagename-general
- optname-price-source))
- (report-title (get-option gnc:pagename-general
- gnc:optname-reportname))
- (include-empty (get-option gnc:pagename-accounts
- optname-zero-shares))
- (include-gains (get-option gnc:pagename-general
- optname-include-gains))
-
- (total-value (gnc:make-commodity-collector))
- (total-moneyin (gnc:make-commodity-collector))
- (total-moneyout (gnc:make-commodity-collector))
- (total-gain (gnc:make-commodity-collector))
- ;; document will be the HTML document that we return.
- (table (gnc:make-html-table))
- (document (gnc:make-html-document)))
-
- (gnc:html-document-set-title!
- document (string-append
- report-title
- (sprintf #f " %s" (gnc:print-date to-date))))
-
-;; (gnc:debug "accounts" accounts)
- (if (not (null? accounts))
- ; at least 1 account selected
- (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)))
- (price-fn
- (case price-source
- ('pricedb-latest
- (lambda (foreign date)
- (gnc:pricedb-lookup-latest-any-currency pricedb foreign)))
- ('pricedb-nearest
- (lambda (foreign date)
- (gnc:pricedb-lookup-nearest-in-time-any-currency pricedb
foreign date))))))
+
+ ;; (gnc:debug "totalunits" totalunits)
+ ;; (gnc:debug "totalunityears" totalunityears)
+
+ (gaincoll 'merge moneyoutcoll #f)
+ (gaincoll 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
+ (gaincoll 'merge moneyincoll #f)
+
+ (gnc-price-list-destroy price-list)
+
+ (if (or include-empty (not (gnc-numeric-zero-p units)))
+ (begin
+ (total-value 'add (gnc:gnc-monetary-commodity value)
(gnc:gnc-monetary-amount value))
+ (total-moneyin 'merge moneyincoll #f)
+ (total-moneyout 'merge moneyoutcoll #f)
+ (total-gain 'merge gaincoll #f)
+
+ ;;(gnc:warn ">name: " (gnc:account-get-name current))
+ ;;(if price (gnc:warn ">price: " (gnc-numeric-to-double
(gnc:gnc-monetary-amount rate))))
+
+ (cons (list current
+ ticker-symbol
+ listing
+ units
+ rate
+ value
+ (gnc:monetary-neg
(gnc:sum-collector-commodity moneyincoll currency exchange-fn))
+ (gnc:sum-collector-commodity moneyoutcoll
currency exchange-fn)
+ (gnc:sum-collector-commodity gaincoll
currency exchange-fn)
+ (* 100 (/ (gnc-numeric-to-double (cadr
(gaincoll 'getpair currency #f)))
+ (gnc-numeric-to-double (cadr
(moneyincoll 'getpair currency #t)))))
+ price)
+ (table-add-stock-rows-internal rest)))
+
+ (table-add-stock-rows-internal rest)))
+ ))
+
+ (set! work-to-do (gnc:accounts-count-splits accounts)) ; #splits as
progress indicator
+
+ (table-add-stock-rows-internal accounts)
+
+ ))
+
+ ;; add one row with stock-computed values to the HTML table
+ (define (table-add-stock-row-html table share-print-info odd-row?
+ current ticker-symbol listing units
+ rate value money-in money-out gain
return price)
+ (let* ((row-style (if odd-row? "normal-row" "alternate-row"))
+ (odd-row? (not odd-row?)))
+ (gnc:html-table-append-row/markup!
+ table
+ row-style
+ (list (gnc:html-account-anchor current)
+ ticker-symbol
+ listing
+ (gnc:make-html-table-header-cell/markup "number-cell"
(xaccPrintAmount units share-print-info))
+ (gnc:make-html-table-header-cell/markup
+ "number-cell"
+ (if price
+ (gnc:html-price-anchor price rate)
+ #f))
+ (gnc:make-html-table-header-cell/markup "number-cell" value)
+ (gnc:make-html-table-header-cell/markup "number-cell" money-in)
+ (gnc:make-html-table-header-cell/markup "number-cell" money-out)
+ (gnc:make-html-table-header-cell/markup "number-cell" gain)
+ (gnc:make-html-table-header-cell/markup "number-cell" (sprintf
#f "%.2f%%" return))
+ ))))
+
+ ;; add all computed values off all stocks selected to the HTML table
+ (define (table-add-stock-rows-html table account-totals)
+ (let*
+ ;; get printing related options first
+ ((share-print-info (gnc-share-print-info-places (inexact->exact
(get-option gnc:pagename-general
+
optname-shares-digits))))
+ (c (get-option gnc:pagename-general
+ optname-sort-column))
+ (odd-row? #t))
+
+ (for-each
+ (lambda (l)
+ (apply table-add-stock-row-html table share-print-info odd-row? l))
+ ;; sort column (c in sort-list compare-less procedure) offsets are:
+ ;; 0 account
+ ;; 1 symbol
+ ;; 2 listing
+ ;; 3 shares (units)
+ ;; 4 price (rate)
+ ;; 5 value
+ ;; 6 money-in
+ ;; 7 money-out
+ ;; 8 gain
+ ;; 9 total-return
+ (sort-list account-totals (cond
+ ((= c 0)
+ (lambda (list1 list2)
+ (if (string<? (xaccAccountGetName
(list-ref list1 c))
+ (xaccAccountGetName
(list-ref list2 c))) #t #f)))
+ ((and (> c 0) (< c 3))
+ (lambda (list1 list2)
+ (if (string<? (list-ref list1 c)
(list-ref list2 c)) #t #f)))
+ ((= c 3)
+ (lambda (list1 list2)
+ (if (< (gnc-numeric-to-double(list-ref
list1 c))
+ (gnc-numeric-to-double(list-ref
list2 c))) #t #f)))
+ ((= c 4)
+ (lambda (list1 list2)
+ (if (< (if (list-ref list1 c)
(gnc-numeric-to-double (gnc:gnc-monetary-amount (list-ref list1 c))) 0.0)
+ (if (list-ref list2 c)
(gnc-numeric-to-double (gnc:gnc-monetary-amount (list-ref list2 c))) 0.0)) #t
#f)))
+ ((and (> c 4) (< c 9))
+ (lambda (list1 list2)
+ (if (< (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list1 c)))
+ (gnc-numeric-to-double
(gnc:gnc-monetary-amount (list-ref list2 c)))) #t #f)))
+ ((> c 8)
+ (lambda (list1 list2)
+ (if (< (list-ref list1 c) (list-ref
list2 c)) #t #f)))
+ )))))
+
+ ;; Tell the user that we're starting.
+ (gnc:report-starting reportname)
+
+ ;; 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
+ ;; be generated by the options generator above.
+ (let ((to-date (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general "Date")))
+ (accounts (get-option gnc:pagename-accounts "Accounts"))
+ (currency (get-option gnc:pagename-general "Report Currency"))
+ (price-source (get-option gnc:pagename-general
+ optname-price-source))
+ (report-title (get-option gnc:pagename-general
+ gnc:optname-reportname))
+ (include-empty (get-option gnc:pagename-accounts
+ optname-zero-shares))
+ (include-gains (get-option gnc:pagename-general
+ optname-include-gains))
- (gnc:html-table-set-col-headers!
- table
- (list (_ "Account")
- (_ "Symbol")
- (_ "Listing")
- (_ "Shares")
- (_ "Price")
- (_ "Value")
- (_ "Money In")
- (_ "Money Out")
- (_ "Gain")
- (_ "Total Return")))
+ (total-value (gnc:make-commodity-collector))
+ (total-moneyin (gnc:make-commodity-collector))
+ (total-moneyout (gnc:make-commodity-collector))
+ (total-gain (gnc:make-commodity-collector))
+ ;; document will be the HTML document that we return.
+ (table (gnc:make-html-table))
+ (document (gnc:make-html-document)))
+
+ (gnc:html-document-set-title!
+ document (string-append
+ report-title
+ (sprintf #f " %s" (gnc-print-date to-date))))
+
+ ;; (gnc:debug "accounts" accounts)
+ (if (not (null? accounts))
+ ; at least one account selected
+ (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-pricedb-get-db (gnc-get-current-book)))
+ (price-fn
+ (case price-source
+ ('pricedb-latest
+ (lambda (foreign date)
+ (gnc-pricedb-lookup-latest-any-currency pricedb
foreign)))
+ ('pricedb-nearest
+ (lambda (foreign date)
+ (gnc-pricedb-lookup-nearest-in-time-any-currency
pricedb foreign date))))))
+
+ (gnc:html-table-set-col-headers!
+ table
+ (list (_ "Account")
+ (_ "Symbol")
+ (_ "Listing")
+ (_ "Shares")
+ (_ "Price")
+ (_ "Value")
+ (_ "Money In")
+ (_ "Money Out")
+ (_ "Gain")
+ (_ "Total Return")))
+
+ (table-add-stock-rows-html table
+ (table-add-stock-rows accounts to-date
+ currency price-fn
exchange-fn
+ include-empty
include-gains
+ total-value
total-moneyin total-moneyout total-gain))
+
+ (gnc:html-table-append-row/markup!
+ table
+ "grand-total"
+ (list
+ (gnc:make-html-table-cell/size
+ 1 10 (gnc:make-html-text (gnc:html-markup-hr)))))
+
+ (gnc:html-table-append-row/markup!
+ table
+ "grand-total"
+ (list (gnc:make-html-table-cell/markup
+ "total-label-cell" (_ "Total"))
+ ""
+ ""
+ ""
+ ""
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity
total-value currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:monetary-neg
(gnc:sum-collector-commodity total-moneyin currency exchange-fn)))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity
total-moneyout currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (gnc:sum-collector-commodity
total-gain currency exchange-fn))
+ (gnc:make-html-table-cell/markup
+ "total-number-cell" (sprintf #f "%.2f%%" (* 100 (/
(gnc-numeric-to-double (cadr (total-gain 'getpair currency #f)))
+
(gnc-numeric-to-double (cadr (total-moneyin 'getpair currency #t)))))))
+ ))
+
+ ;; (total-value
+ ;; 'format
+ ;; (lambda (currency amount)
+ ;; (gnc:html-table-append-row/markup!
+ ;; table
+ ;; "grand-total"
+ ;; (list (gnc:make-html-table-cell/markup
+ ;; "total-label-cell" (_ "Total"))
+ ;; (gnc:make-html-table-cell/size/markup
+ ;; 1 5 "total-number-cell"
+ ;; (gnc:make-gnc-monetary currency amount)))))
+ ;; #f)
+
+ (gnc:html-document-add-object! document table))
- (table-add-stock-rows
- table accounts to-date currency price-fn exchange-fn
- include-empty include-gains total-value total-moneyin
total-moneyout total-gain)
-
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (list
- (gnc:make-html-table-cell/size
- 1 10 (gnc:make-html-text (gnc:html-markup-hr)))))
-
- (gnc:html-table-append-row/markup!
- table
- "grand-total"
- (list (gnc:make-html-table-cell/markup
- "total-label-cell" (_ "Total"))
- ""
- ""
- ""
- ""
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-value
currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:monetary-neg
(gnc:sum-collector-commodity total-moneyin currency exchange-fn)))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity
total-moneyout currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (gnc:sum-collector-commodity total-gain
currency exchange-fn))
- (gnc:make-html-table-cell/markup
- "total-number-cell" (sprintf #f "%.2f%%" (* 100 (/
(gnc:numeric-to-double (cadr (total-gain 'getpair currency #f)))
-
(gnc:numeric-to-double (cadr (total-moneyin 'getpair currency #t)))))))
- ))
+ ;if no accounts selected.
+ (gnc:html-document-add-object!
+ document
+ (gnc:html-make-no-account-warning
+ report-title (gnc:report-id report-obj))))
+
+ (gnc:report-finished)
+ document)))
-;; (total-value
-;; 'format
-;; (lambda (currency amount)
-;; (gnc:html-table-append-row/markup!
-;; table
-;; "grand-total"
-;; (list (gnc:make-html-table-cell/markup
-;; "total-label-cell" (_ "Total"))
-;; (gnc:make-html-table-cell/size/markup
-;; 1 5 "total-number-cell"
-;; (gnc:make-gnc-monetary currency amount)))))
-;; #f)
-
- (gnc:html-document-add-object! document table))
-
- ;if no accounts selected.
- (gnc:html-document-add-object!
- document
- (gnc:html-make-no-account-warning
- report-title (gnc:report-id report-obj))))
-
- (gnc:report-finished)
- document)))
-
(gnc:define-report
'version 1
'name reportname
'menu-path (list gnc:menuname-asset-liability)
'options-generator options-generator
- 'renderer advanced-portfolio-renderer)
+ 'renderer advanced-portfolio-sorted-renderer)
Regards,
Johan
-derek
Johan van Oostrum <[EMAIL PROTECTED]> writes:
In januari I posted a portfolio report for use with GnuCash 1.8.x.
Attached you find an updated version for use with GnuCash 2.2.x.
An option is added with which you can set the column the report
is to
be sorted.
I decided to name it advanced-portfolio-sorted to enable users to
give it a try without removing the original report. Slight
drawback of this
approach is that one has to edit standard-reports.scm.
Note that the calculation of splits, used in the GC 2 Advanced
Report, is not (yet) incorporated in this version. This may result
in total gain differing from that reported in the Advanced Report.
To install the report (I use Fink and have the files located here:
/sw/share/gnucash/guile-modules/gnucash/report/)
* 1 * Copy the report code to advance-portfolio-sorted.scm
* 2 * Add the marked line in standard-reports.scm:
...
(use-modules (gnucash report advanced-portfolio))
(use-modules (gnucash report advanced-portfolio-sorted)) ;; this
is the
new report
(use-modules (gnucash report average-balance))
...
Regards,
Johan
Please remember to CC this list on all your replies.
You can do this by using Reply-To-List or Reply-All.
--
Derek Atkins, SB '93 MIT EE, SM '95 MIT Media Laboratory
Member, MIT Student Information Processing Board (SIPB)
URL: http://web.mit.edu/warlord/ PP-ASEL-IA N1NWH
[EMAIL PROTECTED] PGP key available
_______________________________________________
gnucash-devel mailing list
gnucash-devel@gnucash.org
https://lists.gnucash.org/mailman/listinfo/gnucash-devel
