comparison lisp/mail/rmailmm.el @ 112257:103d72f0a1d5

Another improvement of MIME handling in rmail.

112240:6fd3dcdcc675

(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.
The value is a vector [ INDEX HEADER TAGLINE BODY END], where
  HEADER: the position of the beginning of a header
  TAGLINE: the position of the beginning of a tagline
  BODY: the position of the beginning of a body
  END: the position of the end of the entity.
  INDEX: index into the returned vector indicating where POS is."
  (save-excursion
    (or entity
	(setq entity (get-text-property pos 'rmail-mime-entity)))
    (if (not entity)
	(vector 1 (point) (point) (point) (point))

		(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-next-item ()
  "Move point to the next displayed item of the current MIME entity.
A MIME entity has three items; header, tagline, and body. 
If we are in the last item of the entity, move point to the first
item of the next entity.  If we reach the end of buffer, move
point to the first item of the first entity (i.e. the beginning
of buffer)."
  (interactive)
  (if (rmail-mime-message-p)
      (let* ((segment (rmail-mime-entity-segment (point)))
	     (next-pos (aref segment (1+ (aref segment 0))))
	     (button (next-button (point))))
	(goto-char (if (and button (< (button-start button) next-pos))
		       (button-start button)
		     next-pos))
	(if (eobp)
	    (goto-char (point-min))))))

(defun rmail-mime-previous-item ()
  "Move point to the previous displayed item of the current MIME message.
A MIME entity has three items; header, tagline, and body.
If we are at the beginning of the first item of the entity, move
point to the last item of the previous entity.  If we reach the
beginning of buffer, move point to the last item of the last
entity."
  (interactive)
  (when (rmail-mime-message-p)
    (if (bobp)
	(goto-char (point-max)))
    (let* ((segment (rmail-mime-entity-segment (1- (point))))
	   (prev-pos (aref segment (aref segment 0)))
	   (button (previous-button (point))))
      (goto-char (if (and button (> (button-start button) prev-pos))
		     (button-start button)
		   prev-pos)))))

(defun rmail-mime-shown-mode (entity)
  "Make MIME-entity ENTITY displayed by the default way."
  (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))
    (aset new 2 (aref (rmail-mime-entity-body entity) 2))))
  
(defun rmail-mime-hidden-mode (entity top)
  "Make MIME-entity ENTITY displayed in the hidden mode.
If TOP is non-nil, display ENTITY only by the tagline.
Otherwise, don't display ENTITY."
  (if top
      (let ((new (aref (rmail-mime-entity-display entity) 1)))
	(aset new 0 nil)
	(aset new 1 top)
	(aset new 2 nil)
	(aset (rmail-mime-entity-body entity) 2 nil))
    (let ((current (aref (rmail-mime-entity-display entity) 0)))
      (aset current 0 nil)
      (aset current 1 nil)
      (aset current 2 nil)))
  (dolist (child (rmail-mime-entity-children entity))
    (rmail-mime-hidden-mode child nil)))

(defun rmail-mime-raw-mode (entity)
  "Make MIME-entity ENTITY displayed in the raw mode."
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 'raw)
    (aset new 1 nil)
    (aset new 2 'raw)
    (dolist (child (rmail-mime-entity-children entity))
      (rmail-mime-hidden-mode child nil))))

(defun rmail-mime-toggle-raw (entity)
  "Toggle on and off the raw display mode of MIME-entity ENTITY."
  (let* ((pos (if (eobp) (1- (point-max)) (point)))
	 (entity (get-text-property pos 'rmail-mime-entity))

	(goto-char (aref segment 1))
	(rmail-mime-insert entity)
	(restore-buffer-modified-p modified)))))

(defun rmail-mime-toggle-hidden ()
  "Toggle on and off the hidden display mode of MIME-entity ENTITY."
  (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)))

	   (segment (rmail-mime-entity-segment pos entity)))
      (if (aref current 2)
	  ;; Enter the hidden mode.
	  (progn
	    ;; If point is in the body part, move it to the tagline
	    ;; (or the header if headline is not displayed).
	    (if (= (aref segment 0) 3)
		(goto-char (aref segment 2)))
	    (rmail-mime-hidden-mode entity t)
	    ;; 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))))
	;; Enter the shown mode.
	(aset (rmail-mime-entity-body entity) 2 t)
	(rmail-mime-shown-mode entity))
      (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))))))

