]> code.delx.au - gnu-emacs/commitdiff
Refactor HTML images handling of Gnus and mm-* (a part of bug#21650)
authorKatsumi Yamaoka <yamaoka@jpl.org>
Mon, 8 Feb 2016 22:41:25 +0000 (22:41 +0000)
committerKatsumi Yamaoka <yamaoka@jpl.org>
Mon, 8 Feb 2016 22:41:25 +0000 (22:41 +0000)
* doc/misc/emacs-mime.texi (Display Customization):
Remove mm-inline-text-html-with-images; add documentations for
mm-html-inhibit-images and mm-html-blocked-images.

* lisp/gnus/gnus-art.el (gnus-article-show-images):
No need to bind mm-inline-text-html-with-images.
(gnus-bind-safe-url-regexp): Rename to gnus-bind-mm-vars.
(gnus-bind-mm-vars): Rename from gnus-bind-safe-url-regexp;
bind mm-html-inhibit-images and mm-html-blocked-images.
(gnus-mime-view-all-parts, gnus-mime-view-part-internally)
(gnus-mm-display-part, gnus-mime-display-single)
(gnus-mime-display-alternative): Use gnus-bind-mm-vars.

* lisp/gnus/mm-decode.el (mm-inline-text-html-with-images): Remove.
(mm-html-inhibit-images, mm-html-blocked-images): New user options.
(mm-shr): Bind shr-inhibit-images and shr-blocked-images with
mm-html-inhibit-images and mm-html-blocked-images respectively
instead of gnus-inhibit-images and gnus-blocked-images.

* lisp/gnus/mm-view.el (mm-setup-w3m): Use mm-html-inhibit-images
instead of mm-inline-text-html-with-images.

doc/misc/emacs-mime.texi
lisp/gnus/gnus-art.el
lisp/gnus/mm-decode.el
lisp/gnus/mm-view.el

index b252b116a1cc55d75d685d9e680550188f7d9b67..64fed560f089670c0fe015de2257b2d616aa2218 100644 (file)
@@ -412,17 +412,32 @@ information about emacs-w3m}, @code{links}, @code{lynx},
 external viewer.  You can also specify a function, which will be
 called with a @acronym{MIME} handle as the argument.
 
-@item mm-inline-text-html-with-images
+@item mm-html-inhibit-images
+@vindex mm-html-inhibit-images
 @vindex mm-inline-text-html-with-images
-Some @acronym{HTML} mails might have the trick of spammers using
-@samp{<img>} tags.  It is likely to be intended to verify whether you
-have read the mail.  You can prevent your personal information from
-leaking by setting this option to @code{nil} (which is the default).
-For emacs-w3m, you may use the command @kbd{t} on the image anchor to
-show an image even if it is @code{nil}.@footnote{The command @kbd{T}
-will load all images.  If you have set the option
-@code{w3m-key-binding} to @code{info}, use @kbd{i} or @kbd{I}
-instead.}
+If this is non-@code{nil}, inhibit displaying of images inline in the
+article body.  It is effective to images that are in articles as
+@acronym{MIME} parts, and images in @acronym{HTML} articles rendered
+when @code{mm-text-html-renderer} (@pxref{Display Customization}) is
+@code{shr} or @code{w3m}.  In Gnus, this is overridden by the value
+of @code{gnus-inhibit-images} (@pxref{Misc Article, ,Misc Article, gnus,
+Gnus manual}).
+
+@item mm-html-blocked-images
+@vindex mm-html-blocked-images
+External images that have @acronym{URL}s that match this regexp won't
+be fetched and displayed.  For instance, do block all @acronym{URL}s
+that have the string ``ads'' in them, do the following:
+
+@lisp
+(setq mm-html-blocked-images "ads")
+@end lisp
+
+It is effective when @code{mm-text-html-renderer} (@pxref{Display
+Customization}) is @code{shr}.  In Gnus, this is overridden by the value
+of @code{gnus-blocked-images} or the return value of the function that
+@code{gnus-blocked-images} is set to (@pxref{HTML, ,HTML, gnus, Gnus
+manual}).
 
 @item mm-w3m-safe-url-regexp
 @vindex mm-w3m-safe-url-regexp
