mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Merge branch 'maint'
This commit is contained in:
Christopher Lam
commit
eb58bca7af
@ -276,7 +276,8 @@
|
|||||||
|
|
||||||
;; calculate the exchange rates
|
;; calculate the exchange rates
|
||||||
(exchange-fn (gnc:case-exchange-fn
|
(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
|
;; The HTML document
|
||||||
(doc (gnc:make-html-document)))
|
(doc (gnc:make-html-document)))
|
||||||
|
|||||||
@ -417,8 +417,7 @@
|
|||||||
|
|
||||||
;; wrapper around gnc:html-table-append-ruler!
|
;; wrapper around gnc:html-table-append-ruler!
|
||||||
(define (add-rule table)
|
(define (add-rule table)
|
||||||
(gnc:html-table-append-ruler!
|
(gnc:html-table-append-ruler! table (* 2 tree-depth)))
|
||||||
table (* 2 tree-depth)))
|
|
||||||
|
|
||||||
(cond
|
(cond
|
||||||
((null? accounts)
|
((null? accounts)
|
||||||
@ -427,61 +426,115 @@
|
|||||||
doc
|
doc
|
||||||
(gnc:html-make-no-account-warning
|
(gnc:html-make-no-account-warning
|
||||||
reportname (gnc:report-id report-obj))))
|
reportname (gnc:report-id report-obj))))
|
||||||
|
|
||||||
((not budget-valid?)
|
((not budget-valid?)
|
||||||
;; No budget selected.
|
;; No budget selected.
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc (gnc:html-make-generic-budget-warning report-title)))
|
doc (gnc:html-make-generic-budget-warning report-title)))
|
||||||
|
|
||||||
((and use-budget-period-range?
|
((and use-budget-period-range?
|
||||||
(< user-budget-period-end user-budget-period-start))
|
(< user-budget-period-end user-budget-period-start))
|
||||||
;; User has selected a range with end period lower than start period.
|
;; User has selected a range with end period lower than start period.
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc
|
doc (gnc:html-make-generic-simple-warning
|
||||||
(gnc:html-make-generic-simple-warning
|
|
||||||
report-title
|
report-title
|
||||||
(_ "Reporting range end period cannot be less than start period."))))
|
(_ "Reporting range end period cannot be less than start period."))))
|
||||||
(else (begin
|
|
||||||
|
(else
|
||||||
;; Get all the balances for each of the account types.
|
;; Get all the balances for each of the account types.
|
||||||
(let* (
|
(let* ((revenue-account-balances
|
||||||
(revenue-account-balances #f)
|
(get-assoc-account-balances-budget
|
||||||
(expense-account-balances #f)
|
budget revenue-accounts period-start period-end
|
||||||
|
get-budget-account-budget-balance))
|
||||||
|
|
||||||
(revenue-total #f)
|
(expense-account-balances
|
||||||
(revenue-get-balance-fn #f)
|
(get-assoc-account-balances-budget
|
||||||
|
budget expense-accounts period-start period-end
|
||||||
|
get-budget-account-budget-balance))
|
||||||
|
|
||||||
(expense-total #f)
|
(revenue-total
|
||||||
(expense-get-balance-fn #f)
|
(gnc:get-assoc-account-balances-total revenue-account-balances))
|
||||||
|
|
||||||
(net-income #f)
|
(expense-total
|
||||||
|
(gnc:get-assoc-account-balances-total expense-account-balances))
|
||||||
|
|
||||||
;; Create the account tables below where their
|
(net-income
|
||||||
;; percentage time can be tracked.
|
(gnc:collector- revenue-total expense-total))
|
||||||
(inc-table (gnc:make-html-table)) ;; gnc:html-table
|
|
||||||
(exp-table (gnc:make-html-table))
|
(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))
|
||||||
|
|
||||||
(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))
|
(budget-name (gnc-budget-get-name budget))
|
||||||
|
|
||||||
(period-for
|
(period-for
|
||||||
(if use-budget-period-range?
|
(cond
|
||||||
(if (equal? user-budget-period-start user-budget-period-end)
|
((not use-budget-period-range?)
|
||||||
(format
|
(format #f (_ "for Budget ~a") budget-name))
|
||||||
#f
|
((= user-budget-period-start user-budget-period-end)
|
||||||
(_ "for Budget ~a Period ~d")
|
(format #f (_ "for Budget ~a Period ~d")
|
||||||
budget-name
|
budget-name user-budget-period-start))
|
||||||
user-budget-period-start)
|
(else
|
||||||
(format
|
(format #f (_ "for Budget ~a Periods ~d - ~d")
|
||||||
#f
|
budget-name user-budget-period-start
|
||||||
(_ "for Budget ~a Periods ~d - ~d")
|
user-budget-period-end)))))
|
||||||
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
|
;; a helper to add a line to our report
|
||||||
(define (report-line
|
(define (report-line
|
||||||
@ -500,187 +553,49 @@
|
|||||||
label 0 1 "text-cell"
|
label 0 1 "text-cell"
|
||||||
bal (1+ col) 1 "number-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:report-percent-done 30)
|
||||||
|
|
||||||
(gnc:html-document-set-title!
|
(gnc:html-document-set-title!
|
||||||
doc
|
doc (format #f "~a ~a ~a" company-name report-title period-for))
|
||||||
(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
|
(report-line
|
||||||
(if standard-order?
|
(if standard-order? exp-table inc-table)
|
||||||
exp-table
|
|
||||||
inc-table)
|
|
||||||
(string-append (_ "Net income") " " period-for)
|
(string-append (_ "Net income") " " period-for)
|
||||||
(string-append (_ "Net loss") " " period-for)
|
(string-append (_ "Net loss") " " period-for)
|
||||||
net-income
|
net-income
|
||||||
(* 2 (- tree-depth 1)) exchange-fn #f #f
|
(* 2 (1- tree-depth)) exchange-fn #f #f)
|
||||||
)
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
(let ((build-table (gnc:make-html-table))
|
||||||
doc
|
(inc-cell (gnc:make-html-table-cell inc-table))
|
||||||
(let* ((build-table (gnc:make-html-table)))
|
(exp-cell (gnc:make-html-table-cell exp-table)))
|
||||||
(if two-column?
|
(define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
|
||||||
(gnc:html-table-append-row!
|
(cond
|
||||||
build-table
|
((and two-column? standard-order?)
|
||||||
(if standard-order?
|
(add-cells inc-cell exp-cell))
|
||||||
(list
|
|
||||||
(gnc:make-html-table-cell inc-table)
|
(two-column?
|
||||||
(gnc:make-html-table-cell exp-table)
|
(add-cells exp-cell inc-cell))
|
||||||
)
|
|
||||||
(list
|
(standard-order?
|
||||||
(gnc:make-html-table-cell exp-table)
|
(add-cells inc-cell)
|
||||||
(gnc:make-html-table-cell inc-table)
|
(add-cells exp-cell))
|
||||||
)
|
|
||||||
)
|
(else
|
||||||
)
|
(add-cells exp-cell)
|
||||||
(if standard-order?
|
(add-cells inc-cell)))
|
||||||
(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!
|
(gnc:html-table-set-style!
|
||||||
build-table "td"
|
build-table "td"
|
||||||
'attribute '("align" "left")
|
'attribute '("align" "left")
|
||||||
'attribute '("valign" "top"))
|
'attribute '("valign" "top"))
|
||||||
build-table
|
(gnc:html-document-add-object! doc build-table))
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; add currency information if requested
|
;; add currency information if requested
|
||||||
(gnc:report-percent-done 90)
|
(gnc:report-percent-done 90)
|
||||||
(if show-rates?
|
(when show-rates?
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc ;;(gnc:html-markup-p)
|
doc (gnc:html-make-exchangerates report-commodity exchange-fn accounts)))
|
||||||
(gnc:html-make-exchangerates
|
(gnc:report-percent-done 100))))
|
||||||
report-commodity exchange-fn accounts)))
|
|
||||||
(gnc:report-percent-done 100)
|
|
||||||
|
|
||||||
)
|
|
||||||
))) ;; end cond
|
|
||||||
|
|
||||||
(gnc:report-finished)
|
(gnc:report-finished)
|
||||||
|
|
||||||
|
|||||||
@ -332,7 +332,7 @@
|
|||||||
(let* ((comm (xaccAccountGetCommodity acct))
|
(let* ((comm (xaccAccountGetCommodity acct))
|
||||||
(reverse-balance? (gnc-reverse-balance acct))
|
(reverse-balance? (gnc-reverse-balance acct))
|
||||||
(allperiods (filter number? (gnc:list-flatten column-list)))
|
(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)))
|
(iota (1+ (apply max allperiods)))
|
||||||
allperiods))
|
allperiods))
|
||||||
(income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
|
(income-acct? (eqv? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
|
||||||
@ -537,7 +537,9 @@
|
|||||||
(define (calc-periods
|
(define (calc-periods
|
||||||
budget user-start user-end collapse-before? collapse-after? show-total?)
|
budget user-start user-end collapse-before? collapse-after? show-total?)
|
||||||
(define (range start end)
|
(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))
|
(let* ((num-periods (gnc-budget-get-num-periods budget))
|
||||||
(range-start (or user-start 0))
|
(range-start (or user-start 0))
|
||||||
(range-end (if user-end (1+ user-end) num-periods))
|
(range-end (if user-end (1+ user-end) num-periods))
|
||||||
|
|||||||
@ -196,8 +196,6 @@
|
|||||||
(let* ((tree-depth (if (equal? display-depth 'all)
|
(let* ((tree-depth (if (equal? display-depth 'all)
|
||||||
(accounts-get-children-depth accounts)
|
(accounts-get-children-depth accounts)
|
||||||
display-depth))
|
display-depth))
|
||||||
|
|
||||||
(money-diff-collector (gnc:make-commodity-collector))
|
|
||||||
(account-disp-list
|
(account-disp-list
|
||||||
(map
|
(map
|
||||||
(lambda (account)
|
(lambda (account)
|
||||||
@ -253,8 +251,6 @@
|
|||||||
account-full-name<?))
|
account-full-name<?))
|
||||||
(money-out-alist (cdr (assq 'money-out-alist result)))
|
(money-out-alist (cdr (assq 'money-out-alist result)))
|
||||||
(money-out-collector (cdr (assq 'money-out-collector 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!
|
(gnc:html-document-add-object!
|
||||||
doc
|
doc
|
||||||
@ -318,7 +314,8 @@
|
|||||||
(gnc:make-html-table-header-cell/markup
|
(gnc:make-html-table-header-cell/markup
|
||||||
"total-number-cell"
|
"total-number-cell"
|
||||||
(gnc:sum-collector-commodity
|
(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)
|
(gnc:html-document-add-object! doc table)
|
||||||
|
|
||||||
|
|||||||
@ -387,9 +387,8 @@
|
|||||||
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
|
;; Wrapper to call gnc:html-table-add-labeled-amount-line!
|
||||||
;; with the proper arguments.
|
;; with the proper arguments.
|
||||||
(define (add-subtotal-line table pos-label neg-label signed-balance)
|
(define (add-subtotal-line table pos-label neg-label signed-balance)
|
||||||
(let* ((neg? (and signed-balance
|
(let* ((neg? (and signed-balance neg-label
|
||||||
neg-label
|
(negative?
|
||||||
(gnc-numeric-negative-p
|
|
||||||
(gnc:gnc-monetary-amount
|
(gnc:gnc-monetary-amount
|
||||||
(gnc:sum-collector-commodity
|
(gnc:sum-collector-commodity
|
||||||
signed-balance report-commodity exchange-fn)))))
|
signed-balance report-commodity exchange-fn)))))
|
||||||
@ -405,272 +404,166 @@
|
|||||||
(gnc:html-table-append-ruler! table (* 2 tree-depth)))
|
(gnc:html-table-append-ruler! table (* 2 tree-depth)))
|
||||||
|
|
||||||
(gnc:html-document-set-title!
|
(gnc:html-document-set-title!
|
||||||
doc (format #f
|
doc (format #f (string-append "~a ~a " (_ "For Period Covering ~a to ~a"))
|
||||||
(string-append "~a ~a "
|
|
||||||
(_ "For Period Covering ~a to ~a"))
|
|
||||||
company-name report-title
|
company-name report-title
|
||||||
(qof-print-date start-date-printable)
|
(qof-print-date start-date-printable)
|
||||||
(qof-print-date end-date)))
|
(qof-print-date end-date)))
|
||||||
|
|
||||||
(if (null? accounts)
|
(if (null? accounts)
|
||||||
|
|
||||||
;; error condition: no accounts specified
|
;; error condition: no accounts specified is this *really*
|
||||||
;; is this *really* necessary??
|
;; necessary?? i'd be fine with an all-zero P&L that would,
|
||||||
;; i'd be fine with an all-zero P&L
|
;; technically, be correct....
|
||||||
;; that would, technically, be correct....
|
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc
|
doc (gnc:html-make-no-account-warning
|
||||||
(gnc:html-make-no-account-warning
|
|
||||||
reportname (gnc:report-id report-obj)))
|
reportname (gnc:report-id report-obj)))
|
||||||
|
|
||||||
;; Get all the balances for each of the account types.
|
;; Get all the balances for each of the account types.
|
||||||
(let* ((revenue-closing #f)
|
(let* ((expense-total
|
||||||
(expense-closing #f)
|
(gnc:collector-
|
||||||
(neg-revenue-total #f)
|
(gnc:accountlist-get-comm-balance-interval-with-closing
|
||||||
(revenue-total #f)
|
expense-accounts start-date end-date)
|
||||||
(expense-total #f)
|
(gnc:account-get-trans-type-balance-interval-with-closing
|
||||||
(trading-total #f)
|
expense-accounts closing-pattern start-date end-date)))
|
||||||
(net-income #f)
|
|
||||||
|
|
||||||
;; Create the account tables below where their
|
(revenue-total
|
||||||
;; percentage time can be tracked.
|
(gnc:collector-
|
||||||
(inc-table (gnc:make-html-table)) ;; gnc:html-table
|
(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))
|
(exp-table (gnc:make-html-table))
|
||||||
(tra-table (gnc:make-html-table))
|
(tra-table (gnc:make-html-table))
|
||||||
|
|
||||||
(table-env #f) ;; parameters for :make-
|
(table-env
|
||||||
(params #f) ;; and -add-account-
|
|
||||||
(revenue-table #f) ;; gnc:html-acct-table
|
|
||||||
(expense-table #f) ;; gnc:html-acct-table
|
|
||||||
(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
|
|
||||||
(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
|
||||||
(list 'start-date start-date)
|
(list 'start-date start-date)
|
||||||
(list 'end-date end-date)
|
(list 'end-date end-date)
|
||||||
(list 'display-tree-depth tree-depth)
|
(list 'display-tree-depth tree-depth)
|
||||||
(list 'depth-limit-behavior (if bottom-behavior
|
(list 'depth-limit-behavior (if bottom-behavior 'flatten 'summarize))
|
||||||
'flatten
|
|
||||||
'summarize))
|
|
||||||
(list 'report-commodity report-commodity)
|
(list 'report-commodity report-commodity)
|
||||||
(list 'exchange-fn exchange-fn)
|
(list 'exchange-fn exchange-fn)
|
||||||
(list 'parent-account-subtotal-mode parent-total-mode)
|
(list 'parent-account-subtotal-mode parent-total-mode)
|
||||||
(list 'zero-balance-mode (if show-zb-accts?
|
(list 'zero-balance-mode
|
||||||
'show-leaf-acct
|
(if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
|
||||||
'omit-leaf-acct))
|
(list 'account-label-mode (if use-links? 'anchor 'name))
|
||||||
(list 'account-label-mode (if use-links?
|
|
||||||
'anchor
|
|
||||||
'name))
|
|
||||||
;; we may, at some point, want to add an option to
|
;; we may, at some point, want to add an option to
|
||||||
;; generate a pre-adjustment income statement...
|
;; generate a pre-adjustment income statement...
|
||||||
(list 'balance-mode 'pre-closing)
|
(list 'balance-mode 'pre-closing)
|
||||||
(list 'closing-pattern closing-pattern)
|
(list 'closing-pattern closing-pattern)))
|
||||||
)
|
|
||||||
)
|
(params
|
||||||
(set! params
|
|
||||||
(list
|
(list
|
||||||
(list 'parent-account-balance-mode parent-balance-mode)
|
(list 'parent-account-balance-mode parent-balance-mode)
|
||||||
(list 'zero-balance-display-mode (if omit-zb-bals?
|
(list 'zero-balance-display-mode
|
||||||
'omit-balance
|
(if omit-zb-bals? 'omit-balance 'show-balance))
|
||||||
'show-balance))
|
(list 'multicommodity-mode (and show-fcur? 'table))
|
||||||
(list 'multicommodity-mode (if show-fcur? 'table #f))
|
(list 'rule-mode use-rules?)))
|
||||||
(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 (add-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")))
|
||||||
|
|
||||||
(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! inc-table space)
|
||||||
(gnc:html-table-append-row! exp-table space)
|
(gnc:html-table-append-row! exp-table space)
|
||||||
(gnc:html-table-append-row! tra-table space))
|
(gnc:html-table-append-row! tra-table space))
|
||||||
|
|
||||||
(gnc:report-percent-done 80)
|
(gnc:report-percent-done 80)
|
||||||
(if label-revenue?
|
|
||||||
|
(when label-revenue?
|
||||||
(add-subtotal-line inc-table (_ "Revenues") #f #f))
|
(add-subtotal-line inc-table (_ "Revenues") #f #f))
|
||||||
(set! revenue-table
|
(gnc:html-table-add-account-balances inc-table revenue-table params)
|
||||||
(gnc:make-html-acct-table/env/accts
|
(when total-revenue?
|
||||||
table-env revenue-accounts))
|
(add-subtotal-line inc-table (_ "Total Revenue") #f revenue-total))
|
||||||
(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)
|
(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?
|
(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))
|
(add-subtotal-line tra-table (_ "Trading") #f #f))
|
||||||
(set! trading-table
|
(gnc:html-table-add-account-balances tra-table trading-table params)
|
||||||
(gnc:make-html-acct-table/env/accts
|
(when total-trading?
|
||||||
table-env trading-accounts))
|
(add-subtotal-line tra-table (_ "Total Trading") #f trading-total))
|
||||||
(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
|
(add-report-line
|
||||||
(if standard-order?
|
(if standard-order? exp-table inc-table)
|
||||||
exp-table
|
|
||||||
inc-table)
|
|
||||||
(string-append (_ "Net income") period-for)
|
(string-append (_ "Net income") period-for)
|
||||||
(string-append (_ "Net loss") period-for)
|
(string-append (_ "Net loss") period-for)
|
||||||
net-income
|
net-income (* 2 (1- tree-depth)) exchange-fn #f #f)
|
||||||
(* 2 (- tree-depth 1)) exchange-fn #f #f
|
|
||||||
)
|
|
||||||
|
|
||||||
(gnc:html-document-add-object!
|
;; add the sections in the desired order to document
|
||||||
doc
|
(let ((build-table (gnc:make-html-table))
|
||||||
(let* ((build-table (gnc:make-html-table)))
|
(inc-cell (gnc:make-html-table-cell inc-table))
|
||||||
(if two-column?
|
(tra-cell (if (null? trading-accounts)
|
||||||
(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:html-make-empty-cell)
|
||||||
(gnc:make-html-table-cell tra-table))
|
(gnc:make-html-table-cell tra-table)))
|
||||||
(gnc:make-html-table-cell exp-table)
|
(exp-cell (gnc:make-html-table-cell exp-table)))
|
||||||
)
|
(define (add-cells . lst) (gnc:html-table-append-row! build-table lst))
|
||||||
(list
|
(cond
|
||||||
(gnc:make-html-table-cell exp-table)
|
((and two-column? standard-order?)
|
||||||
(gnc:make-html-table-cell inc-table)
|
(add-cells inc-cell tra-cell exp-cell))
|
||||||
(if (null? trading-accounts)
|
|
||||||
(gnc:html-make-empty-cell)
|
(two-column?
|
||||||
(gnc:make-html-table-cell tra-table))
|
(add-cells exp-cell inc-cell tra-cell))
|
||||||
)
|
|
||||||
)
|
(standard-order?
|
||||||
)
|
(add-cells inc-cell)
|
||||||
(if standard-order?
|
(unless (null? trading-accounts) (add-cells tra-cell))
|
||||||
(begin
|
(add-cells exp-cell))
|
||||||
(gnc:html-table-append-row!
|
|
||||||
build-table
|
(else
|
||||||
(list (gnc:make-html-table-cell inc-table)))
|
(add-cells exp-cell)
|
||||||
(if (not (null? trading-accounts))
|
(add-cells inc-cell)
|
||||||
(gnc:html-table-append-row!
|
(unless (null? trading-accounts) (add-cells tra-cell))))
|
||||||
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!
|
(gnc:html-table-set-style!
|
||||||
build-table "td"
|
build-table "td"
|
||||||
'attribute '("align" "left")
|
'attribute '("align" "left")
|
||||||
'attribute '("valign" "top"))
|
'attribute '("valign" "top"))
|
||||||
build-table
|
(gnc:html-document-add-object! doc build-table))
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; add currency information if requested
|
;; add currency information if requested
|
||||||
(gnc:report-percent-done 90)
|
(gnc:report-percent-done 90)
|
||||||
(if show-rates?
|
(when show-rates?
|
||||||
(gnc:html-document-add-object!
|
(gnc:html-document-add-object!
|
||||||
doc ;;(gnc:html-markup-p)
|
doc (gnc:html-make-exchangerates
|
||||||
(gnc:html-make-exchangerates
|
|
||||||
report-commodity exchange-fn accounts)))
|
report-commodity exchange-fn accounts)))
|
||||||
(gnc:report-percent-done 100)
|
(gnc:report-percent-done 100)))
|
||||||
|
|
||||||
)
|
|
||||||
)
|
|
||||||
|
|
||||||
(gnc:report-finished)
|
(gnc:report-finished)
|
||||||
|
|
||||||
|
|||||||
@ -31,18 +31,26 @@
|
|||||||
(use-modules (gnucash engine))
|
(use-modules (gnucash engine))
|
||||||
(use-modules (sw_engine))
|
(use-modules (sw_engine))
|
||||||
(use-modules (gnucash reports standard budget))
|
(use-modules (gnucash reports standard budget))
|
||||||
|
(use-modules (gnucash reports standard budget-income-statement))
|
||||||
(use-modules (tests test-report-extras))
|
(use-modules (tests test-report-extras))
|
||||||
(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
|
(use-modules (gnucash report stylesheets plain)) ; For the default stylesheet, required for rendering
|
||||||
(use-modules (tests test-engine-extras))
|
(use-modules (tests test-engine-extras))
|
||||||
|
(use-modules (sxml xpath))
|
||||||
|
|
||||||
;; Explicitly set locale to make the report output predictable
|
;; Explicitly set locale to make the report output predictable
|
||||||
(setlocale LC_ALL "C")
|
(setlocale LC_ALL "C")
|
||||||
(define uuid "810ed4b25ef0486ea43bbd3dddb32b11")
|
(define budget-uuid "810ed4b25ef0486ea43bbd3dddb32b11")
|
||||||
|
(define budget-is-uuid "583c313fcc484efc974c4c844404f454")
|
||||||
|
|
||||||
(define (run-test)
|
(define (run-test)
|
||||||
(test-runner-factory gnc:test-runner)
|
(test-runner-factory gnc:test-runner)
|
||||||
(test-begin "budget")
|
(test-begin "budget")
|
||||||
|
(test-group-with-cleanup "budget.scm"
|
||||||
(test-budget)
|
(test-budget)
|
||||||
|
(teardown))
|
||||||
|
(test-group-with-cleanup "budget-income-statement.scm"
|
||||||
|
(test-budget-income-statement)
|
||||||
|
(teardown))
|
||||||
(test-end "budget"))
|
(test-end "budget"))
|
||||||
|
|
||||||
(define (set-option options page tag value)
|
(define (set-option options page tag value)
|
||||||
@ -51,52 +59,23 @@
|
|||||||
(define (teardown)
|
(define (teardown)
|
||||||
(gnc-clear-current-session))
|
(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))
|
(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)
|
(define (test-budget)
|
||||||
(let* ((env (create-test-env))
|
(let* ((env (create-test-env))
|
||||||
(account-alist (create-test-data))
|
(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 uuid))
|
(options (gnc:make-report-options budget-uuid))
|
||||||
(bank (cdr (assoc "Bank" account-alist))))
|
(bank (cdr (assoc "Bank" account-alist))))
|
||||||
|
|
||||||
|
(display "\nbudget.scm\n")
|
||||||
(set-option options "Accounts" "Account Display Depth" 'all)
|
(set-option options "Accounts" "Account Display Depth" 'all)
|
||||||
|
|
||||||
(set-option options "Display" "Show Difference" #f)
|
(set-option options "Display" "Show Difference" #f)
|
||||||
(set-option options "Display" "Show Budget" #f)
|
(set-option options "Display" "Show Budget" #f)
|
||||||
(set-option options "Display" "Show Actual" #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"
|
(test-equal "all display OFF, table has 15 cells"
|
||||||
15
|
15
|
||||||
(length (sxml->table-row-col sxml 1 #f #f))))
|
(length (sxml->table-row-col sxml 1 #f #f))))
|
||||||
@ -105,7 +84,7 @@
|
|||||||
(set-option options "Display" "Show Budget" #t)
|
(set-option options "Display" "Show Budget" #t)
|
||||||
(set-option options "Display" "Show Actual" #t)
|
(set-option options "Display" "Show Actual" #t)
|
||||||
(set-option options "Display" "Show Column with Totals" #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"
|
(test-equal "all display ON, table has 226 cells"
|
||||||
226
|
226
|
||||||
(length (sxml->table-row-col sxml 1 #f #f)))
|
(length (sxml->table-row-col sxml 1 #f #f)))
|
||||||
@ -128,7 +107,7 @@
|
|||||||
(set-option options "General" "Report for range of budget periods" #t)
|
(set-option options "General" "Report for range of budget periods" #t)
|
||||||
(set-option options "General" "Range start" 'current)
|
(set-option options "General" "Range start" 'current)
|
||||||
(set-option options "General" "Range end" 'next)
|
(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"
|
(test-equal "only next period - 133 cells"
|
||||||
133
|
133
|
||||||
(length (sxml->table-row-col sxml 1 #f #f)))
|
(length (sxml->table-row-col sxml 1 #f #f)))
|
||||||
@ -140,7 +119,7 @@
|
|||||||
|
|
||||||
(set-option options "General" "Range start" 'last)
|
(set-option options "General" "Range start" 'last)
|
||||||
(set-option options "General" "Range end" '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"
|
(test-equal "only last period - 102 cells"
|
||||||
102
|
102
|
||||||
(length (sxml->table-row-col sxml 1 #f #f)))
|
(length (sxml->table-row-col sxml 1 #f #f)))
|
||||||
@ -156,7 +135,7 @@
|
|||||||
(set-option options "General" "Exact end period" 4)
|
(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 before selected." #f)
|
||||||
(set-option options "General" "Include collapsed periods after 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"
|
(test-equal "exact periods - 133 cells"
|
||||||
133
|
133
|
||||||
(length (sxml->table-row-col sxml 1 #f #f)))
|
(length (sxml->table-row-col sxml 1 #f #f)))
|
||||||
@ -167,9 +146,33 @@
|
|||||||
(sxml->table-row-col sxml 1 5 #f)))
|
(sxml->table-row-col sxml 1 5 #f)))
|
||||||
|
|
||||||
(set-option options "General" "Use accumulated amounts" #t)
|
(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"
|
(test-equal "use accumulated amounts"
|
||||||
'("Bank" "$60.00" "$15.00" "$45.00" "$60.00" "$82.00" "-$22.00"
|
'("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")
|
"$120.00" "$159.00" "-$39.00" "$120.00" "$159.00" "-$39.00")
|
||||||
(sxml->table-row-col sxml 1 5 #f)))
|
(sxml->table-row-col sxml 1 5 #f)))
|
||||||
))
|
))
|
||||||
|
|
||||||
|
(define (test-budget-income-statement)
|
||||||
|
(let* ((env (create-test-env))
|
||||||
|
(account-alist (create-test-data))
|
||||||
|
(budget (gnc: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)))))
|
||||||
|
|
||||||
|
|||||||
@ -267,6 +267,8 @@
|
|||||||
|
|
||||||
(define (tests)
|
(define (tests)
|
||||||
(run-tests "with empty book")
|
(run-tests "with empty book")
|
||||||
(create-test-data)
|
(let ((env (create-test-env))
|
||||||
|
(account-alist (create-test-data)))
|
||||||
|
(gnc:create-budget-and-transactions env account-alist))
|
||||||
(create-test-invoice-data)
|
(create-test-invoice-data)
|
||||||
(run-tests "on a populated book"))
|
(run-tests "on a populated book"))
|
||||||
|
|||||||
@ -834,6 +834,36 @@
|
|||||||
|
|
||||||
(vector inv-1 inv-2 inv-3 inv-4 inv-5 inv-6 inv-7 inv-8)))
|
(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
|
;; various stock transactions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user