From a3aa93e7e08596c2c6dad3a3ea19a32c7afc8bdf Mon Sep 17 00:00:00 2001 From: Christopher Lam Date: Wed, 23 Mar 2022 23:23:17 +0800 Subject: [PATCH] [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 --- .../reports/standard/income-statement.scm | 146 ++++++++++-------- .../standard/test/test-balsheet-pnl.scm | 44 +++--- 2 files changed, 103 insertions(+), 87 deletions(-) diff --git a/gnucash/report/reports/standard/income-statement.scm b/gnucash/report/reports/standard/income-statement.scm index 866eda6bdc..ebc53a9cd3 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 55dfc90aab..02af288c15 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)))