index 366d14aca1d026f27cd313a852f89eeb7f3c8003..079d16b3e159b4685de1cfe0267f51d144ae1cc9 100644 (file)
@@ -2258,8 +2258,7 @@ This only works if the article in question is HTML."
     (save-restriction
       (widen)
       (if (eq mm-text-html-renderer 'w3m)
-         (let ((mm-inline-text-html-with-images nil))
-           (w3m-toggle-inline-images))
+         (w3m-toggle-inline-images)
        (dolist (region (gnus-find-text-property-region (point-min) (point-max)
                                                        'image-displayer))
          (destructuring-bind (start end function) region
@@ -4929,25 +4928,30 @@ General format specifiers can also be used.  See Info node
                (vector (caddr c) (car c) :active t))
              gnus-url-button-commands)))
 
-(defmacro gnus-bind-safe-url-regexp (&rest body)
-  "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
-  `(let ((mm-w3m-safe-url-regexp
-         (let ((group (if (and (derived-mode-p 'gnus-article-mode)
-                               (gnus-buffer-live-p
-                                gnus-article-current-summary))
-                          (with-current-buffer gnus-article-current-summary
-                            gnus-newsgroup-name)
-                        gnus-newsgroup-name)))
-           (if (cond ((not group)
-                      ;; Maybe we're in a mml-preview buffer
-                      ;; and no group is selected.
-                      t)
-                     ((stringp gnus-safe-html-newsgroups)
-                      (string-match gnus-safe-html-newsgroups group))
-                     ((consp gnus-safe-html-newsgroups)
-                      (member group gnus-safe-html-newsgroups)))
-               nil
-             mm-w3m-safe-url-regexp))))
+(defmacro gnus-bind-mm-vars (&rest body)
+  "Bind some mm-* variables and execute BODY."
+  `(let (mm-html-inhibit-images
+        mm-html-blocked-images
+        (mm-w3m-safe-url-regexp mm-w3m-safe-url-regexp))
+     (with-current-buffer
+        (cond ((derived-mode-p 'gnus-article-mode)
+               (if (gnus-buffer-live-p gnus-article-current-summary)
+                   gnus-article-current-summary
+                 ;; Maybe we're in a mml-preview buffer
+                 ;; and no group is selected.
+                 (current-buffer)))
+              ((gnus-buffer-live-p gnus-summary-buffer)
+               gnus-summary-buffer)
+              (t (current-buffer)))
+       (setq mm-html-inhibit-images gnus-inhibit-images
+            mm-html-blocked-images (gnus-blocked-images))
+       (when (or (not gnus-newsgroup-name)
+                (and (stringp gnus-safe-html-newsgroups)
+                     (string-match gnus-safe-html-newsgroups
+                                   gnus-newsgroup-name))
+                (and (consp gnus-safe-html-newsgroups)
+                     (member gnus-newsgroup-name gnus-safe-html-newsgroups)))
+        (setq mm-w3m-safe-url-regexp nil)))
      ,@body))
 
 (defun gnus-mime-button-menu (event prefix)
@@ -4975,7 +4979,7 @@ General format specifiers can also be used.  See Info node
        (or (search-forward "\n\n") (goto-char (point-max)))
        (let ((inhibit-read-only t))
          (delete-region (point) (point-max))
-         (gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
+         (gnus-bind-mm-vars (mm-display-parts handles)))))))
 
 (defun gnus-article-jump-to-part (n)
   "Jump to MIME part N."
@@ -5514,8 +5518,7 @@ If no internal viewer is available, use an external viewer."
         (gnus-mime-view-part-as-type
          nil (lambda (type) (mm-inlinable-p handle type)))
       (when handle
-       (gnus-bind-safe-url-regexp
-        (mm-display-part handle nil t))))))
+       (gnus-bind-mm-vars (mm-display-part handle nil t))))))
 
 (defun gnus-mime-action-on-part (&optional action)
   "Do something with the MIME attachment at (point)."
@@ -5745,7 +5748,7 @@ all parts."
                                 (mm-inlined-p handle)
                                 t)
                            (with-temp-buffer
-                             (gnus-bind-safe-url-regexp
+                             (gnus-bind-mm-vars
                               (setq retval (mm-display-part handle)))
                              (unless (zerop (buffer-size))
                                (buffer-string))))))
