1 ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
3 ;; Copyright (C) 2006-2011 Free Software Foundation, Inc.
5 ;; Author: Alexander Pohoyda
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; Essentially based on the design of Alexander Pohoyda's MIME
29 ;; extensions (mime-display.el and mime.el).
31 ;; This file provides two operation modes for viewing a MIME message.
33 ;; (1) When rmail-enable-mime is non-nil (now it is the default), the
34 ;; function `rmail-show-mime' is automatically called. That function
35 ;; shows a MIME message directly in RMAIL's view buffer.
37 ;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x
38 ;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*".
40 ;; Both operations share the intermediate functions rmail-mime-process
41 ;; and rmail-mime-process-multipart as below.
44 ;; +- rmail-mime-parse
45 ;; | +- rmail-mime-process <--+------------+
47 ;; | + rmail-mime-process-multipart --+
49 ;; + rmail-mime-insert <----------------+
50 ;; +- rmail-mime-insert-text |
51 ;; +- rmail-mime-insert-bulk |
52 ;; +- rmail-mime-insert-multipart --+
55 ;; +- rmail-mime-show <----------------------------------+
56 ;; +- rmail-mime-process |
57 ;; +- rmail-mime-handle |
58 ;; +- rmail-mime-text-handler |
59 ;; +- rmail-mime-bulk-handler |
60 ;; | + rmail-mime-insert-bulk
61 ;; +- rmail-mime-multipart-handler |
62 ;; +- rmail-mime-process-multipart --+
64 ;; In addition, for the case of rmail-enable-mime being non-nil, this
65 ;; file provides two functions rmail-insert-mime-forwarded-message and
66 ;; rmail-insert-mime-resent-message for composing forwarded and resent
67 ;; messages respectively.
71 ;; Make rmail-mime-media-type-handlers-alist usable in the first
73 ;; Handle multipart/alternative in the second operation mode.
74 ;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
84 (defgroup rmail-mime nil
85 "Rmail MIME handling options."
89 (defcustom rmail-mime-media-type-handlers-alist
90 '(("multipart/.*" rmail-mime-multipart-handler
)
91 ("text/.*" rmail-mime-text-handler
)
92 ("text/\\(x-\\)?patch" rmail-mime-bulk-handler
)
93 ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler
))
94 "Functions to handle various content types.
95 This is an alist with elements of the form (REGEXP FUNCTION ...).
96 The first item is a regular expression matching a content-type.
97 The remaining elements are handler functions to run, in order of
98 decreasing preference. These are called until one returns non-nil.
99 Note that this only applies to items with an inline Content-Disposition,
100 all others are handled by `rmail-mime-bulk-handler'.
101 Note also that this alist is ignored when the variable
102 `rmail-enable-mime' is non-nil."
103 :type
'(alist :key-type regexp
:value-type
(repeat function
))
107 (defcustom rmail-mime-attachment-dirs-alist
108 `(("text/.*" "~/Documents")
109 ("image/.*" "~/Pictures")
110 (".*" "~/Desktop" "~" ,temporary-file-directory
))
111 "Default directories to save attachments of various types into.
112 This is an alist with elements of the form (REGEXP DIR ...).
113 The first item is a regular expression matching a content-type.
114 The remaining elements are directories, in order of decreasing preference.
115 The first directory that exists is used."
116 :type
'(alist :key-type regexp
:value-type
(repeat directory
))
120 (defcustom rmail-mime-show-images
'button
121 "What to do with image attachments that Emacs is capable of displaying.
122 If nil, do nothing special. If `button', add an extra button
123 that when pushed displays the image in the buffer. If a number,
124 automatically show images if they are smaller than that size (in
125 bytes), otherwise add a display button. Anything else means to
126 automatically display the image in the buffer."
127 :type
'(choice (const :tag
"Add button to view image" button
)
128 (const :tag
"No special treatment" nil
)
129 (number :tag
"Show if smaller than certain size")
130 (other :tag
"Always show" show
))
134 ;;; End of user options.
136 ;;; Global variables that always have let-binding when referred.
138 (defvar rmail-mime-mbox-buffer nil
139 "Buffer containing the mbox data.
140 The value is usually nil, and bound to a proper value while
143 (defvar rmail-mime-view-buffer nil
144 "Buffer showing a message.
145 The value is usually nil, and bound to a proper value while
148 (defvar rmail-mime-coding-system nil
149 "The first coding-system used for decoding a MIME entity.
150 The value is usually nil, and bound to non-nil while inserting
153 ;;; MIME-entity object
155 (defun rmail-mime-entity (type disposition transfer-encoding
156 display header tagline body children handler
158 "Return a newly created MIME-entity object from arguments.
160 A MIME-entity is a vector of 10 elements:
162 [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
163 CHILDREN HANDLER TRUNCATED]
165 TYPE and DISPOSITION correspond to MIME headers Content-Type and
166 Content-Disposition respectively, and have this format:
168 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
170 Each VALUE is a string and each ATTRIBUTE is a string.
172 Consider the following header, for example:
174 Content-Type: multipart/mixed;
175 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
177 The corresponding TYPE argument must be:
179 \(\"multipart/mixed\"
180 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
182 TRANSFER-ENCODING corresponds to MIME header
183 Content-Transfer-Encoding, and is a lower-case string.
185 DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
186 the header, tag line, and body of the entity are displayed now,
187 and NEW indicates how their display should be updated.
188 Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
189 where each constituent element is a symbol for the corresponding
190 item with these values:
192 t: displayed by the decoded presentation form
193 raw: displayed by the raw MIME data (for the header and body only)
195 HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
196 END are markers that specify the region of the header or body lines
197 in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
198 header or body is, by default, displayed by the decoded
201 TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
202 string indicating the depth and index number of the entity,
203 BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
204 an attached data, DISPLAY-FLAG non-nil means that the tag line is
205 displayed by default.
207 CHILDREN is a list of child MIME-entities. A \"multipart/*\"
208 entity has one or more children. A \"message/rfc822\" entity
209 has just one child. Any other entity has no child.
211 HANDLER is a function to insert the entity according to DISPLAY.
212 It is called with one argument ENTITY.
214 TRUNCATED is non-nil if the text of this entity was truncated."
216 (vector type disposition transfer-encoding
217 display header tagline body children handler truncated
))
219 ;; Accessors for a MIME-entity object.
220 (defsubst rmail-mime-entity-type
(entity) (aref entity
0))
221 (defsubst rmail-mime-entity-disposition
(entity) (aref entity
1))
222 (defsubst rmail-mime-entity-transfer-encoding
(entity) (aref entity
2))
223 (defsubst rmail-mime-entity-display
(entity) (aref entity
3))
224 (defsubst rmail-mime-entity-header
(entity) (aref entity
4))
225 (defsubst rmail-mime-entity-tagline
(entity) (aref entity
5))
226 (defsubst rmail-mime-entity-body
(entity) (aref entity
6))
227 (defsubst rmail-mime-entity-children
(entity) (aref entity
7))
228 (defsubst rmail-mime-entity-handler
(entity) (aref entity
8))
229 (defsubst rmail-mime-entity-truncated
(entity) (aref entity
9))
230 (defsubst rmail-mime-entity-set-truncated
(entity truncated
)
231 (aset entity
9 truncated
))
233 (defsubst rmail-mime-message-p
()
234 "Non-nil if and only if the current message is a MIME."
235 (or (get-text-property (point) 'rmail-mime-entity
)
236 (get-text-property (point-min) 'rmail-mime-entity
)))
240 (defun rmail-mime-save (button)
241 "Save the attachment using info in the BUTTON."
242 (let* ((rmail-mime-mbox-buffer rmail-view-buffer
)
243 (filename (button-get button
'filename
))
244 (directory (button-get button
'directory
))
245 (data (button-get button
'data
))
246 (ofilename filename
))
247 (if (and (not (stringp data
))
248 (rmail-mime-entity-truncated data
))
249 (unless (y-or-n-p "This entity is truncated; save anyway? ")
251 (setq filename
(expand-file-name
252 (read-file-name (format "Save as (default: %s): " filename
)
254 (expand-file-name filename directory
))
256 ;; If arg is just a directory, use the default file name, but in
257 ;; that directory (copied from write-file).
258 (if (file-directory-p filename
)
259 (setq filename
(expand-file-name
260 (file-name-nondirectory ofilename
)
261 (file-name-as-directory filename
))))
263 (set-buffer-file-coding-system 'no-conversion
)
264 ;; Needed e.g. by jka-compr, so if the attachment is a compressed
265 ;; file, the magic signature compares equal with the unibyte
266 ;; signature string recorded in jka-compr-compression-info-list.
267 (set-buffer-multibyte nil
)
268 (setq buffer-undo-list t
)
271 ;; DATA is a MIME-entity object.
272 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data
))
273 (body (rmail-mime-entity-body data
)))
274 (insert-buffer-substring rmail-mime-mbox-buffer
275 (aref body
0) (aref body
1))
276 (cond ((string= transfer-encoding
"base64")
277 (ignore-errors (base64-decode-region (point-min) (point-max))))
278 ((string= transfer-encoding
"quoted-printable")
279 (quoted-printable-decode-region (point-min) (point-max))))))
280 (write-region nil nil filename nil nil nil t
))))
282 (define-button-type 'rmail-mime-save
'action
'rmail-mime-save
)
284 ;; Display options returned by rmail-mime-entity-display.
285 ;; Value is on of nil, t, raw.
286 (defsubst rmail-mime-display-header
(disp) (aref disp
0))
287 (defsubst rmail-mime-display-tagline
(disp) (aref disp
1))
288 (defsubst rmail-mime-display-body
(disp) (aref disp
2))
290 (defun rmail-mime-entity-segment (pos &optional entity
)
291 "Return a vector describing the displayed region of a MIME-entity at POS.
292 Optional 2nd argument ENTITY is the MIME-entity at POS.
293 The value is a vector [INDEX HEADER TAGLINE BODY END], where
294 INDEX: index into the returned vector indicating where POS is (1..3)
295 HEADER: the position of the beginning of a header
296 TAGLINE: the position of the beginning of a tag line, including
297 the newline that precedes it
298 BODY: the position of the beginning of a body
299 END: the position of the end of the entity."
302 (setq entity
(get-text-property pos
'rmail-mime-entity
)))
304 (vector 1 (point) (point) (point) (point))
305 (let ((current (aref (rmail-mime-entity-display entity
) 0))
306 (beg (if (and (> pos
(point-min))
307 (eq (get-text-property (1- pos
) 'rmail-mime-entity
)
309 (previous-single-property-change pos
'rmail-mime-entity
313 tagline-beg body-beg end
)
315 ;; If the header is displayed, get past it to the tagline.
316 (if (rmail-mime-display-header current
)
317 (search-forward "\n\n" nil t
))
318 (setq tagline-beg
(point))
319 (if (>= pos tagline-beg
)
321 ;; If the tagline is displayed, get past it to the body.
322 (if (rmail-mime-display-tagline current
)
323 ;; The next foward-line call must be in sync with how
324 ;; `rmail-mime-insert-tagline' formats the tagline. The
325 ;; body begins after the empty line that ends the tagline.
327 (setq body-beg
(point))
328 (if (>= pos body-beg
)
330 ;; If the body is displayed, find its end.
331 (if (rmail-mime-display-body current
)
332 (let ((tag (aref (rmail-mime-entity-tagline entity
) 0))
334 (setq end
(next-single-property-change beg
'rmail-mime-entity
336 ;; `tag' is either an empty string or "/n" where n is
337 ;; the number of the part of the multipart MIME message.
338 ;; The loop below finds the next location whose
339 ;; `rmail-mime-entity' property specifies a tag of a
341 (while (and (< end
(point-max))
342 (setq entity
(get-text-property end
'rmail-mime-entity
)
343 tag2
(aref (rmail-mime-entity-tagline entity
) 0))
344 (and (> (length tag2
) 0)
345 (eq (string-match tag tag2
) 0)))
346 (setq end
(next-single-property-change end
'rmail-mime-entity
349 (vector index beg tagline-beg body-beg end
)))))
351 (defun rmail-mime-shown-mode (entity)
352 "Make MIME-entity ENTITY display in the default way."
353 (let ((new (aref (rmail-mime-entity-display entity
) 1)))
354 (aset new
0 (aref (rmail-mime-entity-header entity
) 2))
355 (aset new
1 (aref (rmail-mime-entity-tagline entity
) 2))
356 (aset new
2 (aref (rmail-mime-entity-body entity
) 2)))
357 (dolist (child (rmail-mime-entity-children entity
))
358 (rmail-mime-shown-mode child
)))
360 (defun rmail-mime-hidden-mode (entity)
361 "Make MIME-entity ENTITY display in hidden mode."
362 (let ((new (aref (rmail-mime-entity-display entity
) 1)))
366 (dolist (child (rmail-mime-entity-children entity
))
367 (rmail-mime-hidden-mode child
)))
369 (defun rmail-mime-raw-mode (entity)
370 "Make MIME-entity ENTITY display in raw mode."
371 (let ((new (aref (rmail-mime-entity-display entity
) 1)))
375 (dolist (child (rmail-mime-entity-children entity
))
376 (rmail-mime-raw-mode child
)))
378 (defun rmail-mime-toggle-raw (&optional state
)
379 "Toggle on and off the raw display mode of MIME-entity at point.
380 With optional argument STATE, force the specified display mode.
381 Use `raw' for raw mode, and any other non-nil value for decoded mode."
382 (let* ((pos (if (eobp) (1- (point-max)) (point)))
383 (entity (get-text-property pos
'rmail-mime-entity
))
384 (current (aref (rmail-mime-entity-display entity
) 0))
385 (segment (rmail-mime-entity-segment pos entity
)))
386 (if (or (eq state
'raw
)
388 (not (eq (rmail-mime-display-header current
) 'raw
))))
389 ;; Enter the raw mode.
390 (rmail-mime-raw-mode entity
)
391 ;; Enter the shown mode.
392 (rmail-mime-shown-mode entity
))
393 (let ((inhibit-read-only t
)
394 (modified (buffer-modified-p)))
396 (goto-char (aref segment
1))
397 (rmail-mime-insert entity
)
398 (restore-buffer-modified-p modified
)))))
400 (defun rmail-mime-toggle-hidden ()
401 "Hide or show the body of the MIME-entity at point."
403 (when (rmail-mime-message-p)
404 (let* ((rmail-mime-mbox-buffer rmail-view-buffer
)
405 (rmail-mime-view-buffer (current-buffer))
406 (pos (if (eobp) (1- (point-max)) (point)))
407 (entity (get-text-property pos
'rmail-mime-entity
))
408 (current (aref (rmail-mime-entity-display entity
) 0))
409 (segment (rmail-mime-entity-segment pos entity
)))
410 (if (rmail-mime-display-body current
)
411 ;; Enter the hidden mode.
413 ;; If point is in the body part, move it to the tagline
414 ;; (or the header if tagline is not displayed).
415 (if (= (aref segment
0) 3)
416 (goto-char (aref segment
2)))
417 (rmail-mime-hidden-mode entity
)
418 ;; If the current entity is the topmost one, display the
420 (if (and rmail-mime-mbox-buffer
(= (aref segment
1) (point-min)))
421 (let ((new (aref (rmail-mime-entity-display entity
) 1)))
423 ;; Query as a warning before showing if truncated.
424 (if (and (not (stringp entity
))
425 (rmail-mime-entity-truncated entity
))
426 (unless (y-or-n-p "This entity is truncated; show anyway? ")
428 ;; Enter the shown mode.
429 (rmail-mime-shown-mode entity
)
430 ;; Force this body shown.
431 (aset (aref (rmail-mime-entity-display entity
) 1) 2 t
))
432 (let ((inhibit-read-only t
)
433 (modified (buffer-modified-p))
434 (rmail-mime-mbox-buffer rmail-view-buffer
)
435 (rmail-mime-view-buffer rmail-buffer
))
437 (goto-char (aref segment
1))
438 (rmail-mime-insert entity
)
439 (restore-buffer-modified-p modified
))))))
441 (define-key rmail-mode-map
"\t" 'forward-button
)
442 (define-key rmail-mode-map
[backtab] 'backward-button)
443 (define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
447 (defun rmail-mime-insert-tagline (entity &rest item-list)
448 "Insert a tag line for MIME-entity ENTITY.
449 ITEM-LIST is a list of strings or button-elements (list) to add
451 ;; Precede the tagline by an empty line to make it a separate
452 ;; paragraph, so that it is aligned to the left margin of the window
453 ;; even if preceded by a right-to-left paragraph.
455 (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
456 (if (> (length tag) 0) (insert (substring tag 1) ":")))
457 (insert (car (rmail-mime-entity-type entity)) " ")
458 (insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
459 (if (rmail-mime-display-body new) "Hide" "Show"))
460 :type 'rmail-mime-toggle
461 'help-echo "mouse-2, RET: Toggle show/hide")
462 (dolist (item item-list)
466 (apply 'insert-button item))))
467 ;; Follow the tagline by an empty line to make it a separate
468 ;; paragraph, so that the paragraph direction of the following text
469 ;; is determined based on that text.
472 (defun rmail-mime-update-tagline (entity)
473 "Update the current tag line for MIME-entity ENTITY."
474 (let ((inhibit-read-only t)
475 (modified (buffer-modified-p))
476 ;; If we are going to show the body, the new button label is
477 ;; "Hide". Otherwise, it's "Show".
478 (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
480 (button (next-button (point))))
481 ;; Go to the second character of the button "Show" or "Hide".
482 (goto-char (1+ (button-start button)))
483 (setq button (button-at (point)))
486 (delete-region (point) (button-end button)))
487 (delete-region (button-start button) (point))
488 (put-text-property (point) (button-end button) 'rmail-mime-entity entity)
489 (restore-buffer-modified-p modified)
490 ;; The following call to forward-line must be in sync with how
491 ;; rmail-mime-insert-tagline formats the tagline.
494 (defun rmail-mime-insert-header (header)
495 "Decode and insert a MIME-entity header HEADER in the current buffer.
496 HEADER is a vector [BEG END DEFAULT-STATUS].
497 See `rmail-mime-entity' for details."
499 (last-coding-system-used nil))
501 (narrow-to-region pos pos)
502 (with-current-buffer rmail-mime-mbox-buffer
503 (let ((rmail-buffer rmail-mime-mbox-buffer)
504 (rmail-view-buffer rmail-mime-view-buffer))
506 (goto-char (aref header 0))
507 (rmail-copy-headers (point) (aref header 1)))))
508 (rfc2047-decode-region pos (point))
509 (if (and last-coding-system-used (not rmail-mime-coding-system))
510 (setq rmail-mime-coding-system (cons last-coding-system-used nil)))
511 (goto-char (point-min))
512 (rmail-highlight-headers)
513 (goto-char (point-max))
516 (defun rmail-mime-find-header-encoding (header)
517 "Return the last coding system used to decode HEADER.
518 HEADER is a header component of a MIME-entity object (see
519 `rmail-mime-entity')."
521 (let ((buf (current-buffer)))
522 (with-current-buffer rmail-mime-mbox-buffer
523 (let ((last-coding-system-used nil)
524 (rmail-buffer rmail-mime-mbox-buffer)
525 (rmail-view-buffer buf))
527 (goto-char (aref header 0))
528 (rmail-copy-headers (point) (aref header 1)))))
529 (rfc2047-decode-region (point-min) (point-max))
530 last-coding-system-used)))
532 (defun rmail-mime-text-handler (content-type
534 content-transfer-encoding)
535 "Handle the current buffer as a plain text MIME part."
536 (rmail-mime-insert-text
537 (rmail-mime-entity content-type content-disposition
538 content-transfer-encoding
539 (vector (vector nil nil nil) (vector nil nil t))
540 (vector nil nil nil) (vector "" (cons nil nil) t)
541 (vector nil nil nil) nil 'rmail-mime-insert-text))
544 (defun rmail-mime-insert-decoded-text (entity)
545 "Decode and insert the text body of MIME-entity ENTITY."
546 (let* ((content-type (rmail-mime-entity-type entity))
547 (charset (cdr (assq 'charset (cdr content-type))))
548 (coding-system (if charset
549 (coding-system-from-name charset)))
550 (body (rmail-mime-entity-body entity))
552 (or (and coding-system (coding-system-p coding-system))
553 (setq coding-system 'undecided))
554 (if (stringp (aref body 0))
555 (insert (aref body 0))
556 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
557 (insert-buffer-substring rmail-mime-mbox-buffer
558 (aref body 0) (aref body 1))
559 (cond ((string= transfer-encoding "base64")
560 (ignore-errors (base64-decode-region pos (point))))
561 ((string= transfer-encoding "quoted-printable")
562 (quoted-printable-decode-region pos (point))))))
563 (decode-coding-region pos (point) coding-system)
565 (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
566 (not (eq (coding-system-base coding-system) 'us-ascii)))
567 (setq rmail-mime-coding-system coding-system))
568 (or (bolp) (insert "\n"))))
570 (defun rmail-mime-insert-text (entity)
571 "Presentation handler for a plain text MIME entity."
572 (let ((current (aref (rmail-mime-entity-display entity) 0))
573 (new (aref (rmail-mime-entity-display entity) 1))
574 (header (rmail-mime-entity-header entity))
575 (tagline (rmail-mime-entity-tagline entity))
576 (body (rmail-mime-entity-body entity))
578 (segment (rmail-mime-entity-segment (point) entity)))
580 (or (integerp (aref body 0)) (markerp (aref body 0))
581 (let ((data (buffer-string)))
583 (delete-region (point-min) (point-max))))
586 (if (eq (rmail-mime-display-header current)
587 (rmail-mime-display-header new))
588 (goto-char (aref segment 2))
589 (if (rmail-mime-display-header current)
590 (delete-char (- (aref segment 2) (aref segment 1))))
591 (if (rmail-mime-display-header new)
592 (rmail-mime-insert-header header)))
594 (if (eq (rmail-mime-display-tagline current)
595 (rmail-mime-display-tagline new))
596 (if (or (not (rmail-mime-display-tagline current))
597 (eq (rmail-mime-display-body current)
598 (rmail-mime-display-body new)))
599 (forward-char (- (aref segment 3) (aref segment 2)))
600 (rmail-mime-update-tagline entity))
601 (if (rmail-mime-display-tagline current)
602 (delete-char (- (aref segment 3) (aref segment 2))))
603 (if (rmail-mime-display-tagline new)
604 (rmail-mime-insert-tagline entity)))
606 (if (eq (rmail-mime-display-body current)
607 (rmail-mime-display-body new))
608 (forward-char (- (aref segment 4) (aref segment 3)))
609 (if (rmail-mime-display-body current)
610 (delete-char (- (aref segment 4) (aref segment 3))))
611 (if (rmail-mime-display-body new)
612 (rmail-mime-insert-decoded-text entity)))
613 (put-text-property beg (point) 'rmail-mime-entity entity)))
615 ;; FIXME move to the test/ directory?
616 (defun test-rmail-mime-handler ()
617 "Test of a mail using no MIME parts at all."
618 (let ((mail "To: alex@gnu.org
619 Content-Type: text/plain; charset=koi8-r
620 Content-Transfer-Encoding: 8bit
623 \372\304\322\301\327\323\324\327\325\312\324\305\41"))
624 (switch-to-buffer (get-buffer-create "*test*"))
626 (set-buffer-multibyte nil)
629 (set-buffer-multibyte t)))
632 (defun rmail-mime-insert-image (entity)
633 "Decode and insert the image body of MIME-entity ENTITY."
634 (let* ((content-type (car (rmail-mime-entity-type entity)))
635 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
636 (body (rmail-mime-entity-body entity))
638 (if (stringp (aref body 0))
639 (setq data (aref body 0))
640 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
641 (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
643 (set-buffer-multibyte nil)
644 (setq buffer-undo-list t)
645 (insert-buffer-substring rmail-mime-mbox-buffer
646 (aref body 0) (aref body 1))
647 (cond ((string= transfer-encoding "base64")
648 (ignore-errors (base64-decode-region (point-min) (point-max))))
649 ((string= transfer-encoding "quoted-printable")
650 (quoted-printable-decode-region (point-min) (point-max))))
652 (buffer-substring-no-properties (point-min) (point-max))))))
653 (insert-image (create-image data (cdr bulk-data) t))
656 (defun rmail-mime-toggle-button (button)
657 "Hide or show the body of the MIME-entity associated with BUTTON."
659 (goto-char (button-start button))
660 (rmail-mime-toggle-hidden)))
662 (define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)
665 (defun rmail-mime-bulk-handler (content-type
667 content-transfer-encoding)
668 "Handle the current buffer as an attachment to download.
669 For images that Emacs is capable of displaying, the behavior
670 depends upon the value of `rmail-mime-show-images'."
671 (rmail-mime-insert-bulk
672 (rmail-mime-entity content-type content-disposition content-transfer-encoding
673 (vector (vector nil nil nil) (vector nil t nil))
674 (vector nil nil nil) (vector "" (cons nil nil) t)
675 (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
677 (defun rmail-mime-set-bulk-data (entity)
678 "Setup the information about the attachment object for MIME-entity ENTITY.
679 The value is non-nil if and only if the attachment object should be shown
681 (let ((content-type (car (rmail-mime-entity-type entity)))
682 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
683 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
684 (body (rmail-mime-entity-body entity))
687 (setq size (string-to-number size)))
688 ((stringp (aref body 0))
689 (setq size (length (aref body 0))))
691 ;; Rough estimation of the size.
692 (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
693 (setq size (- (aref body 1) (aref body 0)))
694 (cond ((string= encoding "base64")
695 (setq size (/ (* size 3) 4)))
696 ((string= encoding "quoted-printable")
697 (setq size (/ (* size 7) 3)))))))
700 ((string-match "text/" content-type)
702 ((string-match "image/\\(.*\\)" content-type)
703 (setq type (image-type-from-file-name
704 (concat "." (match-string 1 content-type))))
705 (if (and (memq type image-types)
706 (image-type-available-p type))
707 (if (and rmail-mime-show-images
708 (not (eq rmail-mime-show-images 'button))
709 (or (not (numberp rmail-mime-show-images))
710 (< size rmail-mime-show-images)))
713 (setcar bulk-data size)
714 (setcdr bulk-data type)
717 (defun rmail-mime-insert-bulk (entity)
718 "Presentation handler for an attachment MIME entity."
719 (let* ((content-type (rmail-mime-entity-type entity))
720 (content-disposition (rmail-mime-entity-disposition entity))
721 (current (aref (rmail-mime-entity-display entity) 0))
722 (new (aref (rmail-mime-entity-display entity) 1))
723 (header (rmail-mime-entity-header entity))
724 (tagline (rmail-mime-entity-tagline entity))
725 (bulk-data (aref tagline 1))
726 (body (rmail-mime-entity-body entity))
727 ;; Find the default directory for this media type.
728 (directory (catch 'directory
729 (dolist (entry rmail-mime-attachment-dirs-alist)
730 (when (string-match (car entry) (car content-type))
731 (dolist (dir (cdr entry))
732 (when (file-directory-p dir)
733 (throw 'directory dir)))))))
734 (filename (or (cdr (assq 'name (cdr content-type)))
735 (cdr (assq 'filename (cdr content-disposition)))
737 (units '(B kB MB GB))
738 (segment (rmail-mime-entity-segment (point) entity))
741 (if (or (integerp (aref body 0)) (markerp (aref body 0)))
743 size (car bulk-data))
744 (if (stringp (aref body 0))
745 (setq data (aref body 0))
746 (setq data (string-as-unibyte (buffer-string)))
748 (rmail-mime-set-bulk-data entity)
749 (delete-region (point-min) (point-max)))
750 (setq size (length data)))
751 (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
753 (setq size (/ size 1024.0)
759 (if (eq (rmail-mime-display-header current)
760 (rmail-mime-display-header new))
761 (goto-char (aref segment 2))
762 (if (rmail-mime-display-header current)
763 (delete-char (- (aref segment 2) (aref segment 1))))
764 (if (rmail-mime-display-header new)
765 (rmail-mime-insert-header header)))
768 (if (eq (rmail-mime-display-tagline current)
769 (rmail-mime-display-tagline new))
770 (if (or (not (rmail-mime-display-tagline current))
771 (eq (rmail-mime-display-body current)
772 (rmail-mime-display-body new)))
773 (forward-char (- (aref segment 3) (aref segment 2)))
774 (rmail-mime-update-tagline entity))
775 (if (rmail-mime-display-tagline current)
776 (delete-char (- (aref segment 3) (aref segment 2))))
777 (if (rmail-mime-display-tagline new)
778 (rmail-mime-insert-tagline
782 :type 'rmail-mime-save
783 'help-echo "mouse-2, RET: Save attachment"
785 'directory (file-name-as-directory directory)
787 (format " (%.0f%s)" size (car units))
788 ;; We don't need this button because the "type" string of a
789 ;; tagline is the button to do this.
790 ;; (if (cdr bulk-data)
792 ;; (if (cdr bulk-data)
793 ;; (list "Toggle show/hide"
794 ;; :type 'rmail-mime-image
795 ;; 'help-echo "mouse-2, RET: Toggle show/hide"
796 ;; 'image-type (cdr bulk-data)
797 ;; 'image-data data))
800 (if (eq (rmail-mime-display-body current)
801 (rmail-mime-display-body new))
802 (forward-char (- (aref segment 4) (aref segment 3)))
803 (if (rmail-mime-display-body current)
804 (delete-char (- (aref segment 4) (aref segment 3))))
805 (if (rmail-mime-display-body new)
806 (cond ((eq (cdr bulk-data) 'text)
807 (rmail-mime-insert-decoded-text entity))
809 (rmail-mime-insert-image entity))
811 ;; As we don't know how to display the body, just
812 ;; insert it as a text.
813 (rmail-mime-insert-decoded-text entity)))))
814 (put-text-property beg (point) 'rmail-mime-entity entity)))
816 (defun test-rmail-mime-bulk-handler ()
817 "Test of a mail used as an example in RFC 2183."
818 (let ((mail "Content-Type: image/jpeg
819 Content-Disposition: attachment; filename=genome.jpeg;
820 modification-date=\"Wed, 12 Feb 1997 16:29:51 -0500\";
821 Content-Description: a complete map of the human genome
822 Content-Transfer-Encoding: base64
824 iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAMAAABg3Am1AAAABGdBTUEAALGPC/xhBQAAAAZQ
825 TFRF////AAAAVcLTfgAAAPZJREFUeNq9ldsOwzAIQ+3//+l1WlvA5ZLsoUiTto4TB+ISoAjy
826 +ITfRBfcAmgRFFeAm+J6uhdKdFhFWUgDkFsK0oUp/9G2//Kj7Jx+5tSKOdBscgUYiKHRS/me
827 WATQdRUvAK0Bnmshmtn79PpaLBbbOZkjKvRnjRZoRswOkG1wFchKew2g9wXVJVZL/m4+B+vv
828 9AxQQR2Q33SgAYJzzVACdAWjAfRYzYFO9n6SLnydtQHSMxYDMAKqZ/8FS/lTK+zuq3CtK64L
829 UDwbgUEAUmk2Zyg101d6PhCDySgAvTvDgKiuOrc4dLxUb7UMnhGIexyI+d6U+ABuNAP4Simx
832 (switch-to-buffer (get-buffer-create "*test*"))
837 (defun rmail-mime-multipart-handler (content-type
839 content-transfer-encoding)
840 "Handle the current buffer as a multipart MIME body.
841 The current buffer should be narrowed to the body. CONTENT-TYPE,
842 CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
843 of the respective parsed headers. See `rmail-mime-handle' for their
845 (rmail-mime-process-multipart
846 content-type content-disposition content-transfer-encoding nil)
849 (defun rmail-mime-process-multipart (content-type
851 content-transfer-encoding
853 "Process the current buffer as a multipart MIME body.
855 If PARSE-TAG is nil, modify the current buffer directly for
856 showing the MIME body and return nil.
858 Otherwise, PARSE-TAG is a string indicating the depth and index
859 number of the entity. In this case, parse the current buffer and
860 return a list of MIME-entity objects.
862 The other arguments are the same as `rmail-mime-multipart-handler'."
863 ;; Some MUAs start boundaries with "--", while it should start
864 ;; with "CRLF--", as defined by RFC 2046:
865 ;; The boundary delimiter MUST occur at the beginning of a line,
866 ;; i.e., following a CRLF, and the initial CRLF is considered to
867 ;; be attached to the boundary delimiter line rather than part
868 ;; of the preceding part.
869 ;; We currently don't handle that.
870 (let ((boundary (cdr (assq 'boundary content-type)))
871 (subtype (cadr (split-string (car content-type) "/")))
873 beg end next entities truncated)
875 (rmail-mm-get-boundary-error-message
876 "No boundary defined" content-type content-disposition
877 content-transfer-encoding))
878 (setq boundary (concat "\n--" boundary))
879 ;; Hide the body before the first bodypart
880 (goto-char (point-min))
881 (when (and (search-forward boundary nil t)
882 (looking-at "[ \t]*\n"))
884 (narrow-to-region (match-end 0) (point-max))
885 (delete-region (point-min) (match-end 0))))
887 ;; Change content-type to the proper default one for the children.
888 (cond ((string-match "mixed" subtype)
889 (setq content-type '("text/plain")))
890 ((string-match "digest" subtype)
891 (setq content-type '("message/rfc822")))
893 (setq content-type nil)))
895 ;; Loop over all body parts, where beg points at the beginning of
896 ;; the part and end points at the end of the part. next points at
897 ;; the beginning of the next part. The current point is just
898 ;; after the boundary tag.
899 (setq beg (point-min))
901 (while (or (and (search-forward boundary nil t)
902 (setq truncated nil end (match-beginning 0)))
903 ;; If the boundary does not appear at all,
904 ;; the message was truncated.
905 ;; Handle the rest of the truncated message
906 ;; (if it isn't empty) by pretending that the boundary
907 ;; appears at the end of the message.
909 (skip-chars-forward "\n")
910 (> (point-max) (point)))
911 (setq truncated t end (point-max))))
912 ;; If this is the last boundary according to RFC 2046, hide the
913 ;; epilogue, else hide the boundary only. Use a marker for
914 ;; `next' because `rmail-mime-show' may change the buffer.
915 (cond ((looking-at "--[ \t]*$")
916 (setq next (point-max-marker)))
917 ((looking-at "[ \t]*\n")
918 (setq next (copy-marker (match-end 0) t)))
920 ;; We're handling what's left of a truncated message.
921 (setq next (point-max-marker)))
923 ;; The original code signaled an error as below, but
924 ;; this line may be a boundary of nested multipart. So,
925 ;; we just set `next' to nil to skip this line
926 ;; (rmail-mm-get-boundary-error-message
927 ;; "Malformed boundary" content-type content-disposition
928 ;; content-transfer-encoding)
932 (setq index (1+ index))
936 (narrow-to-region beg end)
937 (let ((child (rmail-mime-process
938 nil (format "%s/%d" parse-tag index)
939 content-type content-disposition)))
940 ;; Display a tagline.
941 (aset (aref (rmail-mime-entity-display child) 1) 1
942 (aset (rmail-mime-entity-tagline child) 2 t))
943 (rmail-mime-entity-set-truncated child truncated)
944 (push child entities)))
946 (delete-region end next)
948 (narrow-to-region beg end)
950 (goto-char (setq beg next))))
953 (setq entities (nreverse entities))
954 (if (string-match "alternative" subtype)
955 ;; Find the best entity to show, and hide all the others.
957 (dolist (child entities)
958 (if (string= (or (car (rmail-mime-entity-disposition child))
959 (car content-disposition))
961 (if (string-match "text/plain"
962 (car (rmail-mime-entity-type child)))
964 (if (string-match "text/.*"
965 (car (rmail-mime-entity-type child)))
966 (setq second child)))))
967 (or best (not second) (setq best second))
968 (dolist (child entities)
969 (unless (eq best child)
970 (aset (rmail-mime-entity-body child) 2 nil)
971 (rmail-mime-hidden-mode child)))))
974 (defun test-rmail-mime-multipart-handler ()
975 "Test of a mail used as an example in RFC 2046."
976 (let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com>
977 To: Ned Freed <ned@innosoft.com>
978 Date: Sun, 21 Mar 1993 23:56:48 -0800 (PST)
979 Subject: Sample message
981 Content-type: multipart/mixed; boundary=\"simple boundary\"
983 This is the preamble. It is to be ignored, though it
984 is a handy place for composition agents to include an
985 explanatory note to non-MIME conformant readers.
989 This is implicitly typed plain US-ASCII text.
990 It does NOT end with a linebreak.
992 Content-type: text/plain; charset=us-ascii
994 This is explicitly typed plain US-ASCII text.
995 It DOES end with a linebreak.
999 This is the epilogue. It is also to be ignored."))
1000 (switch-to-buffer (get-buffer-create "*test*"))
1003 (rmail-mime-show t)))
1005 (defun rmail-mime-insert-multipart (entity)
1006 "Presentation handler for a multipart MIME entity."
1007 (let ((current (aref (rmail-mime-entity-display entity) 0))
1008 (new (aref (rmail-mime-entity-display entity) 1))
1009 (header (rmail-mime-entity-header entity))
1010 (tagline (rmail-mime-entity-tagline entity))
1011 (body (rmail-mime-entity-body entity))
1013 (segment (rmail-mime-entity-segment (point) entity)))
1015 (if (eq (rmail-mime-display-header current)
1016 (rmail-mime-display-header new))
1017 (goto-char (aref segment 2))
1018 (if (rmail-mime-display-header current)
1019 (delete-char (- (aref segment 2) (aref segment 1))))
1020 (if (rmail-mime-display-header new)
1021 (rmail-mime-insert-header header)))
1023 (if (eq (rmail-mime-display-tagline current)
1024 (rmail-mime-display-tagline new))
1025 (if (or (not (rmail-mime-display-tagline current))
1026 (eq (rmail-mime-display-body current)
1027 (rmail-mime-display-body new)))
1028 (forward-char (- (aref segment 3) (aref segment 2)))
1029 (rmail-mime-update-tagline entity))
1030 (if (rmail-mime-display-tagline current)
1031 (delete-char (- (aref segment 3) (aref segment 2))))
1032 (if (rmail-mime-display-tagline new)
1033 (rmail-mime-insert-tagline entity)))
1035 (put-text-property beg (point) 'rmail-mime-entity entity)
1038 (if (eq (rmail-mime-display-body current)
1039 (rmail-mime-display-body new))
1040 (forward-char (- (aref segment 4) (aref segment 3)))
1041 (dolist (child (rmail-mime-entity-children entity))
1042 (rmail-mime-insert child)))
1047 (defun rmail-mime-handle (content-type
1049 content-transfer-encoding)
1050 "Handle the current buffer as a MIME part.
1051 The current buffer should be narrowed to the respective body, and
1052 point should be at the beginning of the body.
1054 CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING
1055 are the values of the respective parsed headers. The latter should
1056 be lower-case. The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
1063 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
1065 VALUE is a string and ATTRIBUTE is a symbol.
1067 Consider the following header, for example:
1069 Content-Type: multipart/mixed;
1070 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
1072 The parsed header value:
1074 \(\"multipart/mixed\"
1075 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
1076 ;; Handle the content transfer encodings we know. Unknown transfer
1077 ;; encodings will be passed on to the various handlers.
1078 (cond ((string= content-transfer-encoding "base64")
1079 (when (ignore-errors
1080 (base64-decode-region (point) (point-max)))
1081 (setq content-transfer-encoding nil)))
1082 ((string= content-transfer-encoding "quoted-printable")
1083 (quoted-printable-decode-region (point) (point-max))
1084 (setq content-transfer-encoding nil))
1085 ((string= content-transfer-encoding "8bit")
1086 ;; FIXME: Is this the correct way?
1087 ;; No, of course not, it just means there's no decoding to do.
1088 ;; (set-buffer-multibyte nil)
1089 (setq content-transfer-encoding nil)
1091 ;; Inline stuff requires work. Attachments are handled by the bulk
1093 (if (string= "inline" (car content-disposition))
1095 (dolist (entry rmail-mime-media-type-handlers-alist)
1096 (when (and (string-match (car entry) (car content-type)) (not stop))
1098 (setq stop (funcall (cadr entry) content-type
1100 content-transfer-encoding))))))
1101 ;; Everything else is an attachment.
1102 (rmail-mime-bulk-handler content-type
1104 content-transfer-encoding))
1107 (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
1110 (setq current (aref (rmail-mime-entity-display entity) 0)
1111 new (aref (rmail-mime-entity-display entity) 1))
1113 (aset current i (aref new i)))))))
1115 (defun rmail-mime-show (&optional show-headers)
1116 "Handle the current buffer as a MIME message.
1117 If SHOW-HEADERS is non-nil, then the headers of the current part
1118 will shown as usual for a MIME message. The headers are also
1119 shown for the content type message/rfc822. This function will be
1120 called recursively if multiple parts are available.
1122 The current buffer must contain a single message. It will be
1124 (rmail-mime-process show-headers nil))
1126 (defun rmail-mime-process (show-headers parse-tag &optional
1127 default-content-type
1128 default-content-disposition)
1129 (let ((end (point-min))
1131 content-transfer-encoding
1132 content-disposition)
1133 ;; `point-min' returns the beginning and `end' points at the end
1135 (goto-char (point-min))
1136 ;; If we're showing a part without headers, then it will start
1138 (if (eq (char-after) ?\n)
1139 (setq end (1+ (point)))
1140 (when (search-forward "\n\n" nil t)
1141 (setq end (match-end 0))
1143 (narrow-to-region (point-min) end)
1144 ;; FIXME: Default disposition of the multipart entities should
1147 (mail-fetch-field "Content-Type")
1148 content-transfer-encoding
1149 (mail-fetch-field "Content-Transfer-Encoding")
1151 (mail-fetch-field "Content-Disposition")))))
1152 ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
1153 ;; are not completely so. Hopefully mail-header-parse-* DTRT.
1154 (if content-transfer-encoding
1155 (setq content-transfer-encoding (downcase content-transfer-encoding)))
1158 (or (mail-header-parse-content-type content-type)
1160 (or default-content-type '("text/plain"))))
1161 (setq content-disposition
1162 (if content-disposition
1163 (mail-header-parse-content-disposition content-disposition)
1164 ;; If none specified, we are free to choose what we deem
1165 ;; suitable according to RFC 2183. We like inline.
1166 (or default-content-disposition '("inline"))))
1167 ;; Unrecognized disposition types are to be treated like
1168 ;; attachment according to RFC 2183.
1169 (unless (member (car content-disposition) '("inline" "attachment"))
1170 (setq content-disposition '("attachment")))
1173 (let* ((is-inline (string= (car content-disposition) "inline"))
1174 (hdr-end (copy-marker end))
1175 (header (vector (point-min-marker) hdr-end nil))
1176 (tagline (vector parse-tag (cons nil nil) t))
1177 (body (vector hdr-end (point-max-marker) is-inline))
1178 (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
1179 children handler entity)
1180 (cond ((string-match "multipart/.*" (car content-type))
1182 (narrow-to-region (1- end) (point-max))
1183 (setq children (rmail-mime-process-multipart
1186 content-transfer-encoding
1188 handler 'rmail-mime-insert-multipart)))
1189 ((string-match "message/rfc822" (car content-type))
1191 (narrow-to-region end (point-max))
1192 (let* ((msg (rmail-mime-process t parse-tag
1193 '("text/plain") '("inline")))
1194 (msg-new (aref (rmail-mime-entity-display msg) 1)))
1195 ;; Show header of the child.
1197 (aset (rmail-mime-entity-header msg) 2 t)
1198 ;; Hide tagline of the child.
1199 (aset msg-new 1 nil)
1200 (aset (rmail-mime-entity-tagline msg) 2 nil)
1201 (setq children (list msg)
1202 handler 'rmail-mime-insert-multipart))))
1203 ((and is-inline (string-match "text/" (car content-type)))
1204 ;; Don't need a tagline.
1205 (aset new 1 (aset tagline 2 nil))
1206 (setq handler 'rmail-mime-insert-text))
1208 ;; Force hidden mode.
1209 (aset new 1 (aset tagline 2 t))
1210 (aset new 2 (aset body 2 nil))
1211 (setq handler 'rmail-mime-insert-bulk)))
1212 (setq entity (rmail-mime-entity content-type
1214 content-transfer-encoding
1215 (vector (vector nil nil nil) new)
1216 header tagline body children handler))
1217 (if (and (eq handler 'rmail-mime-insert-bulk)
1218 (rmail-mime-set-bulk-data entity))
1220 (aset new 2 (aset body 2 t)))
1223 ;; Hide headers and handle the part.
1224 (put-text-property (point-min) (point-max) 'rmail-mime-entity
1226 content-type content-disposition
1227 content-transfer-encoding
1228 (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
1229 (vector nil nil 'raw) (vector "" (cons nil nil) nil)
1230 (vector nil nil 'raw) nil nil))
1232 (cond ((string= (car content-type) "message/rfc822")
1233 (narrow-to-region end (point-max)))
1235 (delete-region (point-min) end)))
1236 (rmail-mime-handle content-type content-disposition
1237 content-transfer-encoding)))))
1239 (defun rmail-mime-parse ()
1240 "Parse the current Rmail message as a MIME message.
1241 The value is a MIME-entity object (see `rmail-mime-entity').
1242 If an error occurs, return an error message string."
1243 (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
1247 (with-current-buffer rmail-mime-mbox-buffer
1249 (goto-char (point-min))
1250 (let* ((entity (rmail-mime-process t ""
1251 '("text/plain") '("inline")))
1252 (new (aref (rmail-mime-entity-display entity) 1)))
1254 (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
1255 ;; Show tagline if and only if body is not shown.
1257 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
1258 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
1260 (error (format "%s" err)))))
1262 (defun rmail-mime-insert (entity)
1263 "Insert a MIME-entity ENTITY in the current buffer.
1265 This function will be called recursively if multiple parts are
1267 (let ((current (aref (rmail-mime-entity-display entity) 0))
1268 (new (aref (rmail-mime-entity-display entity) 1)))
1269 (if (not (eq (rmail-mime-display-header new) 'raw))
1270 ;; Not a raw-mode. Each handler should handle it.
1271 (funcall (rmail-mime-entity-handler entity) entity)
1272 (let ((header (rmail-mime-entity-header entity))
1273 (tagline (rmail-mime-entity-tagline entity))
1274 (body (rmail-mime-entity-body entity))
1276 (segment (rmail-mime-entity-segment (point) entity)))
1278 (if (eq (rmail-mime-display-header current)
1279 (rmail-mime-display-header new))
1280 (goto-char (aref segment 2))
1281 (if (rmail-mime-display-header current)
1282 (delete-char (- (aref segment 2) (aref segment 1))))
1283 (insert-buffer-substring rmail-mime-mbox-buffer
1284 (aref header 0) (aref header 1)))
1286 (if (rmail-mime-display-tagline current)
1287 (delete-char (- (aref segment 3) (aref segment 2))))
1289 (let ((children (rmail-mime-entity-children entity)))
1292 (put-text-property beg (point) 'rmail-mime-entity entity)
1293 (dolist (child children)
1294 (rmail-mime-insert child)))
1295 (if (eq (rmail-mime-display-body current)
1296 (rmail-mime-display-body new))
1297 (forward-char (- (aref segment 4) (aref segment 3)))
1298 (if (rmail-mime-display-body current)
1299 (delete-char (- (aref segment 4) (aref segment 3))))
1300 (insert-buffer-substring rmail-mime-mbox-buffer
1301 (aref body 0) (aref body 1))
1302 (or (bolp) (insert "\n")))
1303 (put-text-property beg (point) 'rmail-mime-entity entity)))))
1305 (aset current i (aref new i)))))
1307 (define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
1308 "Major mode used in `rmail-mime' buffers."
1309 (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
1312 (defun rmail-mime (&optional arg state)
1313 "Toggle the display of a MIME message.
1315 The actual behavior depends on the value of `rmail-enable-mime'.
1317 If `rmail-enable-mime' is non-nil (the default), this command toggles
1318 the display of a MIME message between decoded presentation form and
1319 raw data. With optional prefix argument ARG, it toggles the display only
1320 of the MIME entity at point, if there is one. The optional argument
1321 STATE forces a particular display state, rather than toggling.
1322 `raw' forces raw mode, any other non-nil value forces decoded mode.
1324 If `rmail-enable-mime' is nil, this creates a temporary \"*RMAIL*\"
1325 buffer holding a decoded copy of the message. Inline content-types are
1326 handled according to `rmail-mime-media-type-handlers-alist'.
1327 By default, this displays text and multipart messages, and offers to
1328 download attachments as specified by `rmail-mime-attachment-dirs-alist'.
1329 The arguments ARG and STATE have no effect in this case."
1330 (interactive (list current-prefix-arg nil))
1331 (if rmail-enable-mime
1332 (with-current-buffer rmail-buffer
1333 (if (rmail-mime-message-p)
1334 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
1335 (rmail-mime-view-buffer rmail-buffer)
1336 (entity (get-text-property
1338 (or arg (goto-char (point-min)))
1339 (point)) 'rmail-mime-entity)))
1340 (if (or (not arg) entity) (rmail-mime-toggle-raw state)))
1341 (message "Not a MIME message")))
1342 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
1343 (buf (get-buffer-create "*RMAIL*"))
1344 (rmail-mime-mbox-buffer rmail-view-buffer)
1345 (rmail-mime-view-buffer buf))
1347 (setq buffer-undo-list t)
1348 (let ((inhibit-read-only t))
1349 ;; Decoding the message in fundamental mode for speed, only
1350 ;; switching to rmail-mime-mode at the end for display. Eg
1351 ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
1357 (set-buffer-modified-p nil))
1358 (view-buffer buf))))
1360 (defun rmail-mm-get-boundary-error-message (message type disposition encoding)
1361 "Return MESSAGE with more information on the main MIME components."
1362 (error "%s; type: %s; disposition: %s; encoding: %s"
1363 message type disposition encoding))
1365 (defun rmail-show-mime ()
1366 "Function to use for the value of `rmail-show-mime-function'."
1367 (let ((entity (rmail-mime-parse))
1368 (rmail-mime-mbox-buffer rmail-buffer)
1369 (rmail-mime-view-buffer rmail-view-buffer)
1370 (rmail-mime-coding-system nil))
1371 (if (vectorp entity)
1372 (with-current-buffer rmail-mime-view-buffer
1374 (rmail-mime-insert entity)
1375 (if (consp rmail-mime-coding-system)
1376 ;; Decoding is done by rfc2047-decode-region only for a
1377 ;; header. But, as the used coding system may have been
1378 ;; overridden by mm-charset-override-alist, we can't
1379 ;; trust (car rmail-mime-coding-system). So, here we
1380 ;; try the decoding again with mm-charset-override-alist
1382 (let ((mm-charset-override-alist nil))
1383 (setq rmail-mime-coding-system
1384 (rmail-mime-find-header-encoding
1385 (rmail-mime-entity-header entity)))))
1386 (set-buffer-file-coding-system
1387 (if rmail-mime-coding-system
1388 (coding-system-base rmail-mime-coding-system)
1391 ;; Decoding failed. ENTITY is an error message. Insert the
1392 ;; original message body as is, and show warning.
1393 (let ((region (with-current-buffer rmail-mime-mbox-buffer
1394 (goto-char (point-min))
1395 (re-search-forward "^$" nil t)
1397 (vector (point-min) (point) (point-max)))))
1398 (with-current-buffer rmail-mime-view-buffer
1399 (let ((inhibit-read-only t))
1401 (rmail-mime-insert-header region)
1402 (insert-buffer-substring rmail-mime-mbox-buffer
1403 (aref region 1) (aref region 2))))
1404 (set-buffer-file-coding-system 'no-conversion t t)
1405 (message "MIME decoding failed: %s" entity)))))
1407 (setq rmail-show-mime-function 'rmail-show-mime)
1409 (defun rmail-insert-mime-forwarded-message (forward-buffer)
1410 "Insert the message in FORWARD-BUFFER as a forwarded message.
1411 This is the usual value of `rmail-insert-mime-forwarded-message-function'."
1412 (let ((message-buffer
1413 (with-current-buffer forward-buffer
1414 (if rmail-buffer-swapped
1416 rmail-view-buffer))))
1418 (narrow-to-region (point) (point))
1419 (message-forward-make-body-mime message-buffer))))
1421 (setq rmail-insert-mime-forwarded-message-function
1422 'rmail-insert-mime-forwarded-message)
1424 (defun rmail-insert-mime-resent-message (forward-buffer)
1425 "Function to set in `rmail-insert-mime-resent-message-function' (which see)."
1426 (insert-buffer-substring
1427 (with-current-buffer forward-buffer rmail-view-buffer))
1428 (goto-char (point-min))
1429 (when (looking-at "From ")
1431 (delete-region (point-min) (point))))
1433 (setq rmail-insert-mime-resent-message-function
1434 'rmail-insert-mime-resent-message)
1436 (defun rmail-search-mime-message (msg regexp)
1437 "Function to set in `rmail-search-mime-message-function' (which see)."
1439 (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
1440 (let* ((rmail-mime-mbox-buffer (current-buffer))
1441 (rmail-mime-view-buffer rmail-view-buffer)
1442 (header-end (save-excursion
1443 (re-search-forward "^$" nil 'move) (point)))
1444 (body-end (point-max))
1445 (entity (rmail-mime-parse)))
1447 ;; At first, just search the headers.
1449 (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
1450 (rfc2047-decode-region (point-min) (point))
1451 (goto-char (point-min))
1452 (re-search-forward regexp nil t))
1453 ;; Next, search the body.
1455 ;; RMS: I am not sure why, but sometimes this is a string.
1456 (not (stringp entity))
1457 (let* ((content-type (rmail-mime-entity-type entity))
1458 (charset (cdr (assq 'charset (cdr content-type)))))
1459 (or (not (string-match "text/.*" (car content-type)))
1461 (not (string= (downcase charset) "us-ascii"))))))
1462 ;; Search the decoded MIME message.
1464 (rmail-mime-insert entity)
1465 (goto-char (point-min))
1466 (re-search-forward regexp nil t))
1467 ;; Search the body without decoding.
1468 (goto-char header-end)
1469 (re-search-forward regexp nil t))))))
1471 (setq rmail-search-mime-message-function 'rmail-search-mime-message)
1476 ;; generated-autoload-file: "rmail.el"
1479 ;;; rmailmm.el ends here