Update copyright notices for 2013.
[bpt/emacs.git] / lisp / mail / rmailmm.el
CommitLineData
537ab246
BG
1;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
2
ab422c4d 3;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
537ab246 4
6ea97e7e
GM
5;; Author: Alexander Pohoyda
6;; Alex Schroeder
537ab246
BG
7;; Maintainer: FSF
8;; Keywords: mail
bd78fa1d 9;; Package: rmail
537ab246
BG
10
11;; This file is part of GNU Emacs.
12
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.
17
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.
22
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/>.
25
26;;; Commentary:
27
28;; Essentially based on the design of Alexander Pohoyda's MIME
73422054 29;; extensions (mime-display.el and mime.el).
d1be4ec2
KH
30
31;; This file provides two operation modes for viewing a MIME message.
32
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.
36
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*".
39
40;; Both operations share the intermediate functions rmail-mime-process
41;; and rmail-mime-process-multipart as below.
42
43;; rmail-show-mime
44;; +- rmail-mime-parse
45;; | +- rmail-mime-process <--+------------+
46;; | | +---------+ |
47;; | + rmail-mime-process-multipart --+
48;; |
49;; + rmail-mime-insert <----------------+
50;; +- rmail-mime-insert-text |
51;; +- rmail-mime-insert-bulk |
52;; +- rmail-mime-insert-multipart --+
53;;
54;; rmail-mime
55;; +- rmail-mime-show <----------------------------------+
7c420169 56;; +- rmail-mime-process |
d1be4ec2
KH
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 --+
63
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.
537ab246 68
2e9075d3
GM
69;; Todo:
70
d1be4ec2
KH
71;; Make rmail-mime-media-type-handlers-alist usable in the first
72;; operation mode.
73;; Handle multipart/alternative in the second operation mode.
a92cdd49 74;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
2e9075d3 75
537ab246
BG
76;;; Code:
77
78(require 'rmail)
79(require 'mail-parse)
d1be4ec2 80(require 'message)
537ab246 81
f4ce6150 82;;; User options.
537ab246 83
e8652dd9
GM
84(defgroup rmail-mime nil
85 "Rmail MIME handling options."
86 :prefix "rmail-mime-"
87 :group 'rmail)
88
537ab246
BG
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)
e8652dd9 93 ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler))
f4ce6150 94 "Functions to handle various content types.
c8644de0
GM
95This is an alist with elements of the form (REGEXP FUNCTION ...).
96The first item is a regular expression matching a content-type.
97The remaining elements are handler functions to run, in order of
2e9075d3
GM
98decreasing preference. These are called until one returns non-nil.
99Note that this only applies to items with an inline Content-Disposition,
186f7f0b
KH
100all others are handled by `rmail-mime-bulk-handler'.
101Note also that this alist is ignored when the variable
102`rmail-enable-mime' is non-nil."
c8644de0 103 :type '(alist :key-type regexp :value-type (repeat function))
e8652dd9
GM
104 :version "23.1"
105 :group 'rmail-mime)
537ab246
BG
106
107(defcustom rmail-mime-attachment-dirs-alist
f265b4de 108 `(("text/.*" "~/Documents")
537ab246 109 ("image/.*" "~/Pictures")
f265b4de 110 (".*" "~/Desktop" "~" ,temporary-file-directory))
f4ce6150
GM
111 "Default directories to save attachments of various types into.
112This is an alist with elements of the form (REGEXP DIR ...).
113The first item is a regular expression matching a content-type.
114The remaining elements are directories, in order of decreasing preference.
115The first directory that exists is used."
116 :type '(alist :key-type regexp :value-type (repeat directory))
117 :version "23.1"
e8652dd9
GM
118 :group 'rmail-mime)
119
120(defcustom rmail-mime-show-images 'button
121 "What to do with image attachments that Emacs is capable of displaying.
122If nil, do nothing special. If `button', add an extra button
a92cdd49
GM
123that when pushed displays the image in the buffer. If a number,
124automatically show images if they are smaller than that size (in
125bytes), otherwise add a display button. Anything else means to
126automatically display the image in the buffer."
e8652dd9
GM
127 :type '(choice (const :tag "Add button to view image" button)
128 (const :tag "No special treatment" nil)
a92cdd49 129 (number :tag "Show if smaller than certain size")
e8652dd9
GM
130 (other :tag "Always show" show))
131 :version "23.2"
132 :group 'rmail-mime)
537ab246 133
f4ce6150
GM
134;;; End of user options.
135
186f7f0b
KH
136;;; Global variables that always have let-binding when referred.
137
138(defvar rmail-mime-mbox-buffer nil
139 "Buffer containing the mbox data.
140The value is usually nil, and bound to a proper value while
141processing MIME.")
142
143(defvar rmail-mime-view-buffer nil
144 "Buffer showing a message.
145The value is usually nil, and bound to a proper value while
146processing MIME.")
147
148(defvar rmail-mime-coding-system nil
149 "The first coding-system used for decoding a MIME entity.
150The value is usually nil, and bound to non-nil while inserting
151MIME entities.")
152
d1be4ec2
KH
153;;; MIME-entity object
154
155(defun rmail-mime-entity (type disposition transfer-encoding
aa8a705c
RS
156 display header tagline body children handler
157 &optional truncated)
672b871d 158 "Return a newly created MIME-entity object from arguments.
d1be4ec2 159
aa8a705c 160A MIME-entity is a vector of 10 elements:
d1be4ec2 161
186f7f0b 162 [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
aa8a705c 163 CHILDREN HANDLER TRUNCATED]
7c420169 164
186f7f0b 165TYPE and DISPOSITION correspond to MIME headers Content-Type and
aa8a705c 166Content-Disposition respectively, and have this format:
d1be4ec2
KH
167
168 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
169
aa8a705c 170Each VALUE is a string and each ATTRIBUTE is a string.
d1be4ec2
KH
171
172Consider the following header, for example:
173
174Content-Type: multipart/mixed;
175 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
176
177The corresponding TYPE argument must be:
178
179\(\"multipart/mixed\"
180 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
181
182TRANSFER-ENCODING corresponds to MIME header
672b871d 183Content-Transfer-Encoding, and is a lower-case string.
d1be4ec2 184
186f7f0b 185DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
672b871d
GM
186the header, tag line, and body of the entity are displayed now,
187and NEW indicates how their display should be updated.
188Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
189where each constituent element is a symbol for the corresponding
190item with these values:
186f7f0b 191 nil: not displayed
672b871d 192 t: displayed by the decoded presentation form
186f7f0b
KH
193 raw: displayed by the raw MIME data (for the header and body only)
194
195HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
354cf0ba
RS
196END are markers that specify the region of the header or body lines
197in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
186f7f0b
KH
198header or body is, by default, displayed by the decoded
199presentation form.
200
201TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
202string indicating the depth and index number of the entity,
203BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
672b871d
GM
204an attached data, DISPLAY-FLAG non-nil means that the tag line is
205displayed by default.
186f7f0b
KH
206
207CHILDREN is a list of child MIME-entities. A \"multipart/*\"
672b871d 208entity has one or more children. A \"message/rfc822\" entity
186f7f0b
KH
209has just one child. Any other entity has no child.
210
211HANDLER is a function to insert the entity according to DISPLAY.
aa8a705c
RS
212It is called with one argument ENTITY.
213
214TRUNCATED is non-nil if the text of this entity was truncated."
215
186f7f0b 216 (vector type disposition transfer-encoding
aa8a705c 217 display header tagline body children handler truncated))
d1be4ec2
KH
218
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))
186f7f0b
KH
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))
aa8a705c
RS
229(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
230(defsubst rmail-mime-entity-set-truncated (entity truncated)
231 (aset entity 9 truncated))
186f7f0b
KH
232
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)))
f4ce6150 237
537ab246
BG
238;;; Buttons
239
240(defun rmail-mime-save (button)
241 "Save the attachment using info in the BUTTON."
186f7f0b
KH
242 (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
243 (filename (button-get button 'filename))
537ab246 244 (directory (button-get button 'directory))
fe6793d4
GM
245 (data (button-get button 'data))
246 (ofilename filename))
aa8a705c
RS
247 (if (and (not (stringp data))
248 (rmail-mime-entity-truncated data))
249 (unless (y-or-n-p "This entity is truncated; save anyway? ")
250 (error "Aborted")))
537ab246
BG
251 (setq filename (expand-file-name
252 (read-file-name (format "Save as (default: %s): " filename)
253 directory
254 (expand-file-name filename directory))
255 directory))
fe6793d4
GM
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))))
262 (with-temp-buffer
537ab246 263 (set-buffer-file-coding-system 'no-conversion)
134a027f
EZ
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)
d1be4ec2
KH
268 (setq buffer-undo-list t)
269 (if (stringp data)
270 (insert data)
271 ;; DATA is a MIME-entity object.
272 (let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
273 (body (rmail-mime-entity-body data)))
186f7f0b
KH
274 (insert-buffer-substring rmail-mime-mbox-buffer
275 (aref body 0) (aref body 1))
d1be4ec2
KH
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))))))
fe6793d4 280 (write-region nil nil filename nil nil nil t))))
537ab246 281
fe6793d4 282(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
537ab246 283
49ae5b39
EZ
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))
289
186f7f0b
KH
290(defun rmail-mime-entity-segment (pos &optional entity)
291 "Return a vector describing the displayed region of a MIME-entity at POS.
292Optional 2nd argument ENTITY is the MIME-entity at POS.
672b871d
GM
293The value is a vector [INDEX HEADER TAGLINE BODY END], where
294 INDEX: index into the returned vector indicating where POS is (1..3)
186f7f0b 295 HEADER: the position of the beginning of a header
49ae5b39
EZ
296 TAGLINE: the position of the beginning of a tag line, including
297 the newline that precedes it
186f7f0b 298 BODY: the position of the beginning of a body
e7ca0062 299 END: the position of the end of the entity."
186f7f0b
KH
300 (save-excursion
301 (or entity
302 (setq entity (get-text-property pos 'rmail-mime-entity)))
303 (if (not 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)
308 entity))
309 (previous-single-property-change pos 'rmail-mime-entity
310 nil (point-min))
311 pos))
312 (index 1)
313 tagline-beg body-beg end)
314 (goto-char beg)
49ae5b39
EZ
315 ;; If the header is displayed, get past it to the tagline.
316 (if (rmail-mime-display-header current)
186f7f0b
KH
317 (search-forward "\n\n" nil t))
318 (setq tagline-beg (point))
319 (if (>= pos tagline-beg)
320 (setq index 2))
49ae5b39
EZ
321 ;; If the tagline is displayed, get past it to the body.
322 (if (rmail-mime-display-tagline current)
99d99081 323 ;; The next forward-line call must be in sync with how
49ae5b39
EZ
324 ;; `rmail-mime-insert-tagline' formats the tagline. The
325 ;; body begins after the empty line that ends the tagline.
326 (forward-line 3))
186f7f0b
KH
327 (setq body-beg (point))
328 (if (>= pos body-beg)
329 (setq index 3))
49ae5b39
EZ
330 ;; If the body is displayed, find its end.
331 (if (rmail-mime-display-body current)
186f7f0b
KH
332 (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
333 tag2)
334 (setq end (next-single-property-change beg 'rmail-mime-entity
335 nil (point-max)))
49ae5b39
EZ
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
340 ;; different value.
186f7f0b
KH
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
347 nil (point-max)))))
348 (setq end body-beg))
349 (vector index beg tagline-beg body-beg end)))))
350
186f7f0b 351(defun rmail-mime-shown-mode (entity)
672b871d 352 "Make MIME-entity ENTITY display in the default way."
186f7f0b
KH
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))
e7ca0062 356 (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
186f7f0b 357 (dolist (child (rmail-mime-entity-children entity))
e7ca0062 358 (rmail-mime-shown-mode child)))
d52969e8 359
e7ca0062 360(defun rmail-mime-hidden-mode (entity)
672b871d 361 "Make MIME-entity ENTITY display in hidden mode."
e7ca0062
KH
362 (let ((new (aref (rmail-mime-entity-display entity) 1)))
363 (aset new 0 nil)
364 (aset new 1 t)
365 (aset new 2 nil))
186f7f0b 366 (dolist (child (rmail-mime-entity-children entity))
e7ca0062 367 (rmail-mime-hidden-mode child)))
186f7f0b
KH
368
369(defun rmail-mime-raw-mode (entity)
672b871d 370 "Make MIME-entity ENTITY display in raw mode."
186f7f0b
KH
371 (let ((new (aref (rmail-mime-entity-display entity) 1)))
372 (aset new 0 'raw)
373 (aset new 1 nil)
e7ca0062
KH
374 (aset new 2 'raw))
375 (dolist (child (rmail-mime-entity-children entity))
376 (rmail-mime-raw-mode child)))
186f7f0b 377
d20faa20
GM
378(defun rmail-mime-toggle-raw (&optional state)
379 "Toggle on and off the raw display mode of MIME-entity at point.
380With optional argument STATE, force the specified display mode.
381Use `raw' for raw mode, and any other non-nil value for decoded mode."
186f7f0b
KH
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)))
d20faa20
GM
386 (if (or (eq state 'raw)
387 (and (not state)
49ae5b39 388 (not (eq (rmail-mime-display-header current) 'raw))))
186f7f0b
KH
389 ;; Enter the raw mode.
390 (rmail-mime-raw-mode entity)
391 ;; Enter the shown mode.
0dee970c
RS
392 (rmail-mime-shown-mode entity)
393 (let ((inhibit-read-only t)
394 (modified (buffer-modified-p)))
395 (save-excursion
396 (goto-char (aref segment 1))
397 (rmail-mime-insert entity)
398 (restore-buffer-modified-p modified))))))
186f7f0b
KH
399
400(defun rmail-mime-toggle-hidden ()
672b871d 401 "Hide or show the body of the MIME-entity at point."
186f7f0b
KH
402 (interactive)
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)))
49ae5b39 410 (if (rmail-mime-display-body current)
186f7f0b
KH
411 ;; Enter the hidden mode.
412 (progn
413 ;; If point is in the body part, move it to the tagline
e7ca0062 414 ;; (or the header if tagline is not displayed).
186f7f0b
KH
415 (if (= (aref segment 0) 3)
416 (goto-char (aref segment 2)))
e7ca0062 417 (rmail-mime-hidden-mode entity)
186f7f0b
KH
418 ;; If the current entity is the topmost one, display the
419 ;; header.
420 (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
421 (let ((new (aref (rmail-mime-entity-display entity) 1)))
422 (aset new 0 t))))
aa8a705c
RS
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? ")
427 (error "Aborted")))
186f7f0b 428 ;; Enter the shown mode.
e7ca0062
KH
429 (rmail-mime-shown-mode entity)
430 ;; Force this body shown.
431 (aset (aref (rmail-mime-entity-display entity) 1) 2 t))
186f7f0b
KH
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))
436 (save-excursion
437 (goto-char (aref segment 1))
438 (rmail-mime-insert entity)
439 (restore-buffer-modified-p modified))))))
440
e7ca0062
KH
441(define-key rmail-mode-map "\t" 'forward-button)
442(define-key rmail-mode-map [backtab] 'backward-button)
186f7f0b
KH
443(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)
444
537ab246
BG
445;;; Handlers
446
186f7f0b
KH
447(defun rmail-mime-insert-tagline (entity &rest item-list)
448 "Insert a tag line for MIME-entity ENTITY.
672b871d 449ITEM-LIST is a list of strings or button-elements (list) to add
186f7f0b 450to the tag line."
49ae5b39
EZ
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.
a3cf097f 454 (insert "\n[")
186f7f0b
KH
455 (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
456 (if (> (length tag) 0) (insert (substring tag 1) ":")))
e7ca0062
KH
457 (insert (car (rmail-mime-entity-type entity)) " ")
458 (insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
49ae5b39 459 (if (rmail-mime-display-body new) "Hide" "Show"))
e7ca0062
KH
460 :type 'rmail-mime-toggle
461 'help-echo "mouse-2, RET: Toggle show/hide")
186f7f0b
KH
462 (dolist (item item-list)
463 (when item
464 (if (stringp item)
465 (insert item)
466 (apply 'insert-button item))))
49ae5b39
EZ
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.
a3cf097f 470 (insert "]\n\n"))
7c420169 471
e7ca0062
KH
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"
479 "Show"))
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)))
484 (save-excursion
485 (insert label)
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)
49ae5b39
EZ
490 ;; The following call to forward-line must be in sync with how
491 ;; rmail-mime-insert-tagline formats the tagline.
492 (forward-line 2)))
e7ca0062 493
186f7f0b
KH
494(defun rmail-mime-insert-header (header)
495 "Decode and insert a MIME-entity header HEADER in the current buffer.
496HEADER is a vector [BEG END DEFAULT-STATUS].
672b871d 497See `rmail-mime-entity' for details."
186f7f0b
KH
498 (let ((pos (point))
499 (last-coding-system-used nil))
500 (save-restriction
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))
505 (save-excursion
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))
1a6a03e4 510 (setq rmail-mime-coding-system (cons last-coding-system-used nil)))
186f7f0b
KH
511 (goto-char (point-min))
512 (rmail-highlight-headers)
513 (goto-char (point-max))
514 (insert "\n"))))
515
1a6a03e4 516(defun rmail-mime-find-header-encoding (header)
0b381c7e 517 "Return the last coding system used to decode HEADER.
1a6a03e4
KH
518HEADER is a header component of a MIME-entity object (see
519`rmail-mime-entity')."
520 (with-temp-buffer
16bc9688 521 (let ((buf (current-buffer)))
1a6a03e4 522 (with-current-buffer rmail-mime-mbox-buffer
16bc9688
KH
523 (let ((last-coding-system-used nil)
524 (rmail-buffer rmail-mime-mbox-buffer)
525 (rmail-view-buffer buf))
1a6a03e4
KH
526 (save-excursion
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)))
531
537ab246
BG
532(defun rmail-mime-text-handler (content-type
533 content-disposition
534 content-transfer-encoding)
535 "Handle the current buffer as a plain text MIME part."
186f7f0b
KH
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))
542 t)
543
544(defun rmail-mime-insert-decoded-text (entity)
545 "Decode and insert the text body of MIME-entity ENTITY."
d1be4ec2
KH
546 (let* ((content-type (rmail-mime-entity-type entity))
547 (charset (cdr (assq 'charset (cdr content-type))))
186f7f0b
KH
548 (coding-system (if charset
549 (coding-system-from-name charset)))
550 (body (rmail-mime-entity-body entity))
551 (pos (point)))
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)
16bc9688
KH
564 (if (and
565 (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
566 (not (eq (coding-system-base coding-system) 'us-ascii)))
186f7f0b
KH
567 (setq rmail-mime-coding-system coding-system))
568 (or (bolp) (insert "\n"))))
569
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))
577 (beg (point))
578 (segment (rmail-mime-entity-segment (point) entity)))
579
354cf0ba 580 (or (integerp (aref body 0)) (markerp (aref body 0))
186f7f0b
KH
581 (let ((data (buffer-string)))
582 (aset body 0 data)
583 (delete-region (point-min) (point-max))))
584
585 ;; header
49ae5b39
EZ
586 (if (eq (rmail-mime-display-header current)
587 (rmail-mime-display-header new))
186f7f0b 588 (goto-char (aref segment 2))
49ae5b39 589 (if (rmail-mime-display-header current)
186f7f0b 590 (delete-char (- (aref segment 2) (aref segment 1))))
49ae5b39 591 (if (rmail-mime-display-header new)
186f7f0b
KH
592 (rmail-mime-insert-header header)))
593 ;; tagline
49ae5b39
EZ
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)))
e7ca0062
KH
599 (forward-char (- (aref segment 3) (aref segment 2)))
600 (rmail-mime-update-tagline entity))
49ae5b39 601 (if (rmail-mime-display-tagline current)
186f7f0b 602 (delete-char (- (aref segment 3) (aref segment 2))))
49ae5b39 603 (if (rmail-mime-display-tagline new)
186f7f0b
KH
604 (rmail-mime-insert-tagline entity)))
605 ;; body
49ae5b39
EZ
606 (if (eq (rmail-mime-display-body current)
607 (rmail-mime-display-body new))
186f7f0b 608 (forward-char (- (aref segment 4) (aref segment 3)))
49ae5b39 609 (if (rmail-mime-display-body current)
186f7f0b 610 (delete-char (- (aref segment 4) (aref segment 3))))
49ae5b39 611 (if (rmail-mime-display-body new)
186f7f0b
KH
612 (rmail-mime-insert-decoded-text entity)))
613 (put-text-property beg (point) 'rmail-mime-entity entity)))
d1be4ec2 614
186f7f0b
KH
615(defun rmail-mime-insert-image (entity)
616 "Decode and insert the image body of MIME-entity ENTITY."
617 (let* ((content-type (car (rmail-mime-entity-type entity)))
618 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
619 (body (rmail-mime-entity-body entity))
620 data)
621 (if (stringp (aref body 0))
622 (setq data (aref body 0))
623 (let ((rmail-mime-mbox-buffer rmail-view-buffer)
624 (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
d1be4ec2
KH
625 (with-temp-buffer
626 (set-buffer-multibyte nil)
627 (setq buffer-undo-list t)
186f7f0b
KH
628 (insert-buffer-substring rmail-mime-mbox-buffer
629 (aref body 0) (aref body 1))
d1be4ec2
KH
630 (cond ((string= transfer-encoding "base64")
631 (ignore-errors (base64-decode-region (point-min) (point-max))))
632 ((string= transfer-encoding "quoted-printable")
633 (quoted-printable-decode-region (point-min) (point-max))))
634 (setq data
635 (buffer-substring-no-properties (point-min) (point-max))))))
186f7f0b
KH
636 (insert-image (create-image data (cdr bulk-data) t))
637 (insert "\n")))
e8652dd9 638
e7ca0062
KH
639(defun rmail-mime-toggle-button (button)
640 "Hide or show the body of the MIME-entity associated with BUTTON."
186f7f0b 641 (save-excursion
e7ca0062 642 (goto-char (button-start button))
186f7f0b 643 (rmail-mime-toggle-hidden)))
e8652dd9 644
e7ca0062 645(define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)
e8652dd9
GM
646
647
537ab246
BG
648(defun rmail-mime-bulk-handler (content-type
649 content-disposition
e8652dd9 650 content-transfer-encoding)
2e9075d3 651 "Handle the current buffer as an attachment to download.
e8652dd9
GM
652For images that Emacs is capable of displaying, the behavior
653depends upon the value of `rmail-mime-show-images'."
d1be4ec2
KH
654 (rmail-mime-insert-bulk
655 (rmail-mime-entity content-type content-disposition content-transfer-encoding
186f7f0b
KH
656 (vector (vector nil nil nil) (vector nil t nil))
657 (vector nil nil nil) (vector "" (cons nil nil) t)
658 (vector nil nil nil) nil 'rmail-mime-insert-bulk)))
659
660(defun rmail-mime-set-bulk-data (entity)
661 "Setup the information about the attachment object for MIME-entity ENTITY.
662The value is non-nil if and only if the attachment object should be shown
663directly."
664 (let ((content-type (car (rmail-mime-entity-type entity)))
665 (size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
666 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
667 (body (rmail-mime-entity-body entity))
e7ca0062 668 type to-show)
186f7f0b
KH
669 (cond (size
670 (setq size (string-to-number size)))
671 ((stringp (aref body 0))
672 (setq size (length (aref body 0))))
673 (t
674 ;; Rough estimation of the size.
675 (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
676 (setq size (- (aref body 1) (aref body 0)))
677 (cond ((string= encoding "base64")
678 (setq size (/ (* size 3) 4)))
679 ((string= encoding "quoted-printable")
680 (setq size (/ (* size 7) 3)))))))
681
682 (cond
683 ((string-match "text/" content-type)
684 (setq type 'text))
685 ((string-match "image/\\(.*\\)" content-type)
686 (setq type (image-type-from-file-name
687 (concat "." (match-string 1 content-type))))
688 (if (and (memq type image-types)
689 (image-type-available-p type))
690 (if (and rmail-mime-show-images
691 (not (eq rmail-mime-show-images 'button))
692 (or (not (numberp rmail-mime-show-images))
693 (< size rmail-mime-show-images)))
694 (setq to-show t))
695 (setq type nil))))
696 (setcar bulk-data size)
697 (setcdr bulk-data type)
698 to-show))
d1be4ec2
KH
699
700(defun rmail-mime-insert-bulk (entity)
186f7f0b 701 "Presentation handler for an attachment MIME entity."
d1be4ec2
KH
702 (let* ((content-type (rmail-mime-entity-type entity))
703 (content-disposition (rmail-mime-entity-disposition entity))
186f7f0b
KH
704 (current (aref (rmail-mime-entity-display entity) 0))
705 (new (aref (rmail-mime-entity-display entity) 1))
706 (header (rmail-mime-entity-header entity))
707 (tagline (rmail-mime-entity-tagline entity))
708 (bulk-data (aref tagline 1))
d1be4ec2 709 (body (rmail-mime-entity-body entity))
e7ca0062 710 ;; Find the default directory for this media type.
d1be4ec2 711 (directory (catch 'directory
537ab246
BG
712 (dolist (entry rmail-mime-attachment-dirs-alist)
713 (when (string-match (car entry) (car content-type))
714 (dolist (dir (cdr entry))
715 (when (file-directory-p dir)
716 (throw 'directory dir)))))))
717 (filename (or (cdr (assq 'name (cdr content-type)))
718 (cdr (assq 'filename (cdr content-disposition)))
719 "noname"))
69220882 720 (units '(B kB MB GB))
186f7f0b
KH
721 (segment (rmail-mime-entity-segment (point) entity))
722 beg data size)
723
354cf0ba 724 (if (or (integerp (aref body 0)) (markerp (aref body 0)))
d1be4ec2 725 (setq data entity
186f7f0b
KH
726 size (car bulk-data))
727 (if (stringp (aref body 0))
728 (setq data (aref body 0))
729 (setq data (string-as-unibyte (buffer-string)))
730 (aset body 0 data)
731 (rmail-mime-set-bulk-data entity)
732 (delete-region (point-min) (point-max)))
733 (setq size (length data)))
d1be4ec2 734 (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
69220882
GM
735 (cdr units))
736 (setq size (/ size 1024.0)
737 units (cdr units)))
186f7f0b
KH
738
739 (setq beg (point))
740
741 ;; header
49ae5b39
EZ
742 (if (eq (rmail-mime-display-header current)
743 (rmail-mime-display-header new))
186f7f0b 744 (goto-char (aref segment 2))
49ae5b39 745 (if (rmail-mime-display-header current)
186f7f0b 746 (delete-char (- (aref segment 2) (aref segment 1))))
49ae5b39 747 (if (rmail-mime-display-header new)
186f7f0b
KH
748 (rmail-mime-insert-header header)))
749
750 ;; tagline
49ae5b39
EZ
751 (if (eq (rmail-mime-display-tagline current)
752 (rmail-mime-display-tagline new))
753 (if (or (not (rmail-mime-display-tagline current))
754 (eq (rmail-mime-display-body current)
755 (rmail-mime-display-body new)))
e7ca0062
KH
756 (forward-char (- (aref segment 3) (aref segment 2)))
757 (rmail-mime-update-tagline entity))
49ae5b39 758 (if (rmail-mime-display-tagline current)
186f7f0b 759 (delete-char (- (aref segment 3) (aref segment 2))))
49ae5b39 760 (if (rmail-mime-display-tagline new)
186f7f0b
KH
761 (rmail-mime-insert-tagline
762 entity
e7ca0062 763 " Save:"
186f7f0b
KH
764 (list filename
765 :type 'rmail-mime-save
766 'help-echo "mouse-2, RET: Save attachment"
767 'filename filename
768 'directory (file-name-as-directory directory)
769 'data data)
770 (format " (%.0f%s)" size (car units))
e7ca0062
KH
771 ;; We don't need this button because the "type" string of a
772 ;; tagline is the button to do this.
773 ;; (if (cdr bulk-data)
774 ;; " ")
775 ;; (if (cdr bulk-data)
776 ;; (list "Toggle show/hide"
777 ;; :type 'rmail-mime-image
778 ;; 'help-echo "mouse-2, RET: Toggle show/hide"
779 ;; 'image-type (cdr bulk-data)
780 ;; 'image-data data))
781 )))
186f7f0b 782 ;; body
49ae5b39
EZ
783 (if (eq (rmail-mime-display-body current)
784 (rmail-mime-display-body new))
186f7f0b 785 (forward-char (- (aref segment 4) (aref segment 3)))
49ae5b39 786 (if (rmail-mime-display-body current)
186f7f0b 787 (delete-char (- (aref segment 4) (aref segment 3))))
49ae5b39 788 (if (rmail-mime-display-body new)
186f7f0b
KH
789 (cond ((eq (cdr bulk-data) 'text)
790 (rmail-mime-insert-decoded-text entity))
791 ((cdr bulk-data)
362b9d48
GM
792 (rmail-mime-insert-image entity))
793 (t
794 ;; As we don't know how to display the body, just
795 ;; insert it as a text.
796 (rmail-mime-insert-decoded-text entity)))))
186f7f0b 797 (put-text-property beg (point) 'rmail-mime-entity entity)))
537ab246 798
537ab246
BG
799(defun rmail-mime-multipart-handler (content-type
800 content-disposition
801 content-transfer-encoding)
802 "Handle the current buffer as a multipart MIME body.
803The current buffer should be narrowed to the body. CONTENT-TYPE,
804CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
805of the respective parsed headers. See `rmail-mime-handle' for their
806format."
d1be4ec2 807 (rmail-mime-process-multipart
186f7f0b
KH
808 content-type content-disposition content-transfer-encoding nil)
809 t)
d1be4ec2
KH
810
811(defun rmail-mime-process-multipart (content-type
812 content-disposition
813 content-transfer-encoding
186f7f0b 814 parse-tag)
d1be4ec2
KH
815 "Process the current buffer as a multipart MIME body.
816
186f7f0b
KH
817If PARSE-TAG is nil, modify the current buffer directly for
818showing the MIME body and return nil.
d1be4ec2 819
186f7f0b
KH
820Otherwise, PARSE-TAG is a string indicating the depth and index
821number of the entity. In this case, parse the current buffer and
822return a list of MIME-entity objects.
d1be4ec2
KH
823
824The other arguments are the same as `rmail-mime-multipart-handler'."
537ab246
BG
825 ;; Some MUAs start boundaries with "--", while it should start
826 ;; with "CRLF--", as defined by RFC 2046:
827 ;; The boundary delimiter MUST occur at the beginning of a line,
828 ;; i.e., following a CRLF, and the initial CRLF is considered to
829 ;; be attached to the boundary delimiter line rather than part
830 ;; of the preceding part.
831 ;; We currently don't handle that.
832 (let ((boundary (cdr (assq 'boundary content-type)))
186f7f0b
KH
833 (subtype (cadr (split-string (car content-type) "/")))
834 (index 0)
99a1e701 835 beg end next entities truncated last)
537ab246
BG
836 (unless boundary
837 (rmail-mm-get-boundary-error-message
838 "No boundary defined" content-type content-disposition
839 content-transfer-encoding))
840 (setq boundary (concat "\n--" boundary))
841 ;; Hide the body before the first bodypart
842 (goto-char (point-min))
843 (when (and (search-forward boundary nil t)
844 (looking-at "[ \t]*\n"))
186f7f0b 845 (if parse-tag
d1be4ec2
KH
846 (narrow-to-region (match-end 0) (point-max))
847 (delete-region (point-min) (match-end 0))))
186f7f0b
KH
848
849 ;; Change content-type to the proper default one for the children.
850 (cond ((string-match "mixed" subtype)
851 (setq content-type '("text/plain")))
852 ((string-match "digest" subtype)
362b9d48
GM
853 (setq content-type '("message/rfc822")))
854 (t
855 (setq content-type nil)))
186f7f0b 856
537ab246
BG
857 ;; Loop over all body parts, where beg points at the beginning of
858 ;; the part and end points at the end of the part. next points at
186f7f0b
KH
859 ;; the beginning of the next part. The current point is just
860 ;; after the boundary tag.
537ab246 861 (setq beg (point-min))
d31fd9ac
RS
862
863 (while (or (and (search-forward boundary nil t)
aa8a705c 864 (setq truncated nil end (match-beginning 0)))
d31fd9ac
RS
865 ;; If the boundary does not appear at all,
866 ;; the message was truncated.
867 ;; Handle the rest of the truncated message
868 ;; (if it isn't empty) by pretending that the boundary
869 ;; appears at the end of the message.
99a1e701
GM
870 ;; We use `last' to distinguish this from the more
871 ;; likely situation of there being an epilogue
872 ;; after the last boundary, which should be ignored.
873 ;; See rmailmm-test-multipart-handler for an example,
874 ;; and also bug#10101.
875 (and (not last)
876 (save-excursion
d31fd9ac
RS
877 (skip-chars-forward "\n")
878 (> (point-max) (point)))
aa8a705c 879 (setq truncated t end (point-max))))
537ab246
BG
880 ;; If this is the last boundary according to RFC 2046, hide the
881 ;; epilogue, else hide the boundary only. Use a marker for
882 ;; `next' because `rmail-mime-show' may change the buffer.
ffa1fed6 883 (cond ((looking-at "--[ \t]*$")
99a1e701
GM
884 (setq next (point-max-marker)
885 last t))
537ab246 886 ((looking-at "[ \t]*\n")
ffa1fed6 887 (setq next (copy-marker (match-end 0) t)))
aa8a705c 888 (truncated
d31fd9ac
RS
889 ;; We're handling what's left of a truncated message.
890 (setq next (point-max-marker)))
537ab246 891 (t
8350f087 892 ;; The original code signaled an error as below, but
c1449bff
KH
893 ;; this line may be a boundary of nested multipart. So,
894 ;; we just set `next' to nil to skip this line
895 ;; (rmail-mm-get-boundary-error-message
896 ;; "Malformed boundary" content-type content-disposition
897 ;; content-transfer-encoding)
898 (setq next nil)))
899
900 (when next
901 (setq index (1+ index))
902 ;; Handle the part.
903 (if parse-tag
904 (save-restriction
905 (narrow-to-region beg end)
906 (let ((child (rmail-mime-process
907 nil (format "%s/%d" parse-tag index)
908 content-type content-disposition)))
909 ;; Display a tagline.
910 (aset (aref (rmail-mime-entity-display child) 1) 1
911 (aset (rmail-mime-entity-tagline child) 2 t))
aa8a705c 912 (rmail-mime-entity-set-truncated child truncated)
c1449bff
KH
913 (push child entities)))
914
915 (delete-region end next)
d1be4ec2
KH
916 (save-restriction
917 (narrow-to-region beg end)
c1449bff
KH
918 (rmail-mime-show)))
919 (goto-char (setq beg next))))
186f7f0b
KH
920
921 (when parse-tag
922 (setq entities (nreverse entities))
923 (if (string-match "alternative" subtype)
924 ;; Find the best entity to show, and hide all the others.
925 (let (best second)
926 (dolist (child entities)
927 (if (string= (or (car (rmail-mime-entity-disposition child))
928 (car content-disposition))
929 "inline")
930 (if (string-match "text/plain"
931 (car (rmail-mime-entity-type child)))
932 (setq best child)
933 (if (string-match "text/.*"
934 (car (rmail-mime-entity-type child)))
935 (setq second child)))))
936 (or best (not second) (setq best second))
937 (dolist (child entities)
e7ca0062
KH
938 (unless (eq best child)
939 (aset (rmail-mime-entity-body child) 2 nil)
940 (rmail-mime-hidden-mode child)))))
186f7f0b 941 entities)))
537ab246 942
186f7f0b
KH
943(defun rmail-mime-insert-multipart (entity)
944 "Presentation handler for a multipart MIME entity."
945 (let ((current (aref (rmail-mime-entity-display entity) 0))
946 (new (aref (rmail-mime-entity-display entity) 1))
947 (header (rmail-mime-entity-header entity))
948 (tagline (rmail-mime-entity-tagline entity))
949 (body (rmail-mime-entity-body entity))
950 (beg (point))
951 (segment (rmail-mime-entity-segment (point) entity)))
952 ;; header
49ae5b39
EZ
953 (if (eq (rmail-mime-display-header current)
954 (rmail-mime-display-header new))
186f7f0b 955 (goto-char (aref segment 2))
49ae5b39 956 (if (rmail-mime-display-header current)
186f7f0b 957 (delete-char (- (aref segment 2) (aref segment 1))))
49ae5b39 958 (if (rmail-mime-display-header new)
186f7f0b
KH
959 (rmail-mime-insert-header header)))
960 ;; tagline
49ae5b39
EZ
961 (if (eq (rmail-mime-display-tagline current)
962 (rmail-mime-display-tagline new))
963 (if (or (not (rmail-mime-display-tagline current))
964 (eq (rmail-mime-display-body current)
965 (rmail-mime-display-body new)))
e7ca0062
KH
966 (forward-char (- (aref segment 3) (aref segment 2)))
967 (rmail-mime-update-tagline entity))
49ae5b39 968 (if (rmail-mime-display-tagline current)
186f7f0b 969 (delete-char (- (aref segment 3) (aref segment 2))))
49ae5b39 970 (if (rmail-mime-display-tagline new)
186f7f0b
KH
971 (rmail-mime-insert-tagline entity)))
972
973 (put-text-property beg (point) 'rmail-mime-entity entity)
e7ca0062 974
186f7f0b 975 ;; body
49ae5b39
EZ
976 (if (eq (rmail-mime-display-body current)
977 (rmail-mime-display-body new))
186f7f0b 978 (forward-char (- (aref segment 4) (aref segment 3)))
e7ca0062
KH
979 (dolist (child (rmail-mime-entity-children entity))
980 (rmail-mime-insert child)))
981 entity))
186f7f0b 982
537ab246
BG
983;;; Main code
984
985(defun rmail-mime-handle (content-type
986 content-disposition
987 content-transfer-encoding)
988 "Handle the current buffer as a MIME part.
989The current buffer should be narrowed to the respective body, and
990point should be at the beginning of the body.
991
992CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING
0c9ff2c5 993are the values of the respective parsed headers. The latter should
672b871d 994be lower-case. The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
0c9ff2c5 995have the form
537ab246
BG
996
997 \(VALUE . ALIST)
998
999In other words:
1000
1001 \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
1002
1003VALUE is a string and ATTRIBUTE is a symbol.
1004
1005Consider the following header, for example:
1006
1007Content-Type: multipart/mixed;
1008 boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"
1009
1010The parsed header value:
1011
1012\(\"multipart/mixed\"
1013 \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
1014 ;; Handle the content transfer encodings we know. Unknown transfer
1015 ;; encodings will be passed on to the various handlers.
1016 (cond ((string= content-transfer-encoding "base64")
1017 (when (ignore-errors
1018 (base64-decode-region (point) (point-max)))
1019 (setq content-transfer-encoding nil)))
1020 ((string= content-transfer-encoding "quoted-printable")
1021 (quoted-printable-decode-region (point) (point-max))
1022 (setq content-transfer-encoding nil))
1023 ((string= content-transfer-encoding "8bit")
1024 ;; FIXME: Is this the correct way?
c893016b
SM
1025 ;; No, of course not, it just means there's no decoding to do.
1026 ;; (set-buffer-multibyte nil)
1027 (setq content-transfer-encoding nil)
1028 ))
537ab246
BG
1029 ;; Inline stuff requires work. Attachments are handled by the bulk
1030 ;; handler.
1031 (if (string= "inline" (car content-disposition))
1032 (let ((stop nil))
1033 (dolist (entry rmail-mime-media-type-handlers-alist)
1034 (when (and (string-match (car entry) (car content-type)) (not stop))
1035 (progn
1036 (setq stop (funcall (cadr entry) content-type
1037 content-disposition
1038 content-transfer-encoding))))))
1039 ;; Everything else is an attachment.
1040 (rmail-mime-bulk-handler content-type
1041 content-disposition
e7ca0062
KH
1042 content-transfer-encoding))
1043 (save-restriction
1044 (widen)
1045 (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
1046 current new)
1047 (when entity
1048 (setq current (aref (rmail-mime-entity-display entity) 0)
1049 new (aref (rmail-mime-entity-display entity) 1))
1050 (dotimes (i 3)
1051 (aset current i (aref new i)))))))
537ab246
BG
1052
1053(defun rmail-mime-show (&optional show-headers)
1054 "Handle the current buffer as a MIME message.
1055If SHOW-HEADERS is non-nil, then the headers of the current part
1056will shown as usual for a MIME message. The headers are also
1057shown for the content type message/rfc822. This function will be
1058called recursively if multiple parts are available.
1059
1060The current buffer must contain a single message. It will be
1061modified."
d1be4ec2
KH
1062 (rmail-mime-process show-headers nil))
1063
186f7f0b
KH
1064(defun rmail-mime-process (show-headers parse-tag &optional
1065 default-content-type
1066 default-content-disposition)
537ab246
BG
1067 (let ((end (point-min))
1068 content-type
1069 content-transfer-encoding
1070 content-disposition)
1071 ;; `point-min' returns the beginning and `end' points at the end
1072 ;; of the headers.
1073 (goto-char (point-min))
1074 ;; If we're showing a part without headers, then it will start
1075 ;; with a newline.
1076 (if (eq (char-after) ?\n)
1077 (setq end (1+ (point)))
1078 (when (search-forward "\n\n" nil t)
1079 (setq end (match-end 0))
1080 (save-restriction
1081 (narrow-to-region (point-min) end)
1082 ;; FIXME: Default disposition of the multipart entities should
1083 ;; be inherited.
1084 (setq content-type
1085 (mail-fetch-field "Content-Type")
1086 content-transfer-encoding
1087 (mail-fetch-field "Content-Transfer-Encoding")
1088 content-disposition
1089 (mail-fetch-field "Content-Disposition")))))
0c9ff2c5
GM
1090 ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
1091 ;; are not completely so. Hopefully mail-header-parse-* DTRT.
1092 (if content-transfer-encoding
1093 (setq content-transfer-encoding (downcase content-transfer-encoding)))
1094 (setq content-type
1095 (if content-type
e7ca0062
KH
1096 (or (mail-header-parse-content-type content-type)
1097 '("text/plain"))
186f7f0b 1098 (or default-content-type '("text/plain"))))
537ab246
BG
1099 (setq content-disposition
1100 (if content-disposition
1101 (mail-header-parse-content-disposition content-disposition)
1102 ;; If none specified, we are free to choose what we deem
1103 ;; suitable according to RFC 2183. We like inline.
186f7f0b 1104 (or default-content-disposition '("inline"))))
537ab246
BG
1105 ;; Unrecognized disposition types are to be treated like
1106 ;; attachment according to RFC 2183.
1107 (unless (member (car content-disposition) '("inline" "attachment"))
1108 (setq content-disposition '("attachment")))
d1be4ec2 1109
186f7f0b
KH
1110 (if parse-tag
1111 (let* ((is-inline (string= (car content-disposition) "inline"))
354cf0ba
RS
1112 (hdr-end (copy-marker end))
1113 (header (vector (point-min-marker) hdr-end nil))
186f7f0b 1114 (tagline (vector parse-tag (cons nil nil) t))
354cf0ba 1115 (body (vector hdr-end (point-max-marker) is-inline))
186f7f0b
KH
1116 (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
1117 children handler entity)
1118 (cond ((string-match "multipart/.*" (car content-type))
1119 (save-restriction
1120 (narrow-to-region (1- end) (point-max))
1121 (setq children (rmail-mime-process-multipart
1122 content-type
1123 content-disposition
1124 content-transfer-encoding
1125 parse-tag)
1126 handler 'rmail-mime-insert-multipart)))
1127 ((string-match "message/rfc822" (car content-type))
1128 (save-restriction
d1be4ec2 1129 (narrow-to-region end (point-max))
186f7f0b
KH
1130 (let* ((msg (rmail-mime-process t parse-tag
1131 '("text/plain") '("inline")))
1132 (msg-new (aref (rmail-mime-entity-display msg) 1)))
1133 ;; Show header of the child.
1134 (aset msg-new 0 t)
1135 (aset (rmail-mime-entity-header msg) 2 t)
1136 ;; Hide tagline of the child.
1137 (aset msg-new 1 nil)
1138 (aset (rmail-mime-entity-tagline msg) 2 nil)
1139 (setq children (list msg)
1140 handler 'rmail-mime-insert-multipart))))
1141 ((and is-inline (string-match "text/" (car content-type)))
1142 ;; Don't need a tagline.
1143 (aset new 1 (aset tagline 2 nil))
1144 (setq handler 'rmail-mime-insert-text))
1145 (t
1146 ;; Force hidden mode.
1147 (aset new 1 (aset tagline 2 t))
1148 (aset new 2 (aset body 2 nil))
1149 (setq handler 'rmail-mime-insert-bulk)))
1150 (setq entity (rmail-mime-entity content-type
1151 content-disposition
1152 content-transfer-encoding
1153 (vector (vector nil nil nil) new)
1154 header tagline body children handler))
1155 (if (and (eq handler 'rmail-mime-insert-bulk)
1156 (rmail-mime-set-bulk-data entity))
1157 ;; Show the body.
1158 (aset new 2 (aset body 2 t)))
1159 entity)
1160
d1be4ec2 1161 ;; Hide headers and handle the part.
186f7f0b 1162 (put-text-property (point-min) (point-max) 'rmail-mime-entity
7c420169 1163 (rmail-mime-entity
354cf0ba
RS
1164 content-type content-disposition
1165 content-transfer-encoding
1166 (vector (vector 'raw nil 'raw) (vector 'raw nil 'raw))
1167 (vector nil nil 'raw) (vector "" (cons nil nil) nil)
1168 (vector nil nil 'raw) nil nil))
d1be4ec2
KH
1169 (save-restriction
1170 (cond ((string= (car content-type) "message/rfc822")
1171 (narrow-to-region end (point-max)))
1172 ((not show-headers)
1173 (delete-region (point-min) end)))
1174 (rmail-mime-handle content-type content-disposition
1175 content-transfer-encoding)))))
1176
d1be4ec2
KH
1177(defun rmail-mime-parse ()
1178 "Parse the current Rmail message as a MIME message.
672b871d 1179The value is a MIME-entity object (see `rmail-mime-entity').
8258ae3f 1180If an error occurs, return an error message string."
186f7f0b
KH
1181 (let ((rmail-mime-mbox-buffer (if (rmail-buffers-swapped-p)
1182 rmail-view-buffer
1183 (current-buffer))))
8258ae3f 1184 (condition-case err
186f7f0b
KH
1185 (with-current-buffer rmail-mime-mbox-buffer
1186 (save-excursion
1187 (goto-char (point-min))
1188 (let* ((entity (rmail-mime-process t ""
1189 '("text/plain") '("inline")))
1190 (new (aref (rmail-mime-entity-display entity) 1)))
1191 ;; Show header.
1192 (aset new 0 (aset (rmail-mime-entity-header entity) 2 t))
1193 ;; Show tagline if and only if body is not shown.
1194 (if (aref new 2)
1195 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 nil))
1196 (aset new 1 (aset (rmail-mime-entity-tagline entity) 2 t)))
1197 entity)))
8258ae3f 1198 (error (format "%s" err)))))
186f7f0b
KH
1199
1200(defun rmail-mime-insert (entity)
d1be4ec2
KH
1201 "Insert a MIME-entity ENTITY in the current buffer.
1202
1203This function will be called recursively if multiple parts are
1204available."
186f7f0b
KH
1205 (let ((current (aref (rmail-mime-entity-display entity) 0))
1206 (new (aref (rmail-mime-entity-display entity) 1)))
49ae5b39 1207 (if (not (eq (rmail-mime-display-header new) 'raw))
186f7f0b
KH
1208 ;; Not a raw-mode. Each handler should handle it.
1209 (funcall (rmail-mime-entity-handler entity) entity)
1210 (let ((header (rmail-mime-entity-header entity))
1211 (tagline (rmail-mime-entity-tagline entity))
1212 (body (rmail-mime-entity-body entity))
1213 (beg (point))
1214 (segment (rmail-mime-entity-segment (point) entity)))
1215 ;; header
49ae5b39
EZ
1216 (if (eq (rmail-mime-display-header current)
1217 (rmail-mime-display-header new))
186f7f0b 1218 (goto-char (aref segment 2))
49ae5b39 1219 (if (rmail-mime-display-header current)
186f7f0b
KH
1220 (delete-char (- (aref segment 2) (aref segment 1))))
1221 (insert-buffer-substring rmail-mime-mbox-buffer
0dee970c 1222 (aref header 0) (aref header 1)))
186f7f0b 1223 ;; tagline
49ae5b39 1224 (if (rmail-mime-display-tagline current)
186f7f0b
KH
1225 (delete-char (- (aref segment 3) (aref segment 2))))
1226 ;; body
e7ca0062
KH
1227 (let ((children (rmail-mime-entity-children entity)))
1228 (if children
1229 (progn
1230 (put-text-property beg (point) 'rmail-mime-entity entity)
1231 (dolist (child children)
1232 (rmail-mime-insert child)))
49ae5b39
EZ
1233 (if (eq (rmail-mime-display-body current)
1234 (rmail-mime-display-body new))
e7ca0062 1235 (forward-char (- (aref segment 4) (aref segment 3)))
49ae5b39 1236 (if (rmail-mime-display-body current)
e7ca0062
KH
1237 (delete-char (- (aref segment 4) (aref segment 3))))
1238 (insert-buffer-substring rmail-mime-mbox-buffer
1239 (aref body 0) (aref body 1))
1240 (or (bolp) (insert "\n")))
1241 (put-text-property beg (point) 'rmail-mime-entity entity)))))
186f7f0b
KH
1242 (dotimes (i 3)
1243 (aset current i (aref new i)))))
537ab246 1244
2e9075d3
GM
1245(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
1246 "Major mode used in `rmail-mime' buffers."
1247 (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil)))
1248
73422054 1249;;;###autoload
d20faa20
GM
1250(defun rmail-mime (&optional arg state)
1251 "Toggle the display of a MIME message.
186f7f0b 1252
672b871d 1253The actual behavior depends on the value of `rmail-enable-mime'.
186f7f0b 1254
d20faa20
GM
1255If `rmail-enable-mime' is non-nil (the default), this command toggles
1256the display of a MIME message between decoded presentation form and
1257raw data. With optional prefix argument ARG, it toggles the display only
1258of the MIME entity at point, if there is one. The optional argument
1259STATE forces a particular display state, rather than toggling.
1260`raw' forces raw mode, any other non-nil value forces decoded mode.
1261
1262If `rmail-enable-mime' is nil, this creates a temporary \"*RMAIL*\"
1263buffer holding a decoded copy of the message. Inline content-types are
1264handled according to `rmail-mime-media-type-handlers-alist'.
1265By default, this displays text and multipart messages, and offers to
1266download attachments as specified by `rmail-mime-attachment-dirs-alist'.
1267The arguments ARG and STATE have no effect in this case."
1268 (interactive (list current-prefix-arg nil))
186f7f0b 1269 (if rmail-enable-mime
e7ca0062 1270 (with-current-buffer rmail-buffer
0dee970c
RS
1271 (if (or (rmail-mime-message-p)
1272 (get-text-property (point-min) 'rmail-mime-hidden))
1273 (let* ((hidden (get-text-property (point-min) 'rmail-mime-hidden))
1274 (desired-hidden (if state (eq state 'raw) (not hidden))))
1275 (unless (eq hidden desired-hidden)
1276 (if (not desired-hidden)
1277 (rmail-show-message rmail-current-message)
1278 (let ((rmail-enable-mime nil)
1279 (inhibit-read-only t))
1280 (rmail-show-message rmail-current-message)
1281 (add-text-properties (point-min) (point-max) '(rmail-mime-hidden t))))))
c0bc0fd4
GM
1282 (message "Not a MIME message, just toggling headers")
1283 (rmail-toggle-header)))
186f7f0b
KH
1284 (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
1285 (buf (get-buffer-create "*RMAIL*"))
1286 (rmail-mime-mbox-buffer rmail-view-buffer)
1287 (rmail-mime-view-buffer buf))
1288 (set-buffer buf)
1289 (setq buffer-undo-list t)
1290 (let ((inhibit-read-only t))
1291 ;; Decoding the message in fundamental mode for speed, only
1292 ;; switching to rmail-mime-mode at the end for display. Eg
1293 ;; quoted-printable-decode-region gets very slow otherwise (Bug#4993).
1294 (fundamental-mode)
1295 (erase-buffer)
1296 (insert data)
1297 (rmail-mime-show t)
1298 (rmail-mime-mode)
1299 (set-buffer-modified-p nil))
1300 (view-buffer buf))))
537ab246
BG
1301
1302(defun rmail-mm-get-boundary-error-message (message type disposition encoding)
672b871d 1303 "Return MESSAGE with more information on the main MIME components."
537ab246
BG
1304 (error "%s; type: %s; disposition: %s; encoding: %s"
1305 message type disposition encoding))
1306
d1be4ec2 1307(defun rmail-show-mime ()
45261b50 1308 "Function to use for the value of `rmail-show-mime-function'."
186f7f0b
KH
1309 (let ((entity (rmail-mime-parse))
1310 (rmail-mime-mbox-buffer rmail-buffer)
1311 (rmail-mime-view-buffer rmail-view-buffer)
1312 (rmail-mime-coding-system nil))
2e51d4b5 1313 ;; If ENTITY is not a vector, it is a string describing an error.
8258ae3f 1314 (if (vectorp entity)
186f7f0b
KH
1315 (with-current-buffer rmail-mime-view-buffer
1316 (erase-buffer)
2e51d4b5
KH
1317 ;; This condition-case is for catching an error in the
1318 ;; internal MIME decoding (e.g. incorrect BASE64 form) that
1319 ;; may be signaled by rmail-mime-insert.
1320 ;; FIXME: The current code doesn't set a proper error symbol
1321 ;; in ERR. We must find a way to propagate a correct error
1322 ;; symbol that is caused in the very deep code of text
1323 ;; decoding (e.g. an error by base64-decode-region called by
1324 ;; post-read-conversion function of utf-7).
1325 (condition-case err
1326 (progn
1327 (rmail-mime-insert entity)
1328 (if (consp rmail-mime-coding-system)
1329 ;; Decoding is done by rfc2047-decode-region only for a
1330 ;; header. But, as the used coding system may have been
1331 ;; overridden by mm-charset-override-alist, we can't
1332 ;; trust (car rmail-mime-coding-system). So, here we
1333 ;; try the decoding again with mm-charset-override-alist
1334 ;; bound to nil.
1335 (let ((mm-charset-override-alist nil))
1336 (setq rmail-mime-coding-system
1337 (rmail-mime-find-header-encoding
1338 (rmail-mime-entity-header entity)))))
1339 (set-buffer-file-coding-system
1340 (if rmail-mime-coding-system
1341 (coding-system-base rmail-mime-coding-system)
1342 'undecided)
1343 t t))
1344 (error (setq entity (format "%s" err))))))
1345 ;; Re-check ENTITY. It may be set to an error string.
1346 (when (stringp entity)
8258ae3f
KH
1347 ;; Decoding failed. ENTITY is an error message. Insert the
1348 ;; original message body as is, and show warning.
186f7f0b 1349 (let ((region (with-current-buffer rmail-mime-mbox-buffer
7e116860
KH
1350 (goto-char (point-min))
1351 (re-search-forward "^$" nil t)
1352 (forward-line 1)
8258ae3f 1353 (vector (point-min) (point) (point-max)))))
186f7f0b 1354 (with-current-buffer rmail-mime-view-buffer
7e116860
KH
1355 (let ((inhibit-read-only t))
1356 (erase-buffer)
8258ae3f 1357 (rmail-mime-insert-header region)
186f7f0b 1358 (insert-buffer-substring rmail-mime-mbox-buffer
8258ae3f 1359 (aref region 1) (aref region 2))))
186f7f0b 1360 (set-buffer-file-coding-system 'no-conversion t t)
8258ae3f 1361 (message "MIME decoding failed: %s" entity)))))
d1be4ec2
KH
1362
1363(setq rmail-show-mime-function 'rmail-show-mime)
1364
1365(defun rmail-insert-mime-forwarded-message (forward-buffer)
7a70468f
RS
1366 "Insert the message in FORWARD-BUFFER as a forwarded message.
1367This is the usual value of `rmail-insert-mime-forwarded-message-function'."
1368 (let ((message-buffer
1369 (with-current-buffer forward-buffer
1370 (if rmail-buffer-swapped
bb709253
ML
1371 rmail-view-buffer
1372 forward-buffer))))
d1be4ec2
KH
1373 (save-restriction
1374 (narrow-to-region (point) (point))
7a70468f 1375 (message-forward-make-body-mime message-buffer))))
d1be4ec2
KH
1376
1377(setq rmail-insert-mime-forwarded-message-function
1378 'rmail-insert-mime-forwarded-message)
1379
1380(defun rmail-insert-mime-resent-message (forward-buffer)
7e116860 1381 "Function to set in `rmail-insert-mime-resent-message-function' (which see)."
d1be4ec2
KH
1382 (insert-buffer-substring
1383 (with-current-buffer forward-buffer rmail-view-buffer))
1384 (goto-char (point-min))
1385 (when (looking-at "From ")
1386 (forward-line 1)
1387 (delete-region (point-min) (point))))
1388
1389(setq rmail-insert-mime-resent-message-function
1390 'rmail-insert-mime-resent-message)
1391
7e116860
KH
1392(defun rmail-search-mime-message (msg regexp)
1393 "Function to set in `rmail-search-mime-message-function' (which see)."
1394 (save-restriction
1395 (narrow-to-region (rmail-msgbeg msg) (rmail-msgend msg))
186f7f0b
KH
1396 (let* ((rmail-mime-mbox-buffer (current-buffer))
1397 (rmail-mime-view-buffer rmail-view-buffer)
1398 (header-end (save-excursion
1399 (re-search-forward "^$" nil 'move) (point)))
1400 (body-end (point-max))
1401 (entity (rmail-mime-parse)))
7c420169 1402 (or
7e116860
KH
1403 ;; At first, just search the headers.
1404 (with-temp-buffer
186f7f0b 1405 (insert-buffer-substring rmail-mime-mbox-buffer nil header-end)
7e116860
KH
1406 (rfc2047-decode-region (point-min) (point))
1407 (goto-char (point-min))
1408 (re-search-forward regexp nil t))
1409 ;; Next, search the body.
1410 (if (and entity
a9a936b9
RS
1411 ;; RMS: I am not sure why, but sometimes this is a string.
1412 (not (stringp entity))
7e116860
KH
1413 (let* ((content-type (rmail-mime-entity-type entity))
1414 (charset (cdr (assq 'charset (cdr content-type)))))
7c420169 1415 (or (not (string-match "text/.*" (car content-type)))
7e116860
KH
1416 (and charset
1417 (not (string= (downcase charset) "us-ascii"))))))
1418 ;; Search the decoded MIME message.
1419 (with-temp-buffer
186f7f0b 1420 (rmail-mime-insert entity)
7e116860
KH
1421 (goto-char (point-min))
1422 (re-search-forward regexp nil t))
1423 ;; Search the body without decoding.
1424 (goto-char header-end)
1425 (re-search-forward regexp nil t))))))
1426
1427(setq rmail-search-mime-message-function 'rmail-search-mime-message)
1428
537ab246
BG
1429(provide 'rmailmm)
1430
35426db4
GM
1431;; Local Variables:
1432;; generated-autoload-file: "rmail.el"
1433;; End:
1434
537ab246 1435;;; rmailmm.el ends here