@@ -6106,7 +6109,7 @@ If nil, don't show those extra buttons."
                                       (set-buffer gnus-summary-buffer)
                                     (error))
                                   gnus-newsgroup-ignored-charsets)))
-             (gnus-bind-safe-url-regexp (mm-display-part handle t))))
+             (gnus-bind-mm-vars (mm-display-part handle t))))
           ((and text not-attachment)
            (mm-display-inline handle)))
          (goto-char (point-max))
@@ -6236,7 +6239,7 @@ If nil, don't show those extra buttons."
                  (mail-parse-ignored-charsets
                   (with-current-buffer gnus-summary-buffer
                     gnus-newsgroup-ignored-charsets)))
-             (gnus-bind-safe-url-regexp (mm-display-part preferred))
+             (gnus-bind-mm-vars (mm-display-part preferred))
              ;; Do highlighting.
              (save-excursion
                (save-restriction
index 79fc74a13cf458f1a3a43e3d118e93d04e1477c1..2171bad7f5db0666dbcf55ef9e378e323838d218 100644 (file)
@@ -145,14 +145,23 @@ nil    : use external viewer (default web browser)."
                 (function))
   :group 'mime-display)
 
-(defcustom mm-inline-text-html-with-images nil
-  "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags.
-See also the documentation for the `mm-w3m-safe-url-regexp'
-variable."
-  :version "22.1"
+(defcustom mm-html-inhibit-images
+  (if (boundp 'mm-inline-text-html-with-images)
+      (not (symbol-value 'mm-inline-text-html-with-images))
+    t)
+  "Non-nil means inhibit displaying of images inline in the article body."
+  :version "25.1"
   :type 'boolean
   :group 'mime-display)
 
+(defcustom mm-html-blocked-images ""
+  "Regexp matching image URLs to be blocked, or nil meaning not to block.
+Note that cid images that are embedded in a message won't be blocked."
+  :version "25.1"
+  :type '(choice (const :tag "Allow all" nil)
+                (regexp :tag "Regular expression"))
+  :group 'mime-display)
+
 (defcustom mm-w3m-safe-url-regexp "\\`cid:"
   "Regexp matching URLs which are considered to be safe.
 Some HTML mails might contain a nasty trick used by spammers, using
@@ -1828,14 +1837,11 @@ If RECURSIVE, search recursively."
 (declare-function shr-insert-document "shr" (dom))
 (defvar shr-blocked-images)
 (defvar shr-use-fonts)
-(defvar gnus-inhibit-images)
-(autoload 'gnus-blocked-images "gnus-art")
 
 (defun mm-shr (handle)
   ;; Require since we bind its variables.
   (require 'shr)
-  (let ((article-buffer (current-buffer))
-       (shr-width (if (and (boundp 'shr-use-fonts)
+  (let ((shr-width (if (and (boundp 'shr-use-fonts)
                            shr-use-fonts)
                       nil
                     fill-column))
@@ -1844,15 +1850,9 @@ If RECURSIVE, search recursively."
                                  (when handle
                                    (mm-with-part handle
                                      (buffer-string))))))
-       shr-inhibit-images shr-blocked-images charset char)
-    (if (and (boundp 'gnus-summary-buffer)
-            (bufferp gnus-summary-buffer)
-            (buffer-name gnus-summary-buffer))
-       (with-current-buffer gnus-summary-buffer
-         (setq shr-inhibit-images gnus-inhibit-images
-               shr-blocked-images (gnus-blocked-images)))
-      (setq shr-inhibit-images gnus-inhibit-images
-           shr-blocked-images (gnus-blocked-images)))
+       (shr-inhibit-images mm-html-inhibit-images)
+       (shr-blocked-images mm-html-blocked-images)
+       charset char)
     (unless handle
       (setq handle (mm-dissect-buffer t)))
     (setq charset (mail-content-type-get (mm-handle-type handle) 'charset))
index 9942455300d0776befd9273d8b0c0836a52628b4..8e1e3e782cf7e0e7c89009094489fe89a3f16dd1 100644 (file)
       (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
            w3m-cid-retrieve-function-alist))
     (setq mm-w3m-setup t))
-  (setq w3m-display-inline-images mm-inline-text-html-with-images))
+  (setq w3m-display-inline-images (not mm-html-inhibit-images)))
 
 (defun mm-w3m-cid-retrieve-1 (url handle)
   (dolist (elem handle)