IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2026-09-03 20:53:02 -05:00
Code Issues Packages Projects Releases Wiki Activity

2001-04-25 Robert Graham Merkel <rgmerk@mira.net>

Browse Source 
* src/scm/html-utilities.scm:
	(gnc:html-table-append-ruler/markup!) new function.  Also modify
	(gnc:html-build-acct-table) and other functions to use global row
	styles.

	* src/scm/html-table.scm:(gnc:html-table-prepend-row/markup!)  fix
	bug.

	* src/scm/report/balance-sheet.scm: use new global row styles.

	* src/scm/report/stylesheet-*.scm: add new global row styles.

	* src/scm/report/transaction-report.scm: use new global row styles,
	fix bug with memo display.  Remove local color options.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@4042 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
2001-04-25 07:20:24 +00:00
parent 8763645345
commit 0f03218b20
7 changed files with 245 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files
ChangeLog
+17
View File
@@ -1,3 +1,20 @@
2001-04-25 Robert Graham Merkel <rgmerk@mira.net>
* src/scm/html-utilities.scm:
(gnc:html-table-append-ruler/markup!) new function. Also modify
(gnc:html-build-acct-table) and other functions to use global row
styles.
* src/scm/html-table.scm:(gnc:html-table-prepend-row/markup!) fix
bug.
* src/scm/report/balance-sheet.scm: use new global row styles.
* src/scm/report/stylesheet-*.scm: add new global row styles.
* src/scm/report/transaction-report.scm: use new global row styles,
fix bug with memo display. Remove local color options.
2001-04-24 Bill Gribble <grib@billgribble.com> 2001-04-24 Bill Gribble <grib@billgribble.com>
* src/FileDialog.c: call book-opened-hook and book-closed-hook * src/FileDialog.c: call book-opened-hook and book-closed-hook
src/scm/html-table.scm
+5 -2
View File
@@ -314,7 +314,7 @@
(let ((max 0)) (let ((max 0))
(for-each (for-each
(lambda (row) (lambda (row)
(let ((l (length row))) (let ((l (length row)))
(if (> l max) (if (> l max)
(set! max l)))) (set! max l))))
(gnc:html-table-data table)) (gnc:html-table-data table))
@@ -325,7 +325,10 @@
(gnc:html-table-set-row-markup! table (- rownum 1) markup))) (gnc:html-table-set-row-markup! table (- rownum 1) markup)))
(define (gnc:html-table-prepend-row/markup! table markup newrow) (define (gnc:html-table-prepend-row/markup! table markup newrow)
(gnc:html-table-set-row-markup! table 0 markup)) (begin
(gnc:html-table-prepend-row! table newrow)
(gnc:html-table-set-row-markup! table 0 markup)))
(define (gnc:html-table-append-row! table newrow) (define (gnc:html-table-append-row! table newrow)
(let* ((dd (gnc:html-table-data table)) (let* ((dd (gnc:html-table-data table))
src/scm/html-utilities.scm
+54 -25
View File
@@ -116,6 +116,14 @@
(gnc:make-html-table-cell/size (gnc:make-html-table-cell/size
1 colspan (gnc:make-html-text (gnc:html-markup-hr)))))) 1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
(define (gnc:html-table-append-ruler/markup! table markup colspan)
(gnc:html-table-append-row/markup!
table
markup
(list
(gnc:make-html-table-cell/size
1 colspan (gnc:make-html-text (gnc:html-markup-hr))))))
;; Creates a table cell with some text in it. The cell will be created ;; Creates a table cell with some text in it. The cell will be created
;; with the colspan 'colspan' (the rowspan==1), the content 'content' ;; with the colspan 'colspan' (the rowspan==1), the content 'content'
;; and in boldface if 'boldface?' is true. 'content' may be #f, or a ;; and in boldface if 'boldface?' is true. 'content' may be #f, or a
@@ -139,13 +147,13 @@
(define (gnc:html-acct-table-row-helper! (define (gnc:html-acct-table-row-helper!
table tree-depth table tree-depth
current-depth my-name my-balance current-depth my-name my-balance
reverse-balance? boldface? group-header-line?) reverse-balance? row-style boldface? group-header-line?)
;; just a stupid little helper ;; just a stupid little helper
(define (identity a) (define (identity a)
a) a)
(gnc:html-table-append-row/markup!
(gnc:html-table-append-row!
table table
row-style
(append (append
;; left half of the table ;; left half of the table
(gnc:html-make-empty-cells (- current-depth 1)) (gnc:html-make-empty-cells (- current-depth 1))
@@ -179,16 +187,18 @@
(define (gnc:html-acct-table-comm-row-helper! (define (gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn table tree-depth report-commodity exchange-fn
current-depth my-name my-commodity balance current-depth my-name my-commodity balance
reverse-balance? is-stock-account? boldface? group-header-line?) reverse-balance? is-stock-account? main-row-style other-rows-style
boldface? group-header-line?)
;; Adds one row to the table. my-name is the html-object ;; Adds one row to the table. my-name is the html-object
;; displayed in the name column; foreign-balance is the ;; displayed in the name column; foreign-balance is the
;; <gnc-monetary> for the foreign column or #f if to be left ;; <gnc-monetary> for the foreign column or #f if to be left
;; empty; domestic-balance is the <gnc-monetary> for the ;; empty; domestic-balance is the <gnc-monetary> for the
;; domestic column. ;; domestic column.
(define (commodity-row-helper! (define (commodity-row-helper!
my-name foreign-balance domestic-balance) my-name foreign-balance domestic-balance row-style)
(gnc:html-table-append-row! (gnc:html-table-append-row/markup!
table table
row-style
(append (append
;; left third of the table ;; left third of the table
(gnc:html-make-empty-cells (- current-depth 1)) (gnc:html-make-empty-cells (- current-depth 1))
@@ -220,7 +230,8 @@
my-name #f my-name #f
(if balance (if balance
(balance 'getmonetary report-commodity reverse-balance?) (balance 'getmonetary report-commodity reverse-balance?)
#f)) #f)
main-row-style)
;; Special case for stock-accounts: then the foreign commodity ;; Special case for stock-accounts: then the foreign commodity
;; gets displayed in this line rather then the following lines ;; gets displayed in this line rather then the following lines
;; (loop below). Is also used if is-stock-account? is true. ;; (loop below). Is also used if is-stock-account? is true.
@@ -230,7 +241,8 @@
(commodity-row-helper! (commodity-row-helper!
my-name my-name
my-balance my-balance
(exchange-fn my-balance report-commodity)))) (exchange-fn my-balance report-commodity)
main-row-style)))
;; The additional rows: show no name, but the foreign currency ;; The additional rows: show no name, but the foreign currency
;; balance and its corresponding value in the ;; balance and its corresponding value in the
@@ -251,7 +263,8 @@
;; print the account balance in the respective ;; print the account balance in the respective
;; commodity ;; commodity
bal bal
(exchange-fn bal report-commodity))))) (exchange-fn bal report-commodity)
other-rows-style))))
#f))) #f)))
@@ -389,25 +402,27 @@
;; Wrapper for gnc:html-acct-table-row-helper! ;; Wrapper for gnc:html-acct-table-row-helper!
(define (add-row-helper! (define (add-row-helper!
current-depth my-name my-balance current-depth my-name my-balance
reverse-balance? boldface? group-header-line?) reverse-balance? row-style boldface? group-header-line?)
(gnc:html-acct-table-row-helper! (gnc:html-acct-table-row-helper!
table tree-depth table tree-depth
current-depth my-name my-balance current-depth my-name my-balance
reverse-balance? boldface? group-header-line?)) reverse-balance? row-style boldface? group-header-line?))
;; Wrapper ;; Wrapper
(define (add-commodity-rows! (define (add-commodity-rows!
current-depth my-name my-commodity balance current-depth my-name my-commodity balance
reverse-balance? is-stock-account? boldface? group-header-line?) reverse-balance? is-stock-account?
main-row-style other-rows-style boldface? group-header-line?)
(gnc:html-acct-table-comm-row-helper! (gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn table tree-depth report-commodity exchange-fn
current-depth my-name my-commodity balance current-depth my-name my-commodity balance
reverse-balance? is-stock-account? boldface? group-header-line?)) reverse-balance? is-stock-account? main-row-style other-rows-style boldface? group-header-line?))
;; Adds all appropriate rows to the table which belong to one ;; Adds all appropriate rows to the table which belong to one
;; account. Uses the above helper function, i.e. here the ;; account. Uses the above helper function, i.e. here the
;; necessary values only are "extracted" from the account. ;; necessary values only are "extracted" from the account.
(define (add-account-rows! acct current-depth) (define (add-account-rows! acct current-depth alternate-row?)
(let ((row-style (if alternate-row? "alternate-row" "normal-row")))
(if show-other-curr? (if show-other-curr?
(add-commodity-rows! current-depth (add-commodity-rows! current-depth
(gnc:html-account-anchor acct) (gnc:html-account-anchor acct)
@@ -415,6 +430,7 @@
(my-get-balance acct) (my-get-balance acct)
(gnc:account-reverse-balance? acct) (gnc:account-reverse-balance? acct)
(gnc:account-has-shares? acct) (gnc:account-has-shares? acct)
row-style row-style
#f #f) #f #f)
(add-row-helper! (add-row-helper!
current-depth current-depth
@@ -422,24 +438,28 @@
(gnc:sum-collector-commodity (my-get-balance acct) (gnc:sum-collector-commodity (my-get-balance acct)
report-commodity exchange-fn) report-commodity exchange-fn)
(gnc:account-reverse-balance? acct) (gnc:account-reverse-balance? acct)
#f #f))) row-style
#f #f))))
;; Generalization of add-account-rows! for a subtotal or for the ;; Generalization of add-account-rows! for a subtotal or for the
;; total balance. ;; total balance.
(define (add-subtotal-row! (define (add-subtotal-row!
current-depth subtotal-name balance boldface? group-header-line?) current-depth subtotal-name balance row-style boldface? group-header-line?)
(if show-other-curr? (if show-other-curr?
(add-commodity-rows! current-depth subtotal-name (add-commodity-rows! current-depth subtotal-name
report-commodity report-commodity
(gnc:sum-collector-stocks (gnc:sum-collector-stocks
balance report-commodity exchange-fn) balance report-commodity exchange-fn)
#f #f boldface? group-header-line?) #f #f row-style row-style
boldface? group-header-line?)
;; Show no other currencies. Therefore just calculate ;; Show no other currencies. Therefore just calculate
;; one total via sum-collector-commodity and show it. ;; one total via sum-collector-commodity and show it.
(add-row-helper! current-depth subtotal-name (add-row-helper! current-depth subtotal-name
(gnc:sum-collector-commodity (gnc:sum-collector-commodity
balance report-commodity exchange-fn) balance report-commodity exchange-fn)
#f boldface? group-header-line?))) #f
row-style
boldface? group-header-line?)))
;; This prints *all* the rows that belong to one group: the title ;; This prints *all* the rows that belong to one group: the title
;; row, the subaccount tree, and the Total row with the balance of ;; row, the subaccount tree, and the Total row with the balance of
@@ -449,10 +469,14 @@
;; balance is calculated from the subaccounts list. ;; balance is calculated from the subaccounts list.
(define (add-group! current-depth groupname subaccounts (define (add-group! current-depth groupname subaccounts
thisbalance group-total-line?) thisbalance group-total-line?)
(begin (let ((heading-style (if (= current-depth 1)
"primary-subheading"
"secondary-subheading")))
;; first the group name ;; first the group name
(add-subtotal-row! current-depth groupname (add-subtotal-row! current-depth groupname
(and show-parent-balance? thisbalance) (and show-parent-balance? thisbalance)
heading-style
(not (and show-parent-balance? thisbalance)) #t) (not (and show-parent-balance? thisbalance)) #t)
;; then all the subaccounts ;; then all the subaccounts
(traverse-accounts! subaccounts (+ 1 current-depth)) (traverse-accounts! subaccounts (+ 1 current-depth))
@@ -479,15 +503,17 @@
(if thisbalance (if thisbalance
(subbalance 'merge thisbalance #f)) (subbalance 'merge thisbalance #f))
subbalance) subbalance)
#t #f) heading-style
#t #f)))))
;; and an empty line ;; and an empty line
(add-subtotal-row! current-depth #f #f #f #f))))) ; (add-subtotal-row! current-depth #f #f heading-style #f #f)))))
;; Adds rows to the table. Therefore it goes through the list of ;; Adds rows to the table. Therefore it goes through the list of
;; accounts, runs add-account-rows! on each account. If ;; accounts, runs add-account-rows! on each account. If
;; tree-depth and current-depth require, it will recursively call ;; tree-depth and current-depth require, it will recursively call
;; itself on the list of children accounts. ;; itself on the list of children accounts.
(define (traverse-accounts! accnts current-depth) (define (traverse-accounts! accnts current-depth)
(let ((alternate #f))
(if (<= current-depth tree-depth) (if (<= current-depth tree-depth)
(for-each (for-each
(lambda (acct) (lambda (acct)
@@ -495,7 +521,9 @@
show-acct? show-acct?
(gnc:account-get-immediate-subaccounts acct)))) (gnc:account-get-immediate-subaccounts acct))))
(if (or (= current-depth tree-depth) (null? subaccts)) (if (or (= current-depth tree-depth) (null? subaccts))
(add-account-rows! acct current-depth) (begin
(add-account-rows! acct current-depth alternate)
(set! alternate (not alternate)))
(add-group! current-depth (add-group! current-depth
(gnc:html-account-anchor acct) (gnc:html-account-anchor acct)
subaccts subaccts
@@ -503,7 +531,7 @@
(list acct) my-get-balance-nosub (list acct) my-get-balance-nosub
gnc:account-reverse-balance?) gnc:account-reverse-balance?)
show-parent-total?)))) show-parent-total?))))
(sort-fn accnts)))) (sort-fn accnts)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -528,11 +556,12 @@
;; Show the total sum. ;; Show the total sum.
(if show-total? (if show-total?
(begin (begin
(gnc:html-table-append-ruler! (gnc:html-table-append-ruler/markup!
table (* (if show-other-curr? 3 2) tree-depth)) table "grand-total" (* (if show-other-curr? 3 2) tree-depth))
(add-subtotal-row! (add-subtotal-row!
1 total-name 1 total-name
(get-total-fn (filter show-acct? topl-accounts) my-get-balance) (get-total-fn (filter show-acct? topl-accounts) my-get-balance)
"grand-total"
#t #f))) #t #f)))
;; set default alignment to right, and override for the name ;; set default alignment to right, and override for the name
src/scm/report/balance-sheet.scm
+4 -4
View File
@@ -173,16 +173,15 @@
table tree-depth report-currency exchange-fn table tree-depth report-currency exchange-fn
1 label report-currency 1 label report-currency
(gnc:sum-collector-stocks balance report-currency exchange-fn) (gnc:sum-collector-stocks balance report-currency exchange-fn)
#f #f #t #f) #f #f "primary-subheading" "primary-subheading" #t #f)
(gnc:html-acct-table-row-helper! (gnc:html-acct-table-row-helper!
table tree-depth 1 label table tree-depth 1 label
(gnc:sum-collector-commodity (gnc:sum-collector-commodity
balance report-currency exchange-fn) balance report-currency exchange-fn)
#f #t #f))) #f "primary-subheading" #t #f)))
;;(gnc:warn "account names" liability-account-names) ;;(gnc:warn "account names" liability-account-names)
(gnc:html-document-set-title! (gnc:html-document-set-title!
;; FIXME: Use magic sprintf code (goonie: which one?).
doc (sprintf #f (_ "Balance sheet at %s") doc (sprintf #f (_ "Balance sheet at %s")
(gnc:timepair-to-datestring to-date-tp))) (gnc:timepair-to-datestring to-date-tp)))
@@ -253,8 +252,9 @@
;; Now concatenate the tables. This first prepend-row has ;; Now concatenate the tables. This first prepend-row has
;; to be written out by hand -- we can't use the function ;; to be written out by hand -- we can't use the function
;; append-something because we have to prepend. ;; append-something because we have to prepend.
(gnc:html-table-prepend-row! (gnc:html-table-prepend-row/markup!
asset-table asset-table
"primary-subheading"
(list (gnc:html-acct-table-cell (* (if show-fcur? 3 2) (list (gnc:html-acct-table-cell (* (if show-fcur? 3 2)
tree-depth) tree-depth)
(_ "Assets") #t))) (_ "Assets") #t)))
src/scm/report/stylesheet-fancy.scm
+77 -5
View File
@@ -20,7 +20,7 @@
;; Boston, MA 02111-1307, USA gnu@gnu.org ;; Boston, MA 02111-1307, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:support "report/stylesheet-plain.scm") (gnc:support "report/stylesheet-fancy.scm")
(gnc:depend "report-html.scm") (gnc:depend "report-html.scm")
(gnc:depend "date-utilities.scm") (gnc:depend "date-utilities.scm")
@@ -81,18 +81,21 @@
(N_ "Background Color") "a" (N_ "General background color for report.") (N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #x88 #xff 0) (list #xff #x88 #xff 0)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.") (N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 0) (list #x00 #x00 #x00 0)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.") (N_ "Link Color") "c" (N_ "Link text color.")
(list #x00 #xff #xff 0) (list #x00 #xff #xff 0)
255 #f)) 255 #f))
(opt-register (opt-register
(gnc:make-color-option (gnc:make-color-option
(N_ "Colors") (N_ "Colors")
@@ -100,6 +103,39 @@
(list #xff #x00 #xff 0) (list #xff #x00 #xff 0)
255 #f)) 255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Alternate Table Cell Color") "d"
(N_ "Default alternate background for table cells.")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Subheading/Subtotal Cell Color") "e"
(N_ "Default color for subtotal rows.")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Sub-subheading/total Cell Color") "f"
(N_ "Color for subsubtotals")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Grand Total Cell Color") "g"
(N_ "Color for grand totals")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register (opt-register
(gnc:make-number-range-option (gnc:make-number-range-option
(N_ "Tables") (N_ "Tables")
@@ -134,7 +170,13 @@
(bgcolor (color-val (N_ "Colors") (N_ "Background Color"))) (bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text Color"))) (textcolor (color-val (N_ "Colors") (N_ "Text Color")))
(linkcolor (color-val (N_ "Colors") (N_ "Link Color"))) (linkcolor (color-val (N_ "Colors") (N_ "Link Color")))
(cellcolor (color-val (N_ "Colors") (N_ "Table Cell Color"))) (normal-row-color (color-val (N_ "Colors") (N_ "Table Cell Color")))
(alternate-row-color (color-val (N_ "Colors") (N_ "Alternate Table Cell Color")))
(primary-subheading-color (color-val (N_ "Colors") (N_ "Subheading/Subtotal Cell Color")))
(secondary-subheading-color (color-val (N_ "Colors")
(N_ "Sub-subheading/total Cell Color")))
(grand-total-color (color-val (N_ "Colors")
(N_ "Grand Total Cell Color")))
(bgpixmap (opt-val (N_ "Images") (N_ "Background Tile"))) (bgpixmap (opt-val (N_ "Images") (N_ "Background Tile")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner"))) (headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo"))) (logopixmap (opt-val (N_ "Images") (N_ "Logo")))
@@ -147,7 +189,12 @@
'attribute (list "bgcolor" bgcolor) 'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor) 'attribute (list "text" textcolor)
'attribute (list "link" linkcolor)) 'attribute (list "link" linkcolor))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "align" "right"))
(if (and bgpixmap (if (and bgpixmap
(not (string=? bgpixmap ""))) (not (string=? bgpixmap "")))
(gnc:html-document-set-style! (gnc:html-document-set-style!
@@ -160,11 +207,34 @@
'attribute (list "cellspacing" spacing) 'attribute (list "cellspacing" spacing)
'attribute (list "cellpadding" padding)) 'attribute (list "cellpadding" padding))
(gnc:html-document-set-style!
ssdoc "normal-row"
'attribute (list "bgcolor" normal-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" alternate-row-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" primary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" secondary-subheading-color)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" grand-total-color)
'tag "tr")
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "text-cell" ssdoc "text-cell"
'tag "td" 'tag "td"
'attribute (list "align" "left")) 'attribute (list "align" "left"))
(gnc:html-document-set-style! (gnc:html-document-set-style!
ssdoc "total-number-cell" ssdoc "total-number-cell"
'tag '("td" "b") 'tag '("td" "b")
@@ -174,7 +244,8 @@
ssdoc "total-label-cell" ssdoc "total-label-cell"
'tag '("td" "b") 'tag '("td" "b")
'attribute (list "align" "left")) 'attribute (list "align" "left"))
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! (gnc:html-document-set-style!
@@ -236,3 +307,4 @@
'options-generator fancy-options) 'options-generator fancy-options)
#t) #t)
(gnc:make-html-style-sheet "Fancy" "Technicolor")
src/scm/report/stylesheet-plain.scm
+21
View File
@@ -124,6 +124,27 @@
'tag '("td" "b") 'tag '("td" "b")
'attribute (list "align" "left")) 'attribute (list "align" "left"))
(gnc:html-document-set-style!
ssdoc "normal-row"
'tag "tr")
(gnc:html-document-set-style!
ssdoc "alternate-row"
'attribute (list "bgcolor" bgcolor)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "primary-subheading"
'attribute (list "bgcolor" bgcolor)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "secondary-subheading"
'attribute (list "bgcolor" bgcolor)
'tag "tr")
(gnc:html-document-set-style!
ssdoc "grand-total"
'attribute (list "bgcolor" bgcolor)
'tag "tr")
;; don't surround marked-up links with <a> </a> ;; don't surround marked-up links with <a> </a>
(if (not links?) (if (not links?)
(gnc:html-document-set-style! (gnc:html-document-set-style!
src/scm/report/transaction-report.scm
+67 -121
View File
@@ -38,12 +38,18 @@
(optname-sec-sortkey (N_ "Secondary Key")) (optname-sec-sortkey (N_ "Secondary Key"))
(optname-sec-subtotal (N_ "Secondary Subtotal")) (optname-sec-subtotal (N_ "Secondary Subtotal"))
(optname-sec-date-subtotal (N_ "Secondary Subtotal for Date Key")) (optname-sec-date-subtotal (N_ "Secondary Subtotal for Date Key"))
(def:grand-total-style "grand-total")
(def:normal-row-style "normal-row")
(def:alternate-row-style "alternate-row")
(def:primary-subtotal-style "primary-subheading")
(def:secondary-subtotal-style "secondary-subheading")
;; The option-values of the sorting key multichoice option, for ;; The option-values of the sorting key multichoice option, for
;; which a subtotal should be enabled. ;; which a subtotal should be enabled.
(subtotal-enabled '(account-name account-code (subtotal-enabled '(account-name account-code
corresponding-acc-name corresponding-acc-name
corresponding-acc-code))) corresponding-acc-code)))
(define-syntax addto! (define-syntax addto!
(syntax-rules () (syntax-rules ()
((_ alist element) (set! alist (cons element alist))))) ((_ alist element) (set! alist (cons element alist)))))
@@ -89,17 +95,19 @@
(define (add-subheading-row data table width subheading-style) (define (add-subheading-row data table width subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data))) (let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell width) (gnc:html-table-cell-set-colspan! heading-cell width)
(gnc:html-table-append-row! (gnc:html-table-append-row/markup!
table table
(list heading-cell)) subheading-style
(apply set-last-row-style! (list heading-cell))))
(cons table (cons "tr" subheading-style)))))
(define (render-account-full-name-subheading (define (render-account-full-name-subheading
split table width subheading-style) split table width subheading-style)
(add-subheading-row (gnc:account-get-full-name (let ((account (gnc:split-get-account split)))
(gnc:split-get-account split)) (add-subheading-row (gnc:make-html-text (gnc:html-markup-anchor
table width subheading-style)) (gnc:account-anchor-text account)
(gnc:account-get-full-name
account)))
table width subheading-style)))
(define (render-account-code-subheading split table (define (render-account-code-subheading split table
width subheading-style) width subheading-style)
@@ -160,7 +168,10 @@
(define (used-account-full-name columns-used) (define (used-account-full-name columns-used)
(vector-ref columns-used 11)) (vector-ref columns-used 11))
(define columns-used-size 12) (define (used-memo columns-used)
(vector-ref columns-used 12))
(define columns-used-size 13)
(define (num-columns-required columns-used) (define (num-columns-required columns-used)
(do ((i 0 (+ i 1)) (do ((i 0 (+ i 1))
@@ -173,44 +184,46 @@
(gnc:option-value (gnc:option-value
(gnc:lookup-option options section name))) (gnc:lookup-option options section name)))
(let ((column-list (make-vector columns-used-size #f))) (let ((column-list (make-vector columns-used-size #f)))
(if (opt-val gnc:pagename-display (N_ "Date")) (if (opt-val (N_ "Display") (N_ "Date"))
(vector-set! column-list 0 #t)) (vector-set! column-list 0 #t))
(if (opt-val gnc:pagename-display (N_ "Num")) (if (opt-val (N_ "Display") (N_ "Num"))
(vector-set! column-list 1 #t)) (vector-set! column-list 1 #t))
(if (opt-val gnc:pagename-display (N_ "Description")) (if (opt-val (N_ "Display") (N_ "Description"))
(vector-set! column-list 2 #t)) (vector-set! column-list 2 #t))
(if (opt-val gnc:pagename-display (N_ "Account")) (if (opt-val (N_ "Display") (N_ "Account"))
(vector-set! column-list 3 #t)) (vector-set! column-list 3 #t))
(if (opt-val gnc:pagename-display (N_ "Other Account")) (if (opt-val (N_ "Display") (N_ "Other Account"))
(vector-set! column-list 4 #t)) (vector-set! column-list 4 #t))
(if (opt-val gnc:pagename-display (N_ "Shares")) (if (opt-val (N_ "Display") (N_ "Shares"))
(vector-set! column-list 5 #t)) (vector-set! column-list 5 #t))
(if (opt-val gnc:pagename-display (N_ "Price")) (if (opt-val (N_ "Display") (N_ "Price"))
(vector-set! column-list 6 #t)) (vector-set! column-list 6 #t))
(let ((amount-setting (opt-val gnc:pagename-display (N_ "Amount")))) (let ((amount-setting (opt-val (N_ "Display") (N_ "Amount"))))
(if (eq? amount-setting 'single) (if (eq? amount-setting 'single)
(vector-set! column-list 7 #t)) (vector-set! column-list 7 #t))
(if (eq? amount-setting 'double) (if (eq? amount-setting 'double)
(begin (begin
(vector-set! column-list 8 #t) (vector-set! column-list 8 #t)
(vector-set! column-list 9 #t)))) (vector-set! column-list 9 #t))))
(if (opt-val gnc:pagename-display (N_ "Running Balance")) (if (opt-val (N_ "Display") (N_ "Running Balance"))
(vector-set! column-list 10 #t)) (vector-set! column-list 10 #t))
(if (opt-val gnc:pagename-display (N_ "Use Full Account Name?")) (if (opt-val (N_ "Display") (N_ "Use Full Account Name?"))
(vector-set! column-list 11 #t)) (vector-set! column-list 11 #t))
;; (gnc:debug "Column list:" column-list) (if (opt-val (N_ "Display") (N_ "Memo"))
(vector-set! column-list 12 #t))
column-list)) column-list))
(define (make-heading-list column-vector) (define (make-heading-list column-vector)
(let ((heading-list '())) (let ((heading-list '()))
(gnc:debug "Column-vector" column-vector) ; (gnc:debug "Column-vector" column-vector)
(if (used-date column-vector) (if (used-date column-vector)
(addto! heading-list (_ "Date"))) (addto! heading-list (_ "Date")))
(if (used-num column-vector) (if (used-num column-vector)
(addto! heading-list (_ "Num"))) (addto! heading-list (_ "Num")))
(if (used-description column-vector) (if (used-description column-vector)
(addto! heading-list (_ "Description"))) (addto! heading-list (_ "Description")))
(if (used-memo column-vector)
(addto! heading-list (_ "Memo")))
(if (used-account column-vector) (if (used-account column-vector)
(addto! heading-list (_ "Account"))) (addto! heading-list (_ "Account")))
(if (used-other-account column-vector) (if (used-other-account column-vector)
@@ -239,13 +252,6 @@
(gnc:account-get-type account) #f)) (gnc:account-get-type account) #f))
(currency (gnc:account-get-commodity account)) (currency (gnc:account-get-commodity account))
(damount (gnc:split-get-share-amount split)) (damount (gnc:split-get-share-amount split))
(dummy1 (begin
(gnc:debug "account-type" account-type)
(gnc:debug "account-types-to-reverse"
account-types-to-reverse)
(gnc:debug "member result"
(member account-type account-types-to-reverse))
#f))
(split-value (gnc:make-gnc-monetary (split-value (gnc:make-gnc-monetary
currency currency
(if (member account-type account-types-to-reverse) (if (member account-type account-types-to-reverse)
@@ -268,6 +274,11 @@
(if transaction-row? (if transaction-row?
(gnc:transaction-get-description parent) (gnc:transaction-get-description parent)
" "))) " ")))
(if (used-memo column-vector)
(addto! row-contents
(gnc:split-get-memo split)))
(if (used-account column-vector) (if (used-account column-vector)
(if (used-account-full-name column-vector) (if (used-account-full-name column-vector)
(addto! row-contents (gnc:account-get-full-name account)) (addto! row-contents (gnc:account-get-full-name account))
@@ -308,8 +319,7 @@
"number-cell" "number-cell"
(gnc:make-gnc-monetary currency (gnc:make-gnc-monetary currency
(gnc:split-get-balance split))))) (gnc:split-get-balance split)))))
(gnc:html-table-append-row! table (reverse row-contents)) (gnc:html-table-append-row/markup! table row-style (reverse row-contents))
(apply set-last-row-style! (cons table (cons "tr" row-style)))
split-value)) split-value))
(define (trep-options-generator) (define (trep-options-generator)
@@ -341,7 +351,7 @@
;; account to do report on ;; account to do report on
(gnc:register-trep-option (gnc:register-trep-option
(gnc:make-account-list-option (gnc:make-account-list-option
gnc:pagename-accounts (N_ "Account") gnc:pagename-accounts (N_ "Accounts")
"c" (N_ "Do transaction report on these accounts") "c" (N_ "Do transaction report on these accounts")
(lambda () (lambda ()
;; FIXME : gnc:get-current-accounts disappeared. ;; FIXME : gnc:get-current-accounts disappeared.
@@ -533,54 +543,15 @@
(N_ "Reverse amount display for Liability, Equity, Credit Card, (N_ "Reverse amount display for Liability, Equity, Credit Card,
and Income accounts"))))) and Income accounts")))))
;; Color options
(gnc:register-trep-option
(gnc:make-color-option
(N_ "Colors") (N_ "Primary Subtotals/headings")
"a" (N_ "Background color for primary subtotals and headings")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-trep-option
(gnc:make-color-option
(N_ "Colors") (N_ "Secondary Subtotals/headings")
"b" (N_ "Background color for secondary subtotals and headings")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-trep-option
(gnc:make-color-option
(N_ "Colors") (N_ "Split Odd")
"c" (N_ "Background color for odd-numbered splits (or main splits in a
multi-line report)")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-trep-option
(gnc:make-color-option
(N_ "Colors") (N_ "Split Even")
"d" (N_ "Background color for even-numbered splits
(or \"other\" splits in a multi-line report)")
(list #xff #xff #xff 0)
255
#f))
(gnc:register-trep-option
(gnc:make-color-option
(N_ "Colors") (N_ "Grand Total")
"e" (N_ "Background color for total")
(list #xff #xff #xff 0)
255
#f))
(gnc:options-set-default-section gnc:*transaction-report-options* (gnc:options-set-default-section gnc:*transaction-report-options*
gnc:pagename-general) gnc:pagename-general)
gnc:*transaction-report-options*) gnc:*transaction-report-options*)
(define (display-date-interval begin end) (define (display-date-interval begin end)
(let ((begin-string (strftime "%x" (localtime (car begin)))) (let ((begin-string (strftime "%x" (localtime (car begin))))
(end-string (strftime "%x" (localtime (car end))))) (end-string (strftime "%x" (localtime (car end)))))
@@ -629,19 +600,18 @@ and Income accounts")))))
'format gnc:make-gnc-monetary #f)) 'format gnc:make-gnc-monetary #f))
(blanks (make-list (- width 1) #f))) (blanks (make-list (- width 1) #f)))
(for-each (lambda (currency) (for-each (lambda (currency)
(gnc:html-table-append-row! (gnc:html-table-append-row/markup!
table table
subtotal-style
(append blanks (append blanks
(list (gnc:make-html-table-cell/markup (list (gnc:make-html-table-cell/markup
"total-number-cell" currency)))) "total-number-cell" currency)))))
(apply set-last-row-style!
(cons table (cons "tr" subtotal-style))))
currency-totals))) currency-totals)))
(define (get-account-types-to-reverse options) (define (get-account-types-to-reverse options)
(cdr (assq (gnc:option-value (cdr (assq (gnc:option-value
(gnc:lookup-option options (gnc:lookup-option options
gnc:pagename-display (N_ "Display")
(N_ "Sign Reverses?"))) (N_ "Sign Reverses?")))
account-types-to-reverse-assoc-list))) account-types-to-reverse-assoc-list)))
@@ -655,8 +625,6 @@ and Income accounts")))))
row-style account-types-to-reverse) row-style account-types-to-reverse)
(define (other-rows-driver split parent table used-columns i) (define (other-rows-driver split parent table used-columns i)
(let ((current (gnc:transaction-get-split parent i))) (let ((current (gnc:transaction-get-split parent i)))
(gnc:debug "i" i)
(gnc:debug "current" current)
(cond ((not current) #f) (cond ((not current) #f)
((equal? current split) ((equal? current split)
(other-rows-driver split parent table used-columns (+ i 1))) (other-rows-driver split parent table used-columns (+ i 1)))
@@ -680,28 +648,24 @@ and Income accounts")))))
secondary-subtotal-pred secondary-subtotal-pred
primary-subheading-renderer primary-subheading-renderer
secondary-subheading-renderer secondary-subheading-renderer
main-row-style
alternate-row-style
primary-subtotal-style
secondary-subtotal-style
grand-total-style
primary-subtotal-collector primary-subtotal-collector
secondary-subtotal-collector secondary-subtotal-collector
total-collector) total-collector)
(if (null? splits) (if (null? splits)
(begin (begin
(gnc:html-table-append-row! (gnc:html-table-append-row/markup!
table table
def:grand-total-style
(list (list
(gnc:make-html-table-cell/size (gnc:make-html-table-cell/size
1 width (gnc:make-html-text (gnc:html-markup-hr))))) 1 width (gnc:make-html-text (gnc:html-markup-hr)))))
(add-subtotal-row table width total-collector grand-total-style)) (add-subtotal-row table width total-collector def:grand-total-style))
(let* ((current (car splits)) (let* ((current (car splits))
(current-row-style (if multi-rows? main-row-style (current-row-style (if multi-rows? def:normal-row-style
(if odd-row? main-row-style (if odd-row? def:normal-row-style
alternate-row-style))) def:alternate-row-style)))
(rest (cdr splits)) (rest (cdr splits))
(next (if (null? rest) #f (next (if (null? rest) #f
(car rest))) (car rest)))
@@ -713,8 +677,9 @@ and Income accounts")))))
account-types-to-reverse account-types-to-reverse
#t))) #t)))
(if multi-rows? (if multi-rows?
(add-other-split-rows (add-other-split-rows
current table used-columns alternate-row-style)) current table used-columns def:alternate-row-style account-types-to-reverse))
(primary-subtotal-collector 'add (primary-subtotal-collector 'add
(gnc:gnc-monetary-commodity (gnc:gnc-monetary-commodity
split-value) split-value)
@@ -733,22 +698,22 @@ and Income accounts")))))
(not (secondary-subtotal-pred current next))))) (not (secondary-subtotal-pred current next)))))
(begin (add-subtotal-row table width (begin (add-subtotal-row table width
secondary-subtotal-collector secondary-subtotal-collector
secondary-subtotal-style) def:secondary-subtotal-style)
(secondary-subtotal-collector 'reset #f #f) (secondary-subtotal-collector 'reset #f #f)
(if next (if next
(secondary-subheading-renderer (secondary-subheading-renderer
next table width secondary-subtotal-style)))) next table width def:secondary-subtotal-style))))
(if (and primary-subtotal-pred (if (and primary-subtotal-pred
(or (not next) (or (not next)
(and next (and next
(not (primary-subtotal-pred current next))))) (not (primary-subtotal-pred current next)))))
(begin (add-subtotal-row table width (begin (add-subtotal-row table width
primary-subtotal-collector primary-subtotal-collector
primary-subtotal-style) def:primary-subtotal-style)
(primary-subtotal-collector 'reset #f #f) (primary-subtotal-collector 'reset #f #f)
(if next (if next
(primary-subheading-renderer (primary-subheading-renderer
next table width primary-subtotal-style)))) next table width def:primary-subtotal-style))))
(do-rows-with-subtotals rest (do-rows-with-subtotals rest
table table
used-columns used-columns
@@ -760,11 +725,6 @@ and Income accounts")))))
secondary-subtotal-pred secondary-subtotal-pred
primary-subheading-renderer primary-subheading-renderer
secondary-subheading-renderer secondary-subheading-renderer
main-row-style
alternate-row-style
primary-subtotal-style
secondary-subtotal-style
grand-total-style
primary-subtotal-collector primary-subtotal-collector
secondary-subtotal-collector secondary-subtotal-collector
total-collector)))) total-collector))))
@@ -773,20 +733,9 @@ and Income accounts")))))
(used-columns (build-column-used options)) (used-columns (build-column-used options))
(width (num-columns-required used-columns)) (width (num-columns-required used-columns))
(multi-rows? (transaction-report-multi-rows-p options)) (multi-rows? (transaction-report-multi-rows-p options))
(primary-subtotal-style
(get-primary-subtotal-style options))
(secondary-subtotal-style
(get-secondary-subtotal-style options))
(grand-total-style
(get-grand-total-style options))
(odd-row-style
(get-odd-row-style options))
(even-row-style
(get-even-row-style options))
(account-types-to-reverse (account-types-to-reverse
(get-account-types-to-reverse options))) (get-account-types-to-reverse options)))
(gnc:debug "account-types-to-reverse " account-types-to-reverse)
(gnc:html-table-set-col-headers! (gnc:html-table-set-col-headers!
table table
(make-heading-list used-columns)) (make-heading-list used-columns))
@@ -794,10 +743,10 @@ and Income accounts")))))
(if (not (null? splits)) (if (not (null? splits))
(if primary-subheading-renderer (if primary-subheading-renderer
(primary-subheading-renderer (primary-subheading-renderer
(car splits) table width primary-subtotal-style)) (car splits) table width def:primary-subtotal-style))
(if secondary-subheading-renderer (if secondary-subheading-renderer
(secondary-subheading-renderer (secondary-subheading-renderer
(car splits) table width secondary-subtotal-style))) (car splits) table width def:secondary-subtotal-style)))
(do-rows-with-subtotals splits table used-columns width (do-rows-with-subtotals splits table used-columns width
multi-rows? #t multi-rows? #t
@@ -806,11 +755,6 @@ and Income accounts")))))
secondary-subtotal-pred secondary-subtotal-pred
primary-subheading-renderer primary-subheading-renderer
secondary-subheading-renderer secondary-subheading-renderer
odd-row-style
even-row-style
primary-subtotal-style
secondary-subtotal-style
grand-total-style
(gnc:make-commodity-collector) (gnc:make-commodity-collector)
(gnc:make-commodity-collector) (gnc:make-commodity-collector)
(gnc:make-commodity-collector)) (gnc:make-commodity-collector))
@@ -904,7 +848,7 @@ and Income accounts")))))
2 1)) 2 1))
(let ((document (gnc:make-html-document)) (let ((document (gnc:make-html-document))
(c_accounts (opt-val gnc:pagename-accounts "Account")) (c_accounts (opt-val gnc:pagename-accounts "Accounts"))
(begindate (gnc:timepair-start-day-time (begindate (gnc:timepair-start-day-time
(gnc:date-option-absolute-time (gnc:date-option-absolute-time
(opt-val gnc:pagename-general "From")))) (opt-val gnc:pagename-general "From"))))
@@ -918,6 +862,8 @@ and Income accounts")))))
(splits '()) (splits '())
(query (gnc:malloc-query))) (query (gnc:malloc-query)))
;;(warn "accts in trep-renderer:" c_accounts) ;;(warn "accts in trep-renderer:" c_accounts)
(if (not (or (null? c_accounts) (and-map not c_accounts))) (if (not (or (null? c_accounts) (and-map not c_accounts)))
(begin (begin