X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=35c11597484c35a2091ec09897d3bba6ae370c1d;hb=refs%2Fheads%2Fsemi-pgpgpg;hp=bcd0595c92e21bd65668b4e79fe8eb5f642317a8;hpb=dbae10fbd822fdee5adea0174cd09c387eae1d1d;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index bcd0595..35c1159 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -1,6 +1,6 @@
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1994/07/13
@@ -8,7 +8,7 @@
 ;;	Renamed: 1997/02/19 from tm-view.el
 ;; Keywords: MIME, multimedia, mail, news
 
-;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces).
+;; This file is part of SEMI (Sample of Elastic MIME Interfaces).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -27,10 +27,8 @@
 
 ;;; Code:
 
-(require 'std11)
-(require 'mel)
-(require 'eword-decode)
-(require 'mime-parse)
+(require 'emu)
+(require 'mime)
 (require 'semi-def)
 (require 'calist)
 (require 'alist)
@@ -40,10 +38,11 @@
 ;;; @ version
 ;;;
 
-(defconst mime-view-version-string
-  `,(concat (car mime-module-version) " MIME-View "
-	    (mapconcat #'number-to-string (cddr mime-module-version) ".")
-	    " (" (cadr mime-module-version) ")"))
+(defconst mime-view-version
+  (concat (mime-product-name mime-user-interface-product) " MIME-View "
+	  (mapconcat #'number-to-string
+		     (mime-product-version mime-user-interface-product) ".")
+	  " (" (mime-product-code-name mime-user-interface-product) ")"))
 
 
 ;;; @ variables
@@ -63,51 +62,24 @@
   :group 'mime-view
   :type 'file)
 
+(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."
+  :group 'mime-view
+  :type '(choice (const :tag "Off" nil)
+		 (const :tag "On" t)
+		 (sexp :tag "Situation" 1)))
 
-;;; @ buffer local variables
-;;;
-
-;;; @@ in raw-buffer
+;;; @ in raw-buffer (representation space)
 ;;;
 
-(defvar mime-raw-message-info nil
-  "Information about structure of message.
-Please use reference function `mime-entity-SLOT' to get value of SLOT.
-
-Following is a list of slots of the structure:
-
-buffer			buffer includes this entity (buffer).
-node-id			node-id (list of integers)
-header-start		minimum point of header in raw-buffer
-header-end		maximum point of header in raw-buffer
-body-start		minimum point of body in raw-buffer
-body-end		maximum point of body in raw-buffer
-content-type		content-type (content-type)
-content-disposition	content-disposition (content-disposition)
-encoding		Content-Transfer-Encoding (string or nil)
-children		entities included in this entity (list of entity)
-
-If an entity includes other entities in its body, such as multipart or
-message/rfc822, `mime-entity' structures of them are included in
-`children', so the `mime-entity' structure become a tree.")
-(make-variable-buffer-local 'mime-raw-message-info)
-
-
 (defvar mime-preview-buffer nil
   "MIME-preview buffer corresponding with the (raw) buffer.")
 (make-variable-buffer-local 'mime-preview-buffer)
 
 
-(defvar mime-raw-representation-type nil
-  "Representation-type of mime-raw-buffer.
-It must be nil, `binary' or `cooked'.
-If it is nil, `mime-raw-representation-type-alist' is used as default
-value.
-Notice that this variable is usually used as buffer local variable in
-raw-buffer.")
-
-(make-variable-buffer-local 'mime-raw-representation-type)
-
 (defvar mime-raw-representation-type-alist
   '((mime-show-message-mode     . binary)
     (mime-temp-message-mode     . binary)
@@ -116,12 +88,31 @@ raw-buffer.")
   "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
-`binary' or `cooked'.
-This value is overridden by buffer local variable
-`mime-raw-representation-type' if it is not nil.")
-
-
-;;; @@ in preview-buffer
+`binary' or `cooked'.")
+
+
+;; (defun mime-raw-find-entity-from-point (point &optional message-info)
+;;   "Return entity from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (or message-info
+;;       (setq message-info mime-message-structure))
+;;   (if (and (<= (mime-entity-point-min message-info) point)
+;;            (<= point (mime-entity-point-max message-info)))
+;;       (let ((children (mime-entity-children message-info)))
+;;         (catch 'tag
+;;           (while children
+;;             (let ((ret
+;;                    (mime-raw-find-entity-from-point point (car children))))
+;;               (if ret
+;;                   (throw 'tag ret)
+;;                 ))
+;;             (setq children (cdr children)))
+;;           message-info))))
+;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.")
+
+
+;;; @ in preview-buffer (presentation space)
 ;;;
 
 (defvar mime-mother-buffer nil
@@ -130,141 +121,144 @@ If current MIME-preview buffer is generated by other buffer, such as
 message/partial, it is called `mother-buffer'.")
 (make-variable-buffer-local 'mime-mother-buffer)
 
-(defvar mime-raw-buffer nil
-  "Raw buffer corresponding with the (MIME-preview) buffer.")
-(make-variable-buffer-local 'mime-raw-buffer)
+;; (defvar mime-raw-buffer nil
+;;   "Raw buffer corresponding with the (MIME-preview) buffer.")
+;; (make-variable-buffer-local 'mime-raw-buffer)
 
 (defvar mime-preview-original-window-configuration nil
   "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)
+  "Return major-mode of original buffer.
+If optional argument RECURSIVE is non-nil and current buffer has
+mime-mother-buffer, it returns original major-mode of the
+mother-buffer."
+  (if (and recursive mime-mother-buffer)
+      (save-excursion
+	(set-buffer mime-mother-buffer)
+	(mime-preview-original-major-mode recursive)
+	)
+    (cdr (assq 'major-mode
+	       (get-text-property (or point
+				      (if (> (point) (buffer-size))
+					  (max (1- (point-max)) (point-min))
+					(point)))
+				  'mime-view-situation)))))
+
 
 ;;; @ entity information
 ;;;
 
-(defsubst mime-raw-find-entity-from-node-id (entity-node-id
-					     &optional message-info)
-  "Return entity from ENTITY-NODE-ID in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (mime-raw-find-entity-from-number (reverse entity-node-id) message-info))
-
-(defun mime-raw-find-entity-from-number (entity-number &optional message-info)
-  "Return entity from ENTITY-NUMBER in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (or message-info
-      (setq message-info mime-raw-message-info))
-  (if (eq entity-number t)
-      message-info
-    (let ((sn (car entity-number)))
-      (if (null sn)
-	  message-info
-	(let ((rc (nth sn (mime-entity-children message-info))))
-	  (if rc
-	      (mime-raw-find-entity-from-number (cdr entity-number) rc)
-	    ))
-	))))
-
-(defun mime-raw-find-entity-from-point (point &optional message-info)
-  "Return entity from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (or message-info
-      (setq message-info mime-raw-message-info))
-  (if (and (<= (mime-entity-point-min message-info) point)
-	   (<= point (mime-entity-point-max message-info)))
-      (let ((children (mime-entity-children message-info)))
-	(catch 'tag
-	  (while children
-	    (let ((ret
-		   (mime-raw-find-entity-from-point point (car children))))
-	      (if ret
-		  (throw 'tag ret)
-		))
-	    (setq children (cdr children)))
-	  message-info))))
-
-
-(defsubst mime-entity-parent (entity &optional message-info)
-  "Return mother entity of ENTITY.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' in buffer of ENTITY is used."
-  (mime-raw-find-entity-from-node-id
-   (cdr (mime-entity-node-id entity))
-   (or message-info
-       (save-excursion
-	 (set-buffer (mime-entity-buffer entity))
-	 mime-raw-message-info))))
-
-(defsubst mime-entity-situation (entity)
+(defun mime-entity-situation (entity &optional situation)
   "Return situation of ENTITY."
-  (append (or (mime-entity-content-type entity)
-	      (make-mime-content-type 'text 'plain))
-	  (list (cons 'encoding (mime-entity-encoding entity))
-		(cons 'major-mode
-		      (save-excursion
-			(set-buffer (mime-entity-buffer entity))
-			major-mode)))
-	  ))
+  (let (rest param name)
+    ;; Content-Type
+    (unless (assq 'type situation)
+      (setq rest (or (mime-entity-content-type entity)
+		     (make-mime-content-type 'text 'plain))
+	    situation (cons (car rest) situation)
+	    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))
+      )
+    (while rest
+      (setq param (car rest))
+      (or (assoc (car param) situation)
+	  (setq situation (cons param situation)))
+      (setq rest (cdr rest)))
+    
+    ;; Content-Disposition
+    (setq rest nil)
+    (unless (assq 'disposition-type situation)
+      (setq rest (mime-entity-content-disposition entity))
+      (if rest
+	  (setq situation (cons (cons 'disposition-type
+				      (mime-content-disposition-type rest))
+				situation)
+		rest (mime-content-disposition-parameters rest))
+	))
+    (while rest
+      (setq param (car rest)
+	    name (car param))
+      (if (cond ((string= name "filename")
+		 (if (assq 'filename situation)
+		     nil
+		   (setq name 'filename)))
+		((string= name "creation-date")
+		 (if (assq 'creation-date situation)
+		     nil
+		   (setq name 'creation-date)))
+		((string= name "modification-date")
+		 (if (assq 'modification-date situation)
+		     nil
+		   (setq name 'modification-date)))
+		((string= name "read-date")
+		 (if (assq 'read-date situation)
+		     nil
+		   (setq name 'read-date)))
+		((string= name "size")
+		 (if (assq 'size situation)
+		     nil
+		   (setq name 'size)))
+		(t (setq name (cons 'disposition name))
+		   (if (assoc name situation)
+		       nil
+		     name)))
+	  (setq situation
+		(cons (cons name (cdr param))
+		      situation)))
+      (setq rest (cdr rest)))
+    
+    ;; Content-Transfer-Encoding
+    (or (assq 'encoding situation)
+	(setq situation
+	      (cons (cons 'encoding (or (mime-entity-encoding entity)
+					"7bit"))
+		    situation)))
+    
+    situation))
+
+(defun mime-view-entity-title (entity)
+  (or (mime-entity-read-field entity 'Content-Description)
+      (mime-entity-read-field entity 'Subject)
+      (mime-entity-filename entity)
+      ""))
 
 
-(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
+;; (defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
+;;   "Return entity-node-id from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
 
-(defun mime-raw-get-uu-filename ()
-  (save-excursion
-    (if (re-search-forward "^begin [0-9]+ " nil t)
-	(if (looking-at ".+$")
-	    (buffer-substring (match-beginning 0)(match-end 0))
-	  ))))
+;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.")
 
-(defun mime-raw-get-subject (entity)
-  (or (std11-find-field-body '("Content-Description" "Subject"))
-      (let ((ret (mime-entity-content-disposition entity)))
-	(and ret
-	     (setq ret (mime-content-disposition-filename ret))
-	     (std11-strip-quoted-string ret)
-	     ))
-      (let ((ret (mime-entity-content-type entity)))
-	(and ret
-	     (setq ret
-		   (cdr
-		    (let ((param (mime-content-type-parameters ret)))
-		      (or (assoc "name" param)
-			  (assoc "x-name" param))
-		      )))
-	     (std11-strip-quoted-string ret)
-	     ))
-      (if (member (mime-entity-encoding entity)
-		  mime-view-uuencode-encoding-name-list)
-	  (mime-raw-get-uu-filename))
-      ""))
+;; (defsubst mime-raw-point-to-entity-number (point &optional message-info)
+;;   "Return entity-number from POINT in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
 
+;; (make-obsolete 'mime-raw-point-to-entity-number "don't use it.")
 
-(defsubst mime-raw-point-to-entity-node-id (point &optional message-info)
-  "Return entity-node-id from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (mime-entity-node-id (mime-raw-find-entity-from-point point message-info)))
-
-(defsubst mime-raw-point-to-entity-number (point &optional message-info)
-  "Return entity-number from POINT in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (mime-entity-number (mime-raw-find-entity-from-point point message-info)))
-
-(defun mime-raw-flatten-message-info (&optional message-info)
-  "Return list of entity in mime-raw-buffer.
-If optional argument MESSAGE-INFO is not specified,
-`mime-raw-message-info' is used."
-  (or message-info
-      (setq message-info mime-raw-message-info))
-  (let ((dest (list message-info))
-	(rcl (mime-entity-children message-info)))
-    (while rcl
-      (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
-      (setq rcl (cdr rcl)))
-    dest))
+;; (defun mime-raw-flatten-message-info (&optional message-info)
+;;   "Return list of entity in mime-raw-buffer.
+;; If optional argument MESSAGE-INFO is not specified,
+;; `mime-message-structure' is used."
+;;   (or message-info
+;;       (setq message-info mime-message-structure))
+;;   (let ((dest (list message-info))
+;;         (rcl (mime-entity-children message-info)))
+;;     (while rcl
+;;       (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl))))
+;;       (setq rcl (cdr rcl)))
+;;     dest))
 
 
 ;;; @ presentation of preview
@@ -295,10 +289,11 @@ Please redefine this function if you want to change default setting."
 ;;; @@@ entity button generator
 ;;;
 
-(defun mime-view-insert-entity-button (entity subject)
+(defun mime-view-insert-entity-button (entity)
   "Insert entity-button of ENTITY."
   (let ((entity-node-id (mime-entity-node-id entity))
-	(params (mime-entity-parameters entity)))
+	(params (mime-entity-parameters entity))
+	(subject (mime-view-entity-title entity)))
     (mime-insert-button
      (let ((access-type (assoc "access-type" params))
 	   (num (or (cdr (assoc "x-part-number" params))
@@ -318,9 +313,13 @@ Please redefine this function if you want to change default setting."
 			    num subject access-type (cdr server))
 		(let ((site (cdr (assoc "site" params)))
 		      (dir (cdr (assoc "directory" params)))
+		      (url (cdr (assoc "url" params)))
 		      )
-		  (format "%s %s ([%s] %s:%s)"
-			  num subject access-type site dir)
+		  (if url
+		      (format "%s %s ([%s] %s)"
+			      num subject access-type url)
+		    (format "%s %s ([%s] %s:%s)"
+			    num subject access-type site dir))
 		  )))
 	    )
 	   (t
@@ -350,58 +349,25 @@ Please redefine this function if you want to change default setting."
 ;;; @@ entity-header
 ;;;
 
-;;; @@@ entity header filter
-;;;
-
-(defvar mime-view-content-header-filter-alist nil)
-
-(defun mime-view-default-content-header-filter ()
-  (mime-view-cut-header)
-  (eword-decode-header)
-  )
-
-;;; @@@ entity field cutter
-;;;
+(defvar mime-header-presentation-method-alist nil
+  "Alist of major mode vs. corresponding header-presentation-method functions.
+Each element looks like (SYMBOL . FUNCTION).
+SYMBOL must be major mode in raw-buffer or t.  t means default.
+Interface of FUNCTION must be (ENTITY SITUATION).")
 
 (defvar mime-view-ignored-field-list
-  '(".*Received" ".*Path" ".*Id" "References"
-    "Replied" "Errors-To"
-    "Lines" "Sender" ".*Host" "Xref"
-    "Content-Type" "Precedence"
-    "Status" "X-VM-.*")
+  '(".*Received:" ".*Path:" ".*Id:" "^References:"
+    "^Replied:" "^Errors-To:"
+    "^Lines:" "^Sender:" ".*Host:" "^Xref:"
+    "^Content-Type:" "^Precedence:"
+    "^Status:" "^X-VM-.*:")
   "All fields that match this list will be hidden in MIME preview buffer.
 Each elements are regexp of field-name.")
 
-(defvar mime-view-ignored-field-regexp
-  (concat "^"
-	  (apply (function regexp-or) mime-view-ignored-field-list)
-	  ":"))
-
-(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id")
+(defvar mime-view-visible-field-list '("^Dnas.*:" "^Message-Id:")
   "All fields that match this list will be displayed in MIME preview buffer.
 Each elements are regexp of field-name.")
 
-(defun mime-view-cut-header ()
-  (goto-char (point-min))
-  (while (re-search-forward mime-view-ignored-field-regexp nil t)
-    (let* ((beg (match-beginning 0))
-	   (end (match-end 0))
-	   (name (buffer-substring beg end))
-	   )
-      (catch 'visible
-	(let ((rest mime-view-visible-field-list))
-	  (while rest
-	    (if (string-match (car rest) name)
-		(throw 'visible nil)
-	      )
-	    (setq rest (cdr rest))))
-	(delete-region beg
-		       (save-excursion
-			 (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
-			     (match-beginning 0)
-			   (point-max))))
-	))))
-
 
 ;;; @@ entity-body
 ;;;
@@ -409,6 +375,8 @@ Each elements are regexp of field-name.")
 ;;; @@@ predicate function
 ;;;
 
+(in-calist-package 'mime-view)
+
 (defun mime-calist::field-match-method-as-default-rule (calist
 							field-type field-value)
   (let ((s-field (assq field-type calist)))
@@ -463,42 +431,48 @@ Each elements are regexp of field-name.")
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((body . visible)
-   (body-presentation-method . mime-preview-text/plain)))
+   (body-presentation-method . mime-display-text/plain)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . nil)
    (body . visible)
-   (body-presentation-method . mime-preview-text/plain)))
+   (body-presentation-method . mime-display-text/plain)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . enriched)
    (body . visible)
-   (body-presentation-method . mime-preview-text/enriched)))
+   (body-presentation-method . mime-display-text/enriched)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . richtext)
    (body . visible)
-   (body-presentation-method . mime-preview-text/richtext)))
+   (body-presentation-method . mime-display-text/richtext)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . application)(subtype . x-postpet)
+   (body . visible)
+   (body-presentation-method . mime-display-application/x-postpet)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . t)
    (body . visible)
-   (body-presentation-method . mime-preview-text/plain)))
+   (body-presentation-method . mime-display-text/plain)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . multipart)(subtype . alternative)
    (body . visible)
-   (body-presentation-method . mime-preview-multipart/alternative)))
+   (body-presentation-method . mime-display-multipart/alternative)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition '((type . message)(subtype . partial)
 			   (body-presentation-method
-			    . mime-preview-message/partial-button)))
+			    . mime-display-message/partial-button)))
 
 (ctree-set-calist-strictly
  'mime-preview-condition '((type . message)(subtype . rfc822)
@@ -516,9 +490,137 @@ Each elements are regexp of field-name.")
 ;;; @@@ entity presentation
 ;;;
 
-(autoload 'mime-preview-text/plain "mime-text")
-(autoload 'mime-preview-text/enriched "mime-text")
-(autoload 'mime-preview-text/richtext "mime-text")
+(defun mime-display-text/plain (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (goto-char (point-max))
+    (if (not (eq (char-after (1- (point))) ?\n))
+	(insert "\n")
+      )
+    (mime-add-url-buttons)
+    (run-hooks 'mime-display-text/plain-hook)
+    ))
+
+(defun mime-display-text/richtext (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (let ((beg (point-min)))
+      (remove-text-properties beg (point-max) '(face nil))
+      (richtext-decode beg (point-max))
+      )))
+
+(defun mime-display-text/enriched (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (mime-insert-text-content entity)
+    (run-hooks 'mime-text-decode-hook)
+    (let ((beg (point-min)))
+      (remove-text-properties beg (point-max) '(face nil))
+      (enriched-decode beg (point-max))
+      )))
+
+(put 'unpack 'lisp-indent-function 1)
+(defmacro unpack (string &rest body)
+  `(let* ((*unpack*string* (string-as-unibyte ,string))
+	  (*unpack*index* 0))
+     ,@body))
+
+(defun unpack-skip (len)
+  (setq *unpack*index* (+ len *unpack*index*)))
+
+(defun unpack-fixed (len)
+  (prog1
+      (substring *unpack*string* *unpack*index* (+ *unpack*index* len))
+    (unpack-skip len)))
+
+(defun unpack-byte ()
+  (char-int (aref (unpack-fixed 1) 0)))
+
+(defun unpack-short ()
+  (let* ((b0 (unpack-byte))
+	 (b1 (unpack-byte)))
+    (+ (* 256 b0) b1)))
+
+(defun unpack-long ()
+  (let* ((s0 (unpack-short))
+	 (s1 (unpack-short)))
+    (+ (* 65536 s0) s1)))
+
+(defun unpack-string ()
+  (let ((len (unpack-byte)))
+    (unpack-fixed len)))
+
+(defun unpack-string-sjis ()
+  (decode-mime-charset-string (unpack-string) 'shift_jis))
+
+(defun postpet-decode (string)
+  (condition-case nil
+      (unpack string
+	(let (res)
+	  (unpack-skip 4)
+	  (set-alist 'res 'carryingcount (unpack-long))
+	  (unpack-skip 8)
+	  (set-alist 'res 'sentyear (unpack-short))
+	  (set-alist 'res 'sentmonth (unpack-short))
+	  (set-alist 'res 'sentday (unpack-short))
+	  (unpack-skip 8)
+	  (set-alist 'res 'petname (unpack-string-sjis))
+	  (set-alist 'res 'owner (unpack-string-sjis))
+	  (set-alist 'res 'pettype (unpack-fixed 4))
+	  (set-alist 'res 'health (unpack-short))
+	  (unpack-skip 2)
+	  (set-alist 'res 'sex (unpack-long))
+	  (unpack-skip 1)
+	  (set-alist 'res 'brain (unpack-byte))
+	  (unpack-skip 39)
+	  (set-alist 'res 'happiness (unpack-byte))
+	  (unpack-skip 14)
+	  (set-alist 'res 'petbirthyear (unpack-short))
+	  (set-alist 'res 'petbirthmonth (unpack-short))
+	  (set-alist 'res 'petbirthday (unpack-short))
+	  (unpack-skip 8)
+	  (set-alist 'res 'from (unpack-string))
+	  (unpack-skip 5)
+	  (unpack-skip 160)
+	  (unpack-skip 4)
+	  (unpack-skip 8)
+	  (unpack-skip 8)
+	  (unpack-skip 26)
+	  (set-alist 'res 'treasure (unpack-short))
+	  (set-alist 'res 'money (unpack-long))
+	  res))
+    (error nil)))
+
+(defun mime-display-application/x-postpet (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (let ((pet (postpet-decode (mime-entity-content entity))))
+      (if pet
+	  (insert "Petname: " (cdr (assq 'petname pet)) "\n"
+		  "Owner: " (cdr (assq 'owner pet)) "\n"
+		  "Pettype: " (cdr (assq 'pettype pet)) "\n"
+		  "From: " (cdr (assq 'from pet)) "\n"
+		  "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet))) "\n"
+		  "SentYear: " (int-to-string (cdr (assq 'sentyear pet))) "\n"
+		  "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet))) "\n"
+		  "SentDay: " (int-to-string (cdr (assq 'sentday pet))) "\n"
+		  "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet))) "\n"
+		  "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet))) "\n"
+		  "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet))) "\n"
+		  "Health: " (int-to-string (cdr (assq 'health pet))) "\n"
+		  "Sex: " (int-to-string (cdr (assq 'sex pet))) "\n"
+		  "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"
+		  )
+	(insert "Invalid format\n"))
+      (run-hooks 'mime-display-application/x-postpet-hook))))
+
 
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
@@ -531,7 +633,7 @@ Each elements are regexp of field-name.")
 \[[ Please press `v' key in this buffer.         ]]"
     ))
 
-(defun mime-preview-message/partial-button (&optional entity situation)
+(defun mime-display-message/partial-button (&optional entity situation)
   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
@@ -544,17 +646,16 @@ Each elements are regexp of field-name.")
 		     #'mime-preview-play-current-entity)
     ))
 
-(defun mime-preview-multipart/mixed (entity situation)
+(defun mime-display-multipart/mixed (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)))
     (while children
-      (mime-view-display-entity (car children)
-				(save-excursion
-				  (set-buffer (mime-entity-buffer entity))
-				  mime-raw-message-info)
-				(current-buffer)
-				default-situation)
+      (mime-display-entity (car children) nil default-situation)
       (setq children (cdr children))
       )))
 
@@ -567,20 +668,26 @@ Each elements are regexp of field-name.")
 MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
   :group 'mime-view
   :type '(repeat (cons (choice :tag "Media-Type"
-			       (item :tag "Type/Subtype"
-				     (cons symbol symbol))
-			       (item :tag "Type" symbol)
-			       (item :tag "Default" t))
+			       (cons :tag "Type/Subtype"
+				     (symbol :tag "Primary-type")
+				     (symbol :tag "Subtype"))
+			       (symbol :tag "Type")
+			       (const :tag "Default" t))
 		       integer)))
 
-(defun mime-preview-multipart/alternative (entity situation)
+(defun mime-display-multipart/alternative (entity situation)
   (let* ((children (mime-entity-children entity))
+	 (original-major-mode-cell (assq 'major-mode situation))
 	 (default-situation
 	   (cdr (assq 'childrens-situation situation)))
 	 (i 0)
 	 (p 0)
 	 (max-score 0)
-	 (situations
+	 situations)
+    (if original-major-mode-cell
+	(setq default-situation
+	      (cons original-major-mode-cell default-situation)))
+    (setq situations
 	  (mapcar (function
 		   (lambda (child)
 		     (let ((situation
@@ -611,21 +718,15 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 		       (setq i (1+ i))
 		       situation)
 		     ))
-		  children)))
+		  children))
     (setq i 0)
     (while children
       (let ((child (car children))
 	    (situation (car situations)))
-	(mime-view-display-entity child
-				  (save-excursion
-				    (set-buffer (mime-entity-buffer child))
-				    mime-raw-message-info)
-				  (current-buffer)
-				  default-situation
-				  (if (= i p)
-				      situation
-				    (del-alist 'body-presentation-method
-					       (copy-alist situation))))
+	(mime-display-entity child (if (= i p)
+				       situation
+				     (del-alist 'body-presentation-method
+						(copy-alist situation))))
 	)
       (setq children (cdr children)
 	    situations (cdr situations)
@@ -668,97 +769,58 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 	(setq entries (cdr entries))
 	)))
 
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . t)(subtype . t)(mode . "extract")
-;;    (method . mime-method-to-save)))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . application)(subtype . octet-stream)
+   (mode . "play")
+   (method . mime-detect-content)
+   ))
+
 (ctree-set-calist-with-default
  'mime-acting-condition
  '((mode . "extract")
-   (method . mime-method-to-save)))
-
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . text)(subtype . plain)(mode . "play")
-;;    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . text)(subtype . plain)(mode . "print")
-;;    (method "tm-plain" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . text)(subtype . html)(mode . "play")
-;;    (method "tm-html" nil 'file "" 'encoding 'mode 'name)
-;;    ))
+   (method . mime-save-content)))
+
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47)(mode . "play")
-   (method . mime-method-to-display-caesar)
+   (method . mime-view-caesar)
    ))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . text)(subtype . x-rot13-47-48)(mode . "play")
-   (method . mime-method-to-display-caesar)
+   (method . mime-view-caesar)
    ))
 
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . audio)(subtype . basic)(mode . "play")
-;;    (method "tm-au" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . image)(mode . "play")
-;;    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . image)(mode . "print")
-;;    (method "tm-image" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . video)(subtype . mpeg)(mode . "play")
-;;    (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . application)(subtype . postscript)(mode . "play")
-;;    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-;; (ctree-set-calist-strictly
-;;  'mime-acting-condition
-;;  '((type . application)(subtype . postscript)(mode . "print")
-;;    (method "tm-ps" nil 'file "" 'encoding 'mode 'name)
-;;    ))
-
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . rfc822)(mode . "play")
-   (method . mime-method-to-display-message/rfc822)
+   (method . mime-view-message/rfc822)
    ))
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . partial)(mode . "play")
-   (method . mime-method-to-store-message/partial)
+   (method . mime-store-message/partial-piece)
    ))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
-   (method . mime-method-to-display-message/external-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)
    ))
 
 (ctree-set-calist-strictly
  'mime-acting-condition
  '((type . application)(subtype . octet-stream)
-   (method . mime-method-to-save)
+   (method . mime-save-content)
    ))
 
 
@@ -770,78 +832,33 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
      . mime-preview-quitting-method-for-mime-show-message-mode))
   "Alist of major-mode vs. quitting-method of mime-view.")
 
-(defvar mime-view-over-to-previous-method-alist nil)
-(defvar mime-view-over-to-next-method-alist nil)
+(defvar mime-preview-over-to-previous-method-alist nil
+  "Alist of major-mode vs. over-to-previous-method of mime-view.")
 
-(defvar mime-view-show-summary-method nil
-  "Alist of major-mode vs. show-summary-method.")
+(defvar mime-preview-over-to-next-method-alist nil
+  "Alist of major-mode vs. over-to-next-method of mime-view.")
 
 
 ;;; @ following method
 ;;;
 
-(defvar mime-view-following-method-alist nil
+(defvar mime-preview-following-method-alist nil
   "Alist of major-mode vs. following-method of mime-view.")
 
 (defvar mime-view-following-required-fields-list
   '("From"))
 
 
-;;; @ X-Face
-;;;
-
-;; hack from Gnus 5.0.4.
-
-(defvar mime-view-x-face-to-pbm-command
-  "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm")
-
-(defvar mime-view-x-face-command
-  (concat mime-view-x-face-to-pbm-command
-	  " | xv -quit -")
-  "String to be executed to display an X-Face field.
-The command will be executed in a sub-shell asynchronously.
-The compressed face will be piped to this command.")
-
-(defun mime-view-x-face-function ()
-  "Function to display X-Face field. You can redefine to customize."
-  ;; 1995/10/12 (c.f. tm-eng:130)
-  ;;	fixed by Eric Ding <ericding@San-Jose.ate.slb.com>
-  (save-restriction
-    (narrow-to-region (point-min) (re-search-forward "^$" nil t))
-    ;; end
-    (goto-char (point-min))
-    (if (re-search-forward "^X-Face:[ \t]*" nil t)
-	(let ((beg (match-end 0))
-	      (end (std11-field-end))
-	      )
-	  (call-process-region beg end "sh" nil 0 nil
-			       "-c" mime-view-x-face-command)
-	  ))))
-
-
 ;;; @ buffer setup
 ;;;
 
-(defun mime-view-display-entity (entity message-info obuf
-					default-situation
-					&optional situation)
-  (let* ((raw-buffer (mime-entity-buffer entity))
-	 (start (mime-entity-point-min entity))
-	 (end (mime-entity-point-max entity))
-	 original-major-mode end-of-header e nb ne subj)
-    (set-buffer raw-buffer)
-    (setq original-major-mode major-mode)
-    (goto-char start)
-    (setq end-of-header (if (re-search-forward "^$" nil t)
-			    (1+ (match-end 0))
-			  end))
-    (if (> end-of-header end)
-	(setq end-of-header end)
-      )
-    (save-restriction
-      (narrow-to-region start end)
-      (setq subj (eword-decode-string (mime-raw-get-subject entity)))
-      )
+(defun mime-display-entity (entity &optional situation
+				   default-situation preview-buffer)
+  (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
@@ -852,43 +869,41 @@ The compressed face will be piped to this command.")
 	   (eq (cdr (assq 'entity-button situation)) 'invisible))
 	  (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-presentation-method
 	   (cdr (assq 'body-presentation-method situation)))
 	  (children (mime-entity-children entity)))
-      (set-buffer obuf)
+      (set-buffer preview-buffer)
       (setq nb (point))
       (narrow-to-region nb nb)
       (or button-is-invisible
 	  (if (mime-view-entity-button-visible-p entity)
-	      (mime-view-insert-entity-button entity subj)
+	      (mime-view-insert-entity-button entity)
 	    ))
-      (if header-is-visible
-	  (save-restriction
-	    (narrow-to-region (point)(point))
-	    (insert-buffer-substring raw-buffer start end-of-header)
-	    (let ((f (cdr (assq original-major-mode
-				mime-view-content-header-filter-alist))))
-	      (if (functionp f)
-		  (funcall f)
-		(mime-view-default-content-header-filter)
-		))
-	    (run-hooks 'mime-view-content-header-filter-hook)
-	    ))
-      (cond ((eq body-presentation-method 'with-filter)
-	     (let ((body-filter (cdr (assq 'body-filter situation))))
-	       (save-restriction
-		 (narrow-to-region (point-max)(point-max))
-		 (insert-buffer-substring raw-buffer end-of-header end)
-		 (funcall body-filter situation)
-		 )))
-	    (children)
-	    ((functionp body-presentation-method)
+      (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)
+            ((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 subj)
+	       (mime-view-insert-entity-button entity)
 	       )
 	     (or header-is-visible
 		 (progn
@@ -898,13 +913,14 @@ The compressed face will be piped to this command.")
 	     ))
       (setq ne (point-max))
       (widen)
-      (put-text-property nb ne 'mime-view-raw-buffer raw-buffer)
       (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-preview-multipart/mixed entity situation)
+	    (mime-display-multipart/mixed entity situation)
 	    ))
       )))
 
@@ -922,11 +938,10 @@ The compressed face will be piped to this command.")
     (play	 "Play current entity"     mime-preview-play-current-entity)
     (extract	 "Extract current entity"  mime-preview-extract-current-entity)
     (print	 "Print current entity"    mime-preview-print-current-entity)
-    (x-face	 "Show X Face"             mime-preview-display-x-face)
     )
   "Menu for MIME Viewer")
 
-(cond (running-xemacs
+(cond ((featurep 'xemacs)
        (defvar mime-view-xemacs-popup-menu
 	 (cons mime-view-menu-title
 	       (mapcar (function
@@ -982,8 +997,6 @@ The compressed face will be piped to this command.")
     (define-key mime-view-mode-map
       "q"        (function mime-preview-quit))
     (define-key mime-view-mode-map
-      "h"        (function mime-preview-show-summary))
-    (define-key mime-view-mode-map
       "\C-c\C-x" (function mime-preview-kill-buffer))
     ;; (define-key mime-view-mode-map
     ;;   "<"        (function beginning-of-buffer))
@@ -998,7 +1011,7 @@ The compressed face will be piped to this command.")
     (define-key mime-view-mode-map
       [backspace] (function mime-preview-scroll-down-entity))
     (if (functionp default)
-	(cond (running-xemacs
+	(cond ((featurep 'xemacs)
 	       (set-keymap-default-binding mime-view-mode-map default)
 	       )
 	      (t
@@ -1009,7 +1022,7 @@ The compressed face will be piped to this command.")
 	(define-key mime-view-mode-map
 	  mouse-button-2 (function mime-button-dispatcher))
       )
-    (cond (running-xemacs
+    (cond ((featurep 'xemacs)
 	   (define-key mime-view-mode-map
 	     mouse-button-3 (function mime-view-xemacs-popup-menu))
 	   )
@@ -1047,33 +1060,45 @@ The compressed face will be piped to this command.")
 
 (defvar mime-view-redisplay nil)
 
-(defun mime-view-display-message (message &optional preview-buffer
-					  mother default-keymap-or-function)
+;;;###autoload
+(defun mime-display-message (message &optional preview-buffer
+				     mother default-keymap-or-function
+				     original-major-mode)
+  "View MESSAGE in MIME-View mode.
+
+Optional argument PREVIEW-BUFFER specifies the buffer of the
+presentation.  It must be either nil or a name of preview buffer.
+
+Optional argument MOTHER specifies mother-buffer of the preview-buffer.
+
+Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
+function.  If it is a keymap, keymap of MIME-View mode will be added
+to it.  If it is a function, it will be bound as default binding of
+keymap of MIME-View mode."
   (mime-maybe-hide-echo-buffer)
-  (let ((win-conf (current-window-configuration))
-	(raw-buffer (mime-entity-buffer message)))
+  (let ((win-conf (current-window-configuration)))
     (or preview-buffer
 	(setq preview-buffer
-	      (concat "*Preview-" (buffer-name raw-buffer) "*")))
-    (set-buffer raw-buffer)
-    (setq mime-raw-message-info (mime-parse-message))
-    (setq mime-preview-buffer 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)))
     (let ((inhibit-read-only t))
-      (switch-to-buffer preview-buffer)
+      (set-buffer (get-buffer-create preview-buffer))
       (widen)
       (erase-buffer)
-      (setq mime-raw-buffer raw-buffer)
       (if 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-view-display-entity message message
-				preview-buffer
-				'((entity-button . invisible)
-				  (header . visible)
-				  ))
+      (mime-display-entity message nil
+			   `((entity-button . invisible)
+			     (header . visible)
+			     (major-mode . ,original-major-mode))
+			   preview-buffer)
       (mime-view-define-keymap default-keymap-or-function)
       (let ((point
 	     (next-single-property-change (point-min) 'mime-view-entity)))
@@ -1083,20 +1108,49 @@ The compressed face will be piped to this command.")
 	  (search-forward "\n\n" nil t)
 	  ))
       (run-hooks 'mime-view-mode-hook)
-      ))
-  (set-buffer-modified-p nil)
-  (setq buffer-read-only t)
-  )
+      (set-buffer-modified-p nil)
+      (setq buffer-read-only t)
+      preview-buffer)))
 
+;;;###autoload
 (defun mime-view-buffer (&optional raw-buffer preview-buffer mother
-				   default-keymap-or-function)
+				   default-keymap-or-function
+				   representation-type)
+  "View RAW-BUFFER in MIME-View mode.
+Optional argument PREVIEW-BUFFER is either nil or a name of preview
+buffer.
+Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or
+function.  If it is a keymap, keymap of MIME-View mode will be added
+to it.  If it is a function, it will be bound as default binding of
+keymap of MIME-View mode.
+Optional argument REPRESENTATION-TYPE is representation-type of
+message.  It must be nil, `binary' or `cooked'.  If it is nil,
+`cooked' is used as default."
   (interactive)
-  (mime-view-display-message
-   (save-excursion
-     (if raw-buffer (set-buffer raw-buffer))
-     (mime-parse-message)
-     )
-   preview-buffer mother default-keymap-or-function))
+  (or raw-buffer
+      (setq raw-buffer (current-buffer)))
+  (or representation-type
+      (setq representation-type
+	    (save-excursion
+	      (set-buffer raw-buffer)
+	      (cdr (or (assq major-mode mime-raw-representation-type-alist)
+		       (assq t mime-raw-representation-type-alist)))
+	      )))
+  (if (eq representation-type 'binary)
+      (setq representation-type 'buffer)
+    )
+  (setq preview-buffer (mime-display-message
+			(mime-open-entity representation-type raw-buffer)
+			preview-buffer mother default-keymap-or-function))
+  (or (get-buffer-window preview-buffer)
+      (let ((r-win (get-buffer-window raw-buffer)))
+	(if r-win
+	    (set-window-buffer r-win preview-buffer)
+	  (let ((m-win (and mother (get-buffer-window mother))))
+	    (if m-win
+		(set-window-buffer m-win preview-buffer)
+	      (switch-to-buffer preview-buffer)
+	      ))))))
 
 (defun mime-view-mode (&optional mother ctl encoding
 				 raw-buffer preview-buffer
@@ -1119,19 +1173,32 @@ v		Decode current content as `play mode'
 e		Decode current content as `extract mode'
 C-c C-p		Decode current content as `print mode'
 a		Followup to current content.
-x		Display X-Face
 q		Quit
 button-2	Move to point under the mouse cursor
         	and decode current content as `play mode'
 "
   (interactive)
-  (mime-view-display-message
-   (save-excursion
-     (if raw-buffer (set-buffer raw-buffer))
-     (or mime-view-redisplay
-	 (mime-parse-message ctl encoding))
-     )
-   preview-buffer mother default-keymap-or-function))
+  (unless mime-view-redisplay
+    (save-excursion
+      (if raw-buffer (set-buffer raw-buffer))
+      (let ((type
+	     (cdr
+	      (or (assq major-mode mime-raw-representation-type-alist)
+		  (assq t mime-raw-representation-type-alist)))))
+	(if (eq type 'binary)
+	    (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))
+	)
+      (or (mime-entity-encoding mime-message-structure)
+	  (mime-entity-set-encoding-internal mime-message-structure encoding))
+      ))
+  (mime-display-message mime-message-structure preview-buffer
+			mother default-keymap-or-function)
+  )
 
 
 ;;; @@ playing
@@ -1140,47 +1207,32 @@ button-2	Move to point under the mouse cursor
 (autoload 'mime-preview-play-current-entity "mime-play"
   "Play current entity." t)
 
-(defun mime-preview-extract-current-entity ()
+(defun mime-preview-extract-current-entity (&optional ignore-examples)
   "Extract current entity into file (maybe).
 It decodes current entity to call internal or external method as
 \"extract\" mode.  The method is selected from variable
 `mime-acting-condition'."
-  (interactive)
-  (mime-preview-play-current-entity "extract")
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "extract")
   )
 
-(defun mime-preview-print-current-entity ()
+(defun mime-preview-print-current-entity (&optional ignore-examples)
   "Print current entity (maybe).
 It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable
 `mime-acting-condition'."
-  (interactive)
-  (mime-preview-play-current-entity "print")
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "print")
   )
 
 
 ;;; @@ following
 ;;;
 
-(defun mime-preview-original-major-mode (&optional recursive)
-  "Return major-mode of original buffer.
-If a current buffer has mime-mother-buffer, return original major-mode
-of the mother-buffer."
-  (if (and recursive mime-mother-buffer)
-      (save-excursion
-	(set-buffer mime-mother-buffer)
-	(mime-preview-original-major-mode recursive)
-	)
-    (save-excursion
-      (set-buffer
-       (mime-entity-buffer
-	(get-text-property (point-min) 'mime-view-entity)))
-      major-mode)))
-
 (defun mime-preview-follow-current-entity ()
   "Write follow message to current entity.
 It calls following-method selected from variable
-`mime-view-following-method-alist'."
+`mime-preview-following-method-alist'."
   (interactive)
   (let (entity)
     (while (null (setq entity
@@ -1190,6 +1242,7 @@ It calls following-method selected from variable
     (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))
 	   )
@@ -1233,69 +1286,84 @@ It calls following-method selected from variable
 		 (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))
-	     (a-buf mime-raw-buffer)
 	     fields)
 	(save-excursion
 	  (set-buffer (setq new-buf (get-buffer-create new-name)))
 	  (erase-buffer)
-	  (insert-buffer-substring the-buf p-beg p-end)
+	  (insert-buffer-substring the-buf ph-end p-end)
+	  (when (= ph-end p-beg)
+	    (goto-char (point-min))
+	    (insert ?\n))
 	  (goto-char (point-min))
-          (let ((entity-node-id (mime-entity-node-id entity)) ci str)
-	    (while (progn
-		     (setq
-		      str
-		      (save-excursion
-			(set-buffer a-buf)
-			(setq
-			 ci
-			 (mime-raw-find-entity-from-node-id entity-node-id))
-			(save-restriction
-			  (narrow-to-region
-			   (mime-entity-point-min ci)
-			   (mime-entity-point-max ci)
-			   )
-			  (std11-header-string-except
-			   (concat "^"
-				   (apply (function regexp-or) fields)
-				   ":") ""))))
-		     (if (and
-			  (eq (mime-entity-media-type ci) 'message)
-			  (eq (mime-entity-media-subtype ci) 'rfc822))
-			 nil
-		       (if str
-			   (insert str)
-			 )
-		       entity-node-id))
+          (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)
-		    entity-node-id (cdr entity-node-id))
+		    current-entity (mime-entity-parent current-entity))
 	      )
 	    )
-	  (let ((rest mime-view-following-required-fields-list))
+	  (let ((rest mime-view-following-required-fields-list)
+		field-name ret)
 	    (while rest
-	      (let ((field-name (car rest)))
-		(or (std11-field-body field-name)
-		    (insert
-		     (format
-		      (concat field-name
-			      ": "
-			      (save-excursion
-				(set-buffer the-buf)
-				(set-buffer mime-mother-buffer)
-				(set-buffer mime-raw-buffer)
-				(std11-field-body field-name)
-				)
-			      "\n")))
-		    ))
+	      (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))
 	      ))
-	  (eword-decode-header)
+	  (mime-decode-header-in-buffer)
 	  )
-	(let ((f (cdr (assq mode mime-view-following-method-alist))))
+	(let ((f (cdr (assq mode mime-preview-following-method-alist))))
 	  (if (functionp f)
 	      (funcall f new-buf)
 	    (message
@@ -1306,17 +1374,6 @@ It calls following-method selected from variable
 	))))
 
 
-;;; @@ X-Face
-;;;
-
-(defun mime-preview-display-x-face ()
-  (interactive)
-  (save-window-excursion
-    (set-buffer mime-raw-buffer)
-    (mime-view-x-face-function)
-    ))
-
-
 ;;; @@ moving
 ;;;
 
@@ -1329,16 +1386,23 @@ If there is no upper entity, call function `mime-preview-quit'."
 		       (get-text-property (point) 'mime-view-entity)))
       (backward-char)
       )
-    (let ((r (mime-raw-find-entity-from-node-id
-	      (cdr (mime-entity-node-id cinfo))
-	      (get-text-property 1 'mime-view-entity)))
+    (let ((r (mime-entity-parent cinfo))
 	  point)
       (catch 'tag
 	(while (setq point (previous-single-property-change
 			    (point) 'mime-view-entity))
 	  (goto-char point)
-	  (if (eq r (get-text-property (point) 'mime-view-entity))
-	      (throw 'tag t)
+	  (when (eq r (get-text-property (point) 'mime-view-entity))
+	    (if (or (eq mime-preview-move-scroll t)
+		    (and mime-preview-move-scroll
+			 (>= point
+			     (save-excursion
+			       (move-to-window-line -1)
+			       (forward-line (* -1 next-screen-context-lines))
+			       (beginning-of-line)
+			       (point)))))
+		(recenter next-screen-context-lines))
+	    (throw 'tag t)
 	    )
 	  )
 	(mime-preview-quit)
@@ -1347,20 +1411,32 @@ If there is no upper entity, call function `mime-preview-quit'."
 (defun mime-preview-move-to-previous ()
   "Move to previous entity.
 If there is no previous entity, it calls function registered in
-variable `mime-view-over-to-previous-method-alist'."
+variable `mime-preview-over-to-previous-method-alist'."
   (interactive)
-  (while (null (get-text-property (point) 'mime-view-entity))
+  (while (and (not (bobp))
+	      (null (get-text-property (point) 'mime-view-entity)))
     (backward-char)
     )
   (let ((point (previous-single-property-change (point) 'mime-view-entity)))
-    (if point
+    (if (and point
+	     (>= point (point-min)))
 	(if (get-text-property (1- point) 'mime-view-entity)
-	    (goto-char point)
+	    (progn (goto-char point)
+		   (if
+		    (or (eq mime-preview-move-scroll t)
+			(and mime-preview-move-scroll
+			     (<= point
+				(save-excursion
+				  (move-to-window-line 0)
+				  (forward-line next-screen-context-lines)
+				  (end-of-line)
+				  (point)))))
+			(recenter (* -1 next-screen-context-lines))))
 	  (goto-char (1- point))
 	  (mime-preview-move-to-previous)
 	  )
       (let ((f (assq (mime-preview-original-major-mode)
-		     mime-view-over-to-previous-method-alist)))
+		     mime-preview-over-to-previous-method-alist)))
 	(if f
 	    (funcall (cdr f))
 	  ))
@@ -1369,20 +1445,33 @@ variable `mime-view-over-to-previous-method-alist'."
 (defun mime-preview-move-to-next ()
   "Move to next entity.
 If there is no previous entity, it calls function registered in
-variable `mime-view-over-to-next-method-alist'."
+variable `mime-preview-over-to-next-method-alist'."
   (interactive)
-  (while (null (get-text-property (point) 'mime-view-entity))
+  (while (and (not (eobp))
+	      (null (get-text-property (point) 'mime-view-entity)))
     (forward-char)
     )
   (let ((point (next-single-property-change (point) 'mime-view-entity)))
-    (if point
+    (if (and point
+	     (<= point (point-max)))
 	(progn
 	  (goto-char point)
 	  (if (null (get-text-property point 'mime-view-entity))
 	      (mime-preview-move-to-next)
+	    (and
+	     (or (eq mime-preview-move-scroll t)
+		 (and mime-preview-move-scroll
+		      (>= point
+			 (save-excursion
+			   (move-to-window-line -1)
+			   (forward-line
+			    (* -1 next-screen-context-lines))
+			   (beginning-of-line)
+			   (point)))))
+		 (recenter next-screen-context-lines))
 	    ))
       (let ((f (assq (mime-preview-original-major-mode)
-		     mime-view-over-to-next-method-alist)))
+		     mime-preview-over-to-next-method-alist)))
 	(if f
 	    (funcall (cdr f))
 	  ))
@@ -1391,59 +1480,67 @@ variable `mime-view-over-to-next-method-alist'."
 (defun mime-preview-scroll-up-entity (&optional h)
   "Scroll up current entity.
 If reached to (point-max), it calls function registered in variable
-`mime-view-over-to-next-method-alist'."
+`mime-preview-over-to-next-method-alist'."
   (interactive)
-  (or h
-      (setq h (1- (window-height)))
-      )
-  (if (= (point) (point-max))
+  (if (eobp)
       (let ((f (assq (mime-preview-original-major-mode)
-                     mime-view-over-to-next-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
+		     mime-preview-over-to-next-method-alist)))
+	(if f
+	    (funcall (cdr f))
+	  ))
     (let ((point
 	   (or (next-single-property-change (point) 'mime-view-entity)
-	       (point-max))))
-      (forward-line h)
-      (if (> (point) point)
-          (goto-char point)
-        )
+	       (point-max)))
+	  (bottom (window-end (selected-window))))
+      (if (and (not h)
+	       (> bottom point))
+	  (progn (goto-char point)
+		 (recenter next-screen-context-lines))
+	(condition-case nil
+	    (scroll-up h)
+	  (end-of-buffer
+	   (goto-char (point-max)))))
       )))
 
 (defun mime-preview-scroll-down-entity (&optional h)
   "Scroll down current entity.
 If reached to (point-min), it calls function registered in variable
-`mime-view-over-to-previous-method-alist'."
+`mime-preview-over-to-previous-method-alist'."
   (interactive)
-  (or h
-      (setq h (1- (window-height)))
-      )
-  (if (= (point) (point-min))
+  (if (bobp)
       (let ((f (assq (mime-preview-original-major-mode)
-		     mime-view-over-to-previous-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
+		     mime-preview-over-to-previous-method-alist)))
+	(if f
+	    (funcall (cdr f))
+	  ))
     (let ((point
 	   (or (previous-single-property-change (point) 'mime-view-entity)
-	       (point-min))))
-      (forward-line (- h))
-      (if (< (point) point)
-          (goto-char point)
-        ))))
+	       (point-min)))
+	  (top (window-start (selected-window))))
+      (if (and (not h)
+	       (< top point))
+	  (progn (goto-char point)
+		 (recenter (* -1 next-screen-context-lines)))
+	(condition-case nil
+	    (scroll-down h)
+	  (beginning-of-buffer
+	   (goto-char (point-min)))))
+      )))
 
-(defun mime-preview-next-line-entity ()
-  (interactive)
-  (mime-preview-scroll-up-entity 1)
+(defun mime-preview-next-line-entity (&optional lines)
+  "Scroll up one line (or prefix LINES lines).
+If LINES is negative, scroll down LINES lines."
+  (interactive "p")
+  (mime-preview-scroll-up-entity (or lines 1))
   )
 
-(defun mime-preview-previous-line-entity ()
-  (interactive)
-  (mime-preview-scroll-down-entity 1)
+(defun mime-preview-previous-line-entity (&optional lines)
+  "Scrroll down one line (or prefix LINES lines).
+If LINES is negative, scroll up LINES lines."
+  (interactive "p")
+  (mime-preview-scroll-down-entity (or lines 1))
   )
 
-
 ;;; @@ quitting
 ;;;
 
@@ -1458,17 +1555,6 @@ It calls function registered in variable
 	(funcall (cdr r))
       )))
 
-(defun mime-preview-show-summary ()
-  "Show summary.
-It calls function registered in variable
-`mime-view-show-summary-method'."
-  (interactive)
-  (let ((r (assq (mime-preview-original-major-mode)
-		 mime-view-show-summary-method)))
-    (if r
-	(funcall (cdr r))
-      )))
-
 (defun mime-preview-kill-buffer ()
   (interactive)
   (kill-buffer (current-buffer))