(define-key rmail-mode-map "\t" 'rmail-mime-next-item)
(define-key rmail-mode-map [backtab] 'rmail-mime-previous-item)
(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden)

;;; Handlers

(defun rmail-mime-insert-tagline (entity &rest item-list)

ITEM-LIST is a list of strings or button-elements (list) to be added
to the tag line."
  (insert "[")
  (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
    (if (> (length tag) 0) (insert (substring tag 1) ":")))
  (insert (car (rmail-mime-entity-type entity)))
  (dolist (item item-list)
    (when item
      (if (stringp item)
	  (insert item)
	(apply 'insert-button item))))
  (insert "]\n"))
  
(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].
See `rmail-mime-entity' for the detail."
  (let ((pos (point))

	  (delete-char (- (aref segment 2) (aref segment 1))))
      (if (aref new 0)
	  (rmail-mime-insert-header header)))
    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(forward-char (- (aref segment 3) (aref segment 2)))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline entity)))
    ;; body

	  (setq data
		(buffer-substring-no-properties (point-min) (point-max))))))
    (insert-image (create-image data (cdr bulk-data) t))
    (insert "\n")))

(defun rmail-mime-image (button)
  "Display the image associated with BUTTON."
  (save-excursion
    (goto-char (button-end button))
    (rmail-mime-toggle-hidden)))

(define-button-type 'rmail-mime-image 'action 'rmail-mime-image)


(defun rmail-mime-bulk-handler (content-type
				content-disposition
				content-transfer-encoding)

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))
	size type to-show)
    (cond (size
	   (setq size (string-to-number size)))
	  ((stringp (aref body 0))
	   (setq size (length (aref body 0))))
	  (t

    (setcdr bulk-data type)
    to-show))

(defun rmail-mime-insert-bulk (entity)
  "Presentation handler for an attachment MIME entity."
  ;; Find the default directory for this media type.
  (let* ((content-type (rmail-mime-entity-type entity))
	 (content-disposition (rmail-mime-entity-disposition entity))
	 (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))
	 (body (rmail-mime-entity-body entity))
	 (directory (catch 'directory
		      (dolist (entry rmail-mime-attachment-dirs-alist)
			(when (string-match (car entry) (car content-type))
			  (dolist (dir (cdr entry))
			    (when (file-directory-p dir)

      (if (aref new 0)
	  (rmail-mime-insert-header header)))

    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(forward-char (- (aref segment 3) (aref segment 2)))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline
	   entity
	   " file:"
	   (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))
	   (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)))))
    ;; body
    (if (eq (aref current 2) (aref new 2))
	(forward-char (- (aref segment 4) (aref segment 3)))
      (if (aref current 2)
	  (delete-char (- (aref segment 4) (aref segment 3))))

		    (if (string-match "text/.*"
				      (car (rmail-mime-entity-type child)))
			(setq second child)))))
	    (or best (not second) (setq best second))
	    (dolist (child entities)
	      (or (eq best child)
		  (rmail-mime-hidden-mode child t)))))
      entities)))

(defun test-rmail-mime-multipart-handler ()
  "Test of a mail used as an example in RFC 2046."
  (let ((mail "From: Nathaniel Borenstein <[e-mail]>

	  (delete-char (- (aref segment 2) (aref segment 1))))
      (if (aref new 0)
	  (rmail-mime-insert-header header)))
    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(forward-char (- (aref segment 3) (aref segment 2)))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline entity)))

    (put-text-property beg (point) 'rmail-mime-entity entity)
    ;; body
    (if (eq (aref current 2) (aref new 2))
	(forward-char (- (aref segment 4) (aref segment 3)))
      (if (aref current 2)
	  (delete-char (- (aref segment 4) (aref segment 3))))
      (if (aref new 2)
	  (dolist (child (rmail-mime-entity-children entity))
	    (rmail-mime-insert child))))))

;;; Main code

(defun rmail-mime-handle (content-type
			  content-disposition

				  content-disposition
				  content-transfer-encoding))))))
    ;; Everything else is an attachment.
    (rmail-mime-bulk-handler content-type
		       content-disposition
		       content-transfer-encoding)))

(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

    ;; 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
	      (mail-header-parse-content-type content-type)
	    (or default-content-type '("text/plain"))))
    (setq content-disposition
	  (if content-disposition
	      (mail-header-parse-content-disposition content-disposition)
	    ;; If none specified, we are free to choose what we deem

				     (aref header 0) (aref header 1)))
	;; tagline
	(if (aref current 1)
	    (delete-char (- (aref segment 3) (aref segment 2))))
	;; body
	(if (eq (aref current 2) (aref new 2))
	    (forward-char (- (aref segment 4) (aref segment 3)))
	  (if (aref current 2)
	      (delete-char (- (aref segment 4) (aref segment 3))))
	  (insert-buffer-substring rmail-mime-mbox-buffer
				   (aref body 0) (aref body 1)))
	(put-text-property beg (point) 'rmail-mime-entity entity)))
    (dotimes (i 3)
      (aset current i (aref new i)))))

(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
  "Major mode used in `rmail-mime' buffers."

`rmail-mime-media-type-handlers-alist'.  By default, this
displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'."
  (interactive "P")
  (if rmail-enable-mime
      (if (rmail-mime-message-p)
	  (let ((rmail-mime-mbox-buffer rmail-view-buffer)
		(rmail-mime-view-buffer rmail-buffer)
		(entity (get-text-property (point) 'rmail-mime-entity)))
	    (if arg
		(if entity
		    (rmail-mime-toggle-raw entity))
	      (goto-char (point-min))
	      (rmail-mime-toggle-raw
	       (get-text-property (point) 'rmail-mime-entity))))
	(message "Not a MIME message"))
    (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
	   (buf (get-buffer-create "*RMAIL*"))
	   (rmail-mime-mbox-buffer rmail-view-buffer)
	   (rmail-mime-view-buffer buf))
      (set-buffer buf)

112257:103d72f0a1d5

(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.
The value is a vector [ INDEX HEADER TAGLINE BODY END], where
  INDEX: index into the returned vector indicating where POS is (1..3).
  HEADER: the position of the beginning of a header
  TAGLINE: the position of the beginning of a tagline
  BODY: the position of the beginning of a body
  END: the position of the end of the entity."
  (save-excursion
    (or entity
	(setq entity (get-text-property pos 'rmail-mime-entity)))
    (if (not entity)
	(vector 1 (point) (point) (point) (point))

		(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)
  "Make MIME-entity ENTITY displayed by the default way."
  (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))
    (aset new 2 (aref (rmail-mime-entity-body entity) 2)))
  (dolist (child (rmail-mime-entity-children entity))
    (rmail-mime-shown-mode child)))
  
(defun rmail-mime-hidden-mode (entity)
  "Make MIME-entity ENTITY displayed in the hidden mode."
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 nil)
    (aset new 1 t)
    (aset new 2 nil))
  (dolist (child (rmail-mime-entity-children entity))
    (rmail-mime-hidden-mode child)))

(defun rmail-mime-raw-mode (entity)
  "Make MIME-entity ENTITY displayed in the raw mode."
  (let ((new (aref (rmail-mime-entity-display entity) 1)))
    (aset new 0 'raw)
    (aset new 1 nil)
    (aset new 2 'raw))
  (dolist (child (rmail-mime-entity-children entity))
    (rmail-mime-raw-mode child)))

(defun rmail-mime-toggle-raw (entity)
  "Toggle on and off the raw display mode of MIME-entity ENTITY."
  (let* ((pos (if (eobp) (1- (point-max)) (point)))
	 (entity (get-text-property pos 'rmail-mime-entity))

	(goto-char (aref segment 1))
	(rmail-mime-insert entity)
	(restore-buffer-modified-p modified)))))

(defun rmail-mime-toggle-hidden ()
  "Hide or show the body of MIME-entity at point."
  (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)))

	   (segment (rmail-mime-entity-segment pos entity)))
      (if (aref current 2)
	  ;; Enter the hidden mode.
	  (progn
	    ;; If point is in the body part, move it to the tagline
	    ;; (or the header if tagline is not displayed).
	    (if (= (aref segment 0) 3)
		(goto-char (aref segment 2)))
	    (rmail-mime-hidden-mode entity)
	    ;; 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))))
	;; Enter the shown mode.
	(rmail-mime-shown-mode entity)
	;; Force this body shown.
	(aset (aref (rmail-mime-entity-display entity) 1) 2 t))
      (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))))))

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

;;; Handlers

(defun rmail-mime-insert-tagline (entity &rest item-list)

ITEM-LIST is a list of strings or button-elements (list) to be added
to the tag line."
  (insert "[")
  (let ((tag (aref (rmail-mime-entity-tagline entity) 0)))
    (if (> (length tag) 0) (insert (substring tag 1) ":")))
  (insert (car (rmail-mime-entity-type entity)) " ")
  (insert-button (let ((new (aref (rmail-mime-entity-display entity) 1)))
		   (if (aref new 2) "Hide" "Show"))
		 :type 'rmail-mime-toggle
		 'help-echo "mouse-2, RET: Toggle show/hide")
  (dolist (item item-list)
    (when item
      (if (stringp item)
	  (insert item)
	(apply 'insert-button item))))
  (insert "]\n"))
  
(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)
    (forward-line 1)))

(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].
See `rmail-mime-entity' for the detail."
  (let ((pos (point))

	  (delete-char (- (aref segment 2) (aref segment 1))))
      (if (aref new 0)
	  (rmail-mime-insert-header header)))
    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(if (or (not (aref current 1))
		(eq (aref current 2) (aref new 2)))
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline entity)))
    ;; body

	  (setq data
		(buffer-substring-no-properties (point-min) (point-max))))))
    (insert-image (create-image data (cdr bulk-data) t))
    (insert "\n")))

