Support indirection for all shr-tag-* calls

The 'shr-external-rendering-functions' variable was previously only
honored in the shr-descend function, now all direct calls to the
shr-tag-* functions have been replaced by a call to
'shr-indirect-call' which tries using an alternative rendering
function first.

* lisp/net/shr.el (shr-indirect-call): New helper function.
(shr-descend, shr-tag-object, shr-tag-video):
(shr-collect-extra-strings-in-table): Fix callers to call via
shr-indirect-call.  (Bug#28402)

1 files changed, 19 insertions, 16 deletions

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 7af6148e473..fe5197b35f7 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -470,12 +470,20 @@ size, and full-buffer size."
         (shr-insert sub)
       (shr-descend sub))))
 
+(defun shr-indirect-call (tag-name dom &rest args)
+  (let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray))
+        ;; Allow other packages to override (or provide) rendering
+        ;; of elements.
+        (external (cdr (assq tag-name shr-external-rendering-functions))))
+    (cond (external
+           (apply external dom args))
+          ((fboundp function)
+           (apply function dom args))
+          (t
+           (apply 'shr-generic dom args)))))
+
 (defun shr-descend (dom)
-  (let ((function
-         (intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
-        ;; Allow other packages to override (or provide) rendering
-        ;; of elements.
-        (external (cdr (assq (dom-tag dom) shr-external-rendering-functions)))
+  (let ((tag-name (dom-tag dom))
         (style (dom-attr dom 'style))
         (shr-stylesheet shr-stylesheet)
         (shr-depth (1+ shr-depth))
@@ -490,12 +498,7 @@ size, and full-buffer size."
           (setq style nil)))
       ;; If we have a display:none, then just ignore this part of the DOM.
       (unless (equal (cdr (assq 'display shr-stylesheet)) "none")
-        (cond (external
-               (funcall external dom))
-              ((fboundp function)
-               (funcall function dom))
-              (t
-               (shr-generic dom)))
+        (shr-indirect-call tag-name dom)
         (when (and shr-target-id
                    (equal (dom-attr dom 'id) shr-target-id))
           ;; If the element was empty, we don't have anything to put the
@@ -1404,7 +1407,7 @@ ones, in case fg and bg are nil."
       (when url
         (cond
          (image
-          (shr-tag-img dom url)
+          (shr-indirect-call 'img dom url)
           (setq dom nil))
          (multimedia
           (shr-insert " [multimedia] ")
@@ -1469,7 +1472,7 @@ The preference is a float determined from `shr-prefer-media-type'."
     (unless url
       (setq url (car (shr--extract-best-source dom))))
     (if (> (length image) 0)
-        (shr-tag-img nil image)
+        (shr-indirect-call 'img nil image)
       (shr-insert " [video] "))
     (shr-urlify start (shr-expand-url url))))
 
@@ -1964,9 +1967,9 @@ flags that control whether to collect or render objects."
              do (setq tag (dom-tag child)) and
              unless (memq tag '(comment style))
                if (eq tag 'img)
-                 do (shr-tag-img child)
+                 do (shr-indirect-call 'img child)
                else if (eq tag 'object)
-                 do (shr-tag-object child)
+                 do (shr-indirect-call 'object child)
                else
                  do (setq recurse t) and
                  if (eq tag 'tr)
@@ -1980,7 +1983,7 @@ flags that control whether to collect or render objects."
                      do (setq flags nil)
                    else if (car flags)
                      do (setq recurse nil)
-                        (shr-tag-table child)
+                        (shr-indirect-call 'table child)
                    end end end end end end end end end end
            when recurse
              append (shr-collect-extra-strings-in-table child flags)))