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