gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Wed Oct 2 20:23:41 EDT 2019
Updated 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)
from https://github.com/Gnucash/gnucash/commit/992f657c (commit)
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)
Summary of changes:
gnucash/report/standard-reports/budget-flow.scm | 3 +-
.../standard-reports/budget-income-statement.scm | 437 +++++++++------------
gnucash/report/standard-reports/budget.scm | 6 +-
.../report/standard-reports/test/test-budget.scm | 34 +-
.../standard-reports/test/test-stress-options.scm | 6 +-
libgnucash/engine/test/test-extras.scm | 30 ++
6 files changed, 218 insertions(+), 298 deletions(-)
More information about the gnucash-changes
mailing list