IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06: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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
ChangeLog
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>
* src/FileDialog.c: call book-opened-hook and book-closed-hook

7
src/scm/html-table.scm
View File

@ -314,7 +314,7 @@
(let ((max 0))
(for-each
(lambda (row)
(let ((l (length row)))
(let ((l (length row)))
(if (> l max)
(set! max l))))
(gnc:html-table-data table))
@ -325,7 +325,10 @@
(gnc:html-table-set-row-markup! table (- rownum 1) markup)))
(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)
(let* ((dd (gnc:html-table-data table))

79
src/scm/html-utilities.scm
View File

@ -116,6 +116,14 @@
(gnc:make-html-table-cell/size
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
;; with the colspan 'colspan' (the rowspan==1), the content 'content'
;; and in boldface if 'boldface?' is true. 'content' may be #f, or a
@ -139,13 +147,13 @@
(define (gnc:html-acct-table-row-helper!
table tree-depth
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
(define (identity a)
a)
(gnc:html-table-append-row!
(gnc:html-table-append-row/markup!
table
row-style
(append
;; left half of the table
(gnc:html-make-empty-cells (- current-depth 1))
@ -179,16 +187,18 @@
(define (gnc:html-acct-table-comm-row-helper!
table tree-depth report-commodity exchange-fn
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
;; displayed in the name column; foreign-balance is the
;; <gnc-monetary> for the foreign column or #f if to be left
;; empty; domestic-balance is the <gnc-monetary> for the
;; domestic column.
(define (commodity-row-helper!
my-name foreign-balance domestic-balance)
(gnc:html-table-append-row!
my-name foreign-balance domestic-balance row-style)
(gnc:html-table-append-row/markup!
table
row-style
(append
;; left third of the table
(gnc:html-make-empty-cells (- current-depth 1))
@ -220,7 +230,8 @@
my-name #f
(if balance
(balance 'getmonetary report-commodity reverse-balance?)
#f))
#f)
main-row-style)
;; Special case for stock-accounts: then the foreign commodity
;; gets displayed in this line rather then the following lines
;; (loop below). Is also used if is-stock-account? is true.
@ -230,7 +241,8 @@
(commodity-row-helper!
my-name
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
;; balance and its corresponding value in the
@ -251,7 +263,8 @@
;; print the account balance in the respective
;; commodity
bal
(exchange-fn bal report-commodity)))))
(exchange-fn bal report-commodity)
other-rows-style))))
#f)))
@ -389,25 +402,27 @@
;; Wrapper for gnc:html-acct-table-row-helper!
(define (add-row-helper!
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!
table tree-depth
current-depth my-name my-balance
reverse-balance? boldface? group-header-line?))
reverse-balance? row-style boldface? group-header-line?))
;; Wrapper
(define (add-commodity-rows!
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!
table tree-depth report-commodity exchange-fn
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
;; account. Uses the above helper function, i.e. here the
;; 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?
(add-commodity-rows! current-depth
(gnc:html-account-anchor acct)
@ -415,6 +430,7 @@
(my-get-balance acct)
(gnc:account-reverse-balance? acct)
(gnc:account-has-shares? acct)
row-style row-style
#f #f)
(add-row-helper!
current-depth
@ -422,24 +438,28 @@
(gnc:sum-collector-commodity (my-get-balance acct)
report-commodity exchange-fn)
(gnc:account-reverse-balance? acct)
#f #f)))
row-style
#f #f))))
;; Generalization of add-account-rows! for a subtotal or for the
;; total balance.
(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?
(add-commodity-rows! current-depth subtotal-name
report-commodity
(gnc:sum-collector-stocks
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
;; one total via sum-collector-commodity and show it.
(add-row-helper! current-depth subtotal-name
(gnc:sum-collector-commodity
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
;; row, the subaccount tree, and the Total row with the balance of
@ -449,10 +469,14 @@
;; balance is calculated from the subaccounts list.
(define (add-group! current-depth groupname subaccounts
thisbalance group-total-line?)
(begin
(let ((heading-style (if (= current-depth 1)
"primary-subheading"
"secondary-subheading")))
;; first the group name
(add-subtotal-row! current-depth groupname
(and show-parent-balance? thisbalance)
heading-style
(not (and show-parent-balance? thisbalance)) #t)
;; then all the subaccounts
(traverse-accounts! subaccounts (+ 1 current-depth))
@ -479,15 +503,17 @@
(if thisbalance
(subbalance 'merge thisbalance #f))
subbalance)
#t #f)
heading-style
#t #f)))))
;; 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
;; accounts, runs add-account-rows! on each account. If
;; tree-depth and current-depth require, it will recursively call
;; itself on the list of children accounts.
(define (traverse-accounts! accnts current-depth)
(let ((alternate #f))
(if (<= current-depth tree-depth)
(for-each
(lambda (acct)
@ -495,7 +521,9 @@
show-acct?
(gnc:account-get-immediate-subaccounts acct))))
(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
(gnc:html-account-anchor acct)
subaccts
@ -503,7 +531,7 @@
(list acct) my-get-balance-nosub
gnc:account-reverse-balance?)
show-parent-total?))))
(sort-fn accnts))))
(sort-fn accnts)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -528,11 +556,12 @@
;; Show the total sum.
(if show-total?
(begin
(gnc:html-table-append-ruler!
table (* (if show-other-curr? 3 2) tree-depth))
(gnc:html-table-append-ruler/markup!
table "grand-total" (* (if show-other-curr? 3 2) tree-depth))
(add-subtotal-row!
1 total-name
(get-total-fn (filter show-acct? topl-accounts) my-get-balance)
"grand-total"
#t #f)))
;; set default alignment to right, and override for the name

8
src/scm/report/balance-sheet.scm
View File

@ -173,16 +173,15 @@
table tree-depth report-currency exchange-fn
1 label report-currency
(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!
table tree-depth 1 label
(gnc:sum-collector-commodity
balance report-currency exchange-fn)
#f #t #f)))
#f "primary-subheading" #t #f)))
;;(gnc:warn "account names" liability-account-names)
(gnc:html-document-set-title!
;; FIXME: Use magic sprintf code (goonie: which one?).
doc (sprintf #f (_ "Balance sheet at %s")
(gnc:timepair-to-datestring to-date-tp)))
@ -253,8 +252,9 @@
;; Now concatenate the tables. This first prepend-row has
;; to be written out by hand -- we can't use the function
;; append-something because we have to prepend.
(gnc:html-table-prepend-row!
(gnc:html-table-prepend-row/markup!
asset-table
"primary-subheading"
(list (gnc:html-acct-table-cell (* (if show-fcur? 3 2)
tree-depth)
(_ "Assets") #t)))

82
src/scm/report/stylesheet-fancy.scm
View File

@ -20,7 +20,7 @@
;; 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 "date-utilities.scm")
@ -81,18 +81,21 @@
(N_ "Background Color") "a" (N_ "General background color for report.")
(list #xff #x88 #xff 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Text Color") "b" (N_ "Normal body text color.")
(list #x00 #x00 #x00 0)
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
(N_ "Link Color") "c" (N_ "Link text color.")
(list #x00 #xff #xff 0)
255 #f))
255 #f))
(opt-register
(gnc:make-color-option
(N_ "Colors")
@ -100,6 +103,39 @@
(list #xff #x00 #xff 0)
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
(gnc:make-number-range-option
(N_ "Tables")
@ -134,7 +170,13 @@
(bgcolor (color-val (N_ "Colors") (N_ "Background Color")))
(textcolor (color-val (N_ "Colors") (N_ "Text 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")))
(headpixmap (opt-val (N_ "Images") (N_ "Heading Banner")))
(logopixmap (opt-val (N_ "Images") (N_ "Logo")))
@ -147,7 +189,12 @@
'attribute (list "bgcolor" bgcolor)
'attribute (list "text" textcolor)
'attribute (list "link" linkcolor))
(gnc:html-document-set-style!
ssdoc "number-cell"
'tag "td"
'attribute (list "align" "right"))
(if (and bgpixmap
(not (string=? bgpixmap "")))
(gnc:html-document-set-style!
@ -160,11 +207,34 @@
'attribute (list "cellspacing" spacing)
'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!
ssdoc "text-cell"
'tag "td"
'attribute (list "align" "left"))
(gnc:html-document-set-style!
ssdoc "total-number-cell"
'tag '("td" "b")
@ -174,7 +244,8 @@
ssdoc "total-label-cell"
'tag '("td" "b")
'attribute (list "align" "left"))
;; don't surround marked-up links with <a> </a>
(if (not links?)
(gnc:html-document-set-style!
@ -236,3 +307,4 @@
'options-generator fancy-options)
#t)
(gnc:make-html-style-sheet "Fancy" "Technicolor")

21
src/scm/report/stylesheet-plain.scm
View File

@ -124,6 +124,27 @@
'tag '("td" "b")
'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>
(if (not links?)
(gnc:html-document-set-style!

188
src/scm/report/transaction-report.scm
View File

@ -38,12 +38,18 @@
(optname-sec-sortkey (N_ "Secondary Key"))
(optname-sec-subtotal (N_ "Secondary Subtotal"))
(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
;; which a subtotal should be enabled.
(subtotal-enabled '(account-name account-code
corresponding-acc-name
corresponding-acc-code)))
(define-syntax addto!
(syntax-rules ()
((_ alist element) (set! alist (cons element alist)))))
@ -89,17 +95,19 @@
(define (add-subheading-row data table width subheading-style)
(let ((heading-cell (gnc:make-html-table-cell data)))
(gnc:html-table-cell-set-colspan! heading-cell width)
(gnc:html-table-append-row!
(gnc:html-table-append-row/markup!
table
(list heading-cell))
(apply set-last-row-style!
(cons table (cons "tr" subheading-style)))))
subheading-style
(list heading-cell))))
(define (render-account-full-name-subheading
split table width subheading-style)
(add-subheading-row (gnc:account-get-full-name
(gnc:split-get-account split))
table width subheading-style))
(let ((account (gnc:split-get-account split)))
(add-subheading-row (gnc:make-html-text (gnc:html-markup-anchor
(gnc:account-anchor-text account)
(gnc:account-get-full-name
account)))
table width subheading-style)))
(define (render-account-code-subheading split table
width subheading-style)
@ -160,7 +168,10 @@
(define (used-account-full-name columns-used)
(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)
(do ((i 0 (+ i 1))
@ -173,44 +184,46 @@
(gnc:option-value
(gnc:lookup-option options section name)))
(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))
(if (opt-val gnc:pagename-display (N_ "Num"))
(if (opt-val (N_ "Display") (N_ "Num"))
(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))
(if (opt-val gnc:pagename-display (N_ "Account"))
(if (opt-val (N_ "Display") (N_ "Account"))
(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))
(if (opt-val gnc:pagename-display (N_ "Shares"))
(if (opt-val (N_ "Display") (N_ "Shares"))
(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))
(let ((amount-setting (opt-val gnc:pagename-display (N_ "Amount"))))
(let ((amount-setting (opt-val (N_ "Display") (N_ "Amount"))))
(if (eq? amount-setting 'single)
(vector-set! column-list 7 #t))
(if (eq? amount-setting 'double)
(begin
(vector-set! column-list 8 #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))
(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))
;; (gnc:debug "Column list:" column-list)
(if (opt-val (N_ "Display") (N_ "Memo"))
(vector-set! column-list 12 #t))
column-list))
(define (make-heading-list column-vector)
(let ((heading-list '()))
(gnc:debug "Column-vector" column-vector)
; (gnc:debug "Column-vector" column-vector)
(if (used-date column-vector)
(addto! heading-list (_ "Date")))
(if (used-num column-vector)
(addto! heading-list (_ "Num")))
(if (used-description column-vector)
(addto! heading-list (_ "Description")))
(if (used-memo column-vector)
(addto! heading-list (_ "Memo")))
(if (used-account column-vector)
(addto! heading-list (_ "Account")))
(if (used-other-account column-vector)
@ -239,13 +252,6 @@
(gnc:account-get-type account) #f))
(currency (gnc:account-get-commodity account))
(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
currency
(if (member account-type account-types-to-reverse)
@ -268,6 +274,11 @@
(if transaction-row?
(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-full-name column-vector)
(addto! row-contents (gnc:account-get-full-name account))
@ -308,8 +319,7 @@
"number-cell"
(gnc:make-gnc-monetary currency
(gnc:split-get-balance split)))))
(gnc:html-table-append-row! table (reverse row-contents))
(apply set-last-row-style! (cons table (cons "tr" row-style)))
(gnc:html-table-append-row/markup! table row-style (reverse row-contents))
split-value))
(define (trep-options-generator)
@ -341,7 +351,7 @@
;; account to do report on
(gnc:register-trep-option
(gnc:make-account-list-option
gnc:pagename-accounts (N_ "Account")
gnc:pagename-accounts (N_ "Accounts")
"c" (N_ "Do transaction report on these accounts")
(lambda ()
;; FIXME : gnc:get-current-accounts disappeared.
@ -533,54 +543,15 @@
(N_ "Reverse amount display for Liability, Equity, Credit Card,
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:pagename-general)
gnc:*transaction-report-options*)
(define (display-date-interval begin end)
(let ((begin-string (strftime "%x" (localtime (car begin))))
(end-string (strftime "%x" (localtime (car end)))))
@ -629,19 +600,18 @@ and Income accounts")))))
'format gnc:make-gnc-monetary #f))
(blanks (make-list (- width 1) #f)))
(for-each (lambda (currency)
(gnc:html-table-append-row!
table
(gnc:html-table-append-row/markup!
table
subtotal-style
(append blanks
(list (gnc:make-html-table-cell/markup
"total-number-cell" currency))))
(apply set-last-row-style!
(cons table (cons "tr" subtotal-style))))
"total-number-cell" currency)))))
currency-totals)))
(define (get-account-types-to-reverse options)
(cdr (assq (gnc:option-value
(gnc:lookup-option options
gnc:pagename-display
(N_ "Display")
(N_ "Sign Reverses?")))
account-types-to-reverse-assoc-list)))
@ -655,8 +625,6 @@ and Income accounts")))))
row-style account-types-to-reverse)
(define (other-rows-driver split parent table used-columns i)
(let ((current (gnc:transaction-get-split parent i)))
(gnc:debug "i" i)
(gnc:debug "current" current)
(cond ((not current) #f)
((equal? current split)
(other-rows-driver split parent table used-columns (+ i 1)))
@ -680,28 +648,24 @@ and Income accounts")))))
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
main-row-style
alternate-row-style
primary-subtotal-style
secondary-subtotal-style
grand-total-style
primary-subtotal-collector
secondary-subtotal-collector
total-collector)
(if (null? splits)
(begin
(gnc:html-table-append-row!
(gnc:html-table-append-row/markup!
table
def:grand-total-style
(list
(gnc:make-html-table-cell/size
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))
(current-row-style (if multi-rows? main-row-style
(if odd-row? main-row-style
alternate-row-style)))
(current-row-style (if multi-rows? def:normal-row-style
(if odd-row? def:normal-row-style
def:alternate-row-style)))
(rest (cdr splits))
(next (if (null? rest) #f
(car rest)))
@ -713,8 +677,9 @@ and Income accounts")))))
account-types-to-reverse
#t)))
(if multi-rows?
(add-other-split-rows
current table used-columns alternate-row-style))
(add-other-split-rows
current table used-columns def:alternate-row-style account-types-to-reverse))
(primary-subtotal-collector 'add
(gnc:gnc-monetary-commodity
split-value)
@ -733,22 +698,22 @@ and Income accounts")))))
(not (secondary-subtotal-pred current next)))))
(begin (add-subtotal-row table width
secondary-subtotal-collector
secondary-subtotal-style)
def:secondary-subtotal-style)
(secondary-subtotal-collector 'reset #f #f)
(if next
(secondary-subheading-renderer
next table width secondary-subtotal-style))))
next table width def:secondary-subtotal-style))))
(if (and primary-subtotal-pred
(or (not next)
(and next
(not (primary-subtotal-pred current next)))))
(begin (add-subtotal-row table width
primary-subtotal-collector
primary-subtotal-style)
def:primary-subtotal-style)
(primary-subtotal-collector 'reset #f #f)
(if next
(primary-subheading-renderer
next table width primary-subtotal-style))))
next table width def:primary-subtotal-style))))
(do-rows-with-subtotals rest
table
used-columns
@ -760,11 +725,6 @@ and Income accounts")))))
secondary-subtotal-pred
primary-subheading-renderer
secondary-subheading-renderer
main-row-style
alternate-row-style
primary-subtotal-style
secondary-subtotal-style
grand-total-style
primary-subtotal-collector
secondary-subtotal-collector
total-collector))))
@ -773,20 +733,9 @@ and Income accounts")))))
(used-columns (build-column-used options))
(width (num-columns-required used-columns))
(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
(get-account-types-to-reverse options)))
(gnc:debug "account-types-to-reverse " account-types-to-reverse)
(gnc:html-table-set-col-headers!
table
(make-heading-list used-columns))
@ -794,10 +743,10 @@ and Income accounts")))))
(if (not (null? splits))
(if 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
(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
multi-rows? #t
@ -806,11 +755,6 @@ and Income accounts")))))
secondary-subtotal-pred
primary-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))
@ -904,7 +848,7 @@ and Income accounts")))))
2 1))
(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
(gnc:date-option-absolute-time
(opt-val gnc:pagename-general "From"))))
@ -918,6 +862,8 @@ and Income accounts")))))
(splits '())
(query (gnc:malloc-query)))
;;(warn "accts in trep-renderer:" c_accounts)
(if (not (or (null? c_accounts) (and-map not c_accounts)))
(begin