X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=00b379f5d2d6067b062050b794aea49d41feaf80;hb=f18fb8dd6aba930737bae701deb9dedd8a676bf8;hp=68314dec4eca46e18e5f7632b109a1681b609b5f;hpb=aeadb8000788e6ae6970c6f6dd1991bdbef49286;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index 68314de..00b379f 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,8 +27,8 @@
 
 ;;; Code:
 
-(require 'std11)
-(require 'mime-lib)
+(require 'emu)
+(require 'mime)
 (require 'semi-def)
 (require 'calist)
 (require 'alist)
@@ -38,11 +38,11 @@
 ;;; @ version
 ;;;
 
-(defconst mime-view-version-string
-  `,(concat (car mime-user-interface-version) " MIME-View "
-	    (mapconcat #'number-to-string
-		       (cddr mime-user-interface-version) ".")
-	    " (" (cadr mime-user-interface-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
@@ -62,6 +62,15 @@
   :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)))
 
 ;;; @ in raw-buffer (representation space)
 ;;;
@@ -71,16 +80,6 @@
 (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)
@@ -89,53 +88,28 @@ 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.")
-
-
-(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-message-structure' 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-message-structure' is used."
-  (or message-info
-      (setq message-info mime-message-structure))
-  (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-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))))
+`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)
@@ -147,15 +121,15 @@ 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)
+(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
@@ -165,100 +139,90 @@ mother-buffer."
 	(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)))
+    (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-entity-representation-type (entity)
-  (with-current-buffer (mime-entity-buffer entity)
-    (or mime-raw-representation-type
-	(cdr (or (assq major-mode mime-raw-representation-type-alist)
-		 (assq t mime-raw-representation-type-alist))))))
-
-(defsubst mime-entity-cooked-p (entity)
-  (eq (mime-entity-representation-type entity) 'cooked))
-
-(defsubst mime-entity-parent (entity &optional message-info)
-  "Return mother entity of ENTITY.
-If optional argument MESSAGE-INFO is not specified,
-`mime-message-structure' 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-message-structure))))
-
-(defun 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))
-	  (let ((d (mime-entity-content-disposition entity)))
-	    (cons (cons 'disposition-type
-			(mime-content-disposition-type d))
-		  (mapcar (function
-			   (lambda (param)
-			     (let ((name (car param)))
-			       (cons (cond ((string= name "filename")
-					    'filename)
-					   ((string= name "creation-date")
-					    'creation-date)
-					   ((string= name "modification-date")
-					    'modification-date)
-					   ((string= name "read-date")
-					    'read-date)
-					   ((string= name "size")
-					    'size)
-					   (t (cons 'disposition (car param))))
-				     (cdr param)))))
-			  (mime-content-disposition-parameters d))
-		  ))
-	  (list (cons 'encoding (mime-entity-encoding entity))
-		(cons 'major-mode
-		      (save-excursion
-			(set-buffer (mime-entity-buffer entity))
-			major-mode)))
-	  ))
-
-
-(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
-
-(defun mime-entity-uu-filename (entity)
-  (if (member (mime-entity-encoding entity)
-	      mime-view-uuencode-encoding-name-list)
-      (save-excursion
-	(set-buffer (mime-entity-buffer entity))
-	(goto-char (mime-entity-body-start entity))
-	(if (re-search-forward "^begin [0-9]+ "
-			       (mime-entity-body-end entity) t)
-	    (if (looking-at ".+$")
-		(buffer-substring (match-beginning 0)(match-end 0))
-	      )))))
-
-(defun mime-entity-filename (entity)
-  (or (mime-entity-uu-filename entity)
-      (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)
-	     ))
-      ))
+  (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)
@@ -267,30 +231,34 @@ If optional argument MESSAGE-INFO is not specified,
       ""))
 
 
-(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)))
-
-(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)))
-
-(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))
+;; (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)))
+
+;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.")
+
+;; (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.")
+
+;; (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
@@ -345,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
@@ -384,15 +356,15 @@ 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-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.")
 
@@ -403,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)))
@@ -479,6 +453,12 @@ Each elements are regexp of field-name.")
 
 (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-display-text/plain)))
@@ -510,9 +490,137 @@ Each elements are regexp of field-name.")
 ;;; @@@ entity presentation
 ;;;
 
-(autoload 'mime-display-text/plain "mime-text")
-(autoload 'mime-display-text/enriched "mime-text")
-(autoload 'mime-display-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)
@@ -540,8 +648,12 @@ Each elements are regexp of field-name.")
 
 (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-display-entity (car children) nil default-situation)
       (setq children (cdr children))
@@ -556,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-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
@@ -600,7 +718,7 @@ 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))
@@ -689,7 +807,14 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
  'mime-acting-condition
  '((type . message)(subtype . external-body)
    ("access-type" . "anon-ftp")
-   (method . mime-view-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
@@ -724,38 +849,6 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
   '("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
 ;;;
 
@@ -763,11 +856,9 @@ The compressed face will be piped to this command.")
 				   default-situation preview-buffer)
   (or preview-buffer
       (setq preview-buffer (current-buffer)))
-  (let* ((raw-buffer (mime-entity-buffer entity))
-	 (start (mime-entity-point-min entity))
-	 e nb ne)
-    (set-buffer raw-buffer)
-    (goto-char start)
+  (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
@@ -780,7 +871,8 @@ The compressed face will be piped to this command.")
 	   (eq (cdr (assq 'header situation)) 'visible))
 	  (header-presentation-method
 	   (or (cdr (assq 'header-presentation-method situation))
-	       (cdr (assq major-mode mime-header-presentation-method-alist))))
+	       (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)))
@@ -792,19 +884,18 @@ The compressed face will be piped to this command.")
 	      (mime-view-insert-entity-button entity)
 	    ))
       (when header-is-visible
+	(setq nhb (point))
 	(if header-presentation-method
 	    (funcall header-presentation-method entity situation)
-	  (mime-insert-decoded-header entity
-				      mime-view-ignored-field-list
-				      mime-view-visible-field-list
-				      (if (mime-entity-cooked-p entity)
-					  nil
-					default-mime-charset))
-	  )
+	  (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")
-	(run-hooks 'mime-display-header-hook)
 	)
+      (setq nbb (point))
       (cond (children)
             ((functionp body-presentation-method)
 	     (funcall body-presentation-method entity situation)
@@ -823,6 +914,8 @@ The compressed face will be piped to this command.")
       (setq ne (point-max))
       (widen)
       (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)
@@ -845,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
@@ -866,6 +958,24 @@ The compressed face will be piped to this command.")
        (defvar mouse-button-2 'button2)
        )
       (t
+       (defvar mime-view-popup-menu 
+         (let ((menu (make-sparse-keymap mime-view-menu-title)))
+           (nconc menu
+                  (mapcar (function
+                           (lambda (item)
+                             (list (intern (nth 1 item)) 'menu-item 
+                                   (nth 1 item)(nth 2 item))
+                             ))
+                          mime-view-menu-list))))
+       (defun mime-view-popup-menu (event)
+         "Popup the menu in the MIME Viewer buffer"
+         (interactive "@e")
+         (let ((menu mime-view-popup-menu) events func)
+           (setq events (x-popup-menu t menu))
+           (and events
+                (setq func (lookup-key menu (apply #'vector events)))
+                (commandp func)
+                (funcall func))))
        (defvar mouse-button-2 [mouse-2])
        ))
 
@@ -919,7 +1029,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
@@ -930,11 +1040,13 @@ 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))
 	   )
 	  ((>= emacs-major-version 19)
+	   (define-key mime-view-mode-map
+             mouse-button-3 (function mime-view-popup-menu))
 	   (define-key mime-view-mode-map [menu-bar mime-view]
 	     (cons mime-view-menu-title
 		   (make-sparse-keymap mime-view-menu-title)))
@@ -968,22 +1080,34 @@ The compressed face will be piped to this command.")
 
 (defvar mime-view-redisplay nil)
 
+;;;###autoload
 (defun mime-display-message (message &optional preview-buffer
-				     mother default-keymap-or-function)
+				     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)
-    (mime-parse-buffer)
-    (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)
 	)
@@ -991,8 +1115,9 @@ The compressed face will be piped to this command.")
       (setq major-mode 'mime-view-mode)
       (setq mode-name "MIME-View")
       (mime-display-entity message nil
-			   '((entity-button . invisible)
-			     (header . visible))
+			   `((entity-button . invisible)
+			     (header . visible)
+			     (major-mode . ,original-major-mode))
 			   preview-buffer)
       (mime-view-define-keymap default-keymap-or-function)
       (let ((point
@@ -1003,20 +1128,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-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
@@ -1044,13 +1198,27 @@ button-2	Move to point under the mouse cursor
         	and decode current content as `play mode'
 "
   (interactive)
-  (mime-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
@@ -1059,22 +1227,22 @@ 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")
   )
 
 
@@ -1094,6 +1262,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))
 	   )
@@ -1137,67 +1306,82 @@ 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-preview-following-method-alist))))
 	  (if (functionp f)
@@ -1210,17 +1394,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
 ;;;
 
@@ -1233,16 +1406,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)
@@ -1253,13 +1433,25 @@ If there is no upper entity, call function `mime-preview-quit'."
 If there is no previous entity, it calls function registered in
 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)
 	  )
@@ -1275,15 +1467,28 @@ variable `mime-preview-over-to-previous-method-alist'."
 If there is no previous entity, it calls function registered in
 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-preview-over-to-next-method-alist)))
@@ -1297,22 +1502,24 @@ variable `mime-preview-over-to-next-method-alist'."
 If reached to (point-max), it calls function registered in variable
 `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-preview-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)
@@ -1320,34 +1527,40 @@ If reached to (point-max), it calls function registered in variable
 If reached to (point-min), it calls function registered in variable
 `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-preview-over-to-previous-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
+	(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
 ;;;