Commit 0a4c102a authored by Katsumi Yamaoka's avatar Katsumi Yamaoka

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.
parent 463a8eae
......@@ -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
......
......@@ -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
......
......@@ -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))
......
......@@ -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)
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment