* lisp/net/shr.el (shr-tag-table): Avoid duplication of images.

(shr-collect-extra-strings-in-table): Render images as well.

1 files changed, 37 insertions, 41 deletions

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index afe190803b3..9628ac294ad 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -1895,65 +1895,61 @@ The preference is a float determined from `shr-prefer-media-type'."
                            bgcolor))
     ;; Finally, insert all the images after the table.  The Emacs buffer
     ;; model isn't strong enough to allow us to put the images actually
-    ;; into the tables.
+    ;; into the tables.  It inserts also non-td/th objects.
     (when (zerop shr-table-depth)
       (save-excursion
         (shr-expand-alignments start (point)))
-      ;; Insert also non-td/th objects.
       (save-restriction
         (narrow-to-region (point) (point))
         (insert (mapconcat #'identity
                            (shr-collect-extra-strings-in-table dom)
                            "\n"))
-        (shr-fill-lines (point-min) (point-max)))
-      (dolist (elem (dom-by-tag dom 'object))
-        (shr-tag-object elem))
-      (dolist (elem (dom-by-tag dom 'img))
-        (shr-tag-img elem)))))
+        (shr-fill-lines (point-min) (point-max))))))
 
 (defun shr-collect-extra-strings-in-table (dom &optional flags)
   "Return extra strings in DOM of which the root is a table clause.
-Render extra child tables of which the parent is not td or th as well.
-FLAGS is a cons of two boolean flags that control whether to collect
-or render objects."
-  ;; Currently this function supports extra strings and <table>s that
-  ;; are children of <table> or <tr> clauses, not <td> nor <th>.
-  ;; It runs recursively and collects strings or renders <table>s if
-  ;; the cdr of FLAGS is nil.  FLAGS becomes (t . nil) if a <tr>
-  ;; clause is found in the children of DOM, and becomes (t . t) if
-  ;; a <td> or a <th> clause is found and the car is t then.
-  ;; When a <table> clause is found, FLAGS becomes nil if the cdr is t
-  ;; then.  But if the cdr is nil then, render the <table>.
-  (cl-loop for child in (dom-children dom) with tag with recurse
+Render <img>s and <object>s, and strings and child <table>s of which
+the parent is not <td> or <th> as well.  FLAGS is a cons of two
+boolean flags that control whether to collect or render objects."
+  ;; As for strings and child <table>s, it runs recursively and
+  ;; collects or renders those objects if the cdr of FLAGS is nil.
+  ;; FLAGS becomes (t . nil) if a <tr> clause is found in the children
+  ;; of DOM, and becomes (t . t) if a <td> or a <th> clause is found
+  ;; and the car is t then.  When a <table> clause is found, FLAGS
+  ;; becomes nil if the cdr is t then.  But if the cdr is nil then,
+  ;; it renders the <table>.
+  (cl-loop for child in (dom-children dom) with recurse with tag
+           do (setq recurse nil)
            if (stringp child)
              unless (cdr flags)
                when (string-match "\\(?:[^\t\n\r ]+[\t\n\r ]+\\)*[^\t\n\r ]+"
                                   child)
                  collect (match-string 0 child)
                end end
-           else
-             do (setq tag (dom-tag child)
-                      recurse t)
-             and
-             if (eq tag 'tr)
-               do (setq flags '(t . nil))
-             else if (memq tag '(td th))
-               when (car flags)
-                 do (setq flags '(t . t))
-               end
-             else if (eq tag 'table)
-               if (cdr flags)
-                 do (setq flags nil)
+           else if (consp child)
+             do (setq tag (dom-tag child)) and
+             unless (memq tag '(comment style))
+               if (eq tag 'img)
+                 do (shr-tag-img child)
+               else if (eq tag 'object)
+                 do (shr-tag-object child)
                else
-                 do (setq recurse nil)
-                    (shr-tag-table child)
-               end
-             else
-               when (memq tag '(comment style))
-                 do (setq recurse nil)
-               end end end end and
-             when recurse
-               append (shr-collect-extra-strings-in-table child flags)))
+                 do (setq recurse t) and
+                 if (eq tag 'tr)
+                   do (setq flags '(t . nil))
+                 else if (memq tag '(td th))
+                   when (car flags)
+                     do (setq flags '(t . t))
+                   end
+                 else if (eq tag 'table)
+                   if (cdr flags)
+                     do (setq flags nil)
+                   else
+                     do (setq recurse nil)
+                        (shr-tag-table child)
+                   end end end end end end end end end
+               when recurse
+                 append (shr-collect-extra-strings-in-table child flags)))
 
 (defun shr-insert-table (table widths)
   (let* ((collapse (equal (cdr (assq 'border-collapse shr-stylesheet))