From 2e9075d3968a2542d47b7e64a1e457711568373d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 24 Sep 2009 03:21:20 +0000 Subject: [PATCH] (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). --- lisp/ChangeLog | 6 +++++ lisp/mail/rmailmm.el | 63 ++++++++++++++++++++++++++++++++++++++------ 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 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))) -- 2.39.2