|
|
|
|
@ -34,6 +34,7 @@
|
|
|
|
|
(use-modules (gnucash engine))
|
|
|
|
|
|
|
|
|
|
(use-modules (srfi srfi-1))
|
|
|
|
|
(use-modules (ice-9 match))
|
|
|
|
|
|
|
|
|
|
(gnc:module-load "gnucash/report" 0)
|
|
|
|
|
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc-build-url
|
|
|
|
|
@ -51,6 +52,8 @@
|
|
|
|
|
(define optname-select-columns (N_ "Select Columns"))
|
|
|
|
|
(define optname-show-budget (N_ "Show Budget"))
|
|
|
|
|
(define opthelp-show-budget (N_ "Display a column for the budget values."))
|
|
|
|
|
(define optname-show-notes (N_ "Show Budget Notes"))
|
|
|
|
|
(define opthelp-show-notes (N_ "Display a column for the budget notes."))
|
|
|
|
|
(define optname-show-actual (N_ "Show Actual"))
|
|
|
|
|
(define opthelp-show-actual (N_ "Display a column for the actual values."))
|
|
|
|
|
(define optname-show-difference (N_ "Show Difference"))
|
|
|
|
|
@ -229,9 +232,15 @@
|
|
|
|
|
|
|
|
|
|
;; columns to display
|
|
|
|
|
(add-option
|
|
|
|
|
(gnc:make-simple-boolean-option
|
|
|
|
|
(gnc:make-complex-boolean-option
|
|
|
|
|
gnc:pagename-display optname-show-budget
|
|
|
|
|
"s1" opthelp-show-budget #t))
|
|
|
|
|
"s1" opthelp-show-budget #t #f
|
|
|
|
|
(lambda (x)
|
|
|
|
|
(set-option-enabled options gnc:pagename-display optname-show-notes x))))
|
|
|
|
|
(add-option
|
|
|
|
|
(gnc:make-simple-boolean-option
|
|
|
|
|
gnc:pagename-display optname-show-notes
|
|
|
|
|
"s15" opthelp-show-budget #t))
|
|
|
|
|
(add-option
|
|
|
|
|
(gnc:make-simple-boolean-option
|
|
|
|
|
gnc:pagename-display optname-show-actual
|
|
|
|
|
@ -254,6 +263,27 @@
|
|
|
|
|
|
|
|
|
|
options))
|
|
|
|
|
|
|
|
|
|
;; creates a footnotes collector. (make-footnote-collector) => coll
|
|
|
|
|
;; (coll elt) adds elt to store, returns html-text containing ref eg. [1]
|
|
|
|
|
;; (coll 'list) returns html-text containing <ul> of all elts
|
|
|
|
|
(define (make-footnote-collector)
|
|
|
|
|
(let ((notes '()) (num 0))
|
|
|
|
|
(match-lambda
|
|
|
|
|
('list
|
|
|
|
|
(let lp ((num num) (notes notes) (res '()))
|
|
|
|
|
(match notes
|
|
|
|
|
(() (gnc:make-html-text (gnc:html-markup-ul res)))
|
|
|
|
|
((note . rest)
|
|
|
|
|
(lp (1- num) rest (cons (format #f "~a. ~a" num note) res))))))
|
|
|
|
|
((or #f "")
|
|
|
|
|
(gnc:make-html-table-cell/min-width 1))
|
|
|
|
|
(note
|
|
|
|
|
(set! notes (cons (gnc:html-string-sanitize note) notes))
|
|
|
|
|
(set! num (1+ num))
|
|
|
|
|
(let ((cell (gnc:make-html-table-cell (format #f "[~a]" num))))
|
|
|
|
|
(gnc:html-table-cell-set-style! cell "td" 'attribute `("title" ,note))
|
|
|
|
|
cell)))))
|
|
|
|
|
|
|
|
|
|
;; Create the html table for the budget report
|
|
|
|
|
;;
|
|
|
|
|
;; Parameters
|
|
|
|
|
@ -269,6 +299,8 @@
|
|
|
|
|
(show-actual? (get-val params 'show-actual))
|
|
|
|
|
(show-budget? (get-val params 'show-budget))
|
|
|
|
|
(show-diff? (get-val params 'show-difference))
|
|
|
|
|
(show-note? (get-val params 'show-note))
|
|
|
|
|
(footnotes (get-val params 'footnotes))
|
|
|
|
|
(accumulate? (get-val params 'use-envelope))
|
|
|
|
|
(show-totalcol? (get-val params 'show-totalcol))
|
|
|
|
|
(use-ranges? (get-val params 'use-ranges))
|
|
|
|
|
@ -345,32 +377,38 @@
|
|
|
|
|
;; bgt-val - budget value
|
|
|
|
|
;; act-val - actual value
|
|
|
|
|
;; dif-val - difference value
|
|
|
|
|
;; note - note (string) or #f
|
|
|
|
|
;;
|
|
|
|
|
;; Returns
|
|
|
|
|
;; col - next column
|
|
|
|
|
(define (disp-cols style-tag col0
|
|
|
|
|
bgt-val act-val dif-val)
|
|
|
|
|
bgt-val act-val dif-val note)
|
|
|
|
|
(let* ((col1 (+ col0 (if show-budget? 1 0)))
|
|
|
|
|
(col2 (+ col1 (if show-actual? 1 0)))
|
|
|
|
|
(col3 (+ col2 (if show-diff? 1 0))))
|
|
|
|
|
(col2 (+ col1 (if show-note? 1 0)))
|
|
|
|
|
(col3 (+ col2 (if show-actual? 1 0)))
|
|
|
|
|
(col4 (+ col3 (if show-diff? 1 0))))
|
|
|
|
|
(if show-budget?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table rownum col0
|
|
|
|
|
style-tag
|
|
|
|
|
(if (zero? bgt-val) "."
|
|
|
|
|
(gnc:make-gnc-monetary comm bgt-val))))
|
|
|
|
|
(if show-note?
|
|
|
|
|
(gnc:html-table-set-cell!
|
|
|
|
|
html-table rownum col1
|
|
|
|
|
(footnotes note)))
|
|
|
|
|
(if show-actual?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table rownum col1
|
|
|
|
|
html-table rownum col2
|
|
|
|
|
style-tag
|
|
|
|
|
(gnc:make-gnc-monetary comm act-val)))
|
|
|
|
|
(if show-diff?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table rownum col2
|
|
|
|
|
html-table rownum col3
|
|
|
|
|
style-tag
|
|
|
|
|
(if (and (zero? bgt-val) (zero? act-val)) "."
|
|
|
|
|
(gnc:make-gnc-monetary comm dif-val))))
|
|
|
|
|
col3))
|
|
|
|
|
col4))
|
|
|
|
|
|
|
|
|
|
(let loop ((column-list column-list)
|
|
|
|
|
(current-col (1+ colnum)))
|
|
|
|
|
@ -390,13 +428,16 @@
|
|
|
|
|
(- bgt-total act-total))))
|
|
|
|
|
(loop (cdr column-list)
|
|
|
|
|
(disp-cols "total-number-cell" current-col
|
|
|
|
|
bgt-total act-total dif-total))))
|
|
|
|
|
bgt-total act-total dif-total #f))))
|
|
|
|
|
|
|
|
|
|
(else
|
|
|
|
|
(let* ((period-list (cond
|
|
|
|
|
((list? (car column-list)) (car column-list))
|
|
|
|
|
(accumulate? (iota (1+ (car column-list))))
|
|
|
|
|
(else (list (car column-list)))))
|
|
|
|
|
(note (and (= 1 (length period-list))
|
|
|
|
|
(gnc-budget-get-account-period-note
|
|
|
|
|
budget acct (car period-list))))
|
|
|
|
|
(bgt-val (gnc:get-account-periodlist-budget-value
|
|
|
|
|
budget acct period-list))
|
|
|
|
|
(act-abs (gnc:get-account-periodlist-actual-value
|
|
|
|
|
@ -409,7 +450,7 @@
|
|
|
|
|
(- bgt-val act-val))))
|
|
|
|
|
(loop (cdr column-list)
|
|
|
|
|
(disp-cols "number-cell" current-col
|
|
|
|
|
bgt-val act-val dif-val))))))))
|
|
|
|
|
bgt-val act-val dif-val note))))))))
|
|
|
|
|
|
|
|
|
|
;; Adds header rows to the budget report. The columns are
|
|
|
|
|
;; specified by the column-list parameter.
|
|
|
|
|
@ -423,7 +464,8 @@
|
|
|
|
|
html-table colnum budget column-list)
|
|
|
|
|
(let* ((current-col (1+ colnum))
|
|
|
|
|
(col-span (max 1 (count identity
|
|
|
|
|
(list show-budget? show-actual? show-diff?))))
|
|
|
|
|
(list show-budget? show-actual?
|
|
|
|
|
show-diff? show-note?))))
|
|
|
|
|
(period-to-date-string (lambda (p)
|
|
|
|
|
(qof-print-date
|
|
|
|
|
(gnc-budget-get-period-start-date budget p)))))
|
|
|
|
|
@ -459,8 +501,9 @@
|
|
|
|
|
(col0 current-col))
|
|
|
|
|
(unless (null? column-list)
|
|
|
|
|
(let* ((col1 (+ col0 (if show-budget? 1 0)))
|
|
|
|
|
(col2 (+ col1 (if show-actual? 1 0)))
|
|
|
|
|
(col3 (+ col2 (if show-diff? 1 0))))
|
|
|
|
|
(col2 (+ col1 (if show-note? 1 0)))
|
|
|
|
|
(col3 (+ col2 (if show-actual? 1 0)))
|
|
|
|
|
(col4 (+ col3 (if show-diff? 1 0))))
|
|
|
|
|
(when show-budget?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table 1 col0 "centered-label-cell"
|
|
|
|
|
@ -468,16 +511,16 @@
|
|
|
|
|
(_ "Bgt")))
|
|
|
|
|
(when show-actual?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table 1 col1 "centered-label-cell"
|
|
|
|
|
html-table 1 col2 "centered-label-cell"
|
|
|
|
|
;; Translators: Abbreviation for "Actual" amount
|
|
|
|
|
(_ "Act")))
|
|
|
|
|
(when show-diff?
|
|
|
|
|
(gnc:html-table-set-cell/tag!
|
|
|
|
|
html-table 1 col2 "centered-label-cell"
|
|
|
|
|
html-table 1 col3 "centered-label-cell"
|
|
|
|
|
;; Translators: Abbreviation for "Difference" amount
|
|
|
|
|
(_ "Diff")))
|
|
|
|
|
(loop (cdr column-list)
|
|
|
|
|
col3))))))
|
|
|
|
|
col4))))))
|
|
|
|
|
|
|
|
|
|
;; Determines the budget period relative to current period. Budget
|
|
|
|
|
;; period is current if it start time <= current time and end time
|
|
|
|
|
@ -666,6 +709,7 @@
|
|
|
|
|
(accounts (sort accounts account-full-name<?))
|
|
|
|
|
(accumulate? (get-option gnc:pagename-general optname-accumulate))
|
|
|
|
|
(acct-table (gnc:make-html-acct-table/env/accts env accounts))
|
|
|
|
|
(footnotes (make-footnote-collector))
|
|
|
|
|
(paramsBudget
|
|
|
|
|
(list
|
|
|
|
|
(list 'show-actual
|
|
|
|
|
@ -674,6 +718,10 @@
|
|
|
|
|
(get-option gnc:pagename-display optname-show-budget))
|
|
|
|
|
(list 'show-difference
|
|
|
|
|
(get-option gnc:pagename-display optname-show-difference))
|
|
|
|
|
(list 'show-note
|
|
|
|
|
(and (get-option gnc:pagename-display optname-show-budget)
|
|
|
|
|
(get-option gnc:pagename-display optname-show-notes)))
|
|
|
|
|
(list 'footnotes footnotes)
|
|
|
|
|
(list 'use-envelope accumulate?)
|
|
|
|
|
(list 'show-totalcol
|
|
|
|
|
(get-option gnc:pagename-display optname-show-totalcol))
|
|
|
|
|
@ -717,7 +765,9 @@
|
|
|
|
|
;; 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)))))
|
|
|
|
|
(gnc:html-document-add-object! doc html-table)
|
|
|
|
|
|
|
|
|
|
(gnc:html-document-add-object! doc (footnotes 'list))))))
|
|
|
|
|
|
|
|
|
|
(gnc:report-finished)
|
|
|
|
|
doc))
|
|
|
|
|
|