mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
David Montenegro's patch for trial-balance (bug #144265).
* src/report/standard-reports/trial-balance.scm:
* src/report/standard-reports/standard-reports.scm:
* src/report/standard-reports/Makefile.am
added Trial Balance/Work Sheet report
* src/report/standard-reports/balance-sheet.scm:
added drop-down choices missing in previous version
added support for adjusting/closing entries
* src/report/standard-reports/equity-statement.scm:
added support for adjusting/closing entries
fixed "For Period Covering" label
fixed handling of unrealized gains
investment/draw discrimination based on shares sign
omit unrealized gains when zero
* src/report/report-system/html-acct-table.scm:
* src/report/report-system/html-table.scm:
null reference bug fixes
* src/report/report-system/report-utilities.scm:
added utility functions for accessing splits
and creating double-column balance HTML
gnc:double-col,
gnc:account-get-trans-type-balance-interval,
gnc:account-get-pos-trans-total-interval
* src/report/report-system/commodity-utilities.scm:
* src/report/report-system/html-acct-table.scm:
* src/report/report-system/report-utilities.scm:
moved gnc:commodity-collector-commodity-count and
gnc:uniform-commodity? into commodity-utilities.scm
* src/report/report-system/report-system.scm:
added some additional exports
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@10196 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Derek Atkins
parent
fb8273bc80
commit
2c5f97a8a7
40
ChangeLog
40
ChangeLog
@ -1,3 +1,43 @@
|
||||
2004-07-13 David Montenegro <sunrise2000@comcast.net>
|
||||
|
||||
* src/report/standard-reports/trial-balance.scm:
|
||||
* src/report/standard-reports/standard-reports.scm:
|
||||
* src/report/standard-reports/Makefile.am
|
||||
added Trial Balance/Work Sheet report
|
||||
|
||||
* src/report/standard-reports/balance-sheet.scm:
|
||||
added drop-down choices missing in previous version
|
||||
added support for adjusting/closing entries
|
||||
|
||||
* src/report/standard-reports/equity-statement.scm:
|
||||
added support for adjusting/closing entries
|
||||
fixed "For Period Covering" label
|
||||
fixed handling of unrealized gains
|
||||
investment/draw discrimination based on shares sign
|
||||
omit unrealized gains when zero
|
||||
|
||||
* src/report/report-system/html-acct-table.scm:
|
||||
* src/report/report-system/html-table.scm:
|
||||
null reference bug fixes
|
||||
|
||||
* src/report/report-system/report-utilities.scm:
|
||||
added utility functions for accessing splits
|
||||
and creating double-column balance HTML
|
||||
gnc:double-col,
|
||||
gnc:account-get-trans-type-balance-interval,
|
||||
gnc:account-get-pos-trans-total-interval
|
||||
|
||||
* src/report/report-system/commodity-utilities.scm:
|
||||
* src/report/report-system/html-acct-table.scm:
|
||||
* src/report/report-system/report-utilities.scm:
|
||||
moved gnc:commodity-collector-commodity-count and
|
||||
gnc:uniform-commodity? into commodity-utilities.scm
|
||||
|
||||
* src/report/report-system/report-system.scm:
|
||||
added some additional exports
|
||||
|
||||
Bug #144265
|
||||
|
||||
2004-07-04 Derek Atkins <derek@ihtfp.com>
|
||||
|
||||
* acinclude.m4: create a SCANF_QD_CHECK and make sure both
|
||||
|
||||
@ -906,3 +906,30 @@
|
||||
#f)
|
||||
balance)
|
||||
#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
|
||||
))
|
||||
|
||||
(define (gnc:uniform-commodity? amt report-commodity)
|
||||
;; function to see if the commodity-collector amt
|
||||
;; contains any foreign commodities
|
||||
(let ((elts (gnc:commodity-collector-commodity-count amt))
|
||||
)
|
||||
(or (equal? elts 0)
|
||||
(and (equal? elts 1)
|
||||
(gnc:commodity-collector-contains-commodity?
|
||||
amt report-commodity)
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
@ -62,7 +62,7 @@
|
||||
;;
|
||||
;; 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,
|
||||
;; gnc:make-html-acct-table/accts, gnc:make-html-acct-table/env/accts,
|
||||
;; and gnc:html-table-add-accts! functions.
|
||||
;;
|
||||
;; The gnc:html-acct-table parameters, set with
|
||||
@ -741,10 +741,12 @@
|
||||
(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)))))
|
||||
(let* ((cell (gnc:html-table-get-cell
|
||||
(gnc:_html-acct-table-matrix_ acct-table)
|
||||
row (+ col 1))))
|
||||
(and cell (car (gnc:html-table-cell-data cell)))
|
||||
)
|
||||
)
|
||||
|
||||
(define (gnc:html-acct-table-set-cell! acct-table row col obj)
|
||||
(gnc:html-table-set-cell!
|
||||
@ -753,7 +755,8 @@
|
||||
obj))
|
||||
|
||||
(define (gnc:html-acct-table-get-row-env acct-table row)
|
||||
(gnc:html-acct-table-get-cell acct-table row -1))
|
||||
(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))
|
||||
@ -888,21 +891,6 @@
|
||||
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.
|
||||
|
||||
@ -405,19 +405,25 @@
|
||||
;; (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))
|
||||
(let* ((row (gnc:html-table-get-row table row)))
|
||||
(and row (list-ref-safe row col)))
|
||||
)
|
||||
|
||||
(define (gnc:html-table-get-row table row)
|
||||
(let* ((dd (gnc:html-table-data table))
|
||||
(len (length dd))
|
||||
(len (and dd (length dd)))
|
||||
)
|
||||
(and len
|
||||
(list-ref-safe dd (- (- len 1) row))
|
||||
)
|
||||
(list-ref-safe dd (- (- len 1) row))
|
||||
))
|
||||
|
||||
(define (gnc:html-table-set-cell! table row col . objects)
|
||||
(let ((rowdata #f)
|
||||
(row-loc #f)
|
||||
(l (length (gnc:html-table-data table))))
|
||||
(l (length (gnc:html-table-data table)))
|
||||
(objs (length objects))
|
||||
)
|
||||
;; ensure the row-data is there
|
||||
(if (>= row l)
|
||||
(begin
|
||||
@ -433,8 +439,12 @@
|
||||
(set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
|
||||
|
||||
;; make a table-cell and set the data
|
||||
(let ((tc (gnc:make-html-table-cell)))
|
||||
(apply gnc:html-table-cell-append-objects! tc objects)
|
||||
(let* ((tc (gnc:make-html-table-cell))
|
||||
(first (car objects)))
|
||||
(if (and (equal? objs 1) (gnc:html-table-cell? first))
|
||||
(set! tc first)
|
||||
(apply gnc:html-table-cell-append-objects! tc objects)
|
||||
)
|
||||
(set! rowdata (list-set-safe! rowdata col tc))
|
||||
|
||||
;; add the row-data back to the table
|
||||
|
||||
@ -68,6 +68,7 @@
|
||||
|
||||
;; html-utilities.scm
|
||||
|
||||
(export gnc:html-make-empty-cell)
|
||||
(export gnc:html-make-empty-cells)
|
||||
(export gnc:account-anchor-text)
|
||||
(export gnc:split-anchor-text)
|
||||
@ -593,6 +594,9 @@
|
||||
(export gnc:report-finished)
|
||||
(export gnc:accounts-count-splits)
|
||||
(export gnc:commodity-collector-allzero?)
|
||||
(export gnc:account-get-trans-type-balance-interval)
|
||||
(export gnc:account-get-pos-trans-total-interval)
|
||||
(export gnc:double-col)
|
||||
|
||||
(load-from-path "commodity-utilities.scm")
|
||||
(load-from-path "html-barchart.scm")
|
||||
|
||||
@ -474,17 +474,6 @@
|
||||
(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))
|
||||
@ -706,3 +695,142 @@
|
||||
(gnc:accounts-count-splits (cdr accounts)))
|
||||
0))
|
||||
|
||||
;; Sums up any splits of a certain type affecting a group of accounts.
|
||||
;; the type is an alist '((str "match me") (cased #f) (regexp #f))
|
||||
(define (gnc:account-get-trans-type-balance-interval
|
||||
group type start-date-tp end-date-tp)
|
||||
(let* ((query (gnc:malloc-query))
|
||||
(splits #f)
|
||||
(get-val (lambda (alist key)
|
||||
(let ((lst (assoc-ref alist key)))
|
||||
(if lst (car lst) lst))))
|
||||
(matchstr (get-val type 'str))
|
||||
(case-sens (if (get-val type 'cased) 1 0))
|
||||
(regexp (if (get-val type 'regexp) 1 0))
|
||||
(total (gnc:make-commodity-collector))
|
||||
)
|
||||
(gnc:query-set-book query (gnc:get-current-book))
|
||||
(gnc:query-set-match-non-voids-only! query (gnc:get-current-book))
|
||||
(gnc:query-add-account-match query group 'guid-match-any 'query-and)
|
||||
(gnc:query-add-date-match-timepair
|
||||
query
|
||||
(and start-date-tp #t) start-date-tp
|
||||
(and end-date-tp #t) end-date-tp 'query-and)
|
||||
(gnc:query-add-description-match
|
||||
query matchstr case-sens regexp 'query-and)
|
||||
|
||||
(set! splits (gnc:query-get-splits query))
|
||||
(map (lambda (split)
|
||||
(let* ((shares (gnc:split-get-amount split))
|
||||
(acct-comm (gnc:account-get-commodity
|
||||
(gnc:split-get-account split)))
|
||||
)
|
||||
(gnc:commodity-collector-add total acct-comm shares)
|
||||
)
|
||||
)
|
||||
splits
|
||||
)
|
||||
(gnc:free-query query)
|
||||
total
|
||||
)
|
||||
)
|
||||
|
||||
;; similar, but only counts transactions with non-negative shares and
|
||||
;; *ignores* any closing entries
|
||||
(define (gnc:account-get-pos-trans-total-interval
|
||||
group type start-date-tp end-date-tp)
|
||||
(let* ((str-query (gnc:malloc-query))
|
||||
(sign-query (gnc:malloc-query))
|
||||
(total-query #f)
|
||||
(splits #f)
|
||||
(get-val (lambda (alist key)
|
||||
(let ((lst (assoc-ref alist key)))
|
||||
(if lst (car lst) lst))))
|
||||
(matchstr (get-val type 'str))
|
||||
(case-sens (if (get-val type 'cased) 1 0))
|
||||
(regexp (if (get-val type 'regexp) 1 0))
|
||||
(total (gnc:make-commodity-collector))
|
||||
)
|
||||
(gnc:query-set-book str-query (gnc:get-current-book))
|
||||
(gnc:query-set-book sign-query (gnc:get-current-book))
|
||||
(gnc:query-set-match-non-voids-only! str-query (gnc:get-current-book))
|
||||
(gnc:query-set-match-non-voids-only! sign-query (gnc:get-current-book))
|
||||
(gnc:query-add-account-match str-query group 'guid-match-any 'query-and)
|
||||
(gnc:query-add-account-match sign-query group 'guid-match-any 'query-and)
|
||||
(gnc:query-add-date-match-timepair
|
||||
str-query
|
||||
(and start-date-tp #t) start-date-tp
|
||||
(and end-date-tp #t) end-date-tp 'query-and)
|
||||
(gnc:query-add-date-match-timepair
|
||||
sign-query
|
||||
(and start-date-tp #t) start-date-tp
|
||||
(and end-date-tp #t) end-date-tp 'query-and)
|
||||
(gnc:query-add-description-match
|
||||
str-query matchstr case-sens regexp 'query-and)
|
||||
(set! total-query
|
||||
(gnc:query-merge sign-query (gnc:query-invert str-query) 'query-and))
|
||||
|
||||
(set! splits (gnc:query-get-splits total-query))
|
||||
(map (lambda (split)
|
||||
(let* ((shares (gnc:split-get-amount split))
|
||||
(acct-comm (gnc:account-get-commodity
|
||||
(gnc:split-get-account split)))
|
||||
)
|
||||
(or (gnc:numeric-negative-p shares)
|
||||
(gnc:commodity-collector-add total acct-comm shares)
|
||||
)
|
||||
)
|
||||
)
|
||||
splits
|
||||
)
|
||||
(gnc:free-query total-query)
|
||||
total
|
||||
)
|
||||
)
|
||||
|
||||
;; utility to assist with double-column balance tables
|
||||
;; a request is made with the <req> argument
|
||||
;; <req> may currently be 'entry|'debit-q|'credit-q|'zero-q|'debit|'credit
|
||||
;; 'debit-q|'credit-q|'zero-q tests the sign of the balance
|
||||
;; 'side returns 'debit or 'credit, the column in which to display
|
||||
;; 'debt|'credit return the entry, if appropriate, or #f
|
||||
(define (gnc:double-col
|
||||
req signed-balance report-commodity exchange-fn show-comm?)
|
||||
(let* ((sum (and signed-balance
|
||||
(gnc:sum-collector-commodity
|
||||
signed-balance
|
||||
report-commodity
|
||||
exchange-fn)))
|
||||
(amt (and sum (gnc:gnc-monetary-amount sum)))
|
||||
(neg? (and amt (gnc:numeric-negative-p amt)))
|
||||
(bal (if neg?
|
||||
(let ((bal (gnc:make-commodity-collector)))
|
||||
(bal 'minusmerge signed-balance #f)
|
||||
bal)
|
||||
signed-balance))
|
||||
(bal-sum (gnc:sum-collector-commodity
|
||||
bal
|
||||
report-commodity
|
||||
exchange-fn))
|
||||
(balance
|
||||
(if (gnc:uniform-commodity? bal report-commodity)
|
||||
(if (gnc:numeric-zero-p amt) #f bal-sum)
|
||||
(if show-comm?
|
||||
(gnc:commodity-table bal report-commodity exchange-fn)
|
||||
bal-sum)
|
||||
))
|
||||
)
|
||||
(car (assoc-ref
|
||||
(list
|
||||
(list 'entry balance)
|
||||
(list 'debit (if neg? #f balance))
|
||||
(list 'credit (if neg? balance #f))
|
||||
(list 'zero-q (if neg? #f (if balance #f #t)))
|
||||
(list 'debit-q (if neg? #f (if balance #t #f)))
|
||||
(list 'credit-q (if neg? #t #f))
|
||||
)
|
||||
req
|
||||
))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
@ -37,6 +37,7 @@ gncscmmod_DATA = \
|
||||
price-scatter.scm \
|
||||
register.scm \
|
||||
standard-reports.scm \
|
||||
trial-balance.scm \
|
||||
transaction.scm
|
||||
|
||||
EXTRA_DIST = ${gncscmmod_DATA}
|
||||
|
||||
@ -30,6 +30,7 @@
|
||||
;;
|
||||
;; Line & column alignments still do not conform with
|
||||
;; textbook accounting practice (they're close though!).
|
||||
;; The 'canonically-tabbed option is currently broken.
|
||||
;;
|
||||
;; Progress bar functionality is currently mostly broken.
|
||||
;;
|
||||
@ -101,13 +102,12 @@
|
||||
(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-parent-balance-mode (N_ "Parent account balances"))
|
||||
(define opthelp-parent-balance-mode
|
||||
(N_ "How to show any balance in parent accounts"))
|
||||
(define optname-parent-total-mode (N_ "Parent account subtotals"))
|
||||
(define opthelp-parent-total-mode
|
||||
(N_ "How to show account subtotals for selected accounts having children"))
|
||||
|
||||
(define optname-show-zb-accts (N_ "Include accounts with zero total balances"))
|
||||
(define opthelp-show-zb-accts
|
||||
@ -272,14 +272,36 @@
|
||||
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" opthelp-show-parent-balance #t))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
gnc:pagename-display optname-show-parent-total
|
||||
"d" opthelp-show-parent-total #f))
|
||||
(add-option
|
||||
(gnc:make-multichoice-option
|
||||
gnc:pagename-display optname-parent-balance-mode
|
||||
"c" opthelp-parent-balance-mode
|
||||
'immediate-bal
|
||||
(list (vector 'immediate-bal
|
||||
(N_ "Show Immediate Balance")
|
||||
(N_ "Show only the balance in the parent account, excluding any subaccounts"))
|
||||
(vector 'recursive-bal
|
||||
(N_ "Recursive Balance")
|
||||
(N_ "Include subaccounts in balance"))
|
||||
(vector 'omit-bal
|
||||
(N_ "Omit Balance")
|
||||
(N_ "Do not show parent account balances")))))
|
||||
(add-option
|
||||
(gnc:make-multichoice-option
|
||||
gnc:pagename-display optname-parent-total-mode
|
||||
"d" opthelp-parent-total-mode
|
||||
'f
|
||||
(list (vector 't
|
||||
(N_ "Show subtotals")
|
||||
(N_ "Show subtotals for selected accounts which have subaccounts"))
|
||||
(vector 'f
|
||||
(N_ "Do not show subtotals")
|
||||
(N_ "Do not subtotal selected parent accounts"))
|
||||
(vector 'canonically-tabbed
|
||||
;;(N_ "Subtotals indented text book style")
|
||||
(N_ "Text book style (experimental)")
|
||||
(N_ "Show parent account subtotals, indented per text book practice (experimental)")))))
|
||||
|
||||
;; some detailed formatting options
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
@ -362,10 +384,13 @@
|
||||
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))
|
||||
(parent-balance-mode (get-option gnc:pagename-display
|
||||
optname-parent-balance-mode))
|
||||
(parent-total-mode
|
||||
(car
|
||||
(assoc-ref '((t #t) (f #f) (canonically-tabbed canonically-tabbed))
|
||||
(get-option gnc:pagename-display
|
||||
optname-parent-total-mode))))
|
||||
(show-zb-accts? (get-option gnc:pagename-display
|
||||
optname-show-zb-accts))
|
||||
(omit-zb-bals? (get-option gnc:pagename-display
|
||||
@ -409,7 +434,7 @@
|
||||
;; (asset, liability, equity) have the same width.
|
||||
(tree-depth (if (equal? depth-limit 'all)
|
||||
(gnc:get-current-group-depth)
|
||||
depth-limit))
|
||||
depth-limit))
|
||||
;; exchange rates calculation parameters
|
||||
(exchange-fn
|
||||
(gnc:case-exchange-fn price-source report-commodity date-tp))
|
||||
@ -420,6 +445,7 @@
|
||||
(define (add-subtotal-line table pos-label neg-label signed-balance)
|
||||
(define allow-same-column-totals #t)
|
||||
(let* ((neg? (and signed-balance
|
||||
neg-label
|
||||
(gnc:numeric-negative-p
|
||||
(gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
@ -459,7 +485,7 @@
|
||||
|
||||
;;(gnc:warn "account names" liability-account-names)
|
||||
(gnc:html-document-set-title!
|
||||
doc (string-append report-title " " company-name " "
|
||||
doc (string-append company-name " " report-title " "
|
||||
(gnc:print-date date-tp))
|
||||
)
|
||||
|
||||
@ -616,7 +642,7 @@
|
||||
'summarize))
|
||||
(list 'report-commodity report-commodity)
|
||||
(list 'exchange-fn exchange-fn)
|
||||
(list 'parent-account-subtotal-mode show-parent-total?)
|
||||
(list 'parent-account-subtotal-mode parent-total-mode)
|
||||
(list 'zero-balance-mode (if show-zb-accts?
|
||||
'show-leaf-acct
|
||||
'omit-leaf-acct))
|
||||
@ -627,11 +653,7 @@
|
||||
)
|
||||
(set! params
|
||||
(list
|
||||
(list 'parent-account-balance-mode
|
||||
(if show-parent-balance?
|
||||
'immediate-bal
|
||||
'omit-bal
|
||||
))
|
||||
(list 'parent-account-balance-mode parent-balance-mode)
|
||||
(list 'zero-balance-display-mode (if omit-zb-bals?
|
||||
'omit-balance
|
||||
'show-balance))
|
||||
|
||||
@ -19,7 +19,8 @@
|
||||
;; statement to no more than daily resolution.
|
||||
;;
|
||||
;; The Accounts option panel needs a way to select (and select by
|
||||
;; default) capital and draw accounts.
|
||||
;; default) capital and draw accounts. There really should be a
|
||||
;; contra account type or attribute....
|
||||
;;
|
||||
;; The variables in this code could use more consistent naming.
|
||||
;;
|
||||
@ -87,6 +88,19 @@
|
||||
(define optname-show-rates (N_ "Show Exchange Rates"))
|
||||
(define opthelp-show-rates (N_ "Show the exchange rates used"))
|
||||
|
||||
(define pagename-entries (N_ "Entries"))
|
||||
(define optname-closing-pattern (N_ "Closing Entries pattern"))
|
||||
(define opthelp-closing-pattern
|
||||
(N_ "Any text in the Description column which identifies closing entries"))
|
||||
(define optname-closing-casing
|
||||
(N_ "Closing Entries pattern is case-sensitive"))
|
||||
(define opthelp-closing-casing
|
||||
(N_ "Causes the Closing Entries Pattern match to be case-sensitive"))
|
||||
(define optname-closing-regexp
|
||||
(N_ "Closing Entries Pattern is regular expression"))
|
||||
(define opthelp-closing-regexp
|
||||
(N_ "Causes the Closing Entries Pattern to be treated as a regular expression"))
|
||||
|
||||
;; 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.
|
||||
@ -189,6 +203,23 @@
|
||||
gnc:pagename-display optname-use-rules
|
||||
"f" opthelp-use-rules #f))
|
||||
|
||||
;; adjusting/closing entry match criteria
|
||||
;;
|
||||
;; N.B.: transactions really should have a field where we can put
|
||||
;; transaction types like "Adjusting/Closing/Correcting Entries"
|
||||
(add-option
|
||||
(gnc:make-string-option
|
||||
pagename-entries optname-closing-pattern
|
||||
"a" opthelp-closing-pattern (N_ "Closing Entries")))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-entries optname-closing-casing
|
||||
"b" opthelp-closing-casing #f))
|
||||
(add-option
|
||||
(gnc:make-simple-boolean-option
|
||||
pagename-entries optname-closing-regexp
|
||||
"c" opthelp-closing-regexp #f))
|
||||
|
||||
;; Set the accounts page as default option tab
|
||||
(gnc:options-set-default-section options gnc:pagename-accounts)
|
||||
|
||||
@ -241,6 +272,12 @@
|
||||
optname-show-rates))
|
||||
(use-rules? (get-option gnc:pagename-display
|
||||
optname-use-rules))
|
||||
(closing-str (get-option pagename-entries
|
||||
optname-closing-pattern))
|
||||
(closing-cased (get-option pagename-entries
|
||||
optname-closing-casing))
|
||||
(closing-regexp (get-option pagename-entries
|
||||
optname-closing-regexp))
|
||||
|
||||
;; decompose the account list
|
||||
(split-up-accounts (gnc:decompose-accountlist accounts))
|
||||
@ -257,6 +294,16 @@
|
||||
;; these must still be split-out and itemized separately
|
||||
(capital-accounts #f)
|
||||
(drawing-accounts #f)
|
||||
(investments #f)
|
||||
(withdrawals #f)
|
||||
(net-investment #f)
|
||||
(income-expense-closing #f)
|
||||
(closing-pattern
|
||||
(list (list 'str closing-str)
|
||||
(list 'cased closing-cased)
|
||||
(list 'regexp closing-regexp)
|
||||
)
|
||||
)
|
||||
|
||||
(doc (gnc:make-html-document))
|
||||
;; exchange rates calculation parameters
|
||||
@ -271,11 +318,11 @@
|
||||
(gnc:html-document-set-title!
|
||||
doc (sprintf #f
|
||||
(string-append "%s %s "
|
||||
(N_ "For Period")
|
||||
(N_ "For Period Covering")
|
||||
" %s "
|
||||
(N_ "to")
|
||||
" %s")
|
||||
report-title company-name
|
||||
company-name report-title
|
||||
(gnc:print-date start-date-printable)
|
||||
(gnc:print-date end-date-tp)))
|
||||
|
||||
@ -303,6 +350,8 @@
|
||||
(neg-start-equity-balance #f)
|
||||
(neg-end-equity-balance #f)
|
||||
|
||||
;; these variables wont be used until gnucash gets
|
||||
;; conta account types
|
||||
(start-capital-balance #f)
|
||||
(end-capital-balance #f)
|
||||
(start-drawing-balance #f)
|
||||
@ -315,14 +364,14 @@
|
||||
(end-unrealized-gains #f)
|
||||
(net-unrealized-gains #f)
|
||||
|
||||
(start-total-equity #f)
|
||||
(end-total-equity #f)
|
||||
|
||||
(investments #f)
|
||||
(draws #f)
|
||||
(equity-closing #f)
|
||||
(neg-pre-closing-equity #f)
|
||||
|
||||
(capital-increase #f)
|
||||
|
||||
(start-total-equity #f)
|
||||
(end-total-equity #f)
|
||||
|
||||
;; Create the account table below where its
|
||||
;; percentage time can be tracked.
|
||||
(build-table (gnc:make-html-table)) ;; gnc:html-table
|
||||
@ -350,6 +399,7 @@
|
||||
table pos-label neg-label amount col
|
||||
exchange-fn rule? row-style)
|
||||
(let* ((neg? (and amount
|
||||
neg-label
|
||||
(gnc:numeric-negative-p
|
||||
(gnc:gnc-monetary-amount
|
||||
(gnc:sum-collector-commodity
|
||||
@ -363,10 +413,11 @@
|
||||
(bal (gnc:sum-collector-commodity
|
||||
pos-bal report-commodity exchange-fn))
|
||||
(balance
|
||||
(or (and (gnc:uniform-commodity? bal report-commodity) bal)
|
||||
(or (and (gnc:uniform-commodity? pos-bal report-commodity)
|
||||
bal)
|
||||
(and show-fucr?
|
||||
(gnc:commodity-table
|
||||
bal report-commodity exchange-fn))
|
||||
pos-bal report-commodity exchange-fn))
|
||||
bal
|
||||
))
|
||||
(column (or col 0))
|
||||
@ -444,12 +495,26 @@
|
||||
(accountlist-get-comm-balance-at-date
|
||||
income-expense-accounts
|
||||
forever-ago end-date-tp)) ; OK
|
||||
;; neg-pre-end-retained-earnings is not used to calculate
|
||||
;; profit but is used to calculate unrealized gains
|
||||
|
||||
;; calculate net income
|
||||
;; first, ask out how much profit/loss was closed
|
||||
(set! income-expense-closing
|
||||
(gnc:account-get-trans-type-balance-interval
|
||||
income-expense-accounts closing-pattern
|
||||
start-date-tp end-date-tp)
|
||||
)
|
||||
;; find retained earnings for the period
|
||||
(set! neg-net-income
|
||||
(accountlist-get-comm-balance-at-date
|
||||
income-expense-accounts
|
||||
start-date-tp end-date-tp)) ; OK
|
||||
;; revert the income/expense to its pre-closing balance
|
||||
(neg-net-income 'minusmerge income-expense-closing #f)
|
||||
(set! net-income (gnc:make-commodity-collector))
|
||||
(net-income 'minusmerge neg-net-income #f)
|
||||
;; now we know the net income for the period
|
||||
|
||||
;; start and end (unadjusted) equity balances
|
||||
(set! neg-start-equity-balance
|
||||
@ -458,6 +523,8 @@
|
||||
(set! neg-end-equity-balance
|
||||
(gnc:accounts-get-comm-total-assets
|
||||
equity-accounts get-end-balance-fn)) ; OK
|
||||
;; neg-end-equity-balance is used to calculate unrealized
|
||||
;; gains and investments/withdrawals
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
@ -482,6 +549,10 @@
|
||||
(unrealized-gains-at-date start-book-balance
|
||||
start-exchange-fn
|
||||
start-date-tp)) ; OK
|
||||
;; I suspect that unrealized gains (since never realized)
|
||||
;; must be counted from forever-ago....
|
||||
;; ...yep, this appears to be correct.
|
||||
(set! start-unrealized-gains (gnc:make-commodity-collector))
|
||||
(set! end-unrealized-gains
|
||||
(unrealized-gains-at-date end-book-balance
|
||||
end-exchange-fn
|
||||
@ -492,17 +563,6 @@
|
||||
(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...
|
||||
;;
|
||||
@ -511,21 +571,52 @@
|
||||
;; bit... i'll do a transaction query and classify the
|
||||
;; splits by debit/credit.
|
||||
;;
|
||||
;; withdrawals = investments - (investments - withdrawals)
|
||||
;; investments = withdrawals + (investments - withdrawals)
|
||||
;;
|
||||
;; assume that positive shares on an equity account are debits...
|
||||
;;
|
||||
|
||||
;; 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
|
||||
(set! equity-closing
|
||||
(gnc:account-get-trans-type-balance-interval
|
||||
equity-accounts closing-pattern
|
||||
start-date-tp end-date-tp)
|
||||
)
|
||||
(set! neg-pre-closing-equity (gnc:make-commodity-collector))
|
||||
(neg-pre-closing-equity 'merge neg-end-equity-balance #f)
|
||||
(neg-pre-closing-equity 'minusmerge equity-closing #f)
|
||||
|
||||
(set! net-investment (gnc:make-commodity-collector)) ;; 0
|
||||
(net-investment 'minusmerge neg-pre-closing-equity #f);; > 0
|
||||
(net-investment 'merge neg-start-equity-balance #f) ;; net increase
|
||||
|
||||
(set! withdrawals (gnc:make-commodity-collector))
|
||||
(withdrawals 'merge (gnc:account-get-pos-trans-total-interval
|
||||
equity-accounts closing-pattern
|
||||
start-date-tp end-date-tp)
|
||||
#f)
|
||||
(set! investments (gnc:make-commodity-collector))
|
||||
(investments 'merge net-investment #f)
|
||||
(investments 'merge withdrawals #f)
|
||||
|
||||
;; 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 'minusmerge withdrawals #f)
|
||||
(capital-increase 'merge net-unrealized-gains #f)
|
||||
|
||||
;; starting 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
|
||||
|
||||
;; ending total equity
|
||||
(set! end-total-equity (gnc:make-commodity-collector))
|
||||
(end-total-equity 'merge start-total-equity #f)
|
||||
(end-total-equity 'merge capital-increase #f) ; OK
|
||||
|
||||
(gnc:report-percent-done 30)
|
||||
|
||||
;; Workaround to force gtkhtml into displaying wide
|
||||
@ -555,18 +646,27 @@
|
||||
)
|
||||
(report-line
|
||||
build-table
|
||||
(string-append (N_ "Investments less withdrawals") period-for)
|
||||
(string-append (N_ "Investments") 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
|
||||
(string-append (N_ "Withdrawals") period-for)
|
||||
#f
|
||||
withdrawals
|
||||
0 end-exchange-fn #f #f
|
||||
)
|
||||
(or (gnc:commodity-collector-allzero? net-unrealized-gains)
|
||||
(report-line
|
||||
build-table
|
||||
(N_ "Unrealized gains")
|
||||
(N_ "Unrealized losses")
|
||||
net-unrealized-gains
|
||||
0 end-exchange-fn #f #f
|
||||
)
|
||||
)
|
||||
(report-line
|
||||
build-table
|
||||
(N_ "Increase in capital")
|
||||
|
||||
@ -22,6 +22,22 @@
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; FIXME
|
||||
;;
|
||||
;; Note: the current P&L report must be done before closing, when
|
||||
;; there are still balances in your income/expense accounts. if run
|
||||
;; post-closing, this implementation will report zero profit. in
|
||||
;; other words, users will generally want to run this report after
|
||||
;; adjustments but before closing. this code really should filter-out
|
||||
;; closing (but not adjusting) entries and report on what is left....
|
||||
;;
|
||||
;; (see equity-statement.scm for an example of how to do this)
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(define-module (gnucash report pnl))
|
||||
|
||||
(use-modules (gnucash main)) ;; FIXME: delete after we finish modularizing.
|
||||
@ -35,7 +51,7 @@
|
||||
|
||||
;; Profit and loss report. Actually, people in finances might want
|
||||
;; something different under this name, but they are welcomed to
|
||||
;; contribute their changes :-)
|
||||
;; contribute their changes :-) (perhaps income statement)
|
||||
|
||||
(define reportname (N_ "Profit And Loss"))
|
||||
|
||||
|
||||
@ -80,6 +80,7 @@
|
||||
(use-modules (gnucash report portfolio))
|
||||
(use-modules (gnucash report price-scatter))
|
||||
(use-modules (gnucash report register))
|
||||
(use-modules (gnucash report trial-balance))
|
||||
(use-modules (gnucash report transaction))
|
||||
|
||||
(use-modules (gnucash gnc-module))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user