GNU bug report logs - #19444
shr-tag-table: the value passed to shr-tag-table-1 is not a DOM

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 19444 in the body.
You can then email your comments to 19444 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ivan Shmakov <ivan <at> siamics.net>
To: submit <at> debbugs.gnu.org
Subject: shr-tag-table: the value passed to shr-tag-table-1 is not a DOM 
Date: Fri, 26 Dec 2014 17:27:53 +0000

[Message part 1 (text/plain, inline)]

Package: emacs

	As of 36c43e95de5e (2014-12-18 16:44:11 +0000), shr-tag-table
	fails to pass a valid DOM value to shr-tag-table-1 when the
	table contains a thead, tfoot, or caption element (or any
	combination thereof.)  Consider, e. g.:

(with-temp-buffer
  (mapcar (lambda (table)
	    (erase-buffer)
	    (let ((r (shr-tag-table table)))
	      (cons r (buffer-string))))
	  '((table nil
		   (thead nil (tr nil (th nil "Foo") (th nil "Bar")))
		   (tbody nil (tr nil (th nil "Baz") (th nil "Qux"))))
            (table nil
                   (thead nil (tr nil (th nil "Foo") (th nil "Bar")))
                   (tr nil (th nil "Baz") (th nil "Qux")))
            (table nil
		   (tr nil (th nil "Foo") (th nil "Bar"))
		   (tfoot nil (tr nil (th nil "Baz") (th nil "Qux"))))
            (table nil
                   (caption nil "Hello, world!")
                   (tr nil (th nil "Foo") (th nil "Bar"))
                   (tr nil (th nil "Baz") (th nil "Qux")))
	    (table nil
		   (tr nil (th nil "Foo") (th nil "Bar"))
		   (tr nil (th nil "Baz") (th nil "Qux"))))))
