aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2010-12-24 13:38:22 +0900
committerKenichi Handa2010-12-24 13:38:22 +0900
commit186f7f0b7f48751df956707de5476e63ca4c1dbe (patch)
treed6d4a58a62dba7bcad84319902189080fb6452d0
parente1a235757a06328c5262c19e37e89428b32571ae (diff)
downloademacs-186f7f0b7f48751df956707de5476e63ca4c1dbe.tar.gz
emacs-186f7f0b7f48751df956707de5476e63ca4c1dbe.zip
Enable display mode of MIME message in rmail.
-rw-r--r--etc/NEWS21
-rw-r--r--lisp/ChangeLog43
-rw-r--r--lisp/mail/rmail.el137
-rw-r--r--lisp/mail/rmailmm.el980
4 files changed, 879 insertions, 302 deletions
diff --git a/etc/NEWS b/etc/NEWS
index ebc1f0afc9e..1bf17eff7a1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -72,6 +72,27 @@ Bazaar recognizes the headers "Author", "Date" and "Fixes".
72Git, Mercurial, and Monotone recognize "Author" and "Date". 72Git, Mercurial, and Monotone recognize "Author" and "Date".
73Any unknown header is left as is in the message, so it is not lost. 73Any unknown header is left as is in the message, so it is not lost.
74 74
75** Rmail
76
77** The default value of `rmail-enable-mime' is now t. Rmail decodes
78MIME contents automatically. You can customize the variable
79`rmail-enable-mime' back to `nil' to disable this automatic MIME
80decoding.
81
82** The command `rmail-mime' change the displaying of a MIME message
83between decoded presentation form and raw data if `rmail-enable-mime'
84is non-nil. And, with prefix argument, it change only the displaying
85of the MIME entity at point.
86
87** The new command TAB (rmail-mime-next-item) moves point to the next
88item of MIME message.
89
90** The new command backtab (rmail-mime-previous-item) moves point to
91the previous item of MIME message.
92
93** The new command RET (rmail-mime-toggle-hidden) hide or show the
94body of the MIME entity at point.
95
75** Obsolete packages 96** Obsolete packages
76 97
77+++ 98+++
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dcdfa3ebc88..ee6848449c7 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,46 @@
12010-12-24 Kenichi Handa <handa@m17n.org>
2
3 * mail/rmailmm.el: New key bindings for rmail-mime-next-item,
4 rmail-mime-previous-item, and rmail-mime-toggle-hidden.
5 (rmail-mime-mbox-buffer)
6 (rmail-mime-view-buffer, rmail-mime-coding-system): New variables.
7 (rmail-mime-entity): Argument changed. All codes handling an
8 entity object are changed.
9 (rmail-mime-entity-header, rmail-mime-entity-body): Adjusted for
10 the above change.
11 (rmail-mime-entity-children, rmail-mime-entity-handler)
12 (rmail-mime-entity-tagline): New functions.
13 (rmail-mime-message-p): New function.
14 (rmail-mime-save): Bind rmail-mime-mbox-buffer.
15 (rmail-mime-entity-segment, rmail-mime-next-item)
16 (rmail-mime-previous-item, rmail-mime-shown-mode)
17 (rmail-mime-hidden-mode, rmail-mime-raw-mode)
18 (rmail-mime-toggle-raw, rmail-mime-toggle-hidden)
19 (rmail-mime-insert-tagline, rmail-mime-insert-header): New
20 functions.
21 (rmail-mime-text-handler): Call rmail-mime-insert-text.
22 (rmail-mime-insert-decoded-text): New function.
23 (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text.
24 (rmail-mime-insert-image): Argument changed. Caller changed.
25 (rmail-mime-image): Call rmail-mime-toggle-hidden.
26 (rmail-mime-set-bulk-data): New funciton.
27 (rmail-mime-insert-bulk): Argument changed.
28 (rmail-mime-multipart-handler): Return t.
29 (rmail-mime-process-multipart): Argument changed. Handle
30 "multipart/alternative" here.
31 (rmail-mime-process): Argument changed.
32 (rmail-mime-parse): Bind rmail-mime-mbox-buffer.
33 (rmail-mime-insert): Argument changed. Handle raw display mode.
34 (rmail-mime): Argument changed. Handle toggling of raw display
35 mode.
36 (rmail-show-mime): Bind rmail-mime-mbox-buffer and
37 rmail-mime-view-buffer.
38 (rmail-insert-mime-forwarded-message): Likewise.
39 (rmail-search-mime-message): Likewise. Don't bind rmail-buffer.
40
41 * mail/rmail.el (rmail-show-message-1): If rmail-enable-mime is
42 non-nil, handle the header in rmail-show-mime-function.
43
12010-12-20 Leo <sdl.web@gmail.com> 442010-12-20 Leo <sdl.web@gmail.com>
2 45
3 * help-fns.el (describe-variable): Fix 2010-12-17 change. 46 * help-fns.el (describe-variable): Fix 2010-12-17 change.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 3f5660e82cb..af09e5468a4 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -2691,75 +2691,72 @@ The current mail message becomes the message displayed."
2691 (message "Showing message %d" msg)) 2691 (message "Showing message %d" msg))
2692 (narrow-to-region beg end) 2692 (narrow-to-region beg end)
2693 (goto-char beg) 2693 (goto-char beg)
2694 (if (and rmail-enable-mime
2695 (re-search-forward "mime-version: 1.0" nil t))
2696 (let ((rmail-buffer mbox-buf)
2697 (rmail-view-buffer view-buf))
2698 (funcall rmail-show-mime-function))
2699 (setq body-start (search-forward "\n\n" nil t))
2700 (narrow-to-region beg (point))
2701 (goto-char beg)
2702 (save-excursion
2703 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2704 (setq coding-system (intern (match-string 1)))
2705 (setq coding-system (rmail-get-coding-system))))
2706 (setq character-coding (mail-fetch-field "content-transfer-encoding")
2707 is-text-message (rmail-is-text-p))
2708 (if character-coding
2709 (setq character-coding (downcase character-coding)))
2710 (narrow-to-region beg end)
2711 ;; Decode the message body into an empty view buffer using a
2712 ;; unibyte temporary buffer where the character decoding takes
2713 ;; place.
2714 (with-current-buffer rmail-view-buffer
2715 (erase-buffer))
2716 (if (null character-coding)
2717 ;; Do it directly since that is fast.
2718 (rmail-decode-region body-start end coding-system view-buf)
2719 ;; Can this be done directly, skipping the temp buffer?
2720 (with-temp-buffer
2721 (set-buffer-multibyte nil)
2722 (insert-buffer-substring mbox-buf body-start end)
2723 (cond
2724 ((string= character-coding "quoted-printable")
2725 ;; See bug#5441.
2726 (or (mail-unquote-printable-region (point-min) (point-max)
2727 nil t 'unibyte)
2728 (message "Malformed MIME quoted-printable message")))
2729 ((and (string= character-coding "base64") is-text-message)
2730 (condition-case err
2731 (base64-decode-region (point-min) (point-max))
2732 (error (message "%s" (cdr err)))))
2733 ((eq character-coding 'uuencode)
2734 (error "uuencoded messages are not supported yet"))
2735 (t))
2736 (rmail-decode-region (point-min) (point-max)
2737 coding-system view-buf))))
2738 (with-current-buffer rmail-view-buffer 2694 (with-current-buffer rmail-view-buffer
2739 ;; We give the view buffer a buffer-local value of 2695 ;; We give the view buffer a buffer-local value of
2740 ;; rmail-header-style based on the binding in effect when 2696 ;; rmail-header-style based on the binding in effect when
2741 ;; this function is called; `rmail-toggle-headers' can 2697 ;; this function is called; `rmail-toggle-headers' can
2742 ;; inspect this value to determine how to toggle. 2698 ;; inspect this value to determine how to toggle.
2743 (set (make-local-variable 'rmail-header-style) header-style) 2699 (set (make-local-variable 'rmail-header-style) header-style))
2744 ;; Unquote quoted From lines 2700 (if (and rmail-enable-mime
2745 (goto-char (point-min)) 2701 (re-search-forward "mime-version: 1.0" nil t))
2746 (while (re-search-forward "^>+From " nil t) 2702 (let ((rmail-buffer mbox-buf)
2747 (beginning-of-line) 2703 (rmail-view-buffer view-buf))
2748 (delete-char 1) 2704 (funcall rmail-show-mime-function))
2749 (forward-line)) 2705 (setq body-start (search-forward "\n\n" nil t))
2750 (goto-char (point-min))) 2706 (narrow-to-region beg (point))
2751 ;; Copy the headers to the front of the message view buffer. 2707 (goto-char beg)
2752 (rmail-copy-headers beg end) 2708 (save-excursion
2753 ;; Add the separator (blank line) between headers and body; 2709 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2710 (setq coding-system (intern (match-string 1)))
2711 (setq coding-system (rmail-get-coding-system))))
2712 (setq character-coding (mail-fetch-field "content-transfer-encoding")
2713 is-text-message (rmail-is-text-p))
2714 (if character-coding
2715 (setq character-coding (downcase character-coding)))
2716 (narrow-to-region beg end)
2717 ;; Decode the message body into an empty view buffer using a
2718 ;; unibyte temporary buffer where the character decoding takes
2719 ;; place.
2720 (with-current-buffer rmail-view-buffer
2721 (erase-buffer))
2722 (if (null character-coding)
2723 ;; Do it directly since that is fast.
2724 (rmail-decode-region body-start end coding-system view-buf)
2725 ;; Can this be done directly, skipping the temp buffer?
2726 (with-temp-buffer
2727 (set-buffer-multibyte nil)
2728 (insert-buffer-substring mbox-buf body-start end)
2729 (cond
2730 ((string= character-coding "quoted-printable")
2731 ;; See bug#5441.
2732 (or (mail-unquote-printable-region (point-min) (point-max)
2733 nil t 'unibyte)
2734 (message "Malformed MIME quoted-printable message")))
2735 ((and (string= character-coding "base64") is-text-message)
2736 (condition-case err
2737 (base64-decode-region (point-min) (point-max))
2738 (error (message "%s" (cdr err)))))
2739 ((eq character-coding 'uuencode)
2740 (error "uuencoded messages are not supported yet"))
2741 (t))
2742 (rmail-decode-region (point-min) (point-max)
2743 coding-system view-buf)))
2744 (with-current-buffer rmail-view-buffer
2745 ;; Prepare the separator (blank line) before the body.
2746 (goto-char (point-min))
2747 (insert "\n")
2748 ;; Unquote quoted From lines
2749 (while (re-search-forward "^>+From " nil t)
2750 (beginning-of-line)
2751 (delete-char 1)
2752 (forward-line))
2753 (goto-char (point-min)))
2754 ;; Copy the headers to the front of the message view buffer.
2755 (rmail-copy-headers beg end))
2754 ;; highlight the message, activate any URL like text and add 2756 ;; highlight the message, activate any URL like text and add
2755 ;; special highlighting for and quoted material. 2757 ;; special highlighting for and quoted material.
2756 (with-current-buffer rmail-view-buffer 2758 (with-current-buffer rmail-view-buffer
2757 (insert "\n")
2758 (goto-char (point-min)) 2759 (goto-char (point-min))
2759 ;; Decode the headers according to RFC2047.
2760 (save-excursion
2761 (search-forward "\n\n" nil 'move)
2762 (rfc2047-decode-region (point-min) (point)))
2763 (rmail-highlight-headers) 2760 (rmail-highlight-headers)
2764 ;(rmail-activate-urls) 2761 ;(rmail-activate-urls)
2765 ;(rmail-process-quoted-material) 2762 ;(rmail-process-quoted-material)
@@ -4290,18 +4287,28 @@ With prefix argument N moves forward N messages with these labels.
4290 4287
4291;;;*** 4288;;;***
4292 4289
4293;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "222ca7c1e672a08e5799e5a72fb25049") 4290;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "faa9e26c7781c426785e671a040128ad")
4294;;; Generated autoloads from rmailmm.el 4291;;; Generated autoloads from rmailmm.el
4295 4292
4296(autoload 'rmail-mime "rmailmm" "\ 4293(autoload 'rmail-mime "rmailmm" "\
4297Process the current Rmail message as a MIME message. 4294Toggle displaying of a MIME message.
4298This creates a temporary \"*RMAIL*\" buffer holding a decoded 4295
4299copy of the message. Inline content-types are handled according to 4296The actualy behavior depends on the value of `rmail-enable-mime'.
4297
4298If `rmail-enable-mime' is t (default), this command change the
4299displaying of a MIME message between decoded presentation form
4300and raw data.
4301
4302With ARG, toggle the displaying of the current MIME entity only.
4303
4304If `rmail-enable-mime' is nil, this creates a temporary
4305\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
4306content-types are handled according to
4300`rmail-mime-media-type-handlers-alist'. By default, this 4307`rmail-mime-media-type-handlers-alist'. By default, this
4301displays text and multipart messages, and offers to download 4308displays text and multipart messages, and offers to download
4302attachments as specfied by `rmail-mime-attachment-dirs-alist'. 4309attachments as specfied by `rmail-mime-attachment-dirs-alist'.
4303 4310
4304\(fn)" t nil) 4311\(fn &optional ARG)" t nil)
4305 4312
4306;;;*** 4313;;;***
4307 4314
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 1cd765cbf9f..5733945d5f2 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -96,7 +96,9 @@ The first item is a regular expression matching a content-type.
96The remaining elements are handler functions to run, in order of 96The remaining elements are handler functions to run, in order of
97decreasing preference. These are called until one returns non-nil. 97decreasing preference. These are called until one returns non-nil.
98Note that this only applies to items with an inline Content-Disposition, 98Note that this only applies to items with an inline Content-Disposition,
99all others are handled by `rmail-mime-bulk-handler'." 99all others are handled by `rmail-mime-bulk-handler'.
100Note also that this alist is ignored when the variable
101`rmail-enable-mime' is non-nil."
100 :type '(alist :key-type regexp :value-type (repeat function)) 102 :type '(alist :key-type regexp :value-type (repeat function))
101 :version "23.1" 103 :version "23.1"
102 :group 'rmail-mime) 104 :group 'rmail-mime)
@@ -130,18 +132,36 @@ automatically display the image in the buffer."
130 132
131;;; End of user options. 133;;; End of user options.
132 134
135;;; Global variables that always have let-binding when referred.
136
137(defvar rmail-mime-mbox-buffer nil
138 "Buffer containing the mbox data.
139The value is usually nil, and bound to a proper value while
140processing MIME.")
141
142(defvar rmail-mime-view-buffer nil
143 "Buffer showing a message.
144The value is usually nil, and bound to a proper value while
145processing MIME.")
146
147(defvar rmail-mime-coding-system nil
148 "The first coding-system used for decoding a MIME entity.
149The value is usually nil, and bound to non-nil while inserting
150MIME entities.")
151
133;;; MIME-entity object 152;;; MIME-entity object
134 153
135(defun rmail-mime-entity (type disposition transfer-encoding 154(defun rmail-mime-entity (type disposition transfer-encoding
136 header body children) 155 display header tagline body children handler)
137 "Retrun a newly created MIME-entity object. 156 "Retrun a newly created MIME-entity object from arguments.
138 157
139A MIME-entity is a vector of 6 elements: 158A MIME-entity is a vector of 9 elements:
140 159
141 [ TYPE DISPOSITION TRANSFER-ENCODING HEADER BODY CHILDREN ] 160 [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
161 CHILDREN HANDLER]
142 162
143TYPE and DISPOSITION correspond to MIME headers Content-Type: and 163TYPE and DISPOSITION correspond to MIME headers Content-Type and
144Cotent-Disposition: respectively, and has this format: 164Cotent-Disposition respectively, and has this format:
145 165
146 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...) 166 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
147 167
@@ -160,31 +180,61 @@ The corresponding TYPE argument must be:
160TRANSFER-ENCODING corresponds to MIME header 180TRANSFER-ENCODING corresponds to MIME header
161Content-Transfer-Encoding, and is a lowercased string. 181Content-Transfer-Encoding, and is a lowercased string.
162 182
163HEADER and BODY are a cons (BEG . END), where BEG and END specify 183DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
164the region of the corresponding part in RMAIL's data (mbox) 184the header, tagline, and body of the entity are displayed now,
165buffer. BODY may be nil. In that case, the current buffer is 185and NEW indicates how their displaying should be updated.
166narrowed to the body part. 186Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
167 187where each element is a symbol for the corresponding item that
168CHILDREN is a list of MIME-entities for a \"multipart\" entity, and 188has these values:
169nil for the other types." 189 nil: not displayed
170 (vector type disposition transfer-encoding header body children)) 190 t: displayed by the decoded presentation form
191 raw: displayed by the raw MIME data (for the header and body only)
192
193HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
194END specify the region of the header or body lines in RMAIL's
195data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
196header or body is, by default, displayed by the decoded
197presentation form.
198
199TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
200string indicating the depth and index number of the entity,
201BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
202an attached data, DISPLAY-FLAG non-nil means that the tagline is,
203by default, displayed.
204
205CHILDREN is a list of child MIME-entities. A \"multipart/*\"
206entity have one or more children. A \"message/rfc822\" entity
207has just one child. Any other entity has no child.
208
209HANDLER is a function to insert the entity according to DISPLAY.
210It is called with one argument ENTITY."
211 (vector type disposition transfer-encoding
212 display header tagline body children handler))
171 213
172;; Accessors for a MIME-entity object. 214;; Accessors for a MIME-entity object.
173(defsubst rmail-mime-entity-type (entity) (aref entity 0)) 215(defsubst rmail-mime-entity-type (entity) (aref entity 0))
174(defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) 216(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
175(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) 217(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
176(defsubst rmail-mime-entity-header (entity) (aref entity 3)) 218(defsubst rmail-mime-entity-display (entity) (aref entity 3))
177(defsubst rmail-mime-entity-body (entity) (aref entity 4)) 219(defsubst rmail-mime-entity-header (entity) (aref entity 4))
178(defsubst rmail-mime-entity-children (entity) (aref entity 5)) 220(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
221(defsubst rmail-mime-entity-body (entity) (aref entity 6))
222(defsubst rmail-mime-entity-children (entity) (aref entity 7))
223(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
224
225(defsubst rmail-mime-message-p ()
226 "Non-nil if and only if the current message is a MIME."
227 (or (get-text-property (point) 'rmail-mime-entity)
228 (get-text-property (point-min) 'rmail-mime-entity)))
179 229
180;;; Buttons 230;;; Buttons
181 231
182(defun rmail-mime-save (button) 232(defun rmail-mime-save (button)
183 "Save the attachment using info in the BUTTON." 233 "Save the attachment using info in the BUTTON."
184 (let* ((filename (button-get button 'filename)) 234 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
235 (filename (button-get button 'filename))
185 (directory (button-get button 'directory)) 236 (directory (button-get button 'directory))
186 (data (button-get button 'data)) 237 (data (button-get button 'data))
187 (mbox-buf rmail-view-buffer)
188 (ofilename filename)) 238 (ofilename filename))
189 (setq filename (expand-file-name 239 (setq filename (expand-file-name
190 (read-file-name (format "Save as (default: %s): " filename) 240 (read-file-name (format "Save as (default: %s): " filename)
@@ -209,7 +259,8 @@ nil for the other types."
209 ;; DATA is a MIME-entity object. 259 ;; DATA is a MIME-entity object.
210 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) 260 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
211 (body (rmail-mime-entity-body data))) 261 (body (rmail-mime-entity-body data)))
212 (insert-buffer-substring mbox-buf (car body) (cdr body)) 262 (insert-buffer-substring rmail-mime-mbox-buffer
263 (aref body 0) (aref body 1))
213 (cond ((string= transfer-encoding "base64") 264 (cond ((string= transfer-encoding "base64")
214 (ignore-errors (base64-decode-region (point-min) (point-max)))) 265 (ignore-errors (base64-decode-region (point-min) (point-max))))
215 ((string= transfer-encoding "quoted-printable") 266 ((string= transfer-encoding "quoted-printable")
@@ -218,34 +269,293 @@ nil for the other types."
218 269
219(define-button-type 'rmail-mime-save 'action 'rmail-mime-save) 270(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
220 271
272(defun rmail-mime-entity-segment (pos &optional entity)
273 "Return a vector describing the displayed region of a MIME-entity at POS.
274Optional 2nd argument ENTITY is the MIME-entity at POS.
275The value is a vector [ INDEX HEADER TAGLINE BODY END], where
276 HEADER: the position of the beginning of a header
277 TAGLINE: the position of the beginning of a tagline
278 BODY: the position of the beginning of a body
279 END: the position of the end of the entity.
280 INDEX: index into the returned vector indicating where POS is."
281 (save-excursion
282 (or entity
283 (setq entity (get-text-property pos 'rmail-mime-entity)))
284 (if (not entity)
285 (vector 1 (point) (point) (point) (point))
286 (let ((current (aref (rmail-mime-entity-display entity) 0))
287 (beg (if (and (> pos (point-min))
288 (eq (get-text-property (1- pos) 'rmail-mime-entity)
289 entity))
290 (previous-single-property-change pos 'rmail-mime-entity
291 nil (point-min))
292 pos))
293 (index 1)
294 tagline-beg body-beg end)
295 (goto-char beg)
296 (if (aref current 0)
297 (search-forward "\n\n" nil t))
298 (setq tagline-beg (point))
299 (if (>= pos tagline-beg)
300 (setq index 2))
301 (if (aref current 1)
302 (forward-line 1))
303 (setq body-beg (point))
304 (if (>= pos body-beg)
305 (setq index 3))
306 (if (aref current 2)
307 (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
308 tag2)
309 (setq end (next-single-property-change beg 'rmail-mime-entity
310 nil (point-max)))
311 (while (and (< end (point-max))
312 (setq entity (get-text-property end 'rmail-mime-entity)
313 tag2 (aref (rmail-mime-entity-tagline entity) 0))
314 (and (> (length tag2) 0)
315 (eq (string-match tag tag2) 0)))
316 (setq end (next-single-property-change end 'rmail-mime-entity
317 nil (point-max)))))
318 (setq end body-beg))
319 (vector index beg tagline-beg body-beg end)))))
320
321(defun rmail-mime-next-item ()
322 "Move point to the next displayed item of the current MIME entity.
323A MIME entity has three items; header, tagline, and body.
324If we are in the last item of the entity, move point to the first
325item of the next entity. If we reach the end of buffer, move
326point to the first item of the first entity (i.e. the beginning
327of buffer)."
328 (interactive)
329 (if (rmail-mime-message-p)
330 (let* ((segment (rmail-mime-entity-segment (point)))
331 (next-pos (aref segment (1+ (aref segment 0))))
332 (button (next-button (point))))
333 (goto-char (if (and button (< (button-start button) next-pos))
334 (button-start button)
335 next-pos))
336 (if (eobp)
337 (goto-char (point-min))))))
338
339(defun rmail-mime-previous-item ()
340 "Move point to the previous displayed item of the current MIME message.
341A MIME entity has three items; header, tagline, and body.
342If we are at the beginning of the first item of the entity, move
343point to the last item of the previous entity. If we reach the
344beginning of buffer, move point to the last item of the last
345entity."
346 (interactive)
347 (when (rmail-mime-message-p)
348 (if (bobp)
349 (goto-char (point-max)))
350 (let* ((segment (rmail-mime-entity-segment (1- (point))))
351 (prev-pos (aref segment (aref segment 0)))
352 (button (previous-button (point))))
353 (goto-char (if (and button (> (button-start button) prev-pos))
354 (button-start button)
355 prev-pos)))))
356
357(defun rmail-mime-shown-mode (entity)
358 "Make MIME-entity ENTITY displayed by the default way."
359 (let ((new (aref (rmail-mime-entity-display entity) 1)))
360 (aset new 0 (aref (rmail-mime-entity-header entity) 2))
361 (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
362 (aset new 2 (aref (rmail-mime-entity-body entity) 2))))
363
364(defun rmail-mime-hidden-mode (entity top)
365 "Make MIME-entity ENTITY displayed in the hidden mode.
366If TOP is non-nil, display ENTITY only by the tagline.
367Otherwise, don't display ENTITY."
368 (if top
369 (let ((new (aref (rmail-mime-entity-display entity) 1)))
370 (aset new 0 nil)
371 (aset new 1 top)
372 (aset new 2 nil)
373 (aset (rmail-mime-entity-body entity) 2 nil))
374 (let ((current (aref (rmail-mime-entity-display entity) 0)))
375 (aset current 0 nil)
376 (aset current 1 nil)
377 (aset current 2 nil)))
378 (dolist (child (rmail-mime-entity-children entity))
379 (rmail-mime-hidden-mode child nil)))
380
381(defun rmail-mime-raw-mode (entity)
382 "Make MIME-entity ENTITY displayed in the raw mode."
383 (let ((new (aref (rmail-mime-entity-display entity) 1)))
384 (aset new 0 'raw)
385 (aset new 1 nil)
386 (aset new 2 'raw)
387 (dolist (child (rmail-mime-entity-children entity))
388 (rmail-mime-hidden-mode child nil))))
389
390(defun rmail-mime-toggle-raw (entity)
391 "Toggle on and off the raw display mode of MIME-entity ENTITY."
392 (let* ((pos (if (eobp) (1- (point-max)) (point)))
393 (entity (get-text-property pos 'rmail-mime-entity))
394 (current (aref (rmail-mime-entity-display entity) 0))
395 (segment (rmail-mime-entity-segment pos entity)))
396 (if (not (eq (aref current 0) 'raw))
397 ;; Enter the raw mode.
398 (rmail-mime-raw-mode entity)
399 ;; Enter the shown mode.
400 (rmail-mime-shown-mode entity))
401 (let ((inhibit-read-only t)
402 (modified (buffer-modified-p)))
403 (save-excursion
404 (goto-char (aref segment 1))
405 (rmail-mime-insert entity)
406 (restore-buffer-modified-p modified)))))
407
408(defun rmail-mime-toggle-hidden ()
409 "Toggle on and off the hidden display mode of MIME-entity ENTITY."
410 (interactive)
411 (when (rmail-mime-message-p)
412 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
413 (rmail-mime-view-buffer (current-buffer))
414 (pos (if (eobp) (1- (point-max)) (point)))
415 (entity (get-text-property pos 'rmail-mime-entity))
416 (current (aref (rmail-mime-entity-display entity) 0))
417 (segment (rmail-mime-entity-segment pos entity)))
418 (if (aref current 2)
419 ;; Enter the hidden mode.
420 (progn
421 ;; If point is in the body part, move it to the tagline
422 ;; (or the header if headline is not displayed).
423 (if (= (aref segment 0) 3)
424 (goto-char (aref segment 2)))
425 (rmail-mime-hidden-mode entity t)
426 ;; If the current entity is the topmost one, display the
427 ;; header.
428 (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
429 (let ((new (aref (rmail-mime-entity-display entity) 1)))
430 (aset new 0 t))))
431 ;; Enter the shown mode.
432 (aset (rmail-mime-entity-body entity) 2 t)
433 (rmail-mime-shown-mode entity))
434 (let ((inhibit-read-only t)
435 (modified (buffer-modified-p))
436 (rmail-mime-mbox-buffer rmail-view-buffer)
437 (rmail-mime-view-buffer rmail-buffer))
438 (save-excursion
439 (goto-char (aref segment 1))
440 (rmail-mime-insert entity)
441 (restore-buffer-modified-p modified))))))
442
443(define-key rmail-mode-map "\t" 'rmail-mime-next-item)
444(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
445(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
446
221;;; Handlers 447;;; Handlers
222 448
449(defun rmail-mime-insert-tagline (entity &rest item-list)
450 "Insert a tag line for MIME-entity ENTITY.
451ITEM-LIST is a list of strings or button-elements (list) to be added
452to the tag line."
453 (insert "[")
454 (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
455 (if (> (length tag) 0) (insert (substring tag 1) ":")))
456 (insert (car (rmail-mime-entity-type entity)))
457 (dolist (item item-list)
458 (when item
459 (if (stringp item)
460 (insert item)
461 (apply 'insert-button item))))
462 (insert "]\n"))
463
464(defun rmail-mime-insert-header (header)
465 "Decode and insert a MIME-entity header HEADER in the current buffer.
466HEADER is a vector [BEG END DEFAULT-STATUS].
467See `rmail-mime-entity' for the detail."
468 (let ((pos (point))
469 (last-coding-system-used nil))
470 (save-restriction
471 (narrow-to-region pos pos)
472 (with-current-buffer rmail-mime-mbox-buffer
473 (let ((rmail-buffer rmail-mime-mbox-buffer)
474 (rmail-view-buffer rmail-mime-view-buffer))
475 (save-excursion
476 (goto-char (aref header 0))
477 (rmail-copy-headers (point) (aref header 1)))))
478 (rfc2047-decode-region pos (point))
479 (if (and last-coding-system-used (not rmail-mime-coding-system))
480 (setq rmail-mime-coding-system last-coding-system-used))
481 (goto-char (point-min))
482 (rmail-highlight-headers)
483 (goto-char (point-max))
484 (insert "\n"))))
485
223(defun rmail-mime-text-handler (content-type 486(defun rmail-mime-text-handler (content-type
224 content-disposition 487 content-disposition
225 content-transfer-encoding) 488 content-transfer-encoding)
226 "Handle the current buffer as a plain text MIME part." 489 "Handle the current buffer as a plain text MIME part."
227 (let* ((charset (cdr (assq 'charset (cdr content-type)))) 490 (rmail-mime-insert-text
228 (coding-system (when charset 491 (rmail-mime-entity content-type content-disposition
229 (intern (downcase charset))))) 492 content-transfer-encoding
230 (when (coding-system-p coding-system) 493 (vector (vector nil nil nil) (vector nil nil t))
231 (decode-coding-region (point-min) (point-max) coding-system)))) 494 (vector nil nil nil) (vector "" (cons nil nil) t)
232 495 (vector nil nil nil) nil 'rmail-mime-insert-text))
233(defun rmail-mime-insert-text (entity) 496 t)
234 "Insert MIME-entity ENTITY as a plain text MIME part in the current buffer." 497
498(defun rmail-mime-insert-decoded-text (entity)
499 "Decode and insert the text body of MIME-entity ENTITY."
235 (let* ((content-type (rmail-mime-entity-type entity)) 500 (let* ((content-type (rmail-mime-entity-type entity))
236 (charset (cdr (assq 'charset (cdr content-type)))) 501 (charset (cdr (assq 'charset (cdr content-type))))
237 (coding-system (if charset (intern (downcase charset)))) 502 (coding-system (if charset
238 (transfer-encoding (rmail-mime-entity-transfer-encoding entity)) 503 (coding-system-from-name charset)))
239 (body (rmail-mime-entity-body entity))) 504 (body (rmail-mime-entity-body entity))
240 (save-restriction 505 (pos (point)))
241 (narrow-to-region (point) (point)) 506 (or (and coding-system (coding-system-p coding-system))
242 (insert-buffer-substring rmail-buffer (car body) (cdr body)) 507 (setq coding-system 'undecided))
243 (cond ((string= transfer-encoding "base64") 508 (if (stringp (aref body 0))
244 (ignore-errors (base64-decode-region (point-min) (point-max)))) 509 (insert (aref body 0))
245 ((string= transfer-encoding "quoted-printable") 510 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
246 (quoted-printable-decode-region (point-min) (point-max)))) 511 (insert-buffer-substring rmail-mime-mbox-buffer
247 (if (coding-system-p coding-system) 512 (aref body 0) (aref body 1))
248 (decode-coding-region (point-min) (point-max) coding-system))))) 513 (cond ((string= transfer-encoding "base64")
514 (ignore-errors (base64-decode-region pos (point))))
515 ((string= transfer-encoding "quoted-printable")
516 (quoted-printable-decode-region pos (point))))))
517 (decode-coding-region pos (point) coding-system)
518 (or rmail-mime-coding-system
519 (setq rmail-mime-coding-system coding-system))
520 (or (bolp) (insert "\n"))))
521
522(defun rmail-mime-insert-text (entity)
523 "Presentation handler for a plain text MIME entity."
524 (let ((current (aref (rmail-mime-entity-display entity) 0))
525 (new (aref (rmail-mime-entity-display entity) 1))
526 (header (rmail-mime-entity-header entity))
527 (tagline (rmail-mime-entity-tagline entity))
528 (body (rmail-mime-entity-body entity))
529 (beg (point))
530 (segment (rmail-mime-entity-segment (point) entity)))
531
532 (or (integerp (aref body 0))
533 (let ((data (buffer-string)))
534 (aset body 0 data)
535 (delete-region (point-min) (point-max))))
536
537 ;; header
538 (if (eq (aref current 0) (aref new 0))
539 (goto-char (aref segment 2))
540 (if (aref current 0)
541 (delete-char (- (aref segment 2) (aref segment 1))))
542 (if (aref new 0)
543 (rmail-mime-insert-header header)))
544 ;; tagline
545 (if (eq (aref current 1) (aref new 1))
546 (forward-char (- (aref segment 3) (aref segment 2)))
547 (if (aref current 1)
548 (delete-char (- (aref segment 3) (aref segment 2))))
549 (if (aref new 1)
550 (rmail-mime-insert-tagline entity)))
551 ;; body
552 (if (eq (aref current 2) (aref new 2))
553 (forward-char (- (aref segment 4) (aref segment 3)))
554 (if (aref current 2)
555 (delete-char (- (aref segment 4) (aref segment 3))))
556 (if (aref new 2)
557 (rmail-mime-insert-decoded-text entity)))
558 (put-text-property beg (point) 'rmail-mime-entity entity)))
249 559
250;; FIXME move to the test/ directory? 560;; FIXME move to the test/ directory?
251(defun test-rmail-mime-handler () 561(defun test-rmail-mime-handler ()
@@ -264,35 +574,35 @@ MIME-Version: 1.0
264 (set-buffer-multibyte t))) 574 (set-buffer-multibyte t)))
265 575
266 576
267(defun rmail-mime-insert-image (type data) 577(defun rmail-mime-insert-image (entity)
268 "Insert an image of type TYPE, where DATA is the image data. 578 "Decode and insert the image body of MIME-entity ENTITY."
269If DATA is not a string, it is a MIME-entity object." 579 (let* ((content-type (car (rmail-mime-entity-type entity)))
270 (end-of-line) 580 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
271 (let ((modified (buffer-modified-p))) 581 (body (rmail-mime-entity-body entity))
272 (insert ?\n) 582 data)
273 (unless (stringp data) 583 (if (stringp (aref body 0))
274 ;; DATA is a MIME-entity. 584 (setq data (aref body 0))
275 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data)) 585 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
276 (body (rmail-mime-entity-body data)) 586 (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
277 (mbox-buffer rmail-view-buffer))
278 (with-temp-buffer 587 (with-temp-buffer
279 (set-buffer-multibyte nil) 588 (set-buffer-multibyte nil)
280 (setq buffer-undo-list t) 589 (setq buffer-undo-list t)
281 (insert-buffer-substring mbox-buffer (car body) (cdr body)) 590 (insert-buffer-substring rmail-mime-mbox-buffer
591 (aref body 0) (aref body 1))
282 (cond ((string= transfer-encoding "base64") 592 (cond ((string= transfer-encoding "base64")
283 (ignore-errors (base64-decode-region (point-min) (point-max)))) 593 (ignore-errors (base64-decode-region (point-min) (point-max))))
284 ((string= transfer-encoding "quoted-printable") 594 ((string= transfer-encoding "quoted-printable")
285 (quoted-printable-decode-region (point-min) (point-max)))) 595 (quoted-printable-decode-region (point-min) (point-max))))
286 (setq data 596 (setq data
287 (buffer-substring-no-properties (point-min) (point-max)))))) 597 (buffer-substring-no-properties (point-min) (point-max))))))
288 (insert-image (create-image data type t)) 598 (insert-image (create-image data (cdr bulk-data) t))
289 (set-buffer-modified-p modified))) 599 (insert "\n")))
290 600
291(defun rmail-mime-image (button) 601(defun rmail-mime-image (button)
292 "Display the image associated with BUTTON." 602 "Display the image associated with BUTTON."
293 (let ((inhibit-read-only t)) 603 (save-excursion
294 (rmail-mime-insert-image (button-get button 'image-type) 604 (goto-char (button-end button))
295 (button-get button 'image-data)))) 605 (rmail-mime-toggle-hidden)))
296 606
297(define-button-type 'rmail-mime-image 'action 'rmail-mime-image) 607(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
298 608
@@ -305,15 +615,60 @@ For images that Emacs is capable of displaying, the behavior
305depends upon the value of `rmail-mime-show-images'." 615depends upon the value of `rmail-mime-show-images'."
306 (rmail-mime-insert-bulk 616 (rmail-mime-insert-bulk
307 (rmail-mime-entity content-type content-disposition content-transfer-encoding 617 (rmail-mime-entity content-type content-disposition content-transfer-encoding
308 nil nil nil))) 618 (vector (vector nil nil nil) (vector nil t nil))
619 (vector nil nil nil) (vector "" (cons nil nil) t)
620 (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
621
622(defun rmail-mime-set-bulk-data (entity)
623 "Setup the information about the attachment object for MIME-entity ENTITY.
624The value is non-nil if and only if the attachment object should be shown
625directly."
626 (let ((content-type (car (rmail-mime-entity-type entity)))
627 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
628 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
629 (body (rmail-mime-entity-body entity))
630 size type to-show)
631 (cond (size
632 (setq size (string-to-number size)))
633 ((stringp (aref body 0))
634 (setq size (length (aref body 0))))
635 (t
636 ;; Rough estimation of the size.
637 (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
638 (setq size (- (aref body 1) (aref body 0)))
639 (cond ((string= encoding "base64")
640 (setq size (/ (* size 3) 4)))
641 ((string= encoding "quoted-printable")
642 (setq size (/ (* size 7) 3)))))))
643
644 (cond
645 ((string-match "text/" content-type)
646 (setq type 'text))
647 ((string-match "image/\\(.*\\)" content-type)
648 (setq type (image-type-from-file-name
649 (concat "." (match-string 1 content-type))))
650 (if (and (memq type image-types)
651 (image-type-available-p type))
652 (if (and rmail-mime-show-images
653 (not (eq rmail-mime-show-images 'button))
654 (or (not (numberp rmail-mime-show-images))
655 (< size rmail-mime-show-images)))
656 (setq to-show t))
657 (setq type nil))))
658 (setcar bulk-data size)
659 (setcdr bulk-data type)
660 to-show))
309 661
310(defun rmail-mime-insert-bulk (entity) 662(defun rmail-mime-insert-bulk (entity)
311 "Inesrt a MIME-entity ENTITY as an attachment. 663 "Presentation handler for an attachment MIME entity."
312The optional second arg DATA, if non-nil, is a string containing
313the attachment data that is already decoded."
314 ;; Find the default directory for this media type. 664 ;; Find the default directory for this media type.
315 (let* ((content-type (rmail-mime-entity-type entity)) 665 (let* ((content-type (rmail-mime-entity-type entity))
316 (content-disposition (rmail-mime-entity-disposition entity)) 666 (content-disposition (rmail-mime-entity-disposition entity))
667 (current (aref (rmail-mime-entity-display entity) 0))
668 (new (aref (rmail-mime-entity-display entity) 1))
669 (header (rmail-mime-entity-header entity))
670 (tagline (rmail-mime-entity-tagline entity))
671 (bulk-data (aref tagline 1))
317 (body (rmail-mime-entity-body entity)) 672 (body (rmail-mime-entity-body entity))
318 (directory (catch 'directory 673 (directory (catch 'directory
319 (dolist (entry rmail-mime-attachment-dirs-alist) 674 (dolist (entry rmail-mime-attachment-dirs-alist)
@@ -324,47 +679,70 @@ the attachment data that is already decoded."
324 (filename (or (cdr (assq 'name (cdr content-type))) 679 (filename (or (cdr (assq 'name (cdr content-type)))
325 (cdr (assq 'filename (cdr content-disposition))) 680 (cdr (assq 'filename (cdr content-disposition)))
326 "noname")) 681 "noname"))
327 (label (format "\nAttached %s file: " (car content-type)))
328 (units '(B kB MB GB)) 682 (units '(B kB MB GB))
329 data udata size osize type) 683 (segment (rmail-mime-entity-segment (point) entity))
330 (if body 684 beg data size)
685
686 (if (integerp (aref body 0))
331 (setq data entity 687 (setq data entity
332 udata entity 688 size (car bulk-data))
333 size (- (cdr body) (car body))) 689 (if (stringp (aref body 0))
334 (setq data (buffer-string) 690 (setq data (aref body 0))
335 udata (string-as-unibyte data) 691 (setq data (string-as-unibyte (buffer-string)))
336 size (length udata)) 692 (aset body 0 data)
337 (delete-region (point-min) (point-max))) 693 (rmail-mime-set-bulk-data entity)
338 (setq osize size) 694 (delete-region (point-min) (point-max)))
695 (setq size (length data)))
339 (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message 696 (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
340 (cdr units)) 697 (cdr units))
341 (setq size (/ size 1024.0) 698 (setq size (/ size 1024.0)
342 units (cdr units))) 699 units (cdr units)))
343 (insert label) 700
344 (insert-button filename 701 (setq beg (point))
345 :type 'rmail-mime-save 702
346 'help-echo "mouse-2, RET: Save attachment" 703 ;; header
347 'filename filename 704 (if (eq (aref current 0) (aref new 0))
348 'directory (file-name-as-directory directory) 705 (goto-char (aref segment 2))
349 'data data) 706 (if (aref current 0)
350 (insert (format " (%.0f%s)" size (car units))) 707 (delete-char (- (aref segment 2) (aref segment 1))))
351 (when (and rmail-mime-show-images 708 (if (aref new 0)
352 (string-match "image/\\(.*\\)" (setq type (car content-type))) 709 (rmail-mime-insert-header header)))
353 (setq type (concat "." (match-string 1 type)) 710
354 type (image-type-from-file-name type)) 711 ;; tagline
355 (memq type image-types) 712 (if (eq (aref current 1) (aref new 1))
356 (image-type-available-p type)) 713 (forward-char (- (aref segment 3) (aref segment 2)))
357 (insert " ") 714 (if (aref current 1)
358 (cond ((or (eq rmail-mime-show-images 'button) 715 (delete-char (- (aref segment 3) (aref segment 2))))
359 (and (numberp rmail-mime-show-images) 716 (if (aref new 1)
360 (>= osize rmail-mime-show-images))) 717 (rmail-mime-insert-tagline
361 (insert-button "Display" 718 entity
362 :type 'rmail-mime-image 719 " file:"
363 'help-echo "mouse-2, RET: Show image" 720 (list filename
364 'image-type type 721 :type 'rmail-mime-save
365 'image-data udata)) 722 'help-echo "mouse-2, RET: Save attachment"
366 (t 723 'filename filename
367 (rmail-mime-insert-image type udata)))))) 724 'directory (file-name-as-directory directory)
725 'data data)
726 (format " (%.0f%s)" size (car units))
727 (if (cdr bulk-data)
728 " ")
729 (if (cdr bulk-data)
730 (list "Toggle show/hide"
731 :type 'rmail-mime-image
732 'help-echo "mouse-2, RET: Toggle show/hide"
733 'image-type (cdr bulk-data)
734 'image-data data)))))
735 ;; body
736 (if (eq (aref current 2) (aref new 2))
737 (forward-char (- (aref segment 4) (aref segment 3)))
738 (if (aref current 2)
739 (delete-char (- (aref segment 4) (aref segment 3))))
740 (if (aref new 2)
741 (cond ((eq (cdr bulk-data) 'text)
742 (rmail-mime-insert-decoded-text entity))
743 ((cdr bulk-data)
744 (rmail-mime-insert-image entity)))))
745 (put-text-property beg (point) 'rmail-mime-entity entity)))
368 746
369(defun test-rmail-mime-bulk-handler () 747(defun test-rmail-mime-bulk-handler ()
370 "Test of a mail used as an example in RFC 2183." 748 "Test of a mail used as an example in RFC 2183."
@@ -396,19 +774,21 @@ CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
396of the respective parsed headers. See `rmail-mime-handle' for their 774of the respective parsed headers. See `rmail-mime-handle' for their
397format." 775format."
398 (rmail-mime-process-multipart 776 (rmail-mime-process-multipart
399 content-type content-disposition content-transfer-encoding nil)) 777 content-type content-disposition content-transfer-encoding nil)
778 t)
400 779
401(defun rmail-mime-process-multipart (content-type 780(defun rmail-mime-process-multipart (content-type
402 content-disposition 781 content-disposition
403 content-transfer-encoding 782 content-transfer-encoding
404 parse-only) 783 parse-tag)
405 "Process the current buffer as a multipart MIME body. 784 "Process the current buffer as a multipart MIME body.
406 785
407If PARSE-ONLY is nil, modify the current buffer directly for showing 786If PARSE-TAG is nil, modify the current buffer directly for
408the MIME body and return nil. 787showing the MIME body and return nil.
409 788
410Otherwise, just parse the current buffer and return a list of 789Otherwise, PARSE-TAG is a string indicating the depth and index
411MIME-entity objects. 790number of the entity. In this case, parse the current buffer and
791return a list of MIME-entity objects.
412 792
413The other arguments are the same as `rmail-mime-multipart-handler'." 793The other arguments are the same as `rmail-mime-multipart-handler'."
414 ;; Some MUAs start boundaries with "--", while it should start 794 ;; Some MUAs start boundaries with "--", while it should start
@@ -419,6 +799,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
419 ;; of the preceding part. 799 ;; of the preceding part.
420 ;; We currently don't handle that. 800 ;; We currently don't handle that.
421 (let ((boundary (cdr (assq 'boundary content-type))) 801 (let ((boundary (cdr (assq 'boundary content-type)))
802 (subtype (cadr (split-string (car content-type) "/")))
803 (index 0)
422 beg end next entities) 804 beg end next entities)
423 (unless boundary 805 (unless boundary
424 (rmail-mm-get-boundary-error-message 806 (rmail-mm-get-boundary-error-message
@@ -429,12 +811,20 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
429 (goto-char (point-min)) 811 (goto-char (point-min))
430 (when (and (search-forward boundary nil t) 812 (when (and (search-forward boundary nil t)
431 (looking-at "[ \t]*\n")) 813 (looking-at "[ \t]*\n"))
432 (if parse-only 814 (if parse-tag
433 (narrow-to-region (match-end 0) (point-max)) 815 (narrow-to-region (match-end 0) (point-max))
434 (delete-region (point-min) (match-end 0)))) 816 (delete-region (point-min) (match-end 0))))
817
818 ;; Change content-type to the proper default one for the children.
819 (cond ((string-match "mixed" subtype)
820 (setq content-type '("text/plain")))
821 ((string-match "digest" subtype)
822 (setq content-type '("message/rfc822"))))
823
435 ;; Loop over all body parts, where beg points at the beginning of 824 ;; Loop over all body parts, where beg points at the beginning of
436 ;; the part and end points at the end of the part. next points at 825 ;; the part and end points at the end of the part. next points at
437 ;; the beginning of the next part. 826 ;; the beginning of the next part. The current point is just
827 ;; after the boundary tag.
438 (setq beg (point-min)) 828 (setq beg (point-min))
439 (while (search-forward boundary nil t) 829 (while (search-forward boundary nil t)
440 (setq end (match-beginning 0)) 830 (setq end (match-beginning 0))
@@ -449,17 +839,46 @@ The other arguments are the same as `rmail-mime-multipart-handler'."
449 (rmail-mm-get-boundary-error-message 839 (rmail-mm-get-boundary-error-message
450 "Malformed boundary" content-type content-disposition 840 "Malformed boundary" content-type content-disposition
451 content-transfer-encoding))) 841 content-transfer-encoding)))
842
843 (setq index (1+ index))
452 ;; Handle the part. 844 ;; Handle the part.
453 (if parse-only 845 (if parse-tag
454 (save-restriction 846 (save-restriction
455 (narrow-to-region beg end) 847 (narrow-to-region beg end)
456 (setq entities (cons (rmail-mime-process nil t) entities))) 848 (let ((child (rmail-mime-process
849 nil (format "%s/%d" parse-tag index)
850 content-type content-disposition)))
851 ;; Display a tagline.
852 (aset (aref (rmail-mime-entity-display child) 1) 1
853 (aset (rmail-mime-entity-tagline child) 2 t))
854 (push child entities)))
855
457 (delete-region end next) 856 (delete-region end next)
458 (save-restriction 857 (save-restriction
459 (narrow-to-region beg end) 858 (narrow-to-region beg end)
460 (rmail-mime-show))) 859 (rmail-mime-show)))
461 (goto-char (setq beg next))) 860 (goto-char (setq beg next)))
462 (nreverse entities))) 861
862 (when parse-tag
863 (setq entities (nreverse entities))
864 (if (string-match "alternative" subtype)
865 ;; Find the best entity to show, and hide all the others.
866 (let (best second)
867 (dolist (child entities)
868 (if (string= (or (car (rmail-mime-entity-disposition child))
869 (car content-disposition))
870 "inline")
871 (if (string-match "text/plain"
872 (car (rmail-mime-entity-type child)))
873 (setq best child)
874 (if (string-match "text/.*"
875 (car (rmail-mime-entity-type child)))
876 (setq second child)))))
877 (or best (not second) (setq best second))
878 (dolist (child entities)
879 (or (eq best child)
880 (rmail-mime-hidden-mode child t)))))
881 entities)))
463 882
464(defun test-rmail-mime-multipart-handler () 883(defun test-rmail-mime-multipart-handler ()
465 "Test of a mail used as an example in RFC 2046." 884 "Test of a mail used as an example in RFC 2046."
@@ -492,6 +911,40 @@ This is the epilogue. It is also to be ignored."))
492 (insert mail) 911 (insert mail)
493 (rmail-mime-show t))) 912 (rmail-mime-show t)))
494 913
914(defun rmail-mime-insert-multipart (entity)
915 "Presentation handler for a multipart MIME entity."
916 (let ((current (aref (rmail-mime-entity-display entity) 0))
917 (new (aref (rmail-mime-entity-display entity) 1))
918 (header (rmail-mime-entity-header entity))
919 (tagline (rmail-mime-entity-tagline entity))
920 (body (rmail-mime-entity-body entity))
921 (beg (point))
922 (segment (rmail-mime-entity-segment (point) entity)))
923 ;; header
924 (if (eq (aref current 0) (aref new 0))
925 (goto-char (aref segment 2))
926 (if (aref current 0)
927 (delete-char (- (aref segment 2) (aref segment 1))))
928 (if (aref new 0)
929 (rmail-mime-insert-header header)))
930 ;; tagline
931 (if (eq (aref current 1) (aref new 1))
932 (forward-char (- (aref segment 3) (aref segment 2)))
933 (if (aref current 1)
934 (delete-char (- (aref segment 3) (aref segment 2))))
935 (if (aref new 1)
936 (rmail-mime-insert-tagline entity)))
937
938 (put-text-property beg (point) 'rmail-mime-entity entity)
939 ;; body
940 (if (eq (aref current 2) (aref new 2))
941 (forward-char (- (aref segment 4) (aref segment 3)))
942 (if (aref current 2)
943 (delete-char (- (aref segment 4) (aref segment 3))))
944 (if (aref new 2)
945 (dolist (child (rmail-mime-entity-children entity))
946 (rmail-mime-insert child))))))
947
495;;; Main code 948;;; Main code
496 949
497(defun rmail-mime-handle (content-type 950(defun rmail-mime-handle (content-type
@@ -564,7 +1017,9 @@ The current buffer must contain a single message. It will be
564modified." 1017modified."
565 (rmail-mime-process show-headers nil)) 1018 (rmail-mime-process show-headers nil))
566 1019
567(defun rmail-mime-process (show-headers parse-only) 1020(defun rmail-mime-process (show-headers parse-tag &optional
1021 default-content-type
1022 default-content-disposition)
568 (let ((end (point-min)) 1023 (let ((end (point-min))
569 content-type 1024 content-type
570 content-transfer-encoding 1025 content-transfer-encoding
@@ -595,45 +1050,76 @@ modified."
595 (setq content-type 1050 (setq content-type
596 (if content-type 1051 (if content-type
597 (mail-header-parse-content-type content-type) 1052 (mail-header-parse-content-type content-type)
598 ;; FIXME: Default "message/rfc822" in a "multipart/digest" 1053 (or default-content-type '("text/plain"))))
599 ;; according to RFC 2046.
600 '("text/plain")))
601 (setq content-disposition 1054 (setq content-disposition
602 (if content-disposition 1055 (if content-disposition
603 (mail-header-parse-content-disposition content-disposition) 1056 (mail-header-parse-content-disposition content-disposition)
604 ;; If none specified, we are free to choose what we deem 1057 ;; If none specified, we are free to choose what we deem
605 ;; suitable according to RFC 2183. We like inline. 1058 ;; suitable according to RFC 2183. We like inline.
606 '("inline"))) 1059 (or default-content-disposition '("inline"))))
607 ;; Unrecognized disposition types are to be treated like 1060 ;; Unrecognized disposition types are to be treated like
608 ;; attachment according to RFC 2183. 1061 ;; attachment according to RFC 2183.
609 (unless (member (car content-disposition) '("inline" "attachment")) 1062 (unless (member (car content-disposition) '("inline" "attachment"))
610 (setq content-disposition '("attachment"))) 1063 (setq content-disposition '("attachment")))
611 1064
612 (if parse-only 1065 (if parse-tag
613 (cond ((string-match "multipart/.*" (car content-type)) 1066 (let* ((is-inline (string= (car content-disposition) "inline"))
614 (setq end (1- end)) 1067 (header (vector (point-min) end nil))
615 (save-restriction 1068 (tagline (vector parse-tag (cons nil nil) t))
616 (let ((header (if show-headers (cons (point-min) end)))) 1069 (body (vector end (point-max) is-inline))
1070 (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
1071 children handler entity)
1072 (cond ((string-match "multipart/.*" (car content-type))
1073 (save-restriction
1074 (narrow-to-region (1- end) (point-max))
1075 (setq children (rmail-mime-process-multipart
1076 content-type
1077 content-disposition
1078 content-transfer-encoding
1079 parse-tag)
1080 handler 'rmail-mime-insert-multipart)))
1081 ((string-match "message/rfc822" (car content-type))
1082 (save-restriction
617 (narrow-to-region end (point-max)) 1083 (narrow-to-region end (point-max))
618 (rmail-mime-entity content-type 1084 (let* ((msg (rmail-mime-process t parse-tag
619 content-disposition 1085 '("text/plain") '("inline")))
620 content-transfer-encoding 1086 (msg-new (aref (rmail-mime-entity-display msg) 1)))
621 header nil 1087 ;; Show header of the child.
622 (rmail-mime-process-multipart 1088 (aset msg-new 0 t)
623 content-type content-disposition 1089 (aset (rmail-mime-entity-header msg) 2 t)
624 content-transfer-encoding t))))) 1090 ;; Hide tagline of the child.
625 ((string-match "message/rfc822" (car content-type)) 1091 (aset msg-new 1 nil)
626 (or show-headers 1092 (aset (rmail-mime-entity-tagline msg) 2 nil)
627 (narrow-to-region end (point-max))) 1093 (setq children (list msg)
628 (rmail-mime-process t t)) 1094 handler 'rmail-mime-insert-multipart))))
629 (t 1095 ((and is-inline (string-match "text/" (car content-type)))
630 (rmail-mime-entity content-type 1096 ;; Don't need a tagline.
631 content-disposition 1097 (aset new 1 (aset tagline 2 nil))
632 content-transfer-encoding 1098 (setq handler 'rmail-mime-insert-text))
633 nil 1099 (t
634 (cons end (point-max)) 1100 ;; Force hidden mode.
635 nil))) 1101 (aset new 1 (aset tagline 2 t))
1102 (aset new 2 (aset body 2 nil))
1103 (setq handler 'rmail-mime-insert-bulk)))
1104 (setq entity (rmail-mime-entity content-type
1105 content-disposition
1106 content-transfer-encoding
1107 (vector (vector nil nil nil) new)
1108 header tagline body children handler))
1109 (if (and (eq handler 'rmail-mime-insert-bulk)
1110 (rmail-mime-set-bulk-data entity))
1111 ;; Show the body.
1112 (aset new 2 (aset body 2 t)))
1113 entity)
1114
636 ;; Hide headers and handle the part. 1115 ;; Hide headers and handle the part.
1116 (put-text-property (point-min) (point-max) 'rmail-mime-entity
1117 (rmail-mime-entity
1118 content-type content-disposition
1119 content-transfer-encoding
1120 (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
1121 (vector nil nil 'raw) (vector "" (cons nil nil) nil)
1122 (vector nil nil 'raw) nil nil))
637 (save-restriction 1123 (save-restriction
638 (cond ((string= (car content-type) "message/rfc822") 1124 (cond ((string= (car content-type) "message/rfc822")
639 (narrow-to-region end (point-max))) 1125 (narrow-to-region end (point-max)))
@@ -642,102 +1128,117 @@ modified."
642 (rmail-mime-handle content-type content-disposition 1128 (rmail-mime-handle content-type content-disposition
643 content-transfer-encoding))))) 1129 content-transfer-encoding)))))
644 1130
645(defun rmail-mime-insert-multipart (entity)
646 "Insert MIME-entity ENTITY of multipart type in the current buffer."
647 (let ((subtype (cadr (split-string (car (rmail-mime-entity-type entity))
648 "/")))
649 (disposition (rmail-mime-entity-disposition entity))
650 (header (rmail-mime-entity-header entity))
651 (children (rmail-mime-entity-children entity)))
652 (if header
653 (let ((pos (point)))
654 (or (bolp)
655 (insert "\n"))
656 (insert-buffer-substring rmail-buffer (car header) (cdr header))
657 (rfc2047-decode-region pos (point))
658 (insert "\n")))
659 (cond
660 ((string= subtype "mixed")
661 (dolist (child children)
662 (rmail-mime-insert child '("text/plain") disposition)))
663 ((string= subtype "digest")
664 (dolist (child children)
665 (rmail-mime-insert child '("message/rfc822") disposition)))
666 ((string= subtype "alternative")
667 (let (best-plain-text best-text)
668 (dolist (child children)
669 (if (string= (or (car (rmail-mime-entity-disposition child))
670 (car disposition))
671 "inline")
672 (if (string-match "text/plain"
673 (car (rmail-mime-entity-type child)))
674 (setq best-plain-text child)
675 (if (string-match "text/.*"
676 (car (rmail-mime-entity-type child)))
677 (setq best-text child)))))
678 (if (or best-plain-text best-text)
679 (rmail-mime-insert (or best-plain-text best-text))
680 ;; No child could be handled. Insert all.
681 (dolist (child children)
682 (rmail-mime-insert child nil disposition)))))
683 (t
684 ;; Unsupported subtype. Insert all of them.
685 (dolist (child children)
686 (rmail-mime-insert child))))))
687
688(defun rmail-mime-parse () 1131(defun rmail-mime-parse ()
689 "Parse the current Rmail message as a MIME message. 1132 "Parse the current Rmail message as a MIME message.
690The value is a MIME-entiy object (see `rmail-mime-enty-new')." 1133The value is a MIME-entiy object (see `rmail-mime-entity')."
691 (save-excursion 1134 (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
692 (goto-char (point-min)) 1135 rmail-view-buffer
693 (condition-case nil 1136 (current-buffer))))
694 (rmail-mime-process nil t) 1137 ;;(condition-case err
695 (error nil)))) 1138 (with-current-buffer rmail-mime-mbox-buffer
696 1139 (save-excursion
697(defun rmail-mime-insert (entity &optional content-type disposition) 1140 (goto-char (point-min))
1141 (let* ((entity (rmail-mime-process t ""
1142 '("text/plain") '("inline")))
1143 (new (aref (rmail-mime-entity-display entity) 1)))
1144 ;; Show header.
1145 (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
1146 ;; Show tagline if and only if body is not shown.
1147 (if (aref new 2)
1148 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
1149 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
1150 entity)))
1151 ;;(error (error (format "%s" err))))
1152 ))
1153
1154(defun rmail-mime-insert (entity)
698 "Insert a MIME-entity ENTITY in the current buffer. 1155 "Insert a MIME-entity ENTITY in the current buffer.
699 1156
700This function will be called recursively if multiple parts are 1157This function will be called recursively if multiple parts are
701available." 1158available."
702 (if (rmail-mime-entity-children entity) 1159 (let ((current (aref (rmail-mime-entity-display entity) 0))
703 (rmail-mime-insert-multipart entity) 1160 (new (aref (rmail-mime-entity-display entity) 1)))
704 (setq content-type 1161 (if (not (eq (aref new 0) 'raw))
705 (or (rmail-mime-entity-type entity) content-type)) 1162 ;; Not a raw-mode. Each handler should handle it.
706 (setq disposition 1163 (funcall (rmail-mime-entity-handler entity) entity)
707 (or (rmail-mime-entity-disposition entity) disposition)) 1164 (let ((header (rmail-mime-entity-header entity))
708 (if (and (string= (car disposition) "inline") 1165 (tagline (rmail-mime-entity-tagline entity))
709 (string-match "text/.*" (car content-type))) 1166 (body (rmail-mime-entity-body entity))
710 (rmail-mime-insert-text entity) 1167 (beg (point))
711 (rmail-mime-insert-bulk entity)))) 1168 (segment (rmail-mime-entity-segment (point) entity)))
1169 ;; header
1170 (if (eq (aref current 0) (aref new 0))
1171 (goto-char (aref segment 2))
1172 (if (aref current 0)
1173 (delete-char (- (aref segment 2) (aref segment 1))))
1174 (insert-buffer-substring rmail-mime-mbox-buffer
1175 (aref header 0) (aref header 1)))
1176 ;; tagline
1177 (if (aref current 1)
1178 (delete-char (- (aref segment 3) (aref segment 2))))
1179 ;; body
1180 (if (eq (aref current 2) (aref new 2))
1181 (forward-char (- (aref segment 4) (aref segment 3)))
1182 (if (aref current 2)
1183 (delete-char (- (aref segment 4) (aref segment 3))))
1184 (insert-buffer-substring rmail-mime-mbox-buffer
1185 (aref body 0) (aref body 1)))
1186 (put-text-property beg (point) 'rmail-mime-entity entity)))
1187 (dotimes (i 3)
1188 (aset current i (aref new i)))))
712 1189
713(define-derived-mode rmail-mime-mode fundamental-mode "RMIME" 1190(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
714 "Major mode used in `rmail-mime' buffers." 1191 "Major mode used in `rmail-mime' buffers."
715 (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) 1192 (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
716 1193
717;;;###autoload 1194;;;###autoload
718(defun rmail-mime () 1195(defun rmail-mime (&optional arg)
719 "Process the current Rmail message as a MIME message. 1196 "Toggle displaying of a MIME message.
720This creates a temporary \"*RMAIL*\" buffer holding a decoded 1197
721copy of the message. Inline content-types are handled according to 1198The actualy behavior depends on the value of `rmail-enable-mime'.
1199
1200If `rmail-enable-mime' is t (default), this command change the
1201displaying of a MIME message between decoded presentation form
1202and raw data.
1203
1204With ARG, toggle the displaying of the current MIME entity only.
1205
1206If `rmail-enable-mime' is nil, this creates a temporary
1207\"*RMAIL*\" buffer holding a decoded copy of the message. Inline
1208content-types are handled according to
722`rmail-mime-media-type-handlers-alist'. By default, this 1209`rmail-mime-media-type-handlers-alist'. By default, this
723displays text and multipart messages, and offers to download 1210displays text and multipart messages, and offers to download
724attachments as specfied by `rmail-mime-attachment-dirs-alist'." 1211attachments as specfied by `rmail-mime-attachment-dirs-alist'."
725 (interactive) 1212 (interactive "P")
726 (let ((data (rmail-apply-in-message rmail-current-message 'buffer-string)) 1213 (if rmail-enable-mime
727 (buf (get-buffer-create "*RMAIL*"))) 1214 (if (rmail-mime-message-p)
728 (set-buffer buf) 1215 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
729 (setq buffer-undo-list t) 1216 (rmail-mime-view-buffer rmail-buffer)
730 (let ((inhibit-read-only t)) 1217 (entity (get-text-property (point) 'rmail-mime-entity)))
731 ;; Decoding the message in fundamental mode for speed, only 1218 (if arg
732 ;; switching to rmail-mime-mode at the end for display. Eg 1219 (if entity
733 ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993). 1220 (rmail-mime-toggle-raw entity))
734 (fundamental-mode) 1221 (goto-char (point-min))
735 (erase-buffer) 1222 (rmail-mime-toggle-raw
736 (insert data) 1223 (get-text-property (point) 'rmail-mime-entity))))
737 (rmail-mime-show t) 1224 (message "Not a MIME message"))
738 (rmail-mime-mode) 1225 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
739 (set-buffer-modified-p nil)) 1226 (buf (get-buffer-create "*RMAIL*"))
740 (view-buffer buf))) 1227 (rmail-mime-mbox-buffer rmail-view-buffer)
1228 (rmail-mime-view-buffer buf))
1229 (set-buffer buf)
1230 (setq buffer-undo-list t)
1231 (let ((inhibit-read-only t))
1232 ;; Decoding the message in fundamental mode for speed, only
1233 ;; switching to rmail-mime-mode at the end for display. Eg
1234 ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
1235 (fundamental-mode)
1236 (erase-buffer)
1237 (insert data)
1238 (rmail-mime-show t)
1239 (rmail-mime-mode)
1240 (set-buffer-modified-p nil))
1241 (view-buffer buf))))
741 1242
742(defun rmail-mm-get-boundary-error-message (message type disposition encoding) 1243(defun rmail-mm-get-boundary-error-message (message type disposition encoding)
743 "Return MESSAGE with more information on the main mime components." 1244 "Return MESSAGE with more information on the main mime components."
@@ -746,34 +1247,39 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
746 1247
747(defun rmail-show-mime () 1248(defun rmail-show-mime ()
748 "Function to set in `rmail-show-mime-function' (which see)." 1249 "Function to set in `rmail-show-mime-function' (which see)."
749 (let ((mbox-buf rmail-buffer) 1250 (let ((entity (rmail-mime-parse))
750 (entity (rmail-mime-parse))) 1251 (rmail-mime-mbox-buffer rmail-buffer)
1252 (rmail-mime-view-buffer rmail-view-buffer)
1253 (rmail-mime-coding-system nil))
751 (if entity 1254 (if entity
752 (with-current-buffer rmail-view-buffer 1255 (with-current-buffer rmail-mime-view-buffer
753 (let ((inhibit-read-only t) 1256 (erase-buffer)
754 (rmail-buffer mbox-buf)) 1257 (rmail-mime-insert entity)
755 (erase-buffer) 1258 (if rmail-mime-coding-system
756 (rmail-mime-insert entity))) 1259 (set-buffer-file-coding-system rmail-mime-coding-system t t)))
757 ;; Decoding failed. Insert the original message body as is. 1260 ;; Decoding failed. Insert the original message body as is.
758 (let ((region (with-current-buffer mbox-buf 1261 (let ((region (with-current-buffer rmail-mime-mbox-buffer
759 (goto-char (point-min)) 1262 (goto-char (point-min))
760 (re-search-forward "^$" nil t) 1263 (re-search-forward "^$" nil t)
761 (forward-line 1) 1264 (forward-line 1)
762 (cons (point) (point-max))))) 1265 (cons (point) (point-max)))))
763 (with-current-buffer rmail-view-buffer 1266 (with-current-buffer rmail-mime-view-buffer
764 (let ((inhibit-read-only t)) 1267 (let ((inhibit-read-only t))
765 (erase-buffer) 1268 (erase-buffer)
766 (insert-buffer-substring mbox-buf (car region) (cdr region)))) 1269 (insert-buffer-substring rmail-mime-mbox-buffer
1270 (car region) (cdr region))))
1271 (set-buffer-file-coding-system 'no-conversion t t)
767 (message "MIME decoding failed"))))) 1272 (message "MIME decoding failed")))))
768 1273
769(setq rmail-show-mime-function 'rmail-show-mime) 1274(setq rmail-show-mime-function 'rmail-show-mime)
770 1275
771(defun rmail-insert-mime-forwarded-message (forward-buffer) 1276(defun rmail-insert-mime-forwarded-message (forward-buffer)
772 "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)." 1277 "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)."
773 (let ((mbox-buf (with-current-buffer forward-buffer rmail-view-buffer))) 1278 (let ((rmail-mime-mbox-buffer
1279 (with-current-buffer forward-buffer rmail-view-buffer)))
774 (save-restriction 1280 (save-restriction
775 (narrow-to-region (point) (point)) 1281 (narrow-to-region (point) (point))
776 (message-forward-make-body-mime mbox-buf)))) 1282 (message-forward-make-body-mime rmail-mime-mbox-buffer))))
777 1283
778(setq rmail-insert-mime-forwarded-message-function 1284(setq rmail-insert-mime-forwarded-message-function
779 'rmail-insert-mime-forwarded-message) 1285 'rmail-insert-mime-forwarded-message)
@@ -794,15 +1300,16 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
794 "Function to set in `rmail-search-mime-message-function' (which see)." 1300 "Function to set in `rmail-search-mime-message-function' (which see)."
795 (save-restriction 1301 (save-restriction
796 (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg)) 1302 (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
797 (let ((mbox-buf (current-buffer)) 1303 (let* ((rmail-mime-mbox-buffer (current-buffer))
798 (header-end (save-excursion 1304 (rmail-mime-view-buffer rmail-view-buffer)
799 (re-search-forward "^$" nil 'move) (point))) 1305 (header-end (save-excursion
800 (body-end (point-max)) 1306 (re-search-forward "^$" nil 'move) (point)))
801 (entity (rmail-mime-parse))) 1307 (body-end (point-max))
1308 (entity (rmail-mime-parse)))
802 (or 1309 (or
803 ;; At first, just search the headers. 1310 ;; At first, just search the headers.
804 (with-temp-buffer 1311 (with-temp-buffer
805 (insert-buffer-substring mbox-buf nil header-end) 1312 (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
806 (rfc2047-decode-region (point-min) (point)) 1313 (rfc2047-decode-region (point-min) (point))
807 (goto-char (point-min)) 1314 (goto-char (point-min))
808 (re-search-forward regexp nil t)) 1315 (re-search-forward regexp nil t))
@@ -815,8 +1322,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'."
815 (not (string= (downcase charset) "us-ascii")))))) 1322 (not (string= (downcase charset) "us-ascii"))))))
816 ;; Search the decoded MIME message. 1323 ;; Search the decoded MIME message.
817 (with-temp-buffer 1324 (with-temp-buffer
818 (let ((rmail-buffer mbox-buf)) 1325 (rmail-mime-insert entity)
819 (rmail-mime-insert entity))
820 (goto-char (point-min)) 1326 (goto-char (point-min))
821 (re-search-forward regexp nil t)) 1327 (re-search-forward regexp nil t))
822 ;; Search the body without decoding. 1328 ;; Search the body without decoding.