Improve rmail's MIME handling.
[bpt/emacs.git] / lisp / mail / rmailmm.el
index 0cf22de..6dfa92a 100644 (file)
@@ -1,6 +1,6 @@
 ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
 
-;; Copyright (C) 2006, 2007, 2008, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
 
 ;; Author: Alexander Pohoyda
 ;;     Alex Schroeder
 
 ;; Essentially based on the design of Alexander Pohoyda's MIME
 ;; extensions (mime-display.el and mime.el).
-;; Call `M-x rmail-mime' when viewing an Rmail message.
+
+;; This file provides two operation modes for viewing a MIME message.
+
+;; (1) When rmail-enable-mime is non-nil (now it is the default), the
+;; function `rmail-show-mime' is automatically called.  That function
+;; shows a MIME message directly in RMAIL's view buffer.
+
+;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x
+;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*".
+
+;; Both operations share the intermediate functions rmail-mime-process
+;; and rmail-mime-process-multipart as below.
+
+;; rmail-show-mime
+;;   +- rmail-mime-parse
+;;   |    +- rmail-mime-process <--+------------+
+;;   |         |         +---------+            |
+;;   |         + rmail-mime-process-multipart --+
+;;   |
+;;   + rmail-mime-insert <----------------+
+;;       +- rmail-mime-insert-text        |
+;;       +- rmail-mime-insert-bulk        |
+;;       +- rmail-mime-insert-multipart --+
+;;
+;; rmail-mime
+;;  +- rmail-mime-show <----------------------------------+
+;;       +- rmail-mime-process                            | 
+;;            +- rmail-mime-handle                        |
+;;                 +- rmail-mime-text-handler             |
+;;                 +- rmail-mime-bulk-handler             |
+;;                 |    + rmail-mime-insert-bulk
+;;                 +- rmail-mime-multipart-handler        |
+;;                      +- rmail-mime-process-multipart --+
+
+;; In addition, for the case of rmail-enable-mime being non-nil, this
+;; file provides two functions rmail-insert-mime-forwarded-message and
+;; rmail-insert-mime-resent-message for composing forwarded and resent
+;; messages respectively.
+
+;; Todo:
+
+;; Make rmail-mime-media-type-handlers-alist usable in the first
+;; operation mode.
+;; Handle multipart/alternative in the second operation mode.
+;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
 
 ;;; Code:
 
 (require 'rmail)
 (require 'mail-parse)
+(require 'message)
 
 ;;; User options.
 
-;; FIXME should these be in an rmail group?
-;; FIXME we ought to be able to display images in Emacs.
+(defgroup rmail-mime nil
+  "Rmail MIME handling options."
+  :prefix "rmail-mime-"
+  :group 'rmail)
+
 (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))
   "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"
-  :group 'mime)
+  :group 'rmail-mime)
 
 (defcustom rmail-mime-attachment-dirs-alist
   `(("text/.*" "~/Documents")
@@ -64,15 +112,70 @@ The remaining elements are directories, in order of decreasing preference.
 The first directory that exists is used."
   :type '(alist :key-type regexp :value-type (repeat directory))
   :version "23.1"
-  :group 'mime)
+  :group 'rmail-mime)
+
+(defcustom rmail-mime-show-images 'button
+  "What to do with image attachments that Emacs is capable of displaying.
+If nil, do nothing special.  If `button', add an extra button
+that when pushed displays the image in the buffer.  If a number,
+automatically show images if they are smaller than that size (in
+bytes), otherwise add a display button.  Anything else means to
+automatically display the image in the buffer."
+  :type '(choice (const :tag "Add button to view image" button)
+                (const :tag "No special treatment" nil)
+                (number :tag "Show if smaller than certain size")
+                (other :tag "Always show" show))
+  :version "23.2"
+  :group 'rmail-mime)
 
 ;;; End of user options.
 
+;;; MIME-entity object
+
+(defun rmail-mime-entity (type disposition transfer-encoding
+                              header body children)
+  "Retrun a newly created MIME-entity object.
+
+A MIME-entity is a vector of 6 elements:
+
+  [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ]
+  
+TYPE and DISPOSITION correspond to MIME headers Content-Type: and
+Cotent-Disposition: respectively, and has this format:
+
+  \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+
+VALUE is a string and ATTRIBUTE is a symbol.
+
+Consider the following header, for example:
+
+Content-Type: multipart/mixed;
+       boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
+
+The corresponding TYPE argument must be:
+
+\(\"multipart/mixed\"
+  \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
+
+TRANSFER-ENCODING corresponds to MIME header
+Content-Transfer-Encoding, and is a lowercased string.
+
+HEADER and BODY are a cons (BEG . END), where BEG and END specify
+the region of the corresponding part in RMAIL's data (mbox)
+buffer.  BODY may be nil.  In that case, the current buffer is
+narrowed to the body part.
+
+CHILDREN is a list of MIME-entities for a \"multipart\" entity, and
+nil for the other types."
+  (vector type disposition transfer-encoding header body children))
 
-(defvar rmail-mime-total-number-of-bulk-attachments 0
-  "The total number of bulk attachments in the message.
-If more than 3, offer a way to save all attachments at once.")
-(put 'rmail-mime-total-number-of-bulk-attachments 'permanent-local t)
+;; Accessors for a MIME-entity object.
+(defsubst rmail-mime-entity-type (entity) (aref entity 0))
+(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
+(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
+(defsubst rmail-mime-entity-header (entity) (aref entity 3))
+(defsubst rmail-mime-entity-body (entity) (aref entity 4))
+(defsubst rmail-mime-entity-children (entity) (aref entity 5))
 
 ;;; Buttons
 
@@ -81,6 +184,7 @@ If more than 3, offer a way to save all attachments at once.")
   (let* ((filename (button-get button 'filename))
         (directory (button-get button 'directory))
         (data (button-get button 'data))
+        (mbox-buf rmail-view-buffer)
         (ofilename filename))
     (setq filename (expand-file-name
                    (read-file-name (format "Save as (default: %s): " filename)
@@ -95,7 +199,21 @@ If more than 3, offer a way to save all attachments at once.")
                        (file-name-as-directory filename))))
     (with-temp-buffer
       (set-buffer-file-coding-system 'no-conversion)
-      (insert data)
+      ;; Needed e.g. by jka-compr, so if the attachment is a compressed
+      ;; file, the magic signature compares equal with the unibyte
+      ;; signature string recorded in jka-compr-compression-info-list.
+      (set-buffer-multibyte nil)
+      (setq buffer-undo-list t)
+      (if (stringp data)
+         (insert data)
+       ;; DATA is a MIME-entity object.
+       (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
+             (body (rmail-mime-entity-body data)))
+         (insert-buffer-substring mbox-buf (car body) (cdr body))
+         (cond ((string= transfer-encoding "base64")
+                (ignore-errors (base64-decode-region (point-min) (point-max))))
+               ((string= transfer-encoding "quoted-printable")
+                (quoted-printable-decode-region (point-min) (point-max))))))
       (write-region nil nil filename nil nil nil t))))
 
 (define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
@@ -112,6 +230,23 @@ If more than 3, offer a way to save all attachments at once.")
     (when (coding-system-p coding-system)
       (decode-coding-region (point-min) (point-max) coding-system))))
 
+(defun rmail-mime-insert-text (entity)
+  "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer."
+  (let* ((content-type (rmail-mime-entity-type entity))
+        (charset (cdr (assq 'charset (cdr content-type))))
+        (coding-system (if charset (intern (downcase charset))))
+        (transfer-encoding (rmail-mime-entity-transfer-encoding entity))
+        (body (rmail-mime-entity-body entity)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (insert-buffer-substring rmail-buffer (car body) (cdr body))
+      (cond ((string= transfer-encoding "base64")
+            (ignore-errors (base64-decode-region (point-min) (point-max))))
+           ((string= transfer-encoding "quoted-printable")
+            (quoted-printable-decode-region (point-min) (point-max))))
+      (if (coding-system-p coding-system)
+         (decode-coding-region (point-min) (point-max) coding-system)))))
+
 ;; FIXME move to the test/ directory?
 (defun test-rmail-mime-handler ()
   "Test of a mail using no MIME parts at all."
@@ -128,14 +263,59 @@ MIME-Version: 1.0
     (rmail-mime-show t)
     (set-buffer-multibyte t)))
 
+
+(defun rmail-mime-insert-image (type data)
+  "Insert an image of type TYPE, where DATA is the image data.
+If DATA is not a string, it is a MIME-entity object."
+  (end-of-line)
+  (let ((modified (buffer-modified-p)))
+    (insert ?\n)
+    (unless (stringp data)
+      ;; DATA is a MIME-entity.
+      (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
+           (body (rmail-mime-entity-body data))
+           (mbox-buffer rmail-view-buffer))
+       (with-temp-buffer
+         (set-buffer-multibyte nil)
+         (setq buffer-undo-list t)
+         (insert-buffer-substring mbox-buffer (car body) (cdr body))
+         (cond ((string= transfer-encoding "base64")
+                (ignore-errors (base64-decode-region (point-min) (point-max))))
+               ((string= transfer-encoding "quoted-printable")
+                (quoted-printable-decode-region (point-min) (point-max))))
+         (setq data
+               (buffer-substring-no-properties (point-min) (point-max))))))
+    (insert-image (create-image data type t))
+    (set-buffer-modified-p modified)))
+
+(defun rmail-mime-image (button)
+  "Display the image associated with BUTTON."
+  (let ((inhibit-read-only t))
+    (rmail-mime-insert-image (button-get button 'image-type)
+                            (button-get button 'image-data))))
+
+(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
+
+
 (defun rmail-mime-bulk-handler (content-type
                                content-disposition
                                content-transfer-encoding)
-  "Handle the current buffer as an attachment to download."
-  (setq rmail-mime-total-number-of-bulk-attachments
-       (1+ rmail-mime-total-number-of-bulk-attachments))
-  ;; Find the default directory for this media type
-  (let* ((directory (catch 'directory
+  "Handle the current buffer as an attachment to download.
+For images that Emacs is capable of displaying, the behavior
+depends upon the value of `rmail-mime-show-images'."
+  (rmail-mime-insert-bulk
+   (rmail-mime-entity content-type content-disposition content-transfer-encoding
+                     nil nil nil)))
+
+(defun rmail-mime-insert-bulk (entity)
+  "Inesrt a MIME-entity ENTITY as an attachment.
+The optional second arg DATA, if non-nil, is a string containing
+the attachment data that is already decoded."
+  ;; Find the default directory for this media type.
+  (let* ((content-type (rmail-mime-entity-type entity))
+        (content-disposition (rmail-mime-entity-disposition entity))
+        (body (rmail-mime-entity-body entity))
+        (directory (catch 'directory
                      (dolist (entry rmail-mime-attachment-dirs-alist)
                        (when (string-match (car entry) (car content-type))
                          (dolist (dir (cdr entry))
@@ -145,14 +325,46 @@ MIME-Version: 1.0
                       (cdr (assq 'filename (cdr content-disposition)))
                       "noname"))
         (label (format "\nAttached %s file: " (car content-type)))
-        (data (buffer-string)))
-    (delete-region (point-min) (point-max))
+        (units '(B kB MB GB))
+        data udata size osize type)
+    (if body
+       (setq data entity
+             udata entity
+             size (- (cdr body) (car body)))
+      (setq data (buffer-string)
+           udata (string-as-unibyte data)
+           size (length udata))
+      (delete-region (point-min) (point-max)))
+    (setq osize size)
+    (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
+               (cdr units))
+      (setq size (/ size 1024.0)
+           units (cdr units)))
     (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)
+    (insert (format " (%.0f%s)" size (car units)))
+    (when (and rmail-mime-show-images
+              (string-match "image/\\(.*\\)" (setq type (car content-type)))
+              (setq type (concat "." (match-string 1 type))
+                    type (image-type-from-file-name type))
+              (memq type image-types)
+              (image-type-available-p type))
+      (insert " ")
+      (cond ((or (eq rmail-mime-show-images 'button)
+                (and (numberp rmail-mime-show-images)
+                     (>= osize rmail-mime-show-images)))
+            (insert-button "Display"
+                           :type 'rmail-mime-image
+                           'help-echo "mouse-2, RET: Show image"
+                           'image-type type
+                           'image-data udata))
+           (t
+            (rmail-mime-insert-image type udata))))))
 
 (defun test-rmail-mime-bulk-handler ()
   "Test of a mail used as an example in RFC 2183."
@@ -183,6 +395,22 @@ The current buffer should be narrowed to the body.  CONTENT-TYPE,
 CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
 of the respective parsed headers.  See `rmail-mime-handle' for their
 format."
+  (rmail-mime-process-multipart
+   content-type content-disposition content-transfer-encoding nil))
+
+(defun rmail-mime-process-multipart (content-type
+                                    content-disposition
+                                    content-transfer-encoding
+                                    parse-only)
+  "Process the current buffer as a multipart MIME body.
+
+If PARSE-ONLY is nil, modify the current buffer directly for showing
+the MIME body and return nil.
+
+Otherwise, just parse the current buffer and return a list of
+MIME-entity objects.
+
+The other arguments are the same as `rmail-mime-multipart-handler'."
   ;; Some MUAs start boundaries with "--", while it should start
   ;; with "CRLF--", as defined by RFC 2046:
   ;;    The boundary delimiter MUST occur at the beginning of a line,
@@ -191,7 +419,7 @@ format."
   ;;    of the preceding part.
   ;; We currently don't handle that.
   (let ((boundary (cdr (assq 'boundary content-type)))
-       beg end next)
+       beg end next entities)
     (unless boundary
       (rmail-mm-get-boundary-error-message
        "No boundary defined" content-type content-disposition
@@ -201,9 +429,9 @@ format."
     (goto-char (point-min))
     (when (and (search-forward boundary nil t)
               (looking-at "[ \t]*\n"))
-      (delete-region (point-min) (match-end 0)))
-    ;; Reset the counter
-    (setq rmail-mime-total-number-of-bulk-attachments 0)
+      (if parse-only
+         (narrow-to-region (match-end 0) (point-max))
+       (delete-region (point-min) (match-end 0))))
     ;; Loop over all body parts, where beg points at the beginning of
     ;; the part and end points at the end of the part.  next points at
     ;; the beginning of the next part.
@@ -221,15 +449,17 @@ format."
             (rmail-mm-get-boundary-error-message
              "Malformed boundary" content-type content-disposition
              content-transfer-encoding)))
-      (delete-region end next)
       ;; Handle the part.
-      (save-match-data
-       (save-excursion
+      (if parse-only
          (save-restriction
            (narrow-to-region beg end)
-           (rmail-mime-show))))
-      (setq beg next)
-      (goto-char beg))))
+           (setq entities (cons (rmail-mime-process nil t) entities)))
+       (delete-region end next)
+       (save-restriction
+         (narrow-to-region beg end)
+         (rmail-mime-show)))
+      (goto-char (setq beg next)))
+    (nreverse entities)))
 
 (defun test-rmail-mime-multipart-handler ()
   "Test of a mail used as an example in RFC 2046."
@@ -272,8 +502,9 @@ The current buffer should be narrowed to the respective body, and
 point should be at the beginning of the body.
 
 CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING
-are the values of the respective parsed headers.  The parsed
-headers for CONTENT-TYPE and CONTENT-DISPOSITION have the form
+are the values of the respective parsed headers.  The latter should
+be downcased.  The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
+have the form
 
   \(VALUE . ALIST)
 
@@ -303,7 +534,10 @@ The parsed header value:
         (setq content-transfer-encoding nil))
        ((string= content-transfer-encoding "8bit")
         ;; FIXME: Is this the correct way?
-        (set-buffer-multibyte nil)))
+         ;; No, of course not, it just means there's no decoding to do.
+        ;; (set-buffer-multibyte nil)
+         (setq content-transfer-encoding nil)
+         ))
   ;; Inline stuff requires work.  Attachments are handled by the bulk
   ;; handler.
   (if (string= "inline" (car content-disposition))
@@ -328,6 +562,9 @@ called recursively if multiple parts are available.
 
 The current buffer must contain a single message.  It will be
 modified."
+  (rmail-mime-process show-headers nil))
+
+(defun rmail-mime-process (show-headers parse-only)
   (let ((end (point-min))
        content-type
        content-transfer-encoding
@@ -351,12 +588,16 @@ modified."
                (mail-fetch-field "Content-Transfer-Encoding")
                content-disposition
                (mail-fetch-field "Content-Disposition")))))
-    (if content-type
-       (setq content-type (mail-header-parse-content-type
-                           content-type))
-      ;; FIXME: Default "message/rfc822" in a "multipart/digest"
-      ;; according to RFC 2046.
-      (setq content-type '("text/plain")))
+    ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
+    ;; are not completely so.  Hopefully mail-header-parse-* DTRT.
+    (if content-transfer-encoding
+       (setq content-transfer-encoding (downcase content-transfer-encoding)))
+    (setq content-type
+         (if content-type
+             (mail-header-parse-content-type content-type)
+           ;; FIXME: Default "message/rfc822" in a "multipart/digest"
+           ;; according to RFC 2046.
+           '("text/plain")))
     (setq content-disposition
          (if content-disposition
              (mail-header-parse-content-disposition content-disposition)
@@ -367,20 +608,115 @@ modified."
     ;; attachment according to RFC 2183.
     (unless (member (car content-disposition) '("inline" "attachment"))
       (setq content-disposition '("attachment")))
-    ;; Hide headers and handle the part.
-    (save-restriction
-      (cond ((string= (car content-type) "message/rfc822")
-            (narrow-to-region end (point-max)))
-           ((not show-headers)
-            (delete-region (point-min) end)))
-      (rmail-mime-handle content-type content-disposition
-                        content-transfer-encoding))))
+
+    (if parse-only
+       (cond ((string-match "multipart/.*" (car content-type))
+              (setq end (1- end))
+              (save-restriction
+                (let ((header (if show-headers (cons (point-min) end))))
+                  (narrow-to-region end (point-max))
+                  (rmail-mime-entity content-type
+                                     content-disposition
+                                     content-transfer-encoding
+                                     header nil
+                                     (rmail-mime-process-multipart
+                                      content-type content-disposition
+                                      content-transfer-encoding t)))))
+             ((string-match "message/rfc822" (car content-type))
+              (or show-headers
+                  (narrow-to-region end (point-max)))
+              (rmail-mime-process t t))
+             (t
+              (rmail-mime-entity content-type
+                                 content-disposition
+                                 content-transfer-encoding
+                                 nil
+                                 (cons end (point-max))
+                                 nil)))
+      ;; Hide headers and handle the part.
+      (save-restriction
+       (cond ((string= (car content-type) "message/rfc822")
+              (narrow-to-region end (point-max)))
+             ((not show-headers)
+              (delete-region (point-min) end)))
+       (rmail-mime-handle content-type content-disposition
+                          content-transfer-encoding)))))
+
+(defun rmail-mime-insert-multipart (entity)
+  "Insert MIME-entity ENTITY of multipart type in the current buffer."
+  (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity))
+                                    "/")))
+       (disposition (rmail-mime-entity-disposition entity))
+       (header (rmail-mime-entity-header entity))
+       (children (rmail-mime-entity-children entity)))
+    (if header
+       (let ((pos (point)))
+         (or (bolp)
+             (insert "\n"))
+         (insert-buffer-substring rmail-buffer (car header) (cdr header))
+         (rfc2047-decode-region pos (point))
+         (insert "\n")))
+    (cond
+     ((string= subtype "mixed")
+      (dolist (child children)
+       (rmail-mime-insert child '("text/plain") disposition)))
+     ((string= subtype "digest")
+      (dolist (child children)
+       (rmail-mime-insert child '("message/rfc822") disposition)))
+     ((string= subtype "alternative")
+      (let (best-plain-text best-text)
+       (dolist (child children)
+         (if (string= (or (car (rmail-mime-entity-disposition child))
+                          (car disposition))
+                      "inline")
+             (if (string-match "text/plain"
+                               (car (rmail-mime-entity-type child)))
+                 (setq best-plain-text child)
+               (if (string-match "text/.*"
+                                 (car (rmail-mime-entity-type child)))
+                   (setq best-text child)))))
+       (if (or best-plain-text best-text)
+           (rmail-mime-insert (or best-plain-text best-text))
+         ;; No child could be handled.  Insert all.
+         (dolist (child children)
+           (rmail-mime-insert child nil disposition)))))
+     (t
+      ;; Unsupported subtype.  Insert all as attachment.
+      (dolist (child children)
+       (rmail-mime-insert-bulk child))))))
+
+(defun rmail-mime-parse ()
+  "Parse the current Rmail message as a MIME message.
+The value is a MIME-entiy object (see `rmail-mime-enty-new')."
+  (save-excursion
+    (goto-char (point-min))
+    (rmail-mime-process nil t)))
+
+(defun rmail-mime-insert (entity &optional content-type disposition)
+  "Insert a MIME-entity ENTITY in the current buffer.
+
+This function will be called recursively if multiple parts are
+available."
+  (if (rmail-mime-entity-children entity)
+      (rmail-mime-insert-multipart entity)
+    (setq content-type
+         (or (rmail-mime-entity-type entity) content-type))
+    (setq disposition
+         (or (rmail-mime-entity-disposition entity) disposition))
+    (if (and (string= (car disposition) "inline")
+            (string-match "text/.*" (car content-type)))
+       (rmail-mime-insert-text entity)
+      (rmail-mime-insert-bulk entity))))
+
+(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'."
@@ -390,9 +726,14 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
     (set-buffer buf)
     (setq buffer-undo-list t)
     (let ((inhibit-read-only t))
+      ;; Decoding the message in fundamental mode for speed, only
+      ;; switching to rmail-mime-mode at the end for display.  Eg
+      ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
+      (fundamental-mode)
       (erase-buffer)
       (insert data)
       (rmail-mime-show t)
+      (rmail-mime-mode)
       (set-buffer-modified-p nil))
     (view-buffer buf)))
 
@@ -401,6 +742,50 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
   (error "%s; type: %s; disposition: %s; encoding: %s"
         message type disposition encoding))
 
+(defun rmail-show-mime ()
+  (let ((mbox-buf rmail-buffer))
+    (condition-case nil
+       (let ((entity (rmail-mime-parse)))
+         (with-current-buffer rmail-view-buffer
+           (let ((inhibit-read-only t)
+                 (rmail-buffer mbox-buf))
+             (erase-buffer)
+             (rmail-mime-insert entity))))
+      (error
+       ;; Decoding failed.  Insert the original message body as is.
+       (let ((region (with-current-buffer mbox-buf
+                      (goto-char (point-min))
+                      (re-search-forward "^$" nil t)
+                      (forward-line 1)
+                      (cons (point) (point-max)))))
+        (with-current-buffer rmail-view-buffer
+          (let ((inhibit-read-only t))
+            (erase-buffer)
+            (insert-buffer-substring mbox-buf (car region) (cdr region))))
+        (message "MIME decoding failed"))))))
+
+(setq rmail-show-mime-function 'rmail-show-mime)
+
+(defun rmail-insert-mime-forwarded-message (forward-buffer)
+  (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (message-forward-make-body-mime mbox-buf))))
+
+(setq rmail-insert-mime-forwarded-message-function
+      'rmail-insert-mime-forwarded-message)
+
+(defun rmail-insert-mime-resent-message (forward-buffer)
+  (insert-buffer-substring
+   (with-current-buffer forward-buffer rmail-view-buffer))
+  (goto-char (point-min))
+  (when (looking-at "From ")
+    (forward-line 1)
+    (delete-region (point-min) (point))))
+
+(setq rmail-insert-mime-resent-message-function
+      'rmail-insert-mime-resent-message)
+
 (provide 'rmailmm)
 
 ;; Local Variables: