r20790 - gnucash/branches/2.4/src/report/report-system - [20785] Bug #652377 - XHTML 1.0 Transitional compliance for reports Patch by Tim M BP
Christian Stimming
cstim at code.gnucash.org
Tue Jun 21 06:05:03 EDT 2011
Author: cstim
Date: 2011-06-21 06:05:03 -0400 (Tue, 21 Jun 2011)
New Revision: 20790
Trac: http://svn.gnucash.org/trac/changeset/20790
Modified:
gnucash/branches/2.4/src/report/report-system/html-document.scm
gnucash/branches/2.4/src/report/report-system/html-table.scm
gnucash/branches/2.4/src/report/report-system/html-text.scm
Log:
[20785] Bug #652377 - XHTML 1.0 Transitional compliance for reports Patch by Tim M BP
Original commit by gjanssens.
Modified: gnucash/branches/2.4/src/report/report-system/html-document.scm
===================================================================
--- gnucash/branches/2.4/src/report/report-system/html-document.scm 2011-06-21 10:04:52 UTC (rev 20789)
+++ gnucash/branches/2.4/src/report/report-system/html-document.scm 2011-06-21 10:05:03 UTC (rev 20790)
@@ -157,10 +157,12 @@
;;with the exception of 2 reports:
;;./share/gnucash/guile-modules/gnucash/report/taxinvoice.eguile.scm:<html>
;;./share/gnucash/guile-modules/gnucash/report/balsheet-eg.eguile.scm:<html>
- (push "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \n\"http://www.w3.org/TR/html4/loose.dtd\">") ;;trying 4.01 Trans
- (push "<html>\n")
+
+ ;; Validate against XHTML 1.0 Transitional
+ (push "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \n\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">")
+ (push "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n")
(push "<head>\n")
- (push "<meta http-equiv=\"content-type\" content=\"text-html; charset=utf-8\">\n")
+ (push "<meta http-equiv=\"content-type\" content=\"text/html; charset=utf-8\" />\n")
(if css?
(if style-text
(push (list "</style>" style-text "<style type=\"text/css\">\n"))))
@@ -171,7 +173,7 @@
;; this lovely little number just makes sure that <body>
;; attributes like bgcolor get included
- (push ((gnc:html-markup/no-end "body") doc))))
+ (push ((gnc:html-markup/open-tag-only "body") doc))))
;; now render the children
(for-each
@@ -252,7 +254,7 @@
;; '("attr1" "value1") '("attr2" "value2"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (gnc:html-document-markup-start doc markup . rest)
+(define (gnc:html-document-markup-start doc markup end-tag? . rest)
(let ((childinfo (gnc:html-document-fetch-markup-style doc markup))
(extra-attrib
(if (not (null? rest))
@@ -289,6 +291,8 @@
(push "\n<") (push tag)
(if attr (hash-fold add-attribute #f attr))
(if extra-attrib (for-each addextraatt extra-attrib))
+ (if (not end-tag?)
+ (push " /")) ;;add closing "/" for no-end elements...
(push ">"))))
(if tag
(if (list? tag)
@@ -296,6 +300,10 @@
(build-first-tag (car tag))
(for-each add-internal-tag (cdr tag)))
(build-first-tag tag)))
+ ;; XXX Font styling should be done through CSS, NOT html code
+ ;; XXX Also, why is this even here? 'Font' is an html tag just like anything else,
+ ;; so why does it have it's own custom pseudo code here? It should be built
+ ;; as a call to this function just like any other tag, passing face/size/color as attributes.
(if (or face size color)
(begin
(push "<font ")
Modified: gnucash/branches/2.4/src/report/report-system/html-table.scm
===================================================================
--- gnucash/branches/2.4/src/report/report-system/html-table.scm 2011-06-21 10:04:52 UTC (rev 20789)
+++ gnucash/branches/2.4/src/report/report-system/html-table.scm 2011-06-21 10:05:03 UTC (rev 20790)
@@ -146,9 +146,9 @@
; (or (gnc:html-table-cell-colspan cell) 1)))
(gnc:html-document-push-style doc style)
(push (gnc:html-document-markup-start
- doc (gnc:html-table-cell-tag cell)
- (sprintf #f "rowspan=%a" (gnc:html-table-cell-rowspan cell))
- (sprintf #f "colspan=%a" (gnc:html-table-cell-colspan cell))))
+ doc (gnc:html-table-cell-tag cell) #t
+ (sprintf #f "rowspan=\"%a\"" (gnc:html-table-cell-rowspan cell))
+ (sprintf #f "colspan=\"%a\"" (gnc:html-table-cell-colspan cell))))
(for-each
(lambda (child)
(push (gnc:html-object-render child doc)))
@@ -636,13 +636,13 @@
(gnc:html-table-style table) (gnc:html-document-style-stack doc))
(gnc:html-document-push-style doc (gnc:html-table-style table))
- (push (gnc:html-document-markup-start doc "table"))
+ (push (gnc:html-document-markup-start doc "table" #t))
;; render the caption
(let ((c (gnc:html-table-caption table)))
(if c
(begin
- (push (gnc:html-document-markup-start doc "caption"))
+ (push (gnc:html-document-markup-start doc "caption" #t))
(push (gnc:html-object-render c doc))
(push (gnc:html-document-markup-end doc "caption")))))
@@ -656,7 +656,6 @@
(begin
(gnc:html-document-push-style
doc (gnc:html-table-col-headers-style table))
- (push (gnc:html-document-markup-start doc "tr"))
;; compile the column styles just in case there's
;; something interesting in the table header cells.
@@ -669,12 +668,13 @@
#f (gnc:html-table-col-styles table))
;; render the headers
+ (push (gnc:html-document-markup-start doc "tr" #t))
(for-each
(lambda (hdr)
(gnc:html-document-push-style
doc (gnc:html-table-col-style table colnum))
(if (not (gnc:html-table-cell? hdr))
- (push (gnc:html-document-markup-start doc "th")))
+ (push (gnc:html-document-markup-start doc "th" #t)))
(push (gnc:html-object-render hdr doc))
(if (not (gnc:html-table-cell? hdr))
(push (gnc:html-document-markup-end doc "th")))
@@ -684,6 +684,8 @@
(set! colnum (+ (gnc:html-table-cell-colspan hdr)
colnum))))
ch)
+ (push (gnc:html-document-markup-end doc "tr"))
+
;; pop the col header style
(gnc:html-document-pop-style doc))))
@@ -713,7 +715,7 @@
;; push the style for this row and write the start tag, then
;; pop it again.
(if rowstyle (gnc:html-document-push-style doc rowstyle))
- (push (gnc:html-document-markup-start doc rowmarkup))
+ (push (gnc:html-document-markup-start doc rowmarkup #t))
(if rowstyle (gnc:html-document-pop-style doc))
;; write the column data, pushing the right column style
@@ -728,7 +730,7 @@
;; render the cell contents
(if (not (gnc:html-table-cell? datum))
- (push (gnc:html-document-markup-start doc "td")))
+ (push (gnc:html-document-markup-start doc "td" #t)))
(push (gnc:html-object-render datum doc))
(if (not (gnc:html-table-cell? datum))
(push (gnc:html-document-markup-end doc "td")))
Modified: gnucash/branches/2.4/src/report/report-system/html-text.scm
===================================================================
--- gnucash/branches/2.4/src/report/report-system/html-text.scm 2011-06-21 10:04:52 UTC (rev 20789)
+++ gnucash/branches/2.4/src/report/report-system/html-text.scm 2011-06-21 10:05:03 UTC (rev 20790)
@@ -94,6 +94,16 @@
#t
entities)))
+;; This creates an open html tag which must be explicitly closed later.
+(define (gnc:html-markup/open-tag-only tag . entities)
+ (lambda (doc)
+ (apply gnc:html-text-render-markup-noclose
+ doc
+ tag
+ #f
+ #t
+ entities)))
+
(define (gnc:html-markup/no-end tag . entities)
(lambda (doc)
(apply gnc:html-text-render-markup
@@ -217,10 +227,25 @@
(gnc:html-style-table-uncompile (gnc:html-text-style p))
retval))
+;; XXX It would be better to merge this with the original html-text-render-markup below it,
+;; but that would require a fair amount of work to refactor so that it works correctly.
+(define (gnc:html-text-render-markup-noclose doc markup attrib end-tag? . entities)
+ (let* ((retval '())
+ (push (lambda (l) (set! retval (cons l retval)))))
+ (push (gnc:html-document-markup-start doc markup end-tag? attrib))
+ (for-each
+ (lambda (elt)
+ (cond ((procedure? elt)
+ (push (elt doc)))
+ (#t
+ (push (gnc:html-document-render-data doc elt)))))
+ entities)
+ retval))
+
(define (gnc:html-text-render-markup doc markup attrib end-tag? . entities)
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval)))))
- (push (gnc:html-document-markup-start doc markup attrib))
+ (push (gnc:html-document-markup-start doc markup end-tag? attrib))
(for-each
(lambda (elt)
(cond ((procedure? elt)
More information about the gnucash-changes
mailing list