changeset 111770:dc81ba797214

Improve rmail's MIME handling.
author Kenichi Handa <handa@m17n.org>
date Fri, 26 Nov 2010 13:08:14 +0900
parents fc928538e0b4 (current diff) 0e19494fd75d (diff)
children ec9916da73f2
files
diffstat 4 files changed, 419 insertions(+), 66 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Thu Nov 25 12:57:09 2010 +0900
+++ b/lisp/ChangeLog	Fri Nov 26 13:08:14 2010 +0900
@@ -1,3 +1,46 @@
+2010-11-26  Kenichi Handa  <handa@m17n.org>
+
+	* mail/rmailmm.el (rmail-mime-entity, rmail-mime-entity-type)
+	(rmail-mime-entity-disposition)
+	(rmail-mime-entity-transfer-encoding, rmail-mime-entity-header)
+	(rmail-mime-entity-body, rmail-mime-entity-children): New functions.
+	(rmail-mime-save): Handle the case that the button's `data' is a
+	MIME entity.
+	(rmail-mime-insert-text): New function.
+	(rmail-mime-insert-image): Handle the case that DATA is a MIME
+	entity.
+	(rmail-mime-bulk-handler): Just call rmail-mime-insert-bulk.
+	(rmail-mime-insert-bulk): New function mostly copied from the old
+	rmail-mime-bulk-handler.
+	(rmail-mime-multipart-handler): Just call
+	rmail-mime-process-multipart.
+	(rmail-mime-process-multipart): New funciton mostly copied from
+	the old rmail-mime-multipart-handler.
+	(rmail-mime-show): Just call rmail-mime-process.
+	(rmail-mime-process): New funciton mostly copied from the old
+	rmail-mime-show.
+	(rmail-mime-insert-multipart, rmail-mime-parse)
+	(rmail-mime-insert, rmail-show-mime)
+	(rmail-insert-mime-forwarded-message)
+	(rmail-insert-mime-resent-message): New functions.
+	(rmail-insert-mime-forwarded-message-function): Set to
+	rmail-insert-mime-forwarded-message.
+	(rmail-insert-mime-resent-message-function): Set to
+	rmail-insert-mime-resent-message.
+
+	* mail/rmailsum.el: Require rfc2047.
+	(rmail-header-summary): Handle multiline Subject: field.
+	(rmail-summary-line-decoder): Change the default to
+	rfc2047-decode-string.
+
+	* mail/rmail.el (rmail-enable-mime): Change the default to t.
+	(rmail-mime-feature): Change the default to `rmailmm'.
+	(rmail-quit): Delete the specifal code for rmail-enable-mime.
+	(rmail-display-labels): Likewise.
+	(rmail-show-message-1): Check rmail-enable-mime, and use
+	rmail-show-mime-function for a MIME message.  Decode the headers
+	according to RFC2047.
+
 2010-11-24  Stefan Monnier  <monnier@iro.umontreal.ca>
 
 	* progmodes/which-func.el (which-func-imenu-joiner-function):
--- a/lisp/mail/rmail.el	Thu Nov 25 12:57:09 2010 +0900
+++ b/lisp/mail/rmail.el	Fri Nov 26 13:08:14 2010 +0900
@@ -638,7 +638,7 @@
 
 This is set to nil by default.")
 
-(defcustom rmail-enable-mime nil
+(defcustom rmail-enable-mime t
   "If non-nil, RMAIL uses MIME features.
 If the value is t, RMAIL automatically shows MIME decoded message.
 If the value is neither t nor nil, RMAIL does not show MIME decoded message
@@ -649,6 +649,7 @@
   :type '(choice (const :tag "on" t)
 		 (const :tag "off" nil)
 		 (other :tag "when asked" ask))
+  :version "23.3"
   :group 'rmail)
 
 (defvar rmail-enable-mime-composing nil
@@ -693,13 +694,12 @@
 where MSG is the message number, REGEXP is the regular
 expression, LIMIT is the position specifying the end of header.")
 
-(defvar rmail-mime-feature 'rmail-mime
+(defvar rmail-mime-feature 'rmailmm
   "Feature to require to load MIME support in Rmail.
 When starting Rmail, if `rmail-enable-mime' is non-nil,
 this feature is required with `require'.
 
-The default value is `rmail-mime'.  This feature is provided by
-the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.")
+The default value is `rmailmm'")
 
 ;; FIXME this is unused.
 (defvar rmail-decode-mime-charset t
@@ -1509,17 +1509,9 @@
       (set-buffer-modified-p nil))
     (replace-buffer-in-windows rmail-summary-buffer)
     (bury-buffer rmail-summary-buffer))
-  (if rmail-enable-mime
-      (let ((obuf rmail-buffer)
-	    (ovbuf rmail-view-buffer))
-	(set-buffer rmail-view-buffer)
-	(quit-window)
-	(replace-buffer-in-windows ovbuf)
-	(replace-buffer-in-windows obuf)
-	(bury-buffer obuf))
-    (let ((obuf (current-buffer)))
-      (quit-window)
-      (replace-buffer-in-windows obuf))))
+  (let ((obuf (current-buffer)))
+    (quit-window)
+    (replace-buffer-in-windows obuf)))
 
 (defun rmail-bury ()
   "Bury current Rmail buffer and its summary buffer."
@@ -2219,15 +2211,7 @@
   (let ((blurb (rmail-get-labels)))
     (setq mode-line-process
 	  (format " %d/%d%s"
-		  rmail-current-message rmail-total-messages blurb))
-    ;; If rmail-enable-mime is non-nil, we may have to update
-    ;; `mode-line-process' of rmail-view-buffer too.
-    (if (and rmail-enable-mime
-	     (not (eq (current-buffer) rmail-view-buffer))
-	     (buffer-live-p rmail-view-buffer))
-	(let ((mlp mode-line-process))
-	  (with-current-buffer rmail-view-buffer
-	    (setq mode-line-process mlp))))))
+		  rmail-current-message rmail-total-messages blurb))))
 
 (defun rmail-get-attr-value (attr state)
   "Return the character value for ATTR.
@@ -2706,6 +2690,11 @@
 	  (message "Showing message %d" msg))
 	(narrow-to-region beg end)
 	(goto-char beg)
