gnucash maint: [income-statement] single-column doesn't need separate inc/exp tables
Christopher Lam
clam at code.gnucash.org
Thu Mar 24 20:39:33 EDT 2022
Updated via https://github.com/Gnucash/gnucash/commit/a3aa93e7 (commit)
from https://github.com/Gnucash/gnucash/commit/150ca997 (commit)
commit a3aa93e7e08596c2c6dad3a3ea19a32c7afc8bdf
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Mar 23 23:23:17 2022 +0800
[income-statement] single-column doesn't need separate inc/exp tables
disable html-table within html-table for single-column income statement.
Thanks to AdrienM for debugging.
https://lists.gnucash.org/pipermail/gnucash-user/2022-March/100354.html
diff --git a/gnucash/report/reports/standard/income-statement.scm b/gnucash/report/reports/standard/income-statement.scm
index 866eda6bd..ebc53a9cd 100644
--- a/gnucash/report/reports/standard/income-statement.scm
+++ b/gnucash/report/reports/standard/income-statement.scm
@@ -441,10 +441,7 @@
trading-total
(gnc:collector- expense-total)))
- (inc-table (gnc:make-html-table))
- (exp-table (gnc:make-html-table))
- (tra-table (gnc:make-html-table))
-
+ (build-table (gnc:make-html-table))
(table-env
(list
(list 'start-date start-date)
@@ -494,67 +491,86 @@
label 0 1 "text-cell"
bal (+ col 1) 1 "number-cell")))
- (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
- (gnc:html-table-append-row! inc-table space)
- (gnc:html-table-append-row! exp-table space)
- (gnc:html-table-append-row! tra-table space))
- (gnc:report-percent-done 80)
-
- (when label-revenue?
- (add-subtotal-line inc-table (G_ "Revenues") #f #f))
- (gnc:html-table-add-account-balances inc-table revenue-table params)
- (when total-revenue?
- (add-subtotal-line inc-table (G_ "Total Revenue") #f revenue-total))
- (gnc:report-percent-done 85)
-
- (when label-expense?
- (add-subtotal-line exp-table (G_ "Expenses") #f #f))
- (gnc:html-table-add-account-balances exp-table expense-table params)
- (when total-expense?
- (add-subtotal-line exp-table (G_ "Total Expenses") #f expense-total))
-
- (when label-trading?
- (add-subtotal-line tra-table (G_ "Trading") #f #f))
- (gnc:html-table-add-account-balances tra-table trading-table params)
- (when total-trading?
- (add-subtotal-line tra-table (G_ "Total Trading") #f trading-total))
-
- (add-report-line
- (if standard-order? exp-table inc-table)
- (string-append (G_ "Net income") period-for)
- (string-append (G_ "Net loss") period-for)
- net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
-
- ;; add the sections in the desired order to document
- (let ((build-table (gnc:make-html-table))
- (inc-cell (gnc:make-html-table-cell inc-table))
- (tra-cell (if (null? trading-accounts)
- (gnc:html-make-empty-cell)
- (gnc:make-html-table-cell tra-table)))
- (exp-cell (gnc:make-html-table-cell exp-table)))
- (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
- (cond
- ((and two-column? standard-order?)
- (add-cells inc-cell tra-cell exp-cell))
-
- (two-column?
- (add-cells exp-cell inc-cell tra-cell))
-
- (standard-order?
- (add-cells inc-cell)
- (unless (null? trading-accounts) (add-cells tra-cell))
- (add-cells exp-cell))
-
- (else
- (add-cells exp-cell)
- (add-cells inc-cell)
- (unless (null? trading-accounts) (add-cells tra-cell))))
-
- (gnc:html-table-set-style!
- build-table "td"
- 'attribute '("align" "left")
- 'attribute '("valign" "top"))
- (gnc:html-document-add-object! doc build-table))
+ (define (add-revenue-table table)
+ (when label-revenue?
+ (add-subtotal-line table (G_ "Revenues") #f #f))
+ (gnc:html-table-add-account-balances table revenue-table params)
+ (when total-revenue?
+ (add-subtotal-line table (G_ "Total Revenue") #f revenue-total))
+ table)
+
+ (define (add-expense-table table)
+ (when label-expense?
+ (add-subtotal-line table (G_ "Expenses") #f #f))
+ (gnc:html-table-add-account-balances table expense-table params)
+ (when total-expense?
+ (add-subtotal-line table (G_ "Total Expenses") #f expense-total))
+ table)
+
+ (define (add-trading-table table)
+ (when label-trading?
+ (add-subtotal-line table (G_ "Trading") #f #f))
+ (gnc:html-table-add-account-balances table trading-table params)
+ (when total-trading?
+ (add-subtotal-line table (G_ "Total Trading") #f trading-total))
+ table)
+
+ (cond
+ (two-column?
+ (let* ((exp-table (add-expense-table (gnc:make-html-table)))
+ (inc-table (add-revenue-table (gnc:make-html-table)))
+ (tra-table (add-trading-table (gnc:make-html-table)))
+ (inc-cell (gnc:make-html-table-cell inc-table))
+ (tra-cell (if (null? trading-accounts)
+ (gnc:html-make-empty-cell)
+ (gnc:make-html-table-cell tra-table)))
+ (exp-cell (gnc:make-html-table-cell exp-table)))
+ (define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
+ (add-rule (if standard-order? exp-table inc-table))
+ (add-report-line
+ (if standard-order? exp-table inc-table)
+ (string-append (G_ "Net income") period-for)
+ (string-append (G_ "Net loss") period-for)
+ net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
+ (if standard-order?
+ (add-cells inc-cell tra-cell exp-cell)
+ (add-cells exp-cell inc-cell tra-cell))))
+
+ ;; single-column
+ (standard-order?
+ (add-revenue-table build-table)
+ (add-rule build-table)
+ (unless (null? trading-accounts)
+ (add-trading-table build-table)
+ (add-rule build-table))
+ (add-expense-table build-table)
+ (add-rule build-table)
+ (add-report-line
+ build-table
+ (string-append (G_ "Net income") period-for)
+ (string-append (G_ "Net loss") period-for)
+ net-income (* 2 (1- tree-depth)) exchange-fn #f #f))
+
+ (else
+ (add-expense-table build-table)
+ (add-rule build-table)
+ (unless (null? trading-accounts)
+ (add-trading-table build-table)
+ (add-rule build-table))
+ (add-revenue-table build-table)
+ (add-rule build-table)
+ (add-report-line
+ build-table
+ (string-append (G_ "Net income") period-for)
+ (string-append (G_ "Net loss") period-for)
+ net-income (* 2 (1- tree-depth)) exchange-fn #f #f)))
+
+ (gnc:html-table-set-style!
+ build-table "td"
+ 'attribute '("align" "left")
+ 'attribute '("valign" "top"))
+
+ (gnc:html-document-add-object! doc build-table)
;; add currency information if requested
(gnc:report-percent-done 90)
diff --git a/gnucash/report/reports/standard/test/test-balsheet-pnl.scm b/gnucash/report/reports/standard/test/test-balsheet-pnl.scm
index 55dfc90aa..02af288c1 100644
--- a/gnucash/report/reports/standard/test/test-balsheet-pnl.scm
+++ b/gnucash/report/reports/standard/test/test-balsheet-pnl.scm
@@ -369,39 +369,39 @@
(sxml (options->sxml pnl-uuid pnl-options "pnl-default")))
(test-equal "total revenue = $1,270.00"
(list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml))
(test-equal "total expenses = $0.00"
(list "$0.00")
- ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 7) // (td 6) // *text*))
sxml))
(set-option! pnl-options "Commodities" "Price Source" 'weighted-average)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-weighted-average")))
(test-equal "weighted average revenue = $1160.36"
(list "$1,160.36")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'average-cost)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-average-cost")))
(test-equal "average-cost revenue = $976"
(list "$976.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-nearest)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-nearest")))
(test-equal "pricedb-nearest revenue = $1270"
(list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml)))
(set-option! pnl-options "Commodities" "Price Source" 'pricedb-latest)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-pricedb-latest")))
(test-equal "pricedb-latest revenue = $1270"
(list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml)))
;; set multilevel subtotal style
@@ -411,27 +411,27 @@
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-multilevel")))
(test-equal "multilevel. income = -$250.00"
(list "-$250.00")
- ((sxpath '(// table // (tr 1) // table // (tr 3) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 2) // (td 6) // *text*))
sxml))
(test-equal "multilevel. income-GBP = -#600"
(list "-#600.00" "-$1,020.00")
- ((sxpath '(// table // (tr 1) // table // (tr 4) // (td 5) // *text*))
+ ((sxpath '(// table // (tr 3) // (td 5) // *text*))
sxml))
(test-equal "multilevel. total income = -$1,270.00"
(list "-$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 5) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 4) // (td 6) // *text*))
sxml))
(test-equal "multilevel. total revenue = $1,270.00"
(list "$1,270.00")
- ((sxpath '(// table // (tr 1) // table // (tr 6) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 5) // (td 6) // *text*))
sxml))
(test-equal "multilevel. expenses = $0.00"
(list "$0.00")
- ((sxpath '(// table // (tr 2) // table // (tr 3) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 8) // (td 6) // *text*))
sxml))
(test-equal "multilevel. net-income = $1,270"
(list "$1,270.00")
- ((sxpath '(// table // (tr 2) // table // (tr 4) // (td 6) // *text*))
+ ((sxpath '(// table // (tr 9) // (td 6) // *text*))
sxml)))
;; set recursive-subtotal subtotal style
@@ -439,21 +439,21 @@
(set-option! pnl-options "Display" "Parent account subtotals" 'f)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-recursive")))
(test-equal "recursive. income = $1020+250"
- (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
+ (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00")
+ (sxml->table-row-col sxml 1 2 6))
(test-equal "recursive. income-gbp = $1020"
- (list "-#600.00" "-$1,020.00" "-#600.00" "-$1,020.00")
- (sxml->table-row-col sxml 1 4 5))
+ (list "-#600.00" "-$1,020.00")
+ (sxml->table-row-col sxml 1 3 5))
(test-equal "recursive. total revenue = $1270"
- (list "$1,270.00" "$1,270.00")
- (sxml->table-row-col sxml 1 5 6)))
+ (list "$1,270.00")
+ (sxml->table-row-col sxml 1 4 6)))
(set-option! pnl-options "Commodities" "Show Foreign Currencies" #f)
(set-option! pnl-options "Commodities" "Show Exchange Rates" #f)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-disable show-fcur show-rates")))
(test-equal "show-fcur disabled"
- (list "-$1,270.00" "$0.00" "-$1,270.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
+ (list "-$1,270.00")
+ (sxml->table-row-col sxml 1 2 6))
(test-equal "show-rates disabled"
'()
(sxml->table-row-col sxml 2 #f #f)))
@@ -462,8 +462,8 @@
(set-option! pnl-options "Commodities" "Show Exchange Rates" #t)
(let ((sxml (options->sxml pnl-uuid pnl-options "pnl-enable show-fcur show-rates")))
(test-equal "show-fcur enabled"
- (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00" "-#600.00" "-$1,020.00" "-$250.00" "-$250.00" "$0.00")
- (sxml->table-row-col sxml 1 3 6))
+ (list "-#600.00" "-$1,020.00" "-$250.00" "-$250.00")
+ (sxml->table-row-col sxml 1 2 6))
(test-equal "show-rates enabled"
(list "#1.00" "$1.7000")
(sxml->table-row-col sxml 2 #f #f)))
Summary of changes:
.../report/reports/standard/income-statement.scm | 146 ++++++++++++---------
.../reports/standard/test/test-balsheet-pnl.scm | 44 +++----
2 files changed, 103 insertions(+), 87 deletions(-)
More information about the gnucash-changes
mailing list