From 276fd481767ad980b4896ecb12a28c47d8a2c749 Mon Sep 17 00:00:00 2001
From: LdBeth <andpuke@foxmail.com>
Date: Sun, 19 Dec 2021 12:26:15 +0100
Subject: 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 ebfdaf546e3..e41aa8d886d 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 b50e7e5db0e..862621a4d51 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -409,6 +409,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),
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 5f31f034303..c18d69b5926 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)
-- 
cgit v1.2.3