scheme help - keeping the 1.8 advanced-portfolio.scm working?
Oliver Iberien
odilist at sonic.net
Tue Nov 6 11:16:14 EST 2007
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%
Thanks,
Oliver
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.
>>
>>
>
More information about the gnucash-user
mailing list