X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=4e05729d283951b2074e5bcbf50f6bc5be690b91;hb=95ed637823942efce972395a133ed77ab16e2a09;hp=b6a4d96134da10fa3d9b48296162b9d3182dc105;hpb=f88c828889eba80c7ca4aaa6f34dba277668d5f0;p=elisp%2Fsemi.git

diff --git a/mime-view.el b/mime-view.el
index b6a4d96..4e05729 100644
--- a/mime-view.el
+++ b/mime-view.el
@@ -1,8 +1,8 @@
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
-;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1994/07/13
 ;;	Renamed: 1994/08/31 from tm-body.el
 ;;	Renamed: 1997/02/19 from tm-view.el
@@ -52,13 +52,11 @@
   "MIME view mode"
   :group 'mime)
 
-(defcustom mime-view-find-every-acting-situation t
-  "*Find every available acting-situation if non-nil."
-  :group 'mime-view
-  :type 'boolean)
+(defvar mime-view-find-every-situations t
+  "*Find every available situations if non-nil.")
 
-(defcustom mime-acting-situation-examples-file "~/.mime-example"
-  "*File name of example about acting-situation demonstrated by user."
+(defcustom mime-situation-examples-file "~/.mime-example"
+  "*File name of situation-examples demonstrated by user."
   :group 'mime-view
   :type 'file)
 
@@ -72,6 +70,7 @@ buttom. Nil means don't scroll at all."
 		 (const :tag "On" t)
 		 (sexp :tag "Situation" 1)))
 
+
 ;;; @ in raw-buffer (representation space)
 ;;;
 
@@ -91,27 +90,6 @@ major-mode or t.  t means default.  REPRESENTATION-TYPE must be
 `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)
 ;;;
 
@@ -224,41 +202,277 @@ mother-buffer."
     
     situation))
 
+(defsubst mime-delq-null-situation (situations field
+					       &optional ignored-value)
+  (let (dest)
+    (while situations
+      (let* ((situation (car situations))
+	     (cell (assq field situation)))
+	(if cell
+	    (or (eq (cdr cell) ignored-value)
+		(setq dest (cons situation dest))
+		)))
+      (setq situations (cdr situations)))
+    dest))
+
+(defun mime-compare-situation-with-example (situation example)
+  (let ((example (copy-alist example))
+	(match 0))
+    (while situation
+      (let* ((cell (car situation))
+	     (key (car cell))
+	     (ecell (assoc key example)))
+	(when ecell
+	  (if (equal cell ecell)
+	      (setq match (1+ match))
+	    (setq example (delq ecell example))
+	    ))
+	)
+      (setq situation (cdr situation))
+      )
+    (cons match example)
+    ))
+
+(defun mime-sort-situation (situation)
+  (sort situation
+	#'(lambda (a b)
+	    (let ((a-t (car a))
+		  (b-t (car b))
+		  (order '((type . 1)
+			   (subtype . 2)
+			   (mode . 3)
+			   (method . 4)
+			   (major-mode . 5)
+			   (disposition-type . 6)
+			   ))
+		  a-order b-order)
+	      (if (symbolp a-t)
+		  (let ((ret (assq a-t order)))
+		    (if ret
+			(setq a-order (cdr ret))
+		      (setq a-order 7)
+		      ))
+		(setq a-order 8)
+		)
+	      (if (symbolp b-t)
+		  (let ((ret (assq b-t order)))
+		    (if ret
+			(setq b-order (cdr ret))
+		      (setq b-order 7)
+		      ))
+		(setq b-order 8)
+		)
+	      (if (= a-order b-order)
+		  (string< (format "%s" a-t)(format "%s" b-t))
+		(< a-order b-order))
+	      )))
+  )
+
+(defun mime-unify-situations (entity-situation
+			      condition situation-examples
+			      &optional required-name ignored-value)
+  (let (ret)
+    (in-calist-package 'mime-view)
+    (setq ret
+	  (ctree-find-calist condition entity-situation
+			     mime-view-find-every-situations))
+    (if required-name
+	(setq ret (mime-delq-null-situation ret required-name ignored-value)))
+    (or (assq 'ignore-examples entity-situation)
+	(if (cdr ret)
+	    (let ((rest ret)
+		  (max-score 0)
+		  (max-escore 0)
+		  max-examples
+		  max-situations)
+	      (while rest
+		(let ((situation (car rest))
+		      (examples situation-examples))
+		  (while examples
+		    (let* ((ret
+			    (mime-compare-situation-with-example
+			     situation (caar examples)))
+			   (ret-score (car ret)))
+		      (cond ((> ret-score max-score)
+			     (setq max-score ret-score
+				   max-escore (cdar examples)
+				   max-examples (list (cdr ret))
+				   max-situations (list situation))
+			     )
+			    ((= ret-score max-score)
+			     (cond ((> (cdar examples) max-escore)
+				    (setq max-escore (cdar examples)
+					  max-examples (list (cdr ret))
+					  max-situations (list situation))
+				    )
+				   ((= (cdar examples) max-escore)
+				    (setq max-examples
+					  (cons (cdr ret) max-examples))
+				    (or (member situation max-situations)
+					(setq max-situations
+					      (cons situation max-situations)))
+				    )))))
+		    (setq examples (cdr examples))))
+		(setq rest (cdr rest)))
+	      (when max-situations
+		(setq ret max-situations)
+		(while max-examples
+		  (let* ((example (car max-examples))
+			 (cell
+			  (assoc example situation-examples)))
+		    (if cell
+			(setcdr cell (1+ (cdr cell)))
+		      (setq situation-examples
+			    (cons (cons example 0)
+				  situation-examples))
+		      ))
+		  (setq max-examples (cdr max-examples))
+		  )))))
+    (cons ret situation-examples)
+    ;; ret: list of situations
+    ;; situation-examples: new examples (notoce that contents of
+    ;;                     argument `situation-examples' has bees modified)
+    ))
+
 (defun mime-view-entity-title (entity)
   (or (mime-entity-read-field entity 'Content-Description)
       (mime-entity-read-field entity 'Subject)
       (mime-entity-filename entity)
       ""))
 
-
-;; (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))
+(defvar mime-preview-situation-example-list nil)
+(defvar mime-preview-situation-example-list-max-size 16)
+;; (defvar mime-preview-situation-example-condition nil)
+
+(defun mime-find-entity-preview-situation (entity
+					   &optional default-situation)
+  (or (let ((ret
+	     (mime-unify-situations
+	      (append (mime-entity-situation entity)
+		      default-situation)
+	      mime-preview-condition
+	      mime-preview-situation-example-list)))
+	(setq mime-preview-situation-example-list
+	      (cdr ret))
+	(caar ret))
+      default-situation))
+
+  
+(defvar mime-acting-situation-example-list nil)
+(defvar mime-acting-situation-example-list-max-size 16)
+
+(defun mime-save-situation-examples ()
+  (if (or mime-preview-situation-example-list
+	  mime-acting-situation-example-list)
+      (let* ((file mime-situation-examples-file)
+	     (buffer (get-buffer-create " *mime-example*")))
+	(unwind-protect
+	    (save-excursion
+	      (set-buffer buffer)
+	      (setq buffer-file-name file)
+	      (erase-buffer)
+	      (insert ";;; " (file-name-nondirectory file) "\n")
+	      (insert "\n;; This file is generated automatically by "
+		      mime-view-version "\n\n")
+	      (insert ";;; Code:\n\n")
+	      (if mime-preview-situation-example-list
+		  (pp `(setq mime-preview-situation-example-list
+			     ',mime-preview-situation-example-list)
+		      (current-buffer)))
+	      (if mime-acting-situation-example-list
+		  (pp `(setq mime-acting-situation-example-list
+			     ',mime-acting-situation-example-list)
+		      (current-buffer)))
+	      (insert "\n;;; "
+		      (file-name-nondirectory file)
+		      " ends here.\n")
+	      (save-buffer))
+	  (kill-buffer buffer)))))
+
+(add-hook 'kill-emacs-hook 'mime-save-situation-examples)
+
+(defun mime-reduce-situation-examples (situation-examples)
+  (let ((len (length situation-examples))
+	i ir ic j jr jc ret
+	dest d-i d-j
+	(max-sim 0) sim
+	min-det-ret det-ret
+	min-det-org det-org
+	min-freq freq)
+    (setq i 0
+	  ir situation-examples)
+    (while (< i len)
+      (setq ic (car ir)
+	    j 0
+	    jr situation-examples)
+      (while (< j len)
+	(unless (= i j)
+	  (setq jc (car jr))
+	  (setq ret (mime-compare-situation-with-example (car ic)(car jc))
+		sim (car ret)
+		det-ret (+ (length (car ic))(length (car jc)))
+		det-org (length (cdr ret))
+		freq (+ (cdr ic)(cdr jc)))
+	  (cond ((< max-sim sim)
+		 (setq max-sim sim
+		       min-det-ret det-ret
+		       min-det-org det-org
+		       min-freq freq
+		       d-i i
+		       d-j j
+		       dest (cons (cdr ret) freq))
+		 )
+		((= max-sim sim)
+		 (cond ((> min-det-ret det-ret)
+			(setq min-det-ret det-ret
+			      min-det-org det-org
+			      min-freq freq
+			      d-i i
+			      d-j j
+			      dest (cons (cdr ret) freq))
+			)
+		       ((= min-det-ret det-ret)
+			(cond ((> min-det-org det-org)
+			       (setq min-det-org det-org
+				     min-freq freq
+				     d-i i
+				     d-j j
+				     dest (cons (cdr ret) freq))
+			       )
+			      ((= min-det-org det-org)
+			       (cond ((> min-freq freq)
+				      (setq min-freq freq
+					    d-i i
+					    d-j j
+					    dest (cons (cdr ret) freq))
+				      ))
+			       ))
+			))
+		 ))
+	  )
+	(setq jr (cdr jr)
+	      j (1+ j)))
+      (setq ir (cdr ir)
+	    i (1+ i)))
+    (if (> d-i d-j)
+	(setq i d-i
+	      d-i d-j
+	      d-j i))
+    (setq jr (nthcdr (1- d-j) situation-examples))
+    (setcdr jr (cddr jr))
+    (if (= d-i 0)
+	(setq situation-examples
+	      (cdr situation-examples))
+      (setq ir (nthcdr (1- d-i) situation-examples))
+      (setcdr ir (cddr ir))
+      )
+    (if (setq ir (assoc (car dest) situation-examples))
+	(progn
+	  (setcdr ir (+ (cdr ir)(cdr dest)))
+	  situation-examples)
+      (cons dest situation-examples)
+      ;; situation-examples may be modified.
+      )))
 
 
 ;;; @ presentation of preview
@@ -270,21 +484,21 @@ mother-buffer."
 ;;; @@@ predicate function
 ;;;
 
-(defun mime-view-entity-button-visible-p (entity)
-  "Return non-nil if header of ENTITY is visible.
-Please redefine this function if you want to change default setting."
-  (let ((media-type (mime-entity-media-type entity))
-	(media-subtype (mime-entity-media-subtype entity)))
-    (or (not (eq media-type 'application))
-	(and (not (eq media-subtype 'x-selection))
-	     (or (not (eq media-subtype 'octet-stream))
-		 (let ((mother-entity (mime-entity-parent entity)))
-		   (or (not (eq (mime-entity-media-type mother-entity)
-				'multipart))
-		       (not (eq (mime-entity-media-subtype mother-entity)
-				'encrypted)))
-		   )
-		 )))))
+;; (defun mime-view-entity-button-visible-p (entity)
+;;   "Return non-nil if header of ENTITY is visible.
+;; Please redefine this function if you want to change default setting."
+;;   (let ((media-type (mime-entity-media-type entity))
+;;         (media-subtype (mime-entity-media-subtype entity)))
+;;     (or (not (eq media-type 'application))
+;;         (and (not (eq media-subtype 'x-selection))
+;;              (or (not (eq media-subtype 'octet-stream))
+;;                  (let ((mother-entity (mime-entity-parent entity)))
+;;                    (or (not (eq (mime-entity-media-type mother-entity)
+;;                                 'multipart))
+;;                        (not (eq (mime-entity-media-subtype mother-entity)
+;;                                 'encrypted)))
+;;                    )
+;;                  )))))
 
 ;;; @@@ entity button generator
 ;;;
@@ -451,6 +665,8 @@ Each elements are regexp of field-name.")
    (body . visible)
    (body-presentation-method . mime-display-text/richtext)))
 
+(autoload 'mime-display-application/x-postpet "postpet")
+
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . application)(subtype . x-postpet)
@@ -523,104 +739,6 @@ Each elements are regexp of field-name.")
       (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)
@@ -691,11 +809,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
 	  (mapcar (function
 		   (lambda (child)
 		     (let ((situation
-			    (or (ctree-match-calist
-				 mime-preview-condition
-				 (append (mime-entity-situation child)
-					 default-situation))
-				default-situation)))
+			    (mime-find-entity-preview-situation
+			     child default-situation)))
 		       (if (cdr (assq 'body-presentation-method situation))
 			   (let ((score
 				  (cdr
@@ -861,14 +976,15 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (in-calist-package 'mime-view)
     (or situation
 	(setq situation
-	      (or (ctree-match-calist mime-preview-condition
-				      (append (mime-entity-situation entity)
-					      default-situation))
-		  default-situation)))
+	      (mime-find-entity-preview-situation entity default-situation)))
     (let ((button-is-invisible
-	   (eq (cdr (assq 'entity-button situation)) 'invisible))
+	   (eq (cdr (or (assq '*entity-button situation)
+			(assq 'entity-button situation)))
+	       'invisible))
 	  (header-is-visible
-	   (eq (cdr (assq 'header situation)) 'visible))
+	   (eq (cdr (or (assq '*header situation)
+			(assq 'header situation)))
+	       'visible))
 	  (header-presentation-method
 	   (or (cdr (assq 'header-presentation-method situation))
 	       (cdr (assq (cdr (assq 'major-mode situation))
@@ -880,9 +996,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
       (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)
-	    ))
+          ;; (if (mime-view-entity-button-visible-p entity)
+	  (mime-view-insert-entity-button entity)
+          ;;   )
+	  )
       (when header-is-visible
 	(setq nhb (point))
 	(if header-presentation-method
@@ -1011,6 +1128,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
     (define-key mime-view-mode-map
       "\C-c\C-p" (function mime-preview-print-current-entity))
     (define-key mime-view-mode-map
+      "\C-c\C-t\C-h" (function mime-preview-toggle-header))
+    (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
     (define-key mime-view-mode-map
       "q"        (function mime-preview-quit))
@@ -1101,9 +1220,7 @@ keymap of MIME-View mode."
 	(setq preview-buffer
 	      (concat "*Preview-" (mime-entity-name message) "*")))
     (or original-major-mode
-	(setq original-major-mode
-	      (with-current-buffer (mime-entity-header-buffer message)
-		major-mode)))
+	(setq original-major-mode major-mode))
     (let ((inhibit-read-only t))
       (set-buffer (get-buffer-create preview-buffer))
       (widen)
@@ -1221,6 +1338,59 @@ button-2	Move to point under the mouse cursor
   )
 
 
+;;; @@ utility
+;;;
+
+(defun mime-preview-find-boundary-info (&optional get-mother)
+  (let (entity
+	p-beg p-end
+	entity-node-id len)
+    (while (null (setq entity
+		       (get-text-property (point) 'mime-view-entity)))
+      (backward-char))
+    (setq p-beg (previous-single-property-change (point) 'mime-view-entity))
+    (setq entity-node-id (mime-entity-node-id entity))
+    (setq len (length entity-node-id))
+    (cond ((null p-beg)
+	   (setq p-beg
+		 (if (eq (next-single-property-change (point-min)
+						      'mime-view-entity)
+			 (point))
+		     (point)
+		   (point-min)))
+	   )
+	  ((eq (next-single-property-change p-beg 'mime-view-entity)
+	       (point))
+	   (setq p-beg (point))
+	   ))
+    (setq p-end (next-single-property-change p-beg 'mime-view-entity))
+    (cond ((null p-end)
+	   (setq p-end (point-max))
+	   )
+	  ((null entity-node-id)
+	   (setq p-end (point-max))
+	   )
+	  (get-mother
+	   (save-excursion
+	     (goto-char p-end)
+	     (catch 'tag
+	       (let (e i)
+		 (while (setq e
+			      (next-single-property-change
+			       (point) 'mime-view-entity))
+		   (goto-char e)
+		   (let ((rc (mime-entity-node-id
+			      (get-text-property (1- (point))
+						 'mime-view-entity))))
+		     (or (and (>= (setq i (- (length rc) len)) 0)
+			      (equal entity-node-id (nthcdr i rc)))
+			 (throw 'tag nil)))
+		   (setq p-end e)))
+	       (setq p-end (point-max))))
+	   ))
+    (vector p-beg p-end entity)))
+
+
 ;;; @@ playing
 ;;;
 
@@ -1254,145 +1424,80 @@ It decodes current entity to call internal or external method as
 It calls following-method selected from variable
 `mime-preview-following-method-alist'."
   (interactive)
-  (let (entity)
-    (while (null (setq entity
-		       (get-text-property (point) 'mime-view-entity)))
-      (backward-char)
-      )
-    (let* ((p-beg
-	    (previous-single-property-change (point) 'mime-view-entity))
-	   p-end
-	   ph-end
+  (let ((entity (mime-preview-find-boundary-info t))
+	p-beg p-end
+	pb-beg)
+    (setq p-beg (aref entity 0)
+	  p-end (aref entity 1)
+	  entity (aref entity 2))
+    (if (get-text-property p-beg 'mime-view-entity-body)
+	(setq pb-beg p-beg)
+      (setq pb-beg
+	    (next-single-property-change
+	     p-beg 'mime-view-entity-body nil
+	     (or (next-single-property-change p-beg 'mime-view-entity)
+		 p-end))))
+    (let* ((mode (mime-preview-original-major-mode 'recursive))
 	   (entity-node-id (mime-entity-node-id entity))
-	   (len (length entity-node-id))
-	   )
-      (cond ((null p-beg)
-	     (setq p-beg
-		   (if (eq (next-single-property-change (point-min)
-							'mime-view-entity)
-			   (point))
-		       (point)
-		     (point-min)))
-	     )
-	    ((eq (next-single-property-change p-beg 'mime-view-entity)
-		 (point))
-	     (setq p-beg (point))
-	     ))
-      (setq p-end (next-single-property-change p-beg 'mime-view-entity))
-      (cond ((null p-end)
-	     (setq p-end (point-max))
-	     )
-	    ((null entity-node-id)
-	     (setq p-end (point-max))
-	     )
-	    (t
-	     (save-excursion
-	       (goto-char p-end)
-	       (catch 'tag
-		 (let (e)
-		   (while (setq e
-				(next-single-property-change
-				 (point) 'mime-view-entity))
-		     (goto-char e)
-		     (let ((rc (mime-entity-node-id
-				(get-text-property (point)
-						   'mime-view-entity))))
-		       (or (equal entity-node-id
-				  (nthcdr (- (length rc) len) rc))
-			   (throw 'tag nil)
-			   ))
-		     (setq p-end e)
-		     ))
-		 (setq p-end (point-max))
-		 ))
-	     ))
-      (setq ph-end
-	    (previous-single-property-change p-end 'mime-view-entity-header))
-      (if (or (null ph-end)
-	      (< ph-end p-beg))
-	  (setq ph-end p-beg)
-	)
-      (let* ((mode (mime-preview-original-major-mode 'recursive))
-	     (new-name
-	      (format "%s-%s" (buffer-name) (reverse entity-node-id)))
-	     new-buf
-	     (the-buf (current-buffer))
-	     fields)
-	(save-excursion
-	  (set-buffer (setq new-buf (get-buffer-create new-name)))
-	  (erase-buffer)
-	  (insert-buffer-substring the-buf ph-end p-end)
-	  (when (= ph-end p-beg)
-	    (goto-char (point-min))
-	    (insert ?\n))
-	  (goto-char (point-min))
-          (let ((current-entity
-		 (if (and (eq (mime-entity-media-type entity) 'message)
-			  (eq (mime-entity-media-subtype entity) 'rfc822))
-		     (mime-entity-children entity)
-		   entity))
-		str)
-	    (while (and current-entity
-			(progn
-			  (setq str
-				(with-current-buffer
-				    (mime-entity-header-buffer current-entity)
-				  (save-restriction
-				    (narrow-to-region
-				     (mime-entity-header-start-point
-				      current-entity)
-				     (mime-entity-header-end-point
-				      current-entity))
-				    (std11-header-string-except
-				     (concat
-				      "^"
-				      (apply (function regexp-or) fields)
-				      ":") ""))))
-			  (if (and (eq (mime-entity-media-type
-					current-entity) 'message)
-				   (eq (mime-entity-media-subtype
-					current-entity) 'rfc822))
-			      nil
-			    (if str
-				(insert str)
-			      )
-			    t)))
-	      (setq fields (std11-collect-field-names)
-		    current-entity (mime-entity-parent current-entity))
-	      )
-	    )
-	  (let ((rest mime-view-following-required-fields-list)
-		field-name ret)
-	    (while rest
-	      (setq field-name (car rest))
-	      (or (std11-field-body field-name)
-		  (progn
-		    (save-excursion
-		      (set-buffer the-buf)
-		      (let ((entity (when mime-mother-buffer
-				      (set-buffer mime-mother-buffer)
-				      (get-text-property (point)
-							 'mime-view-entity))))
-			(while (and entity
-				    (null (setq ret (mime-entity-fetch-field
-						     entity field-name))))
-			  (setq entity (mime-entity-parent entity)))))
-		    (if ret
-			(insert (concat field-name ": " ret "\n"))
-		      )))
-	      (setq rest (cdr rest))
-	      ))
-	  (mime-decode-header-in-buffer)
-	  )
-	(let ((f (cdr (assq mode mime-preview-following-method-alist))))
-	  (if (functionp f)
-	      (funcall f new-buf)
-	    (message
-	     (format
-	      "Sorry, following method for %s is not implemented yet."
-	      mode))
+	   (new-name
+	    (format "%s-%s" (buffer-name) (reverse entity-node-id)))
+	   new-buf
+	   (the-buf (current-buffer))
+	   fields)
+      (save-excursion
+	(set-buffer (setq new-buf (get-buffer-create new-name)))
+	(erase-buffer)
+	(insert ?\n)
+	(insert-buffer-substring the-buf pb-beg p-end)
+	(goto-char (point-min))
+	(let ((current-entity
+	       (if (and (eq (mime-entity-media-type entity) 'message)
+			(eq (mime-entity-media-subtype entity) 'rfc822))
+		   (car (mime-entity-children entity))
+		 entity))
+	      str)
+	  (while (and current-entity
+		      (if (and (eq (mime-entity-media-type
+				    current-entity) 'message)
+			       (eq (mime-entity-media-subtype
+				    current-entity) 'rfc822))
+			  nil
+			(mime-insert-header current-entity fields)
+			t))
+	    (setq fields (std11-collect-field-names)
+		  current-entity (mime-entity-parent current-entity))
 	    ))
-	))))
+	(let ((rest mime-view-following-required-fields-list)
+	      field-name ret)
+	  (while rest
+	    (setq field-name (car rest))
+	    (or (std11-field-body field-name)
+		(progn
+		  (save-excursion
+		    (set-buffer the-buf)
+		    (let ((entity (when mime-mother-buffer
+				    (set-buffer mime-mother-buffer)
+				    (get-text-property (point)
+						       'mime-view-entity))))
+		      (while (and entity
+				  (null (setq ret (mime-entity-fetch-field
+						   entity field-name))))
+			(setq entity (mime-entity-parent entity)))))
+		  (if ret
+		      (insert (concat field-name ": " ret "\n"))
+		    )))
+	    (setq rest (cdr rest))
+	    ))
+	)
+      (let ((f (cdr (assq mode mime-preview-following-method-alist))))
+	(if (functionp f)
+	    (funcall f new-buf)
+	  (message
+	   (format
+	    "Sorry, following method for %s is not implemented yet."
+	    mode))
+	  ))
+      )))
 
 
 ;;; @@ moving
@@ -1562,6 +1667,36 @@ If LINES is negative, scroll up LINES lines."
   (mime-preview-scroll-down-entity (or lines 1))
   )
 
+
+;;; @@ display
+;;;
+
+(defun mime-preview-toggle-header ()
+  (interactive)
+  (let ((situation (mime-preview-find-boundary-info))
+	entity p-beg p-end)
+    (setq p-beg (aref situation 0)
+	  p-end (aref situation 1)
+	  entity (aref situation 2)
+	  situation (get-text-property p-beg 'mime-view-situation))
+    (let ((cell (assq '*header situation)))
+      (if (null cell)
+	  (setq cell (assq 'header situation)))
+      (if (eq (cdr cell) 'visible)
+	  (setq situation (put-alist '*header 'invisible situation))
+	(setq situation (put-alist '*header 'visible situation))))
+    (save-excursion
+      (let ((inhibit-read-only t))
+	(delete-region p-beg p-end)
+	(mime-display-entity entity situation)))
+    ;; (ctree-set-calist-strictly 'mime-preview-condition situation)
+    (let ((ret (assoc situation mime-preview-situation-example-list)))
+      (if ret
+	  (setcdr ret (1+ (cdr ret)))
+	(add-to-list 'mime-preview-situation-example-list
+		     (cons situation 0))))))
+
+    
 ;;; @@ quitting
 ;;;
 
@@ -1587,6 +1722,44 @@ It calls function registered in variable
 
 (provide 'mime-view)
 
-(run-hooks 'mime-view-load-hook)
+(let* ((file mime-situation-examples-file)
+       (buffer (get-buffer-create " *mime-example*")))
+  (if (file-readable-p file)
+      (unwind-protect
+	  (save-excursion
+	    (set-buffer buffer)
+	    (erase-buffer)
+	    (insert-file-contents file)
+	    (eval-buffer)
+	    ;; format check
+	    (condition-case nil
+		(let ((i 0))
+		  (while (and (> (length mime-preview-situation-example-list)
+				 mime-preview-situation-example-list-max-size)
+			      (< i 16))
+		    (setq mime-preview-situation-example-list
+			  (mime-reduce-situation-examples
+			   mime-preview-situation-example-list))
+		    (setq i (1+ i))
+		    ))
+	      (error (setq mime-preview-situation-example-list nil)))
+            ;; (let ((rest mime-preview-situation-example-list))
+            ;;   (while rest
+            ;;     (ctree-set-calist-strictly 'mime-preview-condition
+            ;;                                (caar rest))
+            ;;     (setq rest (cdr rest))))
+	    (condition-case nil
+		(let ((i 0))
+		  (while (and (> (length mime-acting-situation-example-list)
+				 mime-acting-situation-example-list-max-size)
+			      (< i 16))
+		    (setq mime-acting-situation-example-list
+			  (mime-reduce-situation-examples
+			   mime-acting-situation-example-list))
+		    (setq i (1+ i))
+		    ))
+	      (error (setq mime-acting-situation-example-list nil)))
+	    )
+	(kill-buffer buffer))))
 
 ;;; mime-view.el ends here