IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[budget] *reindent/untabify/delete-trailing-whitespace*

Browse Source
This commit is contained in:
Christopher Lam 2019-03-02 20:07:16 +08:00
parent d16d71dfc6
commit c8625ab5fb
1 changed files with 536 additions and 599 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

417
gnucash/report/standard-reports/budget.scm
View File

@ -113,34 +113,28 @@
(add-option (add-option
(lambda (new-option) (lambda (new-option)
(gnc:register-option options new-option))) (gnc:register-option options new-option)))
(period-options (list (list->vector (period-options
(list 'first (list (vector 'first
(N_ "First") (N_ "First")
(N_ "The first period of the budget"))) (N_ "The first period of the budget"))
(list->vector (vector 'previous
(list 'previous
(N_ "Previous") (N_ "Previous")
(N_ "Budget period was before current period, according to report evaluation date"))) (N_ "Budget period was before current period, according to report evaluation date"))
(list->vector (vector 'current
(list 'current
(N_ "Current") (N_ "Current")
(N_ "Current period, according to report evaluation date"))) (N_ "Current period, according to report evaluation date"))
(list->vector (vector 'next
(list 'next
(N_ "Next") (N_ "Next")
(N_ "Next period, according to report evaluation date"))) (N_ "Next period, according to report evaluation date"))
(list->vector (vector 'last
(list 'last
(N_ "Last") (N_ "Last")
(N_ "Last budget period"))) (N_ "Last budget period"))
(list->vector (vector 'manual
(list 'manual
(N_ "Manual period selection") (N_ "Manual period selection")
(N_ "Explicitly select period value with spinner below"))))) (N_ "Explicitly select period value with spinner below"))))
(ui-use-periods #f) (ui-use-periods #f)
(ui-start-period-type 'current) (ui-start-period-type 'current)
(ui-end-period-type 'next) (ui-end-period-type 'next))
)
(gnc:register-option (gnc:register-option
options options
@ -148,20 +142,9 @@
gnc:pagename-general optname-budget gnc:pagename-general optname-budget
"a" (N_ "Budget to use."))) "a" (N_ "Budget to use.")))
;; date interval
;;(gnc:options-add-date-interval!
;; options gnc:pagename-general
;; optname-from-date optname-to-date "a")
(gnc:options-add-price-source! (gnc:options-add-price-source!
options gnc:pagename-general optname-price-source "c" 'pricedb-nearest) options gnc:pagename-general optname-price-source "c" 'pricedb-nearest)
;;(gnc:register-option
;; options
;; (gnc:make-simple-boolean-option
;; gnc:pagename-general optname-show-rates
;; "d" (N_ "Show the exchange rates used") #f))
(gnc:register-option (gnc:register-option
options options
(gnc:make-simple-boolean-option (gnc:make-simple-boolean-option
@ -180,23 +163,21 @@
;; selectable only when we are running the report for a budget period ;; selectable only when we are running the report for a budget period
;; range. ;; range.
(lambda (value) (lambda (value)
(let ( (let ((enabler (lambda (target-opt enabled)
(enabler (lambda (target-opt enabled) (set-option-enabled
(set-option-enabled options gnc:pagename-general target-opt enabled))) options gnc:pagename-general target-opt enabled))))
) (for-each
(for-each (lambda (target-opt) (lambda (target-opt)
(enabler target-opt value)) (enabler target-opt value))
(list optname-budget-period-start optname-budget-period-end (list optname-budget-period-start optname-budget-period-end
optname-period-collapse-before optname-period-collapse-after) optname-period-collapse-before optname-period-collapse-after))
)
(enabler optname-budget-period-start-exact (enabler optname-budget-period-start-exact
(and value (and value
(eq? 'manual ui-start-period-type))) (eq? 'manual ui-start-period-type)))
(enabler optname-budget-period-end-exact (enabler optname-budget-period-end-exact
(and value (and value
(eq? 'manual ui-end-period-type))) (eq? 'manual ui-end-period-type)))
(set! ui-use-periods value) (set! ui-use-periods value)))))
))))
(add-option (add-option
(gnc:make-multichoice-callback-option (gnc:make-multichoice-callback-option
@ -208,9 +189,7 @@
(set-option-enabled options gnc:pagename-general (set-option-enabled options gnc:pagename-general
optname-budget-period-start-exact optname-budget-period-start-exact
(and ui-use-periods (eq? 'manual new-val))) (and ui-use-periods (eq? 'manual new-val)))
(set! ui-start-period-type new-val) (set! ui-start-period-type new-val))))
)
))
(add-option (add-option
(gnc:make-number-range-option (gnc:make-number-range-option
@ -231,9 +210,7 @@
(set-option-enabled options gnc:pagename-general (set-option-enabled options gnc:pagename-general
optname-budget-period-end-exact optname-budget-period-end-exact
(and ui-use-periods (eq? 'manual new-val))) (and ui-use-periods (eq? 'manual new-val)))
(set! ui-end-period-type new-val) (set! ui-end-period-type new-val))))
)
))
(add-option (add-option
(gnc:make-number-range-option (gnc:make-number-range-option
@ -299,8 +276,7 @@
;; Set the general page as default option tab ;; Set the general page as default option tab
(gnc:options-set-default-section options gnc:pagename-general) (gnc:options-set-default-section options gnc:pagename-general)
options) options))
)
;; Create the html table for the budget report ;; Create the html table for the budget report
;; ;;
@ -328,9 +304,7 @@
;; assume that it makes twice as many columns as it uses for ;; assume that it makes twice as many columns as it uses for
;; account labels. For now, that seems to be a valid ;; account labels. For now, that seems to be a valid
;; assumption. ;; assumption.
(colnum (quotient numcolumns 2)) (colnum (quotient numcolumns 2)))
)
(define (negative-numeric-p x) (define (negative-numeric-p x)
(if (gnc-numeric-p x) (gnc-numeric-negative-p x) #f)) (if (gnc-numeric-p x) (gnc-numeric-negative-p x) #f))
@ -339,9 +313,10 @@
(define (total-number-cell-tag x) (define (total-number-cell-tag x)
(if (negative-numeric-p x) "total-number-cell-neg" "total-number-cell")) (if (negative-numeric-p x) "total-number-cell-neg" "total-number-cell"))
;; Calculate the value to use for the budget of an account for a specific set of periods. ;; Calculate the value to use for the budget of an account for a
;; If there is 1 period, use that period's budget value. Otherwise, sum the budgets for ;; specific set of periods. If there is 1 period, use that
;; all of the periods. ;; period's budget value. Otherwise, sum the budgets for all of
;; the periods.
;; ;;
;; Parameters: ;; Parameters:
;; budget - budget to use ;; budget - budget to use
@ -352,15 +327,17 @@
;; Budget sum ;; Budget sum
(define (gnc:get-account-periodlist-budget-value budget acct periodlist) (define (gnc:get-account-periodlist-budget-value budget acct periodlist)
(cond (cond
((= (length periodlist) 1) (gnc:get-account-period-rolledup-budget-value budget acct (car periodlist))) ((= (length periodlist) 1)
(else (gnc-numeric-add (gnc:get-account-period-rolledup-budget-value budget acct (car periodlist)) (gnc:get-account-period-rolledup-budget-value budget acct (car periodlist)))
(else
(gnc-numeric-add
(gnc:get-account-period-rolledup-budget-value budget acct (car periodlist))
(gnc:get-account-periodlist-budget-value budget acct (cdr periodlist)) (gnc:get-account-periodlist-budget-value budget acct (cdr periodlist))
GNC-DENOM-AUTO GNC-RND-ROUND)) GNC-DENOM-AUTO GNC-RND-ROUND))))
)
)
;; Calculate the value to use for the actual of an account for a specific set of periods. ;; Calculate the value to use for the actual of an account for a
;; This is the sum of the actuals for each of the periods. ;; specific set of periods. This is the sum of the actuals for
;; each of the periods.
;; ;;
;; Parameters: ;; Parameters:
;; budget - budget to use ;; budget - budget to use
@ -377,9 +354,7 @@
(gnc-numeric-add (gnc-numeric-add
(gnc-budget-get-account-period-actual-value budget acct (car periodlist)) (gnc-budget-get-account-period-actual-value budget acct (car periodlist))
(gnc:get-account-periodlist-actual-value budget acct (cdr periodlist)) (gnc:get-account-periodlist-actual-value budget acct (cdr periodlist))
GNC-DENOM-AUTO GNC-RND-ROUND)) GNC-DENOM-AUTO GNC-RND-ROUND))))
)
)
;; Adds a line to tbe budget report. ;; Adds a line to tbe budget report.
;; ;;
@ -389,19 +364,19 @@
;; colnum - starting column number ;; colnum - starting column number
;; budget - budget to use ;; budget - budget to use
;; acct - account being displayed ;; acct - account being displayed
;; rollup-budget? - rollup budget values for account children if account budget not set ;; rollup-budget? - rollup budget values for account children
;; if account budget not set
;; exchange-fn - exchange function (not used) ;; exchange-fn - exchange function (not used)
(define (gnc:html-table-add-budget-line! (define (gnc:html-table-add-budget-line!
html-table rownum colnum budget acct rollup-budget? column-list exchange-fn) html-table rownum colnum budget acct rollup-budget?
(let* ( column-list exchange-fn)
(current-col (+ colnum 1)) (let* ((current-col (+ colnum 1))
(bgt-total (gnc-numeric-zero)) (bgt-total (gnc-numeric-zero))
(bgt-total-unset? #t) (bgt-total-unset? #t)
(act-total (gnc-numeric-zero)) (act-total (gnc-numeric-zero))
(comm (xaccAccountGetCommodity acct)) (comm (xaccAccountGetCommodity acct))
(reverse-balance? (gnc-reverse-balance acct)) (reverse-balance? (gnc-reverse-balance acct))
(income-acct? (eq? (xaccAccountGetType acct) ACCT-TYPE-INCOME)) (income-acct? (eq? (xaccAccountGetType acct) ACCT-TYPE-INCOME)))
)
;; Displays a set of budget column values ;; Displays a set of budget column values
;; ;;
@ -413,45 +388,44 @@
;; act-numeric-val - actual value, or #f if column not to be shown ;; act-numeric-val - actual value, or #f if column not to be shown
;; dif-numeric val - difference value, or #f if column not to be shown ;; dif-numeric val - difference value, or #f if column not to be shown
(define (gnc:html-table-display-budget-columns! (define (gnc:html-table-display-budget-columns!
html-table rownum total? bgt-numeric-val act-numeric-val dif-numeric-val) html-table rownum total? bgt-numeric-val act-numeric-val
(let* ((bgt-val #f)(act-val #f)(dif-val #f) dif-numeric-val)
(let* ((bgt-val #f)
(act-val #f)
(dif-val #f)
(style-tag (if total? "total-number-cell" "number-cell")) (style-tag (if total? "total-number-cell" "number-cell"))
(style-tag-neg (string-append style-tag "-neg")) (style-tag-neg (string-append style-tag "-neg")))
)
(if show-budget? (if show-budget?
(begin (begin
(set! bgt-val (if (gnc-numeric-zero-p bgt-numeric-val) "." (set! bgt-val (if (gnc-numeric-zero-p bgt-numeric-val) "."
(gnc:make-gnc-monetary comm bgt-numeric-val))) (gnc:make-gnc-monetary comm bgt-numeric-val)))
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table rownum current-col style-tag bgt-val) html-table rownum current-col style-tag bgt-val)
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))
)
)
(if show-actual? (if show-actual?
(begin (begin
(set! act-val (gnc:make-gnc-monetary comm act-numeric-val)) (set! act-val (gnc:make-gnc-monetary comm act-numeric-val))
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table rownum current-col html-table rownum current-col
(if (gnc-numeric-negative-p act-numeric-val) style-tag-neg style-tag) (if (gnc-numeric-negative-p act-numeric-val)
style-tag-neg
style-tag)
act-val) act-val)
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))
)
)
(if show-diff? (if show-diff?
(begin (begin
(set! dif-val (set! dif-val
(if (and (gnc-numeric-zero-p bgt-numeric-val) (gnc-numeric-zero-p act-numeric-val)) (if (and (gnc-numeric-zero-p bgt-numeric-val)
(gnc-numeric-zero-p act-numeric-val))
"." "."
(gnc:make-gnc-monetary comm dif-numeric-val))) (gnc:make-gnc-monetary comm dif-numeric-val)))
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table rownum current-col html-table rownum current-col
(if (gnc-numeric-negative-p dif-numeric-val) style-tag-neg style-tag) (if (gnc-numeric-negative-p dif-numeric-val)
style-tag-neg
style-tag)
dif-val) dif-val)
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))))
)
)
)
);;end of define gnc:html-table-display-budget-columns
;; Adds a set of column values to the budget report for a specific list ;; Adds a set of column values to the budget report for a specific list
;; of periods. ;; of periods.
@ -464,12 +438,12 @@
;; period-list - list of periods to use ;; period-list - list of periods to use
(define (gnc:html-table-add-budget-line-columns! (define (gnc:html-table-add-budget-line-columns!
html-table rownum budget acct period-list) html-table rownum budget acct period-list)
(let* ( (let* (;; budgeted amount
;; budgeted amount (bgt-numeric-val (gnc:get-account-periodlist-budget-value
(bgt-numeric-val (gnc:get-account-periodlist-budget-value budget acct period-list)) budget acct period-list))
;; actual amount ;; actual amount
(act-numeric-abs (gnc:get-account-periodlist-actual-value budget acct period-list)) (act-numeric-abs (gnc:get-account-periodlist-actual-value
budget acct period-list))
(act-numeric-val (act-numeric-val
(if reverse-balance? (if reverse-balance?
(gnc-numeric-neg act-numeric-abs) (gnc-numeric-neg act-numeric-abs)
@ -479,15 +453,15 @@
(dif-numeric-val (dif-numeric-val
(gnc-numeric-sub (gnc-numeric-sub
bgt-numeric-val act-numeric-val bgt-numeric-val act-numeric-val
GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER))) GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER))))
)
(if (not (gnc-numeric-zero-p bgt-numeric-val)) (if (not (gnc-numeric-zero-p bgt-numeric-val))
(begin (begin
(set! bgt-total (gnc-numeric-add bgt-total bgt-numeric-val GNC-DENOM-AUTO GNC-RND-ROUND)) (set! bgt-total (gnc-numeric-add bgt-total bgt-numeric-val
(set! bgt-total-unset? #f)) GNC-DENOM-AUTO GNC-RND-ROUND))
) (set! bgt-total-unset? #f)))
(set! act-total (gnc-numeric-add act-total act-numeric-val GNC-DENOM-AUTO GNC-RND-ROUND)) (set! act-total (gnc-numeric-add act-total act-numeric-val
GNC-DENOM-AUTO GNC-RND-ROUND))
(if income-acct? (if income-acct?
(set! dif-numeric-val (set! dif-numeric-val
(gnc-numeric-sub (gnc-numeric-sub
@ -495,9 +469,7 @@
GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER)))) GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER))))
(gnc:html-table-display-budget-columns! (gnc:html-table-display-budget-columns!
html-table rownum #f html-table rownum #f
bgt-numeric-val act-numeric-val dif-numeric-val) bgt-numeric-val act-numeric-val dif-numeric-val)))
)
);;end of define gnc:html-table-add-budget-line-columns
(while (not (null? column-list)) (while (not (null? column-list))
(let* ((col-info (car column-list))) (let* ((col-info (car column-list)))
@ -511,21 +483,17 @@
GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER)) GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER))
(gnc-numeric-sub (gnc-numeric-sub
bgt-total act-total bgt-total act-total
GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER))) GNC-DENOM-AUTO (+ GNC-DENOM-LCD GNC-RND-NEVER)))))
))
((list? col-info) ((list? col-info)
(gnc:html-table-add-budget-line-columns! html-table rownum budget acct col-info)) (gnc:html-table-add-budget-line-columns!
html-table rownum budget acct col-info))
(else (else
(gnc:html-table-add-budget-line-columns! html-table rownum budget acct (list col-info))) (gnc:html-table-add-budget-line-columns!
) html-table rownum budget acct (list col-info))))
(set! column-list (cdr column-list)) (set! column-list (cdr column-list))))))
)
)
)
);; end of define gnc:html-table-add-budget-line
;; Adds header rows to the budget report. The columns are specified by the ;; Adds header rows to the budget report. The columns are
;; column-list parameter. ;; specified by the column-list parameter.
;; ;;
;; Parameters: ;; Parameters:
;; html-table - html table being created ;; html-table - html table being created
@ -534,12 +502,9 @@
;; column-list - column info list ;; column-list - column info list
(define (gnc:html-table-add-budget-headers! (define (gnc:html-table-add-budget-headers!
html-table colnum budget column-list) html-table colnum budget column-list)
(let* ( (let* ((current-col (+ colnum 1))
(current-col (+ colnum 1))
(col-list column-list) (col-list column-list)
(col-span 0) (col-span 0))
)
(if show-budget? (set! col-span (+ col-span 1))) (if show-budget? (set! col-span (+ col-span 1)))
(if show-actual? (set! col-span (+ col-span 1))) (if show-actual? (set! col-span (+ col-span 1)))
(if show-diff? (set! col-span (+ col-span 1))) (if show-diff? (set! col-span (+ col-span 1)))
@ -550,37 +515,30 @@
(gnc:html-table-prepend-row! html-table '()) (gnc:html-table-prepend-row! html-table '())
(while (not (= (length col-list) 0)) (while (not (= (length col-list) 0))
(let* ( (let* ((col-info (car col-list))
(col-info (car col-list))
(tc #f) (tc #f)
(period-to-date-string (lambda (p) (qof-print-date (gnc-budget-get-period-start-date budget p)))) (period-to-date-string (lambda (p)
) (qof-print-date
(gnc-budget-get-period-start-date
budget p)))))
(cond (cond
((equal? col-info 'total) ((equal? col-info 'total)
(gnc:html-table-set-cell! html-table 0 current-col (_ "Total")) (gnc:html-table-set-cell! html-table 0 current-col (_ "Total")))
)
((list? col-info) ((list? col-info)
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
html-table 0 current-col (string-append html-table 0 current-col (string-append
(period-to-date-string (car col-info)) (period-to-date-string (car col-info))
" – " " – "
(period-to-date-string (car (reverse col-info))) (period-to-date-string
) (car (reverse col-info))))))
)
)
(else (else
(gnc:html-table-set-cell! (gnc:html-table-set-cell!
html-table 0 current-col (period-to-date-string col-info) html-table 0 current-col (period-to-date-string col-info))))
)
)
)
(set! tc (gnc:html-table-get-cell html-table 0 current-col)) (set! tc (gnc:html-table-get-cell html-table 0 current-col))
(gnc:html-table-cell-set-colspan! tc col-span) (gnc:html-table-cell-set-colspan! tc col-span)
(gnc:html-table-cell-set-tag! tc "centered-label-cell") (gnc:html-table-cell-set-tag! tc "centered-label-cell")
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))
(set! col-list (cdr col-list)) (set! col-list (cdr col-list))))
)
)
;; make the column headers ;; make the column headers
(set! col-list column-list) (set! col-list column-list)
@ -592,37 +550,30 @@
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table 1 current-col "centered-label-cell" html-table 1 current-col "centered-label-cell"
(_ "Bgt")) ;; Translators: Abbreviation for "Budget" (_ "Bgt")) ;; Translators: Abbreviation for "Budget"
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))
)
)
(if show-actual? (if show-actual?
(begin (begin
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table 1 current-col "centered-label-cell" html-table 1 current-col "centered-label-cell"
(_ "Act")) ;; Translators: Abbreviation for "Actual" (_ "Act")) ;; Translators: Abbreviation for "Actual"
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))
)
)
(if show-diff? (if show-diff?
(begin (begin
(gnc:html-table-set-cell/tag! (gnc:html-table-set-cell/tag!
html-table 1 current-col "centered-label-cell" html-table 1 current-col "centered-label-cell"
(_ "Diff")) ;; Translators: Abbreviation for "Difference" (_ "Diff")) ;; Translators: Abbreviation for "Difference"
(set! current-col (+ current-col 1)) (set! current-col (+ current-col 1))))
) (set! column-list (cdr column-list))))))
)
(set! column-list (cdr column-list))
)
)
)
);;end of define gnc:html-table-add-budget-headers
;; Determines the budget period relative to current period. Budget period is current if ;; Determines the budget period relative to current period. Budget
;; it start time <= current time and end time >= current time ;; period is current if it start time <= current time and end time
;; When period is found it's passed to adjuster that is responsible for final calculation of period. ;; >= current time When period is found it's passed to adjuster
;; that is responsible for final calculation of period.
;; ;;
;; If budget in future then first period of bundget is returned, if it in past, then the last period is returned ;; If budget in future then first period of budget is returned,
;; if adjuster produced period number that is less then first period or greater than last period, the same rules apply. ;; if it in past, then the last period is returned if adjuster
;; produced period number that is less then first period or
;; greater than last period, the same rules apply.
;; ;;
;; Parameters: ;; Parameters:
;; budget - budget to use ;; budget - budget to use
@ -632,27 +583,24 @@
(total-periods (gnc-budget-get-num-periods budget) ) (total-periods (gnc-budget-get-num-periods budget) )
(last-period (- total-periods 1)) (last-period (- total-periods 1))
(period-start (lambda (x) (gnc-budget-get-period-start-date budget x))) (period-start (lambda (x) (gnc-budget-get-period-start-date budget x)))
(period-end (lambda (x) (gnc-budget-get-period-end-date budget x))) (period-end (lambda (x) (gnc-budget-get-period-end-date budget x))))
)
(cond ((< now (period-start 0)) 1) (cond ((< now (period-start 0)) 1)
((> now (period-end last-period)) total-periods) ((> now (period-end last-period)) total-periods)
( else (let ((found-period ( else (let ((found-period
(find (lambda (period) (find (lambda (period)
(and (>= now (period-start period)) (and (>= now (period-start period))
(<= now (period-end period)))) (<= now (period-end period))))
(iota total-periods)) (iota total-periods))))
))
(gnc:debug "current period =" found-period) (gnc:debug "current period =" found-period)
(if found-period (if found-period
(let ((adjusted (adjuster found-period))) (let ((adjusted (adjuster found-period)))
(cond ((< adjusted 0) 0) ((> adjusted last-period) last-period) (else adjusted)) (cond
) ((< adjusted 0) 0)
#f) ((> adjusted last-period) last-period)
)) (else adjusted)))
) #f))))))
) ;; Maps type of user selected period to concrete period number, if
);;end of find-period-relative-to-current ;; user not selected to use range false is returned
;; Maps type of user selected period to concrete period number, if user not selected to use range false is returned
(define (calc-user-period budget (define (calc-user-period budget
use-ranges? period-type period-exact-val) use-ranges? period-type period-exact-val)
(if (not use-ranges?) (if (not use-ranges?)
@ -662,76 +610,66 @@
((eq? 'last period-type) (- (gnc-budget-get-num-periods budget) 1)) ((eq? 'last period-type) (- (gnc-budget-get-num-periods budget) 1))
((eq? 'manual period-type) (- period-exact-val 1)) ((eq? 'manual period-type) (- period-exact-val 1))
((eq? 'previous period-type) ((eq? 'previous period-type)
(find-period-relative-to-current budget (lambda (period) (- period 1)))) (find-period-relative-to-current budget (lambda (period)
(- period 1))))
((eq? 'current period-type) ((eq? 'current period-type)
(find-period-relative-to-current budget (lambda (period) period ))) (find-period-relative-to-current budget (lambda (period)
period)))
((eq? 'next period-type) ((eq? 'next period-type)
(find-period-relative-to-current budget (lambda (period) ( + period 1)))) (find-period-relative-to-current budget (lambda (period)
) (+ period 1)))))))
) ;; Performs calculation of periods list. If list element is a list
);;end of calc-user-period budget ;; itself, it means that elements of this sublist should be
;; Performs calculation of periods list. If list element is a list itself, it means that ;; presented as summed value. If user required a total column
;; elements of this sublist should be presented as summed value. ;; calculation a quoted total val appended to the end For example
;; If user required a total column calculation a quoted total val appended to the end ;; if function produced list ( (0 1 2 3 4) 5 6 7 (8 9) 'total)
;; For example if function produced list ( (0 1 2 3 4) 5 6 7 (8 9) 'total) then budget report will ;; then budget report will have 6 columns:
;; have 6 columns:
;; -- first column is a sum of values for periods 0..4 ;; -- first column is a sum of values for periods 0..4
;; -- second .. forth columns is a values for periods 5,6,7 ;; -- second .. forth columns is a values for periods 5,6,7
;; -- fifth is a sum of value for periods 8, 9 ;; -- fifth is a sum of value for periods 8, 9
;; -- sixth a column with total of all columns ;; -- sixth a column with total of all columns
;; ;;
;; Total is calculated only for selected periods. So if the list resulted in (3 4 'total), total column ;; Total is calculated only for selected periods. So if the list
;; will contain the sum of values for periods 3,4 ;; resulted in (3 4 'total), total column will contain the sum of
;; values for periods 3,4
(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)
(define (int-range current end step lst) (define (int-range current end step lst)
(if (>= current end) (if (>= current end)
lst lst
(int-range (+ current step) end step (cons current lst)))) (int-range (+ current step) end step (cons current lst))))
(reverse (int-range (if (number? start) start 0) end 1 '())) (reverse (int-range (if (number? start) start 0) end 1 '())))
)
(let* ((num-periods (gnc-budget-get-num-periods budget)) (let* ((num-periods (gnc-budget-get-num-periods budget))
(range-start (if user-start user-start 0)) (range-start (if user-start user-start 0))
(range-end (if user-end (+ 1 user-end) num-periods)) (range-end (if user-end (+ 1 user-end) num-periods))
(fold-before-start 0) (fold-before-start 0)
(fold-before-end (if collapse-before? range-start 0)) (fold-before-end (if collapse-before? range-start 0))
(fold-after-start (if collapse-after? range-end num-periods)) (fold-after-start (if collapse-after? range-end num-periods))
(fold-after-end num-periods) (fold-after-end num-periods))
)
(map (lambda (x) (if (and (list? x) (= 1 (length x))) (car x) x)) (map (lambda (x) (if (and (list? x) (= 1 (length x))) (car x) x))
(filter (lambda (x) (not (null? x))) (filter (lambda (x) (not (null? x)))
(append (list (range fold-before-start fold-before-end)) (append (list (range fold-before-start fold-before-end))
(range range-start range-end) (range range-start range-end)
(list (range fold-after-start fold-after-end)) (list (range fold-after-start fold-after-end))
(if show-total? (list 'total) '()) (if show-total? (list 'total) '()))))))
)))
)
);;end of define calc-periods
;; end of defines ;; end of defines
(let* ((rownum 0) (let* ((rownum 0)
(use-ranges? (get-val params 'use-ranges)) (use-ranges? (get-val params 'use-ranges))
(column-info-list (calc-periods budget (column-info-list (calc-periods
(calc-user-period budget budget
use-ranges? (calc-user-period
budget use-ranges?
(get-val params 'user-start-period) (get-val params 'user-start-period)
(get-val params 'user-start-period-exact) (get-val params 'user-start-period-exact))
) (calc-user-period
(calc-user-period budget budget use-ranges?
use-ranges?
(get-val params 'user-end-period) (get-val params 'user-end-period)
(get-val params 'user-end-period-exact) (get-val params 'user-end-period-exact))
)
(get-val params 'collapse-before) (get-val params 'collapse-before)
(get-val params 'collapse-after) (get-val params 'collapse-after)
show-totalcol? show-totalcol?))
))
;;(html-table (or html-table (gnc:make-html-table))) ;;(html-table (or html-table (gnc:make-html-table)))
;; WARNING: we implicitly depend here on the details of ;; WARNING: we implicitly depend here on the details of
;; gnc:html-table-add-account-balances. Specifically, we ;; gnc:html-table-add-account-balances. Specifically, we
@ -749,22 +687,18 @@
;; call gnc:html-table-add-budget-line! for each account ;; call gnc:html-table-add-budget-line! for each account
(while (< rownum num-rows) (while (< rownum num-rows)
(let* ( (let* ((env (append (gnc:html-acct-table-get-row-env acct-table rownum)
(env (append (gnc:html-acct-table-get-row-env acct-table rownum) params)) params))
(acct (get-val env 'account)) (acct (get-val env 'account))
(exchange-fn (get-val env 'exchange-fn)) (exchange-fn (get-val env 'exchange-fn)))
)
(gnc:html-table-add-budget-line! (gnc:html-table-add-budget-line!
html-table rownum colnum budget acct rollup-budget? column-info-list exchange-fn) html-table rownum colnum budget acct rollup-budget?
(set! rownum (+ rownum 1)) ;; increment rownum column-info-list exchange-fn)
) (set! rownum (+ rownum 1))))
) ;; end of while
;; column headers ;; column headers
(gnc:html-table-add-budget-headers! html-table colnum budget column-info-list) (gnc:html-table-add-budget-headers!
) html-table colnum budget column-info-list))))
)
) ;; end of define gnc:html-table-add-budget-values
;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; budget-renderer ;; budget-renderer
@ -795,20 +729,19 @@
optname-show-zb-accounts)) optname-show-zb-accounts))
(use-ranges? (get-option gnc:pagename-general optname-use-budget-period-range)) (use-ranges? (get-option gnc:pagename-general optname-use-budget-period-range))
(include-collapse-before? (if use-ranges? (include-collapse-before? (if use-ranges?
(get-option gnc:pagename-general optname-period-collapse-before) #f)) (get-option gnc:pagename-general
optname-period-collapse-before)
#f))
(include-collapse-after? (if use-ranges? (include-collapse-after? (if use-ranges?
(get-option gnc:pagename-general optname-period-collapse-after) #f)) (get-option gnc:pagename-general
(row-num 0) ;; ??? optname-period-collapse-after)
#f))
(row-num 0)
(work-done 0) (work-done 0)
(work-to-do 0) (work-to-do 0)
;;(report-currency (get-option gnc:pagename-general
;; optname-report-currency))
(show-full-names? (get-option gnc:pagename-general (show-full-names? (get-option gnc:pagename-general
optname-show-full-names)) optname-show-full-names))
(doc (gnc:make-html-document)) (doc (gnc:make-html-document)))
;;(table (gnc:make-html-table))
;;(txt (gnc:make-html-text))
)
;; end of defines ;; end of defines
@ -835,9 +768,10 @@
(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))
(to-period-val (lambda (v) (inexact->exact (truncate (get-option gnc:pagename-general v))))) (to-period-val (lambda (v)
;;(account-disp-list '()) (inexact->exact
(truncate
(get-option gnc:pagename-general v)))))
(env (list (env (list
(list 'start-date (gnc:budget-get-start-date budget)) (list 'start-date (gnc:budget-get-start-date budget))
(list 'end-date (gnc:budget-get-end-date budget)) (list 'end-date (gnc:budget-get-end-date budget))
@ -846,12 +780,12 @@
(if bottom-behavior 'flatten 'summarize)) (if bottom-behavior 'flatten 'summarize))
(list 'zero-balance-mode (list 'zero-balance-mode
(if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct)) (if show-zb-accts? 'show-leaf-acct 'omit-leaf-acct))
(list 'report-budget budget) (list 'report-budget budget)))
))
(acct-table #f) (acct-table #f)
(html-table (gnc:make-html-table)) (html-table (gnc:make-html-table))
(params '()) (params '())
(paramsBudget (list (paramsBudget
(list
(list 'show-actual (list 'show-actual
(get-option gnc:pagename-display optname-show-actual)) (get-option gnc:pagename-display optname-show-actual))
(list 'show-budget (list 'show-budget
@ -865,14 +799,18 @@
(list 'use-ranges use-ranges?) (list 'use-ranges use-ranges?)
(list 'collapse-before include-collapse-before?) (list 'collapse-before include-collapse-before?)
(list 'collapse-after include-collapse-after?) (list 'collapse-after include-collapse-after?)
(list 'user-start-period (get-option gnc:pagename-general optname-budget-period-start)) (list 'user-start-period
(list 'user-end-period (get-option gnc:pagename-general optname-budget-period-end)) (get-option gnc:pagename-general
(list 'user-start-period-exact (to-period-val optname-budget-period-start-exact)) optname-budget-period-start))
(list 'user-end-period-exact (to-period-val optname-budget-period-end-exact)) (list 'user-end-period
)) (get-option gnc:pagename-general
optname-budget-period-end))
(list 'user-start-period-exact
(to-period-val optname-budget-period-start-exact))
(list 'user-end-period-exact
(to-period-val optname-budget-period-end-exact))))
(report-name (get-option gnc:pagename-general (report-name (get-option gnc:pagename-general
gnc:optname-reportname)) gnc:optname-reportname)))
)
(gnc:html-document-set-title! (gnc:html-document-set-title!
doc (format #f (_ "~a: ~a") doc (format #f (_ "~a: ~a")
@ -899,8 +837,7 @@
;; table width, since the add-account-balance had put stuff ;; table width, since the add-account-balance had put stuff
;; there, but it doesn't seem to matter. ;; there, but it doesn't seem to matter.
(gnc:html-document-add-object! doc html-table)))) (gnc:html-document-add-object! doc html-table)))))
) ;; end cond
(gnc:report-finished) (gnc:report-finished)
doc)) doc))