From 0a4c102a8855786d0f1f1b82beb326680a9e7b05 Mon Sep 17 00:00:00 2001 From: Katsumi Yamaoka Date: Mon, 8 Feb 2016 22:41:25 +0000 Subject: [PATCH] Refactor HTML images handling of Gnus and mm-* (a part of bug#21650) * 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 | 35 +++++++++++++++++------- lisp/gnus/gnus-art.el | 57 +++++++++++++++++++++------------------- lisp/gnus/mm-decode.el | 36 ++++++++++++------------- lisp/gnus/mm-view.el | 2 +- 4 files changed, 74 insertions(+), 56 deletions(-) diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index b252b116a1c..64fed560f08 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -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{} 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 diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 366d14aca1d..079d16b3e15 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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 diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 79fc74a13cf..2171bad7f5d 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -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 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)) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 9942455300d..8e1e3e782cf 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -141,7 +141,7 @@ (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) -- 2.39.5