1 ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 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)
157 "Retrun a newly created MIME-entity object from arguments.
159 A MIME-entity is a vector of 9 elements:
161 [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
164 TYPE and DISPOSITION correspond to MIME headers Content-Type and
165 Cotent-Disposition respectively, and has this format:
167 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
169 VALUE is a string and ATTRIBUTE is a symbol.
171 Consider the following header, for example:
173 Content-Type: multipart/mixed;
174 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
176 The corresponding TYPE argument must be:
178 \(\"multipart/mixed\"
179 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
181 TRANSFER-ENCODING corresponds to MIME header
182 Content-Transfer-Encoding, and is a lowercased string.
184 DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
185 the header, tagline, and body of the entity are displayed now,
186 and NEW indicates how their displaying should be updated.
187 Both elements are vector [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
188 where each element is a symbol for the corresponding item that
191 t: displayed by the decoded presentation form
192 raw: displayed by the raw MIME data (for the header and body only)
194 HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
195 END specify the region of the header or body lines in RMAIL's
196 data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
197 header or body is, by default, displayed by the decoded
200 TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
201 string indicating the depth and index number of the entity,
202 BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
203 an attached data, DISPLAY-FLAG non-nil means that the tagline is,
204 by default, displayed.
206 CHILDREN is a list of child MIME-entities. A \"multipart/*\"
207 entity have one or more children. A \"message/rfc822\" entity
208 has just one child. Any other entity has no child.
210 HANDLER is a function to insert the entity according to DISPLAY.
211 It is called with one argument ENTITY."
212 (vector type disposition transfer-encoding
213 display header tagline body children handler))
215 ;; Accessors for a MIME-entity object.
216 (defsubst rmail-mime-entity-type (entity) (aref entity 0))
217 (defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
218 (defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
219 (defsubst rmail-mime-entity-display (entity) (aref entity 3))
220 (defsubst rmail-mime-entity-header (entity) (aref entity 4))
221 (defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
222 (defsubst rmail-mime-entity-body (entity) (aref entity 6))
223 (defsubst rmail-mime-entity-children (entity) (aref entity 7))
224 (defsubst rmail-mime-entity-handler (entity) (aref entity 8))
226 (defsubst rmail-mime-message-p ()
227 "Non-nil if and only if the current message is a MIME."
228 (or (get-text-property (point) 'rmail-mime-entity)
229 (get-text-property (point-min) 'rmail-mime-entity)))
233 (defun rmail-mime-save (button)
234 "Save the attachment using info in the BUTTON."
235 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
236 (filename (button-get button 'filename))
237 (directory (button-get button 'directory))
238 (data (button-get button 'data))
239 (ofilename filename))
240 (setq filename (expand-file-name
241 (read-file-name (format "Save as (default: %s): " filename)
243 (expand-file-name filename directory))
245 ;; If arg is just a directory, use the default file name, but in
246 ;; that directory (copied from write-file).
247 (if (file-directory-p filename)
248 (setq filename (expand-file-name
249 (file-name-nondirectory ofilename)
250 (file-name-as-directory filename))))
252 (set-buffer-file-coding-system 'no-conversion)
253 ;; Needed e.g. by jka-compr, so if the attachment is a compressed
254 ;; file, the magic signature compares equal with the unibyte
255 ;; signature string recorded in jka-compr-compression-info-list.
256 (set-buffer-multibyte nil)
257 (setq buffer-undo-list t)
260 ;; DATA is a MIME-entity object.
261 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
262 (body (rmail-mime-entity-body data)))
263 (insert-buffer-substring rmail-mime-mbox-buffer
264 (aref body 0) (aref body 1))
265 (cond ((string= transfer-encoding "base64")
266 (ignore-errors (base64-decode-region (point-min) (point-max))))
267 ((string= transfer-encoding "quoted-printable")
268 (quoted-printable-decode-region (point-min) (point-max))))))
269 (write-region nil nil filename nil nil nil t))))
271 (define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
273 (defun rmail-mime-entity-segment (pos &optional entity)
274 "Return a vector describing the displayed region of a MIME-entity at POS.
275 Optional 2nd argument ENTITY is the MIME-entity at POS.
276 The value is a vector [ INDEX HEADER TAGLINE BODY END], where
277 HEADER: the position of the beginning of a header
278 TAGLINE: the position of the beginning of a tagline
279 BODY: the position of the beginning of a body
280 END: the position of the end of the entity.
281 INDEX: index into the returned vector indicating where POS is."
284 (setq entity (get-text-property pos 'rmail-mime-entity)))
286 (vector 1 (point) (point) (point) (point))
287 (let ((current (aref (rmail-mime-entity-display entity) 0))
288 (beg (if (and (> pos (point-min))
289 (eq (get-text-property (1- pos) 'rmail-mime-entity)
291 (previous-single-property-change pos 'rmail-mime-entity
295 tagline-beg body-beg end)
298 (search-forward "\n\n" nil t))
299 (setq tagline-beg (point))
300 (if (>= pos tagline-beg)
304 (setq body-beg (point))
305 (if (>= pos body-beg)
308 (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
310 (setq end (next-single-property-change beg 'rmail-mime-entity
312 (while (and (< end (point-max))
313 (setq entity (get-text-property end 'rmail-mime-entity)
314 tag2 (aref (rmail-mime-entity-tagline entity) 0))
315 (and (> (length tag2) 0)
316 (eq (string-match tag tag2) 0)))
317 (setq end (next-single-property-change end 'rmail-mime-entity
320 (vector index beg tagline-beg body-beg end)))))
322 (defun rmail-mime-next-item ()
323 "Move point to the next displayed item of the current MIME entity.
324 A MIME entity has three items; header, tagline, and body.
325 If we are in the last item of the entity, move point to the first
326 item of the next entity. If we reach the end of buffer, move
327 point to the first item of the first entity (i.e. the beginning
330 (if (rmail-mime-message-p)
331 (let* ((segment (rmail-mime-entity-segment (point)))
332 (next-pos (aref segment (1+ (aref segment 0))))
333 (button (next-button (point))))
334 (goto-char (if (and button (< (button-start button) next-pos))
335 (button-start button)
338 (goto-char (point-min))))))
340 (defun rmail-mime-previous-item ()
341 "Move point to the previous displayed item of the current MIME message.
342 A MIME entity has three items; header, tagline, and body.
343 If we are at the beginning of the first item of the entity, move
344 point to the last item of the previous entity. If we reach the
345 beginning of buffer, move point to the last item of the last
348 (when (rmail-mime-message-p)
350 (goto-char (point-max)))
351 (let* ((segment (rmail-mime-entity-segment (1- (point))))
352 (prev-pos (aref segment (aref segment 0)))
353 (button (previous-button (point))))
354 (goto-char (if (and button (> (button-start button) prev-pos))
355 (button-start button)
358 (defun rmail-mime-shown-mode (entity)
359 "Make MIME-entity ENTITY displayed by the default way."
360 (let ((new (aref (rmail-mime-entity-display entity) 1)))
361 (aset new 0 (aref (rmail-mime-entity-header entity) 2))
362 (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
363 (aset new 2 (aref (rmail-mime-entity-body entity) 2))))
365 (defun rmail-mime-hidden-mode (entity top)
366 "Make MIME-entity ENTITY displayed in the hidden mode.
367 If TOP is non-nil, display ENTITY only by the tagline.
368 Otherwise, don't display ENTITY."
370 (let ((new (aref (rmail-mime-entity-display entity) 1)))
374 (aset (rmail-mime-entity-body entity) 2 nil))
375 (let ((current (aref (rmail-mime-entity-display entity) 0)))
378 (aset current 2 nil)))
379 (dolist (child (rmail-mime-entity-children entity))
380 (rmail-mime-hidden-mode child nil)))
382 (defun rmail-mime-raw-mode (entity)
383 "Make MIME-entity ENTITY displayed in the raw mode."
384 (let ((new (aref (rmail-mime-entity-display entity) 1)))
388 (dolist (child (rmail-mime-entity-children entity))
389 (rmail-mime-hidden-mode child nil))))
391 (defun rmail-mime-toggle-raw (entity)
392 "Toggle on and off the raw display mode of MIME-entity ENTITY."
393 (let* ((pos (if (eobp) (1- (point-max)) (point)))
394 (entity (get-text-property pos 'rmail-mime-entity))
395 (current (aref (rmail-mime-entity-display entity) 0))
396 (segment (rmail-mime-entity-segment pos entity)))
397 (if (not (eq (aref current 0) 'raw))
398 ;; Enter the raw mode.
399 (rmail-mime-raw-mode entity)
400 ;; Enter the shown mode.
401 (rmail-mime-shown-mode entity))
402 (let ((inhibit-read-only t)
403 (modified (buffer-modified-p)))
405 (goto-char (aref segment 1))
406 (rmail-mime-insert entity)
407 (restore-buffer-modified-p modified)))))
409 (defun rmail-mime-toggle-hidden ()
410 "Toggle on and off the hidden display mode of MIME-entity ENTITY."
412 (when (rmail-mime-message-p)
413 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
414 (rmail-mime-view-buffer (current-buffer))
415 (pos (if (eobp) (1- (point-max)) (point)))
416 (entity (get-text-property pos 'rmail-mime-entity))
417 (current (aref (rmail-mime-entity-display entity) 0))
418 (segment (rmail-mime-entity-segment pos entity)))
420 ;; Enter the hidden mode.
422 ;; If point is in the body part, move it to the tagline
423 ;; (or the header if headline is not displayed).
424 (if (= (aref segment 0) 3)
425 (goto-char (aref segment 2)))
426 (rmail-mime-hidden-mode entity t)
427 ;; If the current entity is the topmost one, display the
429 (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
430 (let ((new (aref (rmail-mime-entity-display entity) 1)))
432 ;; Enter the shown mode.
433 (aset (rmail-mime-entity-body entity) 2 t)
434 (rmail-mime-shown-mode entity))
435 (let ((inhibit-read-only t)
436 (modified (buffer-modified-p))
437 (rmail-mime-mbox-buffer rmail-view-buffer)
438 (rmail-mime-view-buffer rmail-buffer))
440 (goto-char (aref segment 1))
441 (rmail-mime-insert entity)
442 (restore-buffer-modified-p modified))))))
444 (define-key rmail-mode-map "\t" 'rmail-mime-next-item)
445 (define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
446 (define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
450 (defun rmail-mime-insert-tagline (entity &rest item-list)
451 "Insert a tag line for MIME-entity ENTITY.
452 ITEM-LIST is a list of strings or button-elements (list) to be added
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 (dolist (item item-list)
462 (apply 'insert-button item))))
465 (defun rmail-mime-insert-header (header)
466 "Decode and insert a MIME-entity header HEADER in the current buffer.
467 HEADER is a vector [BEG END DEFAULT-STATUS].
468 See `rmail-mime-entity' for the detail."
470 (last-coding-system-used nil))
472 (narrow-to-region pos pos)
473 (with-current-buffer rmail-mime-mbox-buffer
474 (let ((rmail-buffer rmail-mime-mbox-buffer)
475 (rmail-view-buffer rmail-mime-view-buffer))
477 (goto-char (aref header 0))
478 (rmail-copy-headers (point) (aref header 1)))))
479 (rfc2047-decode-region pos (point))
480 (if (and last-coding-system-used (not rmail-mime-coding-system))
481 (setq rmail-mime-coding-system last-coding-system-used))
482 (goto-char (point-min))
483 (rmail-highlight-headers)
484 (goto-char (point-max))
487 (defun rmail-mime-text-handler (content-type
489 content-transfer-encoding)
490 "Handle the current buffer as a plain text MIME part."
491 (rmail-mime-insert-text
492 (rmail-mime-entity content-type content-disposition
493 content-transfer-encoding
494 (vector (vector nil nil nil) (vector nil nil t))
495 (vector nil nil nil) (vector "" (cons nil nil) t)
496 (vector nil nil nil) nil 'rmail-mime-insert-text))
499 (defun rmail-mime-insert-decoded-text (entity)
500 "Decode and insert the text body of MIME-entity ENTITY."
501 (let* ((content-type (rmail-mime-entity-type entity))
502 (charset (cdr (assq 'charset (cdr content-type))))
503 (coding-system (if charset
504 (coding-system-from-name charset)))
505 (body (rmail-mime-entity-body entity))
507 (or (and coding-system (coding-system-p coding-system))
508 (setq coding-system 'undecided))
509 (if (stringp (aref body 0))
510 (insert (aref body 0))
511 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
512 (insert-buffer-substring rmail-mime-mbox-buffer
513 (aref body 0) (aref body 1))
514 (cond ((string= transfer-encoding "base64")
515 (ignore-errors (base64-decode-region pos (point))))
516 ((string= transfer-encoding "quoted-printable")
517 (quoted-printable-decode-region pos (point))))))
518 (decode-coding-region pos (point) coding-system)
519 (or rmail-mime-coding-system
520 (setq rmail-mime-coding-system coding-system))
521 (or (bolp) (insert "\n"))))
523 (defun rmail-mime-insert-text (entity)
524 "Presentation handler for a plain text MIME entity."
525 (let ((current (aref (rmail-mime-entity-display entity) 0))
526 (new (aref (rmail-mime-entity-display entity) 1))
527 (header (rmail-mime-entity-header entity))
528 (tagline (rmail-mime-entity-tagline entity))
529 (body (rmail-mime-entity-body entity))
531 (segment (rmail-mime-entity-segment (point) entity)))
533 (or (integerp (aref body 0))
534 (let ((data (buffer-string)))
536 (delete-region (point-min) (point-max))))
539 (if (eq (aref current 0) (aref new 0))
540 (goto-char (aref segment 2))
542 (delete-char (- (aref segment 2) (aref segment 1))))
544 (rmail-mime-insert-header header)))
546 (if (eq (aref current 1) (aref new 1))
547 (forward-char (- (aref segment 3) (aref segment 2)))
549 (delete-char (- (aref segment 3) (aref segment 2))))
551 (rmail-mime-insert-tagline entity)))
553 (if (eq (aref current 2) (aref new 2))
554 (forward-char (- (aref segment 4) (aref segment 3)))
556 (delete-char (- (aref segment 4) (aref segment 3))))
558 (rmail-mime-insert-decoded-text entity)))
559 (put-text-property beg (point) 'rmail-mime-entity entity)))
561 ;; FIXME move to the test/ directory?
562 (defun test-rmail-mime-handler ()
563 "Test of a mail using no MIME parts at all."
564 (let ((mail "To: alex@gnu.org
565 Content-Type: text/plain; charset=koi8-r
566 Content-Transfer-Encoding: 8bit
569 \372\304\322\301\327\323\324\327\325\312\324\305\41"))
570 (switch-to-buffer (get-buffer-create "*test*"))
572 (set-buffer-multibyte nil)
575 (set-buffer-multibyte t)))
578 (defun rmail-mime-insert-image (entity)
579 "Decode and insert the image body of MIME-entity ENTITY."
580 (let* ((content-type (car (rmail-mime-entity-type entity)))
581 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
582 (body (rmail-mime-entity-body entity))
584 (if (stringp (aref body 0))
585 (setq data (aref body 0))
586 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
587 (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
589 (set-buffer-multibyte nil)
590 (setq buffer-undo-list t)
591 (insert-buffer-substring rmail-mime-mbox-buffer
592 (aref body 0) (aref body 1))
593 (cond ((string= transfer-encoding "base64")
594 (ignore-errors (base64-decode-region (point-min) (point-max))))
595 ((string= transfer-encoding "quoted-printable")
596 (quoted-printable-decode-region (point-min) (point-max))))
598 (buffer-substring-no-properties (point-min) (point-max))))))
599 (insert-image (create-image data (cdr bulk-data) t))
602 (defun rmail-mime-image (button)
603 "Display the image associated with BUTTON."
605 (goto-char (button-end button))
606 (rmail-mime-toggle-hidden)))
608 (define-button-type 'rmail-mime-image 'action 'rmail-mime-image)
611 (defun rmail-mime-bulk-handler (content-type
613 content-transfer-encoding)
614 "Handle the current buffer as an attachment to download.
615 For images that Emacs is capable of displaying, the behavior
616 depends upon the value of `rmail-mime-show-images'."
617 (rmail-mime-insert-bulk
618 (rmail-mime-entity content-type content-disposition content-transfer-encoding
619 (vector (vector nil nil nil) (vector nil t nil))
620 (vector nil nil nil) (vector "" (cons nil nil) t)
621 (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
623 (defun rmail-mime-set-bulk-data (entity)
624 "Setup the information about the attachment object for MIME-entity ENTITY.
625 The value is non-nil if and only if the attachment object should be shown
627 (let ((content-type (car (rmail-mime-entity-type entity)))
628 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
629 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
630 (body (rmail-mime-entity-body entity))
633 (setq size (string-to-number size)))
634 ((stringp (aref body 0))
635 (setq size (length (aref body 0))))
637 ;; Rough estimation of the size.
638 (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
639 (setq size (- (aref body 1) (aref body 0)))
640 (cond ((string= encoding "base64")
641 (setq size (/ (* size 3) 4)))
642 ((string= encoding "quoted-printable")
643 (setq size (/ (* size 7) 3)))))))
646 ((string-match "text/" content-type)
648 ((string-match "image/\\(.*\\)" content-type)
649 (setq type (image-type-from-file-name
650 (concat "." (match-string 1 content-type))))
651 (if (and (memq type image-types)
652 (image-type-available-p type))
653 (if (and rmail-mime-show-images
654 (not (eq rmail-mime-show-images 'button))
655 (or (not (numberp rmail-mime-show-images))
656 (< size rmail-mime-show-images)))
659 (setcar bulk-data size)
660 (setcdr bulk-data type)
663 (defun rmail-mime-insert-bulk (entity)
664 "Presentation handler for an attachment MIME entity."
665 ;; Find the default directory for this media type.
666 (let* ((content-type (rmail-mime-entity-type entity))
667 (content-disposition (rmail-mime-entity-disposition entity))
668 (current (aref (rmail-mime-entity-display entity) 0))
669 (new (aref (rmail-mime-entity-display entity) 1))
670 (header (rmail-mime-entity-header entity))
671 (tagline (rmail-mime-entity-tagline entity))
672 (bulk-data (aref tagline 1))
673 (body (rmail-mime-entity-body entity))
674 (directory (catch 'directory
675 (dolist (entry rmail-mime-attachment-dirs-alist)
676 (when (string-match (car entry) (car content-type))
677 (dolist (dir (cdr entry))
678 (when (file-directory-p dir)
679 (throw 'directory dir)))))))
680 (filename (or (cdr (assq 'name (cdr content-type)))
681 (cdr (assq 'filename (cdr content-disposition)))
683 (units '(B kB MB GB))
684 (segment (rmail-mime-entity-segment (point) entity))
687 (if (integerp (aref body 0))
689 size (car bulk-data))
690 (if (stringp (aref body 0))
691 (setq data (aref body 0))
692 (setq data (string-as-unibyte (buffer-string)))
694 (rmail-mime-set-bulk-data entity)
695 (delete-region (point-min) (point-max)))
696 (setq size (length data)))
697 (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
699 (setq size (/ size 1024.0)
705 (if (eq (aref current 0) (aref new 0))
706 (goto-char (aref segment 2))
708 (delete-char (- (aref segment 2) (aref segment 1))))
710 (rmail-mime-insert-header header)))
713 (if (eq (aref current 1) (aref new 1))
714 (forward-char (- (aref segment 3) (aref segment 2)))
716 (delete-char (- (aref segment 3) (aref segment 2))))
718 (rmail-mime-insert-tagline
722 :type 'rmail-mime-save
723 'help-echo "mouse-2, RET: Save attachment"
725 'directory (file-name-as-directory directory)
727 (format " (%.0f%s)" size (car units))
731 (list "Toggle show/hide"
732 :type 'rmail-mime-image
733 'help-echo "mouse-2, RET: Toggle show/hide"
734 'image-type (cdr bulk-data)
735 'image-data data)))))
737 (if (eq (aref current 2) (aref new 2))
738 (forward-char (- (aref segment 4) (aref segment 3)))
740 (delete-char (- (aref segment 4) (aref segment 3))))
742 (cond ((eq (cdr bulk-data) 'text)
743 (rmail-mime-insert-decoded-text entity))
745 (rmail-mime-insert-image entity))
747 ;; As we don't know how to display the body, just
748 ;; insert it as a text.
749 (rmail-mime-insert-decoded-text entity)))))
750 (put-text-property beg (point) 'rmail-mime-entity entity)))
752 (defun test-rmail-mime-bulk-handler ()
753 "Test of a mail used as an example in RFC 2183."
754 (let ((mail "Content-Type: image/jpeg
755 Content-Disposition: attachment; filename=genome.jpeg;
756 modification-date=\"Wed, 12 Feb 1997 16:29:51 -0500\";
757 Content-Description: a complete map of the human genome
758 Content-Transfer-Encoding: base64
760 iVBORw0KGgoAAAANSUhEUgAAADAAAAAwCAMAAABg3Am1AAAABGdBTUEAALGPC/xhBQAAAAZQ
761 TFRF////AAAAVcLTfgAAAPZJREFUeNq9ldsOwzAIQ+3//+l1WlvA5ZLsoUiTto4TB+ISoAjy
762 +ITfRBfcAmgRFFeAm+J6uhdKdFhFWUgDkFsK0oUp/9G2//Kj7Jx+5tSKOdBscgUYiKHRS/me
763 WATQdRUvAK0Bnmshmtn79PpaLBbbOZkjKvRnjRZoRswOkG1wFchKew2g9wXVJVZL/m4+B+vv
764 9AxQQR2Q33SgAYJzzVACdAWjAfRYzYFO9n6SLnydtQHSMxYDMAKqZ/8FS/lTK+zuq3CtK64L
765 UDwbgUEAUmk2Zyg101d6PhCDySgAvTvDgKiuOrc4dLxUb7UMnhGIexyI+d6U+ABuNAP4Simx
768 (switch-to-buffer (get-buffer-create "*test*"))
773 (defun rmail-mime-multipart-handler (content-type
775 content-transfer-encoding)
776 "Handle the current buffer as a multipart MIME body.
777 The current buffer should be narrowed to the body. CONTENT-TYPE,
778 CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
779 of the respective parsed headers. See `rmail-mime-handle' for their
781 (rmail-mime-process-multipart
782 content-type content-disposition content-transfer-encoding nil)
785 (defun rmail-mime-process-multipart (content-type
787 content-transfer-encoding
789 "Process the current buffer as a multipart MIME body.
791 If PARSE-TAG is nil, modify the current buffer directly for
792 showing the MIME body and return nil.
794 Otherwise, PARSE-TAG is a string indicating the depth and index
795 number of the entity. In this case, parse the current buffer and
796 return a list of MIME-entity objects.
798 The other arguments are the same as `rmail-mime-multipart-handler'."
799 ;; Some MUAs start boundaries with "--", while it should start
800 ;; with "CRLF--", as defined by RFC 2046:
801 ;; The boundary delimiter MUST occur at the beginning of a line,
802 ;; i.e., following a CRLF, and the initial CRLF is considered to
803 ;; be attached to the boundary delimiter line rather than part
804 ;; of the preceding part.
805 ;; We currently don't handle that.
806 (let ((boundary (cdr (assq 'boundary content-type)))
807 (subtype (cadr (split-string (car content-type) "/")))
809 beg end next entities)
811 (rmail-mm-get-boundary-error-message
812 "No boundary defined" content-type content-disposition
813 content-transfer-encoding))
814 (setq boundary (concat "\n--" boundary))
815 ;; Hide the body before the first bodypart
816 (goto-char (point-min))
817 (when (and (search-forward boundary nil t)
818 (looking-at "[ \t]*\n"))
820 (narrow-to-region (match-end 0) (point-max))
821 (delete-region (point-min) (match-end 0))))
823 ;; Change content-type to the proper default one for the children.
824 (cond ((string-match "mixed" subtype)
825 (setq content-type '("text/plain")))
826 ((string-match "digest" subtype)
827 (setq content-type '("message/rfc822")))
829 (setq content-type nil)))
831 ;; Loop over all body parts, where beg points at the beginning of
832 ;; the part and end points at the end of the part. next points at
833 ;; the beginning of the next part. The current point is just
834 ;; after the boundary tag.
835 (setq beg (point-min))
836 (while (search-forward boundary nil t)
837 (setq end (match-beginning 0))
838 ;; If this is the last boundary according to RFC 2046, hide the
839 ;; epilogue, else hide the boundary only. Use a marker for
840 ;; `next' because `rmail-mime-show' may change the buffer.
841 (cond ((looking-at "--[ \t]*$")
842 (setq next (point-max-marker)))
843 ((looking-at "[ \t]*\n")
844 (setq next (copy-marker (match-end 0) t)))
846 (rmail-mm-get-boundary-error-message
847 "Malformed boundary" content-type content-disposition
848 content-transfer-encoding)))
850 (setq index (1+ index))
854 (narrow-to-region beg end)
855 (let ((child (rmail-mime-process
856 nil (format "%s/%d" parse-tag index)
857 content-type content-disposition)))
858 ;; Display a tagline.
859 (aset (aref (rmail-mime-entity-display child) 1) 1
860 (aset (rmail-mime-entity-tagline child) 2 t))
861 (push child entities)))
863 (delete-region end next)
865 (narrow-to-region beg end)
867 (goto-char (setq beg next)))
870 (setq entities (nreverse entities))
871 (if (string-match "alternative" subtype)
872 ;; Find the best entity to show, and hide all the others.
874 (dolist (child entities)
875 (if (string= (or (car (rmail-mime-entity-disposition child))
876 (car content-disposition))
878 (if (string-match "text/plain"
879 (car (rmail-mime-entity-type child)))
881 (if (string-match "text/.*"
882 (car (rmail-mime-entity-type child)))
883 (setq second child)))))
884 (or best (not second) (setq best second))
885 (dolist (child entities)
887 (rmail-mime-hidden-mode child t)))))
890 (defun test-rmail-mime-multipart-handler ()
891 "Test of a mail used as an example in RFC 2046."
892 (let ((mail "From: Nathaniel Borenstein <nsb@bellcore.com>
893 To: Ned Freed <ned@innosoft.com>
894 Date: Sun, 21 Mar 1993 23:56:48 -0800 (PST)
895 Subject: Sample message
897 Content-type: multipart/mixed; boundary=\"simple boundary\"
899 This is the preamble. It is to be ignored, though it
900 is a handy place for composition agents to include an
901 explanatory note to non-MIME conformant readers.
905 This is implicitly typed plain US-ASCII text.
906 It does NOT end with a linebreak.
908 Content-type: text/plain; charset=us-ascii
910 This is explicitly typed plain US-ASCII text.
911 It DOES end with a linebreak.
915 This is the epilogue. It is also to be ignored."))
916 (switch-to-buffer (get-buffer-create "*test*"))
919 (rmail-mime-show t)))
921 (defun rmail-mime-insert-multipart (entity)
922 "Presentation handler for a multipart MIME entity."
923 (let ((current (aref (rmail-mime-entity-display entity) 0))
924 (new (aref (rmail-mime-entity-display entity) 1))
925 (header (rmail-mime-entity-header entity))
926 (tagline (rmail-mime-entity-tagline entity))
927 (body (rmail-mime-entity-body entity))
929 (segment (rmail-mime-entity-segment (point) entity)))
931 (if (eq (aref current 0) (aref new 0))
932 (goto-char (aref segment 2))
934 (delete-char (- (aref segment 2) (aref segment 1))))
936 (rmail-mime-insert-header header)))
938 (if (eq (aref current 1) (aref new 1))
939 (forward-char (- (aref segment 3) (aref segment 2)))
941 (delete-char (- (aref segment 3) (aref segment 2))))
943 (rmail-mime-insert-tagline entity)))
945 (put-text-property beg (point) 'rmail-mime-entity entity)
947 (if (eq (aref current 2) (aref new 2))
948 (forward-char (- (aref segment 4) (aref segment 3)))
950 (delete-char (- (aref segment 4) (aref segment 3))))
952 (dolist (child (rmail-mime-entity-children entity))
953 (rmail-mime-insert child))))))
957 (defun rmail-mime-handle (content-type
959 content-transfer-encoding)
960 "Handle the current buffer as a MIME part.
961 The current buffer should be narrowed to the respective body, and
962 point should be at the beginning of the body.
964 CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING
965 are the values of the respective parsed headers. The latter should
966 be downcased. The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
973 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
975 VALUE is a string and ATTRIBUTE is a symbol.
977 Consider the following header, for example:
979 Content-Type: multipart/mixed;
980 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
982 The parsed header value:
984 \(\"multipart/mixed\"
985 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
986 ;; Handle the content transfer encodings we know. Unknown transfer
987 ;; encodings will be passed on to the various handlers.
988 (cond ((string= content-transfer-encoding "base64")
990 (base64-decode-region (point) (point-max)))
991 (setq content-transfer-encoding nil)))
992 ((string= content-transfer-encoding "quoted-printable")
993 (quoted-printable-decode-region (point) (point-max))
994 (setq content-transfer-encoding nil))
995 ((string= content-transfer-encoding "8bit")
996 ;; FIXME: Is this the correct way?
997 ;; No, of course not, it just means there's no decoding to do.
998 ;; (set-buffer-multibyte nil)
999 (setq content-transfer-encoding nil)
1001 ;; Inline stuff requires work. Attachments are handled by the bulk
1003 (if (string= "inline" (car content-disposition))
1005 (dolist (entry rmail-mime-media-type-handlers-alist)
1006 (when (and (string-match (car entry) (car content-type)) (not stop))
1008 (setq stop (funcall (cadr entry) content-type
1010 content-transfer-encoding))))))
1011 ;; Everything else is an attachment.
1012 (rmail-mime-bulk-handler content-type
1014 content-transfer-encoding)))
1016 (defun rmail-mime-show (&optional show-headers)
1017 "Handle the current buffer as a MIME message.
1018 If SHOW-HEADERS is non-nil, then the headers of the current part
1019 will shown as usual for a MIME message. The headers are also
1020 shown for the content type message/rfc822. This function will be
1021 called recursively if multiple parts are available.
1023 The current buffer must contain a single message. It will be
1025 (rmail-mime-process show-headers nil))
1027 (defun rmail-mime-process (show-headers parse-tag &optional
1028 default-content-type
1029 default-content-disposition)
1030 (let ((end (point-min))
1032 content-transfer-encoding
1033 content-disposition)
1034 ;; `point-min' returns the beginning and `end' points at the end
1036 (goto-char (point-min))
1037 ;; If we're showing a part without headers, then it will start
1039 (if (eq (char-after) ?\n)
1040 (setq end (1+ (point)))
1041 (when (search-forward "\n\n" nil t)
1042 (setq end (match-end 0))
1044 (narrow-to-region (point-min) end)
1045 ;; FIXME: Default disposition of the multipart entities should
1048 (mail-fetch-field "Content-Type")
1049 content-transfer-encoding
1050 (mail-fetch-field "Content-Transfer-Encoding")
1052 (mail-fetch-field "Content-Disposition")))))
1053 ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
1054 ;; are not completely so. Hopefully mail-header-parse-* DTRT.
1055 (if content-transfer-encoding
1056 (setq content-transfer-encoding (downcase content-transfer-encoding)))
1059 (mail-header-parse-content-type content-type)
1060 (or default-content-type '("text/plain"))))
1061 (setq content-disposition
1062 (if content-disposition
1063 (mail-header-parse-content-disposition content-disposition)
1064 ;; If none specified, we are free to choose what we deem
1065 ;; suitable according to RFC 2183. We like inline.
1066 (or default-content-disposition '("inline"))))
1067 ;; Unrecognized disposition types are to be treated like
1068 ;; attachment according to RFC 2183.
1069 (unless (member (car content-disposition) '("inline" "attachment"))
1070 (setq content-disposition '("attachment")))
1073 (let* ((is-inline (string= (car content-disposition) "inline"))
1074 (header (vector (point-min) end nil))
1075 (tagline (vector parse-tag (cons nil nil) t))
1076 (body (vector end (point-max) is-inline))
1077 (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
1078 children handler entity)
1079 (cond ((string-match "multipart/.*" (car content-type))
1081 (narrow-to-region (1- end) (point-max))
1082 (setq children (rmail-mime-process-multipart
1085 content-transfer-encoding
1087 handler 'rmail-mime-insert-multipart)))
1088 ((string-match "message/rfc822" (car content-type))
1090 (narrow-to-region end (point-max))
1091 (let* ((msg (rmail-mime-process t parse-tag
1092 '("text/plain") '("inline")))
1093 (msg-new (aref (rmail-mime-entity-display msg) 1)))
1094 ;; Show header of the child.
1096 (aset (rmail-mime-entity-header msg) 2 t)
1097 ;; Hide tagline of the child.
1098 (aset msg-new 1 nil)
1099 (aset (rmail-mime-entity-tagline msg) 2 nil)
1100 (setq children (list msg)
1101 handler 'rmail-mime-insert-multipart))))
1102 ((and is-inline (string-match "text/" (car content-type)))
1103 ;; Don't need a tagline.
1104 (aset new 1 (aset tagline 2 nil))
1105 (setq handler 'rmail-mime-insert-text))
1107 ;; Force hidden mode.
1108 (aset new 1 (aset tagline 2 t))
1109 (aset new 2 (aset body 2 nil))
1110 (setq handler 'rmail-mime-insert-bulk)))
1111 (setq entity (rmail-mime-entity content-type
1113 content-transfer-encoding
1114 (vector (vector nil nil nil) new)
1115 header tagline body children handler))
1116 (if (and (eq handler 'rmail-mime-insert-bulk)
1117 (rmail-mime-set-bulk-data entity))
1119 (aset new 2 (aset body 2 t)))
1122 ;; Hide headers and handle the part.
1123 (put-text-property (point-min) (point-max) 'rmail-mime-entity
1125 content-type content-disposition
1126 content-transfer-encoding
1127 (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
1128 (vector nil nil 'raw) (vector "" (cons nil nil) nil)
1129 (vector nil nil 'raw) nil nil))
1131 (cond ((string= (car content-type) "message/rfc822")
1132 (narrow-to-region end (point-max)))
1134 (delete-region (point-min) end)))
1135 (rmail-mime-handle content-type content-disposition
1136 content-transfer-encoding)))))
1138 (defun rmail-mime-parse ()
1139 "Parse the current Rmail message as a MIME message.
1140 The value is a MIME-entiy object (see `rmail-mime-entity').
1141 If an error occurs, return an error message string."
1142 (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
1146 (with-current-buffer rmail-mime-mbox-buffer
1148 (goto-char (point-min))
1149 (let* ((entity (rmail-mime-process t ""
1150 '("text/plain") '("inline")))
1151 (new (aref (rmail-mime-entity-display entity) 1)))
1153 (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
1154 ;; Show tagline if and only if body is not shown.
1156 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
1157 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
1159 (error (format "%s" err)))))
1161 (defun rmail-mime-insert (entity)
1162 "Insert a MIME-entity ENTITY in the current buffer.
1164 This function will be called recursively if multiple parts are
1166 (let ((current (aref (rmail-mime-entity-display entity) 0))
1167 (new (aref (rmail-mime-entity-display entity) 1)))
1168 (if (not (eq (aref new 0) 'raw))
1169 ;; Not a raw-mode. Each handler should handle it.
1170 (funcall (rmail-mime-entity-handler entity) entity)
1171 (let ((header (rmail-mime-entity-header entity))
1172 (tagline (rmail-mime-entity-tagline entity))
1173 (body (rmail-mime-entity-body entity))
1175 (segment (rmail-mime-entity-segment (point) entity)))
1177 (if (eq (aref current 0) (aref new 0))
1178 (goto-char (aref segment 2))
1179 (if (aref current 0)
1180 (delete-char (- (aref segment 2) (aref segment 1))))
1181 (insert-buffer-substring rmail-mime-mbox-buffer
1182 (aref header 0) (aref header 1)))
1184 (if (aref current 1)
1185 (delete-char (- (aref segment 3) (aref segment 2))))
1187 (if (eq (aref current 2) (aref new 2))
1188 (forward-char (- (aref segment 4) (aref segment 3)))
1189 (if (aref current 2)
1190 (delete-char (- (aref segment 4) (aref segment 3))))
1191 (insert-buffer-substring rmail-mime-mbox-buffer
1192 (aref body 0) (aref body 1)))
1193 (put-text-property beg (point) 'rmail-mime-entity entity)))
1195 (aset current i (aref new i)))))
1197 (define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
1198 "Major mode used in `rmail-mime' buffers."
1199 (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
1202 (defun rmail-mime (&optional arg)
1203 "Toggle displaying of a MIME message.
1205 The actualy behavior depends on the value of `rmail-enable-mime'.
1207 If `rmail-enable-mime' is t (default), this command change the
1208 displaying of a MIME message between decoded presentation form
1211 With ARG, toggle the displaying of the current MIME entity only.
1213 If `rmail-enable-mime' is nil, this creates a temporary
1214 \"*RMAIL*\" buffer holding a decoded copy of the message. Inline
1215 content-types are handled according to
1216 `rmail-mime-media-type-handlers-alist'. By default, this
1217 displays text and multipart messages, and offers to download
1218 attachments as specfied by `rmail-mime-attachment-dirs-alist'."
1220 (if rmail-enable-mime
1221 (if (rmail-mime-message-p)
1222 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
1223 (rmail-mime-view-buffer rmail-buffer)
1224 (entity (get-text-property (point) 'rmail-mime-entity)))
1227 (rmail-mime-toggle-raw entity))
1228 (goto-char (point-min))
1229 (rmail-mime-toggle-raw
1230 (get-text-property (point) 'rmail-mime-entity))))
1231 (message "Not a MIME message"))
1232 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
1233 (buf (get-buffer-create "*RMAIL*"))
1234 (rmail-mime-mbox-buffer rmail-view-buffer)
1235 (rmail-mime-view-buffer buf))
1237 (setq buffer-undo-list t)
1238 (let ((inhibit-read-only t))
1239 ;; Decoding the message in fundamental mode for speed, only
1240 ;; switching to rmail-mime-mode at the end for display. Eg
1241 ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
1247 (set-buffer-modified-p nil))
1248 (view-buffer buf))))
1250 (defun rmail-mm-get-boundary-error-message (message type disposition encoding)
1251 "Return MESSAGE with more information on the main mime components."
1252 (error "%s; type: %s; disposition: %s; encoding: %s"
1253 message type disposition encoding))
1255 (defun rmail-show-mime ()
1256 "Function to set in `rmail-show-mime-function' (which see)."
1257 (let ((entity (rmail-mime-parse))
1258 (rmail-mime-mbox-buffer rmail-buffer)
1259 (rmail-mime-view-buffer rmail-view-buffer)
1260 (rmail-mime-coding-system nil))
1261 (if (vectorp entity)
1262 (with-current-buffer rmail-mime-view-buffer
1264 (rmail-mime-insert entity)
1265 (if rmail-mime-coding-system
1266 (set-buffer-file-coding-system rmail-mime-coding-system t t)))
1267 ;; Decoding failed. ENTITY is an error message. Insert the
1268 ;; original message body as is, and show warning.
1269 (let ((region (with-current-buffer rmail-mime-mbox-buffer
1270 (goto-char (point-min))
1271 (re-search-forward "^$" nil t)
1273 (vector (point-min) (point) (point-max)))))
1274 (with-current-buffer rmail-mime-view-buffer
1275 (let ((inhibit-read-only t))
1277 (rmail-mime-insert-header region)
1278 (insert-buffer-substring rmail-mime-mbox-buffer
1279 (aref region 1) (aref region 2))))
1280 (set-buffer-file-coding-system 'no-conversion t t)
1281 (message "MIME decoding failed: %s" entity)))))
1283 (setq rmail-show-mime-function 'rmail-show-mime)
1285 (defun rmail-insert-mime-forwarded-message (forward-buffer)
1286 "Function to set in `rmail-insert-mime-forwarded-message-function' (which see)."
1287 (let ((rmail-mime-mbox-buffer
1288 (with-current-buffer forward-buffer rmail-view-buffer)))
1290 (narrow-to-region (point) (point))
1291 (message-forward-make-body-mime rmail-mime-mbox-buffer))))
1293 (setq rmail-insert-mime-forwarded-message-function
1294 'rmail-insert-mime-forwarded-message)
1296 (defun rmail-insert-mime-resent-message (forward-buffer)
1297 "Function to set in `rmail-insert-mime-resent-message-function' (which see)."
1298 (insert-buffer-substring
1299 (with-current-buffer forward-buffer rmail-view-buffer))
1300 (goto-char (point-min))
1301 (when (looking-at "From ")
1303 (delete-region (point-min) (point))))
1305 (setq rmail-insert-mime-resent-message-function
1306 'rmail-insert-mime-resent-message)
1308 (defun rmail-search-mime-message (msg regexp)
1309 "Function to set in `rmail-search-mime-message-function' (which see)."
1311 (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
1312 (let* ((rmail-mime-mbox-buffer (current-buffer))
1313 (rmail-mime-view-buffer rmail-view-buffer)
1314 (header-end (save-excursion
1315 (re-search-forward "^$" nil 'move) (point)))
1316 (body-end (point-max))
1317 (entity (rmail-mime-parse)))
1319 ;; At first, just search the headers.
1321 (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
1322 (rfc2047-decode-region (point-min) (point))
1323 (goto-char (point-min))
1324 (re-search-forward regexp nil t))
1325 ;; Next, search the body.
1327 (let* ((content-type (rmail-mime-entity-type entity))
1328 (charset (cdr (assq 'charset (cdr content-type)))))
1329 (or (not (string-match "text/.*" (car content-type)))
1331 (not (string= (downcase charset) "us-ascii"))))))
1332 ;; Search the decoded MIME message.
1334 (rmail-mime-insert entity)
1335 (goto-char (point-min))
1336 (re-search-forward regexp nil t))
1337 ;; Search the body without decoding.
1338 (goto-char header-end)
1339 (re-search-forward regexp nil t))))))
1341 (setq rmail-search-mime-message-function 'rmail-search-mime-message)
1346 ;; generated-autoload-file: "rmail.el"
1349 ;; arch-tag: 3f2c5e5d-1aef-4512-bc20-fd737c9d5dd9
1350 ;;; rmailmm.el ends here