Mercurial > emacs
changeset 111769:0e19494fd75d
Improve rmail's MIME handling.
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Fri, 26 Nov 2010 13:06:59 +0900 |
| parents | 3429632cfcfb (current diff) fc928538e0b4 (diff) |
| children | dc81ba797214 cc824a6e0de5 |
| files | lisp/ChangeLog lisp/mail/rmail.el lisp/mail/rmailmm.el lisp/mail/rmailsum.el |
| diffstat | 4 files changed, 419 insertions(+), 66 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Nov 25 12:56:41 2010 +0900 +++ b/lisp/ChangeLog Fri Nov 26 13:06:59 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:56:41 2010 +0900 +++ b/lisp/mail/rmail.el Fri Nov 26 13:06:59 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:56:41 2010 +0900 +++ b/lisp/mail/rmailmm.el Fri Nov 26 13:06:59 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:56:41 2010 +0900 +++ b/lisp/mail/rmailsum.el Fri Nov 26 13:06:59 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")))