gnucash master: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Thu Oct 3 01:27:56 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/eb58bca7 (commit)
via https://github.com/Gnucash/gnucash/commit/315bbb5d (commit)
via https://github.com/Gnucash/gnucash/commit/d47e49c2 (commit)
via https://github.com/Gnucash/gnucash/commit/c6195d6e (commit)
via https://github.com/Gnucash/gnucash/commit/f015a968 (commit)
via https://github.com/Gnucash/gnucash/commit/5d15fd41 (commit)
via https://github.com/Gnucash/gnucash/commit/34c677d7 (commit)
via https://github.com/Gnucash/gnucash/commit/3452c33c (commit)
via https://github.com/Gnucash/gnucash/commit/1dfd7c55 (commit)
via https://github.com/Gnucash/gnucash/commit/992f657c (commit)
via https://github.com/Gnucash/gnucash/commit/8f1c82e8 (commit)
via https://github.com/Gnucash/gnucash/commit/34bb47e2 (commit)
via https://github.com/Gnucash/gnucash/commit/bf202d14 (commit)
via https://github.com/Gnucash/gnucash/commit/621c857b (commit)
from https://github.com/Gnucash/gnucash/commit/0c65c41b (commit)
commit eb58bca7afafe3eb06bdb18e5df6662b38d72c25
Merge: 0c65c41b3 315bbb5d0
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 13:27:16 2019 +0800
Merge branch 'maint'
diff --cc gnucash/report/reports/standard/test/test-budget.scm
index 34e43278c,21e506316..cf7759683
--- a/gnucash/report/reports/standard/test/test-budget.scm
+++ b/gnucash/report/reports/standard/test/test-budget.scm
@@@ -30,10 -30,12 +30,12 @@@
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (sw_engine))
-(use-modules (gnucash report standard-reports budget))
-(use-modules (gnucash report standard-reports budget-income-statement))
-(use-modules (gnucash report report-system test test-extras))
-(use-modules (gnucash report stylesheets))
-(use-modules (gnucash engine test test-extras))
+(use-modules (gnucash reports standard budget))
++(use-modules (gnucash reports standard budget-income-statement))
+(use-modules (tests test-report-extras))
+(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
+(use-modules (tests test-engine-extras))
+ (use-modules (sxml xpath))
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
commit 315bbb5d0539d7d911b867b2eac8406f8d3e4484
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 13:02:08 2019 +0800
[test-stress-options] reinstate test empty book
d47e49c23 had disabled testing empty book in error.
diff --git a/gnucash/report/standard-reports/test/test-stress-options.scm b/gnucash/report/standard-reports/test/test-stress-options.scm
index 26110ca76..0a4925ebf 100644
--- a/gnucash/report/standard-reports/test/test-stress-options.scm
+++ b/gnucash/report/standard-reports/test/test-stress-options.scm
@@ -264,7 +264,7 @@
optionslist))
(define (tests)
- ;; (run-tests "with empty book")
+ (run-tests "with empty book")
(let ((env (create-test-env))
(account-alist (create-test-data)))
(gnc:create-budget-and-transactions env account-alist))
commit d47e49c230c2085008cdf87b71ebb98cb6ccb1cb
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 08:06:16 2019 +0800
[test-stress-options] add budget to test book
the populated book has a budget. this enables more thorough testing of
budget reports.
diff --git a/gnucash/report/standard-reports/test/test-stress-options.scm b/gnucash/report/standard-reports/test/test-stress-options.scm
index 028441bd5..26110ca76 100644
--- a/gnucash/report/standard-reports/test/test-stress-options.scm
+++ b/gnucash/report/standard-reports/test/test-stress-options.scm
@@ -264,7 +264,9 @@
optionslist))
(define (tests)
- (run-tests "with empty book")
- (create-test-data)
+ ;; (run-tests "with empty book")
+ (let ((env (create-test-env))
+ (account-alist (create-test-data)))
+ (gnc:create-budget-and-transactions env account-alist))
(create-test-invoice-data)
(run-tests "on a populated book"))
commit c6195d6e7aa8e4dd691657df00aaccc85f92388a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 08:05:52 2019 +0800
[test-budget] centralize gnc:create-budget-and-transactions
it will be reused by test-stress-options
diff --git a/gnucash/report/standard-reports/test/test-budget.scm b/gnucash/report/standard-reports/test/test-budget.scm
index 0c59686cf..21e506316 100644
--- a/gnucash/report/standard-reports/test/test-budget.scm
+++ b/gnucash/report/standard-reports/test/test-budget.scm
@@ -62,40 +62,10 @@
(define (options->sxml options uuid test-title)
(gnc:options->sxml uuid options "test-budget" test-title))
-(define (create-budget-and-transactions env account-alist)
- (let* ((book (gnc-get-current-book))
- (budget (gnc-budget-new book))
- (bank (cdr (assoc "Bank" account-alist)))
- (income (cdr (assoc "Income" account-alist)))
- (expense (cdr (assoc "Expenses" account-alist))))
- (gnc-budget-set-name budget "test budget")
- (gnc-budget-begin-edit budget)
- (gnc-budget-set-num-periods budget 6)
- (gnc-budget-set-account-period-value budget bank 0 20)
- (gnc-budget-set-account-period-value budget bank 1 40)
- (gnc-budget-set-account-period-value budget bank 3 60)
- (gnc-budget-set-account-period-value budget expense 1 30)
- (gnc-budget-set-account-period-value budget expense 2 20)
- (gnc-budget-set-account-period-value budget expense 3 40)
- (gnc-budget-set-account-period-value budget income 0 -55)
- (gnc-budget-set-account-period-value budget income 2 -65)
- (gnc-budget-set-account-period-value budget income 3 -75)
- (gnc-budget-commit-edit budget)
- (let ((midperiod (lambda (period)
- (floor (/ (+ (gnc-budget-get-period-start-date budget period)
- (gnc-budget-get-period-end-date budget period))
- 2)))))
- (env-create-transaction env (midperiod 0) bank income 55)
- (env-create-transaction env (midperiod 2) bank income 67)
- (env-create-transaction env (midperiod 3) bank income 77)
- (env-create-transaction env (midperiod 0) expense bank 20)
- (env-create-transaction env (midperiod 1) expense bank 20))
- budget))
-
(define (test-budget)
(let* ((env (create-test-env))
(account-alist (create-test-data))
- (budget (create-budget-and-transactions env account-alist))
+ (budget (gnc:create-budget-and-transactions env account-alist))
(options (gnc:make-report-options budget-uuid))
(bank (cdr (assoc "Bank" account-alist))))
@@ -186,7 +156,7 @@
(define (test-budget-income-statement)
(let* ((env (create-test-env))
(account-alist (create-test-data))
- (budget (create-budget-and-transactions env account-alist))
+ (budget (gnc:create-budget-and-transactions env account-alist))
(options (gnc:make-report-options budget-is-uuid))
(bank (assoc-ref account-alist "Bank")))
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index 3fbe5bd9f..126f7e0ec 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -834,6 +834,36 @@
(vector inv-1 inv-2 inv-3 inv-4 inv-5 inv-6 inv-7 inv-8)))
+(define-public (gnc:create-budget-and-transactions env account-alist)
+ (let* ((book (gnc-get-current-book))
+ (budget (gnc-budget-new book))
+ (bank (cdr (assoc "Bank" account-alist)))
+ (income (cdr (assoc "Income" account-alist)))
+ (expense (cdr (assoc "Expenses" account-alist))))
+ (gnc-budget-set-name budget "test budget")
+ (gnc-budget-begin-edit budget)
+ (gnc-budget-set-num-periods budget 6)
+ (gnc-budget-set-account-period-value budget bank 0 20)
+ (gnc-budget-set-account-period-value budget bank 1 40)
+ (gnc-budget-set-account-period-value budget bank 3 60)
+ (gnc-budget-set-account-period-value budget expense 1 30)
+ (gnc-budget-set-account-period-value budget expense 2 20)
+ (gnc-budget-set-account-period-value budget expense 3 40)
+ (gnc-budget-set-account-period-value budget income 0 -55)
+ (gnc-budget-set-account-period-value budget income 2 -65)
+ (gnc-budget-set-account-period-value budget income 3 -75)
+ (gnc-budget-commit-edit budget)
+ (let ((midperiod (lambda (period)
+ (floor (/ (+ (gnc-budget-get-period-start-date budget period)
+ (gnc-budget-get-period-end-date budget period))
+ 2)))))
+ (env-create-transaction env (midperiod 0) bank income 55)
+ (env-create-transaction env (midperiod 2) bank income 67)
+ (env-create-transaction env (midperiod 3) bank income 77)
+ (env-create-transaction env (midperiod 0) expense bank 20)
+ (env-create-transaction env (midperiod 1) expense bank 20))
+ budget))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; various stock transactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
commit f015a96833825df852f3e20bb5ce0ebcb78a8de4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 00:52:17 2019 +0800
[budget] fixcrash: fix crasher for some periods
eg. the following combo would previously crash:
- periods from next to current
- use accumulated amounts
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 71104db10..b5c1c6443 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -332,7 +332,7 @@
(let* ((comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct))
(allperiods (filter number? (gnc:list-flatten column-list)))
- (total-periods (if accumulate?
+ (total-periods (if (and accumulate? (not (null? allperiods)))
(iota (1+ (apply max allperiods)))
allperiods))
(income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
commit 5d15fd41fd8c73869698a388b7baa3b722e75966
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 00:41:43 2019 +0800
[budget] fixcrash: prevent crash if periods start > end
It's silly to input start-period > end-period. Nevertheless handle it
by swapping them instead of crashing. i.e. report budget periods from
end to start.
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 17274811d..71104db10 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -537,7 +537,9 @@
(define (calc-periods
budget user-start user-end collapse-before? collapse-after? show-total?)
(define (range start end)
- (iota (- end start) start))
+ (if (< start end)
+ (iota (- end start) start)
+ (iota (- start end) end)))
(let* ((num-periods (gnc-budget-get-num-periods budget))
(range-start (or user-start 0))
(range-end (if user-end (1+ user-end) num-periods))
commit 34c677d70d13c8b4b97806af02a6d8c79f92ccd1
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Thu Oct 3 00:01:47 2019 +0800
[budget-flow] fixcrash: exchange-fn needs to specify exchange date
because some exchange-fn *do* require date eg. pricedb-nearest. use
the period end-date for the exchange date.
diff --git a/gnucash/report/standard-reports/budget-flow.scm b/gnucash/report/standard-reports/budget-flow.scm
index 81fda0c03..f20a8f39f 100644
--- a/gnucash/report/standard-reports/budget-flow.scm
+++ b/gnucash/report/standard-reports/budget-flow.scm
@@ -276,7 +276,8 @@
;; calculate the exchange rates
(exchange-fn (gnc:case-exchange-fn
- price-source report-currency #f))
+ price-source report-currency
+ (gnc-budget-get-period-end-date budget period)))
;; The HTML document
(doc (gnc:make-html-document)))
commit 3452c33cdf0b8d405ae50a6755346b45704a890d
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 1 00:56:44 2019 +0800
[budget-income-statement] define vars in formals
and use collector arithmetic
diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index 29baf0751..a2393037c 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -442,28 +442,88 @@
(else
;; Get all the balances for each of the account types.
- (let* (
- (revenue-account-balances #f)
- (expense-account-balances #f)
+ (let* ((revenue-account-balances
+ (get-assoc-account-balances-budget
+ budget revenue-accounts period-start period-end
+ get-budget-account-budget-balance))
+
+ (expense-account-balances
+ (get-assoc-account-balances-budget
+ budget expense-accounts period-start period-end
+ get-budget-account-budget-balance))
+
+ (revenue-total
+ (gnc:get-assoc-account-balances-total revenue-account-balances))
+
+ (expense-total
+ (gnc:get-assoc-account-balances-total expense-account-balances))
+
+ (net-income
+ (gnc:collector- revenue-total expense-total))
+
+ (table-env
+ (list
+ (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))))
+
+ (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 (and show-fcur? 'table))
+ (list 'rule-mode use-rules?)))
+
+ (revenue-get-balance-fn
+ (lambda (acct start-date end-date)
+ (gnc:collector-
+ (gnc:select-assoc-account-balance revenue-account-balances acct))))
+
+ (revenue-table
+ (gnc:make-html-acct-table/env/accts
+ (cons (list 'get-balance-fn revenue-get-balance-fn) table-env)
+ revenue-accounts))
+
+ (expense-get-balance-fn
+ (lambda (acct start-date end-date)
+ (gnc:select-assoc-account-balance expense-account-balances acct)))
+
+ (expense-table
+ (gnc:make-html-acct-table/env/accts
+ (cons (list 'get-balance-fn expense-get-balance-fn) table-env)
+ expense-accounts))
+
+ (space (make-list tree-depth (gnc:make-html-table-cell/min-width 60)))
+
+ (inc-table
+ (let ((table (gnc:make-html-table)))
+ (gnc:html-table-append-row! table space)
+ (when label-revenue?
+ (add-subtotal-line table (_ "Revenues") #f #f))
+ (gnc:html-table-add-account-balances table revenue-table params)
+ (when total-revenue?
+ (add-subtotal-line table (_ "Total Revenue") #f revenue-total))
+ table))
+
+ (exp-table
+ (let ((table (gnc:make-html-table)))
+ (gnc:html-table-append-row! table space)
+ (when label-expense?
+ (add-subtotal-line table (_ "Expenses") #f #f))
+ (gnc:html-table-add-account-balances table expense-table params)
+ (when total-expense?
+ (add-subtotal-line table (_ "Total Expenses") #f expense-total))
+ table))
- (revenue-total #f)
- (revenue-get-balance-fn #f)
-
- (expense-total #f)
- (expense-get-balance-fn #f)
-
- (net-income #f)
-
- ;; Create the account tables below where their
- ;; percentage time can be tracked.
- (inc-table (gnc:make-html-table)) ;; gnc:html-table
- (exp-table (gnc:make-html-table))
-
- (table-env #f) ;; parameters for :make-
- (params #f) ;; and -add-account-
- (revenue-table #f) ;; gnc:html-acct-table
- (expense-table #f) ;; gnc:html-acct-table
(budget-name (gnc-budget-get-name budget))
+
(period-for
(cond
((not use-budget-period-range?)
@@ -493,128 +553,17 @@
label 0 1 "text-cell"
bal (1+ col) 1 "number-cell")))
- (gnc:report-percent-done 5)
-
- ;; Pre-fetch expense account balances.
- (set! expense-account-balances
- (get-assoc-account-balances-budget
- budget
- expense-accounts
- period-start
- period-end
- get-budget-account-budget-balance))
-
- ;; Total expenses.
- (set! expense-total
- (gnc:get-assoc-account-balances-total expense-account-balances))
-
- ;; Function to get individual expense account total.
- (set! expense-get-balance-fn
- (lambda (account start-date end-date)
- (gnc:select-assoc-account-balance expense-account-balances account)))
-
- (gnc:report-percent-done 10)
-
- ;; Pre-fetch revenue account balances.
- (set! revenue-account-balances
- (get-assoc-account-balances-budget
- budget
- revenue-accounts
- period-start
- period-end
- get-budget-account-budget-balance))
-
- ;; Total revenue.
- (set! revenue-total
- (gnc:get-assoc-account-balances-total revenue-account-balances))
-
- ;; Function to get individual revenue account total.
- ;; Budget revenue is always positive, so this must be negated.
- (set! revenue-get-balance-fn
- (lambda (account start-date end-date)
- (gnc:commodity-collector-get-negated
- (gnc:select-assoc-account-balance revenue-account-balances account))))
-
- (gnc:report-percent-done 20)
-
- ;; calculate net income
- (set! net-income
- (gnc:collector- revenue-total expense-total))
-
(gnc:report-percent-done 30)
(gnc:html-document-set-title!
- doc
- (format #f "~a ~a ~a" company-name report-title period-for))
-
- (set! table-env
- (list
- (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))
- )
- )
- (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?)
- )
- )
-
- (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:report-percent-done 80)
- (if label-revenue?
- (add-subtotal-line inc-table (_ "Revenues") #f #f))
- (set! revenue-table
- (gnc:make-html-acct-table/env/accts
- (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
- revenue-accounts))
- (gnc:html-table-add-account-balances
- inc-table revenue-table params)
- (if total-revenue?
- (add-subtotal-line
- inc-table (_ "Total Revenue") #f revenue-total))
-
- (gnc:report-percent-done 85)
- (if label-expense?
- (add-subtotal-line
- exp-table (_ "Expenses") #f #f))
- (set! expense-table
- (gnc:make-html-acct-table/env/accts
- (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
- expense-accounts))
- (gnc:html-table-add-account-balances
- exp-table expense-table params)
- (if total-expense?
- (add-subtotal-line
- exp-table (_ "Total Expenses") #f expense-total))
+ doc (format #f "~a ~a ~a" company-name report-title period-for))
(report-line
- (if standard-order?
- exp-table
- inc-table)
+ (if standard-order? exp-table inc-table)
(string-append (_ "Net income") " " period-for)
(string-append (_ "Net loss") " " period-for)
net-income
- (* 2 (- tree-depth 1)) exchange-fn #f #f
- )
+ (* 2 (1- tree-depth)) exchange-fn #f #f)
(let ((build-table (gnc:make-html-table))
(inc-cell (gnc:make-html-table-cell inc-table))
commit 1dfd7c5547cd7f0842f0a2e5cd8952e84b17f420
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 1 00:48:16 2019 +0800
[budget-income-statement] compact functions
neater.
diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index d26085212..29baf0751 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -417,270 +417,236 @@
;; wrapper around gnc:html-table-append-ruler!
(define (add-rule table)
- (gnc:html-table-append-ruler!
- table (* 2 tree-depth)))
-
+ (gnc:html-table-append-ruler! table (* 2 tree-depth)))
+
(cond
- ((null? accounts)
- ;; No accounts selected.
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- reportname (gnc:report-id report-obj))))
- ((not budget-valid?)
- ;; No budget selected.
- (gnc:html-document-add-object!
- doc (gnc:html-make-generic-budget-warning report-title)))
- ((and use-budget-period-range?
- (< user-budget-period-end user-budget-period-start))
- ;; User has selected a range with end period lower than start period.
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-generic-simple-warning
+ ((null? accounts)
+ ;; No accounts selected.
+ (gnc:html-document-add-object!
+ doc
+ (gnc:html-make-no-account-warning
+ reportname (gnc:report-id report-obj))))
+
+ ((not budget-valid?)
+ ;; No budget selected.
+ (gnc:html-document-add-object!
+ doc (gnc:html-make-generic-budget-warning report-title)))
+
+ ((and use-budget-period-range?
+ (< user-budget-period-end user-budget-period-start))
+ ;; User has selected a range with end period lower than start period.
+ (gnc:html-document-add-object!
+ doc (gnc:html-make-generic-simple-warning
report-title
(_ "Reporting range end period cannot be less than start period."))))
- (else (begin
- ;; Get all the balances for each of the account types.
- (let* (
- (revenue-account-balances #f)
- (expense-account-balances #f)
-
- (revenue-total #f)
- (revenue-get-balance-fn #f)
-
- (expense-total #f)
- (expense-get-balance-fn #f)
-
- (net-income #f)
-
- ;; Create the account tables below where their
- ;; percentage time can be tracked.
- (inc-table (gnc:make-html-table)) ;; gnc:html-table
- (exp-table (gnc:make-html-table))
-
- (table-env #f) ;; parameters for :make-
- (params #f) ;; and -add-account-
- (revenue-table #f) ;; gnc:html-acct-table
- (expense-table #f) ;; gnc:html-acct-table
- (budget-name (gnc-budget-get-name budget))
- (period-for
- (if use-budget-period-range?
- (if (equal? user-budget-period-start user-budget-period-end)
- (format
- #f
- (_ "for Budget ~a Period ~d")
- budget-name
- user-budget-period-start)
- (format
- #f
- (_ "for Budget ~a Periods ~d - ~d")
- budget-name
- user-budget-period-start
- user-budget-period-end))
- (format
- #f
- (_ "for Budget ~a")
- budget-name)))
- )
-
- ;; 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
- (negative?
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- amount report-commodity exchange-fn)))))
- (label (if neg? (or neg-label pos-label) pos-label))
- (abs-amt (if neg? (gnc:collector- amount) amount))
- (bal (gnc:sum-collector-commodity
- abs-amt report-commodity exchange-fn)))
- (gnc:html-table-add-labeled-amount-line!
- table (* 2 tree-depth) row-style rule?
- label 0 1 "text-cell"
- bal (1+ col) 1 "number-cell")))
-
- (gnc:report-percent-done 5)
-
- ;; Pre-fetch expense account balances.
- (set! expense-account-balances
- (get-assoc-account-balances-budget
- budget
- expense-accounts
- period-start
- period-end
- get-budget-account-budget-balance))
-
- ;; Total expenses.
- (set! expense-total
- (gnc:get-assoc-account-balances-total expense-account-balances))
-
- ;; Function to get individual expense account total.
- (set! expense-get-balance-fn
- (lambda (account start-date end-date)
- (gnc:select-assoc-account-balance expense-account-balances account)))
-
- (gnc:report-percent-done 10)
-
- ;; Pre-fetch revenue account balances.
- (set! revenue-account-balances
- (get-assoc-account-balances-budget
- budget
- revenue-accounts
- period-start
- period-end
- get-budget-account-budget-balance))
-
- ;; Total revenue.
- (set! revenue-total
- (gnc:get-assoc-account-balances-total revenue-account-balances))
-
- ;; Function to get individual revenue account total.
- ;; Budget revenue is always positive, so this must be negated.
- (set! revenue-get-balance-fn
- (lambda (account start-date end-date)
- (gnc:commodity-collector-get-negated
- (gnc:select-assoc-account-balance revenue-account-balances account))))
-
- (gnc:report-percent-done 20)
-
- ;; calculate net income
- (set! net-income
- (gnc:collector- revenue-total expense-total))
-
- (gnc:report-percent-done 30)
-
- (gnc:html-document-set-title!
- doc
- (format #f "~a ~a ~a" company-name report-title period-for))
-
- (set! table-env
- (list
- (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))
- )
- )
- (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?)
- )
- )
-
- (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:report-percent-done 80)
- (if label-revenue?
- (add-subtotal-line inc-table (_ "Revenues") #f #f))
- (set! revenue-table
- (gnc:make-html-acct-table/env/accts
- (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
- revenue-accounts))
- (gnc:html-table-add-account-balances
- inc-table revenue-table params)
- (if total-revenue?
- (add-subtotal-line
- inc-table (_ "Total Revenue") #f revenue-total))
-
- (gnc:report-percent-done 85)
- (if label-expense?
- (add-subtotal-line
- exp-table (_ "Expenses") #f #f))
- (set! expense-table
- (gnc:make-html-acct-table/env/accts
- (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
- expense-accounts))
- (gnc:html-table-add-account-balances
- exp-table expense-table params)
- (if total-expense?
- (add-subtotal-line
- exp-table (_ "Total Expenses") #f expense-total))
-
- (report-line
- (if standard-order?
- exp-table
- inc-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
- (let* ((build-table (gnc:make-html-table)))
- (if two-column?
- (gnc:html-table-append-row!
- build-table
- (if standard-order?
- (list
- (gnc:make-html-table-cell inc-table)
- (gnc:make-html-table-cell exp-table)
- )
- (list
- (gnc:make-html-table-cell exp-table)
- (gnc:make-html-table-cell inc-table)
- )
- )
- )
- (if standard-order?
- (begin
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell inc-table)))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell exp-table)))
- )
- (begin
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell exp-table)))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell inc-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)
- (if show-rates?
- (gnc:html-document-add-object!
- doc ;;(gnc:html-markup-p)
- (gnc:html-make-exchangerates
- report-commodity exchange-fn accounts)))
- (gnc:report-percent-done 100)
-
- )
- ))) ;; end cond
+
+ (else
+ ;; Get all the balances for each of the account types.
+ (let* (
+ (revenue-account-balances #f)
+ (expense-account-balances #f)
+
+ (revenue-total #f)
+ (revenue-get-balance-fn #f)
+
+ (expense-total #f)
+ (expense-get-balance-fn #f)
+
+ (net-income #f)
+
+ ;; Create the account tables below where their
+ ;; percentage time can be tracked.
+ (inc-table (gnc:make-html-table)) ;; gnc:html-table
+ (exp-table (gnc:make-html-table))
+
+ (table-env #f) ;; parameters for :make-
+ (params #f) ;; and -add-account-
+ (revenue-table #f) ;; gnc:html-acct-table
+ (expense-table #f) ;; gnc:html-acct-table
+ (budget-name (gnc-budget-get-name budget))
+ (period-for
+ (cond
+ ((not use-budget-period-range?)
+ (format #f (_ "for Budget ~a") budget-name))
+ ((= user-budget-period-start user-budget-period-end)
+ (format #f (_ "for Budget ~a Period ~d")
+ budget-name user-budget-period-start))
+ (else
+ (format #f (_ "for Budget ~a Periods ~d - ~d")
+ budget-name user-budget-period-start
+ user-budget-period-end)))))
+
+ ;; 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
+ (negative?
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ amount report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (abs-amt (if neg? (gnc:collector- amount) amount))
+ (bal (gnc:sum-collector-commodity
+ abs-amt report-commodity exchange-fn)))
+ (gnc:html-table-add-labeled-amount-line!
+ table (* 2 tree-depth) row-style rule?
+ label 0 1 "text-cell"
+ bal (1+ col) 1 "number-cell")))
+
+ (gnc:report-percent-done 5)
+
+ ;; Pre-fetch expense account balances.
+ (set! expense-account-balances
+ (get-assoc-account-balances-budget
+ budget
+ expense-accounts
+ period-start
+ period-end
+ get-budget-account-budget-balance))
+
+ ;; Total expenses.
+ (set! expense-total
+ (gnc:get-assoc-account-balances-total expense-account-balances))
+
+ ;; Function to get individual expense account total.
+ (set! expense-get-balance-fn
+ (lambda (account start-date end-date)
+ (gnc:select-assoc-account-balance expense-account-balances account)))
+
+ (gnc:report-percent-done 10)
+
+ ;; Pre-fetch revenue account balances.
+ (set! revenue-account-balances
+ (get-assoc-account-balances-budget
+ budget
+ revenue-accounts
+ period-start
+ period-end
+ get-budget-account-budget-balance))
+
+ ;; Total revenue.
+ (set! revenue-total
+ (gnc:get-assoc-account-balances-total revenue-account-balances))
+
+ ;; Function to get individual revenue account total.
+ ;; Budget revenue is always positive, so this must be negated.
+ (set! revenue-get-balance-fn
+ (lambda (account start-date end-date)
+ (gnc:commodity-collector-get-negated
+ (gnc:select-assoc-account-balance revenue-account-balances account))))
+
+ (gnc:report-percent-done 20)
+
+ ;; calculate net income
+ (set! net-income
+ (gnc:collector- revenue-total expense-total))
+
+ (gnc:report-percent-done 30)
+
+ (gnc:html-document-set-title!
+ doc
+ (format #f "~a ~a ~a" company-name report-title period-for))
+
+ (set! table-env
+ (list
+ (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))
+ )
+ )
+ (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?)
+ )
+ )
+
+ (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:report-percent-done 80)
+ (if label-revenue?
+ (add-subtotal-line inc-table (_ "Revenues") #f #f))
+ (set! revenue-table
+ (gnc:make-html-acct-table/env/accts
+ (append table-env (list (list 'get-balance-fn revenue-get-balance-fn)))
+ revenue-accounts))
+ (gnc:html-table-add-account-balances
+ inc-table revenue-table params)
+ (if total-revenue?
+ (add-subtotal-line
+ inc-table (_ "Total Revenue") #f revenue-total))
+
+ (gnc:report-percent-done 85)
+ (if label-expense?
+ (add-subtotal-line
+ exp-table (_ "Expenses") #f #f))
+ (set! expense-table
+ (gnc:make-html-acct-table/env/accts
+ (append table-env (list (list 'get-balance-fn expense-get-balance-fn)))
+ expense-accounts))
+ (gnc:html-table-add-account-balances
+ exp-table expense-table params)
+ (if total-expense?
+ (add-subtotal-line
+ exp-table (_ "Total Expenses") #f expense-total))
+
+ (report-line
+ (if standard-order?
+ exp-table
+ inc-table)
+ (string-append (_ "Net income") " " period-for)
+ (string-append (_ "Net loss") " " period-for)
+ net-income
+ (* 2 (- tree-depth 1)) exchange-fn #f #f
+ )
+
+ (let ((build-table (gnc:make-html-table))
+ (inc-cell (gnc:make-html-table-cell inc-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 exp-cell))
+
+ (two-column?
+ (add-cells exp-cell inc-cell))
+
+ (standard-order?
+ (add-cells inc-cell)
+ (add-cells exp-cell))
+
+ (else
+ (add-cells exp-cell)
+ (add-cells inc-cell)))
+
+ (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)
+ (when show-rates?
+ (gnc:html-document-add-object!
+ doc (gnc:html-make-exchangerates report-commodity exchange-fn accounts)))
+ (gnc:report-percent-done 100))))
(gnc:report-finished)
commit 992f657cc50a679715691735f5bdaec3a9a95740
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Wed Oct 2 21:49:41 2019 +0800
[test-budget] augment to test budget-income-statement.scm
diff --git a/gnucash/report/standard-reports/test/test-budget.scm b/gnucash/report/standard-reports/test/test-budget.scm
index c471ca7bf..0c59686cf 100644
--- a/gnucash/report/standard-reports/test/test-budget.scm
+++ b/gnucash/report/standard-reports/test/test-budget.scm
@@ -31,18 +31,26 @@
(use-modules (gnucash engine))
(use-modules (sw_engine))
(use-modules (gnucash report standard-reports budget))
+(use-modules (gnucash report standard-reports budget-income-statement))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report stylesheets))
(use-modules (gnucash engine test test-extras))
+(use-modules (sxml xpath))
;; Explicitly set locale to make the report output predictable
(setlocale LC_ALL "C")
-(define uuid "810ed4b25ef0486ea43bbd3dddb32b11")
+(define budget-uuid "810ed4b25ef0486ea43bbd3dddb32b11")
+(define budget-is-uuid "583c313fcc484efc974c4c844404f454")
(define (run-test)
(test-runner-factory gnc:test-runner)
(test-begin "budget")
- (test-budget)
+ (test-group-with-cleanup "budget.scm"
+ (test-budget)
+ (teardown))
+ (test-group-with-cleanup "budget-income-statement.scm"
+ (test-budget-income-statement)
+ (teardown))
(test-end "budget"))
(define (set-option options page tag value)
@@ -51,7 +59,7 @@
(define (teardown)
(gnc-clear-current-session))
-(define (options->sxml options test-title)
+(define (options->sxml options uuid test-title)
(gnc:options->sxml uuid options "test-budget" test-title))
(define (create-budget-and-transactions env account-alist)
@@ -88,15 +96,16 @@
(let* ((env (create-test-env))
(account-alist (create-test-data))
(budget (create-budget-and-transactions env account-alist))
- (options (gnc:make-report-options uuid))
+ (options (gnc:make-report-options budget-uuid))
(bank (cdr (assoc "Bank" account-alist))))
+ (display "\nbudget.scm\n")
(set-option options "Accounts" "Account Display Depth" 'all)
(set-option options "Display" "Show Difference" #f)
(set-option options "Display" "Show Budget" #f)
(set-option options "Display" "Show Actual" #f)
- (let ((sxml (options->sxml options "basic all display off")))
+ (let ((sxml (options->sxml options budget-uuid "basic all display off")))
(test-equal "all display OFF, table has 15 cells"
15
(length (sxml->table-row-col sxml 1 #f #f))))
@@ -105,7 +114,7 @@
(set-option options "Display" "Show Budget" #t)
(set-option options "Display" "Show Actual" #t)
(set-option options "Display" "Show Column with Totals" #t)
- (let ((sxml (options->sxml options "basic")))
+ (let ((sxml (options->sxml options budget-uuid "basic")))
(test-equal "all display ON, table has 226 cells"
226
(length (sxml->table-row-col sxml 1 #f #f)))
@@ -128,7 +137,7 @@
(set-option options "General" "Report for range of budget periods" #t)
(set-option options "General" "Range start" 'current)
(set-option options "General" "Range end" 'next)
- (let ((sxml (options->sxml options "only next period")))
+ (let ((sxml (options->sxml options budget-uuid "only next period")))
(test-equal "only next period - 133 cells"
133
(length (sxml->table-row-col sxml 1 #f #f)))
@@ -140,7 +149,7 @@
(set-option options "General" "Range start" 'last)
(set-option options "General" "Range end" 'last)
- (let ((sxml (options->sxml options "only last period")))
+ (let ((sxml (options->sxml options budget-uuid "only last period")))
(test-equal "only last period - 102 cells"
102
(length (sxml->table-row-col sxml 1 #f #f)))
@@ -156,7 +165,7 @@
(set-option options "General" "Exact end period" 4)
(set-option options "General" "Include collapsed periods before selected." #f)
(set-option options "General" "Include collapsed periods after selected." #f)
- (let ((sxml (options->sxml options "exact periods")))
+ (let ((sxml (options->sxml options budget-uuid "exact periods")))
(test-equal "exact periods - 133 cells"
133
(length (sxml->table-row-col sxml 1 #f #f)))
@@ -167,9 +176,33 @@
(sxml->table-row-col sxml 1 5 #f)))
(set-option options "General" "Use accumulated amounts" #t)
- (let ((sxml (options->sxml options "Use accumulated amounts")))
+ (let ((sxml (options->sxml options budget-uuid "Use accumulated amounts")))
(test-equal "use accumulated amounts"
'("Bank" "$60.00" "$15.00" "$45.00" "$60.00" "$82.00" "-$22.00"
"$120.00" "$159.00" "-$39.00" "$120.00" "$159.00" "-$39.00")
(sxml->table-row-col sxml 1 5 #f)))
))
+
+(define (test-budget-income-statement)
+ (let* ((env (create-test-env))
+ (account-alist (create-test-data))
+ (budget (create-budget-and-transactions env account-alist))
+ (options (gnc:make-report-options budget-is-uuid))
+ (bank (assoc-ref account-alist "Bank")))
+
+ (display "\nbudget-income-statement.scm\n")
+ (let ((sxml (options->sxml options budget-is-uuid "budget-is-basic")))
+ (test-equal "basic test"
+ 72
+ (length (sxml->table-row-col sxml 1 #f #f)))
+
+ (test-equal "budgeted income amounts"
+ '("$195.00" "Income")
+ ((sxpath '(// table // (tr 1) // table // (tr 3) // *text*))
+ sxml))
+
+ (test-equal "net loss for budget"
+ '("Net loss for Budget test budget" "$285.00")
+ ((sxpath '(// table // (tr 2) // table // (tr 5) // *text*))
+ sxml)))))
+
commit 8f1c82e875d5d8152d0d96a228035fde5e1bb895
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 1 01:21:20 2019 +0800
[cash-flow] use collector arithmetic
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 9a35699d2..67e9a4752 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -196,8 +196,6 @@
(let* ((tree-depth (if (equal? display-depth 'all)
(accounts-get-children-depth accounts)
display-depth))
-
- (money-diff-collector (gnc:make-commodity-collector))
(account-disp-list
(map
(lambda (account)
@@ -253,8 +251,6 @@
account-full-name<?))
(money-out-alist (cdr (assq 'money-out-alist result)))
(money-out-collector (cdr (assq 'money-out-collector result))))
- (money-diff-collector 'merge money-in-collector #f)
- (money-diff-collector 'minusmerge money-out-collector #f)
(gnc:html-document-add-object!
doc
@@ -318,7 +314,8 @@
(gnc:make-html-table-header-cell/markup
"total-number-cell"
(gnc:sum-collector-commodity
- money-diff-collector report-currency exchange-fn))))
+ (gnc:collector- money-in-collector money-out-collector)
+ report-currency exchange-fn))))
(gnc:html-document-add-object! doc table)
commit 34bb47e23f9beacf1d219b4fd7a7868d9d131ad4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Tue Oct 1 00:06:48 2019 +0800
[income-statement] compact functions
diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index 444101339..55d45f73a 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -383,45 +383,40 @@
(exchange-fn
(gnc:case-exchange-fn price-source report-commodity end-date))
)
-
+
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
;; with the proper arguments.
(define (add-subtotal-line table pos-label neg-label signed-balance)
- (let* ((neg? (and signed-balance
- neg-label
- (gnc-numeric-negative-p
- (gnc:gnc-monetary-amount
- (gnc:sum-collector-commodity
- signed-balance report-commodity exchange-fn)))))
- (label (if neg? (or neg-label pos-label) pos-label))
- (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
- (gnc:html-table-add-labeled-amount-line!
- table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
- (gnc:sum-collector-commodity balance report-commodity exchange-fn)
- (1- (* tree-depth 2)) 1 "total-number-cell")))
-
+ (let* ((neg? (and signed-balance neg-label
+ (negative?
+ (gnc:gnc-monetary-amount
+ (gnc:sum-collector-commodity
+ signed-balance report-commodity exchange-fn)))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (balance (if neg? (gnc:collector- signed-balance) signed-balance)))
+ (gnc:html-table-add-labeled-amount-line!
+ table (* tree-depth 2) "primary-subheading" #f label 0 1 "total-label-cell"
+ (gnc:sum-collector-commodity balance report-commodity exchange-fn)
+ (1- (* tree-depth 2)) 1 "total-number-cell")))
+
;; wrapper around gnc:html-table-append-ruler!
(define (add-rule table)
(gnc:html-table-append-ruler! table (* 2 tree-depth)))
-
- (gnc:html-document-set-title!
- doc (format #f
- (string-append "~a ~a "
- (_ "For Period Covering ~a to ~a"))
- company-name report-title
+
+ (gnc:html-document-set-title!
+ doc (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a"))
+ company-name report-title
(qof-print-date start-date-printable)
(qof-print-date end-date)))
-
+
(if (null? accounts)
-
- ;; error condition: no accounts specified
- ;; is this *really* necessary??
- ;; i'd be fine with an all-zero P&L
- ;; that would, technically, be correct....
- (gnc:html-document-add-object!
- doc
- (gnc:html-make-no-account-warning
- reportname (gnc:report-id report-obj)))
+
+ ;; error condition: no accounts specified is this *really*
+ ;; necessary?? i'd be fine with an all-zero P&L 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 of the account types.
(let* ((expense-total
@@ -530,82 +525,48 @@
(string-append (_ "Net income") period-for)
(string-append (_ "Net loss") period-for)
net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
-
- (gnc:html-document-add-object!
- doc
- (let* ((build-table (gnc:make-html-table)))
- (if two-column?
- (gnc:html-table-append-row!
- build-table
- (if standard-order?
- (list
- (gnc:make-html-table-cell inc-table)
- (if (null? trading-accounts)
- (gnc:html-make-empty-cell)
- (gnc:make-html-table-cell tra-table))
- (gnc:make-html-table-cell exp-table)
- )
- (list
- (gnc:make-html-table-cell exp-table)
- (gnc:make-html-table-cell inc-table)
- (if (null? trading-accounts)
- (gnc:html-make-empty-cell)
- (gnc:make-html-table-cell tra-table))
- )
- )
- )
- (if standard-order?
- (begin
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell inc-table)))
- (if (not (null? trading-accounts))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell tra-table))))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell exp-table)))
- )
- (begin
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell exp-table)))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell inc-table)))
- (if (not (null? trading-accounts))
- (gnc:html-table-append-row!
- build-table
- (list (gnc:make-html-table-cell tra-table))))
- )
- )
- )
-
- (gnc:html-table-set-style!
- build-table "td"
- 'attribute '("align" "left")
- 'attribute '("valign" "top"))
- build-table
- )
- )
-
-
-
+
+ ;; 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))
+
;; add currency information if requested
- (gnc:report-percent-done 90)
- (if show-rates?
- (gnc:html-document-add-object!
- doc ;;(gnc:html-markup-p)
- (gnc:html-make-exchangerates
- report-commodity exchange-fn accounts)))
- (gnc:report-percent-done 100)
-
- )
- )
-
+ (gnc:report-percent-done 90)
+ (when show-rates?
+ (gnc:html-document-add-object!
+ doc (gnc:html-make-exchangerates
+ report-commodity exchange-fn accounts)))
+ (gnc:report-percent-done 100)))
+
(gnc:report-finished)
-
+
doc))
(define is-reportname (N_ "Income Statement"))
commit bf202d14614aa8bc7bdde063851f345ceb15101f
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Sep 30 23:50:08 2019 +0800
[income-statement] use collector arithmetic, define vars in formals
diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index 2a9918c8d..444101339 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -422,32 +422,71 @@
doc
(gnc:html-make-no-account-warning
reportname (gnc:report-id report-obj)))
-
+
;; Get all the balances for each of the account types.
- (let* ((revenue-closing #f)
- (expense-closing #f)
- (neg-revenue-total #f)
- (revenue-total #f)
- (expense-total #f)
- (trading-total #f)
- (net-income #f)
-
- ;; Create the account tables below where their
- ;; percentage time can be tracked.
- (inc-table (gnc:make-html-table)) ;; gnc:html-table
- (exp-table (gnc:make-html-table))
- (tra-table (gnc:make-html-table))
-
- (table-env #f) ;; parameters for :make-
- (params #f) ;; and -add-account-
- (revenue-table #f) ;; gnc:html-acct-table
- (expense-table #f) ;; gnc:html-acct-table
- (trading-table #f)
+ (let* ((expense-total
+ (gnc:collector-
+ (gnc:accountlist-get-comm-balance-interval-with-closing
+ expense-accounts start-date end-date)
+ (gnc:account-get-trans-type-balance-interval-with-closing
+ expense-accounts closing-pattern start-date end-date)))
+
+ (revenue-total
+ (gnc:collector-
+ (gnc:account-get-trans-type-balance-interval-with-closing
+ revenue-accounts closing-pattern start-date end-date)
+ (gnc:accountlist-get-comm-balance-interval-with-closing
+ revenue-accounts start-date end-date)))
+
+ (trading-total
+ (gnc:accountlist-get-comm-balance-interval-with-closing
+ trading-accounts start-date end-date))
+
+ (net-income
+ (gnc:collector+ revenue-total
+ trading-total
+ (gnc:collector- expense-total)))
+
+ (inc-table (gnc:make-html-table))
+ (exp-table (gnc:make-html-table))
+ (tra-table (gnc:make-html-table))
+
+ (table-env
+ (list
+ (list 'start-date start-date)
+ (list 'end-date end-date)
+ (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)))
+
+ (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 (and show-fcur? 'table))
+ (list 'rule-mode use-rules?)))
+
+ (revenue-table
+ (gnc:make-html-acct-table/env/accts table-env revenue-accounts))
+ (expense-table
+ (gnc:make-html-acct-table/env/accts table-env expense-accounts))
+ (trading-table
+ (gnc:make-html-acct-table/env/accts table-env trading-accounts))
(period-for (string-append " " (_ "for Period"))))
;; a helper to add a line to our report
- (define (report-line
+ (define (add-report-line
table pos-label neg-label amount col
exchange-fn rule? row-style)
(let* ((mon (gnc:sum-collector-commodity
@@ -461,123 +500,36 @@
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-with-closing
- revenue-accounts closing-pattern
- start-date end-date)
- ) ;; this is norm positive (debit)
- (set! expense-closing
- (gnc:account-get-trans-type-balance-interval-with-closing
- expense-accounts closing-pattern
- start-date end-date)
- ) ;; this is norm negative (credit)
- (set! expense-total
- (gnc:accountlist-get-comm-balance-interval-with-closing
- expense-accounts
- start-date end-date))
- (expense-total 'minusmerge expense-closing #f)
- (set! neg-revenue-total
- (gnc:accountlist-get-comm-balance-interval-with-closing
- revenue-accounts
- start-date end-date))
- (neg-revenue-total 'minusmerge revenue-closing #f)
- (set! revenue-total (gnc:make-commodity-collector))
- (revenue-total 'minusmerge neg-revenue-total #f)
- (set! trading-total
- (gnc:accountlist-get-comm-balance-interval-with-closing
- trading-accounts
- start-date end-date))
- ;; calculate net income
- (set! net-income (gnc:make-commodity-collector))
- (net-income 'merge revenue-total #f)
- (net-income 'merge trading-total #f)
- (net-income 'minusmerge expense-total #f)
-
- (set! table-env
- (list
- (list 'start-date start-date)
- (list 'end-date end-date)
- (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?)
- )
- )
-
- (let ((space (make-list tree-depth (gnc:make-html-table-cell/min-width 60))))
+ (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)
- (if label-revenue?
- (add-subtotal-line inc-table (_ "Revenues") #f #f))
- (set! revenue-table
- (gnc:make-html-acct-table/env/accts
- table-env revenue-accounts))
- (gnc:html-table-add-account-balances
- inc-table revenue-table params)
- (if total-revenue?
- (add-subtotal-line
- inc-table (_ "Total Revenue") #f revenue-total))
-
- (gnc:report-percent-done 85)
- (if label-expense?
- (add-subtotal-line
- exp-table (_ "Expenses") #f #f))
- (set! expense-table
- (gnc:make-html-acct-table/env/accts
- table-env expense-accounts))
- (gnc:html-table-add-account-balances
- exp-table expense-table params)
- (if total-expense?
- (add-subtotal-line
- exp-table (_ "Total Expenses") #f expense-total))
-
- (if label-trading?
- (add-subtotal-line tra-table (_ "Trading") #f #f))
- (set! trading-table
- (gnc:make-html-acct-table/env/accts
- table-env trading-accounts))
- (gnc:html-table-add-account-balances
- tra-table trading-table params)
- (if total-trading?
- (add-subtotal-line
- tra-table (_ "Total Trading") #f trading-total))
-
- (report-line
- (if standard-order?
- exp-table
- inc-table)
- (string-append (_ "Net income") period-for)
- (string-append (_ "Net loss") period-for)
- net-income
- (* 2 (- tree-depth 1)) exchange-fn #f #f
- )
+ (gnc:report-percent-done 80)
+
+ (when label-revenue?
+ (add-subtotal-line inc-table (_ "Revenues") #f #f))
+ (gnc:html-table-add-account-balances inc-table revenue-table params)
+ (when total-revenue?
+ (add-subtotal-line inc-table (_ "Total Revenue") #f revenue-total))
+ (gnc:report-percent-done 85)
+
+ (when label-expense?
+ (add-subtotal-line exp-table (_ "Expenses") #f #f))
+ (gnc:html-table-add-account-balances exp-table expense-table params)
+ (when total-expense?
+ (add-subtotal-line exp-table (_ "Total Expenses") #f expense-total))
+
+ (when label-trading?
+ (add-subtotal-line tra-table (_ "Trading") #f #f))
+ (gnc:html-table-add-account-balances tra-table trading-table params)
+ (when total-trading?
+ (add-subtotal-line tra-table (_ "Total Trading") #f trading-total))
+
+ (add-report-line
+ (if standard-order? exp-table inc-table)
+ (string-append (_ "Net income") period-for)
+ (string-append (_ "Net loss") period-for)
+ net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
(gnc:html-document-add-object!
doc
commit 621c857b6a3df6a75b390f9cad6838dd80ea5db4
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Mon Sep 30 23:36:59 2019 +0800
[income-statement] remove dead code, compact function
column and balance were unused. compact function.
diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index d5477685d..2a9918c8d 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -445,43 +445,23 @@
(trading-table #f)
(period-for (string-append " " (_ "for Period"))))
-
- ;; 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)
- (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")
- )
- )
-
- ;; sum revenues and expenses
+
+ ;; 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* ((mon (gnc:sum-collector-commodity
+ amount report-commodity exchange-fn))
+ (neg? (and amount neg-label
+ (negative? (gnc:gnc-monetary-amount mon))))
+ (label (if neg? (or neg-label pos-label) pos-label))
+ (bal (if neg? (gnc:monetary-neg mon) mon)))
+ (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-with-closing
revenue-accounts closing-pattern
Summary of changes:
gnucash/report/reports/standard/budget-flow.scm | 3 +-
.../reports/standard/budget-income-statement.scm | 437 +++++++++-----------
gnucash/report/reports/standard/budget.scm | 6 +-
gnucash/report/reports/standard/cash-flow.scm | 7 +-
.../report/reports/standard/income-statement.scm | 439 ++++++++-------------
.../report/reports/standard/test/test-budget.scm | 85 ++--
.../reports/standard/test/test-stress-options.scm | 4 +-
libgnucash/engine/test/test-engine-extras.scm | 30 ++
8 files changed, 427 insertions(+), 584 deletions(-)
More information about the gnucash-changes
mailing list