X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=d8a05af4a340319f39253579df708e7ac3f14f43;hb=957328ebbc667deae8c53feb0baa9e0162938e2a;hp=6539c65daf0912734faf3662b78b56ea1e60b7b8;hpb=2d0d383d18e7984ea063c06797f2c8833ca489cf;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index 6539c65..d8a05af 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -64,9 +64,9 @@
 
 (defcustom mime-preview-move-scroll nil
   "*Decides whether to scroll when moving to next entity.
-When t, scroll the buffer. Non-nil but not t means scroll when
-the next entity is within next-screen-context-lines from top or
-buttom. Nil means don't scroll at all."
+When t, scroll the buffer.  Non-nil but not t means scroll when
+the next entity is within `next-screen-context-lines' from top or
+buttom.  Nil means don't scroll at all."
   :group 'mime-view
   :type '(choice (const :tag "Off" nil)
 		 (const :tag "On" t)
@@ -117,6 +117,23 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 			       (const :tag "Default" t))
 		       integer)))
 
+(defcustom mime-view-mailcap-files
+    (if (memq system-type '(ms-dos ms-windows windows-nt))
+      '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
+      '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
+	"/usr/local/etc/mailcap"))
+    "*Search path of mailcap files."
+    :group 'mime
+    :type '(repeat file))
+
+(defvar mime-view-automatic-conversion
+  (cond ((featurep 'xemacs)
+	 'automatic-conversion)
+	((boundp 'MULE)
+	 '*autoconv*)
+	(t
+	 'undecided)))
+
 ;;; @ in raw-buffer (representation space)
 ;;;
 
@@ -128,11 +145,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 (defvar mime-raw-representation-type-alist
   '((mime-show-message-mode     . binary)
     (mime-temp-message-mode     . binary)
-    (t                          . cooked)
-    )
-  "Alist of major-mode vs. representation-type of mime-raw-buffer.
+    (t                          . cooked))
+  "Alist of `major-mode' vs. representation-type of mime-raw-buffer.
 Each element looks like (SYMBOL . REPRESENTATION-TYPE).  SYMBOL is
-major-mode or t.  t means default.  REPRESENTATION-TYPE must be
+`major-mode' or t.  t means default.  REPRESENTATION-TYPE must be
 `binary' or `cooked'.")
 
 
@@ -171,7 +187,7 @@ message/partial, it is called `mother-buffer'.")
 ;; (make-variable-buffer-local 'mime-raw-buffer)
 
 (defvar mime-preview-original-window-configuration nil
-  "Window-configuration before mime-view-mode is called.")
+  "Window-configuration before `mime-view-mode' is called.")
 (make-variable-buffer-local 'mime-preview-original-window-configuration)
 
 (defun mime-preview-original-major-mode (&optional recursive point)
@@ -182,8 +198,7 @@ mother-buffer."
   (if (and recursive mime-mother-buffer)
       (save-excursion
 	(set-buffer mime-mother-buffer)
-	(mime-preview-original-major-mode recursive)
-	)
+	(mime-preview-original-major-mode recursive))
     (cdr (assq 'major-mode
 	       (get-text-property (or point
 				      (if (> (point) (buffer-size))
@@ -203,15 +218,13 @@ mother-buffer."
       (setq rest (or (mime-entity-content-type entity)
 		     (make-mime-content-type 'text 'plain))
 	    situation (cons (car rest) situation)
-	    rest (cdr rest))
-      )
+	    rest (cdr rest)))
     (unless (assq 'subtype situation)
       (or rest
 	  (setq rest (or (cdr (mime-entity-content-type entity))
 			 '((subtype . plain)))))
       (setq situation (cons (car rest) situation)
-	    rest (cdr rest))
-      )
+	    rest (cdr rest)))
     (while rest
       (setq param (car rest))
       (or (assoc (car param) situation)
@@ -226,8 +239,7 @@ mother-buffer."
 	  (setq situation (cons (cons 'disposition-type
 				      (mime-content-disposition-type rest))
 				situation)
-		rest (mime-content-disposition-parameters rest))
-	))
+		rest (mime-content-disposition-parameters rest))))
     (while rest
       (setq param (car rest)
 	    name (car param))
@@ -305,6 +317,30 @@ mother-buffer."
 ;;       (setq rcl (cdr rcl)))
 ;;     dest))
 
+(defmacro mime-view-header-is-visible (situation)
+  `(eq (cdr (or (assq '*header ,situation)
+		(assq 'header ,situation)))
+       'visible))
+
+(defmacro mime-view-body-is-visible (situation)
+  `(eq (cdr (or (assq '*body ,situation)
+		(assq 'body ,situation)))
+       'visible))
+
+(defmacro mime-view-children-is-invisible (situation)
+  `(eq (cdr (or (assq '*children ,situation)
+		(assq 'children ,situation)))
+       'invisible))
+
+(defmacro mime-view-button-is-visible (situation)
+  ;; Kludge.
+  `(or (eq (or (cdr (assq '*entity-button ,situation))
+	       (cdr (assq 'entity-button ,situation)))
+	   'visible)
+       (and (not (eq (or (cdr (assq '*entity-button ,situation))
+			 (cdr (assq 'entity-button ,situation)))
+		     'invisible))
+	    (mime-view-entity-button-visible-p entity))))
 
 ;;; @ presentation of preview
 ;;;
@@ -337,26 +373,30 @@ You can customize the visibility by changing `mime-view-button-place-alist'."
 		    mime-view-button-place-alist))
 	 '(around before))
    (and (mime-entity-parent entity)
-   (let ((prev-entity
-	 (cadr (memq entity
-		     (reverse (mime-entity-children
-			       (mime-entity-parent entity)))))))
-     ;; When previous entity exists
-     (and prev-entity
-	  (or
-	   ;; Check previous entity
-	   ;; type/subtype
-	   (memq (cdr
-		  (assq
-		   (mime-view-entity-type/subtype prev-entity)
-		   mime-view-button-place-alist))
-		 '(around after))
-	   ;; type
-	   (memq (cdr
-		  (assq
-		   (mime-entity-media-type prev-entity)
-		   mime-view-button-place-alist))
-		 '(around after))))))))
+	(let ((prev-entity
+	       (cadr (memq entity
+			   (reverse (mime-entity-children
+				     (mime-entity-parent entity)))))))
+	  ;; When previous entity exists
+	  (and prev-entity
+	       (or
+		;; Check previous entity
+		;; type/subtype
+		(memq (cdr
+		       (assq
+			(mime-view-entity-type/subtype prev-entity)
+			mime-view-button-place-alist))
+		      '(around after))
+		;; type
+		(memq (cdr
+		       (assq
+			(mime-entity-media-type prev-entity)
+			mime-view-button-place-alist))
+		      '(around after))))))
+   ;; default for everything.
+   (memq (cdr (assq t
+		    mime-view-button-place-alist))
+	 '(around before))))
 
 ;;; @@@ entity button generator
 ;;;
@@ -450,8 +490,7 @@ Each elements are regexp of field-name.")
 							field-type field-value)
   (let ((s-field (assq field-type calist)))
     (cond ((null s-field)
-	   (cons (cons field-type field-value) calist)
-	   )
+	   (cons (cons field-type field-value) calist))
 	  (t calist))))
 
 (define-calist-field-match-method
@@ -464,10 +503,11 @@ Each elements are regexp of field-name.")
 (defvar mime-preview-condition nil
   "Condition-tree about how to display entity.")
 
-(ctree-set-calist-strictly
- 'mime-preview-condition '((type . application)(subtype . t)
-			   (encoding . nil)
-			   (body . visible)))
+;;(ctree-set-calist-strictly
+;; 'mime-preview-condition '((type . application)(subtype . octet-stream)
+;;			   (encoding . nil)
+;;			   (body . visible)))
+
 (ctree-set-calist-strictly
  'mime-preview-condition '((type . application)(subtype . t)
 			   (encoding . "7bit")
@@ -527,6 +567,12 @@ Each elements are regexp of field-name.")
    (body-presentation-method . mime-display-application/x-postpet)))
 
 (ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . t)
+			   (encoding . t)
+			   (body . invisible)
+			   (body-presentation-method . mime-display-detect-application/octet-stream)))
+
+(ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . t)
    (body . visible)
@@ -545,21 +591,42 @@ Each elements are regexp of field-name.")
    (body-presentation-method . mime-display-multipart/alternative)))
 
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . partial)
-			   (body-presentation-method
-			    . mime-display-message/partial-button)))
+ 'mime-preview-condition
+ '((type . multipart)(subtype . t)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . partial)
+   (body . visible)
+   (body-presentation-method . mime-display-message/partial-button)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . rfc822)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+			(entity-button . invisible))))
 
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . rfc822)
-			   (body-presentation-method . nil)
-			   (childrens-situation (header . visible)
-						(entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . news)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+			(entity-button . invisible))))
 
+;; message/external-body has only one child.
 (ctree-set-calist-strictly
- 'mime-preview-condition '((type . message)(subtype . news)
-			   (body-presentation-method . nil)
-			   (childrens-situation (header . visible)
-						(entity-button . invisible))))
+ 'mime-preview-condition
+ '((type . message)(subtype . external-body)
+   (body . visible)
+   (body-presentation-method . nil)
+   (childrens-situation (header . invisible)
+			(body . invisible)
+			(entity-button . visible))))
 
 
 ;;; @@@ entity presentation
@@ -568,15 +635,38 @@ Each elements are regexp of field-name.")
 (defun mime-display-text/plain (entity situation)
   (save-restriction
     (narrow-to-region (point-max)(point-max))
-    (mime-insert-text-content entity)
+    (condition-case nil
+	(mime-insert-text-content entity)
+      (error
+       (message "Wrong Content-Transfer-Encoding: %s"
+		(mime-entity-encoding entity))
+       (if (fboundp 'mime-entity-body)
+	   (insert (mime-entity-body entity))
+	 (insert ""))))
     (run-hooks 'mime-text-decode-hook)
     (goto-char (point-max))
     (if (not (eq (char-after (1- (point))) ?\n))
-	(insert "\n")
-      )
+	(insert "\n"))
     (mime-add-url-buttons)
-    (run-hooks 'mime-display-text/plain-hook)
-    ))
+    (run-hooks 'mime-display-text/plain-hook)))
+
+(defun mime-display-text (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max) (point-max))
+    (insert
+     (decode-coding-string
+      (mime-decode-string
+       (if (fboundp 'mime-entity-body)
+	   ;; FLIM 1.14
+	   (mime-entity-body entity)
+	 ;; #### This is wrong, but...
+	 (mime-entity-content entity))
+       (or (cdr (assq 'encoding situation))
+	   (if (fboundp 'mime-entity-body)
+	       (mime-entity-encoding entity)
+	     "7bit")))
+      (or (cdr (assq 'coding situation))
+	  'binary)))))
 
 (defun mime-display-text/richtext (entity situation)
   (save-restriction
@@ -585,8 +675,7 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-text-decode-hook)
     (let ((beg (point-min)))
       (remove-text-properties beg (point-max) '(face nil))
-      (richtext-decode beg (point-max))
-      )))
+      (richtext-decode beg (point-max)))))
 
 (defun mime-display-text/enriched (entity situation)
   (save-restriction
@@ -595,8 +684,7 @@ Each elements are regexp of field-name.")
     (run-hooks 'mime-text-decode-hook)
     (let ((beg (point-min)))
       (remove-text-properties beg (point-max) '(face nil))
-      (enriched-decode beg (point-max))
-      )))
+      (enriched-decode beg (point-max)))))
 
 (defun mime-display-text/x-rot13-47-48 (entity situation)
   (save-restriction
@@ -701,8 +789,7 @@ Each elements are regexp of field-name.")
 		  "Brain: " (int-to-string (cdr (assq 'brain pet))) "\n"
 		  "Happiness: " (int-to-string (cdr (assq 'happiness pet))) "\n"
 		  "Treasure: " (int-to-string (cdr (assq 'treasure pet))) "\n"
-		  "Money: " (int-to-string (cdr (assq 'money pet))) "\n"
-		  )
+		  "Money: " (int-to-string (cdr (assq 'money pet))) "\n")
 	(insert "Invalid format\n"))
       (run-hooks 'mime-display-application/x-postpet-hook))))
 
@@ -710,26 +797,24 @@ Each elements are regexp of field-name.")
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
       "\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer          ]]
-\[[ or click here by mouse button-2.             ]]"
+This is message/partial style split message.
+Please press `v' key in this buffer or click here by mouse button-2."
     "\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer.         ]]"
-    ))
+This is message/partial style split message.
+Please press `v' key in this buffer."))
 
 (defun mime-display-message/partial-button (&optional entity situation)
   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
-	(insert "\n")
-      )
+	(insert "\n"))
     (goto-char (point-max))
-    (narrow-to-region (point-max)(point-max))
-    (insert mime-view-announcement-for-message/partial)
-    (mime-add-button (point-min)(point-max)
-		     #'mime-preview-play-current-entity)
-    ))
+    ;;(narrow-to-region (point-max)(point-max))
+    ;;(insert mime-view-announcement-for-message/partial)
+    ;; (mime-add-button (point-min)(point-max)
+    ;;                  #'mime-preview-play-current-entity)
+    (mime-insert-button mime-view-announcement-for-message/partial
+			#'mime-preview-play-current-entity)))
 
 (defun mime-display-multipart/mixed (entity situation)
   (let ((children (mime-entity-children entity))
@@ -741,8 +826,7 @@ Each elements are regexp of field-name.")
 	      (cons original-major-mode-cell default-situation)))
     (while children
       (mime-display-entity (car children) nil default-situation)
-      (setq children (cdr children))
-      )))
+      (setq children (cdr children)))))
 
 (defun mime-display-multipart/alternative (entity situation)
   (let* ((children (mime-entity-children entity))
@@ -778,15 +862,12 @@ Each elements are regexp of field-name.")
 					mime-view-type-subtype-score-alist)
 				       (assq
 					t
-					mime-view-type-subtype-score-alist)
-				       ))))
+					mime-view-type-subtype-score-alist)))))
 			     (if (> score max-score)
 				 (setq p i
-				       max-score score)
-			       )))
+				       max-score score))))
 		       (setq i (1+ i))
-		       situation)
-		     ))
+		       situation)))
 		  children))
     (setq i 0)
     (while children
@@ -795,20 +876,68 @@ Each elements are regexp of field-name.")
 	(mime-display-entity child (if (= i p)
 				       situation
 				     (del-alist 'body-presentation-method
-						(copy-alist situation))))
-	)
+						(copy-alist situation)))))
       (setq children (cdr children)
 	    situations (cdr situations)
-	    i (1+ i))
-      )))
+	    i (1+ i)))))
+
+(defun mime-display-multipart/encrypted (entity situation)
+  (let ((children (mime-entity-children entity))
+	(original-major-mode-cell (assq 'major-mode situation))
+	(default-situation
+	  (cdr (assq 'childrens-situation situation))))
+    (if original-major-mode-cell
+	(setq default-situation
+	      (cons original-major-mode-cell default-situation)))
+    (mime-display-entity (car children) nil default-situation)
+    (mime-display-entity (cadr children) nil
+			 (put-alist '*entity-button
+				    'invisible default-situation))
+    (del-alist '*entity-button default-situation)
+    (setq children (nth 2 children))
+    ;; This shouldn't happen.
+    (while children
+      (mime-display-entity (car children) nil default-situation)
+      (setq children (cdr children)))))
+
+(defun mime-display-detect-application/octet-stream (entity situation)
+  "Detect unknown ENTITY and display it inline.
+This can only handle gzipped contents."
+  (or (and (mime-entity-filename entity)
+	   (string-match "\\.gz$" (mime-entity-filename entity))
+	   (mime-display-gzipped entity situation))
+      (mime-display-text/plain entity situation)))
+
+(defun mime-display-gzipped (entity situation)
+  "Ungzip gzipped part and display."
+    (insert
+     (decode-coding-string
+      (with-temp-buffer
+	;; #### Kludge to make FSF Emacs happy.
+	(if (featurep 'xemacs)
+	    (insert (mime-entity-content entity))
+	  (let ((content (mime-entity-content entity)))
+	    (if (not (multibyte-string-p content))
+		;; I really hate this brain-damaged function.
+		(set-buffer-multibyte nil))
+	    (insert content)))
+	(as-binary-process
+	 (call-process-region (point-min) (point-max) "gzip" t t
+			      nil "-cd"))
+	;; Oh my goodness.
+	(when (fboundp 'set-buffer-multibyte)
+	  (set-buffer-multibyte t))
+	(buffer-string))
+      mime-view-automatic-conversion))
+     t)
 
 (defun mime-preview-inline ()
-  "View part as text without code conversion"
+  "View part as text without code conversion."
   (interactive)
   (let ((inhibit-read-only t)
 	(entity (get-text-property (point) 'mime-view-entity))
 	(situation (get-text-property (point) 'mime-view-situation))
-	start end)
+	start)
     (when (and entity
 	       (not (get-text-property (point) 'mime-view-entity-header))
 	       (not (memq (mime-entity-media-type entity)
@@ -847,113 +976,63 @@ Each elements are regexp of field-name.")
 With prefix, it prompts for coding-system."
   (interactive "P")
   (let ((inhibit-read-only t)
-	(entity (get-text-property (point) 'mime-view-entity))
-	(situation (get-text-property (point) 'mime-view-situation))
+	(mime-view-force-inline-types t)
+	(position (mime-preview-entity-boundary))
 	(coding (if ask-coding
 		    (or (read-coding-system "Coding system: ")
-			'undecided)
-		  'undecided)))
-    (when (and entity
-	       (not (get-text-property (point) 'mime-view-entity-header))
-	       (not (memq (mime-entity-media-type entity)
-			  '(multipart message))))
-      (setq start (or (and (not (mime-entity-parent entity))
-			   (1+ (previous-single-property-change
-				(point)
-				'mime-view-entity-header)))
-		      (and (not (eq (point) (point-min)))
-			   (not (eq (get-text-property (1- (point))
-						       'mime-view-entity)
-				    entity))
-			   (point))
-		      (previous-single-property-change (point)
-						       'mime-view-entity)
-		      (point)))
-      (delete-region start
-		     (1-
-		      (or (next-single-property-change (point)
-						       'mime-view-entity)
-			  (point-max))))
-      (setq start (point))
-      (if (mime-view-entity-button-visible-p entity)
-	  (mime-view-insert-entity-button entity))
-      (insert (decode-coding-string (mime-entity-content entity) coding))
-      (if (and (bolp) (eolp))
-	  (delete-char 1)
-	(forward-char 1))
-      (add-text-properties start (point)
-			   (list 'mime-view-entity entity
-				 'mime-view-situation situation))
-      (goto-char start))))
-	      
+			mime-view-automatic-conversion)
+		  mime-view-automatic-conversion))
+	(cte (if ask-coding
+		 (completing-read "Content Transfer Encoding: "
+				  (mime-encoding-alist) nil t)))
+	entity situation)
+    (setq entity (get-text-property (car position) 'mime-view-entity)
+	  situation (get-text-property (car position) 'mime-view-situation))
+    (setq situation
+	  (put-alist
+	   'encoding cte
+	   (put-alist
+	    'coding coding
+	    (put-alist
+	     'body-presentation-method 'mime-display-text
+	     (put-alist '*body 'visible situation)))))
+    (save-excursion
+      (delete-region (car position) (cdr position))
+      (mime-display-entity entity situation))))
 
 (defun mime-preview-type ()
-  "View part as text without code conversion"
+  "View part as text without code conversion."
   (interactive)
-  (let ((inhibit-read-only t)
-	(entity (get-text-property (point) 'mime-view-entity))
-	(situation (get-text-property (point) 'mime-view-situation))
-	(mime-view-force-inline-types t)
-	start end)
-    (when (and entity
-	       (not (get-text-property (point) 'mime-view-entity-header))
-	       (not (memq (mime-entity-media-type entity)
-			  '(multipart message))))
-      (setq start (or (and (not (mime-entity-parent entity))
-			   (1+ (previous-single-property-change
-				(point)
-			       'mime-view-entity-header)))
-		      (and (not (eq (point) (point-min)))
-			   (not (eq (get-text-property (1- (point))
-						       'mime-view-entity)
-				    entity))
-			   (point))
-		      (previous-single-property-change (point)
-						   'mime-view-entity)
-		      (point)))
-      (delete-region start
-		     (1-
-		      (or (next-single-property-change (point)
-						       'mime-view-entity)
-			  (point-max))))
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (point) (point))
-	  (mime-display-entity entity (if (eq (assq 'body situation)
-					      'invisible)
-					  situation
-					(put-alist 'body 'visible
-						   situation))))
-	(if (and (bolp) (eolp))
-	      (delete-char 1))))))
+  (mime-preview-toggle-content t))
 
 (defun mime-preview-buttonize ()
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let ((inhibit-read-only t)
-	  point)
+    (let (point)
       (while (setq point (next-single-property-change
 			  (point) 'mime-view-entity))
 	(goto-char point)
-	(unless (get-text-property (point) 'mime-button-callback)
-	  (mime-view-insert-entity-button
-	   (get-text-property (point) 'mime-view-entity)))))))
+	(unless (get-text-property (point) 'mime-button)
+	  (mime-preview-toggle-button t))))))
 
 (defun mime-preview-unbuttonize ()
   (interactive)
   (save-excursion
     (goto-char (point-min))
-    (let ((inhibit-read-only t)
-	  point)
+    (let (point)
       (while (setq point (next-single-property-change
 			  (point) 'mime-view-entity))
 	(goto-char point)
-	(if (get-text-property (point) 'mime-button-callback)
-	    (delete-region (point) (save-excursion
-				     (goto-char
-				      (next-single-property-change
-				       (point) 'mime-button-callback)))))))))
+	(when (get-text-property (point) 'mime-button)
+	  ;; Remove invisible text following XPM buttons.
+	  (static-if (featurep 'xemacs)
+	      (let ((extent (extent-at (point) nil 'invisible))
+		    (inhibit-read-only t))
+		(if extent
+		    (delete-region (extent-start-position extent)
+				   (extent-end-position extent)))))
+	  (mime-preview-toggle-button 'hide))))))
 	  
 
 ;;; @ acting-condition
@@ -962,41 +1041,71 @@ With prefix, it prompts for coding-system."
 (defvar mime-acting-condition nil
   "Condition-tree about how to process entity.")
 
-(if (file-readable-p mailcap-file)
-    (let ((entries (mailcap-parse-file)))
-      (while entries
-	(let ((entry (car entries))
-	      view print shared)
-	  (while entry
-	    (let* ((field (car entry))
-		   (field-type (car field)))
-	      (cond ((eq field-type 'view)  (setq view field))
-		    ((eq field-type 'print) (setq print field))
-		    ((memq field-type '(compose composetyped edit)))
-		    (t (setq shared (cons field shared))))
-	      )
-	    (setq entry (cdr entry))
-	    )
-	  (setq shared (nreverse shared))
-	  (ctree-set-calist-with-default
-	   'mime-acting-condition
-	   (append shared (list '(mode . "play")(cons 'method (cdr view)))))
-	  (if print
-	      (ctree-set-calist-with-default
-	       'mime-acting-condition
-	       (append shared
-		       (list '(mode . "print")(cons 'method (cdr view))))
-	       ))
-	  )
-	(setq entries (cdr entries))
-	)))
+(defvar mime-view-mailcap-parsed-p nil)
+
+;; ### Fix flim
+(defun mime-view-parse-mailcap-files (&optional path)
+  (if (not (or path (setq path (getenv "MAILCAPS"))))
+      (setq path mime-view-mailcap-files))
+  (let ((fnames (reverse
+		 (if (stringp path)
+		     (parse-colon-path path)
+		   path)))
+	fname)
+    (setq mim-view-mailcap-parsed-p t)
+    (with-temp-buffer
+      (while fnames
+	(setq fname (car fnames))
+	(when (and (file-readable-p fname)
+		   (file-regular-p fname))
+	  (insert-file-contents fname)
+	  (unless (bolp)
+	    (insert "\n")))
+	(setq fnames (cdr fnames)))
+      (mailcap-parse-buffer))))
+
+(defun mime-view-parse-mailcap (&optional path force)
+    "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system.  If FORCE, re-parse even if already
+parsed.  If PATH is omitted, use the value of `mime-view-mailcap-files'."
+    (interactive (list nil t))
+    (when (or (not mime-view-mailcap-parsed-p)
+	      force)
+      (let ((entries (mime-view-parse-mailcap-files path)))
+	(while entries
+	  (let ((entry (car entries))
+		view print shared)
+	    (while entry
+	      (let* ((field (car entry))
+		     (field-type (car field)))
+		(cond ((eq field-type 'view)
+		       (setq view field))
+		      ((eq field-type 'print)
+		       (setq print field))
+		      ((memq field-type '(compose composetyped edit)))
+		      (t
+		       (setq shared (cons field shared)))))
+	      (setq entry (cdr entry)))
+	    (setq shared (nreverse shared))
+	    (ctree-set-calist-with-default
+	     'mime-acting-condition
+	     (append shared
+		     (list '(mode . "play") (cons 'method (cdr view)))))
+	    (if print
+		(ctree-set-calist-with-default
+		 'mime-acting-condition
+		 (append shared
+			 (list '(mode . "print") (cons 'method (cdr view)))))))
+	  (setq entries (cdr entries))))))
+
+(mime-view-parse-mailcap)
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . application)(subtype . octet-stream)
    (mode . "play")
-   (method . mime-detect-content)
-   ))
+   (method . mime-detect-content)))
 
 (ctree-set-calist-with-default
  'mime-acting-condition
@@ -1006,44 +1115,37 @@ With prefix, it prompts for coding-system."
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47)(mode . "play")
-   (method . mime-view-caesar)
-   ))
+   (method . mime-view-caesar)))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
-   (method . mime-view-caesar)
-   ))
+   (method . mime-view-caesar)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . rfc822)(mode . "play")
-   (method . mime-view-message/rfc822)
-   ))
+   (method . mime-view-message/rfc822)))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . partial)(mode . "play")
-   (method . mime-store-message/partial-piece)
-   ))
+   (method . mime-store-message/partial-piece)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
-   (method . mime-view-message/external-anon-ftp)
-   ))
+   (method . mime-view-message/external-anon-ftp)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "url")
-   (method . mime-view-message/external-url)
-   ))
+   (method . mime-view-message/external-url)))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . application)(subtype . octet-stream)
-   (method . mime-save-content)
-   ))
+   (method . mime-save-content)))
 
 
 ;;; @ quitting method
