Mercurial > emacs
changeset 111577:db20adbc4108
gnus-art.el (gnus-inhibit-images): New user option.
* gnus-art.el (gnus-inhibit-images): New user option.
(gnus-mime-display-single): Don't display image if it is non-nil.
* mm-decode.el (mm-shr): Bind shr-inhibit-images to the value of
gnus-inhibit-images.
* shr.el (shr-image-displayer): New function.
(shr-tag-img): Use it.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Wed, 17 Nov 2010 07:22:19 +0000 |
| parents | 58fdd277496b |
| children | 312237f41f80 |
| files | lisp/gnus/ChangeLog lisp/gnus/gnus-art.el lisp/gnus/mm-decode.el lisp/gnus/shr.el |
| diffstat | 4 files changed, 43 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/gnus/ChangeLog Wed Nov 17 14:51:36 2010 +0900 +++ b/lisp/gnus/ChangeLog Wed Nov 17 07:22:19 2010 +0000 @@ -1,3 +1,14 @@ +2010-11-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-inhibit-images): New user option. + (gnus-mime-display-single): Don't display image if it is non-nil. + + * mm-decode.el (mm-shr): Bind shr-inhibit-images to the value of + gnus-inhibit-images. + + * shr.el (shr-image-displayer): New function. + (shr-tag-img): Use it. + 2010-11-16 Daniel Dehennin <daniel.dehennin@baby-gnu.org> * mml2015.el (mml2015-epg-sign): Use From header.
--- a/lisp/gnus/gnus-art.el Wed Nov 17 14:51:36 2010 +0900 +++ b/lisp/gnus/gnus-art.el Wed Nov 17 07:22:19 2010 +0000 @@ -1636,6 +1636,12 @@ :group 'gnus-article :type 'boolean) +(defcustom gnus-inhibit-images nil + "Non-nil means inhibit displaying of images inline in the article body." + :version "24.1" + :group 'gnus-article + :type 'boolean) + (defcustom gnus-blocked-images 'gnus-block-private-groups "Images that have URLs matching this regexp will be blocked. This can also be a function to be evaluated. If so, it will be @@ -5845,7 +5851,9 @@ (while ignored (when (string-match (pop ignored) type) (throw 'ignored nil))) - (if (and (setq not-attachment + (if (and (not (and gnus-inhibit-images + (string-match "\\`image/" type))) + (setq not-attachment (and (not (mm-inline-override-p handle)) (or (not (mm-handle-disposition handle)) (equal (car (mm-handle-disposition handle))
--- a/lisp/gnus/mm-decode.el Wed Nov 17 14:51:36 2010 +0900 +++ b/lisp/gnus/mm-decode.el Wed Nov 17 07:22:19 2010 +0000 @@ -1687,6 +1687,7 @@ (start end &optional base-url)) (declare-function shr-insert-document "shr" (dom)) (defvar shr-blocked-images) +(defvar gnus-inhibit-images) (autoload 'gnus-blocked-images "gnus-art") (defun mm-shr (handle) @@ -1703,6 +1704,7 @@ (when handle (mm-with-part handle (buffer-string)))))) + (shr-inhibit-images gnus-inhibit-images) charset) (unless handle (setq handle (mm-dissect-buffer t)))
--- a/lisp/gnus/shr.el Wed Nov 17 14:51:36 2010 +0900 +++ b/lisp/gnus/shr.el Wed Nov 17 07:22:19 2010 +0000 @@ -435,6 +435,26 @@ (search-forward "\r\n\r\n" nil t)) (buffer-substring (point) (point-max)))))) +(defun shr-image-displayer (content-function) + "Return a function to display an image. +CONTENT-FUNCTION is a function to retrieve an image for a cid url that +is an argument. The function to be returned takes three arguments URL, +START, and END." + `(lambda (url start end) + (if (string-match "\\`cid:" url) + ,(when content-function + `(let ((image (funcall ,content-function + (substring url (match-end 0))))) + (when image + (goto-char start) + (shr-put-image image + (prog1 + (buffer-substring-no-properties start end) + (delete-region start end)))))) + (url-retrieve url 'shr-image-fetched + (list (current-buffer) start end) + t)))) + (defun shr-heading (cont &rest types) (shr-ensure-paragraph) (apply #'shr-fontize-cont cont types) @@ -574,10 +594,7 @@ (put-text-property start (point) 'shr-alt alt) (put-text-property start (point) 'image-url url) (put-text-property start (point) 'image-displayer - (lambda (url start end) - (url-retrieve url 'shr-image-fetched - (list (current-buffer) start end) - t))) + (shr-image-displayer shr-content-function)) (put-text-property start (point) 'help-echo alt) (setq shr-state 'image)))))