bug#28402: 25.2; shr.el uses shr-tag-img despite set shr-external-rendering-functions

[Vasilij Schneidermann <v.schneidermann@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 131 bytes --]

> Fair enough.  Fortunately, it sounds like Lars have just agreed to
> that.

Alright, I finally got to creating a patch for this.

[-- Attachment #2: 0001-Add-indirection-to-all-shr-tag-calls.patch --]
[-- Type: text/x-diff, Size: 3625 bytes --]

From abe3f5702999b3b11645d924c7d05f48f4a265c4 Mon Sep 17 00:00:00 2001
From: Vasilij Schneidermann <mail@vasilij.de>
Date: Sun, 24 Sep 2017 14:59:10 +0200
Subject: [PATCH] Add indirection to 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
---
 lisp/net/shr.el | 35 +++++++++++++++++++----------------
 1 file changed, 19 insertions(+), 16 deletions(-)

diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 7af6148e47..fe5197b35f 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -470,12 +470,20 @@ shr-generic
 	(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 @@ shr-descend
 	  (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 @@ shr-tag-object
       (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 @@ shr-tag-video
     (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 @@ shr-collect-extra-strings-in-table
 	     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 @@ shr-collect-extra-strings-in-table
 		     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)))
-- 
2.14.1