[Emacs-diffs] emacs/lisp ChangeLog mail/rmailmm.el

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       09/09/24 03:21:23

Modified files:
        lisp           : ChangeLog 
        lisp/mail      : rmailmm.el 

Log 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).

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/ChangeLog?cvsroot=emacs&r1=1.16248&r2=1.16249
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/mail/rmailmm.el?cvsroot=emacs&r1=1.11&r2=1.12

Patches:
Index: ChangeLog
===================================================================
RCS file: /sources/emacs/emacs/lisp/ChangeLog,v
retrieving revision 1.16248
retrieving revision 1.16249
diff -u -b -r1.16248 -r1.16249
--- ChangeLog   24 Sep 2009 03:15:27 -0000      1.16248
+++ ChangeLog   24 Sep 2009 03:21:20 -0000      1.16249
@@ -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  <address@hidden>
 

Index: mail/rmailmm.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/mail/rmailmm.el,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- mail/rmailmm.el     24 Sep 2009 03:15:30 -0000      1.11
+++ mail/rmailmm.el     24 Sep 2009 03:21:23 -0000      1.12
@@ -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 @@
 
 (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 @@
     (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 @@
     (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 @@
       (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 @@
     (let ((inhibit-read-only t))
       (erase-buffer)
       (insert data)
+      (rmail-mime-mode)
       (rmail-mime-show t)
       (set-buffer-modified-p nil))
     (view-buffer buf)))