mirror of
https://github.com/Gnucash/gnucash.git
synced 2026-09-03 20:53:02 -05:00
2001-05-13 Christian Stimming <stimming@tuhh.de>
* src/scm/report/portfolio.scm: Added price-source option. Added code to use prices from transactions. * src/scm/commodity-utilities.scm: fix warnings. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4185 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
@@ -1,3 +1,10 @@
|
||||
2001-05-13 Christian Stimming <stimming@tuhh.de>
|
||||
|
||||
* src/scm/report/portfolio.scm: Added price-source option. Added
|
||||
code to use prices from transactions.
|
||||
|
||||
* src/scm/commodity-utilities.scm: fix warnings.
|
||||
|
||||
2001-05-13 Dave Peticolas <dave@krondo.com>
|
||||
|
||||
* src/FileDialog.c (gncPostFileOpen): fix bug -- current_book
|
||||
|
||||
@@ -181,6 +181,11 @@
|
||||
currency-accounts end-date-tp c report-currency)))
|
||||
commodity-list)))
|
||||
|
||||
;; Helper for warnings below.
|
||||
(define (commodity-numeric->string commodity numeric)
|
||||
(gnc:monetary->string
|
||||
(gnc:make-gnc-monetary commodity numeric)))
|
||||
|
||||
;; Get the instantaneous prices for the 'price-commodity', measured in
|
||||
;; amounts of the 'report-currency'. The prices are taken from all
|
||||
;; splits in 'currency-accounts' up until the date
|
||||
|
||||
@@ -1,15 +1,32 @@
|
||||
;; -*-scheme-*-
|
||||
|
||||
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; portfolio.scm
|
||||
;; by Robert Merkel (rgmerk@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@gnu.org
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(gnc:support "report/portfolio.scm")
|
||||
(gnc:depend "report-html.scm")
|
||||
|
||||
(let ()
|
||||
(let ((optname-price-source (N_ "Price Source")))
|
||||
|
||||
(define (options-generator)
|
||||
(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.
|
||||
@@ -17,11 +34,20 @@
|
||||
(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")
|
||||
|
||||
(gnc:options-add-price-source!
|
||||
options gnc:pagename-general
|
||||
optname-price-source "d" 'pricedb-latest)
|
||||
|
||||
;; Account tab
|
||||
(add-option
|
||||
(gnc:make-account-list-option
|
||||
gnc:pagename-accounts (N_ "Accounts")
|
||||
@@ -30,12 +56,10 @@
|
||||
(lambda () (filter gnc:account-is-stock?
|
||||
(gnc:group-get-subaccounts
|
||||
(gnc:get-current-group))))
|
||||
(lambda (accounts) (list #t (filter gnc:account-is-stock? accounts)))
|
||||
(lambda (accounts) (list #t
|
||||
(filter gnc:account-is-stock? accounts)))
|
||||
#t))
|
||||
|
||||
(gnc:options-add-currency!
|
||||
options gnc:pagename-general (N_ "Report Currency") "c")
|
||||
|
||||
(gnc:options-set-default-section options gnc:pagename-general)
|
||||
options))
|
||||
|
||||
@@ -51,11 +75,11 @@
|
||||
(define (get-op section name)
|
||||
(gnc:lookup-option (gnc:report-options report-obj) section name))
|
||||
|
||||
(define (op-value section name)
|
||||
(define (get-option section name)
|
||||
(gnc:option-value (get-op section name)))
|
||||
|
||||
(define (table-add-stock-rows table accounts to-date
|
||||
currency pricedb collector)
|
||||
currency price-fn collector)
|
||||
|
||||
(define (table-add-stock-rows-internal accounts odd-row?)
|
||||
(if (null? accounts) collector
|
||||
@@ -70,15 +94,8 @@
|
||||
current to-date #f))
|
||||
(units (cadr (unit-collector 'getpair commodity #f)))
|
||||
|
||||
(price (gnc:pricedb-lookup-nearest-in-time pricedb
|
||||
commodity
|
||||
currency
|
||||
to-date))
|
||||
(price-value (price-fn commodity currency to-date))
|
||||
|
||||
(price-value (if price
|
||||
(gnc:price-get-value price)
|
||||
(gnc:numeric-zero)))
|
||||
|
||||
(value-num (gnc:numeric-mul
|
||||
units
|
||||
price-value
|
||||
@@ -100,7 +117,6 @@
|
||||
price-value))
|
||||
(gnc:make-html-table-header-cell/markup
|
||||
"number-cell" value)))
|
||||
(gnc:price-unref price)
|
||||
(table-add-stock-rows-internal rest (not odd-row?)))))
|
||||
|
||||
(table-add-stock-rows-internal accounts #t))
|
||||
@@ -109,22 +125,69 @@
|
||||
;; 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
|
||||
(op-value gnc:pagename-general "Date")))
|
||||
(accounts (op-value gnc:pagename-accounts "Accounts"))
|
||||
(currency (op-value gnc:pagename-general "Report Currency"))
|
||||
(get-option gnc:pagename-general "Date")))
|
||||
(accounts (get-option gnc:pagename-accounts "Accounts"))
|
||||
(currency (get-option gnc:pagename-general "Report Currency"))
|
||||
(report-title (get-option gnc:pagename-general
|
||||
gnc:optname-reportname))
|
||||
(price-source (get-option gnc:pagename-general
|
||||
optname-price-source))
|
||||
|
||||
(collector (gnc:make-commodity-collector))
|
||||
;; document will be the HTML document that we return.
|
||||
(table (gnc:make-html-table))
|
||||
(document (gnc:make-html-document))
|
||||
(pricedb (gnc:book-get-pricedb (gnc:get-current-book))))
|
||||
(document (gnc:make-html-document)))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
document (sprintf #f
|
||||
(_ "Investment Portfolio Report: %s")
|
||||
(gnc:timepair-to-datestring to-date)))
|
||||
document (string-append
|
||||
report-title
|
||||
(sprintf #f " %s" (gnc:timepair-to-datestring to-date))))
|
||||
|
||||
(gnc:debug "accounts" accounts)
|
||||
(if (not (null? accounts))
|
||||
(begin
|
||||
(let* ((commodity-list (gnc:accounts-get-commodities
|
||||
(append
|
||||
(gnc:acccounts-get-all-subaccounts
|
||||
accounts) accounts) currency))
|
||||
(pricedb (gnc:book-get-pricedb (gnc:get-current-book)))
|
||||
(price-fn
|
||||
(case price-source
|
||||
('weighted-average
|
||||
(let ((pricealist
|
||||
(gnc:get-commoditylist-totalavg-prices
|
||||
commodity-list currency to-date)))
|
||||
(lambda (foreign domestic date)
|
||||
(let ((plist
|
||||
(assoc-ref pricealist foreign)))
|
||||
(if (and plist (not (null? plist)))
|
||||
(let ((price
|
||||
(gnc:pricelist-price-find-nearest
|
||||
plist date)))
|
||||
(if price
|
||||
price
|
||||
(gnc:numeric-zero)))
|
||||
(gnc:numeric-zero))))))
|
||||
('pricedb-latest
|
||||
(lambda (foreign domestic date)
|
||||
(let ((price
|
||||
(gnc:pricedb-lookup-latest
|
||||
pricedb foreign domestic)))
|
||||
(if price
|
||||
(let ((v (gnc:price-get-value price)))
|
||||
(gnc:price-unref price)
|
||||
v)
|
||||
(gnc:numeric-zero)))))
|
||||
('pricedb-nearest
|
||||
(lambda (foreign domestic date)
|
||||
(let ((price
|
||||
(gnc:pricedb-lookup-nearest-in-time
|
||||
pricedb foreign domestic date)))
|
||||
(if price
|
||||
(let ((v (gnc:price-get-value price)))
|
||||
(gnc:price-unref price)
|
||||
v)
|
||||
(gnc:numeric-zero))))))))
|
||||
|
||||
(gnc:html-table-set-col-headers!
|
||||
table
|
||||
(list (_ "Account")
|
||||
@@ -135,7 +198,8 @@
|
||||
(_ "Value")))
|
||||
|
||||
(table-add-stock-rows
|
||||
table accounts to-date currency pricedb collector)
|
||||
table accounts to-date currency
|
||||
price-fn collector)
|
||||
|
||||
(gnc:html-table-append-row/markup!
|
||||
table
|
||||
@@ -167,19 +231,8 @@
|
||||
document))
|
||||
|
||||
(gnc:define-report
|
||||
|
||||
;; The version of this report.
|
||||
'version 1
|
||||
|
||||
;; The name of this report. This will be used, among other things,
|
||||
;; for making its menu item in the main menu. You need to use the
|
||||
;; untranslated value here!
|
||||
'name (N_ "Investment Portfolio")
|
||||
|
||||
'menu-path (list gnc:menuname-asset-liability)
|
||||
|
||||
;; The options generator function defined above.
|
||||
'options-generator options-generator
|
||||
|
||||
;; The rendering function defined above.
|
||||
'renderer portfolio-renderer))
|
||||
|
||||
Reference in New Issue
Block a user