rmailmm.el 53.8 KB
Newer Older
1 2
;;; rmailmm.el --- MIME decoding and display stuff for RMAIL

3
;; Copyright (C) 2006-2011  Free Software Foundation, Inc.
4

Glenn Morris's avatar
Glenn Morris committed
5 6
;; Author: Alexander Pohoyda
;;	Alex Schroeder
7 8
;; Maintainer: FSF
;; Keywords: mail
9
;; Package: rmail
10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Essentially based on the design of Alexander Pohoyda's MIME
Glenn Morris's avatar
Glenn Morris committed
29
;; extensions (mime-display.el and mime.el).
Kenichi Handa's avatar
Kenichi Handa committed
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55

;; This file provides two operation modes for viewing a MIME message.

;; (1) When rmail-enable-mime is non-nil (now it is the default), the
;; function `rmail-show-mime' is automatically called.  That function
;; shows a MIME message directly in RMAIL's view buffer.

;; (2) When rmail-enable-mime is nil, the command 'v' (or M-x
;; rmail-mime) shows a MIME message in a new buffer "*RMAIL*".

;; Both operations share the intermediate functions rmail-mime-process
;; and rmail-mime-process-multipart as below.

;; rmail-show-mime
;;   +- rmail-mime-parse
;;   |    +- rmail-mime-process <--+------------+
;;   |         |         +---------+            |
;;   |         + rmail-mime-process-multipart --+
;;   |
;;   + rmail-mime-insert <----------------+
;;       +- rmail-mime-insert-text        |
;;       +- rmail-mime-insert-bulk        |
;;       +- rmail-mime-insert-multipart --+
;;
;; rmail-mime
;;  +- rmail-mime-show <----------------------------------+
56
;;       +- rmail-mime-process                            |
Kenichi Handa's avatar
Kenichi Handa committed
57 58 59 60 61 62 63 64 65 66 67
;;            +- rmail-mime-handle                        |
;;                 +- rmail-mime-text-handler             |
;;                 +- rmail-mime-bulk-handler             |
;;                 |    + rmail-mime-insert-bulk
;;                 +- rmail-mime-multipart-handler        |
;;                      +- rmail-mime-process-multipart --+

;; In addition, for the case of rmail-enable-mime being non-nil, this
;; file provides two functions rmail-insert-mime-forwarded-message and
;; rmail-insert-mime-resent-message for composing forwarded and resent
;; messages respectively.
68

69 70
;; Todo:

Kenichi Handa's avatar
Kenichi Handa committed
71 72 73
;; Make rmail-mime-media-type-handlers-alist usable in the first
;; operation mode.
;; Handle multipart/alternative in the second operation mode.
74
;; Offer the option to call external/internal viewers (doc-view, xpdf, etc).
75

76 77 78 79
;;; Code:

(require 'rmail)
(require 'mail-parse)
Kenichi Handa's avatar
Kenichi Handa committed
80
(require 'message)
81

82
;;; User options.
83

Glenn Morris's avatar
Glenn Morris committed
84 85 86 87 88
(defgroup rmail-mime nil
  "Rmail MIME handling options."
  :prefix "rmail-mime-"
  :group 'rmail)

89 90 91 92
(defcustom rmail-mime-media-type-handlers-alist
  '(("multipart/.*" rmail-mime-multipart-handler)
    ("text/.*" rmail-mime-text-handler)
    ("text/\\(x-\\)?patch" rmail-mime-bulk-handler)
Glenn Morris's avatar
Glenn Morris committed
93
    ("\\(image\\|audio\\|video\\|application\\)/.*" rmail-mime-bulk-handler))
94
  "Functions to handle various content types.
95 96 97
This is an alist with elements of the form (REGEXP FUNCTION ...).
The first item is a regular expression matching a content-type.
The remaining elements are handler functions to run, in order of
98 99
decreasing preference.  These are called until one returns non-nil.
Note that this only applies to items with an inline Content-Disposition,
100 101 102
all others are handled by `rmail-mime-bulk-handler'.
Note also that this alist is ignored when the variable
`rmail-enable-mime' is non-nil."
103
  :type '(alist :key-type regexp :value-type (repeat function))
Glenn Morris's avatar
Glenn Morris committed
104 105
  :version "23.1"
  :group 'rmail-mime)
106 107

(defcustom rmail-mime-attachment-dirs-alist
108
  `(("text/.*" "~/Documents")
109
    ("image/.*" "~/Pictures")
110
    (".*" "~/Desktop" "~" ,temporary-file-directory))
111 112 113 114 115 116 117
  "Default directories to save attachments of various types into.
This is an alist with elements of the form (REGEXP DIR ...).
The first item is a regular expression matching a content-type.
The remaining elements are directories, in order of decreasing preference.
The first directory that exists is used."
  :type '(alist :key-type regexp :value-type (repeat directory))
  :version "23.1"
Glenn Morris's avatar
Glenn Morris committed
118 119 120 121 122
  :group 'rmail-mime)