(defun rmail-mime-toggle-button (button)
  "Hide or show the body of the MIME-entity associated with BUTTON."
  (save-excursion
    (goto-char (button-start button))
    (rmail-mime-toggle-hidden)))

(define-button-type 'rmail-mime-toggle 'action 'rmail-mime-toggle-button)


(defun rmail-mime-bulk-handler (content-type
				content-disposition
				content-transfer-encoding)

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))
	type to-show)
    (cond (size
	   (setq size (string-to-number size)))
	  ((stringp (aref body 0))
	   (setq size (length (aref body 0))))
	  (t

    (setcdr bulk-data type)
    to-show))

(defun rmail-mime-insert-bulk (entity)
  "Presentation handler for an attachment MIME entity."
  (let* ((content-type (rmail-mime-entity-type entity))
	 (content-disposition (rmail-mime-entity-disposition entity))
	 (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))
	 (body (rmail-mime-entity-body entity))
	 ;; Find the default directory for this media type.
	 (directory (catch 'directory
		      (dolist (entry rmail-mime-attachment-dirs-alist)
			(when (string-match (car entry) (car content-type))
			  (dolist (dir (cdr entry))
			    (when (file-directory-p dir)

      (if (aref new 0)
	  (rmail-mime-insert-header header)))

    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(if (or (not (aref current 1))
		(eq (aref current 2) (aref new 2)))
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline
	   entity
	   " Save:"
	   (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))
	   ;; 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))
	   )))
    ;; body
    (if (eq (aref current 2) (aref new 2))
	(forward-char (- (aref segment 4) (aref segment 3)))
      (if (aref current 2)
	  (delete-char (- (aref segment 4) (aref segment 3))))

		    (if (string-match "text/.*"
				      (car (rmail-mime-entity-type child)))
			(setq second child)))))
	    (or best (not second) (setq best second))
	    (dolist (child entities)
	      (unless (eq best child)
		(aset (rmail-mime-entity-body child) 2 nil)
		(rmail-mime-hidden-mode child)))))
      entities)))

