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
|
||||
(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)))
|
||||
|
||||
@ -417,270 +417,185 @@
|
||||
|
||||
;; 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)
|
||||
(else
|
||||
;; Get all the balances for each of the account types.
|
||||
(let* ((revenue-account-balances
|
||||
(get-assoc-account-balances-budget
|
||||
budget revenue-accounts period-start period-end
|
||||
get-budget-account-budget-balance))
|
||||
|
||||
(expense-total #f)
|
||||
(expense-get-balance-fn #f)
|
||||
(expense-account-balances
|
||||
(get-assoc-account-balances-budget
|
||||
budget expense-accounts period-start period-end
|
||||
get-budget-account-budget-balance))
|
||||
|
||||
(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))
|
||||
(revenue-total
|
||||
(gnc:get-assoc-account-balances-total revenue-account-balances))
|
||||
|
||||
(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)))
|
||||
)
|
||||
(expense-total
|
||||
(gnc:get-assoc-account-balances-total expense-account-balances))
|
||||
|
||||
;; 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")))
|
||||
(net-income
|
||||
(gnc:collector- revenue-total expense-total))
|
||||
|
||||
(gnc:report-percent-done 5)
|
||||
(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))))
|
||||
|
||||
;; 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))
|
||||
(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?)))
|
||||
|
||||
;; Total expenses.
|
||||
(set! expense-total
|
||||
(gnc:get-assoc-account-balances-total expense-account-balances))
|
||||
(revenue-get-balance-fn
|
||||
(lambda (acct start-date end-date)
|
||||
(gnc:collector-
|
||||
(gnc:select-assoc-account-balance revenue-account-balances acct))))
|
||||
|
||||
;; 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)))
|
||||
(revenue-table
|
||||
(gnc:make-html-acct-table/env/accts
|
||||
(cons (list 'get-balance-fn revenue-get-balance-fn) table-env)
|
||||
revenue-accounts))
|
||||
|
||||
(gnc:report-percent-done 10)
|
||||
(expense-get-balance-fn
|
||||
(lambda (acct start-date end-date)
|
||||
(gnc:select-assoc-account-balance expense-account-balances acct)))
|
||||
|
||||
;; 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))
|
||||
(expense-table
|
||||
(gnc:make-html-acct-table/env/accts
|
||||
(cons (list 'get-balance-fn expense-get-balance-fn) table-env)
|
||||
expense-accounts))
|
||||
|
||||
;; Total revenue.
|
||||
(set! revenue-total
|
||||
(gnc:get-assoc-account-balances-total revenue-account-balances))
|
||||
(space (make-list tree-depth (gnc:make-html-table-cell/min-width 60)))
|
||||
|
||||
;; 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))))
|
||||
(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))
|
||||
|
||||
(gnc:report-percent-done 20)
|
||||
(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))
|
||||
|
||||
;; calculate net income
|
||||
(set! net-income
|
||||
(gnc:collector- revenue-total expense-total))
|
||||
(budget-name (gnc-budget-get-name budget))
|
||||
|
||||
(gnc:report-percent-done 30)
|
||||
(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)))))
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc
|
||||
(format #f "~a ~a ~a" company-name report-title period-for))
|
||||
;; 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")))
|
||||
|
||||
(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
|
||||
(gnc:report-percent-done 30)
|
||||
|
||||
(gnc:html-document-set-title!
|
||||
doc (format #f "~a ~a ~a" company-name report-title period-for))
|
||||
|
||||
(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)
|
||||
|
||||
(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)
|
||||
|
||||
|
||||
@ -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)))
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -383,297 +383,190 @@
|
||||
(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)))
|
||||
|
||||
;; 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)
|
||||
(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)))
|
||||
|
||||
;; Get all the balances for each of the account types.
|
||||
(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
|
||||
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 '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))))
|
||||
|
||||
;; 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))))
|
||||
(gnc:html-table-append-row! inc-table space)
|
||||
(gnc:html-table-append-row! exp-table space)
|
||||
(gnc:html-table-append-row! tra-table space))
|
||||
(gnc:report-percent-done 80)
|
||||
|
||||
(when label-revenue?
|
||||
(add-subtotal-line inc-table (_ "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)
|
||||
|
||||
;; 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))
|
||||
|
||||
(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: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 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"))
|
||||
|
||||
@ -31,18 +31,26 @@
|
||||
(use-modules (gnucash engine))
|
||||
(use-modules (sw_engine))
|
||||
(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")
|
||||
(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,52 +59,23 @@
|
||||
(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)
|
||||
(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))
|
||||
(options (gnc:make-report-options uuid))
|
||||
(budget (gnc:create-budget-and-transactions env account-alist))
|
||||
(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 +84,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 +107,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 +119,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 +135,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 +146,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 (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)
|
||||
(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)
|
||||
(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)))
|
||||
|
||||
(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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user