(defcustom rmail-mime-show-images 'button
  "What to do with image attachments that Emacs is capable of displaying.
If nil, do nothing special.  If `button', add an extra button
123 124 125 126
that when pushed displays the image in the buffer.  If a number,
automatically show images if they are smaller than that size (in
bytes), otherwise add a display button.  Anything else means to
automatically display the image in the buffer."
Glenn Morris's avatar
Glenn Morris committed
127 128
  :type '(choice (const :tag "Add button to view image" button)
		 (const :tag "No special treatment" nil)
129
		 (number :tag "Show if smaller than certain size")
Glenn Morris's avatar
Glenn Morris committed
130 131 132
		 (other :tag "Always show" show))
  :version "23.2"
  :group 'rmail-mime)
133

134 135
;;; End of user options.

136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
;;; Global variables that always have let-binding when referred.

(defvar rmail-mime-mbox-buffer nil
  "Buffer containing the mbox data.
The value is usually nil, and bound to a proper value while
processing MIME.")

(defvar rmail-mime-view-buffer nil
  "Buffer showing a message.
The value is usually nil, and bound to a proper value while
processing MIME.")

(defvar rmail-mime-coding-system nil
  "The first coding-system used for decoding a MIME entity.
The value is usually nil, and bound to non-nil while inserting
MIME entities.")

Kenichi Handa's avatar
Kenichi Handa committed
153 154 155
;;; MIME-entity object

(defun rmail-mime-entity (type disposition transfer-encoding
156 157
			       display header tagline body children handler
			       &optional truncated)
Glenn Morris's avatar
Glenn Morris committed
158
  "Return a newly created MIME-entity object from arguments.
Kenichi Handa's avatar
Kenichi Handa committed
159

160
A MIME-entity is a vector of 10 elements:
Kenichi Handa's avatar
Kenichi Handa committed
161

162
  [TYPE DISPOSITION TRANSFER-ENCODING DISPLAY HEADER TAGLINE BODY
163
   CHILDREN HANDLER TRUNCATED]
164

165
TYPE and DISPOSITION correspond to MIME headers Content-Type and
166
Content-Disposition respectively, and have this format:
Kenichi Handa's avatar
Kenichi Handa committed
167 168 169

  \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)

170
Each VALUE is a string and each ATTRIBUTE is a string.
Kenichi Handa's avatar
Kenichi Handa committed
171 172 173 174 175 176 177 178 179 180 181 182

Consider the following header, for example:

Content-Type: multipart/mixed;
	boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"

The corresponding TYPE argument must be:

\(\"multipart/mixed\"
  \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))

TRANSFER-ENCODING corresponds to MIME header
Glenn Morris's avatar
Glenn Morris committed
183
Content-Transfer-Encoding, and is a lower-case string.
Kenichi Handa's avatar
Kenichi Handa committed
184

185
DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how
Glenn Morris's avatar
Glenn Morris committed
186 187 188 189 190
the header, tag line, and body of the entity are displayed now,
and NEW indicates how their display should be updated.
Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY],
where each constituent element is a symbol for the corresponding
item with these values:
191
  nil: not displayed
Glenn Morris's avatar
Glenn Morris committed
192
  t:   displayed by the decoded presentation form
193 194 195
  raw: displayed by the raw MIME data (for the header and body only)

HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and
196 197
END are markers that specify the region of the header or body lines
in RMAIL's data (mbox) buffer, and DISPLAY-FLAG non-nil means that the
198 199 200 201 202 203
header or body is, by default, displayed by the decoded
presentation form.

TAGLINE is a vector [TAG BULK-DATA DISPLAY-FLAG], where TAG is a
string indicating the depth and index number of the entity,
BULK-DATA is a cons (SIZE . TYPE) indicating the size and type of
Glenn Morris's avatar
Glenn Morris committed
204 205
an attached data, DISPLAY-FLAG non-nil means that the tag line is
displayed by default.
206 207

CHILDREN is a list of child MIME-entities.  A \"multipart/*\"
Glenn Morris's avatar
Glenn Morris committed
208
entity has one or more children.  A \"message/rfc822\" entity
209 210 211
has just one child.  Any other entity has no child.

HANDLER is a function to insert the entity according to DISPLAY.
212 213 214 215
It is called with one argument ENTITY.

TRUNCATED is non-nil if the text of this entity was truncated."

216
  (vector type disposition transfer-encoding
217
	  display header tagline body children handler truncated))
Kenichi Handa's avatar
Kenichi Handa committed
218 219 220 221 222

;; Accessors for a MIME-entity object.
(defsubst rmail-mime-entity-type (entity) (aref entity 0))
(defsubst rmail-mime-entity-disposition (entity) (aref entity 1))
(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2))
223 224 225 226 227 228
(defsubst rmail-mime-entity-display (entity) (aref entity 3))
(defsubst rmail-mime-entity-header (entity) (aref entity 4))
(defsubst rmail-mime-entity-tagline (entity) (aref entity 5))
(defsubst rmail-mime-entity-body (entity) (aref entity 6))
(defsubst rmail-mime-entity-children (entity) (aref entity 7))
(defsubst rmail-mime-entity-handler (entity) (aref entity 8))
229 230 231
(defsubst rmail-mime-entity-truncated (entity) (aref entity 9))
(defsubst rmail-mime-entity-set-truncated (entity truncated)
  (aset entity 9 truncated))
232 233 234 235 236

(defsubst rmail-mime-message-p ()
  "Non-nil if and only if the current message is a MIME."
  (or (get-text-property (point) 'rmail-mime-entity)
      (get-text-property (point-min) 'rmail-mime-entity)))
237

238 239 240 241
;;; Buttons

(defun rmail-mime-save (button)
  "Save the attachment using info in the BUTTON."
242 243
  (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
	 (filename (button-get button 'filename))
244
	 (directory (button-get button 'directory))
245 246
	 (data (button-get button 'data))
	 (ofilename filename))
247 248 249 250
    (if (and (not (stringp data))
	     (rmail-mime-entity-truncated data))
	(unless (y-or-n-p "This entity is truncated; save anyway? ")
	  (error "Aborted")))
251 252 253 254 255
    (setq filename (expand-file-name
		    (read-file-name (format "Save as (default: %s): " filename)
				    directory
				    (expand-file-name filename directory))
		    directory))
256 257 258 259 260 261 262
    ;; If arg is just a directory, use the default file name, but in
    ;; that directory (copied from write-file).
    (if (file-directory-p filename)
	(setq filename (expand-file-name
			(file-name-nondirectory ofilename)
			(file-name-as-directory filename))))
    (with-temp-buffer
263
      (set-buffer-file-coding-system 'no-conversion)
264 265 266 267
      ;; Needed e.g. by jka-compr, so if the attachment is a compressed
      ;; file, the magic signature compares equal with the unibyte
      ;; signature string recorded in jka-compr-compression-info-list.
      (set-buffer-multibyte nil)
Kenichi Handa's avatar
Kenichi Handa committed
268 269 270 271 272 273
      (setq buffer-undo-list t)
      (if (stringp data)
	  (insert data)
	;; DATA is a MIME-entity object.
	(let ((transfer-encoding (rmail-mime-entity-transfer-encoding data))
	      (body (rmail-mime-entity-body data)))
274 275
	  (insert-buffer-substring rmail-mime-mbox-buffer
				   (aref body 0) (aref body 1))
Kenichi Handa's avatar
Kenichi Handa committed
276 277 278 279
	  (cond ((string= transfer-encoding "base64")
		 (ignore-errors (base64-decode-region (point-min) (point-max))))
		((string= transfer-encoding "quoted-printable")
		 (quoted-printable-decode-region (point-min) (point-max))))))
280
      (write-region nil nil filename nil nil nil t))))
281

282
(define-button-type 'rmail-mime-save 'action 'rmail-mime-save)
283

284 285 286 287 288 289
;; Display options returned by rmail-mime-entity-display.
;; Value is on of nil, t, raw.
(defsubst rmail-mime-display-header (disp)  (aref disp 0))
(defsubst rmail-mime-display-tagline (disp) (aref disp 1))
(defsubst rmail-mime-display-body (disp)    (aref disp 2))

290 291 292
(defun rmail-mime-entity-segment (pos &optional entity)
  "Return a vector describing the displayed region of a MIME-entity at POS.
Optional 2nd argument ENTITY is the MIME-entity at POS.
Glenn Morris's avatar
Glenn Morris committed
293 294
The value is a vector [INDEX HEADER TAGLINE BODY END], where
  INDEX: index into the returned vector indicating where POS is (1..3)
295
  HEADER: the position of the beginning of a header
296 297
  TAGLINE: the position of the beginning of a tag line, including
           the newline that precedes it
298
  BODY: the position of the beginning of a body
299
  END: the position of the end of the entity."
300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
  (save-excursion
    (or entity
	(setq entity (get-text-property pos 'rmail-mime-entity)))
    (if (not entity)
	(vector 1 (point) (point) (point) (point))
      (let ((current (aref (rmail-mime-entity-display entity) 0))
	    (beg (if (and (> pos (point-min))
			  (eq (get-text-property (1- pos) 'rmail-mime-entity)
			      entity))
		     (previous-single-property-change pos 'rmail-mime-entity
						      nil (point-min))
		   pos))
	    (index 1)
	    tagline-beg body-beg end)
	(goto-char beg)
315 316
	;; If the header is displayed, get past it to the tagline.
	(if (rmail-mime-display-header current)
317 318 319 320
	    (search-forward "\n\n" nil t))
	(setq tagline-beg (point))
	(if (>= pos tagline-beg)
	    (setq index 2))
321 322
	;; If the tagline is displayed, get past it to the body.
	(if (rmail-mime-display-tagline current)
Paul Eggert's avatar
Paul Eggert committed
323
	    ;; The next forward-line call must be in sync with how
324 325 326
	    ;; `rmail-mime-insert-tagline' formats the tagline.  The
	    ;; body begins after the empty line that ends the tagline.
	    (forward-line 3))