(defun test-rmail-mime-multipart-handler ()
  "Test of a mail used as an example in RFC 2046."
  (let ((mail "From: Nathaniel Borenstein <[e-mail]>

	  (delete-char (- (aref segment 2) (aref segment 1))))
      (if (aref new 0)
	  (rmail-mime-insert-header header)))
    ;; tagline
    (if (eq (aref current 1) (aref new 1))
	(if (or (not (aref current 1))
		(eq (aref current 2) (aref new 2)))
	    (forward-char (- (aref segment 3) (aref segment 2)))
	  (rmail-mime-update-tagline entity))
      (if (aref current 1)
	  (delete-char (- (aref segment 3) (aref segment 2))))
      (if (aref new 1)
	  (rmail-mime-insert-tagline entity)))

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

    ;; body
    (if (eq (aref current 2) (aref new 2))
	(forward-char (- (aref segment 4) (aref segment 3)))
      (dolist (child (rmail-mime-entity-children entity))
	(rmail-mime-insert child)))
    entity))

;;; Main code

(defun rmail-mime-handle (content-type
			  content-disposition

				  content-disposition
				  content-transfer-encoding))))))
    ;; Everything else is an attachment.
    (rmail-mime-bulk-handler content-type
		       content-disposition
		       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)))))))

(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

    ;; 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
	      (or (mail-header-parse-content-type content-type)
		  '("text/plain"))
	    (or default-content-type '("text/plain"))))
    (setq content-disposition
	  (if content-disposition
	      (mail-header-parse-content-disposition content-disposition)
	    ;; If none specified, we are free to choose what we deem

				     (aref header 0) (aref header 1)))
	;; tagline
	(if (aref current 1)
	    (delete-char (- (aref segment 3) (aref segment 2))))
	;; body
	(let ((children (rmail-mime-entity-children entity)))
	  (if children
	      (progn
		(put-text-property beg (point) 'rmail-mime-entity entity)
		(dolist (child children)
		  (rmail-mime-insert child)))
	    (if (eq (aref current 2) (aref new 2))
		(forward-char (- (aref segment 4) (aref segment 3)))
	      (if (aref current 2)
		(delete-char (- (aref segment 4) (aref segment 3))))
	      (insert-buffer-substring rmail-mime-mbox-buffer
				       (aref body 0) (aref body 1))
	      (or (bolp) (insert "\n")))
	    (put-text-property beg (point) 'rmail-mime-entity entity)))))
    (dotimes (i 3)
      (aset current i (aref new i)))))

(define-derived-mode rmail-mime-mode fundamental-mode "RMIME"
  "Major mode used in `rmail-mime' buffers."

`rmail-mime-media-type-handlers-alist'.  By default, this
displays text and multipart messages, and offers to download
attachments as specfied by `rmail-mime-attachment-dirs-alist'."
  (interactive "P")
  (if rmail-enable-mime
      (with-current-buffer rmail-buffer
	(if (rmail-mime-message-p)
	    (let ((rmail-mime-mbox-buffer rmail-view-buffer)
		  (rmail-mime-view-buffer rmail-buffer)
		  (entity (get-text-property (point) 'rmail-mime-entity)))
	      (if arg
		  (if entity
		      (rmail-mime-toggle-raw entity))
		(goto-char (point-min))
		(rmail-mime-toggle-raw
		 (get-text-property (point) 'rmail-mime-entity))))
	  (message "Not a MIME message")))
    (let* ((data (rmail-apply-in-message rmail-current-message 'buffer-string))
	   (buf (get-buffer-create "*RMAIL*"))
	   (rmail-mime-mbox-buffer rmail-view-buffer)
	   (rmail-mime-view-buffer buf))
      (set-buffer buf)