scheme help - keeping the 1.8 advanced-portfolio.scm working?
Andrew Sackville-West
ajswest at mindspring.com
Tue Nov 6 12:55:15 EST 2007
On Tue, Nov 06, 2007 at 08:16:14AM -0800, Oliver Iberien wrote:
> In case an example helps, here's the way in which advanced-portfolio
> currently treats accounts with split transactions:
>
> Account Symbol Listing Shares Price Basis Value Money In Money Out
> Realized Gain Unrealized Gain Total Gain Total Return
> Oriental Minerals OMNLF.PK PNK 3,000.00 $1.0483 $407.00 $3,144.90
> -$7,577.00 $5,238.00 $13,222.00 $2,737.90 $15,959.90 -210.64%
>
I am sure this coincides with one of the existing advanced-portfolio
bugs. Maybe, http://bugzilla.gnome.org/show_bug.cgi?id=343245, or
http://bugzilla.gnome.org/show_bug.cgi?id=355660 or many others.
If you could look through those and determine which ones match your
situation, that would be helpful. Also, if you have a sample data file
that could be used to demonstrate your *specific* situation, that
would be very helpful as well.
A
>
> Derek Atkins wrote:
> > Have you tried the 2.2.1 version of the advanced portfolio
> > report? How does it "return garbage for accounts with
> > split transactions"?
> >
> > The Scheme API completely changed in 2.2; this error is a result
> > of you using a report that uses the old scheme API.
> >
> > -derek
> >
> > Oliver Iberien <odilist at sonic.net> writes:
> >
> >> I've been using the version of advanced-portfolio.scm from 1.8 as the
> >> subsequent ones return garbage for accounts with split transactions.
> >> Having just upgraded to 2.2.1 on Ubuntu 7.10, I find that this .scm no
> >> longer works -- it crashes Gnucash. The backtrace follows. I've also
> >> attached the old .scm file.
> >>
> >> Can any of the scheme experts out there tell me if there any tweaking
> >> that can be done to this to get it to continue to work?
> >>
> >> Thanks,
> >>
> >> Oliver
> >>
> >> Backtrace:
> >> In unknown file:
> >> ?: 0* [#<procedure #f (window)> #<swig-pointer GncMainWindow *
> >> 81fa000>]
> >> In /usr/share/gnucash/guile-modules/gnucash/report/report-gnome.scm:
> >> 79: 1* (let ((report #)) (gnc-main-window-open-report report window))
> >> 79: 2* [gnc:make-report "Advanced Portfolio"]
> >> In /usr/share/gnucash/scm/report.scm:
> >> 244: 3 (let (# #) (let # # #) (gnc:report-set-id! r #) ...)
> >> 255: 4* (let ((options (if # # ...))) (gnc:report-set-options! r
> >> options) ...)
> >> 256: 5* (if (not (null? rest)) (car rest) ...)
> >> 258: 6 [gnc:report-template-new-options #]
> >> ...
> >> 176: 7 (let ((options (generator))) (gnc:register-option options
> >> stylesheet) ...)
> >> 176: 8* [options-generator]
> >> In /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:
> >> 47: 9 (let* # # # ...)
> >> 90: 10* [#<procedure #f (new-option)> ...
> >> 91: 11* [gnc:make-account-list-option "Accounts" "Accounts" ...]
> >> In /usr/share/gnucash/scm/options.scm:
> >> 594: 12 [gnc:make-account-list-limited-option "Accounts" "Accounts" ...]
> >> ...
> >> 625: 13 (let* (# # # # ...) (gnc:make-option section name sort-tag ...))
> >> 625: 14* [map #<procedure convert-to-guid (item)> ...
> >> 625: 15* [#<procedure #f ()>]
> >> In /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:
> >> 95: 16 [filter #<procedure gnc:account-is-stock? (account)> ...
> >> 96: 17* (gnc:group-get-subaccounts (gnc:get-current-group))
> >>
> >> /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:96:26:
> >> In expression (gnc:group-get-subaccounts (gnc:get-current-group)):
> >> /usr/share/gnucash/guile-modules/gnucash/report/advanced-portfolio.scm:96:26:
> >> Unbound variable: gnc:group-get-subaccounts
> >>
> >>
> >> ;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> >> ;; advanced-portfolio.scm
> >> ;; by Martijn van Oosterhout (kleptog at svana.org) Feb 2002
> >> ;; modified for GnuCash 1.8 by Herbert Thoma (herbie at hthoma.de) Oct 2002
> >> ;;
> >> ;; Heavily based on portfolio.scm
> >> ;; by Robert Merkel (rgmerk at mira.net)
> >> ;;
> >> ;; This program is free software; you can redistribute it and/or
> >> ;; modify it under the terms of the GNU General Public License as
> >> ;; published by the Free Software Foundation; either version 2 of
> >> ;; the License, or (at your option) any later version.
> >> ;;
> >> ;; This program is distributed in the hope that it will be useful,
> >> ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> >> ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
> >> ;; GNU General Public License for more details.
> >> ;;
> >> ;; You should have received a copy of the GNU General Public License
> >> ;; along with this program; if not, contact:
> >> ;;
> >> ;; Free Software Foundation Voice: +1-617-542-5942
> >> ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
> >> ;; Boston, MA 02111-1307, USA gnu at gnu.org
> >> ;;
> >> ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> >>
> >> (define-module (gnucash report advanced-portfolio))
> >>
> >> (use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
> >> (use-modules (srfi srfi-1))
> >> (use-modules (ice-9 slib))
> >> (use-modules (gnucash gnc-module))
> >>
> >> (require 'printf)
> >>
> >> (gnc:module-load "gnucash/report/report-system" 0)
> >>
> >> (define reportname (N_ "Advanced Portfolio"))
> >>
> >> (define optname-price-source (N_ "Price Source"))
> >> (define optname-shares-digits (N_ "Share decimal places"))
> >> (define optname-zero-shares (N_ "Include accounts with no shares"))
> >> (define optname-include-gains (N_ "Include gains and losses"))
> >>
> >> (define (options-generator)
> >> (let* ((options (gnc:new-options))
> >> ;; This is just a helper function for making options.
> >> ;; See gnucash/src/scm/options.scm for details.
> >> (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-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"))
> >> )))
> >>
> >>
> >> (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))
> >>
> >> (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
> >> gnc:pagename-accounts (N_ "Accounts")
> >> "b"
> >> (N_ "Stock Accounts to report on")
> >> (lambda () (filter gnc:account-is-stock?
> >> (gnc:group-get-subaccounts
> >> (gnc:get-current-group))))
> >> (lambda (accounts) (list #t
> >> (filter gnc:account-is-stock? accounts)))
> >> #t))
> >>
> >> (gnc:register-option
> >> options
> >> (gnc:make-simple-boolean-option
> >> gnc:pagename-accounts optname-zero-shares "e"
> >> (N_ "Include accounts that have a zero share balances.")
> >> #f))
> >>
> >> (gnc:options-set-default-section options gnc:pagename-general)
> >> options))
> >>
> >> ;; This is the rendering function. It accepts a database of options
> >> ;; and generates an object of type <html-document>. See the file
> >> ;; report-html.txt for documentation; the file report-html.scm
> >> ;; 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)
> >>
> >> (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
> >> (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)))
> >> )
> >> )
> >> (gnc:transaction-get-splits parent)
> >> )
> >> )
> >> )
> >> )
> >> (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:html-table-set-col-headers!
> >> table
> >> (list (_ "Account")
> >> (_ "Symbol")
> >> (_ "Listing")
> >> (_ "Shares")
> >> (_ "Price")
> >> (_ "Value")
> >> (_ "Money In")
> >> (_ "Money Out")
> >> (_ "Gain")
> >> (_ "Total Return")))
> >>
> >> (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)))))))
> >> ))
> >>
> >> ;; (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)
> >> _______________________________________________
> >> gnucash-user mailing list
> >> gnucash-user at gnucash.org
> >> https://lists.gnucash.org/mailman/listinfo/gnucash-user
> >> -----
> >> Please remember to CC this list on all your replies.
> >> You can do this by using Reply-To-List or Reply-All.
> >>
> >>
> >
>
> _______________________________________________
> gnucash-user mailing list
> gnucash-user at gnucash.org
> https://lists.gnucash.org/mailman/listinfo/gnucash-user
> -----
> Please remember to CC this list on all your replies.
> You can do this by using Reply-To-List or Reply-All.
>
--
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: Digital signature
Url : http://lists.gnucash.org/pipermail/gnucash-user/attachments/20071106/273bc2d6/attachment.bin
More information about the gnucash-user
mailing list