aherman
/
gnucash
mirror of https://github.com/Gnucash/gnucash
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[budget-income-statement] compact functions

Browse Source 
neater.
pull/587/head
Christopher Lam 7 years ago
parent 992f657cc5
commit 1dfd7c5547
1 changed files with 227 additions and 261 deletions
Show Stats Download Patch File Download Diff File

488
gnucash/report/standard-reports/budget-income-statement.scm
Unescape View File

@ -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)

Write Preview
Loading…
Cancel
Save