[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/emacs-23 r100243: Improve rmail's MIME hand
|
From: |
Kenichi Handa |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/emacs-23 r100243: Improve rmail's MIME handling. |
|
Date: |
Fri, 26 Nov 2010 13:08:14 +0900 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100243 [merge]
committer: Kenichi Handa <address@hidden>
branch nick: emacs-23
timestamp: Fri 2010-11-26 13:08:14 +0900
message:
Improve rmail's MIME handling.
modified:
lisp/ChangeLog
lisp/mail/rmail.el
lisp/mail/rmailmm.el
lisp/mail/rmailsum.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-11-24 02:21:55 +0000
+++ b/lisp/ChangeLog 2010-11-26 04:06:59 +0000
@@ -1,3 +1,46 @@
+2010-11-26 Kenichi Handa <address@hidden>
+
+ * 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 <address@hidden>
* progmodes/which-func.el (which-func-imenu-joiner-function):
=== modified file 'lisp/mail/rmail.el'
--- a/lisp/mail/rmail.el 2010-10-14 04:23:36 +0000
+++ b/lisp/mail/rmail.el 2010-11-26 04:06:59 +0000
@@ -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)
=== modified file 'lisp/mail/rmailmm.el'
--- a/lisp/mail/rmailmm.el 2010-07-16 09:59:37 +0000
+++ b/lisp/mail/rmailmm.el 2010-11-26 04:06:59 +0000
@@ -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:
=== modified file 'lisp/mail/rmailsum.el'
--- a/lisp/mail/rmailsum.el 2010-01-13 08:35:10 +0000
+++ b/lisp/mail/rmailsum.el 2010-11-26 04:06:59 +0000
@@ -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")))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/emacs-23 r100243: Improve rmail's MIME handling.,
Kenichi Handa <=