>From abe3f5702999b3b11645d924c7d05f48f4a265c4 Mon Sep 17 00:00:00 2001 From: Vasilij Schneidermann 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