r18213 - gnucash/trunk/src/report - Fix budget report so that it uses stylesheet tags so that fonts can be controlled
Phil Longstaff
plongstaff at code.gnucash.org
Fri Jul 17 18:36:53 EDT 2009
Author: plongstaff
Date: 2009-07-17 18:36:53 -0400 (Fri, 17 Jul 2009)
New Revision: 18213
Trac: http://svn.gnucash.org/trac/changeset/18213
Modified:
gnucash/trunk/src/report/report-system/html-table.scm
gnucash/trunk/src/report/report-system/report-system.scm
gnucash/trunk/src/report/standard-reports/budget.scm
Log:
Fix budget report so that it uses stylesheet tags so that fonts can be controlled
Modified: gnucash/trunk/src/report/report-system/html-table.scm
===================================================================
--- gnucash/trunk/src/report/report-system/html-table.scm 2009-07-17 18:11:15 UTC (rev 18212)
+++ gnucash/trunk/src/report/report-system/html-table.scm 2009-07-17 22:36:53 UTC (rev 18213)
@@ -424,31 +424,31 @@
;; otherwise, append all remaining objects to the existing cell
(define (gnc:html-table-set-cell! table row col . objects)
(let ((rowdata #f)
- (row-loc #f)
+ (row-loc #f)
(l (length (gnc:html-table-data table)))
- (objs (length objects))
- )
+ (objs (length objects))
+ )
;; ensure the row-data is there
(if (>= row l)
- (begin
+ (begin
(let loop ((i l))
- (gnc:html-table-append-row! table (list))
+ (gnc:html-table-append-row! table (list))
(if (< i row)
(loop (+ i 1))))
(set! l (gnc:html-table-num-rows table))
- (set! row-loc (- (- l 1) row))
+ (set! row-loc (- (- l 1) row))
(set! rowdata (list)))
- (begin
- (set! row-loc (- (- l 1) row))
- (set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
+ (begin
+ (set! row-loc (- (- l 1) row))
+ (set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
;; make a table-cell and set the data
(let* ((tc (gnc:make-html-table-cell))
- (first (car objects)))
+ (first (car objects)))
(if (and (equal? objs 1) (gnc:html-table-cell? first))
- (set! tc first)
- (apply gnc:html-table-cell-append-objects! tc objects)
- )
+ (set! tc first)
+ (apply gnc:html-table-cell-append-objects! tc objects)
+ )
(set! rowdata (list-set-safe! rowdata col tc))
;; add the row-data back to the table
@@ -457,6 +457,44 @@
(gnc:html-table-data table)
row-loc rowdata)))))
+;; if the 4th arg is a cell, overwrite the existing cell,
+;; otherwise, append all remaining objects to the existing cell
+(define (gnc:html-table-set-cell/tag! table row col tag . objects)
+ (let ((rowdata #f)
+ (row-loc #f)
+ (l (length (gnc:html-table-data table)))
+ (num-objs (length objects))
+ )
+ ;; ensure the row-data is there
+ (if (>= row l)
+ (begin
+ (let loop ((i l))
+ (gnc:html-table-append-row! table (list))
+ (if (< i row)
+ (loop (+ i 1))))
+ (set! l (gnc:html-table-num-rows table))
+ (set! row-loc (- (- l 1) row))
+ (set! rowdata (list)))
+ (begin
+ (set! row-loc (- (- l 1) row))
+ (set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
+
+ ;; make a table-cell and set the data
+ (let* ((tc (gnc:make-html-table-cell))
+ (first (car objects)))
+ (if (and (equal? num-objs 1) (gnc:html-table-cell? first))
+ (set! tc first)
+ (apply gnc:html-table-cell-append-objects! tc objects)
+ )
+ (gnc:html-table-cell-set-tag! tc tag)
+ (set! rowdata (list-set-safe! rowdata col tc))
+
+ ;; add the row-data back to the table
+ (gnc:html-table-set-data!
+ table (list-set-safe!
+ (gnc:html-table-data table)
+ row-loc rowdata)))))
+
(define (gnc:html-table-append-column! table newcol)
(define (maxwidth table-data)
(if (null? table-data) 0
Modified: gnucash/trunk/src/report/report-system/report-system.scm
===================================================================
--- gnucash/trunk/src/report/report-system/report-system.scm 2009-07-17 18:11:15 UTC (rev 18212)
+++ gnucash/trunk/src/report/report-system/report-system.scm 2009-07-17 22:36:53 UTC (rev 18213)
@@ -580,6 +580,7 @@
(export gnc:html-table-prepend-row!)
(export gnc:html-table-get-cell)
(export gnc:html-table-set-cell!)
+(export gnc:html-table-set-cell/tag!)
(export gnc:html-table-append-column!)
(export gnc:html-table-prepend-column!)
(export gnc:html-table-merge)
Modified: gnucash/trunk/src/report/standard-reports/budget.scm
===================================================================
--- gnucash/trunk/src/report/standard-reports/budget.scm 2009-07-17 18:11:15 UTC (rev 18212)
+++ gnucash/trunk/src/report/standard-reports/budget.scm 2009-07-17 22:36:53 UTC (rev 18213)
@@ -195,22 +195,22 @@
(set! act-total (gnc-numeric-add act-total act-numeric-val GNC-DENOM-AUTO GNC-RND-ROUND))
(if show-budget?
(begin
- (gnc:html-table-set-cell!
- html-table rownum current-col bgt-val)
+ (gnc:html-table-set-cell/tag!
+ html-table rownum current-col "number-cell" bgt-val)
(set! current-col (+ current-col 1))
)
)
(if show-actual?
(begin
- (gnc:html-table-set-cell!
- html-table rownum current-col act-val)
+ (gnc:html-table-set-cell/tag!
+ html-table rownum current-col "number-cell" act-val)
(set! current-col (+ current-col 1))
)
)
(if show-diff?
(begin
- (gnc:html-table-set-cell!
- html-table rownum current-col dif-val)
+ (gnc:html-table-set-cell/tag!
+ html-table rownum current-col "number-cell" dif-val)
(set! current-col (+ current-col 1))
)
)
@@ -268,29 +268,30 @@
;; make the column headers
(while (< period num-periods)
(let* ((date (gnc-budget-get-period-start-date budget period)))
- (gnc:html-table-set-cell!
- html-table 0 (if show-diff? (+ current-col 1) current-col) (gnc-print-date date))
+ (gnc:html-table-set-cell/tag!
+ html-table 0 (if show-diff? (+ current-col 1) current-col) "centered-label-cell"
+ (gnc-print-date date))
(if show-budget?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Bgt")) ;; Translators: Abbreviation for "Budget"
+ (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))
)
)
(if show-actual?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Act")) ;; Translators: Abbreviation for "Actual"
+ (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))
)
)
(if show-diff?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Diff")) ;; Translators: Abbrevation for "Difference"
+ (gnc:html-table-set-cell/tag!
+ html-table 1 current-col "centered-label-cell"
+ (_ "Diff")) ;; Translators: Abbrevation for "Difference"
(set! current-col (+ current-col 1))
)
)
@@ -299,29 +300,30 @@
)
(if show-totalcol?
(begin
- (gnc:html-table-set-cell!
- html-table 0 (if show-diff? (+ current-col 1) current-col) "Total")
+ (gnc:html-table-set-cell/tag!
+ html-table 0 (if show-diff? (+ current-col 1) current-col) "centered-label-cell"
+ "Total")
(if show-budget?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Bgt")) ;; Translators: Abbreviation for "Budget"
+ (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))
)
)
(if show-actual?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Act")) ;; Translators: Abbreviation for "Actual"
+ (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))
)
)
(if show-diff?
(begin
- (gnc:html-table-set-cell!
- html-table 1
- current-col (_ "Diff")) ;; Translators: Abbrevation for "Difference"
+ (gnc:html-table-set-cell/tag!
+ html-table 1 current-col "centered-label-cell"
+ (_ "Diff")) ;; Translators: Abbrevation for "Difference"
(set! current-col (+ current-col 1))
)
)
More information about the gnucash-changes
mailing list