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:
Christian Stimming
2001-05-14 00:39:37 +00:00
parent 574a211f00
commit 3d90d386a6
3 changed files with 106 additions and 41 deletions
+7
View File
@@ -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
+5
View File
@@ -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
+94 -41
View File
@@ -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))