master 276fd48 2/2: Add a shr-allowed-images user option

[Lars Ingebrigtsen]

branch: master
commit 276fd481767ad980b4896ecb12a28c47d8a2c749
Author: LdBeth <andpuke@foxmail.com>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a shr-allowed-images user option
    
    * lisp/net/shr.el (shr-allowed-images): New variable (bug#52594).
    (shr-image-is-blocked): New function to use it.
    (shr-tag-img): Use it.
    * doc/misc/eww.texi (Advanced): Document it.
    
    Copyright-paperwork-exempt: yes
---
 doc/misc/eww.texi |  5 ++++-
 etc/NEWS          |  5 +++++
 lisp/net/shr.el   | 23 +++++++++++++++++------
 3 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index ebfdaf5..e41aa8d 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -305,6 +305,7 @@ state the directionality.
 
 @vindex shr-max-image-proportion
 @vindex shr-blocked-images
+@vindex shr-allowed-images
 @cindex Image Display
   Loading random images from the web can be problematic due to their
 size or content.  By customizing @code{shr-max-image-proportion} you
@@ -312,7 +313,9 @@ can set the maximal image proportion in relation to the 
window they
 are displayed in.  E.g., 0.7 means an image is allowed to take up 70%
 of the width and height.  If Emacs supports image scaling (ImageMagick
 support required) then larger images are scaled down.  You can block
-specific images completely by customizing @code{shr-blocked-images}.
+specific images completely by customizing @code{shr-blocked-images},
+or, if you want to only allow some specific images, customize
+@code{shr-allowed-images}.
 
 @vindex shr-inhibit-images
   You can control image display by customizing
diff --git a/etc/NEWS b/etc/NEWS
index b50e7e5..862621a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -410,6 +410,11 @@ It narrows to the current node.
 ** eww/shr
 
 +++
+*** New user option 'shr-allowed-images'.
+This complements 'shr-blocked-images', but allows specifying just the
+allowed images.
+
++++
 *** New user option 'shr-use-xwidgets-for-media'.
 If non-nil (and Emacs has been built with support for xwidgets),
 display <video> elements with an xwidget.  Note that this is
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 5f31f03..c18d69b 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -57,8 +57,15 @@ fit these criteria."
   :version "24.1"
   :type 'float)
 
+(defcustom shr-allowed-images nil
+  "If non-nil, only images that match this regexp are displayed.
+If nil, all URLs are allowed.  Also see `shr-blocked-images'."
+  :version "29.1"
+  :type '(choice (const nil) regexp))
+
 (defcustom shr-blocked-images nil
-  "Images that have URLs matching this regexp will be blocked."
+  "Images that have URLs matching this regexp will be blocked.
+If nil, no images are blocked.  Also see `shr-allowed-images'."
   :version "24.1"
   :type '(choice (const nil) regexp))
 
@@ -552,6 +559,12 @@ size, and full-buffer size."
        (shr-insert sub)
       (shr-descend sub))))
 
+(defun shr-image-blocked-p (url)
+  (or (and shr-blocked-images
+           (string-match shr-blocked-images url))
+      (and shr-allowed-images
+           (not (string-match shr-allowed-images url)))))
+
 (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
@@ -1165,7 +1178,7 @@ Return a string with image data."
     ;; SVG images may contain references to further images that we may
     ;; want to block.  So special-case these by parsing the XML data
     ;; and remove anything that looks like a blocked bit.
-    (when (and shr-blocked-images
+    (when (and (or shr-allowed-images shr-blocked-images)
                (eq content-type 'image/svg+xml))
       (setq data
             ;; Note that libxml2 doesn't parse everything perfectly,
@@ -1344,8 +1357,7 @@ ones, in case fg and bg are nil."
        ((or (not (eq (dom-tag elem) 'image))
            ;; Filter out blocked elements inside the SVG image.
            (not (setq url (dom-attr elem ':xlink:href)))
-           (not shr-blocked-images)
-           (not (string-match-p shr-blocked-images url)))
+           (not (shr-image-blocked-p url)))
        (insert " ")
        (shr-dom-print elem)))))
   (insert (format "</%s>" (dom-tag dom))))
@@ -1651,8 +1663,7 @@ The preference is a float determined from 
`shr-prefer-media-type'."
              (funcall shr-put-image-function image alt
                        (list :width width :height height)))))
         ((or shr-inhibit-images
-             (and shr-blocked-images
-                  (string-match-p shr-blocked-images url)))
+             (shr-image-blocked-p url))
          (setq shr-start (point))
           (shr-insert alt))
         ((and (not shr-ignore-cache)