gnucash master: [budget] show budget-notes in report as footnotes

Christopher Lam clam at code.gnucash.org
Thu Oct 10 10:18:08 EDT 2019


Updated	 via  https://github.com/Gnucash/gnucash/commit/fa800fad (commit)
	from  https://github.com/Gnucash/gnucash/commit/84034044 (commit)



commit fa800fadee4711ee0c96b5ad4c0e87bf7025d2db
Author: Christopher Lam <christopher.lck at gmail.com>
Date:   Mon Oct 7 22:20:59 2019 +0800

    [budget] show budget-notes in report as footnotes

diff --git a/gnucash/report/reports/standard/budget.scm b/gnucash/report/reports/standard/budget.scm
index 0345d456e..b0eb31370 100644
--- a/gnucash/report/reports/standard/budget.scm
+++ b/gnucash/report/reports/standard/budget.scm
@@ -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))



Summary of changes:
 gnucash/report/reports/standard/budget.scm | 84 ++++++++++++++++++++++++------
 1 file changed, 67 insertions(+), 17 deletions(-)



More information about the gnucash-changes mailing list