327 328 329
	(setq body-beg (point))
	(if (>= pos body-beg)
	    (setq index 3))
330 331
	;; If the body is displayed, find its end.
	(if (rmail-mime-display-body current)
332 333 334 335
	    (let ((tag (aref (rmail-mime-entity-tagline entity) 0))
		  tag2)
	      (setq end (next-single-property-change beg 'rmail-mime-entity
						     nil (point-max)))
336 337 338 339 340
	      ;; `tag' is either an empty string or "/n" where n is
	      ;; the number of the part of the multipart MIME message.
	      ;; The loop below finds the next location whose
	      ;; `rmail-mime-entity' property specifies a tag of a
	      ;; different value.
341 342 343 344 345 346 347 348 349 350 351
	      (while (and (< end (point-max))
			  (setq entity (get-text-property end 'rmail-mime-entity)
				tag2 (aref (rmail-mime-entity-tagline entity) 0))
			  (and (> (length tag2) 0)
			       (eq (string-match tag tag2) 0)))
		(setq end (next-single-property-change end 'rmail-mime-entity
						       nil (point-max)))))
	  (setq end body-beg))
	(vector index beg tagline-beg body-beg end)))))

(defun rmail-mime-shown-mode (entity)
Glenn Morris's avatar
Glenn Morris committed
352
  "Make MIME-entity ENTITY display in the default way."
353 354 355
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 (aref (rmail-mime-entity-header entity) 2))
    (aset new 1 (aref (rmail-mime-entity-tagline entity) 2))
356
    (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
357
  (dolist (child (rmail-mime-entity-children entity))
358
    (rmail-mime-shown-mode child)))
359

360
(defun rmail-mime-hidden-mode (entity)
Glenn Morris's avatar
Glenn Morris committed
361
  "Make MIME-entity ENTITY display in hidden mode."
362 363 364 365
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 nil)
    (aset new 1 t)
    (aset new 2 nil))
366
  (dolist (child (rmail-mime-entity-children entity))
367
    (rmail-mime-hidden-mode child)))
368 369