; → ((nil . "") (nil . "") (nil . "") (nil . "")
;    (nil . " Foo Bar \n Baz Qux \n"))

	The reasons to this are twofold.  First of all, shr-tag-table
	generally assumes that the value of header and footer locals
	(and body, – if at least one of header, footer is non-nil) are
	lists of elements, while they are in fact DOM values:

  1440	(defun shr-tag-table (dom)
  1441	  (shr-ensure-paragraph)
  1442	  (let* ((caption (dom-child-by-tag dom 'caption))
  1443		 (header (dom-child-by-tag dom 'thead))
  1444		 (body (or (dom-child-by-tag dom 'tbody) dom))
  1445		 (footer (dom-child-by-tag dom 'tfoot))

	Suppose that (thead nil (tr nil (th nil "Foo") (th nil "Bar")))
	gets assigned to ‘header’, for instance.

	Now, at a later point, ‘header’ is assumed to hold a list of
	elements instead, which are put into a new tbody element:

  1469			    (if (= nbody nfooter)
  1470				`((tr (td (table (tbody ,@header ,@body ,@footer)))))
  1471			      (nconc `((tr (td (table (tbody ,@header ,@body)))))
  1472				     (if (= nfooter 1)
  1473					 footer
  1474				       `((tr (td (table (tbody ,@footer))))))))

	The second reason behind this problem is that the above
	backquote templates by no means lead to valid DOM values!  For
	example, the last template above should instead read:

   `((tr nil (td nil (table nil (tbody nil ,@footer)))))

	Please consider the patch MIMEd.

	* lisp/net/shr.el (shr-tag-table): Ensure that shr-tag-table-1
	gets passed a valid DOM value for tables containing a thead,
	tfoot, or caption.

	FWIW, applying the change makes the example above give a more
	sensible result:

    ((nil . "  Foo Bar  \n  Baz Qux  \n")
     (nil . "  Foo Bar  \n  Baz Qux  \n")
     (nil . "  Foo Bar  \n  Baz Qux  \n")
     (nil . " Hello, world! \n  Foo Bar      \n  Baz Qux      \n")
     (nil . " Foo Bar \n Baz Qux \n"))

PS.  I also took the liberty of rearranging a chain of ‘if’ forms into a
	cond.  Not that it makes a big difference, though.

-- 
FSF associate member #7257  np. Hope – Apocalyptica     … 3013 B6A0 230E 334A

[Message part 2 (text/diff, inline)]

--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1439,10 +1439,11 @@ defun shr-tag-table-1 (dom)
 
 (defun shr-tag-table (dom)
   (shr-ensure-paragraph)
-  (let* ((caption (dom-child-by-tag dom 'caption))
-	 (header (dom-child-by-tag dom 'thead))
-	 (body (or (dom-child-by-tag dom 'tbody) dom))
-	 (footer (dom-child-by-tag dom 'tfoot))
+  (let* ((caption  (dom-children (dom-child-by-tag dom 'caption)))
+	 (header   (dom-non-text-children (dom-child-by-tag dom 'thead)))
+	 (body (dom-non-text-children (or (dom-child-by-tag dom 'tbody)
+					  dom)))
+	 (footer   (dom-non-text-children (dom-child-by-tag dom 'tfoot)))
          (bgcolor (dom-attr dom 'bgcolor))
 	 (start (point))
 	 (shr-stylesheet (nconc (list (cons 'background-color bgcolor))
@@ -1461,42 +1462,62 @@ defun shr-tag-table (dom)
       ;; It's a real table, so render it.
       (shr-tag-table-1
        (nconc
-	(if caption `((tr (td ,@caption))))
-	(if header
-	    (if footer
-		;; header + body + footer
-		(if (= nheader nbody)
-		    (if (= nbody nfooter)
-			`((tr (td (table (tbody ,@header ,@body ,@footer)))))
-		      (nconc `((tr (td (table (tbody ,@header ,@body)))))
-			     (if (= nfooter 1)
-				 footer
-			       `((tr (td (table (tbody ,@footer))))))))
-		  (nconc `((tr (td (table (tbody ,@header)))))
-			 (if (= nbody nfooter)
-			     `((tr (td (table (tbody ,@body ,@footer)))))
-			   (nconc `((tr (td (table (tbody ,@body)))))
-				  (if (= nfooter 1)
-				      footer
-				    `((tr (td (table (tbody ,@footer))))))))))
-	      ;; header + body
-	      (if (= nheader nbody)
-		  `((tr (td (table (tbody ,@header ,@body)))))
-		(if (= nheader 1)
-		    `(,@header (tr (td (table (tbody ,@body)))))
-		  `((tr (td (table (tbody ,@header))))
-		    (tr (td (table (tbody ,@body))))))))
-	  (if footer
-	      ;; body + footer
-	      (if (= nbody nfooter)
-		  `((tr (td (table (tbody ,@body ,@footer)))))
-		(nconc `((tr (td (table (tbody ,@body)))))
-		       (if (= nfooter 1)
-			   footer
-			 `((tr (td (table (tbody ,@footer))))))))
-	    (if caption
-		`((tr (td (table (tbody ,@body)))))
-	      body))))))
+	(list 'table nil)
+	(if caption `((tr nil (td nil ,@caption))))
+	(cond (header
+	       (if footer
+		   ;; header + body + footer
+		   (if (= nheader nbody)
+		       (if (= nbody nfooter)
+			   `((tr nil (td nil (table nil
+						    (tbody nil ,@header
+							   ,@body ,@footer)))))
+			 (nconc `((tr nil (td nil (table nil
+							 (tbody nil ,@header
+								,@body)))))
+				(if (= nfooter 1)
+				    footer
+				  `((tr nil (td nil (table
+						     nil (tbody
+							  nil ,@footer))))))))
+		     (nconc `((tr nil (td nil (table nil (tbody
+							  nil ,@header)))))
+			    (if (= nbody nfooter)
+				`((tr nil (td nil (table
+						   nil (tbody nil ,@body
+							      ,@footer)))))
+			      (nconc `((tr nil (td nil (table
+							nil (tbody nil
+								   ,@body)))))
+				     (if (= nfooter 1)
+					 footer
+				       `((tr nil (td nil (table
+							  nil
+							  (tbody
+							   nil
+							   ,@footer))))))))))
+		 ;; header + body
+		 (if (= nheader nbody)
+		     `((tr nil (td nil (table nil (tbody nil ,@header
+							 ,@body)))))
+		   (if (= nheader 1)
+		       `(,@header (tr nil (td nil (table
+						   nil (tbody nil ,@body)))))
+		     `((tr nil (td nil (table nil (tbody nil ,@header))))
+		       (tr nil (td nil (table nil (tbody nil ,@body)))))))))
+	      (footer
+	       ;; body + footer
+	       (if (= nbody nfooter)
+		   `((tr nil (td nil (table
+				      nil (tbody nil ,@body ,@footer)))))
+		 (nconc `((tr nil (td nil (table nil (tbody nil ,@body)))))
+			(if (= nfooter 1)
+			    footer
+			  `((tr nil (td nil (table
+					     nil (tbody nil ,@footer)))))))))
+	      (caption
+	       `((tr nil (td nil (table nil (tbody nil ,@body))))))
+	      (body)))))
     (when bgcolor
       (shr-colorize-region start (point) (cdr (assq 'color shr-stylesheet))
 			   bgcolor))

Message #10 received at 19444 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Ivan Shmakov <ivan <at> siamics.net>
Cc: 19444 <at> debbugs.gnu.org
Subject: Re: bug#19444: shr-tag-table: the value passed to shr-tag-table-1 is
 not a DOM
Date: Sun, 28 Dec 2014 15:06:39 +0100

Thanks; applied.

-- 
(domestic pets only, the antidote for overdose, milk.)
  bloggy blog http://lars.ingebrigtsen.no/

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.