Allow several <tbody> tags in shr

* shr.el (shr-table-body): New function to find the real body
of a table.
(shr-tag-table): Use it to render several <tbody> tags in a
table (bug#22170).

Backport:

(cherry picked from commit cdaf33029d6620073833876d76056045ecfbc7c4)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index d51b8c73d109f3bdc2de03f6da213f6ddae7e335..18eadcb0f91663b4ec524f1fb6966f23171fb787 100644 (file)
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1572,12 +1572,23 @@ The preference is a float determined from `shr-prefer-media-type'."
     ;; Then render the table again with these new "hard" widths.
     (shr-insert-table (shr-make-table dom sketch-widths t) sketch-widths)))
 
+(defun shr-table-body (dom)
+  (let ((tbodies (dom-by-tag dom 'tbody)))
+    (cond
+     ((null tbodies)
+      dom)
+     ((= (length tbodies) 1)
+      (car tbodies))
+     (t
+      ;; Table with multiple tbodies.  Convert into a single tbody.
+      `(tbody nil
+              ,@(reduce 'append (mapcar 'dom-non-text-children tbodies)))))))
+
 (defun shr-tag-table (dom)
   (shr-ensure-paragraph)
   (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)))
+        (body (dom-non-text-children (shr-table-body dom)))
         (footer (dom-non-text-children (dom-child-by-tag dom 'tfoot)))
          (bgcolor (dom-attr dom 'bgcolor))
         (start (point))