(rmail-mime-media-type-handlers-alist): Doc fix. Add image handler.

(rmail-mime-bulk-handler): Optionally handle images.
(rmail-mime-image): New button action.
(rmail-mime-image-handler): New function.
(rmail-mime-mode): New mode.
(rmail-mime): Doc fix.  Use rmail-mime-mode (for font-lock).

2 files changed, 61 insertions, 8 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 26342e5697c..1d5cf220ca1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -4,6 +4,12 @@
 	there is no newline after the final mime boundary.  (Bug#4539)
 	Move markers on insertion so that any buttons inserted don't end up in
 	the next part of a multipart message.
+	(rmail-mime-media-type-handlers-alist): Doc fix.  Add image handler.
+	(rmail-mime-bulk-handler): Optionally handle images.
+	(rmail-mime-image): New button action.
+	(rmail-mime-image-handler): New function.
+	(rmail-mime-mode): New mode.
+	(rmail-mime): Doc fix.  Use rmail-mime-mode (for font-lock).
 
 2009-09-24  Stefan Monnier  <monnier@iro.umontreal.ca>
 
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 0cf22de5214..71248b047bc 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -28,6 +28,10 @@
 ;; extensions (mime-display.el and mime.el).
 ;; Call `M-x rmail-mime' when viewing an Rmail message.
 
+;; Todo:
+
+;; Handle multipart/alternative.
+
 ;;; Code:
 
 (require 'rmail)
@@ -36,21 +40,23 @@
 ;;; User options.
 
 ;; FIXME should these be in an rmail group?
-;; FIXME we ought to be able to display images in Emacs.
 (defcustom rmail-mime-media-type-handlers-alist
   '(("multipart/.*" rmail-mime-multipart-handler)
     ("text/.*" rmail-mime-text-handler)
     ("text/\\(x-\\)?patch" rmail-mime-bulk-handler)
     ;; FIXME this handler not defined anywhere?
 ;;;   ("application/pgp-signature" rmail-mime-application/pgp-signature-handler)
-    ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler))
+    ("\\(audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler)
+    ("image/.*" rmail-mime-image-handler))
   "Functions to handle various content types.
 This is an alist with elements of the form (REGEXP FUNCTION ...).
 The first item is a regular expression matching a content-type.
 The remaining elements are handler functions to run, in order of
-decreasing preference.  These are called until one returns non-nil."
+decreasing preference.  These are called until one returns non-nil.
+Note that this only applies to items with an inline Content-Disposition,
+all others are handled by `rmail-mime-bulk-handler'."
   :type '(alist :key-type regexp :value-type (repeat function))
-  :version "23.1"
+  :version "23.2"			; added image-handler
   :group 'mime)
 
 (defcustom rmail-mime-attachment-dirs-alist
@@ -130,8 +136,10 @@ MIME-Version: 1.0
 
 (defun rmail-mime-bulk-handler (content-type
 				content-disposition
-				content-transfer-encoding)
-  "Handle the current buffer as an attachment to download."
+				content-transfer-encoding &optional image)
+  "Handle the current buffer as an attachment to download.
+Optional argument IMAGE non-nil means if Emacs can display the
+attachment as an image, add an option to do so."
   (setq rmail-mime-total-number-of-bulk-attachments
 	(1+ rmail-mime-total-number-of-bulk-attachments))
   ;; Find the default directory for this media type
@@ -150,9 +158,34 @@ MIME-Version: 1.0
     (insert label)
     (insert-button filename
 		   :type 'rmail-mime-save
+		   'help-echo "mouse-2, RET: Save attachment"
 		   'filename filename
 		   'directory (file-name-as-directory directory)
-		   'data data)))
+		   'data data)
+    (when (and image
+	       (string-match "image/\\(.*\\)" (setq image (car content-type)))
+	       (setq image (concat "." (match-string 1 image))
+		     image (image-type-from-file-name image))
+	       (memq image image-types)
+	       (image-type-available-p image))
+      (insert " ")
+      ;; FIXME ought to check or at least display the image size.
+      (insert-button "Display"
+		     :type 'rmail-mime-image
+		     'help-echo "mouse-2, RET: Show image"
+		     'image-type image
+		     'image-data (string-as-unibyte data)))))
+
+(defun rmail-mime-image (button)
+  "Display the image associated with BUTTON."
+  (let ((type (button-get button 'image-type))
+	(data (button-get button 'image-data))
+	(inhibit-read-only t))
+    (end-of-line)
+    (insert ?\n)
+    (insert-image (create-image data type t))))
+
+(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
 
 (defun test-rmail-mime-bulk-handler ()
   "Test of a mail used as an example in RFC 2183."
@@ -175,6 +208,15 @@ lgAAAABJRU5ErkJggg==
     (insert mail)
     (rmail-mime-show)))
 
+;; FIXME should rmail-mime-bulk-handler instead just always do this?
+(defun rmail-mime-image-handler (content-type content-disposition
+					      content-transfer-encoding)
+  "Handle the current buffer as an image.
+Like `rmail-mime-bulk-handler', but if possible adds a second
+button to display the image in the buffer."
+  (rmail-mime-bulk-handler content-type content-disposition
+			   content-transfer-encoding t))
+
 (defun rmail-mime-multipart-handler (content-type
 				     content-disposition
 				     content-transfer-encoding)
@@ -376,11 +418,15 @@ modified."
       (rmail-mime-handle content-type content-disposition
 			 content-transfer-encoding))))
 
+(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
+  "Major mode used in `rmail-mime' buffers."
+  (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
+
 ;;;###autoload
 (defun rmail-mime ()
   "Process the current Rmail message as a MIME message.
 This creates a temporary \"*RMAIL*\" buffer holding a decoded
-copy of the message.  Content-types are handled according to
+copy of the message.  Inline content-types are handled according to
 `rmail-mime-media-type-handlers-alist'.  By default, this
 displays text and multipart messages, and offers to download
 attachments as specfied by `rmail-mime-attachment-dirs-alist'."
@@ -392,6 +438,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
     (let ((inhibit-read-only t))
       (erase-buffer)
       (insert data)
+      (rmail-mime-mode)
       (rmail-mime-show t)
       (set-buffer-modified-p nil))
     (view-buffer buf)))