On Thu, 22 Mar 2001 19:17:45 PST, the world broke into rejoicing as
Christian Stimming <[EMAIL PROTECTED]> said:
> I have a question on how to use the HTML style features. I would like to
> have a table cell style grand-total as described below, but I would like
> to have it markup the cell content in boldface. How do I specify that one
> semantic tags (grand-total) gets rendered to several HTML tags
> (<td><b>...)? Or did I misunderstand the intended usage of the stylesheets?
>
> Christian
>
> On Friday 09 March 2001 08:09, Bill Gribble wrote:
> > Dave: after our IRC discussion I added a few new things to the
> > html-table API to allow reports to assign semantic tags like "total",
> > "subtotal", "summary-row" etc to table cells and rows
> >
> > For example, if you want all "grand-total" table
> > cells to be rendered with a background color of 0xff00ff, you'd put
> > this in the style sheet definition:
> >
> > (gnc:html-style-sheet-set-style!
> > ss "grand-total"
> > 'tag "td"
> > 'attribute (list "bgcolor" "0xff00ff"))
It would seem that the following _should_ work:
(gnc:html-style-sheet-set-style!
ss "grand-total"
'tag (list "td" "b")
'attribute (list "bgcolor" "0xff00ff"))
This would be expected to generate the following:
<td> <b>
...stuff omitted...
</b> </td>
Change html-document.scm, replacing functions as follows:
(define (gnc:html-document-markup-start doc markup . rest)
(let ((childinfo (gnc:html-document-fetch-markup-style doc markup))
(extra-attrib
(if (not (null? rest))
rest #f))
(show-result #f))
;; now generate the start tag
(let ((tag (gnc:html-markup-style-info-tag childinfo))
(attr (gnc:html-markup-style-info-attributes childinfo))
(face (gnc:html-markup-style-info-font-face childinfo))
(size (gnc:html-markup-style-info-font-size childinfo))
(color (gnc:html-markup-style-info-font-color childinfo)))
;; "" tags mean "show no tag"; #f tags means use default.
(cond ((not tag)
(set! tag markup))
((string=? tag "")
(set! tag #f)))
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval))))
(add-internal-tag (lambda (t) (push "<") (push tag) (push ">")))
(add-attribute
(lambda (key value prior) (push " ") (push key) (push "=")
(push value) #t))
(addextraatt
(lambda (attr)
(cond ((string? attr) (push " ") (push attr))
(attr (gnc:warn "non-string attribute" attr)))))
(build-first-tag
(lambda (tag)
(push "\n<") (push tag)
(if attr (hash-fold add-attribute #f attr))
(if extra-attrib (for-each addextraatt extra-attrib))
(push ">"))))
(if tag
(if (list? tag)
(begin
(build-first-tag (car tag))
(for-each add-internal-tag (cdr tag)))
(build-first-tag tag)))
; (if tag
; (begin
; (push "\n<")
; (push tag)
; (if attr
; (hash-fold
; (lambda (key value prior)
; (push " ") (push key) (push "=")
; (push value)
; #t)
; #f
; attr))
; (if extra-attrib
; (for-each
; (lambda (attr)
; (cond ((string? attr) (push " ") (push attr))
; (attr (gnc:warn "non-string attribute" attr))))
; extra-attrib))
; (push ">")))
(if (or face size color)
(begin
(push "<font ")
(if face
(begin
(push "face=\"") (push face) (push "\" ")))
(if size
(begin
(push "size=\"") (push size) (push "\" ")))
(if color
(begin
(push "color=\"") (push color) (push "\" ")))
(push ">")))
retval))))
(define (gnc:html-document-markup-end doc markup)
(let ((childinfo (gnc:html-document-fetch-markup-style doc markup)))
;; now generate the end tag
(let ((tag (gnc:html-markup-style-info-tag childinfo))
(closing-font-tag
(gnc:html-markup-style-info-closing-font-tag childinfo)))
;; "" tags mean "show no tag"; #f tags means use default.
(cond ((not tag)
(set! tag markup))
((string=? tag "")
(set! tag #f)))
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))))
(if closing-font-tag
(push "</font>\n"))
; (if tag
; (begin
; (push "</")
; (push tag)
; ;; newline after every close tag... just temporary
; (push ">\n")))
(if tag
(let ((addtag (lambda (t)
(push "</")
(push tag)
(push ">\n"))))
(cond
((string? tag)
(addtag tag))
((list? tag)
(for-each addtag (reverse tag))))))
retval))))
Note that I haven't tried this out at all; your milage may vary...
--
(reverse (concatenate 'string "gro.mca@" "enworbbc"))
http://www.ntlug.org/~cbbrowne/internet.html
MS-Windows: Proof that P.T. Barnum was correct.
_______________________________________________
gnucash-devel mailing list
[EMAIL PROTECTED]
http://www.gnumatic.com/cgi-bin/mailman/listinfo/gnucash-devel
