mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
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.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@10078 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
parent
ef88252b7c
commit
f6b1637e25
31
ChangeLog
31
ChangeLog
@ -1,3 +1,34 @@
|
||||
2004-06-24 Derek Atkins <derek@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@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@tuhh.de>
|
||||
|
||||
* src/scm/main-window.scm, src/scm/main.scm: Added example Menu
|
||||
|
||||
@ -63,14 +63,14 @@ CLEANFILES = gnucash-config
|
||||
## brackets here, instead of the usual @...@. 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'
|
||||
|
||||
@ -6,6 +6,13 @@
|
||||
# mailing list gnucash-patches@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'.
|
||||
#
|
||||
|
||||
@ -46,6 +46,7 @@ noinst_DATA = .scm-links
|
||||
gncscmdir = ${GNC_SHAREDIR}/scm
|
||||
gncscm_DATA = \
|
||||
commodity-utilities.scm \
|
||||
html-acct-table.scm \
|
||||
html-barchart.scm \
|
||||
html-document.scm \
|
||||
html-piechart.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.
|
||||
|
||||
|
||||
@ -202,7 +202,7 @@ We have three different kinds of style control information available:
|
||||
|
||||
- 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 @@ We have three different kinds of style control information available:
|
||||
;; 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))
|
||||
|
||||
1102
src/report/report-system/html-acct-table.scm
Normal file
1102
src/report/report-system/html-acct-table.scm
Normal file
File diff suppressed because it is too large
Load Diff
@ -3,6 +3,8 @@
|
||||
;; for simple style elements.
|
||||
;; Copyright 2000 Bill Gribble <grib@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@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)))))
|
||||
|
||||
@ -1,7 +1,9 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-utilities.scm: Useful functions when using the HTML generator.
|
||||
;; Copyright 2001 Christian Stimming <stimming@tu-harburg.de>
|
||||
;;
|
||||
;; Modified slightly by David Montenegro 2004.06.18.
|
||||
;;
|
||||
;; Copyright 2001 Christian Stimming <stimming@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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -30,6 +30,7 @@ gncscmmod_DATA = \
|
||||
cash-flow.scm \
|
||||
category-barchart.scm \
|
||||
daily-reports.scm \
|
||||
equity-statement.scm \
|
||||
net-barchart.scm \
|
||||
pnl.scm \
|
||||
portfolio.scm \
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
650
src/report/standard-reports/equity-statement.scm
Normal file
650
src/report/standard-reports/equity-statement.scm
Normal file
@ -0,0 +1,650 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; equity-statement.scm: statement of owner's equity (net worth)
|
||||
;;
|
||||
;; By David Montenegro 2004.06.23 <sunrise2000@comcast.net>
|
||||
;;
|
||||
;; * Based on balance-sheet.scm by Robert Merkel <rgmerk@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@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
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user