(defun rmail-mime-raw-mode (entity)
Glenn Morris's avatar
Glenn Morris committed
370
  "Make MIME-entity ENTITY display in raw mode."
371 372 373
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 'raw)
    (aset new 1 nil)
374 375 376
    (aset new 2 'raw))
  (dolist (child (rmail-mime-entity-children entity))
    (rmail-mime-raw-mode child)))
377

378 379 380 381
(defun rmail-mime-toggle-raw (&optional state)
  "Toggle on and off the raw display mode of MIME-entity at point.
With optional argument STATE, force the specified display mode.
Use `raw' for raw mode, and any other non-nil value for decoded mode."
382 383 384 385
  (let* ((pos (if (eobp) (1- (point-max)) (point)))
	 (entity (get-text-property pos 'rmail-mime-entity))
	 (current (aref (rmail-mime-entity-display entity) 0))
	 (segment (rmail-mime-entity-segment pos entity)))
386 387
    (if (or (eq state 'raw)
	    (and (not state)
388
		 (not (eq (rmail-mime-display-header current) 'raw))))
389 390 391 392 393 394 395 396 397 398 399 400
	;; Enter the raw mode.
	(rmail-mime-raw-mode entity)
      ;; Enter the shown mode.
      (rmail-mime-shown-mode entity))
    (let ((inhibit-read-only t)
	  (modified (buffer-modified-p)))
      (save-excursion
	(goto-char (aref segment 1))
	(rmail-mime-insert entity)
	(restore-buffer-modified-p modified)))))

(defun rmail-mime-toggle-hidden ()
Glenn Morris's avatar
Glenn Morris committed
401
  "Hide or show the body of the MIME-entity at point."
402 403 404 405 406 407 408 409
  (interactive)
  (when (rmail-mime-message-p)
    (let* ((rmail-mime-mbox-buffer rmail-view-buffer)
	   (rmail-mime-view-buffer (current-buffer))
	   (pos (if (eobp) (1- (point-max)) (point)))
	   (entity (get-text-property pos 'rmail-mime-entity))
	   (current (aref (rmail-mime-entity-display entity) 0))
	   (segment (rmail-mime-entity-segment pos entity)))
410
      (if (rmail-mime-display-body current)
411 412 413
	  ;; Enter the hidden mode.
	  (progn
	    ;; If point is in the body part, move it to the tagline
414
	    ;; (or the header if tagline is not displayed).
415 416
	    (if (= (aref segment 0) 3)
		(goto-char (aref segment 2)))
417
	    (rmail-mime-hidden-mode entity)
418 419 420 421 422
	    ;; If the current entity is the topmost one, display the
	    ;; header.
	    (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min)))
		(let ((new (aref (rmail-mime-entity-display entity) 1)))
		  (aset new 0 t))))
423 424 425 426 427
	;; Query as a warning before showing if truncated.
	(if (and (not (stringp entity))
		 (rmail-mime-entity-truncated entity))
	    (unless (y-or-n-p "This entity is truncated; show anyway? ")
	      (error "Aborted")))
428
	;; Enter the shown mode.
429 430 431
	(rmail-mime-shown-mode entity)
	;; Force this body shown.
	(aset (aref (rmail-mime-entity-display entity) 1) 2 t))
432 433 434 435 436 437 438 439 440
      (let ((inhibit-read-only t)
	    (modified (buffer-modified-p))
	    (rmail-mime-mbox-buffer rmail-view-buffer)
	    (rmail-mime-view-buffer rmail-buffer))
	(save-excursion
	  (goto-char (aref segment 1))
	  (rmail-mime-insert entity)
	  (restore-buffer-modified-p modified))))))

441 442
(define-key rmail-mode-map "\t" 'forward-button)
(define-key rmail-mode-map [backtab] 'backward-button)
443 444
(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)

445 446
;;; Handlers

447 448
(defun rmail-mime-insert-tagline (entity &rest item-list)
  "Insert a tag line for MIME-entity ENTITY.
Glenn Morris's avatar
Glenn Morris committed
449
ITEM-LIST is a list of strings or button-elements (list) to add
450
to the tag line."
451 452 453
  ;; Precede the tagline by an empty line to make it a separate
  ;; paragraph, so that it is aligned to the left margin of the window
  ;; even if preceded by a right-to-left paragraph.
454
  (insert "\n[")
455 456
  (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
    (if (> (length tag) 0) (insert (substring tag 1) ":")))
457 458
  (insert (car (rmail-mime-entity-type entity)) " ")
  (insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
459
		   (if (rmail-mime-display-body new) "Hide" "Show"))
460 461
		 :type 'rmail-mime-toggle
		 'help-echo "mouse-2, RET: Toggle show/hide")
462 463 464 465 466
  (dolist (item item-list)
    (when item
      (if (stringp item)
	  (insert item)
	(apply 'insert-button item))))
467 468 469
  ;; Follow the tagline by an empty line to make it a separate
  ;; paragraph, so that the paragraph direction of the following text
  ;; is determined based on that text.
470
  (insert "]\n\n"))
471

472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489
(defun rmail-mime-update-tagline (entity)
  "Update the current tag line for MIME-entity ENTITY."
  (let ((inhibit-read-only t)
	(modified (buffer-modified-p))
	;; If we are going to show the body, the new button label is
	;; "Hide".  Otherwise, it's "Show".
	(label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide"
		 "Show"))
	(button (next-button (point))))
    ;; Go to the second character of the button "Show" or "Hide".
    (goto-char (1+ (button-start button)))
    (setq button (button-at (point)))
    (save-excursion
      (insert label)
      (delete-region (point) (button-end button)))
    (delete-region (button-start button) (point))
    (put-text-property (point) (button-end button) 'rmail-mime-entity entity)
    (restore-buffer-modified-p modified)
490 491 492
    ;; The following call to forward-line must be in sync with how
    ;; rmail-mime-insert-tagline formats the tagline.
    (forward-line 2)))
493

494 495 496
(defun rmail-mime-insert-header (header)
  "Decode and insert a MIME-entity header HEADER in the current buffer.
HEADER is a vector [BEG END DEFAULT-STATUS].
Glenn Morris's avatar
Glenn Morris committed
497
See `rmail-mime-entity' for details."
498 499 500 501 502 503 504 505 506 507 508 509
  (let ((pos (point))
	(last-coding-system-used nil))
    (save-restriction
      (narrow-to-region pos pos)
      (with-current-buffer rmail-mime-mbox-buffer
	(let ((rmail-buffer rmail-mime-mbox-buffer)
	      (rmail-view-buffer rmail-mime-view-buffer))
	  (save-excursion
	    (goto-char (aref header 0))
	    (rmail-copy-headers (point) (aref header 1)))))
      (rfc2047-decode-region pos (point))
      (if (and last-coding-system-used (not rmail-mime-coding-system))
510
	  (setq rmail-mime-coding-system (cons last-coding-system-used nil)))
511 512 513 514 515
      (goto-char (point-min))
      (rmail-highlight-headers)
      (goto-char (point-max))
      (insert "\n"))))

516
(defun rmail-mime-find-header-encoding (header)
Juanma Barranquero's avatar
Juanma Barranquero committed
517
  "Return the last coding system used to decode HEADER.
518 519 520
HEADER is a header component of a MIME-entity object (see
`rmail-mime-entity')."
  (with-temp-buffer
521
    (let ((buf (current-buffer)))
522
      (with-current-buffer rmail-mime-mbox-buffer
523 524 525
	(let ((last-coding-system-used nil)
	      (rmail-buffer rmail-mime-mbox-buffer)
	      (rmail-view-buffer buf))
526 527 528 529 530 531
	  (save-excursion
	    (goto-char (aref header 0))
	    (rmail-copy-headers (point) (aref header 1)))))
      (rfc2047-decode-region (point-min) (point-max))
      last-coding-system-used)))

532 533 534 535
(defun rmail-mime-text-handler (content-type
				content-disposition
				content-transfer-encoding)
  "Handle the current buffer as a plain text MIME part."
536 537 538 539 540 541 542 543 544 545
  (rmail-mime-insert-text
   (rmail-mime-entity content-type content-disposition
		      content-transfer-encoding
		      (vector (vector nil nil nil) (vector nil nil t))
		      (vector nil nil nil) (vector "" (cons nil nil) t)
		      (vector nil nil nil) nil 'rmail-mime-insert-text))
  t)

(defun rmail-mime-insert-decoded-text (entity)
  "Decode and insert the text body of MIME-entity ENTITY."
Kenichi Handa's avatar
Kenichi Handa committed
546 547
  (let* ((content-type (rmail-mime-entity-type entity))
	 (charset (cdr (assq 'charset (cdr content-type))))
548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563
	 (coding-system (if charset
			    (coding-system-from-name charset)))
	 (body (rmail-mime-entity-body entity))
	 (pos (point)))
    (or (and coding-system (coding-system-p coding-system))
	(setq coding-system 'undecided))
    (if (stringp (aref body 0))
	(insert (aref body 0))
      (let ((transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
	(insert-buffer-substring rmail-mime-mbox-buffer
				 (aref body 0) (aref body 1))
	(cond ((string= transfer-encoding "base64")
	       (ignore-errors (base64-decode-region pos (point))))
	      ((string= transfer-encoding "quoted-printable")
	       (quoted-printable-decode-region pos (point))))))
    (decode-coding-region pos (point) coding-system)
564 565 566
    (if (and
	 (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
	 (not (eq (coding-system-base coding-system) 'us-ascii)))
567 568 569 570 571 572 573 574 575 576 577 578 579
	(setq rmail-mime-coding-system coding-system))
    (or (bolp) (insert "\n"))))

(defun rmail-mime-insert-text (entity)
  "Presentation handler for a plain text MIME entity."
  (let ((current (aref (rmail-mime-entity-display entity) 0))
	(new (aref (rmail-mime-entity-display entity) 1))
	(header (rmail-mime-entity-header entity))
	(tagline (rmail-mime-entity-tagline entity))
	(body (rmail-mime-entity-body entity))
	(beg (point))
	(segment (rmail-mime-entity-segment (point) entity)))

580
    (or (integerp (aref body 0)) (markerp (aref body 0))
581 582 583 584 585
	(let ((data (buffer-string)))
	  (aset body 0 data)
	  (delete-region (point-min) (point-max))))

    ;; header
586 587
    (if (eq (rmail-mime-display-header current)
	    (rmail-mime-display-header new))
588
	(goto-char (aref segment 2))
589
      (if (rmail-mime-display-header current)
590
	  (delete-char (- (aref segment 2) (aref segment 1))))
591
      (if (rmail-mime-display-header new)
592 593
	  (rmail-mime-insert-header header)))
    ;; tagline
594 595 596 597 598
    (if (eq (rmail-mime-display-tagline current)
	    (rmail-mime-display-tagline new))
	(if (or (not (rmail-mime-display-tagline current))
		(eq (rmail-mime-display-body current)
		    (rmail-mime-display-body new)))
599 600
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
601
      (if (rmail-mime-display-tagline current)
602
	  (delete-char (- (aref segment 3) (aref segment 2))))
603
      (if (rmail-mime-display-tagline new)
604 605
	  (rmail-mime-insert-tagline entity)))
    ;; body
606 607
    (if (eq (rmail-mime-display-body current)
	    (rmail-mime-display-body new))
608
	(forward-char (- (aref segment 4) (aref segment 3)))
609
      (if (rmail-mime-display-body current)
610
	  (delete-char (- (aref segment 4) (aref segment 3))))
611
      (if (rmail-mime-display-body new)
612 613
	  (rmail-mime-insert-decoded-text entity)))
    (put-text-property beg (point) 'rmail-mime-entity entity)))
Kenichi Handa's avatar
Kenichi Handa committed
614

615 616 617 618 619 620 621 622 623 624
(defun rmail-mime-insert-image (entity)
  "Decode and insert the image body of MIME-entity ENTITY."
  (let* ((content-type (car (rmail-mime-entity-type entity)))
	 (bulk-data (aref (rmail-mime-entity-tagline entity) 1))
	 (body (rmail-mime-entity-body entity))
	 data)
    (if (stringp (aref body 0))
	(setq data (aref body 0))
      (let ((rmail-mime-mbox-buffer rmail-view-buffer)
	    (transfer-encoding (rmail-mime-entity-transfer-encoding entity)))
Kenichi Handa's avatar
Kenichi Handa committed
625 626 627
	(with-temp-buffer
	  (set-buffer-multibyte nil)
	  (setq buffer-undo-list t)
628 629
	  (insert-buffer-substring rmail-mime-mbox-buffer
				   (aref body 0) (aref body 1))
Kenichi Handa's avatar
Kenichi Handa committed
630 631 632 633 634 635
	  (cond ((string= transfer-encoding "base64")
		 (ignore-errors (base64-decode-region (point-min) (point-max))))
		((string= transfer-encoding "quoted-printable")
		 (quoted-printable-decode-region (point-min) (point-max))))
	  (setq data
		(buffer-substring-no-properties (point-min) (point-max))))))
636 637
    (insert-image (create-image data (cdr bulk-data) t))
    (insert "\n")))
Glenn Morris's avatar
Glenn Morris committed
638

639 640
(defun rmail-mime-toggle-button (button)
  "Hide or show the body of the MIME-entity associated with BUTTON."
641
  (save-excursion
642
    (goto-char (button-start button))
643
    (rmail-mime-toggle-hidden)))
Glenn Morris's avatar
Glenn Morris committed
644

645
(define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)
Glenn Morris's avatar
Glenn Morris committed
646 647


648 649
(defun rmail-mime-bulk-handler (content-type
				content-disposition
Glenn Morris's avatar
Glenn Morris committed
650
				content-transfer-encoding)
651
  "Handle the current buffer as an attachment to download.
Glenn Morris's avatar
Glenn Morris committed
652 653
For images that Emacs is capable of displaying, the behavior
depends upon the value of `rmail-mime-show-images'."
Kenichi Handa's avatar
Kenichi Handa committed
654 655
  (rmail-mime-insert-bulk
   (rmail-mime-entity content-type content-disposition content-transfer-encoding
656 657 658 659 660 661 662 663 664 665 666 667
		      (vector (vector nil nil nil) (vector nil t nil))
		      (vector nil nil nil) (vector "" (cons nil nil) t)
		      (vector nil nil nil) nil 'rmail-mime-insert-bulk)))

(defun rmail-mime-set-bulk-data (entity)
  "Setup the information about the attachment object for MIME-entity ENTITY.
The value is non-nil if and only if the attachment object should be shown
directly."
  (let ((content-type (car (rmail-mime-entity-type entity)))
	(size (cdr (assq 'size (cdr (rmail-mime-entity-disposition entity)))))
	(bulk-data (aref (rmail-mime-entity-tagline entity) 1))
	(body (rmail-mime-entity-body entity))
668
	type to-show)
669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
    (cond (size
	   (setq size (string-to-number size)))
	  ((stringp (aref body 0))
	   (setq size (length (aref body 0))))
	  (t
	   ;; Rough estimation of the size.
	   (let ((encoding (rmail-mime-entity-transfer-encoding entity)))
	     (setq size (- (aref body 1) (aref body 0)))
	     (cond ((string= encoding "base64")
		    (setq size (/ (* size 3) 4)))
		   ((string= encoding "quoted-printable")
		    (setq size (/ (* size 7) 3)))))))

    (cond
     ((string-match "text/" content-type)
      (setq type 'text))
     ((string-match "image/\\(.*\\)" content-type)
      (setq type (image-type-from-file-name
		  (concat "." (match-string 1 content-type))))
      (if (and (memq type image-types)
	       (image-type-available-p type))
	  (if (and rmail-mime-show-images
		   (not (eq rmail-mime-show-images 'button))
		   (or (not (numberp rmail-mime-show-images))
		       (< size rmail-mime-show-images)))
	      (setq to-show t))
	(setq type nil))))
    (setcar bulk-data size)
    (setcdr bulk-data type)
    to-show))
Kenichi Handa's avatar
Kenichi Handa committed
699 700

(defun rmail-mime-insert-bulk (entity)
701
  "Presentation handler for an attachment MIME entity."
Kenichi Handa's avatar
Kenichi Handa committed
702 703
  (let* ((content-type (rmail-mime-entity-type entity))
	 (content-disposition (rmail-mime-entity-disposition entity))
704 705 706 707 708
	 (current (aref (rmail-mime-entity-display entity) 0))
	 (new (aref (rmail-mime-entity-display entity) 1))
	 (header (rmail-mime-entity-header entity))
	 (tagline (rmail-mime-entity-tagline entity))
	 (bulk-data (aref tagline 1))
Kenichi Handa's avatar
Kenichi Handa committed
709
	 (body (rmail-mime-entity-body entity))
710
	 ;; Find the default directory for this media type.
Kenichi Handa's avatar
Kenichi Handa committed
711
	 (directory (catch 'directory
712 713 714 715 716 717 718 719
		      (dolist (entry rmail-mime-attachment-dirs-alist)
			(when (string-match (car entry) (car content-type))
			  (dolist (dir (cdr entry))
			    (when (file-directory-p dir)
			      (throw 'directory dir)))))))
	 (filename (or (cdr (assq 'name (cdr content-type)))
		       (cdr (assq 'filename (cdr content-disposition)))
		       "noname"))
720
	 (units '(B kB MB GB))
721 722 723
	 (segment (rmail-mime-entity-segment (point) entity))
	 beg data size)

724
    (if (or (integerp (aref body 0)) (markerp (aref body 0)))
Kenichi Handa's avatar
Kenichi Handa committed
725
	(setq data entity
726 727 728 729 730 731 732 733
	      size (car bulk-data))
      (if (stringp (aref body 0))
	  (setq data (aref body 0))
	(setq data (string-as-unibyte (buffer-string)))
	(aset body 0 data)
	(rmail-mime-set-bulk-data entity)
	(delete-region (point-min) (point-max)))
      (setq size (length data)))
Kenichi Handa's avatar
Kenichi Handa committed
734
    (while (and (> size 1024.0) ; cribbed from gnus-agent-expire-done-message
735 736 737
		(cdr units))
      (setq size (/ size 1024.0)
	    units (cdr units)))
738 739 740 741

    (setq beg (point))

    ;; header
742 743
    (if (eq (rmail-mime-display-header current)
	    (rmail-mime-display-header new))
744
	(goto-char (aref segment 2))
745
      (if (rmail-mime-display-header current)
746
	  (delete-char (- (aref segment 2) (aref segment 1))))
747
      (if (rmail-mime-display-header new)
748 749 750
	  (rmail-mime-insert-header header)))

    ;; tagline
751 752 753 754 755
    (if (eq (rmail-mime-display-tagline current)
	    (rmail-mime-display-tagline new))
	(if (or (not (rmail-mime-display-tagline current))
		(eq (rmail-mime-display-body current)
		    (rmail-mime-display-body new)))
756 757
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
758
      (if (rmail-mime-display-tagline current)
759
	  (delete-char (- (aref segment 3) (aref segment 2))))
760
      (if (rmail-mime-display-tagline new)
761 762
	  (rmail-mime-insert-tagline
	   entity
763
	   " Save:"
764 765 766 767 768 769 770
	   (list filename
		 :type 'rmail-mime-save
		 'help-echo "mouse-2, RET: Save attachment"
		 'filename filename
		 'directory (file-name-as-directory directory)
		 'data data)
	   (format " (%.0f%s)" size (car units))
771 772 773 774 775 776 777 778 779 780 781
	   ;; We don't need this button because the "type" string of a
	   ;; tagline is the button to do this.
	   ;; (if (cdr bulk-data)
	   ;;     " ")
	   ;; (if (cdr bulk-data)
	   ;;     (list "Toggle show/hide"
	   ;; 	     :type 'rmail-mime-image
	   ;; 	     'help-echo "mouse-2, RET: Toggle show/hide"
	   ;; 	     'image-type (cdr bulk-data)
	   ;; 	     'image-data data))
	   )))
782
    ;; body
783 784
    (if (eq (rmail-mime-display-body current)
	    (rmail-mime-display-body new))
785
	(forward-char (- (aref segment 4) (aref segment 3)))
786
      (if (rmail-mime-display-body current)
787
	  (delete-char (- (aref segment 4) (aref segment 3))))
788
      (if (rmail-mime-display-body new)
789 790 791
	  (cond ((eq (cdr bulk-data) 'text)
		 (rmail-mime-insert-decoded-text entity))
		((cdr bulk-data)
Glenn Morris's avatar
Glenn Morris committed
792 793 794 795 796
		 (rmail-mime-insert-image entity))
		(t
		 ;; As we don't know how to display the body, just
		 ;; insert it as a text.
		 (rmail-mime-insert-decoded-text entity)))))
797
    (put-text-property beg (point) 'rmail-mime-entity entity)))
798 799 800 801 802 803 804 805 806

(defun rmail-mime-multipart-handler (content-type
				     content-disposition
				     content-transfer-encoding)
  "Handle the current buffer as a multipart MIME body.
The current buffer should be narrowed to the body.  CONTENT-TYPE,
CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING are the values
of the respective parsed headers.  See `rmail-mime-handle' for their
format."
Kenichi Handa's avatar
Kenichi Handa committed
807
  (rmail-mime-process-multipart
808 809
   content-type content-disposition content-transfer-encoding nil)
  t)
Kenichi Handa's avatar
Kenichi Handa committed
810 811 812 813

(defun rmail-mime-process-multipart (content-type
				     content-disposition
				     content-transfer-encoding
814
				     parse-tag)
Kenichi Handa's avatar
Kenichi Handa committed
815 816
  "Process the current buffer as a multipart MIME body.

817 818
If PARSE-TAG is nil, modify the current buffer directly for
showing the MIME body and return nil.
Kenichi Handa's avatar
Kenichi Handa committed
819

820 821 822
Otherwise, PARSE-TAG is a string indicating the depth and index
number of the entity.  In this case, parse the current buffer and
return a list of MIME-entity objects.
Kenichi Handa's avatar
Kenichi Handa committed
823 824

The other arguments are the same as `rmail-mime-multipart-handler'."
825 826 827 828 829 830 831 832
  ;; Some MUAs start boundaries with "--", while it should start
  ;; with "CRLF--", as defined by RFC 2046:
  ;;    The boundary delimiter MUST occur at the beginning of a line,
  ;;    i.e., following a CRLF, and the initial CRLF is considered to
  ;;    be attached to the boundary delimiter line rather than part
  ;;    of the preceding part.
  ;; We currently don't handle that.
  (let ((boundary (cdr (assq 'boundary content-type)))
833 834
	(subtype (cadr (split-string (car content-type) "/")))
	(index 0)
835
	beg end next entities truncated)
836 837 838 839 840 841 842 843 844
    (unless boundary
      (rmail-mm-get-boundary-error-message
       "No boundary defined" content-type content-disposition
       content-transfer-encoding))
    (setq boundary (concat "\n--" boundary))
    ;; Hide the body before the first bodypart
    (goto-char (point-min))
    (when (and (search-forward boundary nil t)
	       (looking-at "[ \t]*\n"))
845
      (if parse-tag
Kenichi Handa's avatar
Kenichi Handa committed
846 847
	  (narrow-to-region (match-end 0) (point-max))
	(delete-region (point-min) (match-end 0))))
848 849 850 851 852

    ;; Change content-type to the proper default one for the children.
    (cond ((string-match "mixed" subtype)
	   (setq content-type '("text/plain")))
	  ((string-match "digest" subtype)
Glenn Morris's avatar
Glenn Morris committed
853 854 855
	   (setq content-type '("message/rfc822")))
	  (t
	   (setq content-type nil)))
856

857 858
    ;; Loop over all body parts, where beg points at the beginning of
    ;; the part and end points at the end of the part.  next points at
859 860
    ;; the beginning of the next part.  The current point is just
    ;; after the boundary tag.
861
    (setq beg (point-min))
862 863

    (while (or (and (search-forward boundary nil t)
864
		    (setq truncated nil end (match-beginning 0)))
865 866 867 868 869 870 871 872
	       ;; If the boundary does not appear at all,
	       ;; the message was truncated.
	       ;; Handle the rest of the truncated message
	       ;; (if it isn't empty) by pretending that the boundary
	       ;; appears at the end of the message.
	       (and (save-excursion
		      (skip-chars-forward "\n")
		      (> (point-max) (point)))
873
		    (setq truncated t end (point-max))))
874 875 876
      ;; If this is the last boundary according to RFC 2046, hide the
      ;; epilogue, else hide the boundary only.  Use a marker for
      ;; `next' because `rmail-mime-show' may change the buffer.
877
      (cond ((looking-at "--[ \t]*$")
878 879
	     (setq next (point-max-marker)))
	    ((looking-at "[ \t]*\n")
880
	     (setq next (copy-marker (match-end 0) t)))
881
	    (truncated
882 883
	     ;; We're handling what's left of a truncated message.
	     (setq next (point-max-marker)))
884
	    (t
Paul Eggert's avatar
Paul Eggert committed
885
	     ;; The original code signaled an error as below, but
886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904
	     ;; this line may be a boundary of nested multipart.  So,
	     ;; we just set `next' to nil to skip this line
	     ;; (rmail-mm-get-boundary-error-message
	     ;;  "Malformed boundary" content-type content-disposition
	     ;;  content-transfer-encoding)
	     (setq next nil)))

      (when next
	(setq index (1+ index))
	;; Handle the part.
	(if parse-tag
	    (save-restriction
	      (narrow-to-region beg end)
	      (let ((child (rmail-mime-process
			    nil (format "%s/%d" parse-tag index)
			    content-type content-disposition)))
		;; Display a tagline.
		(aset (aref (rmail-mime-entity-display child) 1) 1
		      (aset (rmail-mime-entity-tagline child) 2 t))
905
		(rmail-mime-entity-set-truncated child truncated)
906 907 908
		(push child entities)))

	  (delete-region end next)
Kenichi Handa's avatar
Kenichi Handa committed
909 910
	  (save-restriction
	    (narrow-to-region beg end)
911 912
	    (rmail-mime-show)))
	(goto-char (setq beg next))))
913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930

    (when parse-tag
      (setq entities (nreverse entities))
      (if (string-match "alternative" subtype)
	  ;; Find the best entity to show, and hide all the others.
	  (let (best second)
	    (dolist (child entities)
	      (if (string= (or (car (rmail-mime-entity-disposition child))
			       (car content-disposition))
			   "inline")
		  (if (string-match "text/plain"
				    (car (rmail-mime-entity-type child)))
		      (setq best child)
		    (if (string-match "text/.*"
				      (car (rmail-mime-entity-type child)))
			(setq second child)))))
	    (or best (not second) (setq best second))
	    (dolist (child entities)
931 932 933
	      (unless (eq best child)
		(aset (rmail-mime-entity-body child) 2 nil)
		(rmail-mime-hidden-mode child)))))
934
      entities)))
935

936 937 938 939 940 941 942 943 944 945
(defun rmail-mime-insert-multipart (entity)
  "Presentation handler for a multipart MIME entity."
  (let ((current (aref (rmail-mime-entity-display entity) 0))
	(new (aref (rmail-mime-entity-display entity) 1))
	(header (rmail-mime-entity-header entity))
	(tagline (rmail-mime-entity-tagline entity))
	(body (rmail-mime-entity-body entity))
	(beg (point))
	(segment (rmail-mime-entity-segment (point) entity)))
    ;; header
946 947
    (if (eq (rmail-mime-display-header current)
	    (rmail-mime-display-header new))
948
	(goto-char (aref segment 2))
949
      (if (rmail-mime-display-header current)
950
	  (delete-char (- (aref segment 2) (aref segment 1))))
951
      (if (rmail-mime-display-header new)
952 953
	  (rmail-mime-insert-header header)))
    ;; tagline
954 955 956 957 958
    (if (eq (rmail-mime-display-tagline current)
	    (rmail-mime-display-tagline new))
	(if (or (not (rmail-mime-display-tagline current))
		(eq (rmail-mime-display-body current)
		    (rmail-mime-display-body new)))
959 960
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
961
      (if (rmail-mime-display-tagline current)
962
	  (delete-char (- (aref segment 3) (aref segment 2))))
963
      (if (rmail-mime-display-tagline new)
964 965 966
	  (rmail-mime-insert-tagline entity)))

    (put-text-property beg (point) 'rmail-mime-entity entity)
967

968
    ;; body
969 970
    (if (eq (rmail-mime-display-body current)
	    (rmail-mime-display-body new))
971
	(forward-char (- (aref segment 4) (aref segment 3)))
972 973 974
      (dolist (child (rmail-mime-entity-children entity))
	(rmail-mime-insert child)))
    entity))
975

976 977 978 979 980 981 982 983 984 985
;;; Main code

(defun rmail-mime-handle (content-type
			  content-disposition
			  content-transfer-encoding)
  "Handle the current buffer as a MIME part.
The current buffer should be narrowed to the respective body, and
point should be at the beginning of the body.

CONTENT-TYPE, CONTENT-DISPOSITION, and CONTENT-TRANSFER-ENCODING
Glenn Morris's avatar
Glenn Morris committed
986
are the values of the respective parsed headers.  The latter should
Glenn Morris's avatar
Glenn Morris committed
987
be lower-case.  The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
Glenn Morris's avatar
Glenn Morris committed
988
have the form
989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017

  \(VALUE . ALIST)

In other words:

  \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)

VALUE is a string and ATTRIBUTE is a symbol.

Consider the following header, for example:

Content-Type: multipart/mixed;
	boundary=\"----=_NextPart_000_0104_01C617E4.BDEC4C40\"

The parsed header value:

\(\"multipart/mixed\"
  \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
  ;; Handle the content transfer encodings we know.  Unknown transfer
  ;; encodings will be passed on to the various handlers.
  (cond ((string= content-transfer-encoding "base64")
	 (when (ignore-errors
		 (base64-decode-region (point) (point-max)))
	   (setq content-transfer-encoding nil)))
	((string= content-transfer-encoding "quoted-printable")
	 (quoted-printable-decode-region (point) (point-max))
	 (setq content-transfer-encoding nil))
	((string= content-transfer-encoding "8bit")
	 ;; FIXME: Is this the correct way?
1018 1019 1020 1021
         ;; No, of course not, it just means there's no decoding to do.
	 ;; (set-buffer-multibyte nil)
         (setq content-transfer-encoding nil)
         ))
1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034
  ;; Inline stuff requires work.  Attachments are handled by the bulk
  ;; handler.
  (if (string= "inline" (car content-disposition))
      (let ((stop nil))
	(dolist (entry rmail-mime-media-type-handlers-alist)
	  (when (and (string-match (car entry) (car content-type)) (not stop))
	    (progn
	      (setq stop (funcall (cadr entry) content-type
				  content-disposition
				  content-transfer-encoding))))))
    ;; Everything else is an attachment.
    (rmail-mime-bulk-handler content-type
		       content-disposition
1035 1036 1037 1038 1039 1040 1041 1042 1043 1044
		       content-transfer-encoding))
  (save-restriction
    (widen)
    (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))
	  current new)
      (when entity
	(setq current (aref (rmail-mime-entity-display entity) 0)
	      new (aref (rmail-mime-entity-display entity) 1))
	(dotimes (i 3)
	  (aset current i (aref new i)))))))
1045 1046 1047 1048 1049 1050 1051 1052 1053 1054

(defun rmail-mime-show (&optional show-headers)
  "Handle the current buffer as a MIME message.
If SHOW-HEADERS is non-nil, then the headers of the current part
will shown as usual for a MIME message.  The headers are also
shown for the content type message/rfc822.  This function will be
called recursively if multiple parts are available.

The current buffer must contain a single message.  It will be
modified."
Kenichi Handa's avatar
Kenichi Handa committed
1055 1056
  (rmail-mime-process show-headers nil))

1057 1058 1059
(defun rmail-mime-process (show-headers parse-tag &optional
					default-content-type
					default-content-disposition)
1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082
  (let ((end (point-min))
	content-type
	content-transfer-encoding
	content-disposition)
    ;; `point-min' returns the beginning and `end' points at the end
    ;; of the headers.
    (goto-char (point-min))
    ;; If we're showing a part without headers, then it will start
    ;; with a newline.
    (if (eq (char-after) ?\n)
	(setq end (1+ (point)))
      (when (search-forward "\n\n" nil t)
	(setq end (match-end 0))
	(save-restriction
	  (narrow-to-region (point-min) end)
	  ;; FIXME: Default disposition of the multipart entities should
	  ;; be inherited.
	  (setq content-type
		(mail-fetch-field "Content-Type")
		content-transfer-encoding
		(mail-fetch-field "Content-Transfer-Encoding")
		content-disposition
		(mail-fetch-field "Content-Disposition")))))
Glenn Morris's avatar
Glenn Morris committed
1083 1084 1085 1086 1087 1088
    ;; Per RFC 2045, C-T-E is case insensitive (bug#5070), but the others
    ;; are not completely so.  Hopefully mail-header-parse-* DTRT.
    (if content-transfer-encoding
	(setq content-transfer-encoding (downcase content-transfer-encoding)))
    (setq content-type
	  (if content-type
1089 1090
	      (or (mail-header-parse-content-type content-type)
		  '("text/plain"))
1091
	    (or default-content-type '("text/plain"))))
1092 1093 1094 1095 1096
    (setq content-disposition
	  (if content-disposition
	      (mail-header-parse-content-disposition content-disposition)
	    ;; If none specified, we are free to choose what we deem
	    ;; suitable according to RFC 2183.  We like inline.
1097
	    (or default-content-disposition '("inline"))))
1098 1099 1100 1101
    ;; Unrecognized disposition types are to be treated like
    ;; attachment according to RFC 2183.
    (unless (member (car content-disposition) '("inline" "attachment"))
      (setq content-disposition '("attachment")))
Kenichi Handa's avatar
Kenichi Handa committed
1102

1103 1104
    (if parse-tag
	(let* ((is-inline (string= (car content-disposition) "inline"))
1105 1106
	       (hdr-end (copy-marker end))
	       (header (vector (point-min-marker) hdr-end nil))
1107
	       (tagline (vector parse-tag (cons nil nil) t))
1108
	       (body (vector hdr-end (point-max-marker) is-inline))
1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121
	       (new (vector (aref header 2) (aref tagline 2) (aref body 2)))
	       children handler entity)
	  (cond ((string-match "multipart/.*" (car content-type))
		 (save-restriction
		   (narrow-to-region (1- end) (point-max))
		   (setq children (rmail-mime-process-multipart
				   content-type
				   content-disposition
				   content-transfer-encoding
				   parse-tag)
			 handler 'rmail-mime-insert-multipart)))
		((string-match "message/rfc822" (car content-type))
		 (save-restriction
Kenichi Handa's avatar
Kenichi Handa committed
1122
		   (narrow-to-region end (point-max))
1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153
		   (let* ((msg (rmail-mime-process t parse-tag
						   '("text/plain") '("inline")))
			  (msg-new (aref (rmail-mime-entity-display msg) 1)))
		     ;; Show header of the child.
		     (aset msg-new 0 t)
		     (aset (rmail-mime-entity-header msg) 2 t)
		     ;; Hide tagline of the child.
		     (aset msg-new 1 nil)
		     (aset (rmail-mime-entity-tagline msg) 2 nil)
		     (setq children (list msg)
			   handler 'rmail-mime-insert-multipart))))
		((and is-inline (string-match "text/" (car content-type)))
		 ;; Don't need a tagline.