[budget] show budget-notes in report as footnotes

pull/588/head
Christopher Lam 7 years ago
parent 84034044ce
commit fa800fadee

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

Loading…
Cancel
Save