[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/emacs-23 r100323: Enable display mode of MI
|
From: |
Kenichi Handa |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/emacs-23 r100323: Enable display mode of MIME message in rmail. |
|
Date: |
Fri, 24 Dec 2010 13:40:42 +0900 |
|
User-agent: |
Bazaar (2.0.3) |
------------------------------------------------------------
revno: 100323 [merge]
committer: Kenichi Handa <address@hidden>
branch nick: emacs-23
timestamp: Fri 2010-12-24 13:40:42 +0900
message:
Enable display mode of MIME message in rmail.
modified:
etc/NEWS
lisp/ChangeLog
lisp/mail/rmail.el
lisp/mail/rmailmm.el
=== modified file 'etc/NEWS'
--- a/etc/NEWS 2010-12-18 08:53:28 +0000
+++ b/etc/NEWS 2010-12-24 04:38:22 +0000
@@ -72,6 +72,27 @@
Git, Mercurial, and Monotone recognize "Author" and "Date".
Any unknown header is left as is in the message, so it is not lost.
+** Rmail
+
+** The default value of `rmail-enable-mime' is now t. Rmail decodes
+MIME contents automatically. You can customize the variable
+`rmail-enable-mime' back to `nil' to disable this automatic MIME
+decoding.
+
+** The command `rmail-mime' change the displaying of a MIME message
+between decoded presentation form and raw data if `rmail-enable-mime'
+is non-nil. And, with prefix argument, it change only the displaying
+of the MIME entity at point.
+
+** The new command TAB (rmail-mime-next-item) moves point to the next
+item of MIME message.
+
+** The new command backtab (rmail-mime-previous-item) moves point to
+the previous item of MIME message.
+
+** The new command RET (rmail-mime-toggle-hidden) hide or show the
+body of the MIME entity at point.
+
** Obsolete packages
+++
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2010-12-20 11:31:15 +0000
+++ b/lisp/ChangeLog 2010-12-24 04:38:22 +0000
@@ -1,3 +1,46 @@
+2010-12-24 Kenichi Handa <address@hidden>
+
+ * mail/rmailmm.el: New key bindings for rmail-mime-next-item,
+ rmail-mime-previous-item, and rmail-mime-toggle-hidden.
+ (rmail-mime-mbox-buffer)
+ (rmail-mime-view-buffer, rmail-mime-coding-system): New variables.
+ (rmail-mime-entity): Argument changed. All codes handling an
+ entity object are changed.
+ (rmail-mime-entity-header, rmail-mime-entity-body): Adjusted for
+ the above change.
+ (rmail-mime-entity-children, rmail-mime-entity-handler)
+ (rmail-mime-entity-tagline): New functions.
+ (rmail-mime-message-p): New function.
+ (rmail-mime-save): Bind rmail-mime-mbox-buffer.
+ (rmail-mime-entity-segment, rmail-mime-next-item)
+ (rmail-mime-previous-item, rmail-mime-shown-mode)
+ (rmail-mime-hidden-mode, rmail-mime-raw-mode)
+ (rmail-mime-toggle-raw, rmail-mime-toggle-hidden)
+ (rmail-mime-insert-tagline, rmail-mime-insert-header): New
+ functions.
+ (rmail-mime-text-handler): Call rmail-mime-insert-text.
+ (rmail-mime-insert-decoded-text): New function.
+ (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text.
+ (rmail-mime-insert-image): Argument changed. Caller changed.
+ (rmail-mime-image): Call rmail-mime-toggle-hidden.
+ (rmail-mime-set-bulk-data): New funciton.
+ (rmail-mime-insert-bulk): Argument changed.
+ (rmail-mime-multipart-handler): Return t.
+ (rmail-mime-process-multipart): Argument changed. Handle
+ "multipart/alternative" here.
+ (rmail-mime-process): Argument changed.
+ (rmail-mime-parse): Bind rmail-mime-mbox-buffer.
+ (rmail-mime-insert): Argument changed. Handle raw display mode.
+ (rmail-mime): Argument changed. Handle toggling of raw display
+ mode.
+ (rmail-show-mime): Bind rmail-mime-mbox-buffer and
+ rmail-mime-view-buffer.
+ (rmail-insert-mime-forwarded-message): Likewise.
+ (rmail-search-mime-message): Likewise. Don't bind rmail-buffer.
+
+ * mail/rmail.el (rmail-show-message-1): If rmail-enable-mime is
+ non-nil, handle the header in rmail-show-mime-function.
+
2010-12-20 Leo <address@hidden>
* help-fns.el (describe-variable): Fix 2010-12-17 change.
=== modified file 'lisp/mail/rmail.el'
--- a/lisp/mail/rmail.el 2010-12-06 06:54:52 +0000
+++ b/lisp/mail/rmail.el 2010-12-24 04:38:22 +0000
@@ -2691,75 +2691,72 @@
(message "Showing message %d" msg))
(narrow-to-region beg end)
(goto-char beg)
+ (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))
(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)
- (save-excursion
- (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
- (setq coding-system (intern (match-string 1)))
- (setq coding-system (rmail-get-coding-system))))
- (setq character-coding (mail-fetch-field "content-transfer-encoding")
- is-text-message (rmail-is-text-p))
- (if character-coding
- (setq character-coding (downcase character-coding)))
- (narrow-to-region beg end)
- ;; Decode the message body into an empty view buffer using a
- ;; unibyte temporary buffer where the character decoding takes
- ;; place.
- (with-current-buffer rmail-view-buffer
- (erase-buffer))
- (if (null character-coding)
- ;; Do it directly since that is fast.
- (rmail-decode-region body-start end coding-system view-buf)
- ;; Can this be done directly, skipping the temp buffer?
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert-buffer-substring mbox-buf body-start end)
- (cond
- ((string= character-coding "quoted-printable")
- ;; See bug#5441.
- (or (mail-unquote-printable-region (point-min) (point-max)
- nil t 'unibyte)
- (message "Malformed MIME quoted-printable message")))
- ((and (string= character-coding "base64") is-text-message)
- (condition-case err
- (base64-decode-region (point-min) (point-max))
- (error (message "%s" (cdr err)))))
- ((eq character-coding 'uuencode)
- (error "uuencoded messages are not supported yet"))
- (t))
- (rmail-decode-region (point-min) (point-max)
- 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)
- (beginning-of-line)
- (delete-char 1)
- (forward-line))
- (goto-char (point-min)))
- ;; Copy the headers to the front of the message view buffer.
- (rmail-copy-headers beg end)
- ;; Add the separator (blank line) between headers and body;
+ (setq body-start (search-forward "\n\n" nil t))
+ (narrow-to-region beg (point))
+ (goto-char beg)
+ (save-excursion
+ (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
+ (setq coding-system (intern (match-string 1)))
+ (setq coding-system (rmail-get-coding-system))))
+ (setq character-coding (mail-fetch-field "content-transfer-encoding")
+ is-text-message (rmail-is-text-p))
+ (if character-coding
+ (setq character-coding (downcase character-coding)))
+ (narrow-to-region beg end)
+ ;; Decode the message body into an empty view buffer using a
+ ;; unibyte temporary buffer where the character decoding takes
+ ;; place.
+ (with-current-buffer rmail-view-buffer
+ (erase-buffer))
+ (if (null character-coding)
+ ;; Do it directly since that is fast.
+ (rmail-decode-region body-start end coding-system view-buf)
+ ;; Can this be done directly, skipping the temp buffer?
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-buffer-substring mbox-buf body-start end)
+ (cond
+ ((string= character-coding "quoted-printable")
+ ;; See bug#5441.
+ (or (mail-unquote-printable-region (point-min) (point-max)
+ nil t 'unibyte)
+ (message "Malformed MIME quoted-printable message")))
+ ((and (string= character-coding "base64") is-text-message)
+ (condition-case err
+ (base64-decode-region (point-min) (point-max))
+ (error (message "%s" (cdr err)))))
+ ((eq character-coding 'uuencode)
+ (error "uuencoded messages are not supported yet"))
+ (t))
+ (rmail-decode-region (point-min) (point-max)
+ coding-system view-buf)))
+ (with-current-buffer rmail-view-buffer
+ ;; Prepare the separator (blank line) before the body.
+ (goto-char (point-min))
+ (insert "\n")
+ ;; Unquote quoted From lines
+ (while (re-search-forward "^>+From " nil t)
+ (beginning-of-line)
+ (delete-char 1)
+ (forward-line))
+ (goto-char (point-min)))
+ ;; Copy the headers to the front of the message view buffer.
+ (rmail-copy-headers beg end))
;; highlight the message, activate any URL like text and add
;; special highlighting for and quoted material.
(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)
@@ -4290,18 +4287,28 @@
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el"
"222ca7c1e672a08e5799e5a72fb25049")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el"
"faa9e26c7781c426785e671a040128ad")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
-Process the current Rmail message as a MIME message.
-This creates a temporary \"*RMAIL*\" buffer holding a decoded
-copy of the message. Inline content-types are handled according to
+Toggle displaying of a MIME message.
+
+The actualy behavior depends on the value of `rmail-enable-mime'.
+
+If `rmail-enable-mime' is t (default), this command change the
+displaying of a MIME message between decoded presentation form
+and raw data.
+
+With ARG, toggle the displaying of the current MIME entity only.
+
+If `rmail-enable-mime' is nil, this creates a temporary
+\"*RMAIL*\" buffer holding a decoded 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'.
-\(fn)" t nil)
+\(fn &optional ARG)" t nil)
;;;***
=== modified file 'lisp/mail/rmailmm.el'
--- a/lisp/mail/rmailmm.el 2010-11-29 12:22:39 +0000
+++ b/lisp/mail/rmailmm.el 2010-12-24 04:38:22 +0000
@@ -96,7 +96,9 @@
The remaining elements are handler functions to run, in order of
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'."
+all others are handled by `rmail-mime-bulk-handler'.
+Note also that this alist is ignored when the variable
+`rmail-enable-mime' is non-nil."
:type '(alist :key-type regexp :value-type (repeat function))
:version "23.1"
:group 'rmail-mime)
@@ -130,18 +132,36 @@
;;; End of user options.
+;;; Global variables that always have let-binding when referred.
+
+(defvar rmail-mime-mbox-buffer nil
+ "Buffer containing the mbox data.
+The value is usually nil, and bound to a proper value while
+processing MIME.")
+
+(defvar rmail-mime-view-buffer nil
+ "Buffer showing a message.
+The value is usually nil, and bound to a proper value while
+processing MIME.")
+
+(defvar rmail-mime-coding-system nil
+ "The first coding-system used for decoding a MIME entity.
+The value is usually nil, and bound to non-nil while inserting
+MIME entities.")
+
;;; 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 ]
+ display header tagline body children handler)
+ "Retrun a newly created MIME-entity object from arguments.
+
+A MIME-entity is a vector of 9 elements:
+
+ [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
+ CHILDREN HANDLER]
-TYPE and DISPOSITION correspond to MIME headers Content-Type: and
-Cotent-Disposition: respectively, and has this format:
+TYPE and DISPOSITION correspond to MIME headers Content-Type and
+Cotent-Disposition respectively, and has this format:
\(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
@@ -160,31 +180,61 @@
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))
+DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
+the header, tagline, and body of the entity are displayed now,
+and NEW indicates how their displaying should be updated.
+Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
+where each element is a symbol for the corresponding item that
+has these values:
+ nil: not displayed
+ t: displayed by the decoded presentation form
+ raw: displayed by the raw MIME data (for the header and body only)
+
+HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
+END specify the region of the header or body lines in RMAIL's
+data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
+header or body is, by default, displayed by the decoded
+presentation form.
+
+TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
+string indicating the depth and index number of the entity,
+BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
+an attached data, DISPLAY-FLAG non-nil means that the tagline is,
+by default, displayed.
+
+CHILDREN is a list of child MIME-entities. A \"multipart/*\"
+entity have one or more children. A \"message/rfc822\" entity
+has just one child. Any other entity has no child.
+
+HANDLER is a function to insert the entity according to DISPLAY.
+It is called with one argument ENTITY."
+ (vector type disposition transfer-encoding
+ display header tagline body children handler))
;; 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))
+(defsubst rmail-mime-entity-display (entity) (aref entity 3))
+(defsubst rmail-mime-entity-header (entity) (aref entity 4))
+(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
+(defsubst rmail-mime-entity-body (entity) (aref entity 6))
+(defsubst rmail-mime-entity-children (entity) (aref entity 7))
+(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
+
+(defsubst rmail-mime-message-p ()
+ "Non-nil if and only if the current message is a MIME."
+ (or (get-text-property (point) 'rmail-mime-entity)
+ (get-text-property (point-min) 'rmail-mime-entity)))
;;; Buttons
(defun rmail-mime-save (button)
"Save the attachment using info in the BUTTON."
- (let* ((filename (button-get button 'filename))
+ (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (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)
@@ -209,7 +259,8 @@
;; 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))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
(cond ((string= transfer-encoding "base64")
(ignore-errors (base64-decode-region (point-min) (point-max))))
((string= transfer-encoding "quoted-printable")
@@ -218,34 +269,293 @@
(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
+(defun rmail-mime-entity-segment (pos &optional entity)
+ "Return a vector describing the displayed region of a MIME-entity at POS.
+Optional 2nd argument ENTITY is the MIME-entity at POS.
+The value is a vector [ INDEX HEADER TAGLINE BODY END], where
+ HEADER: the position of the beginning of a header
+ TAGLINE: the position of the beginning of a tagline
+ BODY: the position of the beginning of a body
+ END: the position of the end of the entity.
+ INDEX: index into the returned vector indicating where POS is."
+ (save-excursion
+ (or entity
+ (setq entity (get-text-property pos 'rmail-mime-entity)))
+ (if (not entity)
+ (vector 1 (point) (point) (point) (point))
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (beg (if (and (> pos (point-min))
+ (eq (get-text-property (1- pos) 'rmail-mime-entity)
+ entity))
+ (previous-single-property-change pos 'rmail-mime-entity
+ nil (point-min))
+ pos))
+ (index 1)
+ tagline-beg body-beg end)
+ (goto-char beg)
+ (if (aref current 0)
+ (search-forward "\n\n" nil t))
+ (setq tagline-beg (point))
+ (if (>= pos tagline-beg)
+ (setq index 2))
+ (if (aref current 1)
+ (forward-line 1))
+ (setq body-beg (point))
+ (if (>= pos body-beg)
+ (setq index 3))
+ (if (aref current 2)
+ (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
+ tag2)
+ (setq end (next-single-property-change beg 'rmail-mime-entity
+ nil (point-max)))
+ (while (and (< end (point-max))
+ (setq entity (get-text-property end
'rmail-mime-entity)
+ tag2 (aref (rmail-mime-entity-tagline entity)
0))
+ (and (> (length tag2) 0)
+ (eq (string-match tag tag2) 0)))
+ (setq end (next-single-property-change end 'rmail-mime-entity
+ nil (point-max)))))
+ (setq end body-beg))
+ (vector index beg tagline-beg body-beg end)))))
+
+(defun rmail-mime-next-item ()
+ "Move point to the next displayed item of the current MIME entity.
+A MIME entity has three items; header, tagline, and body.
+If we are in the last item of the entity, move point to the first
+item of the next entity. If we reach the end of buffer, move
+point to the first item of the first entity (i.e. the beginning
+of buffer)."
+ (interactive)
+ (if (rmail-mime-message-p)
+ (let* ((segment (rmail-mime-entity-segment (point)))
+ (next-pos (aref segment (1+ (aref segment 0))))
+ (button (next-button (point))))
+ (goto-char (if (and button (< (button-start button) next-pos))
+ (button-start button)
+ next-pos))
+ (if (eobp)
+ (goto-char (point-min))))))
+
+(defun rmail-mime-previous-item ()
+ "Move point to the previous displayed item of the current MIME message.
+A MIME entity has three items; header, tagline, and body.
+If we are at the beginning of the first item of the entity, move
+point to the last item of the previous entity. If we reach the
+beginning of buffer, move point to the last item of the last
+entity."
+ (interactive)
+ (when (rmail-mime-message-p)
+ (if (bobp)
+ (goto-char (point-max)))
+ (let* ((segment (rmail-mime-entity-segment (1- (point))))
+ (prev-pos (aref segment (aref segment 0)))
+ (button (previous-button (point))))
+ (goto-char (if (and button (> (button-start button) prev-pos))
+ (button-start button)
+ prev-pos)))))
+
+(defun rmail-mime-shown-mode (entity)
+ "Make MIME-entity ENTITY displayed by the default way."
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 (aref (rmail-mime-entity-header entity) 2))
+ (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
+ (aset new 2 (aref (rmail-mime-entity-body entity) 2))))
+
+(defun rmail-mime-hidden-mode (entity top)
+ "Make MIME-entity ENTITY displayed in the hidden mode.
+If TOP is non-nil, display ENTITY only by the tagline.
+Otherwise, don't display ENTITY."
+ (if top
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 nil)
+ (aset new 1 top)
+ (aset new 2 nil)
+ (aset (rmail-mime-entity-body entity) 2 nil))
+ (let ((current (aref (rmail-mime-entity-display entity) 0)))
+ (aset current 0 nil)
+ (aset current 1 nil)
+ (aset current 2 nil)))
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-hidden-mode child nil)))
+
+(defun rmail-mime-raw-mode (entity)
+ "Make MIME-entity ENTITY displayed in the raw mode."
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 'raw)
+ (aset new 1 nil)
+ (aset new 2 'raw)
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-hidden-mode child nil))))
+
+(defun rmail-mime-toggle-raw (entity)
+ "Toggle on and off the raw display mode of MIME-entity ENTITY."
+ (let* ((pos (if (eobp) (1- (point-max)) (point)))
+ (entity (get-text-property pos 'rmail-mime-entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (segment (rmail-mime-entity-segment pos entity)))
+ (if (not (eq (aref current 0) 'raw))
+ ;; Enter the raw mode.
+ (rmail-mime-raw-mode entity)
+ ;; Enter the shown mode.
+ (rmail-mime-shown-mode entity))
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p)))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified)))))
+
+(defun rmail-mime-toggle-hidden ()
+ "Toggle on and off the hidden display mode of MIME-entity ENTITY."
+ (interactive)
+ (when (rmail-mime-message-p)
+ (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer (current-buffer))
+ (pos (if (eobp) (1- (point-max)) (point)))
+ (entity (get-text-property pos 'rmail-mime-entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (segment (rmail-mime-entity-segment pos entity)))
+ (if (aref current 2)
+ ;; Enter the hidden mode.
+ (progn
+ ;; If point is in the body part, move it to the tagline
+ ;; (or the header if headline is not displayed).
+ (if (= (aref segment 0) 3)
+ (goto-char (aref segment 2)))
+ (rmail-mime-hidden-mode entity t)
+ ;; If the current entity is the topmost one, display the
+ ;; header.
+ (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
+ (let ((new (aref (rmail-mime-entity-display entity) 1)))
+ (aset new 0 t))))
+ ;; Enter the shown mode.
+ (aset (rmail-mime-entity-body entity) 2 t)
+ (rmail-mime-shown-mode entity))
+ (let ((inhibit-read-only t)
+ (modified (buffer-modified-p))
+ (rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer))
+ (save-excursion
+ (goto-char (aref segment 1))
+ (rmail-mime-insert entity)
+ (restore-buffer-modified-p modified))))))
+
+(define-key rmail-mode-map "\t" 'rmail-mime-next-item)
+(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
+(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
+
;;; Handlers
+(defun rmail-mime-insert-tagline (entity &rest item-list)
+ "Insert a tag line for MIME-entity ENTITY.
+ITEM-LIST is a list of strings or button-elements (list) to be added
+to the tag line."
+ (insert "[")
+ (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
+ (if (> (length tag) 0) (insert (substring tag 1) ":")))
+ (insert (car (rmail-mime-entity-type entity)))
+ (dolist (item item-list)
+ (when item
+ (if (stringp item)
+ (insert item)
+ (apply 'insert-button item))))
+ (insert "]\n"))
+
+(defun rmail-mime-insert-header (header)
+ "Decode and insert a MIME-entity header HEADER in the current buffer.
+HEADER is a vector [BEG END DEFAULT-STATUS].
+See `rmail-mime-entity' for the detail."
+ (let ((pos (point))
+ (last-coding-system-used nil))
+ (save-restriction
+ (narrow-to-region pos pos)
+ (with-current-buffer rmail-mime-mbox-buffer
+ (let ((rmail-buffer rmail-mime-mbox-buffer)
+ (rmail-view-buffer rmail-mime-view-buffer))
+ (save-excursion
+ (goto-char (aref header 0))
+ (rmail-copy-headers (point) (aref header 1)))))
+ (rfc2047-decode-region pos (point))
+ (if (and last-coding-system-used (not rmail-mime-coding-system))
+ (setq rmail-mime-coding-system last-coding-system-used))
+ (goto-char (point-min))
+ (rmail-highlight-headers)
+ (goto-char (point-max))
+ (insert "\n"))))
+
(defun rmail-mime-text-handler (content-type
content-disposition
content-transfer-encoding)
"Handle the current buffer as a plain text MIME part."
- (let* ((charset (cdr (assq 'charset (cdr content-type))))
- (coding-system (when charset
- (intern (downcase charset)))))
- (when (coding-system-p coding-system)
- (decode-coding-region (point-min) (point-max) coding-system))))
+ (rmail-mime-insert-text
+ (rmail-mime-entity content-type content-disposition
+ content-transfer-encoding
+ (vector (vector nil nil nil) (vector nil nil t))
+ (vector nil nil nil) (vector "" (cons nil nil) t)
+ (vector nil nil nil) nil 'rmail-mime-insert-text))
+ t)
+
+(defun rmail-mime-insert-decoded-text (entity)
+ "Decode and insert the text body of MIME-entity ENTITY."
+ (let* ((content-type (rmail-mime-entity-type entity))
+ (charset (cdr (assq 'charset (cdr content-type))))
+ (coding-system (if charset
+ (coding-system-from-name charset)))
+ (body (rmail-mime-entity-body entity))
+ (pos (point)))
+ (or (and coding-system (coding-system-p coding-system))
+ (setq coding-system 'undecided))
+ (if (stringp (aref body 0))
+ (insert (aref body 0))
+ (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
+ (cond ((string= transfer-encoding "base64")
+ (ignore-errors (base64-decode-region pos (point))))
+ ((string= transfer-encoding "quoted-printable")
+ (quoted-printable-decode-region pos (point))))))
+ (decode-coding-region pos (point) coding-system)
+ (or rmail-mime-coding-system
+ (setq rmail-mime-coding-system coding-system))
+ (or (bolp) (insert "\n"))))
(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)))))
+ "Presentation handler for a plain text MIME entity."
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+
+ (or (integerp (aref body 0))
+ (let ((data (buffer-string)))
+ (aset body 0 data)
+ (delete-region (point-min) (point-max))))
+
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline entity)))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (rmail-mime-insert-decoded-text entity)))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
;; FIXME move to the test/ directory?
(defun test-rmail-mime-handler ()
@@ -264,35 +574,35 @@
(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))
+(defun rmail-mime-insert-image (entity)
+ "Decode and insert the image body of MIME-entity ENTITY."
+ (let* ((content-type (car (rmail-mime-entity-type entity)))
+ (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
+ (body (rmail-mime-entity-body entity))
+ data)
+ (if (stringp (aref body 0))
+ (setq data (aref body 0))
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-undo-list t)
- (insert-buffer-substring mbox-buffer (car body) (cdr body))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1))
(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)))
+ (insert-image (create-image data (cdr bulk-data) t))
+ (insert "\n")))
(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))))
+ (save-excursion
+ (goto-char (button-end button))
+ (rmail-mime-toggle-hidden)))
(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
@@ -305,15 +615,60 @@
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)))
+ (vector (vector nil nil nil) (vector nil t nil))
+ (vector nil nil nil) (vector "" (cons nil nil) t)
+ (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
+
+(defun rmail-mime-set-bulk-data (entity)
+ "Setup the information about the attachment object for MIME-entity ENTITY.
+The value is non-nil if and only if the attachment object should be shown
+directly."
+ (let ((content-type (car (rmail-mime-entity-type entity)))
+ (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
+ (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
+ (body (rmail-mime-entity-body entity))
+ size type to-show)
+ (cond (size
+ (setq size (string-to-number size)))
+ ((stringp (aref body 0))
+ (setq size (length (aref body 0))))
+ (t
+ ;; Rough estimation of the size.
+ (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
+ (setq size (- (aref body 1) (aref body 0)))
+ (cond ((string= encoding "base64")
+ (setq size (/ (* size 3) 4)))
+ ((string= encoding "quoted-printable")
+ (setq size (/ (* size 7) 3)))))))
+
+ (cond
+ ((string-match "text/" content-type)
+ (setq type 'text))
+ ((string-match "image/\\(.*\\)" content-type)
+ (setq type (image-type-from-file-name
+ (concat "." (match-string 1 content-type))))
+ (if (and (memq type image-types)
+ (image-type-available-p type))
+ (if (and rmail-mime-show-images
+ (not (eq rmail-mime-show-images 'button))
+ (or (not (numberp rmail-mime-show-images))
+ (< size rmail-mime-show-images)))
+ (setq to-show t))
+ (setq type nil))))
+ (setcar bulk-data size)
+ (setcdr bulk-data type)
+ to-show))
(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."
+ "Presentation handler for an attachment MIME entity."
;; Find the default directory for this media type.
(let* ((content-type (rmail-mime-entity-type entity))
(content-disposition (rmail-mime-entity-disposition entity))
+ (current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (bulk-data (aref tagline 1))
(body (rmail-mime-entity-body entity))
(directory (catch 'directory
(dolist (entry rmail-mime-attachment-dirs-alist)
@@ -324,47 +679,70 @@
(filename (or (cdr (assq 'name (cdr content-type)))
(cdr (assq 'filename (cdr content-disposition)))
"noname"))
- (label (format "\nAttached %s file: " (car content-type)))
(units '(B kB MB GB))
- data udata size osize type)
- (if body
+ (segment (rmail-mime-entity-segment (point) entity))
+ beg data size)
+
+ (if (integerp (aref body 0))
(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)
+ size (car bulk-data))
+ (if (stringp (aref body 0))
+ (setq data (aref body 0))
+ (setq data (string-as-unibyte (buffer-string)))
+ (aset body 0 data)
+ (rmail-mime-set-bulk-data entity)
+ (delete-region (point-min) (point-max)))
+ (setq size (length data)))
(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)
- (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))))))
+
+ (setq beg (point))
+
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline
+ entity
+ " file:"
+ (list filename
+ :type 'rmail-mime-save
+ 'help-echo "mouse-2, RET: Save attachment"
+ 'filename filename
+ 'directory (file-name-as-directory directory)
+ 'data data)
+ (format " (%.0f%s)" size (car units))
+ (if (cdr bulk-data)
+ " ")
+ (if (cdr bulk-data)
+ (list "Toggle show/hide"
+ :type 'rmail-mime-image
+ 'help-echo "mouse-2, RET: Toggle show/hide"
+ 'image-type (cdr bulk-data)
+ 'image-data data)))))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (cond ((eq (cdr bulk-data) 'text)
+ (rmail-mime-insert-decoded-text entity))
+ ((cdr bulk-data)
+ (rmail-mime-insert-image entity)))))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
(defun test-rmail-mime-bulk-handler ()
"Test of a mail used as an example in RFC 2183."
@@ -396,19 +774,21 @@
of the respective parsed headers. See `rmail-mime-handle' for their
format."
(rmail-mime-process-multipart
- content-type content-disposition content-transfer-encoding nil))
+ content-type content-disposition content-transfer-encoding nil)
+ t)
(defun rmail-mime-process-multipart (content-type
content-disposition
content-transfer-encoding
- parse-only)
+ parse-tag)
"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.
+If PARSE-TAG 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.
+Otherwise, PARSE-TAG is a string indicating the depth and index
+number of the entity. In this case, 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
@@ -419,6 +799,8 @@
;; of the preceding part.
;; We currently don't handle that.
(let ((boundary (cdr (assq 'boundary content-type)))
+ (subtype (cadr (split-string (car content-type) "/")))
+ (index 0)
beg end next entities)
(unless boundary
(rmail-mm-get-boundary-error-message
@@ -429,12 +811,20 @@
(goto-char (point-min))
(when (and (search-forward boundary nil t)
(looking-at "[ \t]*\n"))
- (if parse-only
+ (if parse-tag
(narrow-to-region (match-end 0) (point-max))
(delete-region (point-min) (match-end 0))))
+
+ ;; Change content-type to the proper default one for the children.
+ (cond ((string-match "mixed" subtype)
+ (setq content-type '("text/plain")))
+ ((string-match "digest" subtype)
+ (setq content-type '("message/rfc822"))))
+
;; 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.
+ ;; the beginning of the next part. The current point is just
+ ;; after the boundary tag.
(setq beg (point-min))
(while (search-forward boundary nil t)
(setq end (match-beginning 0))
@@ -449,17 +839,46 @@
(rmail-mm-get-boundary-error-message
"Malformed boundary" content-type content-disposition
content-transfer-encoding)))
+
+ (setq index (1+ index))
;; Handle the part.
- (if parse-only
+ (if parse-tag
(save-restriction
(narrow-to-region beg end)
- (setq entities (cons (rmail-mime-process nil t) entities)))
+ (let ((child (rmail-mime-process
+ nil (format "%s/%d" parse-tag index)
+ content-type content-disposition)))
+ ;; Display a tagline.
+ (aset (aref (rmail-mime-entity-display child) 1) 1
+ (aset (rmail-mime-entity-tagline child) 2 t))
+ (push child entities)))
+
(delete-region end next)
(save-restriction
(narrow-to-region beg end)
(rmail-mime-show)))
(goto-char (setq beg next)))
- (nreverse entities)))
+
+ (when parse-tag
+ (setq entities (nreverse entities))
+ (if (string-match "alternative" subtype)
+ ;; Find the best entity to show, and hide all the others.
+ (let (best second)
+ (dolist (child entities)
+ (if (string= (or (car (rmail-mime-entity-disposition child))
+ (car content-disposition))
+ "inline")
+ (if (string-match "text/plain"
+ (car (rmail-mime-entity-type child)))
+ (setq best child)
+ (if (string-match "text/.*"
+ (car (rmail-mime-entity-type child)))
+ (setq second child)))))
+ (or best (not second) (setq best second))
+ (dolist (child entities)
+ (or (eq best child)
+ (rmail-mime-hidden-mode child t)))))
+ entities)))
(defun test-rmail-mime-multipart-handler ()
"Test of a mail used as an example in RFC 2046."
@@ -492,6 +911,40 @@
(insert mail)
(rmail-mime-show t)))
+(defun rmail-mime-insert-multipart (entity)
+ "Presentation handler for a multipart MIME entity."
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1))
+ (header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (if (aref new 0)
+ (rmail-mime-insert-header header)))
+ ;; tagline
+ (if (eq (aref current 1) (aref new 1))
+ (forward-char (- (aref segment 3) (aref segment 2)))
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ (if (aref new 1)
+ (rmail-mime-insert-tagline entity)))
+
+ (put-text-property beg (point) 'rmail-mime-entity entity)
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (if (aref new 2)
+ (dolist (child (rmail-mime-entity-children entity))
+ (rmail-mime-insert child))))))
+
;;; Main code
(defun rmail-mime-handle (content-type
@@ -564,7 +1017,9 @@
modified."
(rmail-mime-process show-headers nil))
-(defun rmail-mime-process (show-headers parse-only)
+(defun rmail-mime-process (show-headers parse-tag &optional
+ default-content-type
+ default-content-disposition)
(let ((end (point-min))
content-type
content-transfer-encoding
@@ -595,45 +1050,76 @@
(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")))
+ (or default-content-type '("text/plain"))))
(setq content-disposition
(if content-disposition
(mail-header-parse-content-disposition content-disposition)
;; If none specified, we are free to choose what we deem
;; suitable according to RFC 2183. We like inline.
- '("inline")))
+ (or default-content-disposition '("inline"))))
;; Unrecognized disposition types are to be treated like
;; attachment according to RFC 2183.
(unless (member (car content-disposition) '("inline" "attachment"))
(setq content-disposition '("attachment")))
- (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))))
+ (if parse-tag
+ (let* ((is-inline (string= (car content-disposition) "inline"))
+ (header (vector (point-min) end nil))
+ (tagline (vector parse-tag (cons nil nil) t))
+ (body (vector end (point-max) is-inline))
+ (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
+ children handler entity)
+ (cond ((string-match "multipart/.*" (car content-type))
+ (save-restriction
+ (narrow-to-region (1- end) (point-max))
+ (setq children (rmail-mime-process-multipart
+ content-type
+ content-disposition
+ content-transfer-encoding
+ parse-tag)
+ handler 'rmail-mime-insert-multipart)))
+ ((string-match "message/rfc822" (car content-type))
+ (save-restriction
(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)))
+ (let* ((msg (rmail-mime-process t parse-tag
+ '("text/plain") '("inline")))
+ (msg-new (aref (rmail-mime-entity-display msg) 1)))
+ ;; Show header of the child.
+ (aset msg-new 0 t)
+ (aset (rmail-mime-entity-header msg) 2 t)
+ ;; Hide tagline of the child.
+ (aset msg-new 1 nil)
+ (aset (rmail-mime-entity-tagline msg) 2 nil)
+ (setq children (list msg)
+ handler 'rmail-mime-insert-multipart))))
+ ((and is-inline (string-match "text/" (car content-type)))
+ ;; Don't need a tagline.
+ (aset new 1 (aset tagline 2 nil))
+ (setq handler 'rmail-mime-insert-text))
+ (t
+ ;; Force hidden mode.
+ (aset new 1 (aset tagline 2 t))
+ (aset new 2 (aset body 2 nil))
+ (setq handler 'rmail-mime-insert-bulk)))
+ (setq entity (rmail-mime-entity content-type
+ content-disposition
+ content-transfer-encoding
+ (vector (vector nil nil nil) new)
+ header tagline body children handler))
+ (if (and (eq handler 'rmail-mime-insert-bulk)
+ (rmail-mime-set-bulk-data entity))
+ ;; Show the body.
+ (aset new 2 (aset body 2 t)))
+ entity)
+
;; Hide headers and handle the part.
+ (put-text-property (point-min) (point-max) 'rmail-mime-entity
+ (rmail-mime-entity
+ content-type content-disposition
+ content-transfer-encoding
+ (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
+ (vector nil nil 'raw) (vector "" (cons nil nil) nil)
+ (vector nil nil 'raw) nil nil))
(save-restriction
(cond ((string= (car content-type) "message/rfc822")
(narrow-to-region end (point-max)))
@@ -642,102 +1128,117 @@
(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 of them.
- (dolist (child children)
- (rmail-mime-insert 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))
- (condition-case nil
- (rmail-mime-process nil t)
- (error nil))))
+The value is a MIME-entiy object (see `rmail-mime-entity')."
+ (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
+ rmail-view-buffer
+ (current-buffer))))
+ ;;(condition-case err
+ (with-current-buffer rmail-mime-mbox-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let* ((entity (rmail-mime-process t ""
+ '("text/plain") '("inline")))
+ (new (aref (rmail-mime-entity-display entity) 1)))
+ ;; Show header.
+ (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
+ ;; Show tagline if and only if body is not shown.
+ (if (aref new 2)
+ (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
+ (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
+ entity)))
+ ;;(error (error (format "%s" err))))
+ ))
-(defun rmail-mime-insert (entity &optional content-type disposition)
+(defun rmail-mime-insert (entity)
"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))))
+ (let ((current (aref (rmail-mime-entity-display entity) 0))
+ (new (aref (rmail-mime-entity-display entity) 1)))
+ (if (not (eq (aref new 0) 'raw))
+ ;; Not a raw-mode. Each handler should handle it.
+ (funcall (rmail-mime-entity-handler entity) entity)
+ (let ((header (rmail-mime-entity-header entity))
+ (tagline (rmail-mime-entity-tagline entity))
+ (body (rmail-mime-entity-body entity))
+ (beg (point))
+ (segment (rmail-mime-entity-segment (point) entity)))
+ ;; header
+ (if (eq (aref current 0) (aref new 0))
+ (goto-char (aref segment 2))
+ (if (aref current 0)
+ (delete-char (- (aref segment 2) (aref segment 1))))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref header 0) (aref header 1)))
+ ;; tagline
+ (if (aref current 1)
+ (delete-char (- (aref segment 3) (aref segment 2))))
+ ;; body
+ (if (eq (aref current 2) (aref new 2))
+ (forward-char (- (aref segment 4) (aref segment 3)))
+ (if (aref current 2)
+ (delete-char (- (aref segment 4) (aref segment 3))))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (aref body 0) (aref body 1)))
+ (put-text-property beg (point) 'rmail-mime-entity entity)))
+ (dotimes (i 3)
+ (aset current i (aref new i)))))
(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. Inline content-types are handled according to
+(defun rmail-mime (&optional arg)
+ "Toggle displaying of a MIME message.
+
+The actualy behavior depends on the value of `rmail-enable-mime'.
+
+If `rmail-enable-mime' is t (default), this command change the
+displaying of a MIME message between decoded presentation form
+and raw data.
+
+With ARG, toggle the displaying of the current MIME entity only.
+
+If `rmail-enable-mime' is nil, this creates a temporary
+\"*RMAIL*\" buffer holding a decoded 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'."
- (interactive)
- (let ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
- (buf (get-buffer-create "*RMAIL*")))
- (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)))
+ (interactive "P")
+ (if rmail-enable-mime
+ (if (rmail-mime-message-p)
+ (let ((rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer rmail-buffer)
+ (entity (get-text-property (point) 'rmail-mime-entity)))
+ (if arg
+ (if entity
+ (rmail-mime-toggle-raw entity))
+ (goto-char (point-min))
+ (rmail-mime-toggle-raw
+ (get-text-property (point) 'rmail-mime-entity))))
+ (message "Not a MIME message"))
+ (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
+ (buf (get-buffer-create "*RMAIL*"))
+ (rmail-mime-mbox-buffer rmail-view-buffer)
+ (rmail-mime-view-buffer buf))
+ (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))))
(defun rmail-mm-get-boundary-error-message (message type disposition encoding)
"Return MESSAGE with more information on the main mime components."
@@ -746,34 +1247,39 @@
(defun rmail-show-mime ()
"Function to set in `rmail-show-mime-function' (which see)."
- (let ((mbox-buf rmail-buffer)
- (entity (rmail-mime-parse)))
+ (let ((entity (rmail-mime-parse))
+ (rmail-mime-mbox-buffer rmail-buffer)
+ (rmail-mime-view-buffer rmail-view-buffer)
+ (rmail-mime-coding-system nil))
(if entity
- (with-current-buffer rmail-view-buffer
- (let ((inhibit-read-only t)
- (rmail-buffer mbox-buf))
- (erase-buffer)
- (rmail-mime-insert entity)))
+ (with-current-buffer rmail-mime-view-buffer
+ (erase-buffer)
+ (rmail-mime-insert entity)
+ (if rmail-mime-coding-system
+ (set-buffer-file-coding-system rmail-mime-coding-system t t)))
;; Decoding failed. Insert the original message body as is.
- (let ((region (with-current-buffer mbox-buf
+ (let ((region (with-current-buffer rmail-mime-mbox-buffer
(goto-char (point-min))
(re-search-forward "^$" nil t)
(forward-line 1)
(cons (point) (point-max)))))
- (with-current-buffer rmail-view-buffer
+ (with-current-buffer rmail-mime-view-buffer
(let ((inhibit-read-only t))
(erase-buffer)
- (insert-buffer-substring mbox-buf (car region) (cdr region))))
+ (insert-buffer-substring rmail-mime-mbox-buffer
+ (car region) (cdr region))))
+ (set-buffer-file-coding-system 'no-conversion t t)
(message "MIME decoding failed")))))
(setq rmail-show-mime-function 'rmail-show-mime)
(defun rmail-insert-mime-forwarded-message (forward-buffer)
"Function to set in `rmail-insert-mime-forwarded-message-function' (which
see)."
- (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer)))
+ (let ((rmail-mime-mbox-buffer
+ (with-current-buffer forward-buffer rmail-view-buffer)))
(save-restriction
(narrow-to-region (point) (point))
- (message-forward-make-body-mime mbox-buf))))
+ (message-forward-make-body-mime rmail-mime-mbox-buffer))))
(setq rmail-insert-mime-forwarded-message-function
'rmail-insert-mime-forwarded-message)
@@ -794,15 +1300,16 @@
"Function to set in `rmail-search-mime-message-function' (which see)."
(save-restriction
(narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
- (let ((mbox-buf (current-buffer))
- (header-end (save-excursion
- (re-search-forward "^$" nil 'move) (point)))
- (body-end (point-max))
- (entity (rmail-mime-parse)))
+ (let* ((rmail-mime-mbox-buffer (current-buffer))
+ (rmail-mime-view-buffer rmail-view-buffer)
+ (header-end (save-excursion
+ (re-search-forward "^$" nil 'move) (point)))
+ (body-end (point-max))
+ (entity (rmail-mime-parse)))
(or
;; At first, just search the headers.
(with-temp-buffer
- (insert-buffer-substring mbox-buf nil header-end)
+ (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
(rfc2047-decode-region (point-min) (point))
(goto-char (point-min))
(re-search-forward regexp nil t))
@@ -815,8 +1322,7 @@
(not (string= (downcase charset) "us-ascii"))))))
;; Search the decoded MIME message.
(with-temp-buffer
- (let ((rmail-buffer mbox-buf))
- (rmail-mime-insert entity))
+ (rmail-mime-insert entity)
(goto-char (point-min))
(re-search-forward regexp nil t))
;; Search the body without decoding.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/emacs-23 r100323: Enable display mode of MIME message in rmail.,
Kenichi Handa <=