@@ -1052,20 +1154,20 @@ With prefix, it prompts for coding-system."
 (defvar mime-preview-quitting-method-alist
   '((mime-show-message-mode
      . mime-preview-quitting-method-for-mime-show-message-mode))
-  "Alist of major-mode vs. quitting-method of mime-view.")
+  "Alist of `major-mode' vs. quitting-method of mime-view.")
 
 (defvar mime-preview-over-to-previous-method-alist nil
-  "Alist of major-mode vs. over-to-previous-method of mime-view.")
+  "Alist of `major-mode' vs. over-to-previous-method of mime-view.")
 
 (defvar mime-preview-over-to-next-method-alist nil
-  "Alist of major-mode vs. over-to-next-method of mime-view.")
+  "Alist of `major-mode' vs. over-to-next-method of mime-view.")
 
 
 ;;; @ following method
 ;;;
 
 (defvar mime-preview-following-method-alist nil
-  "Alist of major-mode vs. following-method of mime-view.")
+  "Alist of `major-mode' vs. following-method of mime-view.")
 
 (defvar mime-view-following-required-fields-list
   '("From"))
@@ -1076,95 +1178,95 @@ With prefix, it prompts for coding-system."
 
 (defun mime-display-entity (entity &optional situation
 				   default-situation preview-buffer)
+  "Display mime-entity ENTITY."
   (or preview-buffer
       (setq preview-buffer (current-buffer)))
-  (let (e nb ne nhb nbb)
-    (mime-goto-header-start-point entity)
-    (in-calist-package 'mime-view)
-    (or situation
-	(setq situation
-	      (or (ctree-match-calist mime-preview-condition
-				      (append (mime-entity-situation entity)
-					      default-situation))
-		  default-situation)))
-    (let ((button-is-invisible
-	   (or (eq (cdr (assq 'entity-button situation)) 'invisible)
-	       (not (mime-view-entity-button-visible-p entity))))
-	   (header-is-visible
-	    (eq (cdr (assq 'header situation)) 'visible))
-	   (header-presentation-method
-	    (or (cdr (assq 'header-presentation-method situation))
-		(cdr (assq (cdr (assq 'major-mode situation))
-			   mime-header-presentation-method-alist))))
-	   (body-is-visible
-	    (eq (cdr (assq 'body situation)) 'visible))
-	   (body-presentation-method
-	    (cdr (assq 'body-presentation-method situation)))
-	   (children (mime-entity-children entity)))
-      ;; Check if attachment is specified.
-      ;; if inline is forced or not.
-      (unless (or (eq t mime-view-force-inline-types)
-		  (memq (mime-entity-media-type entity)
-			mime-view-force-inline-types)
-		  (memq (mime-view-entity-type/subtype entity)
-			 mime-view-force-inline-types)
-		   ;; whether Content-Disposition header exists.
-		  (not (mime-entity-content-disposition entity))
-		  (eq 'inline
-		      (mime-content-disposition-type
-		       (mime-entity-content-disposition entity))))
-	;; This is attachment
-	(setq header-is-visible nil
-	      body-is-visible nil))
-      (set-buffer preview-buffer)
-      (setq nb (point))
-      (save-restriction
-	(narrow-to-region nb nb)
-	(or button-is-invisible
-	    (if (mime-view-entity-button-visible-p entity)
-		(mime-view-insert-entity-button entity
-						;; work around composite type
-						(not (or children
-							 body-is-visible)))))
-	(when header-is-visible
-	  (setq nhb (point))
-	  (if header-presentation-method
-	      (funcall header-presentation-method entity situation)
-	    (mime-insert-header entity
-				mime-view-ignored-field-list
-				mime-view-visible-field-list))
-	  (run-hooks 'mime-display-header-hook)
-	  (put-text-property nhb (point-max) 'mime-view-entity-header entity)
-	  (goto-char (point-max))
-	  (insert "\n"))
-	(setq nbb (point))
-	(cond (children)
-	      ((and body-is-visible
-		    (functionp body-presentation-method))
-	       (funcall body-presentation-method entity situation))
-	      (t
-	       (when button-is-invisible
-		 (goto-char (point-max))
-		 (mime-view-insert-entity-button entity
-						 ;; work around composite type
-						 (not (or children
-							  body-is-visible))))
-	       (or header-is-visible
-		   (progn
-		     (goto-char (point-max))
-		     (insert "\n")
-		     ))
-	       ))
-	(setq ne (point-max)))
-      (put-text-property nb ne 'mime-view-entity entity)
-      (put-text-property nb ne 'mime-view-situation situation)
-      (put-text-property nbb ne 'mime-view-entity-body entity)
-      (goto-char ne)
-      (if children
-	  (if (functionp body-presentation-method)
-	      (funcall body-presentation-method entity situation)
-	    (mime-display-multipart/mixed entity situation))))))
-
+  (in-calist-package 'mime-view)
+  (or situation
+      (setq situation
+	    (or (ctree-match-calist mime-preview-condition
+				    (append (mime-entity-situation entity)
+					    default-situation))
+		default-situation)))
+  (let ((button-is-visible (mime-view-button-is-visible situation))
+	(header-is-visible
+	 (mime-view-header-is-visible situation))
+	(header-presentation-method
+	 (or (cdr (assq '*header-presentation-method situation))
+	     (cdr (assq 'header-presentation-method situation))
+	     (cdr (assq (cdr (assq 'major-mode situation))
+			mime-header-presentation-method-alist))))
+	(body-is-visible
+	 (mime-view-body-is-visible situation))
+	(body-presentation-method
+	 (cdr (assq 'body-presentation-method situation)))
+	(children (mime-entity-children entity))
+	nb ne nhb nbb)
+    ;; Check if attachment is specified.
+    ;; if inline is forced or not.
+    (unless (or (eq t mime-view-force-inline-types)
+		(memq (mime-entity-media-type entity)
+		      mime-view-force-inline-types)
+		(memq (mime-view-entity-type/subtype entity)
+		      mime-view-force-inline-types)
+		;; whether Content-Disposition header exists.
+		(not (mime-entity-content-disposition entity))
+		(eq 'inline
+		    (mime-content-disposition-type
+		     (mime-entity-content-disposition entity))))
+      ;; This is attachment.
+      ;; But show header when this is root entity.
+      (if (mime-root-entity-p entity)
+	  (progn (setq body-is-visible nil)
+		 (put-alist 'body 'invisible situation))
+	(setq header-is-visible nil)
+	(put-alist 'header 'invisible situation)))
+    (set-buffer preview-buffer)
+    (setq nb (point))
+    (save-restriction
+      (narrow-to-region nb nb)
+      (if button-is-visible
+	  (mime-view-insert-entity-button entity
+					  ;; work around composite type
+					  (not (or children
+						   body-is-visible))))
+      (when header-is-visible
+	(setq nhb (point))
+	(if header-presentation-method
+	    (funcall header-presentation-method entity situation)
+	  (mime-insert-header entity
+			      mime-view-ignored-field-list
+			      mime-view-visible-field-list))
+	(run-hooks 'mime-display-header-hook)
+	(put-text-property nhb (point-max) 'mime-view-entity-header entity)
+	(goto-char (point-max))
+	(insert "\n"))
+      (setq nbb (point))
+      (cond (children)
+	    ((and body-is-visible
+		  (functionp body-presentation-method))
+	     (funcall body-presentation-method entity situation))
+	    (t
+	     ;; When both body and button is not displayed,
+	     ;; there should be a button to indicate there's a part.
+	     (unless button-is-visible
+	       (goto-char (point-max))
+	       (mime-view-insert-entity-button entity
+					       ;; work around composite type
+					       (not (or children
+							body-is-visible))))
+	     (unless header-is-visible
+	       (goto-char (point-max))
+	       (insert "\n"))))
+      (setq ne (point-max)))
+    (put-text-property nb ne 'mime-view-entity entity)
+    (put-text-property nb ne 'mime-view-situation situation)
+    (put-text-property nbb ne 'mime-view-entity-body entity)
+    (goto-char ne)
+    (if (and children body-is-visible)
+	(if (functionp body-presentation-method)
+	    (funcall body-presentation-method entity situation)
+	  (mime-display-multipart/mixed entity situation)))))
 
 ;;; @ MIME viewer mode
 ;;;
@@ -1181,17 +1283,15 @@ With prefix, it prompts for coding-system."
     (print	 "Print current entity"    mime-preview-print-current-entity)
     (raw "View text without code conversion" mime-preview-inline)
     (text "View text with code conversion" mime-preview-text)
-    (type "View internally as type" mime-preview-type)
-    )
-  "Menu for MIME Viewer")
+    (type "View internally as type" mime-preview-type))
+  "Menu for MIME Viewer.")
 
 (cond ((featurep 'xemacs)
        (defvar mime-view-xemacs-popup-menu
 	 (cons mime-view-menu-title
 	       (mapcar (function
 			(lambda (item)
-			  (vector (nth 1 item)(nth 2 item) t)
-			  ))
+			  (vector (nth 1 item)(nth 2 item) t)))
 		       mime-view-menu-list)))
        (defun mime-view-xemacs-popup-menu (event)
 	 "Popup the menu in the MIME Viewer buffer"
@@ -1199,17 +1299,14 @@ With prefix, it prompts for coding-system."
 	 (select-window (event-window event))
 	 (set-buffer (event-buffer event))
 	 (popup-menu 'mime-view-xemacs-popup-menu))
-       (defvar mouse-button-2 'button2)
-       )
+       (defvar mouse-button-2 'button2))
       (t
-       (defvar mouse-button-2 [mouse-2])
-       ))
+       (defvar mouse-button-2 [mouse-2])))
 
 (defun mime-view-define-keymap (&optional default)
   (let ((mime-view-mode-map (if (keymapp default)
 				(copy-keymap default)
-			      (make-sparse-keymap)
-			      )))
+			      (make-sparse-keymap))))
     (define-key mime-view-mode-map
       "u"        (function mime-preview-move-to-upper))
     (define-key mime-view-mode-map
@@ -1235,6 +1332,8 @@ With prefix, it prompts for coding-system."
     (define-key mime-view-mode-map
       "e"        (function mime-preview-extract-current-entity))
     (define-key mime-view-mode-map
+      "\C-c\C-e"        (function mime-preview-extract-current-entity))
+    (define-key mime-view-mode-map
       "i"        (function mime-preview-inline))
     (define-key mime-view-mode-map
       "c"        (function mime-preview-text))
@@ -1245,6 +1344,18 @@ With prefix, it prompts for coding-system."
     (define-key mime-view-mode-map
       "B"        (function mime-preview-unbuttonize))
     (define-key mime-view-mode-map
+      "\C-c\C-t\C-h" (function mime-preview-toggle-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-th" (function mime-preview-toggle-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-t\C-c" (function mime-preview-toggle-content))
+    (define-key mime-view-mode-map
+      "\C-c\C-tc" (function mime-preview-toggle-content))
+    (define-key mime-view-mode-map
+      "\C-c\C-tH" (function mime-preview-toggle-all-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-tb" (function mime-preview-toggle-button))
+    (define-key mime-view-mode-map
       "\C-c\C-p" (function mime-preview-print-current-entity))
     (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
@@ -1266,20 +1377,16 @@ With prefix, it prompts for coding-system."
       [backspace] (function mime-preview-scroll-down-entity))
     (if (functionp default)
 	(cond ((featurep 'xemacs)
-	       (set-keymap-default-binding mime-view-mode-map default)
-	       )
+	       (set-keymap-default-binding mime-view-mode-map default))
 	      (t
 	       (setq mime-view-mode-map
-		     (append mime-view-mode-map (list (cons t default))))
-	       )))
+		     (append mime-view-mode-map (list (cons t default)))))))
     (if mouse-button-2
 	(define-key mime-view-mode-map
-	  mouse-button-2 (function mime-button-dispatcher))
-      )
+	  mouse-button-2 (function mime-button-dispatcher)))
     (cond ((featurep 'xemacs)
 	   (define-key mime-view-mode-map
-	     mouse-button-3 (function mime-view-xemacs-popup-menu))
-	   )
+	     mouse-button-3 (function mime-view-xemacs-popup-menu)))
 	  ((>= emacs-major-version 19)
 	   (define-key mime-view-mode-map [menu-bar mime-view]
 	     (cons mime-view-menu-title
@@ -1288,15 +1395,10 @@ With prefix, it prompts for coding-system."
 		    (lambda (item)
 		      (define-key mime-view-mode-map
 			(vector 'menu-bar 'mime-view (car item))
-			(cons (nth 1 item)(nth 2 item))
-			)
-		      ))
-		   (reverse mime-view-menu-list)
-		   )
-	   ))
+			(cons (nth 1 item)(nth 2 item)))))
+		   (reverse mime-view-menu-list))))
     (use-local-map mime-view-mode-map)
-    (run-hooks 'mime-view-define-keymap-hook)
-    ))
+    (run-hooks 'mime-view-define-keymap-hook)))
 
 (defsubst mime-maybe-hide-echo-buffer ()
   "Clear mime-echo buffer and delete window for it."
@@ -1307,10 +1409,8 @@ With prefix, it prompts for coding-system."
 	  (erase-buffer)
 	  (let ((win (get-buffer-window buf)))
 	    (if win
-		(delete-window win)
-	      ))
-	  (bury-buffer buf)
-	  ))))
+		(delete-window win)))
+	  (bury-buffer buf)))))
 
 (defvar mime-view-redisplay nil)
 
@@ -1335,32 +1435,29 @@ keymap of MIME-View mode."
 	(setq preview-buffer
 	      (concat "*Preview-" (mime-entity-name message) "*")))
     (or original-major-mode
-	(setq original-major-mode
-	      (with-current-buffer (mime-entity-header-buffer message)
-		major-mode)))
+	(setq original-major-mode major-mode))
     (let ((inhibit-read-only t))
       (set-buffer (get-buffer-create preview-buffer))
       (widen)
       (erase-buffer)
       (if mother
-	  (setq mime-mother-buffer mother)
-	)
+	  (setq mime-mother-buffer mother))
       (setq mime-preview-original-window-configuration win-conf)
       (setq major-mode 'mime-view-mode)
       (setq mode-name "MIME-View")
       (mime-display-entity message nil
-			   `((entity-button . invisible)
-			     (header . visible)
-			     (major-mode . ,original-major-mode))
+			   (list (cons 'entity-button 'invisible)
+				 (cons 'header 'visible)
+				 (cons 'major-mode original-major-mode))
 			   preview-buffer)
       (mime-view-define-keymap default-keymap-or-function)
+      (set (make-local-variable 'line-move-ignore-invisible) t)
       (let ((point
 	     (next-single-property-change (point-min) 'mime-view-entity)))
 	(if point
 	    (goto-char point)
 	  (goto-char (point-min))
-	  (search-forward "\n\n" nil t)
-	  ))
+	  (search-forward "\n\n" nil t)))
       (run-hooks 'mime-view-mode-hook)
       (set-buffer-modified-p nil)
       (setq buffer-read-only t)
@@ -1388,11 +1485,9 @@ message.  It must be nil, `binary' or `cooked'.  If it is nil,
 	    (save-excursion
 	      (set-buffer raw-buffer)
 	      (cdr (or (assq major-mode mime-raw-representation-type-alist)
-		       (assq t mime-raw-representation-type-alist)))
-	      )))
+		       (assq t mime-raw-representation-type-alist))))))
   (if (eq representation-type 'binary)
-      (setq representation-type 'buffer)
-    )
+      (setq representation-type 'buffer))
   (setq preview-buffer (mime-display-message
 			(mime-open-entity representation-type raw-buffer)
 			preview-buffer mother default-keymap-or-function))
@@ -1403,8 +1498,7 @@ message.  It must be nil, `binary' or `cooked'.  If it is nil,
 	  (let ((m-win (and mother (get-buffer-window mother))))
 	    (if m-win
 		(set-window-buffer m-win preview-buffer)
-	      (switch-to-buffer preview-buffer)
-	      ))))))
+	      (switch-to-buffer preview-buffer)))))))
 
 (defun mime-view-mode (&optional mother ctl encoding
 				 raw-buffer preview-buffer
@@ -1429,8 +1523,7 @@ C-c C-p		Decode current content as `print mode'
 a		Followup to current content.
 q		Quit
 button-2	Move to point under the mouse cursor
-        	and decode current content as `play mode'
-"
+        	and decode current content as `play mode'"
   (interactive)
   (unless mime-view-redisplay
     (save-excursion
@@ -1440,19 +1533,15 @@ button-2	Move to point under the mouse cursor
 	      (or (assq major-mode mime-raw-representation-type-alist)
 		  (assq t mime-raw-representation-type-alist)))))
 	(if (eq type 'binary)
-	    (setq type 'buffer)
-	  )
+	    (setq type 'buffer))
 	(setq mime-message-structure (mime-open-entity type raw-buffer))
 	(or (mime-entity-content-type mime-message-structure)
 	    (mime-entity-set-content-type-internal
-	     mime-message-structure ctl))
-	)
+	     mime-message-structure ctl)))
       (or (mime-entity-encoding mime-message-structure)
-	  (mime-entity-set-encoding-internal mime-message-structure encoding))
-      ))
+	  (mime-entity-set-encoding-internal mime-message-structure encoding))))
   (mime-display-message mime-message-structure preview-buffer
-			mother default-keymap-or-function)
-  )
+			mother default-keymap-or-function))
 
 
 ;;; @@ playing
@@ -1467,8 +1556,7 @@ It decodes current entity to call internal or external method as
 \"extract\" mode.  The method is selected from variable
 `mime-acting-condition'."
   (interactive "P")
-  (mime-preview-play-current-entity ignore-examples "extract")
-  )
+  (mime-preview-play-current-entity ignore-examples "extract"))
 
 (defun mime-preview-print-current-entity (&optional ignore-examples)
   "Print current entity (maybe).
@@ -1476,8 +1564,7 @@ It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable
 `mime-acting-condition'."
   (interactive "P")
-  (mime-preview-play-current-entity ignore-examples "print")
-  )
+  (mime-preview-play-current-entity ignore-examples "print"))
 
 
 ;;; @@ following
@@ -1488,144 +1575,90 @@ It decodes current entity to call internal or external method as
 It calls following-method selected from variable
 `mime-preview-following-method-alist'."
   (interactive)
-  (let (entity)
+  (let (entity position entity-node-id header-exists)
     (while (null (setq entity
 		       (get-text-property (point) 'mime-view-entity)))
-      (backward-char)
-      )
-    (let* ((p-beg
-	    (previous-single-property-change (point) 'mime-view-entity))
-	   p-end
-	   ph-end
-	   (entity-node-id (mime-entity-node-id entity))
-	   (len (length entity-node-id))
-	   )
-      (cond ((null p-beg)
-	     (setq p-beg
-		   (if (eq (next-single-property-change (point-min)
-							'mime-view-entity)
-			   (point))
-		       (point)
-		     (point-min)))
-	     )
-	    ((eq (next-single-property-change p-beg 'mime-view-entity)
-		 (point))
-	     (setq p-beg (point))
-	     ))
-      (setq p-end (next-single-property-change p-beg 'mime-view-entity))
-      (cond ((null p-end)
-	     (setq p-end (point-max))
-	     )
-	    ((null entity-node-id)
-	     (setq p-end (point-max))
-	     )
-	    (t
-	     (save-excursion
-	       (goto-char p-end)
-	       (catch 'tag
-		 (let (e)
-		   (while (setq e
-				(next-single-property-change
-				 (point) 'mime-view-entity))
-		     (goto-char e)
-		     (let ((rc (mime-entity-node-id
-				(get-text-property (point)
-						   'mime-view-entity))))
-		       (or (equal entity-node-id
-				  (nthcdr (- (length rc) len) rc))
-			   (throw 'tag nil)
-			   ))
-		     (setq p-end e)
-		     ))
-		 (setq p-end (point-max))
-		 ))
-	     ))
-      (setq ph-end
-	    (previous-single-property-change p-end 'mime-view-entity-header))
-      (if (or (null ph-end)
-	      (< ph-end p-beg))
-	  (setq ph-end p-beg)
-	)
-      (let* ((mode (mime-preview-original-major-mode 'recursive))
-	     (new-name
-	      (format "%s-%s" (buffer-name) (reverse entity-node-id)))
-	     new-buf
-	     (the-buf (current-buffer))
-	     fields)
-	(save-excursion
-	  (set-buffer (setq new-buf (get-buffer-create new-name)))
-	  (erase-buffer)
-	  (insert-buffer-substring the-buf ph-end p-end)
-	  (when (= ph-end p-beg)
-	    (goto-char (point-min))
-	    (insert ?\n))
+      (backward-char))
+    (setq position (mime-preview-entity-boundary))
+    (setq entity-node-id (mime-entity-node-id entity)
+	  header-exists
+	  ;; When on an invisible entity, there's no header.
+	  (or (mime-view-header-is-visible
+	       (get-text-property (car position) 'mime-view-situation))
+	      ;; We are on a rfc822 button.
+	      (and (eq 'message (mime-entity-media-type
+				 entity))
+		   (eq 'rfc822 (mime-entity-media-subtype
+				entity))
+		   (get-text-property
+		    (next-single-property-change
+		     (car position) 'mime-button
+		     nil (point-max))
+		    'mime-view-entity-header))))
+    (let* ((mode (mime-preview-original-major-mode 'recursive))
+	   (new-name
+	    (format "%s-%s" (buffer-name) (reverse entity-node-id)))
+	   new-buf
+	   (the-buf (current-buffer))
+	   fields)
+      (save-excursion
+	(set-buffer (setq new-buf (get-buffer-create new-name)))
+	(erase-buffer)
+	;; Compatibility kludge.
+	;; FSF Emacs can only take substring of current-buffer.
+	(insert
+	 (save-excursion
+	   (set-buffer the-buf)
+	   (buffer-substring-no-properties (car position)
+					   (cdr position))))
+	(if header-exists
+	    (delete-region (goto-char (point-min))
+			   (re-search-forward "^$"))
 	  (goto-char (point-min))
-          (let ((current-entity
-		 (if (and (eq (mime-entity-media-type entity) 'message)
-			  (eq (mime-entity-media-subtype entity) 'rfc822))
-		     (mime-entity-children entity)
-		   entity))
-		str)
-	    (while (and current-entity
-			(progn
-			  (setq str
-				(with-current-buffer
-				    (mime-entity-header-buffer current-entity)
-				  (save-restriction
-				    (narrow-to-region
-				     (mime-entity-header-start-point
-				      current-entity)
-				     (mime-entity-header-end-point
-				      current-entity))
-				    (std11-header-string-except
-				     (concat
-				      "^"
-				      (apply (function regexp-or) fields)
-				      ":") ""))))
-			  (if (and (eq (mime-entity-media-type
-					current-entity) 'message)
-				   (eq (mime-entity-media-subtype
-					current-entity) 'rfc822))
-			      nil
-			    (if str
-				(insert str)
-			      )
-			    t)))
-	      (setq fields (std11-collect-field-names)
-		    current-entity (mime-entity-parent current-entity))
-	      )
-	    )
-	  (let ((rest mime-view-following-required-fields-list)
-		field-name ret)
-	    (while rest
-	      (setq field-name (car rest))
-	      (or (std11-field-body field-name)
-		  (progn
-		    (save-excursion
-		      (set-buffer the-buf)
-		      (setq ret
-			    (when mime-mother-buffer
-			      (set-buffer mime-mother-buffer)
-			      (mime-entity-fetch-field
-			       (get-text-property (point)
-						  'mime-view-entity)
-			       field-name))))
-		    (if ret
-			(insert (concat field-name ": " ret "\n"))
-		      )))
-	      (setq rest (cdr rest))
-	      ))
-	  (mime-decode-header-in-buffer)
-	  )
-	(let ((f (cdr (assq mode mime-preview-following-method-alist))))
-	  (if (functionp f)
-	      (funcall f new-buf)
-	    (message
-	     (format
-	      "Sorry, following method for %s is not implemented yet."
-	      mode))
-	    ))
-	))))
+	  (insert "\n"))
+	(goto-char (point-min))
+	(let ((current-entity
+	       (if (and (eq (mime-entity-media-type entity) 'message)
+			(eq (mime-entity-media-subtype entity) 'rfc822))
+		   (car (mime-entity-children entity))
+		 entity)))
+	  (while (and current-entity
+		      (if (and (eq (mime-entity-media-type
+				    current-entity) 'message)
+			       (eq (mime-entity-media-subtype
+				    current-entity) 'rfc822))
+			  nil
+			(mime-insert-header current-entity fields)
+			t))
+	    (setq fields (std11-collect-field-names)
+		  current-entity (mime-entity-parent current-entity))))
+	(let ((rest mime-view-following-required-fields-list)
+	      field-name ret)
+	  (while rest
+	    (setq field-name (car rest))
+	    (or (std11-field-body field-name)
+		(progn
+		  (save-excursion
+		    (set-buffer the-buf)
+		    (let ((entity (when mime-mother-buffer
+				    (set-buffer mime-mother-buffer)
+				    (get-text-property (point)
+						       'mime-view-entity))))
+		      (while (and entity
+				  (null (setq ret (mime-entity-fetch-field
+						   entity field-name))))
+			(setq entity (mime-entity-parent entity)))))
+		  (if ret
+		      (insert (concat field-name ": " ret "\n")))))
+	    (setq rest (cdr rest))))
+	(mime-decode-header-in-buffer))
+      (let ((f (cdr (assq mode mime-preview-following-method-alist))))
+	(if (functionp f)
+	    (funcall f new-buf)
+	  (message
+	   (format
+	    "Sorry, following method for %s is not implemented yet."
+	    mode)))))))
 
 
 ;;; @@ moving
@@ -1665,8 +1698,7 @@ variable `mime-preview-over-to-previous-method-alist'."
   (interactive)
   (while (and (not (bobp))
 	      (null (get-text-property (point) 'mime-view-entity)))
-    (backward-char)
-    )
+    (backward-char))
   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
     (if (and point
 	     (>= point (point-min)))
@@ -1683,8 +1715,7 @@ variable `mime-preview-over-to-previous-method-alist'."
 				  (point)))))
 			(recenter next-screen-context-lines)))
 	  (goto-char (1- point))
-	  (mime-preview-move-to-previous)
-	  )
+	  (mime-preview-move-to-previous))
       (let ((f (assq (mime-preview-original-major-mode)
 		     mime-preview-over-to-previous-method-alist)))
 	(if f
@@ -1741,7 +1772,8 @@ If reached to (point-max), it calls function registered in variable
 	  (progn (goto-char point)
 		 (recenter next-screen-context-lines))
 	(condition-case nil
-	    (scroll-up h)
+	    (let (window-pixel-scroll-increment)
+	      (scroll-up h))
 	  (end-of-buffer
 	   (goto-char (point-max))))))))
 
@@ -1765,7 +1797,8 @@ If reached to (point-min), it calls function registered in variable
 	  (progn (goto-char point)
 		 (recenter (* -1 next-screen-context-lines)))
 	(condition-case nil
-	    (scroll-down h)
+	    (let (window-pixel-scroll-increment)
+	      (scroll-down h))
 	  (beginning-of-buffer
 	   (goto-char (point-min))))))))
 
@@ -1781,6 +1814,148 @@ If LINES is negative, scroll up LINES lines."
   (interactive "p")
   (mime-preview-scroll-down-entity (or lines 1)))
 
+(defun mime-preview-entity-boundary (&optional point)
+  (or point
+      (setq point (point)))
+  (and (eq point (point-max))
+       (setq point (1- (point-max))))
+  (let ((entity (get-text-property point 'mime-view-entity))
+	(start (previous-single-property-change (1+ point) 'mime-view-entity
+						nil (point-min)))
+	end done)
+    (if (not (mime-entity-node-id entity))
+	(setq end (point-max))
+      (while (and (mime-entity-children entity)
+		  (not done))
+	(if (not (mime-view-body-is-visible
+		  (get-text-property point 'mime-view-situation)))
+	    (setq done t)
+	  ;; If the part is shown, search the last part.
+	  (let* ((child (car (last (mime-entity-children entity))))
+		 (node-id (mime-entity-node-id child))
+		 (tmp-node-id (mime-entity-node-id
+				 (get-text-property point
+						    'mime-view-entity))))
+	    (while (or (< (length tmp-node-id)
+			  (length node-id))
+		       (not (eq (nthcdr (- (length tmp-node-id)
+					   (length node-id))
+					tmp-node-id)
+				node-id)))
+	      (setq point
+		    (next-single-property-change point 'mime-view-entity)
+		    tmp-node-id (mime-entity-node-id
+				 (get-text-property point
+						    'mime-view-entity))))
+	    (setq entity child))))
+      (setq end (next-single-property-change
+		 point 'mime-view-entity nil (point-max))))
+    (cons start end)))
+
+(defun mime-preview-toggle-header (&optional show)
+  "Toggle display of entity header.
+When prefix is given, it always displays the header."
+  (interactive "P")
+  (let ((inhibit-read-only t)
+	(mime-view-force-inline-types t)
+	(position (mime-preview-entity-boundary))
+	entity header-is-visible situation)
+    (setq entity (get-text-property (car position) 'mime-view-entity)
+	  situation (get-text-property (car position) 'mime-view-situation))
+    (setq header-is-visible (mime-view-header-is-visible situation))
+    (save-excursion
+      (delete-region (car position) (cdr position))
+      (if (or show (not header-is-visible))
+	  (mime-display-entity
+	   entity
+	   (del-alist '*entity-button
+		      (put-alist '*header 'visible
+				 situation)))
+	(mime-display-entity
+	 entity
+	 (put-alist '*entity-button
+		    'visible
+		    (put-alist '*header 'invisible
+			       situation)))))))
+
+(defun mime-preview-toggle-all-header (&optional show)
+  "Toggle display of entity header.
+When prefix is given, it always displays the header."
+  (interactive "P")
+  (let ((inhibit-read-only t)
+	(mime-view-force-inline-types t)
+	(position (mime-preview-entity-boundary))
+	entity header-is-visible situation)
+    (setq entity (get-text-property (car position) 'mime-view-entity)
+	  situation (get-text-property (car position) 'mime-view-situation))
+    (setq header-is-visible (mime-view-header-is-visible situation))
+    (save-excursion
+      (delete-region (car position) (cdr position))
+      (if (or show (not header-is-visible))
+	  (mime-display-entity
+	   entity
+	   (del-alist '*entity-button
+		      (del-alist '*header
+				 (del-alist '*header-presentation-method
+					    situation))))
+	(mime-display-entity
+	 entity
+	 (put-alist
+	  '*entity-button
+	  'visible
+	  (put-alist
+	   '*header 'invisible
+	   (put-alist '*header-presentation-method
+		      #'(lambda (entity situation)
+			  (mime-insert-header
+			   entity nil '(".*")))
+		      situation))))))))
+
+(defun mime-preview-toggle-content (&optional show)
+  "Toggle display of entity body.
+When prefix is given, it always displays the content."
+  (interactive "P")
+  (let ((inhibit-read-only t)
+	(mime-view-force-inline-types t)
+	(position (mime-preview-entity-boundary))
+	entity situation)
+    (setq entity (get-text-property (car position) 'mime-view-entity)
+	  situation (get-text-property (car position) 'mime-view-situation))
+    (setq situation
+	  (if (or show (not (mime-view-body-is-visible situation)))
+	      (del-alist
+	       '*entity-button
+	       (put-alist '*body 'visible situation))
+	    (put-alist
+	     '*entity-button 'visible
+	     (put-alist '*body 'invisible situation))))
+    (save-excursion
+      (delete-region (car position) (cdr position))
+      (mime-display-entity entity situation))))
+
+(defun mime-preview-toggle-button (&optional condition)
+  "Toggle display of entity button.
+When prefix is given, it always displays the content.
+If condition is 'hide, hide all buttons."
+  (interactive "P")
+  (let ((inhibit-read-only t)
+	(mime-view-force-inline-types t)
+	(position (mime-preview-entity-boundary))
+	entity situation button-is-visible)
+    (setq entity (get-text-property (car position) 'mime-view-entity)
+	  situation (get-text-property (car position) 'mime-view-situation)
+	  button-is-visible (mime-view-button-is-visible situation))
+    (save-excursion
+      (delete-region (car position) (cdr position))
+      (if (or (eq condition 'hide)
+	      (and (not condition) button-is-visible))
+	  (mime-display-entity entity
+			       (put-alist '*entity-button
+					  'invisible situation))
+	(mime-display-entity entity
+			     (put-alist '*entity-button
+					'visible situation))))))
+
 ;;; @@ quitting
 ;;;
 
@@ -1793,12 +1968,11 @@ It calls function registered in variable
 		 mime-preview-quitting-method-alist)))
     (if r
 	(funcall (cdr r))
-      )))
+      (kill-buffer (current-buffer)))))
 
 (defun mime-preview-kill-buffer ()
   (interactive)
-  (kill-buffer (current-buffer))
-  )
+  (kill-buffer (current-buffer)))
 
 
 ;;; @ end