[Gnucash-changes] David Montenegro's Balance Sheet + Equity
Statement patch (#144243).
Derek Atkins
warlord at cvs.gnucash.org
Thu Jun 24 18:11:28 EDT 2004
Log Message:
-----------
David Montenegro's Balance Sheet + Equity Statement patch (#144243).
* Makefile.am: be sure to rebuild make-gnucash-patch and
make-gnucash-potfiles when the Makefile changes (which means the
PERL paths might have changed).
* src/scm/paths.scm: change the default config file to 1.9, so we
don't screw up users of 1.8.
* src/report/report-system/html-acct-table.scm:
Added file implementing gnc:html-acct-table utility
object for easier creation of HTML reports.
* src/report/standard-reports/balance-sheet.scm:
Updated to use the new gnc:html-acct-table object.
Added many new options, including report/account
form option.
* src/report/standard-reports/equity-statement.scm:
Created Statement of Owner's Equity.
(Unsure if correct exchange-fn's are being used.)
* src/report/report-system/commodity-utilities.scm:
* src/report/report-system/html-table.scm:
* src/report/report-system/html-utilities.scm:
* src/report/report-system/report-system.scm:
* src/report/report-system/report-utilities.scm:
miscellaneous small additions and/or fixes
Fixes #144243.
Modified Files:
--------------
gnucash:
ChangeLog
Makefile.am
make-gnucash-patch.in
gnucash/src/report/report-system:
Makefile.am
commodity-utilities.scm
html-table.scm
html-utilities.scm
report-system.scm
report-utilities.scm
gnucash/src/report/report-system/doc:
report-html.txt
gnucash/src/report/standard-reports:
Makefile.am
balance-sheet.scm
standard-reports.scm
gnucash/src/scm:
path.scm
Added Files:
-----------
gnucash/src/report/report-system:
html-acct-table.scm
gnucash/src/report/standard-reports:
equity-statement.scm
Revision Data
-------------
Index: make-gnucash-patch.in
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/make-gnucash-patch.in,v
retrieving revision 1.37
retrieving revision 1.38
diff -Lmake-gnucash-patch.in -Lmake-gnucash-patch.in -u -r1.37 -r1.38
--- make-gnucash-patch.in
+++ make-gnucash-patch.in
@@ -6,6 +6,13 @@
# mailing list gnucash-patches at gnucash.org. For more info
# consult the README.
#
+# WARNING: By default, this script will checkout an entire
+# up to date copy of the source tree in ../tmp/gnucash/.
+#
+# In order to prevent patches which reverse recent changes
+# made in CVS, make sure to "cvs update" in both
+# directories before running make-gnucash-patch.
+#
# This script requires the programs 'makepatch', 'gzip',
# a 'diff' work-a-like, and 'uuencode'.
#
Index: ChangeLog
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/ChangeLog,v
retrieving revision 1.1817
retrieving revision 1.1818
diff -LChangeLog -LChangeLog -u -r1.1817 -r1.1818
--- ChangeLog
+++ ChangeLog
@@ -1,3 +1,34 @@
+2004-06-24 Derek Atkins <derek at ihtfp.com>
+
+ * Makefile.am: be sure to rebuild make-gnucash-patch and
+ make-gnucash-potfiles when the Makefile changes (which means the
+ PERL paths might have changed).
+ * src/scm/paths.scm: change the default config file to 1.9, so we
+ don't screw up users of 1.8.
+
+2004-06-23 David Montenegro <sunrise2000 at comcast.net>
+
+ * src/report/report-system/html-acct-table.scm:
+ Added file implementing gnc:html-acct-table utility
+ object for easier creation of HTML reports.
+
+ * src/report/standard-reports/balance-sheet.scm:
+ Updated to use the new gnc:html-acct-table object.
+ Added many new options, including report/account
+ form option.
+
+ * src/report/standard-reports/equity-statement.scm:
+ Created Statement of Owner's Equity.
+ (Unsure if correct exchange-fn's are being used.)
+
+ * src/report/report-system/commodity-utilities.scm:
+ * src/report/report-system/html-table.scm:
+ * src/report/report-system/html-utilities.scm:
+ * src/report/report-system/report-system.scm:
+ * src/report/report-system/report-utilities.scm:
+ miscellaneous small additions and/or fixes
+ Fixes #144243.
+
2004-06-18 Christian Stimming <stimming at tuhh.de>
* src/scm/main-window.scm, src/scm/main.scm: Added example Menu
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/Makefile.am,v
retrieving revision 1.59
retrieving revision 1.60
diff -LMakefile.am -LMakefile.am -u -r1.59 -r1.60
--- Makefile.am
+++ Makefile.am
@@ -63,14 +63,14 @@
## brackets here, instead of the usual @... at . This prevents autoconf
## from substituting the values directly into the left-hand sides of
## the sed substitutions.
-make-gnucash-patch: make-gnucash-patch.in
+make-gnucash-patch: make-gnucash-patch.in Makefile
rm -f $@.tmp
sed < $< > $@.tmp \
-e 's:@-PERL-@:${PERL}:g'
chmod +x $@.tmp
mv $@.tmp $@
-make-gnucash-potfiles: make-gnucash-potfiles.in
+make-gnucash-potfiles: make-gnucash-potfiles.in Makefile
rm -f $@.tmp
sed < $< > $@.tmp \
-e 's:@-PERL-@:${PERL}:g'
Index: report-system.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/report-system.scm,v
retrieving revision 1.22
retrieving revision 1.23
diff -Lsrc/report/report-system/report-system.scm -Lsrc/report/report-system/report-system.scm -u -r1.22 -r1.23
--- src/report/report-system/report-system.scm
+++ src/report/report-system/report-system.scm
@@ -48,7 +48,7 @@
(export gnc:case-exchange-time-fn)
(export gnc:sum-collector-commodity)
(export gnc:sum-collector-stocks)
-
+(export gnc:commodity-collector-contains-commodity?)
;; options-utilities.scm
@@ -84,7 +84,8 @@
(export gnc:html-acct-table-cell)
(export gnc:html-acct-table-row-helper! )
(export gnc:html-acct-table-comm-row-helper!)
-(export gnc:html-build-acct-table )
+(export gnc:html-build-acct-table)
+(export gnc:first-html-build-acct-table)
(export gnc:html-make-exchangerates)
(export gnc:html-make-no-account-warning)
(export gnc:html-make-empty-data-warning)
@@ -401,6 +402,43 @@
(export gnc:html-style-sheet-find)
(export gnc:html-style-sheet-remove)
+;; html-acct-table.scm
+
+(export gnc:colspans-are-working-right)
+(export <html-acct-table>)
+(export gnc:html-acct-table?)
+(export gnc:_make-html-acct-table_)
+(export gnc:make-html-acct-table)
+(export gnc:make-html-acct-table/env)
+(export gnc:make-html-acct-table/env/accts)
+(export gnc:_html-acct-table-matrix_)
+(export gnc:_html-acct-table-set-matrix!_)
+(export gnc:_html-acct-table-env_)
+(export gnc:_html-acct-table-set-env!_)
+(export gnc:html-acct-table-add-accounts!)
+(export gnc:html-acct-table-num-rows)
+(export gnc:html-acct-table-num-cols)
+(export gnc:html-acct-table-get-row)
+(export gnc:html-acct-table-get-cell)
+(export gnc:html-acct-table-set-cell!)
+(export gnc:html-acct-table-get-row-env)
+(export gnc:html-acct-table-set-row-env!)
+(export gnc:html-acct-table-append-row)
+(export gnc:html-acct-table-prepend-row!)
+(export gnc:html-acct-table-append-col)
+(export gnc:html-acct-table-prepend-col!)
+(export gnc:html-acct-table-remove-last-row!)
+(export gnc:html-acct-table-render)
+(export gnc:account-code-less-p)
+(export gnc:account-name-less-p)
+(export gnc:account-path-less-p)
+(export gnc:identity)
+(export gnc:html-table-add-labeled-amount-line!)
+(export gnc:html-table-add-account-balances)
+(export gnc:second-html-build-acct-table)
+(export gnc:commodity-table)
+(export gnc:uniform-commodity?)
+
;; html-table.scm
(export <html-table>)
@@ -465,9 +503,11 @@
(export gnc:html-table-append-row!)
(export gnc:html-table-remove-last-row!)
(export gnc:html-table-prepend-row!)
+(export gnc:html-table-get-cell)
(export gnc:html-table-set-cell!)
(export gnc:html-table-append-column!)
(export gnc:html-table-prepend-column!)
+(export gnc:html-table-merge)
(export gnc:html-table-render)
;; html-text.scm
@@ -530,6 +570,7 @@
(export gnc:make-value-collector)
(export gnc:make-numeric-collector)
(export gnc:make-commodity-collector)
+(export gnc:commodity-collector-commodity-count)
(export gnc:account-get-balance-at-date)
(export gnc:account-get-comm-balance-at-date)
(export gnc:accounts-get-balance-helper)
@@ -549,6 +590,7 @@
(export gnc:report-percent-done)
(export gnc:report-finished)
(export gnc:accounts-count-splits)
+(export gnc:commodity-collector-allzero?)
(load-from-path "commodity-utilities.scm")
(load-from-path "html-barchart.scm")
@@ -560,6 +602,7 @@
(load-from-path "html-style-sheet.scm")
(load-from-path "html-table.scm")
(load-from-path "html-text.scm")
+(load-from-path "html-acct-table.scm")
(load-from-path "html-utilities.scm")
(load-from-path "options-utilities.scm")
(load-from-path "report-utilities.scm")
Index: html-table.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-table.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lsrc/report/report-system/html-table.scm -Lsrc/report/report-system/html-table.scm -u -r1.1 -r1.2
--- src/report/report-system/html-table.scm
+++ src/report/report-system/html-table.scm
@@ -3,6 +3,8 @@
;; for simple style elements.
;; Copyright 2000 Bill Gribble <grib at gnumatic.com>
;;
+;; * 2004.06.18: David Montenegro, added gnc:html-table-get-cell
+;;
;; 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
@@ -21,6 +23,16 @@
;; Boston, MA 02111-1307, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; NB: In this code, "markup" and "/markup" *do not* refer to
+;; style information. Rather, they let you override the tag
+;; associated with an html-table row or cell. Style
+;; information is stored in addition to this "markup" (in
+;; an entirely different record field).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(define <html-table>
(make-record-type "<html-table>"
'(col-headers
@@ -125,6 +137,11 @@
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval))))
(style (gnc:html-table-cell-style cell)))
+
+; ;; why dont colspans export??!
+; (gnc:html-table-cell-set-style! cell "td"
+; 'attribute (list "colspan"
+; (or (gnc:html-table-cell-colspan cell) 1)))
(gnc:html-document-push-style doc style)
(push (gnc:html-document-markup-start
doc (gnc:html-table-cell-tag cell)
@@ -384,6 +401,19 @@
new-num-rows))
+;; list-set! is 0-based...
+;; (let ((a '(0 1 2))) (list-set! a 1 "x") a)
+;; => (0 "x" 2)
+(define (gnc:html-table-get-cell table row col)
+ (list-ref-safe (gnc:html-table-get-row table row) col))
+
+(define (gnc:html-table-get-row table row)
+ (let* ((dd (gnc:html-table-data table))
+ (len (length dd))
+ )
+ (list-ref-safe dd (- (- len 1) row))
+ ))
+
(define (gnc:html-table-set-cell! table row col . objects)
(let ((rowdata #f)
(row-loc #f)
@@ -518,6 +548,26 @@
remaining-elements)
#f))))
+;;
+;; It would be nice to have table row/col/cell accessor functions in here.
+;; It would also be nice to have table juxtaposition functions, too.
+;; i.e., (gnc:html-table-nth-row table n)
+;; (gnc:html-table-append-table-horizontal table add-table)
+;; (An old merge-table used to exist inside balance-sheet.scm/GnuCash 1.8.9.)
+;; Feel free to contribute! :-)
+;;
+
+;; This function was moved here from balance-sheet.scm.
+(define (gnc:html-table-merge t1 t2)
+ (begin
+ (gnc:html-table-set-data! t1
+ (append
+ (gnc:html-table-data t2)
+ (gnc:html-table-data t1)))
+ (gnc:html-table-set-num-rows-internal!
+ t1 (+ (gnc:html-table-num-rows t1)
+ (gnc:html-table-num-rows t2)))))
+
(define (gnc:html-table-render table doc)
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))))
Index: commodity-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/commodity-utilities.scm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Lsrc/report/report-system/commodity-utilities.scm -Lsrc/report/report-system/commodity-utilities.scm -u -r1.12 -r1.13
--- src/report/report-system/commodity-utilities.scm
+++ src/report/report-system/commodity-utilities.scm
@@ -21,6 +21,15 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (gnc:commodity-collector-contains-commodity? collector commodity)
+ (let ((ret #f))
+ (gnc:commodity-collector-map
+ collector
+ (lambda (comm amt)
+ (set! ret (or ret (gnc:commodity-equiv? comm commodity)))))
+ ret
+ ))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to get splits with interesting data from accounts.
Index: report-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/report-utilities.scm,v
retrieving revision 1.19
retrieving revision 1.20
diff -Lsrc/report/report-system/report-utilities.scm -Lsrc/report/report-system/report-utilities.scm -u -r1.19 -r1.20
--- src/report/report-system/report-utilities.scm
+++ src/report/report-system/report-utilities.scm
@@ -474,6 +474,17 @@
(define (gnc:commodity-collector-list collector)
(collector 'list #f #f))
+;; Returns the number of commodities in a commodity-collector.
+;; (If this were implemented as a record, I would be able to
+;; just (length ...) the alist, but....)
+(define (gnc:commodity-collector-commodity-count collector)
+ (let ((commodities 0))
+ (gnc:commodity-collector-map
+ collector
+ (lambda (comm amt) (set! commodities (+ commodities 1))))
+ commodities
+ ))
+
;; Returns zero if all entries in this collector are zero.
(define (gnc:commodity-collector-allzero? collector)
(let ((result #t))
Index: html-utilities.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/html-utilities.scm,v
retrieving revision 1.10
retrieving revision 1.11
diff -Lsrc/report/report-system/html-utilities.scm -Lsrc/report/report-system/html-utilities.scm -u -r1.10 -r1.11
--- src/report/report-system/html-utilities.scm
+++ src/report/report-system/html-utilities.scm
@@ -1,7 +1,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-utilities.scm: Useful functions when using the HTML generator.
-;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
;;
+;; Modified slightly by David Montenegro 2004.06.18.
+;;
+;; Copyright 2001 Christian Stimming <stimming at tu-harburg.de>
;; 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
@@ -21,22 +23,23 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; returns a list with n #f (empty cell) values
+(define (gnc:html-make-empty-cell) #f)
(define (gnc:html-make-empty-cells n)
(if (> n 0)
(cons #f (gnc:html-make-empty-cells (- n 1)))
- '()))
+ (list)))
-(define (register-guid type guid)
+(define (gnc:register-guid type guid)
(gnc:html-build-url gnc:url-type-register (string-append type guid) #f))
(define (gnc:account-anchor-text acct)
- (register-guid "acct-guid=" (gnc:account-get-guid acct)))
+ (gnc:register-guid "acct-guid=" (gnc:account-get-guid acct)))
(define (gnc:split-anchor-text split)
- (register-guid "split-guid=" (gnc:split-get-guid split)))
+ (gnc:register-guid "split-guid=" (gnc:split-get-guid split)))
(define (gnc:transaction-anchor-text trans)
- (register-guid "trans-guid=" (gnc:transaction-get-guid trans)))
+ (gnc:register-guid (gnc:transaction-get-guid trans)))
(define (gnc:report-anchor-text report-id)
(gnc:html-build-url gnc:url-type-report
@@ -117,22 +120,32 @@
(assign-colors (+ i 1)))))
(assign-colors 0))
-;; Appends a horizontal ruler to a html-table with the specified width
-;; colspan.
-(define (gnc:html-table-append-ruler! table colspan)
+;; Appends a horizontal ruler to a html-table with the specified
+;; colspan at, optionally, the specified column.
+(define (gnc:html-table-append-ruler/at! table colskip colspan)
+ (define empty-cell '())
(gnc:html-table-append-row!
table
- (list
- (gnc:make-html-table-cell/size
- 1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
-
-(define (gnc:html-table-append-ruler/markup! table markup colspan)
- (gnc:html-table-append-row/markup!
+ (append (make-list colskip empty-cell)
+ (list
+ (gnc:make-html-table-cell/size
+ 1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))))
+
+(define (gnc:html-table-append-ruler/at/markup! table markup colskip colspan)
+ (define empty-cell "")
+ (gnc:html-table-append-row/markup!
table
markup
- (list
- (gnc:make-html-table-cell/size
- 1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
+ (append (make-list colskip empty-cell)
+ (list
+ (gnc:make-html-table-cell/size
+ 1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))))
+
+(define (gnc:html-table-append-ruler! table colspan)
+ (gnc:html-table-append-ruler/at! table 0 colspan))
+
+(define (gnc:html-table-append-ruler/markup! table markup colspan)
+ (gnc:html-table-append-ruler/at/markup! table markup 0 colspan))
;; Creates a table cell with some text in it. The cell will be created
;; with the colspan 'colspan' (the rowspan==1), the content 'content'
@@ -140,10 +153,12 @@
;; string, or a <html-text> object. Returns a <html-table-cell>
;; object.
(define (gnc:html-acct-table-cell colspan content boldface?)
+ ;; instead of html-markup-b, just use the corresponding html-table-styles.
+ (define default-style "text-cell")
+ (define boldface-style "total-label-cell")
(gnc:make-html-table-cell/size/markup
1 colspan
- ;; instead of html-markup-b, just use the right html-table-styles.
- (if boldface? "total-label-cell" "text-cell")
+ (if boldface? boldface-style default-style)
content))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -194,8 +209,10 @@
;; in the appropriate name column. my-commodity (a
;; <gnc:commodity*>) is the "natural" balance of the current
;; account. balance (a commodity-collector) is the balance to be
-;; printed. If reverse-balance? == #t then the balance's signs get
+;; printed. If reverse-balance? == #t then the balances' signs get
;; reversed.
+;; DM: If you trace this function through gnc:html-build-acct-table,
+;; my-commodity always ends up being report-commodity.
(define (gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn
current-depth my-name my-commodity balance
@@ -232,12 +249,14 @@
"number-cell"
(gnc:make-html-text (gnc:html-markup-b domestic-balance)))))
(list
- (gnc:make-html-table-cell/markup
- "number-cell"
- foreign-balance)
- (gnc:make-html-table-cell/markup
- "number-cell"
- domestic-balance)))
+ (and foreign-balance
+ (gnc:make-html-table-cell/markup
+ "number-cell"
+ foreign-balance))
+ (and domestic-balance
+ (gnc:make-html-table-cell/markup
+ "number-cell"
+ domestic-balance))))
(gnc:html-make-empty-cells (* 2 (- current-depth
(if group-header-line? 0 1)))))))
@@ -288,7 +307,7 @@
(gnc:make-gnc-monetary curr val))))
(commodity-row-helper!
;; print no account name
- (car (gnc:html-make-empty-cells 1))
+ (gnc:html-make-empty-cell)
;; print the account balance in the respective
;; commodity
bal
@@ -375,6 +394,37 @@
show-total? get-total-fn
total-name group-types? show-parent-balance? show-parent-total?
show-other-curr? report-commodity exchange-fn show-zero-entries?)
+ ;; Select, here, which version of gnc:html-build-acct-table you want
+ ;; to use by default.
+ (define fn-version 'first)
+ (if (equal? fn-version 'second)
+ (gnc:second-html-build-acct-table
+ start-date end-date
+ tree-depth show-subaccts? accounts
+ start-percent delta-percent
+ show-col-headers?
+ show-total? get-total-fn
+ total-name group-types? show-parent-balance? show-parent-total?
+ show-other-curr? report-commodity exchange-fn show-zero-entries?)
+ (gnc:first-html-build-acct-table
+ start-date end-date
+ tree-depth show-subaccts? accounts
+ start-percent delta-percent
+ show-col-headers?
+ show-total? get-total-fn
+ total-name group-types? show-parent-balance? show-parent-total?
+ show-other-curr? report-commodity exchange-fn show-zero-entries?)
+ )
+ )
+
+(define (gnc:first-html-build-acct-table
+ start-date end-date
+ tree-depth show-subaccts? accounts
+ start-percent delta-percent
+ show-col-headers?
+ show-total? get-total-fn
+ total-name group-types? show-parent-balance? show-parent-total?
+ show-other-curr? report-commodity exchange-fn show-zero-entries?)
(let ((table (gnc:make-html-table))
(work-to-do 0)
(work-done 0)
@@ -410,7 +460,7 @@
this-collector x )))
(gnc:group-map-all-accounts
(lambda (a)
- ;; Important: Calculate the balance if and only of the
+ ;; Important: Calculate the balance if and only if the
;; account a is shown, i.e. (use-acct? a) == #t.
(and (use-acct? a)
(my-get-balance-nosub a)))
@@ -659,7 +709,7 @@
(gnc:html-table-set-style!
table "th"
- 'attribute '("align" "right")
+ 'attribute '("align" "center")
'attribute '("valign" "top"))
;; set some column headers
--- /dev/null
+++ src/report/report-system/html-acct-table.scm
@@ -0,0 +1,1102 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; html-acct-table.scm : generate a multi-columnar list of accounts
+;; including utilities to convert to <html-table> form
+;;
+;; By David Montenegro 2004.06.23 <sunrise2000 at comcast.net>
+;;
+;; Borrowed largely from html-table.scm by Bill Gribble <grib at gnumatic.com>
+;; and html-utilities.scm by Christian Stimming <stimming at tu-harburg.de>
+;;
+;; 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
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;
+;;
+;; DESCRIPTION
+;;
+;; The html-acct-table object is a utility object, not an html object.
+;; It is used to collect and then render a table whose leftmost column(s)
+;; are a list or chart of accounts.
+;;
+;; You start by creating the object and initializing it with a list of
+;; accounts and a few assorted parameters. It generates a table, which
+;; can be read using accessor functions, containing information which
+;; makes it easy(ier) to create a great variety of html-table forms.
+;;
+;; add-accounts add-account-balances
+;; account-list ------------> html-acct-table ----------> html-table
+;;
+;; This utility object was written because of some shortcomings
+;; inherent in how the gnc:html-build-acct-table function was
+;; designed. Ultimately, the intent is to replace
+;; gnc:html-build-acct-table with an html-acct-table with the
+;; appropriate thunks. But, because this is new, I'm leaving the
+;; original gnc:html-build-acct-table in place, just to be safe.
+;;
+;;
+;; ARGUMENTS
+;;
+;; For boolean arguments, #t and #f have their usual meanings. If a
+;; boolean argument is not set, a default value may be assumed. For
+;; non-boolean arguments, values may be specified. When #f is
+;; specified as the value of a non-boolean argument, it generally
+;; means to omit whatever function the argument controls. When #t is
+;; specified for such an argument, it generally means to use that
+;; functionality, but just accept whatever default functionality that
+;; option may have.
+;;
+;; The list of accounts which are to be placed in the
+;; gnc:html-acct-table object can be controled with the
+;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/accts/env,
+;; and gnc:html-table-add-accts! functions.
+;;
+;; The gnc:html-acct-table parameters, set with
+;; gnc:make-html-acct-table/env and gnc:make-html-acct-table/accts/env
+;; and fetched with gnc:html-acct-table-env; accept the following
+;; parameters:
+;;
+;; display-tree-depth: integer 'unlimited 'all #f
+;;
+;; the number of levels of accounts to display
+;; 'unlimited, 'all, and #f impose no depth limit.
+;; the default is 'all.
+;;
+;; depth-limit-behavior: 'summarize 'flatten 'truncate
+;;
+;; when the display tree reaches its depth limit, this option
+;; tells gnc:html-acct-table what to do. 'summarize tells it
+;; to omit accounts below the depth limit and summarize their
+;; contents as belonging to their parent account at the depth
+;; limit. 'flatten tells it to display every selected
+;; subaccount, all the way down the tree, but to position
+;; them, in the chart, at the depth limit. the default value
+;; is 'summarize
+;;
+;; initial-indent: integer
+;;
+;; the number of table cells to indent the first level of
+;; accounts displayed. this is merely a convenience. the
+;; default initial-indent is 0.
+;;
+;; account-less-p: binary_predicate #t #f
+;;
+;; used for sorting accounts, below each parent account, into
+;; the order in which they will be displayed. the function
+;; must take two Account arguments and represent a total
+;; ordering on Account-space. #t means to use the default
+;; sorting function. #f means to preform no sorting. the
+;; default sorting function is gnc:account-code-less-p.
+;;
+;; start-date: timepair
+;;
+;; the starting date of the reporting period over which to
+;; report balances for this account. if start-date is #f,
+;; will be no limit on how early a counted transaction may
+;; ocurr.
+;;
+;; end-date: timepair
+;;
+;; the ending date of the reporting period over which to
+;; report balances for this account. if end-date is #f, there
+;; will be no limit on how late a counted transaction may
+;; ocurr. note: i do not know if GnuCash, right now, supports
+;; transactions in the future. so be prepared for the
+;; possibility that this may match transactions which haven't
+;; ocurred, yet.
+;;
+;; report-commodity: commodity
+;;
+;; the commodity into which to convert any balances containing
+;; foreign currencies. the balance will be converted using
+;; the exchange function exchange-fn. the defalut is the
+;; currency returned by (gnc:default-report-currency).
+;;
+;; exchange-fn: commodity_exchange_function
+;;
+;; the commodity exchange function (you know, that weighted
+;; average, most recent, nearest in time fun stuff) used to
+;; convert balances which are not exclusively in the report
+;; commodity into the report commodity.
+;;
+;; column-header: html-table-header-cell #f #t
+;;
+;; the table column header cell (TH tag) with which to head
+;; the columns containing the account tree. if supplied, the
+;; header cell may contain style information. if #f, no
+;; column header cell will be used. if #t, a default header
+;; cell (reading "Account") will be used. the colspan of any
+;; header cell will be automatically set appropriately. this
+;; is for convenience only; gnc:html-acct-table does not use
+;; this data.
+;;
+;; account-label-mode: 'name 'anchor
+;;
+;; tells whether to render account labels as hyperlinks or
+;; text. stylesheets, really, should be able to remove
+;; link markup.
+;;
+;; parent-account-subtotal-mode: #t #f 'canonically-tabbed
+;;
+;; indicates whether or not to add a line, recursively
+;; subtotalling an account and its descendents, for any
+;; account with children (non-leaf account). if #t or
+;; #canonically-tabbed, a subtotal row will be created for
+;; each non-leaf account. if #f, no non-leaf account
+;; subtotal rows will be created. if 'canonically-tabbed,
+;; account total entry labels will be placed at the position
+;; specified by accounting texts (indented one column from
+;; the accounts being totalled, two columns from where
+;; gnc:html-acct-table would otherwise place them). the
+;; default is #f.
+;;
+;; zero-balance-mode: 'show-leaf-acct 'omit-leaf-acct
+;;
+;; indicates what to do with accounts with zero balance. if
+;; 'omit-leaf-acct, no account row will be generated for any
+;; account having a balance of zero. otherwise, a row will be
+;; generated for the account.
+;;
+;; account-type: unimplemented
+;; account-class: unimplemented
+;; row-thunk: unimplemented (for gnc:html-acct-table-render)
+;; row-list: unimplemented (list of all the rows ever added)
+;;
+;; The html-acct-table object lets you generate, store, and access the
+;; following parameters:
+;;
+;; account: Account
+;;
+;; the account in the current row
+;;
+;; account-parent: Account #f
+;;
+;; the parent account of the current account, if one exists.
+;; #f if the current account has no parent.
+;;
+;; account-path: string
+;;
+;; the full name of the account in the current row. i.e., if
+;; the name of the account is "Assets:Current Assets:Cash",
+;; the value will be "Assets:Current Assets:Cash".
+;;
+;; account-name: string
+;;
+;; the "basename" of the account in the current row. i.e., if
+;; the name of the account is "Assets:Current Assets:Cash",
+;; the value will be "Cash".
+;;
+;; account-code: string
+;;
+;; the account of the account in the current row, as returned
+;; by gnc:account-get-code.
+;;
+;; account-anchor: text(maybe?)
+;;
+;; a link to the account in the current row
+;;
+;; account-label: string
+;;
+;; the text used to label the account in the current row. if
+;; account-label-mode is 'name, this consists of account-name
+;; prepended, if row-type is 'subtotal-row, by "Total ". if
+;; account-label-mode is 'anchor, this consists of
+;; account-anchor prepended, if row-type is 'subtotal-row, by
+;; "Total ".
+;;
+;; account-depth: integer
+;;
+;; the depth at which the account in the current row resides
+;; in the account tree. note that this may differ from
+;; display-depth when depth-limit-behavior is 'flatten.
+;; unlike in gnc:html-build-acct-table, the first level of
+;; accounts is level 0.
+;;
+;; logical-depth: integer
+;;
+;; the depth at which the account in the current row resides
+;; in the effective account tree. this is the depth the
+;; account tree when ignoring unselected parent accounts.
+;; note that this may differ from account-depth when a
+;; selected account has a deselected ancestor.
+;;
+;; display-depth: integer
+;;
+;; the depth at which the account in the current row resides
+;; in the display tree. note that this may differ from
+;; account-depth when depth-limit-behavior is 'flatten.
+;; unlike in gnc:html-build-acct-table, the first level of
+;; accounts is level 0. this means that display-depth is also
+;; the number of empty cells which should preceed the account
+;; name in the gnc:html-table being generated.
+;;
+;; indented-depth: integer
+;;
+;; the depth at which the account in the current row resides
+;; in the indented display tree. also account-depth plus
+;; indent.
+;;
+;; logical-cols: integer
+;;
+;; the number of columns in which account labels were placed.
+;;
+;; label-cols: integer
+;;
+;; the number of columns in the group of account columns to
+;; which a row was assigned. also one more than the maximum
+;; column depth at which rows were positioned in the
+;; table. this value may be different from logical-cols when
+;; parent-account-subtotal-mode is 'canonically-tabbed.
+;;
+;; account-cols: integer
+;;
+;; the number of columns in the group of account columns. if
+;; display-tree-depth is #f, this is the value of label-cols
+;; plus any indent. if display-tree-depth is set, this is the
+;; value of display-tree-depth, plus indent plus zero, if
+;; parent-account-subotal-mode is not 'canonically-tabbed, or,
+;; if parent-account-subtotal-mode is 'canonically-tabbed,
+;; plus one. dont you just love english?
+;;
+;; account-colspan: integer
+;;
+;; the number of table columns which the account label of the
+;; account in the current row should span in the
+;; gnc:html-table being generated.
+;;
+;; account-children: list of Accounts
+;;
+;; a list of all children of the account in the current row.
+;;
+;; account-bal: commodity-collector
+;;
+;; the balance of the account in the current row, exclusive of
+;; any balances in any subaccounts. this is for convenience.
+;;
+;; recursive-bal: commodity-collector
+;;
+;; the balance of the account in the current row, recursively
+;; including all balances in any *selected* subaccounts. this
+;; is for convenience.
+;;
+;; report-comm-account-bal: commodity-collector
+;;
+;; the balance of the account in the current row, exclusive of
+;; any balances in any subaccounts, converted to
+;; report-commodity using exchange-fn. this is for
+;; convenience.
+;;
+;; report-comm-recursive-bal: commodity-collector
+;;
+;; the balance of the account in the current row, recursively
+;; including all balances in any *selected* subaccounts,
+;; converted to report-commodity using exchange-fn. this is
+;; for convenience.
+;;
+;; account-commodity: commodity
+;;
+;; returns the default commodity of the account in the current
+;; row, as returned by gnc:account-get-commodity. the g-wrap
+;; documentation string reads: "Get the commodity in which the
+;; account is denominated." note: afaik, gnucash accounts can
+;; only contain one commodity; but it's plausible that future
+;; releases may permit mixed-commodity accounts, so it's
+;; probably safest not to assume that an account contains only
+;; its default commodity.
+;;
+;; row-type: 'account-row 'subtotal-row
+;;
+;; indicates the nature of the current row. 'account-row
+;; indicates that the current row represents an account
+;; balance. 'subtotal-row indicates that it represents a
+;; subtotal.
+;;
+;;
+;; DIFFERENCES FROM PARAMETERS USED BY gnc:html-build-acct-table
+;;
+;; The show-subaccounts? option of gnc:html-build-acct-table, which
+;; used to select an accounts recursively like the "-R" option to ls,
+;; has been removed. I find it both confusing, as a user, and
+;; obfuscating, as a programmer. Any accounts which are to be
+;; included in the report may be selected in the Accounts options
+;; widget. While, when selecting whole subtrees of accounts, this may
+;; be tedious, this really is a GUI problem. The ideal solution would
+;; be to give the Account selection widget a "recursively select"
+;; option which selects (i.e., hilights) both the account selected and
+;; all its subaccounts. Note that, as a worst-case workaround, the
+;; user could always use the spacebar and arrow keys to select entire
+;; subtrees rather rapidly. It order to make this shortcoming as
+;; benign as possible, reports are advised to make the default account
+;; selection that which is closest to what the report user is likely
+;; to select. It is my hope that a recursive account selection widget
+;; will soon be implemented.
+;;
+;; The group-types? option of gnc:html-build-acct-table, which
+;; would display accounts by account type and supply header and
+;; total lines for each type (see source), has been removed.
+;; It is easy enough to duplicate this functionality, report-side,
+;; using the new gnc:html-acct-table object.
+;;
+;; The start-percent and delta-percent options of
+;; gnc:html-build-acct-table, which told the function to
+;; gnc:report-percent-done start-percent to
+;; (start-percent+start-delta) percent of the progress bar, has been
+;; removed. Most of the report building is done while reading the
+;; gnc:html-acct-table object, anyway, so this is not a great loss.
+;; This functionality should, however, be included as the amount of
+;; work required to build an gnc:html-acct-table object is
+;; non-trivial. Being non-critical as it is, this is left as a future
+;; project. Since much of the code for this has already been written
+;; (in gnc:html-build-acct-table), when the time comes, this
+;; functionality should not be difficult to add.
+;;
+;;
+;; INTERNALS
+;;
+;; Internally, html-acct-table uses an html-table object to store
+;; data. Since the html-acct-table object is arguably a more general
+;; class than html-table, one might think that the html-table object
+;; should be written to use an html-acct-table for data storage,
+;; manipulation, and access. The html-table class, as it happens, was
+;; written first, so the decision was made to use it rather than
+;; redesign the horse around the carriage.
+;;
+;; It may also be possible to have made html-acct-table a markup/style
+;; sheet pair. To do this, the html-acct-table (which would
+;; essentially be a markup object) would have to store thunks and call
+;; them when rendering its contents to its parent html-doc. This
+;; means that report code would be called during stylization, rather
+;; than while building the report. Making html-acct-table a utility
+;; object means that one can use it in a report generator in a
+;; programmatic manner, keeping clear the separation between report
+;; generation and stylization.
+;;
+;; The first cell in each row of the html-table consist of an a-list
+;; of row-parameters. These parameters are described in PARAMETERS
+;; above. Any remaining cells in the row represent data set by the
+;; user. This class simply maps its contents to the html-table.
+;;
+
+;; this is to work around a bug in the HTML export sytmem
+;; which causes COLSPAN= attributes not to be exported (!!)
+(define gnc:colspans-are-working-right #f)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; <html-acct-table> class
+;; utility class for generating account tables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define <html-acct-table>
+ (make-record-type "<html-acct-table>"
+ '(matrix ;; an html-table
+ env ;; an alist
+ )))
+
+(define gnc:html-acct-table?
+ (record-predicate <html-acct-table>))
+
+(define gnc:_make-html-acct-table_
+ (record-constructor <html-acct-table>))
+
+(define (gnc:make-html-acct-table)
+ (gnc:_make-html-acct-table_
+ (gnc:make-html-table) ;; matrix
+ #f ;; env
+ ))
+
+(define (gnc:make-html-acct-table/env env)
+ (let ((acct-table (gnc:make-html-acct-table)))
+ (gnc:html-acct-table-set-env! acct-table env)
+ acct-table))
+
+(define (gnc:make-html-acct-table/env/accts env accts)
+ (let ((acct-table (gnc:make-html-acct-table)))
+ ;; the env must be set *before* the accounts... because the env
+ ;; parameter end-date is required by
+ ;; gnc:html-acct-table-add-accounts!.
+ (gnc:_html-acct-table-set-env!_ acct-table env)
+ (gnc:html-acct-table-add-accounts! acct-table accts)
+ acct-table))
+
+(define gnc:_html-acct-table-matrix_
+ (record-accessor <html-acct-table> 'matrix))
+
+(define gnc:_html-acct-table-set-matrix!_
+ (record-modifier <html-acct-table> 'matrix))
+
+(define gnc:_html-acct-table-env_
+ (record-accessor <html-acct-table> 'env))
+
+(define gnc:_html-acct-table-set-env!_
+ (record-modifier <html-acct-table> 'env))
+
+;; some useful predicates to export
+(define (gnc:account-code-less-p a b)
+ (string<? (gnc:account-get-code a)
+ (gnc:account-get-code b)))
+(define (gnc:account-name-less-p a b)
+ (string<? (gnc:account-get-name a)
+ (gnc:account-get-name b)))
+(define (gnc:account-path-less-p a b)
+ (string<? (gnc:account-get-full-name a)
+ (gnc:account-get-full-name b)))
+
+(define (gnc:html-acct-table-add-accounts! acct-table accounts)
+ ;;
+ ;; This is where most of the html-acct-table functionality ends up....
+ ;;
+ ;; This function traverses the (current) account tree, adding
+ ;; information about the selected accounts to acct-table.
+ ;;
+
+ ;; helper for fetching values from the key/val environment alist
+ (define (get-val alist key)
+ (let ((lst (assoc-ref alist key)))
+ (if lst (car lst) lst)))
+
+ ;; helper to plop <env> in the next available env cell
+ (define (add-row env)
+ (let ((html-table (gnc:_html-acct-table-matrix_ acct-table)))
+ (gnc:html-table-set-cell!
+ html-table
+ (gnc:html-table-num-rows html-table)
+ 0
+ env)
+ )
+ )
+
+ (let* ((env (gnc:_html-acct-table-env_ acct-table))
+ ;; establish all input parameters and their defaults
+ (depth-limit (let ((lim (get-val env 'display-tree-depth)))
+ (if (or (equal? lim 'unlimited)
+ (equal? lim 'all))
+ #f
+ lim)))
+ (limit-behavior (or (get-val env 'depth-limit-behavior) 'summarize))
+ (indent (or (get-val env 'initial-indent) 0))
+ (less-p (let ((pred (get-val env 'account-less-p)))
+ (if (equal? pred #t) gnc:account-code-less-p pred)))
+ (start-date (get-val env 'start-date))
+ (end-date (or (get-val env 'end-date)
+ (cons 'absolute (cons (current-time) 0))))
+ (report-commodity (or (get-val env 'report-commodity)
+ (gnc:default-report-currency)))
+ (exchange-fn (or (get-val env 'exchange-fn)
+ 'weighted-average))
+ (column-header (let ((cell (get-val env 'column-header)))
+ (if (equal? cell #t)
+ (gnc:make-html-table-cell "Account name")
+ cell)))
+ (subtotal-mode (get-val env 'parent-account-subtotal-mode))
+ (zero-mode (let ((mode (get-val env 'zero-balance-mode)))
+ (or (if (equal? mode #t) 'show-leaf-acct mode)
+ 'show-leaf-acct)
+ ))
+ (label-mode (or (get-val env 'account-label-mode) 'anchor))
+ ;; local variables
+ (toplvl-accts (gnc:group-get-account-list (gnc:get-current-group)))
+ (acct-depth-reached 0)
+ (logi-depth-reached (if depth-limit (- depth-limit 1) 0))
+ (disp-depth-reached 0)
+ )
+
+ (define (traverse-accounts! accts acct-depth logi-depth)
+
+ (define (use-acct? acct)
+ (and (or (equal? limit-behavior 'flatten) (< logi-depth depth-limit))
+ (member acct accounts)
+ )
+ )
+
+ ;; the following two functions were lifted directly
+ ;; from html-utilities.scm
+ (define (my-get-balance-nosub account start-date end-date)
+ (if start-date
+ (gnc:account-get-comm-balance-interval
+ account start-date end-date #f)
+ (gnc:account-get-comm-balance-at-date
+ account end-date #f)))
+
+ ;; Additional function that includes the subaccounts as
+ ;; well. Note: It is necessary to define this here (instead of
+ ;; changing an argument for account-get-balance) because the
+ ;; use-acct? query is needed.
+ (define (my-get-balance account start-date end-date)
+ ;; this-collector for storing the result
+ (let ((this-collector
+ (my-get-balance-nosub account start-date end-date)))
+ (for-each
+ (lambda (x) (if x (gnc:commodity-collector-merge this-collector x)))
+ (gnc:group-map-all-accounts
+ (lambda (a)
+ ;; Important: Calculate the balance if and only if the
+ ;; account a is shown, i.e. (use-acct? a) == #t.
+ (and (use-acct? a)
+ (my-get-balance-nosub a start-date end-date)))
+ (gnc:account-get-children account)))
+ this-collector))
+
+ (let ((disp-depth
+ (if (integer? depth-limit)
+ (min (- depth-limit 1) logi-depth)
+ logi-depth))
+ )
+
+ (for-each
+ (lambda (acct)
+ (let* ((subaccts
+ (gnc:account-get-immediate-subaccounts acct))
+ ;; assign output parameters
+ (account acct)
+ (account-name (gnc:account-get-name acct))
+ (account-code (gnc:account-get-code acct))
+ (account-path (gnc:account-get-full-name acct))
+ (account-anchor (gnc:html-account-anchor acct))
+ (account-parent (gnc:account-get-parent-account acct))
+ (account-children subaccts)
+ (account-depth acct-depth)
+ (logical-depth logi-depth)
+ (account-commodity (gnc:account-get-commodity acct))
+ (account-bal (my-get-balance-nosub
+ acct start-date end-date))
+ (recursive-bal
+ (my-get-balance acct start-date end-date))
+ (report-comm-account-bal
+ (gnc:sum-collector-commodity
+ account-bal report-commodity exchange-fn))
+ (report-comm-recursive-bal
+ (gnc:sum-collector-commodity
+ recursive-bal report-commodity exchange-fn))
+ (grp-env
+ (append env
+ (list
+ (list 'initial-indent indent)
+ (list 'account account)
+ (list 'account-name account-name)
+ (list 'account-code account-code)
+ (list 'account-path account-path)
+ (list 'account-parent account-parent)
+ (list 'account-children account-children)
+ (list 'account-depth account-depth)
+ (list 'logical-depth logical-depth)
+ (list 'account-commodity account-commodity)
+ (list 'account-anchor account-anchor)
+ (list 'account-bal account-bal)
+ (list 'recursive-bal recursive-bal)
+ (list 'report-comm-account-bal
+ report-comm-account-bal)
+ (list 'report-comm-recursive-bal
+ report-comm-recursive-bal)
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ )))
+ (row-env #f)
+ (label (or (and (equal? label-mode 'anchor)
+ account-anchor)
+ (and (equal? label-mode 'name)
+ (gnc:make-html-text account-name))
+ ))
+ )
+ (set! acct-depth-reached (max acct-depth-reached acct-depth))
+ (set! logi-depth-reached (max logi-depth-reached logi-depth))
+ (set! disp-depth-reached (max disp-depth-reached disp-depth))
+ (or (not (use-acct? acct))
+ ;; ok, so we'll consider parent accounts with zero
+ ;; recursive-bal to be zero balance leaf accounts
+ (and (gnc:commodity-collector-allzero? recursive-bal)
+ (equal? zero-mode 'omit-leaf-acct))
+ (begin
+ (set! row-env
+ (append grp-env
+ (list
+ (list 'account-label label)
+ (list 'row-type 'account-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth
+ (+ disp-depth indent))
+ )
+ ))
+ (add-row row-env)
+ )
+ )
+ ;; Dive into an account even if it isnt selected!
+ (traverse-accounts! subaccts
+ (+ acct-depth 1)
+ (if (use-acct? acct)
+ (+ logi-depth 1)
+ logi-depth)
+ )
+ (or (not (use-acct? acct))
+ (not subtotal-mode)
+ ;; ignore use-acct for subtotals...
+ ;; (not (use-acct acct))
+ (null? subaccts)
+ (let* ((lbl-txt (gnc:make-html-text (_ "Total") " ")))
+ (apply gnc:html-text-append! lbl-txt
+ (gnc:html-text-body label))
+ (if (equal? subtotal-mode 'canonically-tabbed)
+ (set! disp-depth (+ disp-depth 1))
+ (set! disp-depth-reached
+ (max disp-depth-reached disp-depth))
+ )
+ (set! row-env
+ (append grp-env
+ (list
+ (list 'account-label lbl-txt)
+ (list 'row-type 'subtotal-row)
+ (list 'display-depth disp-depth)
+ (list 'indented-depth
+ (+ disp-depth indent))
+ )
+ ))
+ (add-row row-env)
+ )
+ )
+ ))
+ (if less-p
+ (sort accts less-p)
+ accts)
+ ))
+ )
+
+ ;; do it
+ (traverse-accounts! toplvl-accts 0 0)
+
+ ;; set the column-header colspan
+ (if gnc:colspans-are-working-right
+ (if (gnc:html-table-cell? column-header)
+ (gnc:html-table-cell-set-colspan! column-header
+ (+ disp-depth-reached 1 indent))
+ )
+ )
+
+ ;; now set the account-colspan entries
+ ;; he he... (let ((x 0)) (while (< x 5) (display x) (set! x (+ x 1))))
+ ;; now I know how to loop in scheme... yay!
+ (let ((row 0)
+ (rows (gnc:html-acct-table-num-rows acct-table)))
+ (while (< row rows)
+ (let* ((orig-env
+ (gnc:html-acct-table-get-row-env acct-table row))
+ (display-depth (get-val orig-env 'display-depth))
+ (depth-limit (get-val orig-env 'display-tree-depth))
+ (indent (get-val orig-env 'initial-indent))
+ (indented-depth (get-val orig-env 'indented-depth))
+ (subtotal-mode
+ (get-val orig-env 'parent-account-subtotal-mode))
+ (label-cols (+ disp-depth-reached 1))
+ (logical-cols (if depth-limit
+ (min
+ (+ logi-depth-reached 1)
+ depth-limit)
+ (+ logi-depth-reached 1)))
+ (colspan (- label-cols display-depth))
+ ;; these parameters *should* always, by now, be set...
+ (new-env
+ (append
+ orig-env
+ (list
+ (list 'account-colspan colspan)
+ (list 'label-cols label-cols)
+ (list 'logical-cols logical-cols)
+ (list 'account-cols
+ (+ indent
+ (max label-cols
+ (if depth-limit depth-limit 0)
+ )
+ )
+ )
+ )
+ ))
+ )
+ (gnc:html-acct-table-set-row-env! acct-table row new-env)
+ (set! row (+ row 1))))
+ )
+
+ ;; done
+
+ )
+ )
+
+(define (gnc:html-acct-table-num-rows acct-table)
+ (gnc:html-table-num-rows (gnc:_html-acct-table-matrix_ acct-table)))
+
+(define (gnc:html-acct-table-num-cols acct-table)
+ (- (gnc:html-table-num-cols (gnc:_html-acct-table-matrix_ acct-table)) 1))
+
+(define (gnc:html-acct-table-get-cell acct-table row col)
+ ;; we'll only ever store one object in an html-table-cell
+ ;; returns the first object stored in that cell
+ (car (gnc:html-table-cell-data
+ (gnc:html-table-get-cell
+ (gnc:_html-acct-table-matrix_ acct-table)
+ row (+ col 1)))))
+
+(define (gnc:html-acct-table-set-cell! acct-table row col obj)
+ (gnc:html-table-set-cell!
+ (gnc:_html-acct-table-matrix_ acct-table)
+ row (+ col 1)
+ obj))
+
+(define (gnc:html-acct-table-get-row-env acct-table row)
+ (gnc:html-acct-table-get-cell acct-table row -1))
+
+(define (gnc:html-acct-table-set-row-env! acct-table row env)
+ (gnc:html-acct-table-set-cell! acct-table row -1 env))
+
+(define (gnc:html-acct-table-append-row acct-table objects)
+ (gnc:html-table-append-row!
+ (gnc:_html-acct-table-matrix_ acct-table)
+ (map
+ (lambda (x) (gnc:make-html-table-cell (list x)))
+ objects)))
+
+(define (gnc:html-acct-table-prepend-row! acct-table newrow)
+ (gnc:html-table-prepend-row!
+ (gnc:_html-acct-table-matrix_ acct-table)
+ (map
+ (lambda (x) (gnc:make-html-table-cell (list x)))
+ objects)))
+
+(define (gnc:html-acct-table-append-col acct-table objects)
+ (gnc:html-table-append-col!
+ (gnc:_html-acct-table-matrix_ acct-table)
+ (map
+ (lambda (x) (gnc:make-html-table-cell (list x)))
+ objects)))
+
+(define (gnc:html-acct-table-prepend-col! acct-table newrow)
+ (gnc:html-table-prepend-col!
+ (gnc:_html-acct-table-matrix_ acct-table)
+ (map
+ (lambda (x) (gnc:make-html-table-cell (list x)))
+ objects)))
+
+(define (gnc:html-acct-table-remove-last-row! acct-table)
+ (gnc:html-table-remove-last-row! (gnc:_html-acct-table-matrix_ acct-table)))
+
+(define (gnc:identity i) i)
+
+(define (gnc:html-acct-table-render acct-table doc)
+ ;; this will be used if we ever decide to let the utility object
+ ;; render a document by calling thunks registered in the row-envs...
+ ;; but, for now, this (optional) feature is left unimplemented...
+ #f
+ )
+
+;;
+;; Here are some standard functions to help process gnc:html-acct-tables.
+;;
+
+;; Stylesheets define the following cell styles which these functions
+;; use: "text-cell" "total-label-cell" "number-cell"
+;; "total-number-cell". Row styles include "normal-row",
+;; "alternate-row", "primary-subheading", "secondary-subheading", and
+;; "grand-total". there really should also be a "first-number-cell"
+;; and "last-number-cell" to put currency symbols and underlines,
+;; respectively, on the numbers.
+
+(define (gnc:html-table-add-labeled-amount-line!
+ html-table table-width row-markup total-rule?
+ label label-depth label-colspan label-markup
+ amount amount-depth amount-colspan amount-markup)
+ ;; function to add a label and/or amount (which we'll call a "line")
+ ;; to a gnc:html-table. all depths are zero-indexed.
+ ;; if total-rule?, an <hr> is placed in the cell previous to label
+ (let* ((lbl-depth (or label-depth 0))
+ (lbl-colspan (if gnc:colspans-are-working-right
+ (or label-colspan 1)
+ 1))
+ (amt-depth (or amount-depth (+ lbl-depth lbl-colspan)))
+ (amt-colspan (if gnc:colspans-are-working-right
+ (or amount-colspan 1)
+ 1))
+ (tbl-width (or table-width (+ amt-depth amt-colspan)))
+ (row
+ (append
+ (gnc:html-make-empty-cells lbl-depth)
+ (list
+ (if label-markup
+ (gnc:make-html-table-cell/size/markup
+ 1 lbl-colspan label-markup label)
+ (gnc:make-html-table-cell/size
+ 1 lbl-colspan label))
+ )
+ (gnc:html-make-empty-cells
+ (+ (- amt-depth (+ lbl-depth lbl-colspan))
+ (if total-rule? -1 0)
+ ))
+ (if total-rule?
+ (list (gnc:make-html-table-cell
+ (gnc:make-html-text (gnc:html-markup-hr))))
+ (list)
+ )
+ (list
+ (if amount-markup
+ (gnc:make-html-table-cell/size/markup
+ 1 amt-colspan amount-markup amount)
+ (gnc:make-html-table-cell/size
+ 1 amt-colspan amount))
+ )
+ (gnc:html-make-empty-cells
+ (- table-width (+ amt-depth amt-colspan)))
+ ))
+ )
+ (if row-markup
+ (gnc:html-table-append-row/markup! html-table row-markup row)
+ (gnc:html-table-append-row! html-table row))))
+
+(define (gnc:commodity-table amount report-commodity exchange-fn)
+ ;; this creates a small two-column table listing each commodity
+ ;; balance and its respective report balance. note that this
+ ;; shows report-commodity amounts twice: first as a commodity
+ ;; and second in the report commodity. though this may arguably
+ ;; be a bit redundant, i beleive that it makes the report more
+ ;; readable.
+ (let* ((table (gnc:make-html-table))
+ )
+ (gnc:commodity-collector-map
+ amount
+ (lambda (curr val)
+ (let ((bal (gnc:make-gnc-monetary curr val)))
+ (gnc:html-table-append-row!
+ table
+ (list
+ ;; add the account balance in the respective commodity
+ (gnc:make-html-table-cell/markup
+ "number-cell" bal)
+ ;; add the account balance in the report commodity
+ (gnc:make-html-table-cell/markup
+ "number-cell" (exchange-fn bal report-commodity))
+ )
+ )
+ )))
+ table)
+ )
+
+(define (gnc:uniform-commodity? amt report-commodity)
+ ;; function to see if the commodity-collector amt
+ ;; contains any foreign commodities
+ (lambda (amt)
+ (let ((elts (gnc:commodity-collector-commodity-count amt))
+ )
+ (or (equal? elts 0)
+ (and (equal? elts 1)
+ (gnc:commodity-collector-contains-commodity?
+ amt report-commodity)
+ )
+ )
+ )
+ ))
+
+;;
+;; This function adds all the lines from a gnc:html-acct-table to a
+;; gnc:html-table in "labeled amount" form.
+;;
+;; The resulting gnc:html-table is similar to what
+;; gnc:html-build-acct-table used to (and still should) produce.
+;;
+;; this function accepts the following additional parameters:
+;; parent-account-balance-mode: 'immediate-bal 'recursive-bal ['omit-bal/#f]
+;; zero-balance-display-mode: ['show-balance] 'omit-balance
+;; multicommodity-mode: [#f] 'table/#t
+;; rule-mode: #t [#f]
+;;
+(define (gnc:html-table-add-account-balances html-table acct-table params)
+ (let* ((num-rows (gnc:html-acct-table-num-rows acct-table))
+ (rownum 0)
+ (html-table (or html-table (gnc:make-html-table)))
+ (get-val (lambda (alist key)
+ (let ((lst (assoc-ref alist key)))
+ (if lst (car lst) lst))))
+ )
+
+ (while (< rownum num-rows)
+ (let* ((env (append
+ (gnc:html-acct-table-get-row-env acct-table rownum)
+ params))
+ (acct (get-val env 'account))
+ (children (get-val env 'account-children))
+ (label (get-val env 'account-label))
+ (acct-name (get-val env 'account-name)) ;; for diagnostics...
+ (report-commodity (get-val env 'report-commodity))
+ (exchange-fn (get-val env 'exchange-fn))
+ (account-cols (get-val env 'account-cols))
+ (logical-cols (get-val env 'logical-cols))
+ (label-cols (get-val env 'label-cols))
+ (logical-depth (get-val env 'logical-depth))
+ (display-depth (get-val env 'display-depth))
+ (display-tree-depth (get-val env 'display-tree-depth))
+ (subtotal-mode (get-val env 'subtotal-mode))
+ (row-type (get-val env 'row-type))
+ (rule-mode (and (equal? row-type 'subtotal-row)
+ (get-val env 'rule-mode)))
+ (multicommodity-mode (get-val env 'multicommodity-mode))
+ (limit-behavior
+ (or (get-val env 'depth-limit-behavior)
+ 'summarize))
+ (parent-acct-bal-mode
+ (or (get-val env 'parent-account-balance-mode)
+ 'omit-bal))
+ (bal-method
+ ;; figure out how to calculate our balance:
+ ;; 'immediate-bal|'recursive-bal|'omit-bal
+ (or (and (equal? row-type 'subtotal-row) 'recursive-bal)
+ (and (equal? (+ display-depth 1) display-tree-depth)
+ (if (equal? limit-behavior 'truncate)
+ 'immediate-bal
+ ;; 'summarize, 'flatten, and unknown
+ ;; depth limit behaviors yield
+ ;; 'recursive-bal. this is true
+ ;; whether a leaf account or not.
+ 'recursive-bal)
+ )
+ (if (null? children) #f parent-acct-bal-mode)
+ 'immediate-bal
+ )
+ )
+ (comm-amt
+ ;; this will be the immediate/recursize commodity
+ ;; balance or #f
+ (get-val env
+ (car (or (assoc-ref
+ '((immediate-bal account-bal)
+ (recursive-bal recursive-bal)
+ (omit-bal #f))
+ bal-method)
+ '(#f)
+ ))))
+ (zero-mode (let ((mode
+ (get-val
+ env 'zero-balance-display-mode)))
+ (or (if (equal? mode #t) 'show-balance mode)
+ 'show-balance)
+ ))
+ (reverse-balance (gnc:account-reverse-balance? acct))
+ (native-comm?
+ (lambda (amt)
+ (gnc:uniform-commodity? amt report-commodity)))
+ (amount (and comm-amt
+ (if (and (equal? zero-mode 'omit-balance)
+ (gnc:commodity-collector-allzero? comm-amt)
+ )
+ #f
+ ;; otherwise
+ (let*
+ ((amt (gnc:make-commodity-collector)))
+ (if reverse-balance
+ (amt 'minusmerge comm-amt #f)
+ (set! amt comm-amt))
+ (or (and (native-comm? amt)
+ (gnc:sum-collector-commodity
+ amt
+ report-commodity
+ exchange-fn)
+ )
+ (if (and (equal?
+ multicommodity-mode 'table)
+ (equal?
+ row-type 'account-row)
+ )
+ (gnc:commodity-table
+ amt
+ report-commodity
+ exchange-fn)
+ (gnc:sum-collector-commodity
+ amt
+ report-commodity
+ exchange-fn)
+ )
+ )
+ )
+ )
+ ))
+ (indented-depth (get-val env 'indented-depth))
+ (account-colspan (get-val env 'account-colspan))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ html-table
+ (+ account-cols logical-cols)
+ #f rule-mode
+ label indented-depth account-colspan #f ;"label-cell"
+ amount
+ (+ account-cols (- 0 1)
+ (- logical-cols display-depth)
+ ;; account for 'immediate-bal parents displaying children
+ ;; NOTE: before you go mucking with this, BE ABSOLUTELY
+ ;; SURE you know what youre doing... i spent A LOT of
+ ;; time trying to make sure this is right. i know, in
+ ;; some reports, the output might look incorrect. but,
+ ;; if you think long and hard about it, i think you'll
+ ;; find the current treatment correct... i think. -DM-
+ (- 0 (if (if (null? children)
+ #f
+ (equal? bal-method 'immediate-bal))
+ 1 0)
+ )
+ (if (equal? subtotal-mode 'canonically-tabbed) 1 0)
+ )
+ 1 "number-cell")
+ (set! rownum (+ rownum 1))
+ )
+ )
+ html-table
+ )
+ )
+
+(define (gnc:second-html-build-acct-table
+ start-date end-date
+ tree-depth show-subaccts? accounts
+ start-percent delta-percent
+ show-col-headers?
+ show-total? get-total-fn
+ total-name group-types? show-parent-balance? show-parent-total?
+ show-other-curr? report-commodity exchange-fn show-zero-entries?)
+ ;; THIS NEW FUNCTION DOES NOT IMPLEMENT SOME FEATURES OF THE OLD ONE
+ ;; of these options: start-percent/delta-percent, the balance column
+ ;; header, show-total?/get-total-fn/total-name, and group-types? are
+ ;; presently unimplemented. many of these functions are better left
+ ;; to the renderer, anyway. but if you *really* need them, you may
+ ;; still use gnc:first-html-build-acct-table.
+ (let* ((env (list
+ (list 'start-date start-date)
+ (list 'end-date end-date)
+ (list 'display-tree-depth tree-depth)
+ ;;(list 'progress-start-percent start-percent)
+ ;;(list 'progress-length-percent delta-percent)
+ (list 'column-header show-col-headers?)
+ (list 'parent-account-subtotal-mode show-parent-total?)
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ (list 'zero-balance-display-mode
+ (if show-zero-entries?
+ 'show-balance
+ 'omit-balance))
+ ))
+ (html-table (gnc:make-html-table))
+ (acct-table (gnc:make-html-acct-table/env/accts env accounts))
+ (params (list
+ (list 'parent-account-balance-mode
+ (if show-parent-balance? 'immediate-bal))
+ ))
+ )
+ (gnc:html-table-add-account-balances html-table acct-table params)
+ html-table
+ ))
+
+;; END
+
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/Makefile.am,v
retrieving revision 1.12
retrieving revision 1.13
diff -Lsrc/report/report-system/Makefile.am -Lsrc/report/report-system/Makefile.am -u -r1.12 -r1.13
--- src/report/report-system/Makefile.am
+++ src/report/report-system/Makefile.am
@@ -46,6 +46,7 @@
gncscmdir = ${GNC_SHAREDIR}/scm
gncscm_DATA = \
commodity-utilities.scm \
+ html-acct-table.scm \
html-barchart.scm \
html-document.scm \
html-piechart.scm \
Index: report-html.txt
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/report-system/doc/report-html.txt,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lsrc/report/report-system/doc/report-html.txt -Lsrc/report/report-system/doc/report-html.txt -u -r1.1 -r1.2
--- src/report/report-system/doc/report-html.txt
+++ src/report/report-system/doc/report-html.txt
@@ -202,7 +202,7 @@
- the HTML tag to render (specified by 'tag). Note that this
may be different from the tag used to look up the style (the
- one passed to html-markup).
+ one passed to html-markup). (See NB below.)
- Any attributes to be used inside the start tag (listed
individually as 'attribute (list name value))
- The font face to use in the body ('font-face)
@@ -259,6 +259,7 @@
;; object is rendered.
(gnc:html-text-set-style! txt
"bigred" 'tag "" 'font-color "ff0000" 'font-size 7)
+ ;; ^^ NB: "bigred" is the tag. 'tag "" is the info in the style table.
(gnc:html-document-add-object! doc txt)
(gnc:html-document-render doc))
Index: standard-reports.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/standard-reports.scm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Lsrc/report/standard-reports/standard-reports.scm -Lsrc/report/standard-reports/standard-reports.scm -u -r1.15 -r1.16
--- src/report/standard-reports/standard-reports.scm
+++ src/report/standard-reports/standard-reports.scm
@@ -71,6 +71,7 @@
(use-modules (gnucash report advanced-portfolio))
(use-modules (gnucash report average-balance))
(use-modules (gnucash report balance-sheet))
+(use-modules (gnucash report equity-statement))
(use-modules (gnucash report cash-flow))
(use-modules (gnucash report category-barchart))
(use-modules (gnucash report daily-reports))
Index: Makefile.am
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/Makefile.am,v
retrieving revision 1.14
retrieving revision 1.15
diff -Lsrc/report/standard-reports/Makefile.am -Lsrc/report/standard-reports/Makefile.am -u -r1.14 -r1.15
--- src/report/standard-reports/Makefile.am
+++ src/report/standard-reports/Makefile.am
@@ -30,6 +30,7 @@
cash-flow.scm \
category-barchart.scm \
daily-reports.scm \
+ equity-statement.scm \
net-barchart.scm \
pnl.scm \
portfolio.scm \
Index: balance-sheet.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/report/standard-reports/balance-sheet.scm,v
retrieving revision 1.15
retrieving revision 1.16
diff -Lsrc/report/standard-reports/balance-sheet.scm -Lsrc/report/standard-reports/balance-sheet.scm -u -r1.15 -r1.16
--- src/report/standard-reports/balance-sheet.scm
+++ src/report/standard-reports/balance-sheet.scm
@@ -1,8 +1,50 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; balance-sheet.scm: balance sheet
+;; balance-sheet.scm: balance sheet
;;
;; By Robert Merkel <rgmerk at mira.net>
;;
+;; Heavily modified and Frankensteined by David Montenegro
+;; 2004.06.12-2004.06.23 <sunrise2000 at comcast.net>
+;;
+;; * Removed from-date & Net Profit from the report.
+;;
+;; * Updated to use the new gnc:html-acct-table utility object.
+;; Added *lots* of new options. The report can now probably
+;; be coerced into the form that *you* want. <grin>
+;;
+;; * BUGS:
+;;
+;; The Accounts option panel needs a way to select (and select by
+;; default) accounts representative of current & fixed assets &
+;; liabilities.
+;;
+;; There are some gnc:html-acct-table options which remain unused,
+;; mostly because I don't know how to make drop-down option
+;; controls.
+;;
+;; This code makes the assumption that you want your equity
+;; statement to no more than daily resolution.
+;;
+;; The Company Name field does not currently default to the name
+;; in (gnc:get-current-book).
+;;
+;; Line & column alignments still do not conform with
+;; textbook accounting practice (they're close though!).
+;;
+;; Progress bar functionality is currently mostly broken.
+;;
+;; The variables in this code could use more consistent naming.
+;;
+;; I'm not sure if I got (_ ) vs (N_ ) right. (What are they?)
+;;
+;; The multicurrency support has been tested, BUT IS ALPHA. I
+;; *think* it works right, but can make no guarantees.... In
+;; particular, I have made the educated assumption <grin> that a
+;; decrease in the value of a liability or equity also represents
+;; an unrealized loss. I *think* that is right, but am not sure.
+;;
+;; See also all the "FIXME"s in the code.
+;;
;; Largely borrowed from pnl.scm by:
;; Christian Stimming <stimming at tu-harburg.de>
;;
@@ -30,59 +72,110 @@
(use-modules (ice-9 slib))
(use-modules (gnucash gnc-module))
-(require 'printf)
-
(gnc:module-load "gnucash/report/report-system" 0)
(define reportname (N_ "Balance Sheet"))
-;; define all option's names so that they are properly defined
-;; in *one* place.
-(define optname-from-date (N_ "From"))
-(define optname-to-date (N_ "To"))
-
-(define optname-display-depth (N_ "Account Display Depth"))
-(define optname-show-subaccounts (N_ "Always show sub-accounts"))
-(define optname-accounts (N_ "Account"))
-
-(define optname-show-parent-balance (N_ "Show balances for parent accounts"))
-(define optname-show-parent-total (N_ "Show subtotals"))
+;; define all option's names and help text so that they are properly
+;; defined in *one* place.
+(define optname-report-title (N_ "Report Title"))
+(define opthelp-report-title (N_ "Title for this report"))
+
+(define optname-party-name (N_ "Company name"))
+(define opthelp-party-name (N_ "Name of company/individual"))
+
+(define optname-date (N_ "Balance Sheet Date"))
+(define opthelp-date (N_ "Balance sheet as-of date"))
+(define optname-report-form (N_ "Report form Balance Sheet"))
+(define opthelp-report-form
+ (N_ "Create report in report (as opposed to report) form"))
+;; FIXME this needs an indent option
+
+(define optname-accounts (N_ "Accounts to include"))
+(define opthelp-accounts
+ (N_ "Report on these accounts, if display depth allows."))
+(define optname-depth-limit (N_ "Levels of Subaccounts"))
+(define opthelp-depth-limit
+ (N_ "Maximum number of levels in the account tree displayed"))
+(define optname-bottom-behavior (N_ "Flatten list to depth limit"))
+(define opthelp-bottom-behavior
+ (N_ "Displays accounts which exceed the depth limit at the depth limit"))
+
+(define optname-show-parent-balance (N_ "Show any balance in parent accounts"))
+(define opthelp-show-parent-balance (N_ "Show any balance in parent accounts"))
+;; FIXME optname-show-parent-balance needs immediate/recursive/omit choices
+(define optname-show-parent-total (N_ "Show parent account subtotals"))
+(define opthelp-show-parent-total
+ (N_ "Show account subtotals for all selected accounts having children"))
+;; FIXME optname-show-parent-total needs a 'canonically-tabbed choice
+
+(define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
+(define opthelp-show-zb-accts
+ (N_ "Include accounts with zero total (recursive) balances in this report"))
+(define optname-omit-zb-bals (N_ "Omit zero balance figures"))
+(define opthelp-omit-zb-bals
+ (N_ "Show blank space in place of any zero balances which would be shown"))
+
+(define optname-use-rules (N_ "Show accounting-style rules"))
+(define opthelp-use-rules
+ (N_ "Use rules beneath columns of added numbers like accountants do"))
+
+(define optname-account-links (N_ "Display accounts as hyperlinks"))
+(define opthelp-account-links (N_ "Shows each account in the table as a hyperlink to its register window"))
+
+(define optname-label-assets (N_ "Label the assets section"))
+(define opthelp-label-assets
+ (N_ "Whether or not to include a label for the assets section"))
+(define optname-total-assets (N_ "Include assets total"))
+(define opthelp-total-assets
+ (N_ "Whether or not to include a line indicating total assets"))
+(define optname-label-liabilities (N_ "Label the liabilities section"))
+(define opthelp-label-liabilities
+ (N_ "Whether or not to include a label for the liabilities section"))
+(define optname-total-liabilities (N_ "Include liabilities total"))
+(define opthelp-total-liabilities
+ (N_ "Whether or not to include a line indicating total liabilities"))
+(define optname-label-equity (N_ "Label the equity section"))
+(define opthelp-label-equity
+ (N_ "Whether or not to include a label for the equity section"))
+(define optname-total-equity (N_ "Include equity total"))
+(define opthelp-total-equity
+ (N_ "Whether or not to include a line indicating total equity"))
-(define optname-report-currency (N_ "Report's currency"))
+(define pagename-commodities (N_ "Commodities"))
+(define optname-report-commodity (N_ "Report's currency"))
(define optname-price-source (N_ "Price Source"))
(define optname-show-foreign (N_ "Show Foreign Currencies"))
+(define opthelp-show-foreign
+ (N_ "Display any foreign currency amount in an account"))
(define optname-show-rates (N_ "Show Exchange Rates"))
-(define optname-show-zeros (N_ "Show accounts with zero balance"))
+(define opthelp-show-rates (N_ "Show the exchange rates used"))
-;; Moderatly ugly hack here, i.e. this depends on the internal
-;; structure of html-table -- if that is changed, this might break.
-(define (html-table-merge t1 t2)
- (begin
- (gnc:html-table-set-data! t1
- (append
- (gnc:html-table-data t2)
- (gnc:html-table-data t1)))
- (gnc:html-table-set-num-rows-internal!
- t1 (+ (gnc:html-table-num-rows t1)
- (gnc:html-table-num-rows t2)))))
-
-(define (accountlist-get-comm-balance-at-date accountlist from date)
+;; This calculates the increase in the balance(s) of all accounts in
+;; <accountlist> over the period from <from-date> to <to-date>.
+;; Returns a commodity collector.
+;;
+;; Note: There is both a gnc:account-get-comm-balance-interval and
+;; gnc:group-get-comm-balance-interval which could replace this
+;; function....
+;;
+(define (accountlist-get-comm-balance-at-date accountlist from-date to-date)
;; (for-each (lambda (x) (display x))
-;; (list "computing from: " (gnc:print-date from) " to "
-;; (gnc:print-date date) "\n"))
+;; (list "computing from: " (gnc:print-date from-date) " to "
+;; (gnc:print-date to-date) "\n"))
(let ((collector (gnc:make-commodity-collector)))
(for-each (lambda (account)
(let* (
(start-balance
(gnc:account-get-comm-balance-at-date
- account from #f))
+ account from-date #f))
(sb (cadr (start-balance
'getpair
(gnc:account-get-commodity account)
#f)))
(end-balance
(gnc:account-get-comm-balance-at-date
- account date #f))
+ account to-date #f))
(eb (cadr (end-balance
'getpair
(gnc:account-get-commodity account)
@@ -100,371 +193,596 @@
;; options generator
(define (balance-sheet-options-generator)
- (let ((options (gnc:new-options)))
-
+ (let* ((options (gnc:new-options))
+ (add-option
+ (lambda (new-option)
+ (gnc:register-option options new-option))))
+
+ (add-option
+ (gnc:make-string-option
+ (N_ "General") optname-report-title
+ "a" opthelp-report-title reportname))
+ (add-option
+ (gnc:make-string-option
+ (N_ "General") optname-party-name
+ "b" opthelp-party-name (N_ "")))
+ ;; this should default to company name in (gnc:get-current-book)
+ ;; does anyone know the function to get the company name??
+ ;; (GnuCash is *so* well documented... sigh)
+
;; date at which to report balance
- (gnc:options-add-date-interval!
- options gnc:pagename-general
- optname-from-date optname-to-date "a")
-
+ (add-option
+ (gnc:make-date-option
+ (N_ "General") optname-date
+ "c" opthelp-date
+ (lambda () (cons 'absolute (cons (current-time) 0)))
+ #f 'both '(start-cal-year start-prev-year end-prev-year) ))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-general optname-report-form
+ "d" opthelp-report-form #t))
+
+ ;; accounts to work on
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "a"
+ opthelp-accounts
+ (lambda ()
+ (gnc:filter-accountlist-type
+ '(bank cash credit asset liability stock mutual-fund currency
+ payable receivable equity income expense)
+ (gnc:group-get-subaccounts (gnc:get-current-group))))
+ #f #t))
+ (gnc:options-add-account-levels!
+ options gnc:pagename-accounts optname-depth-limit
+ "b" opthelp-depth-limit 3)
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-accounts optname-bottom-behavior
+ "c" opthelp-bottom-behavior #f))
+
;; all about currencies
(gnc:options-add-currency!
- options gnc:pagename-general
- optname-report-currency "b")
-
+ options pagename-commodities
+ optname-report-commodity "a")
+
(gnc:options-add-price-source!
- options gnc:pagename-general
- optname-price-source "c" 'weighted-average)
-
- ;; accounts to work on
- (gnc:options-add-account-selection!
- options gnc:pagename-accounts
- optname-display-depth optname-show-subaccounts
- optname-accounts "a" 2
- (lambda ()
- (gnc:filter-accountlist-type
- '(bank cash credit asset liability stock mutual-fund currency
- payable receivable equity income expense)
- (gnc:group-get-subaccounts (gnc:get-current-group))))
- #t)
-
- ;; what to show about non-leaf accounts
- (gnc:register-option
- options
+ options pagename-commodities
+ optname-price-source "b" 'weighted-average)
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-foreign
+ "c" opthelp-show-foreign #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-rates
+ "d" opthelp-show-rates #f))
+
+ ;; what to show for zero-balance accounts
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-show-zb-accts
+ "a" opthelp-show-zb-accts #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-omit-zb-bals
+ "b" opthelp-omit-zb-bals #f))
+ ;; what to show for non-leaf accounts
+ (add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-parent-balance
- "c" (N_ "Show balances for parent accounts") #t))
-
- ;; have a subtotal for each parent account?
- (gnc:register-option
- options
+ "c" opthelp-show-parent-balance #t))
+ (add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-show-parent-total
- "d" (N_ "Show subtotals for parent accounts") #f))
-
- (gnc:register-option
- options
+ "d" opthelp-show-parent-total #f))
+ ;; some detailed formatting options
+ (add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-foreign
- "e" (N_ "Display the account's foreign currency amount?") #f))
-
- (gnc:register-option
- options
+ gnc:pagename-display optname-account-links
+ "e" opthelp-account-links #t))
+ (add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-rates
- "f" (N_ "Show the exchange rates used") #f))
-
- (gnc:register-option
- options
+ gnc:pagename-display optname-use-rules
+ "f" opthelp-use-rules #f))
+
+ (add-option
(gnc:make-simple-boolean-option
- gnc:pagename-display optname-show-zeros
- "g" (N_ "Show accounts with a 0.0 total") #t))
-
- ;; Set the general page as default option tab
- (gnc:options-set-default-section options gnc:pagename-general)
-
+ gnc:pagename-display optname-label-assets
+ "g" opthelp-label-assets #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-total-assets
+ "h" opthelp-total-assets #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-label-liabilities
+ "i" opthelp-label-liabilities #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-total-liabilities
+ "j" opthelp-total-liabilities #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-label-equity
+ "k" opthelp-label-equity #t))
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-total-equity
+ "l" opthelp-total-equity #t))
+
+ ;; Set the accounts page as default option tab
+ (gnc:options-set-default-section options gnc:pagename-accounts)
+
options))
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; balance-sheet-renderer
;; set up the document and add the table
+;; then then return the document or, if
+;; requested, export it to a file
;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (balance-sheet-renderer report-obj)
+(define (balance-sheet-renderer report-obj choice filename)
(define (get-option pagename optname)
(gnc:option-value
(gnc:lookup-option
(gnc:report-options report-obj) pagename optname)))
-
+ (define forever-ago (cons 0 0))
+
(gnc:report-starting reportname)
-
+
;; get all option's values
- (let* ((display-depth (get-option gnc:pagename-accounts
- optname-display-depth))
- (show-subaccts? (get-option gnc:pagename-accounts
- optname-show-subaccounts))
+ (let* (
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (get-option gnc:pagename-general optname-party-name))
+ (date-tp (gnc:timepair-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-date))))
+ (report-form? (get-option gnc:pagename-general
+ optname-report-form))
(accounts (get-option gnc:pagename-accounts
optname-accounts))
+ (depth-limit (get-option gnc:pagename-accounts
+ optname-depth-limit))
+ (bottom-behavior (get-option gnc:pagename-accounts
+ optname-bottom-behavior))
+ (report-commodity (get-option pagename-commodities
+ optname-report-commodity))
+ (price-source (get-option pagename-commodities
+ optname-price-source))
+ (show-fcur? (get-option pagename-commodities
+ optname-show-foreign))
+ (show-rates? (get-option pagename-commodities
+ optname-show-rates))
(show-parent-balance? (get-option gnc:pagename-display
optname-show-parent-balance))
(show-parent-total? (get-option gnc:pagename-display
optname-show-parent-total))
- (show-fcur? (get-option gnc:pagename-display
- optname-show-foreign))
- (report-currency (get-option gnc:pagename-general
- optname-report-currency))
- (price-source (get-option gnc:pagename-general
- optname-price-source))
- (show-rates? (get-option gnc:pagename-display
- optname-show-rates))
- (show-zeros? (get-option gnc:pagename-display
- optname-show-zeros))
- (from-date-printable (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-from-date)))
- (from-date-tp (gnc:timepair-end-day-time
- (gnc:timepair-previous-day from-date-printable)))
- (to-date-tp (gnc:timepair-end-day-time
- (gnc:date-option-absolute-time
- (get-option gnc:pagename-general
- optname-to-date))))
-
+ (show-zb-accts? (get-option gnc:pagename-display
+ optname-show-zb-accts))
+ (omit-zb-bals? (get-option gnc:pagename-display
+ optname-omit-zb-bals))
+ (label-assets? (get-option gnc:pagename-display
+ optname-label-assets))
+ (total-assets? (get-option gnc:pagename-display
+ optname-total-assets))
+ (label-liabilities? (get-option gnc:pagename-display
+ optname-label-liabilities))
+ (total-liabilities? (get-option gnc:pagename-display
+ optname-total-liabilities))
+ (label-equity? (get-option gnc:pagename-display
+ optname-label-equity))
+ (total-equity? (get-option gnc:pagename-display
+ optname-total-equity))
+ (use-links? (get-option gnc:pagename-display
+ optname-account-links))
+ (use-rules? (get-option gnc:pagename-display
+ optname-use-rules))
+ (indent 0)
+ (tabbing #f)
+
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(asset-accounts
- (assoc-ref split-up-accounts 'asset))
+ (assoc-ref split-up-accounts 'asset))
(liability-accounts
- (assoc-ref split-up-accounts 'liability))
+ (assoc-ref split-up-accounts 'liability))
(equity-accounts
(assoc-ref split-up-accounts 'equity))
(income-expense-accounts
(append (assoc-ref split-up-accounts 'income)
(assoc-ref split-up-accounts 'expense)))
-
+
(doc (gnc:make-html-document))
- (txt (gnc:make-html-text))
- (tree-depth (if (equal? display-depth 'all)
+ ;; this can occasionally put extra (blank) columns in our
+ ;; table (when there is one account at the maximum depth and
+ ;; it has at least one of its ancestors deselected), but this
+ ;; is the only simple way to ensure that all three tables
+ ;; (asset, liability, equity) have the same width.
+ (tree-depth (if (equal? depth-limit 'all)
(gnc:get-current-group-depth)
- display-depth))
- ;; calculate the exchange rates
- (exchange-fn #f)
- (totals-get-balance #f))
-
- ;; Wrapper to call the right html-utility function.
- (define (add-subtotal-line table label balance)
- (if show-fcur?
- (gnc:html-acct-table-comm-row-helper!
- table tree-depth report-currency exchange-fn
- 1 label report-currency
- (gnc:sum-collector-stocks balance report-currency exchange-fn)
- #f #f "primary-subheading" "primary-subheading" #t #f)
- (gnc:html-acct-table-row-helper!
- table tree-depth 1 label
- (gnc:sum-collector-commodity
- balance report-currency exchange-fn)
- #f "primary-subheading" #t #f)))
+ depth-limit))
+ ;; exchange rates calculation parameters
+ (exchange-fn
+ (gnc:case-exchange-fn price-source report-commodity date-tp))
+ )
+
+ ;; Wrapper to call gnc:html-table-add-labeled-amount-line!
+ ;; with the proper arguments.
+ (define (add-subtotal-line table pos-label neg-label signed-balance)
+ (define allow-same-column-totals #t)
+ (let* ((neg? (and signed-balance
+ (gnc:numeric-negative-p
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ signed-balance report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (balance (if neg?
+ (let ((bal (gnc:make-commodity-collector)))
+ (bal 'minusmerge signed-balance #f)
+ bal)
+ signed-balance))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ table
+ (+ indent (* tree-depth 2)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))
+ "primary-subheading"
+ (and (not allow-same-column-totals) balance use-rules?)
+ label indent 1 "total-label-cell"
+ (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+ (+ indent (* tree-depth 2) (- 0 1)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))
+ 1 "total-number-cell")
+ )
+ )
+ ;; (gnc:sum-collector-stocks balance report-commodity exchange-fn)
+ ;; Hey! Look at that! This rolls the stocks into the balance!
+ ;; Can anyone think of a reason why this would be desireable?
+ ;; None come to (my) mind. Perhaps this should be a report option?
+
+ ;; Wrapper around gnc:html-table-append-ruler! since we call it so
+ ;; often.
+ (define (add-rule table)
+ (gnc:html-table-append-ruler!
+ table
+ (+ (* 2 tree-depth)
+ (if (equal? tabbing 'canonically-tabbed) 1 0))))
;;(gnc:warn "account names" liability-account-names)
(gnc:html-document-set-title!
- doc (sprintf #f "%s %s - %s"
- (get-option gnc:pagename-general gnc:optname-reportname)
- (gnc:print-date from-date-printable)
- (gnc:print-date to-date-tp)))
-
- (if (not (null? accounts))
+ doc (string-append report-title " " company-name " "
+ (gnc:print-date date-tp))
+ )
+
+ (if (null? accounts)
+
+ ;; error condition: no accounts specified
+ ;; is this *really* necessary??
+ ;; i'd be fine with an all-zero balance sheet
+ ;; that would, technically, be correct....
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj)))
+
;; Get all the balances for each account group.
(let* ((asset-balance #f)
+ (neg-liability-balance #f) ;; credit balances are < 0
(liability-balance #f)
+ (neg-equity-balance #f)
(equity-balance #f)
- (sign-reversed-liability-balance #f)
- (neg-net-profit-balance #f)
- (net-profit-balance #f)
- (neg-retained-earnings-balance #f)
- (retained-earnings-balance #f)
- (total-equity-balance #f)
- (equity-plus-liability #f)
+ (neg-retained-earnings #f) ;; credit, income - expenses, < 0
+ (retained-earnings #f)
(unrealized-gain-collector #f)
-
+ (total-equity-balance #f)
+ (liability-plus-equity #f)
+ (book-balance #f) ;; assets - liabilities - equity, norm 0
+
;; Create the account tables below where their
;; percentage time can be tracked.
- (asset-table #f)
- (liability-table #f)
- (equity-table #f))
-
- (gnc:report-percent-done 2)
- (set! totals-get-balance (lambda (account)
- (gnc:account-get-comm-balance-at-date
- account to-date-tp #f)))
+ (left-table (gnc:make-html-table)) ;; gnc:html-table
+ (right-table (if report-form? left-table
+ (gnc:make-html-table)))
+ (table-env #f) ;; parameters for :make-
+ (params #f) ;; and -add-account-
+ (asset-table #f) ;; gnc:html-acct-table
+ (liability-table #f) ;; gnc:html-acct-table
+ (equity-table #f) ;; gnc:html-acct-table
+ (get-total-balance-fn
+ (lambda (account)
+ (gnc:account-get-comm-balance-at-date
+ account date-tp #f)))
+ )
+
+ ;; If you ask me, any outstanding(TM) retained earnings and
+ ;; unrealized gains should be added directly into equity,
+ ;; since the balance sheet does not have a period over which
+ ;; to report earnings.... See discussion on bugzilla.
(gnc:report-percent-done 4)
+ ;; sum assets
(set! asset-balance
(gnc:accounts-get-comm-total-assets
- asset-accounts totals-get-balance))
+ asset-accounts get-total-balance-fn))
(gnc:report-percent-done 6)
- (set! liability-balance
+ ;; sum liabilities
+ (set! neg-liability-balance
(gnc:accounts-get-comm-total-assets
- liability-accounts totals-get-balance))
+ liability-accounts get-total-balance-fn))
+ (set! liability-balance
+ (gnc:make-commodity-collector))
+ (liability-balance 'minusmerge
+ neg-liability-balance
+ #f)
(gnc:report-percent-done 8)
- (set! equity-balance
+ ;; sum equities
+ (set! neg-equity-balance
(gnc:accounts-get-comm-total-assets
- equity-accounts totals-get-balance))
- (gnc:report-percent-done 10)
- (set! sign-reversed-liability-balance
- (gnc:make-commodity-collector))
+ equity-accounts get-total-balance-fn))
+ (set! equity-balance (gnc:make-commodity-collector))
+ (equity-balance 'minusmerge
+ neg-equity-balance
+ #f)
(gnc:report-percent-done 12)
- (set! neg-net-profit-balance
- (accountlist-get-comm-balance-at-date
- income-expense-accounts
- from-date-tp to-date-tp))
- (set! neg-retained-earnings-balance
+ ;; sum any retained earnings
+ (set! neg-retained-earnings
(accountlist-get-comm-balance-at-date
income-expense-accounts
- (cons 0 0) from-date-tp))
+ forever-ago date-tp))
+ (set! retained-earnings (gnc:make-commodity-collector))
+ (retained-earnings 'minusmerge
+ neg-retained-earnings
+ #f)
(gnc:report-percent-done 14)
- (set! net-profit-balance (gnc:make-commodity-collector))
- (set! retained-earnings-balance (gnc:make-commodity-collector))
- (gnc:report-percent-done 16)
- (set! total-equity-balance (gnc:make-commodity-collector))
- (gnc:report-percent-done 18)
- (set! equity-plus-liability (gnc:make-commodity-collector))
- (set! unrealized-gain-collector (gnc:make-commodity-collector))
-
- (gnc:report-percent-done 20)
- (set! exchange-fn (gnc:case-exchange-fn
- price-source report-currency to-date-tp))
- (gnc:report-percent-done 30)
-
- ;;; Arbitrarily declare that the building of these tables
- ;;; takes 50% of the total amount of time spent building
- ;;; this report. (from 30%-80%)
- (set! asset-table
- (gnc:html-build-acct-table
- #f to-date-tp
- tree-depth show-subaccts?
- asset-accounts
- 30 20
- #f #f #f #f #f
- show-parent-balance? show-parent-total?
- show-fcur? report-currency exchange-fn show-zeros?))
- (set! liability-table
- (gnc:html-build-acct-table
- #f to-date-tp
- tree-depth show-subaccts?
- liability-accounts
- 50 20
- #f #f #f #f #f
- show-parent-balance? show-parent-total?
- show-fcur? report-currency exchange-fn show-zeros?))
- (set! equity-table
- (gnc:html-build-acct-table
- #f to-date-tp
- tree-depth show-subaccts?
- equity-accounts
- 70 10
- #f #f #f #f #f
- show-parent-balance? show-parent-total?
- show-fcur? report-currency exchange-fn show-zeros?))
-
- (net-profit-balance 'minusmerge
- neg-net-profit-balance
- #f)
- (retained-earnings-balance 'minusmerge
- neg-retained-earnings-balance
- #f)
- (total-equity-balance 'minusmerge equity-balance #f)
- (total-equity-balance 'merge
- net-profit-balance
- #f)
- (total-equity-balance 'merge
- retained-earnings-balance
- #f)
- (sign-reversed-liability-balance 'minusmerge
- liability-balance
- #f)
- (equity-plus-liability 'merge
- sign-reversed-liability-balance
- #f)
- (equity-plus-liability 'merge
- total-equity-balance
- #f)
-
- ;; Now concatenate the tables. This first prepend-row has
- ;; to be written out by hand -- we can't use the function
- ;; append-something because we have to prepend.
- (gnc:report-percent-done 80)
- (gnc:html-table-prepend-row/markup!
- asset-table
- "primary-subheading"
- (append
- (list (gnc:html-acct-table-cell tree-depth
- (_ "Assets") #t))
- ;; Workaround to force gtkhtml into displaying wide
- ;; enough columns.
- (make-list (* (if show-fcur? 2 1) tree-depth)
- " \
- \
- ")))
-
- (add-subtotal-line
- asset-table (_ "Assets") asset-balance)
-
- ;; add a horizontal ruler
- (gnc:html-table-append-ruler!
- asset-table (* (if show-fcur? 3 2) tree-depth))
-
- (gnc:report-percent-done 85)
- (add-subtotal-line
- asset-table (_ "Liabilities") #f)
- (html-table-merge asset-table liability-table)
- (add-subtotal-line
- asset-table (_ "Liabilities") sign-reversed-liability-balance)
-
+ ;; sum any unrealized gains
+ ;;
+ ;; Hm... unrealized gains.... This is when you purchase
+ ;; something and its value increases/decreases (prior to
+ ;; your selling it) and you have to reflect that on your
+ ;; balance sheet.
+ ;;
+ ;; I *think* a decrease in the value of a liability or
+ ;; equity constitutes an unrealized loss. I'm unsure about
+ ;; that though....
+ ;;
+ (set! book-balance (gnc:make-commodity-collector))
+ (book-balance 'merge asset-balance #f)
+ (book-balance 'merge neg-liability-balance #f)
+ (book-balance 'merge neg-equity-balance #f)
+ (book-balance 'merge neg-retained-earnings #f)
+ (set! unrealized-gain-collector (gnc:make-commodity-collector))
(let* ((weighted-fn
(gnc:case-exchange-fn 'weighted-average
- report-currency to-date-tp))
-
+ report-commodity date-tp))
+
(value
(gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity asset-balance
- report-currency
+ (gnc:sum-collector-commodity book-balance
+ report-commodity
exchange-fn)))
-
+
(cost
(gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity asset-balance
- report-currency
+ (gnc:sum-collector-commodity book-balance
+ report-commodity
weighted-fn)))
-
+
(unrealized-gain (gnc:numeric-sub-fixed value cost)))
-
- (unrealized-gain-collector 'add report-currency unrealized-gain)
- (equity-plus-liability 'add report-currency unrealized-gain)
-
- (add-subtotal-line
- asset-table (_ "Unrealized Gains(Losses)")
- unrealized-gain-collector))
-
- (gnc:html-table-append-ruler!
- asset-table (* (if show-fcur? 3 2) tree-depth))
-
+
+ (unrealized-gain-collector 'add report-commodity unrealized-gain)
+ )
+ ;; calculate equity and liability+equity totals
+ (set! total-equity-balance (gnc:make-commodity-collector))
+ (total-equity-balance 'merge
+ equity-balance
+ #f)
+ (total-equity-balance 'merge
+ retained-earnings
+ #f)
+ (total-equity-balance 'merge
+ unrealized-gain-collector
+ #f)
+ (gnc:report-percent-done 18)
+ (set! liability-plus-equity (gnc:make-commodity-collector))
+ (liability-plus-equity 'merge
+ liability-balance
+ #f)
+ (liability-plus-equity 'merge
+ total-equity-balance
+ #f)
+
+ (gnc:report-percent-done 20)
+ (gnc:report-percent-done 30)
+
+ ;;; Arbitrarily declare that the building of these tables
+ ;;; takes 50% of the total amount of time spent building
+ ;;; this report. (from 30%-80%)
+
+ (set! table-env
+ (list
+ (list 'start-date #f)
+ (list 'end-date date-tp)
+ (list 'display-tree-depth tree-depth)
+ (list 'depth-limit-behavior (if bottom-behavior
+ 'flatten
+ 'summarize))
+ (list 'report-commodity report-commodity)
+ (list 'exchange-fn exchange-fn)
+ (list 'parent-account-subtotal-mode show-parent-total?)
+ (list 'zero-balance-mode (if show-zb-accts?
+ 'show-leaf-acct
+ 'omit-leaf-acct))
+ (list 'account-label-mode (if use-links?
+ 'anchor
+ 'name))
+ )
+ )
+ (set! params
+ (list
+ (list 'parent-account-balance-mode
+ (if show-parent-balance?
+ 'immediate-bal
+ 'omit-bal
+ ))
+ (list 'zero-balance-display-mode (if omit-zb-bals?
+ 'omit-balance
+ 'show-balance))
+ (list 'multicommodity-mode (if show-fcur? 'table #f))
+ (list 'rule-mode use-rules?)
+ )
+ )
+
+ ;(gnc:html-table-set-style!
+ ; left-table "table" 'attribute '("rules" "rows"))
+ ;(gnc:html-table-set-style!
+ ; right-table "table" 'attribute '("rules" "rows"))
+ ;; could also '("border" "1") or '("rules" "all")
+
+ ;; Workaround to force gtkhtml into displaying wide
+ ;; enough columns.
+ (let ((space
+ (make-list tree-depth " \
+ \
+ ")
+ ))
+ (gnc:html-table-append-row! left-table space)
+ (if (not report-form?)
+ (gnc:html-table-append-row! right-table space))
+ )
+
+ (gnc:report-percent-done 80)
+ (if label-assets? (add-subtotal-line left-table (_ "Assets") #f #f))
+ (set! asset-table
+ (gnc:make-html-acct-table/env/accts
+ table-env asset-accounts))
+ (gnc:html-table-add-account-balances
+ left-table asset-table params)
+ (if total-assets? (add-subtotal-line
+ left-table (_ "Total Assets") #f asset-balance))
+
+ (if report-form?
+ (add-rule left-table))
+ (if report-form?
+ (add-rule left-table))
+
+ (gnc:report-percent-done 85)
+ (if label-liabilities?
+ (add-subtotal-line
+ right-table (_ "Liabilities") #f #f))
+ (set! liability-table
+ (gnc:make-html-acct-table/env/accts
+ table-env liability-accounts))
+ (gnc:html-table-add-account-balances
+ right-table liability-table params)
+ (if total-liabilities?
+ (add-subtotal-line
+ right-table (_ "Total Liabilities") #f liability-balance))
+
+ (add-rule right-table)
+
(gnc:report-percent-done 88)
+ (if label-equity?
+ (add-subtotal-line
+ right-table (_ "Equity") #f #f))
+ (set! equity-table
+ (gnc:make-html-acct-table/env/accts
+ table-env equity-accounts))
+ (gnc:html-table-add-account-balances
+ right-table equity-table params)
+ ;; we omit retianed earnings & unrealized gains
+ ;; from the balance report, if zero, since they
+ ;; are not present on normal balance sheets
+ (and (not (gnc:commodity-collector-allzero?
+ retained-earnings))
+ (add-subtotal-line right-table
+ (N_ "Retained Earnings")
+ (N_ "Retained Losses")
+ retained-earnings))
+ (and (not (gnc:commodity-collector-allzero?
+ unrealized-gain-collector))
+ (add-subtotal-line right-table
+ (N_ "Unrealized Gains")
+ (N_ "Unrealized Losses")
+ unrealized-gain-collector))
+ (if total-equity?
+ (add-subtotal-line
+ right-table (_ "Total Equity") #f total-equity-balance))
+
+ (add-rule right-table)
+
(add-subtotal-line
- asset-table (_ "Equity") #f)
- (html-table-merge asset-table equity-table)
- (add-subtotal-line
- asset-table (_ "Retained Earnings") retained-earnings-balance)
- (add-subtotal-line
- asset-table (_ "Net Profit") net-profit-balance)
- (add-subtotal-line
- asset-table (_ "Total Equity") total-equity-balance)
-
- (gnc:html-table-append-ruler!
- asset-table (* (if show-fcur? 3 2) tree-depth))
- (add-subtotal-line
- asset-table (_ "Liabilities & Equity") equity-plus-liability)
- (gnc:html-document-add-object! doc asset-table)
-
- ;; add currency information
+ right-table (_ "Total Liabilities & Equity")
+ #f liability-plus-equity)
+
+ (gnc:html-document-add-object!
+ doc
+ (if report-form?
+ left-table
+ (let* ((build-table (gnc:make-html-table))
+ )
+ (gnc:html-table-append-row!
+ build-table
+ (list
+ (gnc:make-html-table-cell left-table)
+ (gnc:make-html-table-cell right-table)
+ )
+ )
+ (gnc:html-table-set-style!
+ build-table "td"
+ 'attribute '("align" "left")
+ 'attribute '("valign" "top"))
+ build-table
+ )
+ )
+ )
+
+ ;; add currency information if requested
(gnc:report-percent-done 90)
(if show-rates?
(gnc:html-document-add-object!
- doc ;;(gnc:html-markup-p
+ doc ;;(gnc:html-markup-p)
(gnc:html-make-exchangerates
- report-currency exchange-fn accounts)))
- (gnc:report-percent-done 100))
-
-
- ;; error condition: no accounts specified
-
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- (_ "Balance Sheet") (gnc:report-id report-obj))))
+ report-commodity exchange-fn accounts)))
+ (gnc:report-percent-done 100)
+
+ ;; if sending the report to a file, do so now
+ ;; however, this still doesn't seem to get around the
+ ;; colspan bug... cf. gnc:colspans-are-working-right
+ (if filename
+ (let* ((port (open-output-file filename))
+ (gnc:display-report-list-item
+ (list doc) port " balance-sheet.scm ")
+ (close-output-port port)
+ )
+ )
+ )
+ )
+ )
+
(gnc:report-finished)
- doc))
+
+ doc
+ )
+ )
(gnc:define-report
- 'version 1
+ 'version 2
'name reportname
'menu-path (list gnc:menuname-asset-liability)
'options-generator balance-sheet-options-generator
- 'renderer balance-sheet-renderer)
+ 'renderer (lambda (report-obj)
+ (balance-sheet-renderer report-obj #f #f))
+ 'export-types #f
+ 'export-thunk (lambda (report-obj choice filename)
+ (balance-sheet-renderer report-obj #f filename)))
+
+;; END
+
--- /dev/null
+++ src/report/standard-reports/equity-statement.scm
@@ -0,0 +1,650 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; equity-statement.scm: statement of owner's equity (net worth)
+;;
+;; By David Montenegro 2004.06.23 <sunrise2000 at comcast.net>
+;;
+;; * Based on balance-sheet.scm by Robert Merkel <rgmerk at mira.net>
+;;
+;; * BUGS:
+;;
+;; The multicurrency support has NOT been tested and IS ALPHA. I
+;; really don't if I used the correct exchange functions. Search
+;; code for regexp "*exchange-fn".
+;;
+;; I have also made the educated assumption <grin> that a decrease
+;; in the value of a liability or equity also represents an
+;; unrealized loss. I *think* that is right, but am not sure.
+;;
+;; This code makes the assumption that you want your equity
+;; statement to no more than daily resolution.
+;;
+;; The Accounts option panel needs a way to select (and select by
+;; default) capital and draw accounts.
+;;
+;; The variables in this code could use more consistent naming.
+;;
+;; See also any "FIXME"s in the code.
+;;
+;; 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 equity-statement))
+(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
+(use-modules (ice-9 slib))
+(use-modules (gnucash gnc-module))
+
+(require 'printf)
+
+(gnc:module-load "gnucash/report/report-system" 0)
+
+(define reportname (N_ "Equity Statement"))
+
+;; define all option's names and help text so that they are properly
+;; defined in *one* place.
+(define optname-report-title (N_ "Report Title"))
+(define opthelp-report-title (N_ "Title for this report"))
+
+(define optname-party-name (N_ "Company name"))
+(define opthelp-party-name (N_ "Name of company/individual"))
+
+(define optname-start-date (N_ "Equity Statement Start Date"))
+(define opthelp-start-date
+ (N_ "Start of the period this equity statement will cover"))
+(define optname-end-date (N_ "Equity Statement End Date"))
+(define opthelp-end-date
+ (N_ "End of the period this equity statement will cover"))
+
+(define optname-accounts (N_ "Accounts to include"))
+(define opthelp-accounts
+ (N_ "Report only on these accounts"))
+
+(define optname-use-rules (N_ "Show accounting-style rules"))
+(define opthelp-use-rules
+ (N_ "Use rules beneath columns of added numbers like accountants do"))
+
+(define pagename-commodities (N_ "Commodities"))
+(define optname-report-commodity (N_ "Report's currency"))
+(define optname-price-source (N_ "Price Source"))
+(define optname-show-foreign (N_ "Show Foreign Currencies"))
+(define opthelp-show-foreign
+ (N_ "Display any foreign currency amount in an account"))
+(define optname-show-rates (N_ "Show Exchange Rates"))
+(define opthelp-show-rates (N_ "Show the exchange rates used"))
+
+;; This calculates the increase in the balance(s) of all accounts in
+;; <accountlist> over the period from <start-date> to <end-date>.
+;; Returns a commodity collector.
+;;
+;; Note: There is both a gnc:account-get-comm-balance-interval and
+;; gnc:group-get-comm-balance-interval which could replace this
+;; function....
+;;
+(define (accountlist-get-comm-balance-at-date accountlist start-date end-date)
+;; (for-each (lambda (x) (display x))
+;; (list "computing from: " (gnc:print-date start-date) " to "
+;; (gnc:print-date end-date) "\n"))
+ (let ((collector (gnc:make-commodity-collector)))
+ (for-each (lambda (account)
+ (let* (
+ (start-balance
+ (gnc:account-get-comm-balance-at-date
+ account start-date #f))
+ (sb (cadr (start-balance
+ 'getpair
+ (gnc:account-get-commodity account)
+ #f)))
+ (end-balance
+ (gnc:account-get-comm-balance-at-date
+ account end-date #f))
+ (eb (cadr (end-balance
+ 'getpair
+ (gnc:account-get-commodity account)
+ #f)))
+ )
+;; (for-each (lambda (x) (display x))
+;; (list "Start balance: " sb " : "
+;; (gnc:account-get-name account) " : end balance: "
+;; eb "\n"))
+ (collector 'merge end-balance #f)
+ (collector 'minusmerge start-balance #f)
+ ))
+ accountlist)
+ collector))
+
+;; options generator
+(define (equity-statement-options-generator)
+ (let* ((options (gnc:new-options))
+ (add-option
+ (lambda (new-option)
+ (gnc:register-option options new-option))))
+
+ (add-option
+ (gnc:make-string-option
+ (N_ "General") optname-report-title
+ "a" opthelp-report-title reportname))
+ (add-option
+ (gnc:make-string-option
+ (N_ "General") optname-party-name
+ "b" opthelp-party-name (N_ "")))
+ ;; this should default to company name in (gnc:get-current-book)
+ ;; does anyone know the function to get the company name??
+ ;; (GnuCash is *so* well documented... sigh)
+
+ ;; date at which to report balance
+ (gnc:options-add-date-interval!
+ options gnc:pagename-general
+ optname-start-date optname-end-date "c")
+
+ ;; accounts to work on
+ (add-option
+ (gnc:make-account-list-option
+ gnc:pagename-accounts optname-accounts
+ "a"
+ opthelp-accounts
+ (lambda ()
+ (gnc:filter-accountlist-type
+ '(bank cash credit asset liability stock mutual-fund currency
+ payable receivable equity income expense)
+ (gnc:group-get-subaccounts (gnc:get-current-group))))
+ #f #t))
+
+ ;; all about currencies
+ (gnc:options-add-currency!
+ options pagename-commodities
+ optname-report-commodity "a")
+
+ (gnc:options-add-price-source!
+ options pagename-commodities
+ optname-price-source "b" 'weighted-average)
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-foreign
+ "c" opthelp-show-foreign #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ pagename-commodities optname-show-rates
+ "d" opthelp-show-rates #f))
+
+ ;; some detailed formatting options
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-use-rules
+ "f" opthelp-use-rules #f))
+
+ ;; Set the accounts page as default option tab
+ (gnc:options-set-default-section options gnc:pagename-accounts)
+
+ options))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; equity-statement-renderer
+;; set up the document and add the table
+;; then then return the document or, if
+;; requested, export it to a file
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (equity-statement-renderer report-obj choice filename)
+ (define (get-option pagename optname)
+ (gnc:option-value
+ (gnc:lookup-option
+ (gnc:report-options report-obj) pagename optname)))
+ (define forever-ago (cons 0 0))
+
+ (gnc:report-starting reportname)
+
+ ;; get all option's values
+ (let* (
+ (report-title (get-option gnc:pagename-general optname-report-title))
+ (company-name (get-option gnc:pagename-general optname-party-name))
+ ;; this code makes the assumption that you want your equity
+ ;; statement to no more than daily resolution
+ (start-date-printable (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-start-date)))
+ (start-date-tp (gnc:timepair-end-day-time
+ (gnc:timepair-previous-day start-date-printable)))
+ (end-date-tp (gnc:timepair-end-day-time
+ (gnc:date-option-absolute-time
+ (get-option gnc:pagename-general
+ optname-end-date))))
+ ;;(end-date-printable (gnc:date-option-absolute-time
+ ;; (get-option gnc:pagename-general
+ ;; optname-end-date)))
+ ;; why dont we use this? why use any -printable at all?
+ (accounts (get-option gnc:pagename-accounts
+ optname-accounts))
+ (report-commodity (get-option pagename-commodities
+ optname-report-commodity))
+ (price-source (get-option pagename-commodities
+ optname-price-source))
+ (show-fcur? (get-option pagename-commodities
+ optname-show-foreign))
+ (show-rates? (get-option pagename-commodities
+ optname-show-rates))
+ (use-rules? (get-option gnc:pagename-display
+ optname-use-rules))
+
+ ;; decompose the account list
+ (split-up-accounts (gnc:decompose-accountlist accounts))
+ (asset-accounts
+ (assoc-ref split-up-accounts 'asset))
+ (liability-accounts
+ (assoc-ref split-up-accounts 'liability))
+ (income-expense-accounts
+ (append (assoc-ref split-up-accounts 'income)
+ (assoc-ref split-up-accounts 'expense)))
+ (equity-accounts
+ (assoc-ref split-up-accounts 'equity))
+ ;; N.B.: equity-accounts will also contain drawing accounts
+ ;; these must still be split-out and itemized separately
+ (capital-accounts #f)
+ (drawing-accounts #f)
+
+ (doc (gnc:make-html-document))
+ ;; exchange rates calculation parameters
+ (start-exchange-fn
+ (gnc:case-exchange-fn
+ price-source report-commodity start-date-tp))
+ (end-exchange-fn
+ (gnc:case-exchange-fn
+ price-source report-commodity end-date-tp))
+ )
+
+ (gnc:html-document-set-title!
+ doc (sprintf #f
+ (string-append "%s %s "
+ (N_ "For Period")
+ " %s "
+ (N_ "to")
+ " %s")
+ report-title company-name
+ (gnc:print-date start-date-printable)
+ (gnc:print-date end-date-tp)))
+
+ (if (null? accounts)
+
+ ;; error condition: no accounts specified is this *really*
+ ;; necessary?? i'd be fine with an all-zero income statement
+ ;; that would, technically, be correct....
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj)))
+
+ ;; Get all the balances for each account group.
+ (let* ((book-balance #f) ;; assets - liabilities - equity, norm 0
+ (start-asset-balance #f)
+ (end-asset-balance #f)
+ (neg-start-liability-balance #f) ;; credit balances are < 0
+ (neg-end-liability-balance #f)
+ (neg-pre-start-retained-earnings #f)
+ (neg-pre-end-retained-earnings #f)
+ (neg-net-income #f)
+ (net-income #f)
+
+ (neg-start-equity-balance #f)
+ (neg-end-equity-balance #f)
+
+ (start-capital-balance #f)
+ (end-capital-balance #f)
+ (start-drawing-balance #f)
+ (end-drawing-balance #f)
+
+ (start-book-balance #f)
+ (end-book-balance #f)
+
+ (start-unrealized-gains #f)
+ (end-unrealized-gains #f)
+ (net-unrealized-gains #f)
+
+ (start-total-equity #f)
+ (end-total-equity #f)
+
+ (investments #f)
+ (draws #f)
+
+ (capital-increase #f)
+
+ ;; Create the account table below where its
+ ;; percentage time can be tracked.
+ (build-table (gnc:make-html-table)) ;; gnc:html-table
+ (get-start-balance-fn
+ (lambda (account)
+ (gnc:account-get-comm-balance-at-date
+ account start-date-tp #f)))
+ (get-end-balance-fn
+ (lambda (account)
+ (gnc:account-get-comm-balance-at-date
+ account end-date-tp #f)))
+ (terse-period? #t)
+ (period-for (if terse-period?
+ (string-append " " (N_ "for Period"))
+ (string-append
+ ", "
+ (gnc:print-date start-date-printable) " "
+ (N_ "to") " "
+ (gnc:print-date end-date-tp)
+ )))
+ )
+
+ ;; a helper to add a line to our report
+ (define (report-line
+ table pos-label neg-label amount col
+ exchange-fn rule? row-style)
+ (let* ((neg? (and amount
+ (gnc:numeric-negative-p
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ amount report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (pos-bal (if neg?
+ (let ((bal (gnc:make-commodity-collector)))
+ (bal 'minusmerge amount #f)
+ bal)
+ amount))
+ (bal (gnc:sum-collector-commodity
+ pos-bal report-commodity exchange-fn))
+ (balance
+ (or (and (gnc:uniform-commodity? bal report-commodity) bal)
+ (and show-fucr?
+ (gnc:commodity-table
+ bal report-commodity exchange-fn))
+ bal
+ ))
+ (column (or col 0))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ table 3 row-style rule?
+ label 0 1 "text-cell"
+ bal (+ col 1) 1 "number-cell")
+ )
+ )
+
+ ;; sum any unrealized gains
+ ;;
+ ;; Hm... unrealized gains.... This is when you purchase
+ ;; something and its value increases/decreases (prior to
+ ;; your selling it) and you have to reflect that on your
+ ;; balance sheet.
+ ;;
+ ;; I *think* a decrease in the value of a liability or
+ ;; equity constitutes an unrealized loss. I'm unsure about
+ ;; that though....
+ ;;
+ (define (unrealized-gains-at-date book-balance exchange-fn date-tp)
+ (let* ((unrealized-gain-collector (gnc:make-commodity-collector))
+ (weighted-fn
+ (gnc:case-exchange-fn 'weighted-average
+ report-commodity date-tp))
+
+ (value
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity book-balance
+ report-commodity
+ exchange-fn)))
+
+ (cost
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity book-balance
+ report-commodity
+ weighted-fn)))
+
+ (unrealized-gain (gnc:numeric-sub-fixed value cost)))
+
+ (unrealized-gain-collector 'add report-commodity unrealized-gain)
+ unrealized-gain-collector
+ )
+ )
+
+ ;; If you ask me, any outstanding(TM) retained earnings and
+ ;; unrealized gains should be added directly into equity,
+ ;; both at the start and end dates of the reporting period.
+ (gnc:report-percent-done 4)
+
+ ;; start and end asset balances
+ (set! start-asset-balance
+ (gnc:accounts-get-comm-total-assets
+ asset-accounts get-start-balance-fn)) ; OK
+ (set! end-asset-balance
+ (gnc:accounts-get-comm-total-assets
+ asset-accounts get-end-balance-fn)) ; OK
+
+ ;; start and end liability balances
+ (set! neg-start-liability-balance
+ (gnc:accounts-get-comm-total-assets
+ liability-accounts get-start-balance-fn)) ; OK
+ (set! neg-end-liability-balance
+ (gnc:accounts-get-comm-total-assets
+ liability-accounts get-end-balance-fn)) ; OK
+
+ ;; start and end retained earnings (income - expenses)
+ (set! neg-pre-start-retained-earnings
+ (accountlist-get-comm-balance-at-date
+ income-expense-accounts
+ forever-ago start-date-tp)) ; OK
+ (set! neg-pre-end-retained-earnings
+ (accountlist-get-comm-balance-at-date
+ income-expense-accounts
+ forever-ago end-date-tp)) ; OK
+ (set! neg-net-income
+ (accountlist-get-comm-balance-at-date
+ income-expense-accounts
+ start-date-tp end-date-tp)) ; OK
+ (set! net-income (gnc:make-commodity-collector))
+ (net-income 'minusmerge neg-net-income #f)
+
+ ;; start and end (unadjusted) equity balances
+ (set! neg-start-equity-balance
+ (gnc:accounts-get-comm-total-assets
+ equity-accounts get-start-balance-fn)) ; OK
+ (set! neg-end-equity-balance
+ (gnc:accounts-get-comm-total-assets
+ equity-accounts get-end-balance-fn)) ; OK
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;
+ ;; beleive it or not, i think this part is right...
+ ;;
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;; start and end unrealized gains
+ (set! start-book-balance (gnc:make-commodity-collector))
+ (start-book-balance 'merge start-asset-balance #f)
+ (start-book-balance 'merge neg-start-liability-balance #f)
+ (start-book-balance 'merge neg-start-equity-balance #f)
+ (start-book-balance 'merge neg-pre-start-retained-earnings #f) ; OK
+
+ (set! end-book-balance (gnc:make-commodity-collector))
+ (end-book-balance 'merge end-asset-balance #f)
+ (end-book-balance 'merge neg-end-liability-balance #f)
+ (end-book-balance 'merge neg-end-equity-balance #f)
+ (end-book-balance 'merge neg-pre-end-retained-earnings #f) ; OK
+
+ (set! start-unrealized-gains
+ (unrealized-gains-at-date start-book-balance
+ start-exchange-fn
+ start-date-tp)) ; OK
+ (set! end-unrealized-gains
+ (unrealized-gains-at-date end-book-balance
+ end-exchange-fn
+ end-date-tp)) ; OK
+
+ ;; unrealized gains accrued during the reporting period...
+ (set! net-unrealized-gains (gnc:make-commodity-collector))
+ (net-unrealized-gains 'merge end-unrealized-gains #f)
+ (net-unrealized-gains 'minusmerge start-unrealized-gains #f) ; OK
+
+ ;; starting and ending total equity...
+ (set! start-total-equity (gnc:make-commodity-collector))
+ (start-total-equity 'minusmerge neg-start-equity-balance #f)
+ (start-total-equity 'minusmerge neg-pre-start-retained-earnings #f)
+ (start-total-equity 'merge start-unrealized-gains #f) ; OK
+
+ (set! end-total-equity (gnc:make-commodity-collector))
+ (end-total-equity 'minusmerge neg-end-equity-balance #f)
+ (end-total-equity 'minusmerge neg-pre-end-retained-earnings #f)
+ (end-total-equity 'merge end-unrealized-gains #f) ; OK
+
+ ;;
+ ;; calculate investments & draws...
+ ;;
+ ;; since, as this time, GnuCash does not have any
+ ;; contra-account types, i'm gonna have to fudge this a
+ ;; bit... i'll do a transaction query and classify the
+ ;; splits by debit/credit.
+ ;;
+
+ ;; FIXME: um... no. that sounds like too much work.
+ ;; ok, for now, just assume draws are zero and investments signed
+ (set! draws (gnc:make-commodity-collector)) ;; 0
+ (set! investments (gnc:make-commodity-collector)) ;; 0
+ (investments 'minusmerge neg-end-equity-balance #f) ;; > 0
+ (investments 'merge neg-start-equity-balance #f) ;; net increase
+
+ ;; increase in equity
+ (set! capital-increase (gnc:make-commodity-collector))
+ (capital-increase 'merge net-income #f)
+ (capital-increase 'merge investments #f)
+ (capital-increase 'minusmerge draws #f)
+ (capital-increase 'merge net-unrealized-gains #f)
+
+ (gnc:report-percent-done 30)
+
+ ;; Workaround to force gtkhtml into displaying wide
+ ;; enough columns.
+ (gnc:html-table-append-row!
+ build-table
+ (make-list 2 " \
+ \
+ ")
+ )
+
+ (gnc:report-percent-done 80)
+
+ (report-line
+ build-table
+ (string-append (N_ "Capital") ", "
+ (gnc:print-date start-date-printable))
+ #f start-total-equity
+ 1 start-exchange-fn #f "primary-subheading"
+ )
+ (report-line
+ build-table
+ (string-append (N_ "Net income") period-for)
+ (string-append (N_ "Net loss") period-for)
+ net-income
+ 0 end-exchange-fn #f #f
+ )
+ (report-line
+ build-table
+ (string-append (N_ "Investments less withdrawals") period-for)
+ #f
+ investments
+ 0 end-exchange-fn #f #f
+ )
+ (report-line
+ build-table
+ (string-append (N_ "Unrealized gains") period-for)
+ (string-append (N_ "Unrealized losses") period-for)
+ net-unrealized-gains
+ 0 end-exchange-fn #f #f
+ )
+ (report-line
+ build-table
+ (N_ "Increase in capital")
+ (N_ "Decrease in capital")
+ capital-increase
+ 1 end-exchange-fn use-rules? #f
+ )
+ (report-line
+ build-table
+ (string-append (N_ "Captial") ", "
+ (gnc:print-date end-date-tp))
+ #f
+ end-total-equity
+ 1 end-exchange-fn #f "primary-subheading"
+ )
+
+ (gnc:html-document-add-object! doc build-table)
+
+ ;; add currency information if requested
+ (gnc:report-percent-done 90)
+ (and show-rates?
+ (let* ((curr-tbl (gnc:make-html-table))
+ (headers (list
+ (gnc:print-date start-date-printable)
+ (gnc:print-date end-date-tp)
+ )
+ )
+ (then (gnc:html-make-exchangerates
+ report-commodity start-exchange-fn accounts))
+ (now (gnc:html-make-exchangerates
+ report-commodity end-exchange-fn accounts))
+ )
+
+ (gnc:html-table-set-col-headers! curr-tbl headers)
+ (gnc:html-table-set-style!
+ curr-tbl "table" 'attribute '("border" "1"))
+ (gnc:html-table-set-style!
+ then "table" 'attribute '("border" "0"))
+ (gnc:html-table-set-style!
+ now "table" 'attribute '("border" "0"))
+ (gnc:html-table-append-ruler! build-table 3)
+ (gnc:html-table-append-row! curr-tbl (list then now))
+ (gnc:html-document-add-object! doc curr-tbl)
+ )
+ )
+
+ (gnc:report-percent-done 100)
+
+ ;; if sending the report to a file, do so now
+ ;; however, this still doesn't seem to get around the
+ ;; colspan bug... cf. gnc:colspans-are-working-right
+ (if filename
+ (let* ((port (open-output-file filename))
+ (gnc:display-report-list-item
+ (list doc) port " equity-statement.scm ")
+ (close-output-port port)
+ )
+ )
+ )
+ )
+ )
+
+ (gnc:report-finished)
+
+ doc
+ )
+ )
+
+(gnc:define-report
+ 'version 1
+ 'name reportname
+ 'menu-path (list gnc:menuname-income-expense)
+ 'options-generator equity-statement-options-generator
+ 'renderer (lambda (report-obj)
+ (equity-statement-renderer report-obj #f #f))
+ 'export-types #f
+ 'export-thunk (lambda (report-obj choice filename)
+ (equity-statement-renderer report-obj #f filename)))
+
+;; END
+
Index: path.scm
===================================================================
RCS file: /home/cvs/cvsroot/gnucash/src/scm/path.scm,v
retrieving revision 1.19
retrieving revision 1.20
diff -Lsrc/scm/path.scm -Lsrc/scm/path.scm -u -r1.19 -r1.20
--- src/scm/path.scm
+++ src/scm/path.scm
@@ -40,10 +40,10 @@
(gnc:make-dir home-dir)))
(define gnc:current-config-auto
- (build-path (getenv "HOME") ".gnucash" "config-1.8.auto"))
+ (build-path (getenv "HOME") ".gnucash" "config-1.9.auto"))
(define gnc:current-saved-reports
- (build-path (getenv "HOME") ".gnucash" "saved-reports-1.8"))
+ (build-path (getenv "HOME") ".gnucash" "saved-reports-1.9"))
(define gnc:load-user-config-if-needed
(let ((user-config-loaded? #f))
@@ -74,11 +74,13 @@
;; Don't continue adding to this list. When 2.0
;; rolls around bump the 1.4 (unnumbered) files
;; off the list.
- '("config-1.8.user" "config-1.6.user" "config.user"
- "config-1.8.auto" "config-1.6.auto" "config.auto"))
+ '("config-1.9.user" "config-1.8.user"
+ "config-1.6.user" "config.user"
+ "config-1.9.auto" "config-1.8.auto"
+ "config-1.6.auto" "config.auto"))
(gnc:debug "loading saved reports")
(or-map try-load-no-set
- '("saved-reports-1.8"))
+ '("saved-reports-1.9" "saved-reports-1.8"))
)))))
;; the system config should probably be loaded from some directory
More information about the gnucash-changes
mailing list