diff lisp/gnus/shr.el @ 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 ee13ba492319
children 312237f41f80
line wrap: on
line diff
--- 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)))))