Herbert Thoma's patch:

* /src/report/standard-reports/advanced-portfolio.scm: new report
	which shows money-in, money-out and gain of stock and fund accounts
	(based on the work of Martijn van Oosterhout and portfolio.scm
	by Robert Merkel)

	* src/report/standard-reports/standard-reports.scm: add
	advanced-portfolio.scm to gncscmmod_DATA

	* doc/build-suse.txt: updated for GnuCash 1.7


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@7259 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
2002-10-01 20:48:27 +00:00
parent f86d58454a
commit 0f5a6b518b
6 changed files with 413 additions and 54 deletions

View File

@@ -1,3 +1,15 @@
2002-10-01 Herbert Thoma <herbie@hthoma.de>
* /src/report/standard-reports/advanced-portfolio.scm: new report
which shows money-in, money-out and gain of stock and fund accounts
(based on the work of Martijn van Oosterhout and portfolio.scm
by Robert Merkel)
* src/report/standard-reports/standard-reports.scm: add
advanced-portfolio.scm to gncscmmod_DATA
* doc/build-suse.txt: updated for GnuCash 1.7
2002-10-01 Christian Stimming <stimming@tuhh.de>
* src/import-export/hbci/gnc-hbci-actions.c: More work and fixes

View File

@@ -1,7 +1,7 @@
How to install gnucash on SuSE
==============================
(written 2000-01-07 by Peter Pointner <peter@wuzel.m.isar.de>)
(last changed 2001-06-13 by Herbert Thoma (herbie@hthoma.de))
(last changed 2002-08-08 by Herbert Thoma (herbie@hthoma.de))
Notes:
@@ -10,7 +10,7 @@ Notes:
your own risk. If you find errors, you might report them to the
gnucash mailing list (gnucash-devel@gnucash.org)
- This is for SuSE 6.3, 6.4, 7.0, 7.1 and 7.2 (Intel). Earlier SuSE
- This is for SuSE 7.2, 7.3 and 8.0 (Intel). Earlier SuSE
distributions lack some required packages. Later SuSE distributions
didn't exist at the time of writing.
NOTE: You can install new packages to older versions of SuSE from
@@ -18,67 +18,27 @@ Notes:
- This howto is primarily intended for compiling from source.
If you install the rpm, you don't need the various dev packages
and you don't need g-wrap. (However, you won't see this howto
until you installed the GnuCash rpm succesfully ;-).)
(However, you won't see this howto until you installed the
GnuCash rpm succesfully ;-).)
- The current stable version is gnucash-1.6.x,
the current development version is gnucash-1.7.x,
the development version needs the latest GNOME libraries
to build, especially gnprint >= 0.23, gdk_pix >= 0.8
and gtkhtml-0.8, which are not included with current SuSE
distibutions. The easiest way to get the latest GNOME is to do
"lynx -source http://go-gnome.com | sh"
as root.
SuSE 7.2 comes with all required gnome packages, but you
should get a newer revision of Guppi, if you want to use
all features of graphical reports, see below.
the current development version is gnucash-1.7.x.
Let's go:
* Make sure you have a running system, including X. For my tests I
started with a default installation and removed some packages to
save diskspace.
* Install the following packages (the list is valid for SuSE 7.2):
+ from series d
guile gettext libxml libxmld
and optionally
autoconf automake libtool
(You must install libtool if you have autoconf/automake
installed!)
+ from series x
xdevel
+ from series xdev
glade glib-devel gtk gtk-devel libglade libglade-devel
+ from series gnm
Guppi bonobo bonobo-devel gal gconf gdk-pixbuf gdk-pixbuf-devel
gnome-core gnome-core-devel gnome-libs gnome-libs-devel
gnome-print gnome-print-devel gtkhtml gtkhtml-devel
libghttp libghttp-devel libunicode oaf oaf-devel
+ from series gra
imlib imlibdev
+ from series sgm
docb* jade* sgmltools
* Download slib from
ftp://ftp.gnu.org/pub/gnu/jacal/slib2c7.zip
and install it by unpacking it to /usr/share/guile (this will
create a sub-directory slib):
cd /usr/share/guile
su root -c "unzip -L /tmp/slib2c7"
* Make sure you have a running system, including X and gnome
(and don't forget the development packages)
* Download g-wrap from
ftp://ftp.gnucash.org/pub/g-wrap/
For the 1.6.x version you need g-wrap-1.1.5.tar.gz or newer
For the 1.6.x version you need g-wrap-1.2.1
unpack and untar, then
./configure, make, su, make install
* Download Guppi from
ftp://ftp.gnome.org/pub/guppi/
You need Guppi-0.35.5 or newer, if you want to use all features
of the reports
unpack and untar, then
./configure --prefix=/opt/gnome, make, su, make install
For the 1.7.x version you need g-wrap-1.3.2
g-wrap-1.2 and g-wrap-1-3 are NOT compatible. If you want to
use both the stable and the development version of GnuCash
see the notes at the end of this file.
* Download GnuCash
stable version:
@@ -103,13 +63,16 @@ Let's go:
done as root, the files go to various places in /usr/local.
cd gnucash-1.y.x
./configure
./autogen.sh
make
su root -c "make install"
To build GnuCash 1.7.x you need to add the argument --host=i686-pc-linux-gnu
to the autogen.sh command (at least with SuSE 8.0).
* You may need to run GnuCash once as root, because guile needs to set up
some things for slib. Alternatively you can try as root:
guile -c '(use-modules (ice-9 slib)) (require 'new-catalog)'
guile -c "(use-modules (ice-9 slib)) (require 'new-catalog)"
* If want to send a patch, you need the makepatch perl module, which can
be found at:
@@ -117,3 +80,26 @@ Let's go:
unpack and untar, then
perl Makefile.PL, make, su, make install
Installing GnuCash 1.6 and 1.7 to one system:
---------------------------------------------
It is quite tricky to have the stable and development versions of
GnuCash running on one system, because they need incompatible
versions of g-wrap (1.2.1 resp. 1.3.2).
On my system I have GnuCash 1.6.x and g-wrap-1.2.1 installed in the
usual location (/usr/local/).
GnuCash 1.7.x is installed in /opt/gnucash/test_install/cvs_head
g-wrap-1.3.2 is installed in /opt/gnucash/g-wrap-latest
To compile GnuCash 1.7.x I do:
export PATH=/opt/gnucash/g-wrap-latest/bin:$PATH
export LD_LIBRARY_PATH=/opt/gnucash/g-wrap-latest/lib:$LD_LIBRARY_PATH
./autogen.sh --prefix=/opt/gnucash/test_install/cvs_head
--with-g-wrap-prefix=/opt/gnucash/g-wrap-latest --host=i686-pc-linux-gnu
make

View File

@@ -294,3 +294,5 @@ __DATA__
*.xac.*.xac
*~
.#*
doc/gnc-prices.1
doc/gnucash.1

View File

@@ -21,6 +21,7 @@ gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/report/
gncscmmod_DATA = \
account-piecharts.scm \
account-summary.scm \
advanced-portfolio.scm \
average-balance.scm \
balance-sheet.scm \
category-barchart.scm \

View File

@@ -0,0 +1,357 @@
;; -*-scheme-*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; advanced-portfolio.scm
;; by Martijn van Oosterhout (kleptog@svana.org) Feb 2002
;; modified for GnuCash 1.8 by Herbert Thoma (herbie@hthoma.de) Oct 2002
;;
;; Heavily based on 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
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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 optname-price-source (N_ "Price Source"))
(define optname-zero-shares (N_ "Include accounts with no shares"))
(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")
(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")
"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)
;; 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 include-empty total-value total-moneyin total-moneyout total-gain)
(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-info (price-fn commodity currency to-date))
(value-num (gnc:numeric-mul
units
(cdr price-info)
(gnc:commodity-get-fraction currency)
GNC-RND-ROUND))
(value (gnc:make-gnc-monetary currency value-num))
)
;; (gnc:debug "---" name "---")
(for-each
(lambda (split)
(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) (unitscoll 'add commodity (gnc:split-get-amount s)) ;; Is the stock transaction?
;; (gnc:debug "amount" (gnc:numeric-to-double (gnc:split-get-amount s)) )
(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))))) )
((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:numeric-negative-p (gnc:split-get-value s)) (moneyincoll 'add currency (gnc:split-get-value s)))
(else (moneyoutcoll '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 currency value-num)
(gaincoll 'merge moneyincoll #f)
(if (or include-empty (not (gnc:numeric-zero-p units)))
(begin (total-value 'add currency value-num)
(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:numeric-to-double units))
(gnc:make-html-table-header-cell/markup
"number-cell"
(gnc:html-price-anchor
(car price-info)
(gnc:make-gnc-monetary currency
(cdr price-info))))
(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 price-fn)))
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:sum-collector-commodity moneyoutcoll currency price-fn))
(gnc:make-html-table-header-cell/markup
"number-cell" (gnc:sum-collector-commodity gaincoll currency price-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?)))))
(table-add-stock-rows-internal accounts #t))
;; 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"))
(report-title (get-option gnc:pagename-general
gnc:optname-reportname))
(price-source (get-option gnc:pagename-general
optname-price-source))
(include-empty (get-option gnc:pagename-accounts
optname-zero-shares))
(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* ((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)
(cons #f (gnc:pricealist-lookup-nearest-in-time
pricealist foreign date)))))
('pricedb-latest
(lambda (foreign domestic date)
(let ((price
(gnc:pricedb-lookup-latest
pricedb foreign domestic)))
(if price
(let ((v (gnc:price-get-value price)))
(cons price v))
(cons #f (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)))
(cons price v))
(cons #f (gnc:numeric-zero)))))))))
(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 include-empty 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 price-fn))
(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:monetary-neg (gnc:sum-collector-commodity total-moneyin currency price-fn)))
(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:sum-collector-commodity total-moneyout currency price-fn))
(gnc:make-html-table-cell/markup
"total-number-cell" (gnc:sum-collector-commodity total-gain currency price-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))))
document))
(gnc:define-report
'version 1
'name (N_ "Advanced Portfolio")
'menu-path (list gnc:menuname-asset-liability)
'options-generator options-generator
'renderer advanced-portfolio-renderer)

View File

@@ -68,6 +68,7 @@
(use-modules (gnucash report account-piecharts))
(use-modules (gnucash report account-summary))
(use-modules (gnucash report advanced-portfolio))
(use-modules (gnucash report average-balance))
(use-modules (gnucash report balance-sheet))
(use-modules (gnucash report category-barchart))