+	(if (and rmail-enable-mime
+		 (re-search-forward "mime-version: 1.0" nil t))
+	    (let ((rmail-buffer mbox-buf)
+		  (rmail-view-buffer view-buf))
+	      (funcall rmail-show-mime-function))
 	(setq body-start (search-forward "\n\n" nil t))
 	(narrow-to-region beg (point))
 	(goto-char beg)
@@ -2722,11 +2711,6 @@
 	;; unibyte temporary buffer where the character decoding takes
 	;; place.
 	(with-current-buffer rmail-view-buffer
-	  ;; We give the view buffer a buffer-local value of
-	  ;; rmail-header-style based on the binding in effect when
-	  ;; this function is called; `rmail-toggle-headers' can
-	  ;; inspect this value to determine how to toggle.
-	  (set (make-local-variable 'rmail-header-style) header-style)
 	  (erase-buffer))
 	(if (null character-coding)
 	    ;; Do it directly since that is fast.
@@ -2749,8 +2733,13 @@
 	      (error "uuencoded messages are not supported yet"))
 	     (t))
 	    (rmail-decode-region (point-min) (point-max)
-				 coding-system view-buf)))
+				 coding-system view-buf))))
 	(with-current-buffer rmail-view-buffer
+	  ;; We give the view buffer a buffer-local value of
+	  ;; rmail-header-style based on the binding in effect when
+	  ;; this function is called; `rmail-toggle-headers' can
+	  ;; inspect this value to determine how to toggle.
+	  (set (make-local-variable 'rmail-header-style) header-style)
 	  ;; Unquote quoted From lines
 	  (goto-char (point-min))
 	  (while (re-search-forward "^>+From " nil t)
@@ -2766,6 +2755,10 @@
 	(with-current-buffer rmail-view-buffer
 	  (insert "\n")
 	  (goto-char (point-min))
+	  ;; Decode the headers according to RFC2047.
+	  (save-excursion
+	    (search-forward "\n\n" nil 'move)
+	    (rfc2047-decode-region (point-min) (point)))
 	  (rmail-highlight-headers)
 					;(rmail-activate-urls)
 					;(rmail-process-quoted-material)
--- a/lisp/mail/rmailmm.el	Thu Nov 25 12:57:09 2010 +0900
+++ b/lisp/mail/rmailmm.el	Fri Nov 26 13:08:14 2010 +0900
@@ -26,17 +26,57 @@
 
 ;; 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:
 
-;; Handle multipart/alternative.
+;; 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.
 
@@ -90,6 +130,52 @@
 
 ;;; 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))
+
+;; 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
 
@@ -98,6 +184,7 @@
   (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)
@@ -116,7 +203,17 @@
       ;; file, the magic signature compares equal with the unibyte
       ;; signature string recorded in jka-compr-compression-info-list.
       (set-buffer-multibyte nil)
-      (insert data)
+      (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)
@@ -133,6 +230,23 @@
     (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."
@@ -151,10 +265,28 @@
 
 
 (defun rmail-mime-insert-image (type data)
-  "Insert an image of type TYPE, where DATA is the image 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)
-  (insert ?\n)
-  (insert-image (create-image data type t)))
+  (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."
@@ -171,8 +303,19 @@
   "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* ((directory (catch 'directory
+  (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))
@@ -182,17 +325,21 @@
 		       (cdr (assq 'filename (cdr content-disposition)))
 		       "noname"))
 	 (label (format "\nAttached %s file: " (car content-type)))
-	 (data (buffer-string))
-	 (udata (string-as-unibyte data))
-	 (size (length udata))
-	 (osize size)
 	 (units '(B kB MB GB))
-	 type)
-    (while (and (> size 1024.0)	; cribbed from gnus-agent-expire-done-message
+	 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)))
-    (delete-region (point-min) (point-max))
     (insert label)
     (insert-button filename
 		   :type 'rmail-mime-save
@@ -248,6 +395,22 @@
 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,
@@ -256,7 +419,7 @@
   ;;    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
@@ -266,7 +429,9 @@
     (goto-char (point-min))
     (when (and (search-forward boundary nil t)
 	       (looking-at "[ \t]*\n"))
-      (delete-region (point-min) (match-end 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.
@@ -284,13 +449,17 @@
 	     (rmail-mm-get-boundary-error-message
 	      "Malformed boundary" content-type content-disposition
 	      content-transfer-encoding)))
-      (delete-region end next)
       ;; Handle the part.
-      (save-restriction
-	(narrow-to-region beg end)
-	(rmail-mime-show))
-      (goto-char (setq beg next)))))
-
+      (if parse-only
+	  (save-restriction
+	    (narrow-to-region beg end)
+	    (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."
@@ -393,6 +562,9 @@
 
 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
@@ -436,14 +608,105 @@
     ;; 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."
@@ -479,6 +742,50 @@
   (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:
--- a/lisp/mail/rmailsum.el	Thu Nov 25 12:57:09 2010 +0900
+++ b/lisp/mail/rmailsum.el	Fri Nov 26 13:08:14 2010 +0900
@@ -31,6 +31,7 @@
 
 ;; For rmail-select-summary.
 (require 'rmail)
+(require 'rfc2047)
 
 (defcustom rmail-summary-scroll-between-messages t
   "Non-nil means Rmail summary scroll commands move between messages.
@@ -363,13 +364,15 @@
       (aset rmail-summary-vector (1- msgnum) line))
     line))
 
-(defcustom rmail-summary-line-decoder (function identity)
+(defcustom rmail-summary-line-decoder (function rfc2047-decode-string)
   "Function to decode a Rmail summary line.
 It receives the summary line for one message as a string
 and should return the decoded string.
 
-By default, it is `identity', which returns the string unaltered."
+By default, it is `rfc2047-decode-string', which decodes MIME-encoded
+subject."
   :type 'function
+  :version "23.3"
   :group 'rmail-summary)
 
 (defun rmail-create-summary-line (msgnum)
@@ -588,10 +591,17 @@
 						     (t (- mch 14))))
 				      (min len (+ lo 25)))))))))
    (concat (if (re-search-forward "^Subject:" nil t)
-	       (progn (skip-chars-forward " \t")
-		      (buffer-substring (point)
-					(progn (end-of-line)
-					       (point))))
+	       (let (pos str)
+		 (skip-chars-forward " \t")
+		 (setq pos (point))
+		 (forward-line 1)
+		 (setq str (buffer-substring pos (1- (point))))
+		 (while (looking-at "\\s ")
+		   (setq str (concat str " " 
+				     (buffer-substring (match-end 0)
+						       (line-end-position))))
+		   (forward-line 1))
+		 str)
 	     (re-search-forward "[\n][\n]+" nil t)
 	     (buffer-substring (point) (progn (end-of-line) (point))))
 	   "\n")))