As was discussed on irc yesterday (http://lists.gnucash.org/logs/2007/10/2007-10-17.html#T13:39:55), here is a patch for a two-column income-statement. Seems kinda silly to me, but apparently the germans really want this, so there it is ;)
meanwhile, its also here: http://bugzilla.gnome.org/show_bug.cgi?id=488004 thanks A
Index: src/report/standard-reports/income-statement.scm
===================================================================
--- src/report/standard-reports/income-statement.scm (revision 16566)
+++ src/report/standard-reports/income-statement.scm (working copy)
@@ -123,6 +123,10 @@
(N_ "Closing Entries Pattern is regular expression"))
(define opthelp-closing-regexp
(N_ "Causes the Closing Entries Pattern to be treated as a regular expression"))
+(define optname-two-column
+ (N_ "Display as a two column report"))
+(define opthelp-two-column
+ (N_ "Divides the report into an income column and an expense column"))
;; options generator
(define (income-statement-options-generator)
@@ -225,10 +229,16 @@
(gnc:make-simple-boolean-option
gnc:pagename-display optname-label-expense
"i" opthelp-label-expense #t))
+
(add-option
(gnc:make-simple-boolean-option
gnc:pagename-display optname-total-expense
"j" opthelp-total-expense #t))
+
+ (add-option
+ (gnc:make-simple-boolean-option
+ gnc:pagename-display optname-two-column
+ "k" opthelp-two-column #f))
;; closing entry match criteria
;;
@@ -323,6 +333,8 @@
optname-closing-casing))
(closing-regexp (get-option pagename-entries
optname-closing-regexp))
+ (two-column? (get-option gnc:pagename-display
+ optname-two-column))
(closing-pattern
(list (list 'str closing-str)
(list 'cased closing-cased)
@@ -331,7 +343,7 @@
)
(indent 0)
(tabbing #f)
-
+
;; decompose the account list
(split-up-accounts (gnc:decompose-accountlist accounts))
(revenue-accounts (assoc-ref split-up-accounts ACCT-TYPE-INCOME))
@@ -421,7 +433,14 @@
;; Create the account tables below where their
;; percentage time can be tracked.
- (build-table (gnc:make-html-table)) ;; gnc:html-table
+ (left-table (gnc:make-html-table)) ;; gnc:html-table
+
+ ;; this is sneaky. for a one column report (the default) we
+ ;; just point back to the very same object as above so all
+ ;; actions happen to the one table. ;-P
+ (right-table (if two-column?
+ (gnc:make-html-table)
+ left-table))
(table-env #f) ;; parameters for :make-
(params #f) ;; and -add-account-
(revenue-table #f) ;; gnc:html-acct-table
@@ -437,147 +456,169 @@
)
)
- ;; 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
- neg-label
- (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)
+ ;; 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
+ neg-label
+ (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? pos-bal report-commodity)
bal)
- amount))
- (bal (gnc:sum-collector-commodity
- pos-bal report-commodity exchange-fn))
- (balance
- (or (and (gnc:uniform-commodity? pos-bal report-commodity)
- bal)
- (and show-fcur?
- (gnc-commodity-table
- pos-bal report-commodity exchange-fn))
- bal
- ))
- (column (or col 0))
+ (and show-fcur?
+ (gnc-commodity-table
+ pos-bal report-commodity exchange-fn))
+ bal
+ ))
+ (column (or col 0))
+ )
+ (gnc:html-table-add-labeled-amount-line!
+ table (* 2 tree-depth) row-style rule?
+ label 0 1 "text-cell"
+ bal (+ col 1) 1 "number-cell")
)
- (gnc:html-table-add-labeled-amount-line!
- table (* 2 tree-depth) row-style rule?
- label 0 1 "text-cell"
- bal (+ col 1) 1 "number-cell")
- )
- )
-
- ;; sum revenues and expenses
- (set! revenue-closing
- (gnc:account-get-trans-type-balance-interval
- revenue-accounts closing-pattern
- start-date-tp end-date-tp)
- ) ;; this is norm positive (debit)
- (set! expense-closing
- (gnc:account-get-trans-type-balance-interval
- expense-accounts closing-pattern
- start-date-tp end-date-tp)
- ) ;; this is norm negative (credit)
- (set! expense-total
- (gnc:accountlist-get-comm-balance-interval
- expense-accounts
- start-date-tp end-date-tp))
- (expense-total 'minusmerge expense-closing #f)
- (set! neg-revenue-total
- (gnc:accountlist-get-comm-balance-interval
- revenue-accounts
- start-date-tp end-date-tp))
- (neg-revenue-total 'minusmerge revenue-closing #f)
- (set! revenue-total (gnc:make-commodity-collector))
- (revenue-total 'minusmerge neg-revenue-total #f)
- ;; calculate net income
- (set! net-income (gnc:make-commodity-collector))
- (net-income 'merge revenue-total #f)
- (net-income 'minusmerge expense-total #f)
-
- (set! table-env
- (list
- (list 'start-date start-date-tp)
- (list 'end-date end-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 parent-total-mode)
- (list 'zero-balance-mode (if show-zb-accts?
- 'show-leaf-acct
- 'omit-leaf-acct))
- (list 'account-label-mode (if use-links?
- 'anchor
- 'name))
- ;; we may, at some point, want to add an option to
- ;; generate a pre-adjustment income statement...
- (list 'balance-mode 'pre-closing)
- (list 'closing-pattern closing-pattern)
)
- )
- (set! params
- (list
- (list 'parent-account-balance-mode parent-balance-mode)
- (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?)
- )
- )
-
- ;; Workaround to force gtkhtml into displaying wide
- ;; enough columns.
- (let ((space
- (make-list tree-depth " \
+
+ ;; sum revenues and expenses
+ (set! revenue-closing
+ (gnc:account-get-trans-type-balance-interval
+ revenue-accounts closing-pattern
+ start-date-tp end-date-tp)
+ ) ;; this is norm positive (debit)
+ (set! expense-closing
+ (gnc:account-get-trans-type-balance-interval
+ expense-accounts closing-pattern
+ start-date-tp end-date-tp)
+ ) ;; this is norm negative (credit)
+ (set! expense-total
+ (gnc:accountlist-get-comm-balance-interval
+ expense-accounts
+ start-date-tp end-date-tp))
+ (expense-total 'minusmerge expense-closing #f)
+ (set! neg-revenue-total
+ (gnc:accountlist-get-comm-balance-interval
+ revenue-accounts
+ start-date-tp end-date-tp))
+ (neg-revenue-total 'minusmerge revenue-closing #f)
+ (set! revenue-total (gnc:make-commodity-collector))
+ (revenue-total 'minusmerge neg-revenue-total #f)
+ ;; calculate net income
+ (set! net-income (gnc:make-commodity-collector))
+ (net-income 'merge revenue-total #f)
+ (net-income 'minusmerge expense-total #f)
+
+ (set! table-env
+ (list
+ (list 'start-date start-date-tp)
+ (list 'end-date end-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 parent-total-mode)
+ (list 'zero-balance-mode (if show-zb-accts?
+ 'show-leaf-acct
+ 'omit-leaf-acct))
+ (list 'account-label-mode (if use-links?
+ 'anchor
+ 'name))
+ ;; we may, at some point, want to add an option to
+ ;; generate a pre-adjustment income statement...
+ (list 'balance-mode 'pre-closing)
+ (list 'closing-pattern closing-pattern)
+ )
+ )
+ (set! params
+ (list
+ (list 'parent-account-balance-mode parent-balance-mode)
+ (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?)
+ )
+ )
+
+ ;; Workaround to force gtkhtml into displaying wide
+ ;; enough columns.
+ (let ((space
+ (make-list tree-depth " \
\
")
- ))
- (gnc:html-table-append-row! build-table space)
- )
-
+ ))
+ (gnc:html-table-append-row! left-table space)
+ (if two-column?
+ (gnc:html-table-append-row! right-table space))
+ )
+
(gnc:report-percent-done 80)
(if label-revenue?
- (add-subtotal-line build-table (_ "Revenues") #f #f))
+ (add-subtotal-line left-table (_ "Revenues") #f #f))
(set! revenue-table
(gnc:make-html-acct-table/env/accts
table-env revenue-accounts))
(gnc:html-table-add-account-balances
- build-table revenue-table params)
+ left-table revenue-table params)
(if total-revenue?
(add-subtotal-line
- build-table (_ "Total Revenue") #f revenue-total))
+ left-table (_ "Total Revenue") #f revenue-total))
(gnc:report-percent-done 85)
(if label-expense?
(add-subtotal-line
- build-table (_ "Expenses") #f #f))
+ right-table (_ "Expenses") #f #f))
(set! expense-table
(gnc:make-html-acct-table/env/accts
table-env expense-accounts))
(gnc:html-table-add-account-balances
- build-table expense-table params)
+ right-table expense-table params)
(if total-expense?
(add-subtotal-line
- build-table (_ "Total Expenses") #f expense-total))
+ right-table (_ "Total Expenses") #f expense-total))
(report-line
- build-table
+ right-table
(string-append (_ "Net income") period-for)
(string-append (_ "Net loss") period-for)
net-income
(* 2 (- tree-depth 1)) exchange-fn #f #f
)
- (gnc:html-document-add-object! doc build-table)
+ (gnc:html-document-add-object!
+ doc
+ (if (not two-column?)
+ 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)
signature.asc
Description: Digital signature
_______________________________________________ gnucash-devel mailing list [email protected] https://lists.gnucash.org/mailman/listinfo/gnucash-devel
