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