From 40de2c6dd32a746e3d31492a0f43a290e9ef5d1d Mon Sep 17 00:00:00 2001
From: Katsumi Yamaoka <yamaoka@jpl.org>
Date: Wed, 17 Nov 2010 07:22:19 +0000
Subject: [PATCH] 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.
---
 lisp/gnus/ChangeLog    | 11 +++++++++++
 lisp/gnus/gnus-art.el  | 10 +++++++++-
 lisp/gnus/mm-decode.el |  2 ++
 lisp/gnus/shr.el       | 25 +++++++++++++++++++++----
 4 files changed, 43 insertions(+), 5 deletions(-)

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 2cf48e24c7c..7d3b2d06835 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -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.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index e2be314f8d1..4ff36e7a589 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -1636,6 +1636,12 @@ This requires GNU Libidn, and by default only enabled if it is found."
   :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 @@ If displaying \"text/html\" is discouraged \(see
 	(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))
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 2ab5a548e42..f27cc5907b0 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1687,6 +1687,7 @@ If RECURSIVE, search recursively."
 		  (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 @@ If RECURSIVE, search recursively."
 				  (when handle
 				    (mm-with-part handle
 				      (buffer-string))))))
+	(shr-inhibit-images gnus-inhibit-images)
 	charset)
     (unless handle
       (setq handle (mm-dissect-buffer t)))
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el
index 4f3b20531f5..2dd33ecbc13 100644
--- a/lisp/gnus/shr.el
+++ b/lisp/gnus/shr.el
@@ -435,6 +435,26 @@ Return a string with image data."
 		(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 @@ Return a string with image data."
 	(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)))))
 
-- 
2.39.5