* mime-image.el (mime-image-normalize-xbm-buffer): Add missing format

[elisp/semi.git] / mime-view.el

diff --git a/mime-view.el b/mime-view.el
index 6ea8360..41d4329 100644 (file)
--- a/mime-view.el
+++ b/mime-view.el
@@ -1,15 +1,14 @@
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 

-;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.

 
 

-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Created: 1994/7/13
-;;     Renamed: 1994/8/31 from tm-body.el
+;; 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
 ;;     Renamed: 1997/02/19 from tm-view.el

-;; Version: $Revision: 0.46 $

 ;; Keywords: MIME, multimedia, mail, news
 
 ;; Keywords: MIME, multimedia, mail, news
 

-;; This file is part of SEMI (SEMI is 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
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as

@@ -28,673 +27,1120 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(require 'cl)
-(require 'std11)
-(require 'mel)
-(require 'eword-decode)
-(require 'mime-parse)
-(require 'mime-text)
+(require 'mime)
+(require 'semi-def)
+(require 'calist)
+(require 'alist)
+(require 'mime-conf)
+
+(eval-when-compile (require 'static))

 
 
 ;;; @ version
 ;;;
 
 
 
 ;;; @ version
 ;;;
 

-(defconst mime-view-RCS-ID
-  "$Id: mime-view.el,v 0.46 1997-03-17 13:55:01 morioka Exp $")
-
-(defconst mime-view-version (get-version-string mime-view-RCS-ID))
+(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
 ;;;
 
 
 
 ;;; @ variables
 ;;;
 

-(defvar mime/content-decoding-condition
-  '(((type . "text/plain")
-     (method "tm-plain" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "text/html")
-     (method "tm-html" nil 'file 'type 'encoding 'mode 'name)
-     (mode . "play")
-     )
-    ((type . "text/x-rot13-47")
-     (method . mime-article/decode-caesar)
-     (mode . "play")
-     )
-    ((type . "audio/basic")
-     (method "tm-au"    nil 'file 'type 'encoding 'mode 'name)
-     (mode . "play")
-     )
-    
-    ((type . "image/jpeg")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/gif")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/tiff")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/x-tiff")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/x-xbm")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/x-pic")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "image/x-mag")
-     (method "tm-image" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    
-    ((type . "video/mpeg")
-     (method "tm-mpeg"  nil 'file 'type 'encoding 'mode 'name)
-     (mode . "play")
-     )
-    
-    ((type . "application/postscript")
-     (method "tm-ps" nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    ((type . "application/octet-stream")
-     (method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
-     (mode "play" "print")
-     )
-    
-    ;;((type . "message/external-body")
-    ;; (method "xterm" nil
-    ;;        "-e" "showexternal"
-    ;;         'file '"access-type" '"name" '"site" '"directory"))
-    ((type . "message/rfc822")
-     (method . mime-article/view-message/rfc822)
-     (mode . "play")
-     )
-    ((type . "message/partial")
-     (method . mime-article/decode-message/partial)
-     (mode . "play")
-     )
-    ((type . "message/external-body")
-     ("access-type" . "anon-ftp")
-     (method . mime-article/decode-message/external-ftp)
-     )
-    
-    ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file)
-     (mode . "play")
-     )
-    ((method "tm-file"  nil 'file 'type 'encoding 'mode 'name)
-     (mode . "extract")
-     )
-    ))
-
-(defvar mime-view-childrens-header-showing-Content-Type-list
-  '("message/rfc822" "message/news"))
-
-(defvar mime-view-visible-media-type-list
-  '("text/plain" nil "text/richtext" "text/enriched"
-    "text/rfc822-headers"
-    "text/x-latex" "application/x-latex"
-    "message/delivery-status"
-    "application/pgp" "text/x-pgp"
-    "application/octet-stream"
-    "application/x-selection" "application/x-comment")
-  "*List of media-types to be able to display in MIME-View buffer.
-Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".")
-
-(defvar mime-view-content-button-visible-ctype-list
-  '("application/pgp"))
-
-(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode"))
-
-(defvar mime-view-ignored-field-list
-  '(".*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. [mime-view.el]")
-
-(defvar mime-view-ignored-field-regexp
-  (concat "^"
-         (apply (function regexp-or) mime-view-ignored-field-list)
-         ":"))
+(defgroup mime-view nil
+  "MIME view mode"
+  :group 'mime)
+
+(defcustom mime-situation-examples-file "~/.mime-example"
+  "*File name of situation-examples demonstrated by user."
+  :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)))
+
+(defcustom mime-view-mailcap-files
+  (let ((files '("/etc/mailcap" "/usr/etc/mailcap" "~/.mailcap")))
+    (or (member mime-mailcap-file files)
+       (setq files (cons mime-mailcap-file files)))
+    files)
+  "List of mailcap files."
+  :group 'mime-view
+  :type '(repeat file))
+
+
+;;; @ in raw-buffer (representation space)
+;;;

 
 

-(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. [mime-view.el]")
+(defvar mime-preview-buffer nil
+  "MIME-preview buffer corresponding with the (raw) buffer.")
+(make-variable-buffer-local 'mime-preview-buffer)

 
 

-(defvar mime-view-visible-field-regexp
-  (concat "^"
-         (apply (function regexp-or) mime-view-visible-field-list)
-         ":"))

 
 

-(defvar mime-view-redisplay nil)
-
-(defvar mime-view-announcement-for-message/partial
-  (if (and (>= emacs-major-version 19) window-system)
-      "\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer          ]]
-\[[ or click here by mouse button-2.             ]]"
-    "\
-\[[ This is message/partial style split message. ]]
-\[[ Please press `v' key in this buffer.         ]]"
-    ))
+(defvar mime-raw-representation-type-alist
+  '((mime-show-message-mode     . binary)
+    (mime-temp-message-mode     . binary)
+    (t                          . cooked)
+    )
+  "Alist of major-mode vs. representation-type of mime-raw-buffer.
+Each element looks like (SYMBOL . REPRESENTATION-TYPE).  SYMBOL is
+major-mode or t.  t means default.  REPRESENTATION-TYPE must be
+`binary' or `cooked'.")

 
 
 
 

-;;; @@ predicate functions
+;;; @ in preview-buffer (presentation space)

 ;;;
 
 ;;;
 

-(defun mime-view-header-visible-p (rcnum cinfo)
-  "Return non-nil if header of current entity is visible."
-  (or (null rcnum)
-      (member (mime::content-info/type
-              (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
-             mime-view-childrens-header-showing-Content-Type-list)
-      ))
-
-(defun mime-view-body-visible-p (rcnum cinfo &optional ctype)
-  (let (ccinfo)
-    (or ctype
-       (setq ctype
-             (mime::content-info/type
-              (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
-              ))
+(defvar mime-mother-buffer nil
+  "Mother buffer corresponding with the (MIME-preview) buffer.
+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-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)

        )
        )

-    (and (member ctype mime-view-visible-media-type-list)
-        (if (string-equal ctype "application/octet-stream")
-            (progn
-              (or ccinfo
-                  (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo))
-                  )
-              (member (mime::content-info/encoding ccinfo)
-                      '(nil "7bit" "8bit"))
-              )
-          t))
-    ))
+    (cdr (assq 'major-mode
+              (get-text-property (or point
+                                     (if (> (point) (buffer-size))
+                                         (max (1- (point-max)) (point-min))
+                                       (point)))
+                                 'mime-view-situation)))))

 
 
 
 

-;;; @@ entity button
+;;; @ entity information

 ;;;
 
 ;;;
 

-(defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding)
-  "Insert entity-button."
-  (save-restriction
-    (narrow-to-region (point)(point))
-    (let ((access-type (assoc "access-type" params))
-         (num (or (cdr (assoc "x-part-number" params))
-                  (if (consp rcnum)
-                      (mapconcat (function
-                                  (lambda (num)
-                                    (format "%s" (1+ num))
-                                    ))
-                                 (reverse rcnum) ".")
-                    "0"))
-              ))
-      (cond (access-type
-            (let ((server (assoc "server" params)))
-              (setq access-type (cdr access-type))
-              (if server
-                  (insert (format "[%s %s ([%s] %s)]\n" num subj
-                                  access-type (cdr server)))
-                (let ((site (cdr (assoc "site" params)))
-                      (dir (cdr (assoc "directory" params)))
-                      )
-                  (insert (format "[%s %s ([%s] %s:%s)]\n" num subj
-                                  access-type site dir))
-                  )))
-            )
-           (t
-            (let ((charset (cdr (assoc "charset" params))))
-              (insert (concat "[" num " " subj))
-              (let ((rest
-                     (concat " <" ctype
-                             (if charset
-                                 (concat "; " charset)
-                               (if encoding (concat " (" encoding ")"))
-                               )
-                             ">]\n")))
-                (if (>= (+ (current-column)(length rest))(window-width))
-                    (insert "\n\t")
-                  )
-                (insert rest)
-                ))))
+(defun mime-entity-situation (entity &optional situation)
+  "Return situation of ENTITY."
+  (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))

       )
       )

-    (mime-add-button (point-min)(1- (point-max))
-                    (function mime-view-play-current-entity))
-    ))
-
-(defun mime-view-entity-button-function
-  (rcnum cinfo ctype params subj encoding)
-  "Insert entity button conditionally."
-  (or (null rcnum)
-      (string= ctype "application/x-selection")
-      (and (string= ctype "application/octet-stream")
-          (string= (mime::content-info/type
-                    (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo))
-                   "multipart/encrypted"))
-      (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding)
-      ))
-
-
-;;; @@ content header filter
-;;;
+    (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))
+
+(defsubst mime-delq-null-situation (situations field
+                                              &rest ignored-values)
+  (let (dest)
+    (while situations
+      (let* ((situation (car situations))
+            (cell (assq field situation)))
+       (if cell
+           (or (memq (cdr cell) ignored-values)
+               (setq dest (cons situation dest))
+               )))
+      (setq situations (cdr situations)))
+    dest))

 
 

-(defun mime-preview/cut-header ()
-  (goto-char (point-min))
-  (while (and
-         (re-search-forward mime-view-ignored-field-regexp nil t)
-         (let* ((beg (match-beginning 0))
-                (end (match-end 0))
-                (name (buffer-substring beg end))
-                )
-           (if (not (string-match mime-view-visible-field-regexp name))
-               (delete-region
-                beg
-                (save-excursion
-                  (and
-                   (re-search-forward "^\\([^ \t]\\|$\\)" nil t)
-                   (match-beginning 0)
-                   )))
-             )
-           t)))
-  )
+(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-view-default-content-header-filter ()
-  (mime-preview/cut-header)
-  (eword-decode-header)
+(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))
+             )))

   )
 
   )
 

-(defvar mime-view-content-header-filter-alist nil)
-
-
-;;; @@ content filter
-;;;
-
-(defvar mime-view-content-filter-alist
-  '(("text/enriched" . mime-preview/filter-for-text/enriched)
-    ("text/richtext" . mime-preview/filter-for-text/richtext)
-    (t . mime-preview/filter-for-text/plain)
+(defun mime-unify-situations (entity-situation
+                             condition situation-examples
+                             &optional required-name ignored-value
+                             every-situations)
+  (let (ret)
+    (in-calist-package 'mime-view)
+    (setq ret
+         (ctree-find-calist condition entity-situation
+                            every-situations))
+    (if required-name
+       (setq ret (mime-delq-null-situation ret required-name
+                                           ignored-value t)))
+    (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)
+      ""))

 
 

-;;; @@ content separator
-;;;
-
-(defun mime-view-entity-separator-function (rcnum cinfo ctype params subj)
-  (if (and (not (mime-view-header-visible-p rcnum cinfo))
-          (not (mime-view-body-visible-p rcnum cinfo ctype))
-          )
-      (progn
-       (goto-char (point-max))
-       (insert "\n")
-       )))
-
+(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)
+(defvar mime-situation-examples-file-coding-system nil)
+
+(defun mime-view-read-situation-examples-file (&optional file)
+  (or file
+      (setq file mime-situation-examples-file))
+  (if (and file
+          (file-readable-p file))
+      (with-temp-buffer
+       (insert-file-contents file)
+       (setq mime-situation-examples-file-coding-system
+              (static-cond
+              ((boundp 'buffer-file-coding-system)
+               (symbol-value 'buffer-file-coding-system))
+              ((boundp 'file-coding-system)
+               (symbol-value 'file-coding-system))
+              (t nil))
+             ;; (and (boundp 'buffer-file-coding-system)
+              ;;      buffer-file-coding-system)
+             )
+       (condition-case error
+           (eval-buffer)
+         (error (message "%s is broken: %s" file (cdr error))))
+       ;; 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))))))
+
+(defun mime-save-situation-examples ()
+  (if (or mime-preview-situation-example-list
+         mime-acting-situation-example-list)
+      (let ((file mime-situation-examples-file)
+           print-length print-level)
+       (with-temp-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")
+         (static-cond
+          ((boundp 'buffer-file-coding-system)
+           (setq buffer-file-coding-system
+                 mime-situation-examples-file-coding-system))
+          ((boundp 'file-coding-system)
+           (setq file-coding-system
+                 mime-situation-examples-file-coding-system)))
+         ;; (setq buffer-file-coding-system
+         ;;       mime-situation-examples-file-coding-system)
+         (setq buffer-file-name file)
+         (save-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.
+      )))

 
 

-;;; @@ buffer local variables
-;;;

 
 

-;;; @@@ in raw buffer
+;;; @ presentation of preview

 ;;;
 
 ;;;
 

-(make-variable-buffer-local 'mime::article/content-info)
-
-(defvar mime::article/preview-buffer nil)
-(make-variable-buffer-local 'mime::article/preview-buffer)
-
-
-;;; @@@ in view buffer
+;;; @@ entity-button

 ;;;
 
 ;;;
 

-(make-variable-buffer-local 'mime::preview/mother-buffer)
-(make-variable-buffer-local 'mime::preview/content-list)
-
-(defvar mime::preview/article-buffer nil)
-(make-variable-buffer-local 'mime::preview/article-buffer)
-
-(make-variable-buffer-local 'mime::preview/original-major-mode)
-(make-variable-buffer-local 'mime::preview/original-window-configuration)
-
-
-;;; @@ quitting method
+;;; @@@ predicate function

 ;;;
 
 ;;;
 

-(defvar mime-view-quitting-method-alist
-  '((mime/show-message-mode
-     . mime-view-quitting-method-for-mime/show-message-mode)))
-
-(defvar mime-view-over-to-previous-method-alist nil)
-(defvar mime-view-over-to-next-method-alist nil)
-
-(defvar mime-view-show-summary-method nil)
-
-
-;;; @@ following method
+;; (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

 ;;;
 
 ;;;
 

-(defvar mime-view-following-method-alist nil)
-
-(defvar mime-view-following-required-fields-list
-  '("From"))
+(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))
+       (subject (mime-view-entity-title entity)))
+    (mime-insert-button
+     (let ((access-type (assoc "access-type" params))
+          (num (or (cdr (assoc "x-part-number" params))
+                   (if (consp entity-node-id)
+                       (mapconcat (function
+                                   (lambda (num)
+                                     (format "%s" (1+ num))
+                                     ))
+                                  (reverse entity-node-id) ".")
+                     "0"))
+               ))
+       (cond (access-type
+             (let ((server (assoc "server" params)))
+               (setq access-type (cdr access-type))
+               (if server
+                   (format "%s %s ([%s] %s)"
+                           num subject access-type (cdr server))
+               (let ((site (cdr (assoc "site" params)))
+                     (dir (cdr (assoc "directory" params)))
+                     (url (cdr (assoc "url" params)))
+                     )
+                 (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
+           (let* ((charset (cdr (assoc "charset" params)))
+                  (encoding (mime-entity-encoding entity))
+                  (rest (format " <%s/%s%s%s>"
+                                (mime-entity-media-type entity)
+                                (mime-entity-media-subtype entity)
+                                (if charset
+                                    (concat "; " charset)
+                                  "")
+                                (if encoding
+                                    (concat " (" encoding ")")
+                                  ""))))
+             (concat
+              num " " subject
+              (if (>= (+ (current-column)(length rest))(window-width))
+                  "\n\t")
+              rest))
+           )))
+     (function mime-preview-play-current-entity))
+    ))

 
 
 
 

-;;; @@ X-Face
+;;; @@ entity-header

 ;;;
 
 ;;;
 

-;; 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)
-         ))))
-
+(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).")

 
 

-;;; @@ utility
-;;;
+(defvar mime-view-ignored-field-list
+  '(".*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.")

 
 

-(defun mime-preview/get-original-major-mode ()
-  (if mime::preview/mother-buffer
-      (save-excursion
-       (set-buffer mime::preview/mother-buffer)
-       (mime-preview/get-original-major-mode)
-       )
-    mime::preview/original-major-mode))
+(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.")

 
 
 
 

-;;; @ data structures
+;;; @@ entity-body

 ;;;
 
 ;;;
 

-;;; @@ preview-content-info
+;;; @@@ predicate function

 ;;;
 
 ;;;
 

-(define-structure mime::preview-content-info
-  point-min point-max buffer content-info)
+(in-calist-package 'mime-view)

 
 

-
-;;; @ buffer setup
+(defun mime-calist::field-match-method-as-default-rule (calist
+                                                       field-type field-value)
+  (let ((s-field (assq field-type calist)))
+    (cond ((null s-field)
+          (cons (cons field-type field-value) calist)
+          )
+         (t calist))))
+
+(define-calist-field-match-method
+  'header #'mime-calist::field-match-method-as-default-rule)
+
+(define-calist-field-match-method
+  'body #'mime-calist::field-match-method-as-default-rule)
+
+
+(defvar mime-preview-condition nil
+  "Condition-tree about how to display entity.")
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . octet-stream)
+                          (encoding . nil)
+                          (body . visible)))
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . octet-stream)
+                          (encoding . "7bit")
+                          (body . visible)))
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . octet-stream)
+                          (encoding . "8bit")
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . pgp)
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . x-latex)
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . x-selection)
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . application)(subtype . x-comment)
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition '((type . message)(subtype . delivery-status)
+                          (body . visible)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((body . visible)
+   (body-presentation-method . mime-display-text/plain)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . nil)
+   (body . visible)
+   (body-presentation-method . mime-display-text/plain)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . text)(subtype . enriched)
+   (body . visible)
+   (body-presentation-method . mime-display-text/enriched)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . text)(subtype . richtext)
+   (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)
+   (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)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . multipart)(subtype . alternative)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/alternative)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . multipart)(subtype . related)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/related)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . multipart)(subtype . t)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . partial)
+   (body . visible)
+   (body-presentation-method . mime-display-message/partial-button)))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . rfc822)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+                       (entity-button . invisible))))
+
+(ctree-set-calist-strictly
+ 'mime-preview-condition
+ '((type . message)(subtype . news)
+   (body . visible)
+   (body-presentation-method . mime-display-multipart/mixed)
+   (childrens-situation (header . visible)
+                       (entity-button . invisible))))
+
+
+;;; @@@ entity presentation

 ;;;
 
 ;;;
 

-(defun mime-view-setup-buffer (&optional ctl encoding ibuf obuf)
-  (if ibuf
-      (progn
-       (get-buffer ibuf)
-       (set-buffer ibuf)
-       ))
-  (or mime-view-redisplay
-      (setq mime::article/content-info (mime-parse-message ctl encoding))
+(defun mime-display-text/plain (entity situation)
+  (save-restriction
+    (narrow-to-region (point-max)(point-max))
+    (condition-case nil
+       (mime-insert-text-content entity)
+      (error (progn
+              (message "Can't decode current entity.")
+              (sit-for 1))))
+    (run-hooks 'mime-text-decode-hook)
+    (goto-char (point-max))
+    (if (not (eq (char-after (1- (point))) ?\n))
+       (insert "\n")

       )
       )

-  (let ((ret (mime-view-make-preview-buffer obuf)))
-    (setq mime::article/preview-buffer (car ret))
-    ret))
-
-(defun mime-view-make-preview-buffer (&optional obuf)
-  (let* ((cinfo mime::article/content-info)
-        (pcl (mime/flatten-content-info cinfo))
-        (dest (make-list (length pcl) nil))
-        (the-buf (current-buffer))
-        (mode major-mode)
-        )
-    (or obuf
-       (setq obuf (concat "*Preview-" (buffer-name the-buf) "*")))
-    (set-buffer (get-buffer-create obuf))
-    (setq buffer-read-only nil)
-    (widen)
-    (erase-buffer)
-    (setq mime::preview/article-buffer the-buf)
-    (setq mime::preview/original-major-mode mode)
-    (setq major-mode 'mime-view-mode)
-    (setq mode-name "MIME-View")
-    (let ((drest dest))
-      (while pcl
-       (setcar drest
-               (mime-preview/display-content (car pcl) cinfo the-buf obuf))
-       (setq pcl (cdr pcl)
-             drest (cdr drest))
-       ))
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (set-buffer the-buf)
-    (list obuf dest)
+    (mime-add-url-buttons)
+    (run-hooks 'mime-display-text/plain-hook)

     ))
 
     ))
 

-(defun mime-preview/display-content (content cinfo ibuf obuf)
-  (let* ((beg (mime::content-info/point-min content))
-        (end (mime::content-info/point-max content))
-        (ctype (mime::content-info/type content))
-        (params (mime::content-info/parameters content))
-        (encoding (mime::content-info/encoding content))
-        (rcnum (mime::content-info/rcnum content))
-        he e nb ne subj)
-    (set-buffer ibuf)
-    (goto-char beg)
-    (setq he (if (re-search-forward "^$" nil t)
-                (1+ (match-end 0))
-              end))
-    (if (> he end)
-       (setq he end)
-      )
-    (save-restriction
-      (narrow-to-region beg end)
-      (setq subj
-           (eword-decode-string
-            (mime-article/get-subject params encoding)))
-      )
-    (set-buffer obuf)
-    (setq nb (point))
-    (narrow-to-region nb nb)
-    (mime-view-entity-button-function rcnum cinfo ctype params subj encoding)
-    (if (mime-view-header-visible-p rcnum cinfo)
-       (mime-preview/display-header beg he)
-      )
-    (if (and (null rcnum)
-            (member
-             ctype mime-view-content-button-visible-ctype-list))
-       (save-excursion
-         (goto-char (point-max))
-         (mime-view-insert-entity-button
-          rcnum cinfo ctype params subj encoding)
-         ))
-    (cond ((mime-view-body-visible-p rcnum cinfo ctype)
-          (mime-preview/display-body he end
-                                     rcnum cinfo ctype params subj encoding)
-          )
-         ((equal ctype "message/partial")
-          (mime-preview/display-message/partial)
-          )
-         ((and (null rcnum)
-               (null (mime::content-info/children cinfo))
-               )
-          (goto-char (point-max))
-          (mime-view-insert-entity-button
-           rcnum cinfo ctype params subj encoding)
-          ))
-    (mime-view-entity-separator-function rcnum cinfo ctype params subj)
-    (prog1
-       (progn
-         (setq ne (point-max))
-         (widen)
-         (mime::preview-content-info/create nb (1- ne) ibuf content)
-         )
-      (goto-char ne)
-      )))
-
-(defun mime-preview/display-header (beg end)
+(defun mime-display-text/richtext (entity situation)

   (save-restriction
   (save-restriction

-    (narrow-to-region (point)(point))
-    (insert-buffer-substring mime::preview/article-buffer beg end)
-    (let ((f (cdr (assq mime::preview/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)
-    ))
+    (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-preview/display-body (beg end
-                                     rcnum cinfo ctype params subj encoding)
+(defun mime-display-text/enriched (entity situation)

   (save-restriction
     (narrow-to-region (point-max)(point-max))
   (save-restriction
     (narrow-to-region (point-max)(point-max))

-    (insert-buffer-substring mime::preview/article-buffer beg end)
-    (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist)
-                     (assq t mime-view-content-filter-alist)))))
-      (and (functionp f)
-          (funcall f ctype params encoding)
-          )
+    (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))

       )))
 
       )))
 

-(defun mime-preview/display-message/partial ()
+
+(defvar mime-view-announcement-for-message/partial
+  (if (and (>= emacs-major-version 19) window-system)
+      "\
+\[[ This is message/partial style split message. ]]
+\[[ Please press `v' key in this buffer          ]]
+\[[ or click here by mouse button-2.             ]]"
+    "\
+\[[ This is message/partial style split message. ]]
+\[[ Please press `v' key in this buffer.         ]]"
+    ))
+
+(defun mime-display-message/partial-button (&optional entity situation)

   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
        (insert "\n")
       )
   (save-restriction
     (goto-char (point-max))
     (if (not (search-backward "\n\n" nil t))
        (insert "\n")
       )

-    (let ((be (point-max)))
-      (narrow-to-region be be)
-      (insert mime-view-announcement-for-message/partial)
-      (mime-add-button (point-min)(point-max)
-                      (function mime-view-play-current-entity))
+    (goto-char (point-max))
+    (narrow-to-region (point-max)(point-max))
+    (insert mime-view-announcement-for-message/partial)
+    (mime-add-button (point-min)(point-max)
+                    #'mime-preview-play-current-entity)
+    ))
+
+(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))

       )))
 
       )))
 

-(defun mime-article/get-uu-filename (param &optional encoding)
-  (if (member (or encoding
-                 (cdr (assq 'encoding param))
-                 )
-             mime-view-uuencode-encoding-name-list)
-      (save-excursion
-       (or (if (re-search-forward "^begin [0-9]+ " nil t)
-               (if (looking-at ".+$")
-                   (buffer-substring (match-beginning 0)(match-end 0))
-                 ))
-           ""))
-    ))
+(defcustom mime-view-type-subtype-score-alist
+  '(((text . enriched) . 3)
+    ((text . richtext) . 2)
+    ((text . plain)    . 1)
+    (t . 0))
+  "Alist MEDIA-TYPE vs corresponding score.
+MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
+  :group 'mime-view
+  :type '(repeat (cons (choice :tag "Media-Type"
+                              (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)
+    (if original-major-mode-cell
+       (setq default-situation
+             (cons original-major-mode-cell default-situation)))
+    (setq situations
+         (mapcar (function
+                  (lambda (child)
+                    (let ((situation
+                           (mime-find-entity-preview-situation
+                            child default-situation)))
+                      (if (cdr (assq 'body-presentation-method situation))
+                          (let ((score
+                                 (cdr
+                                  (or (assoc
+                                       (cons
+                                        (cdr (assq 'type situation))
+                                        (cdr (assq 'subtype situation)))
+                                       mime-view-type-subtype-score-alist)
+                                      (assq
+                                       (cdr (assq 'type situation))
+                                       mime-view-type-subtype-score-alist)
+                                      (assq
+                                       t
+                                       mime-view-type-subtype-score-alist)
+                                      ))))
+                            (if (> score max-score)
+                                (setq p i
+                                      max-score score)
+                              )))
+                      (setq i (1+ i))
+                      situation)
+                    ))
+                 children))
+    (setq i 0)
+    (while children
+      (let ((child (car children))
+           (situation (car situations)))
+       (mime-display-entity child (if (= i p)
+                                      situation
+                                    (put-alist 'body 'invisible
+                                               (copy-alist situation)))))
+      (setq children (cdr children)
+           situations (cdr situations)
+           i (1+ i)))))
+
+(defun mime-display-multipart/related (entity situation)
+  (let* ((param-start (mime-parse-msg-id
+                      (std11-lexical-analyze
+                       (cdr (assoc "start"
+                                   (mime-content-type-parameters
+                                    (mime-entity-content-type entity)))))))
+        (start (or (and param-start (mime-find-entity-from-content-id
+                                     param-start
+                                     entity))
+                   (car (mime-entity-children entity))))
+        (original-major-mode-cell (assq 'major-mode situation))
+        (default-situation (cdr (assq 'childrens-situation situation))))
+    (if original-major-mode-cell
+       (setq default-situation
+             (cons original-major-mode-cell default-situation)))
+    (mime-display-entity start nil default-situation)))
+
+;;; @ acting-condition
+;;;

 
 

-(defun mime-article/get-subject (param &optional encoding)
-  (or (std11-find-field-body '("Content-Description" "Subject"))
-      (let (ret)
-       (if (or (and (setq ret (mime/Content-Disposition))
-                    (setq ret (assoc "filename" (cdr ret)))
-                    )
-               (setq ret (assoc "name" param))
-               (setq ret (assoc "x-name" param))
-               )
-           (std11-strip-quoted-string (cdr ret))
-         ))
-      (mime-article/get-uu-filename param encoding)
-      ""))
+(defvar mime-acting-condition nil
+  "Condition-tree about how to process entity.")
+
+(defun mime-view-read-mailcap-files (&optional files)
+  (or files
+      (setq files mime-view-mailcap-files))
+  (let (entries file)
+    (while files
+      (setq file (car files))
+      (if (file-readable-p file)
+         (setq entries (append entries (mime-parse-mailcap-file file))))
+      (setq files (cdr files)))
+    (while entries
+      (let ((entry (car entries))
+           view print shared)
+       (while entry
+         (let* ((field (car entry))
+                (field-type (car field)))
+           (cond ((eq field-type 'view)  (setq view field))
+                 ((eq field-type 'print) (setq print field))
+                 ((memq field-type '(compose composetyped edit)))
+                 (t (setq shared (cons field shared))))
+           )
+         (setq entry (cdr entry)))
+       (setq shared (nreverse shared))
+       (ctree-set-calist-with-default
+        'mime-acting-condition
+        (append shared (list '(mode . "play")(cons 'method (cdr view)))))
+       (if print
+           (ctree-set-calist-with-default
+            'mime-acting-condition
+            (append shared
+                    (list '(mode . "print")(cons 'method (cdr view)))))))
+      (setq entries (cdr entries)))))
+
+(mime-view-read-mailcap-files)
+
+(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-save-content)))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . text)(subtype . x-rot13-47)(mode . "play")
+   (method . mime-view-caesar)
+   ))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . text)(subtype . x-rot13-47-48)(mode . "play")
+   (method . mime-view-caesar)
+   ))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . message)(subtype . rfc822)(mode . "play")
+   (method . mime-view-message/rfc822)
+   ))
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . message)(subtype . partial)(mode . "play")
+   (method . mime-store-message/partial-piece)
+   ))
+
+(ctree-set-calist-strictly
+ 'mime-acting-condition
+ '((type . message)(subtype . external-body)
+   ("access-type" . "anon-ftp")
+   (method . mime-view-message/external-anon-ftp)
+   ))
+
+(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-save-content)
+   ))
+
+
+;;; @ quitting method
+;;;
+
+(defvar mime-preview-quitting-method-alist
+  '((mime-show-message-mode
+     . mime-preview-quitting-method-for-mime-show-message-mode))
+  "Alist of major-mode vs. quitting-method of mime-view.")

 
 

+(defvar mime-preview-over-to-previous-method-alist nil
+  "Alist of major-mode vs. over-to-previous-method of mime-view.")

 
 

-;;; @ content information
+(defvar mime-preview-over-to-next-method-alist nil
+  "Alist of major-mode vs. over-to-next-method of mime-view.")
+
+
+;;; @ following method

 ;;;
 
 ;;;
 

-(defun mime-article/point-content-number (p &optional cinfo)
-  (or cinfo
-      (setq cinfo mime::article/content-info)
-      )
-  (let ((b (mime::content-info/point-min cinfo))
-       (e (mime::content-info/point-max cinfo))
-       (c (mime::content-info/children cinfo))
-       )
-    (if (and (<= b p)(<= p e))
-       (or (let (co ret (sn 0))
-             (catch 'tag
-               (while c
-                 (setq co (car c))
-                 (setq ret (mime-article/point-content-number p co))
-                 (cond ((eq ret t) (throw 'tag (list sn)))
-                       (ret (throw 'tag (cons sn ret)))
-                       )
-                 (setq c (cdr c))
-                 (setq sn (1+ sn))
-                 )))
-           t))))
+(defvar mime-preview-following-method-alist nil
+  "Alist of major-mode vs. following-method of mime-view.")

 
 

-(defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo)
-  (or cinfo
-      (setq cinfo mime::article/content-info)
-      )
-  (find-if (function
-           (lambda (ci)
-             (equal (mime::content-info/rcnum ci) rcnum)
-             ))
-          (mime/flatten-content-info cinfo)
-          ))
+(defvar mime-view-following-required-fields-list
+  '("From"))

 
 

-(defun mime-article/cnum-to-cinfo (cn &optional cinfo)
-  (or cinfo
-      (setq cinfo mime::article/content-info)
-      )
-  (if (eq cn t)
-      cinfo
-    (let ((sn (car cn)))
-      (if (null sn)
-         cinfo
-       (let ((rc (nth sn (mime::content-info/children cinfo))))
-         (if rc
-             (mime-article/cnum-to-cinfo (cdr cn) rc)
-           ))
-       ))))

 
 

-(defun mime/flatten-content-info (&optional cinfo)
-  (or cinfo
-      (setq cinfo mime::article/content-info)
-      )
-  (let ((dest (list cinfo))
-       (rcl (mime::content-info/children cinfo))
-       )
-    (while rcl
-      (setq dest (nconc dest (mime/flatten-content-info (car rcl))))
-      (setq rcl (cdr rcl))
-      )
-    dest))
+;;; @ buffer setup
+;;;

 
 

-(defun mime-preview/point-pcinfo (p &optional pcl)
-  (or pcl
-      (setq pcl mime::preview/content-list)
-      )
-  (catch 'tag
-    (let ((r pcl) cell)
-      (while r
-       (setq cell (car r))
-       (if (and (<= (mime::preview-content-info/point-min cell) p)
-                (<= p (mime::preview-content-info/point-max cell))
-                )
-           (throw 'tag cell)
+(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)
+    (in-calist-package 'mime-view)
+    (or situation
+       (setq situation
+             (mime-find-entity-preview-situation entity default-situation)))
+    (let ((button-is-invisible
+          (eq (cdr (or (assq '*entity-button situation)
+                       (assq 'entity-button situation)))
+              'invisible))
+         (header-is-visible
+          (eq (cdr (or (assq '*header situation)
+                       (assq 'header situation)))
+              'visible))
+         (body-is-visible
+          (eq (cdr (or (assq '*body situation)
+                       (assq 'body situation)))
+              'visible))
+         (children (mime-entity-children entity)))
+      (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)
+          ;;   )

          )
          )

-       (setq r (cdr r))
-       ))
-    (car (last pcl))
-    ))
+      (if header-is-visible
+         (let ((header-presentation-method
+                (or (cdr (assq 'header-presentation-method situation))
+                    (cdr (assq (cdr (assq 'major-mode situation))
+                               mime-header-presentation-method-alist)))))
+           (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))
+      (unless children
+       (if body-is-visible
+           (let ((body-presentation-method
+                  (cdr (assq 'body-presentation-method situation))))
+             (if (functionp body-presentation-method)
+                 (funcall body-presentation-method entity situation)
+               (mime-display-text/plain entity situation)))
+         (when button-is-invisible
+           (goto-char (point-max))
+           (mime-view-insert-entity-button entity)
+           )
+         (unless header-is-visible
+           (goto-char (point-max))
+           (insert "\n"))
+         ))
+      (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 (and children body-is-visible)
+         (let ((body-presentation-method
+                (cdr (assq 'body-presentation-method situation))))
+           (if (functionp body-presentation-method)
+               (funcall body-presentation-method entity situation)
+             (mime-display-multipart/mixed entity situation))))
+      )))

 
 
 ;;; @ MIME viewer mode
 
 
 ;;; @ MIME viewer mode

@@ -702,19 +1148,18 @@ The compressed face will be piped to this command.")
 
 (defconst mime-view-menu-title "MIME-View")
 (defconst mime-view-menu-list
 
 (defconst mime-view-menu-title "MIME-View")
 (defconst mime-view-menu-list

-  '((up                 "Move to upper content"      mime-view-up-content)
-    (previous   "Move to previous content"   mime-view-previous-content)
-    (next       "Move to next content"       mime-view-next-content)
-    (scroll-down "Scroll to previous content" mime-view-scroll-down-content)
-    (scroll-up  "Scroll to next content"     mime-view-scroll-up-content)
-    (play       "Play Content"               mime-view-play-current-entity)
-    (extract    "Extract Content"            mime-view-extract-current-entity)
-    (print      "Print"                      mime-view-print-current-entity)
-    (x-face     "Show X Face"                mime-view-display-x-face)
+  '((up                 "Move to upper entity"    mime-preview-move-to-upper)
+    (previous   "Move to previous entity" mime-preview-move-to-previous)
+    (next       "Move to next entity"     mime-preview-move-to-next)
+    (scroll-down "Scroll-down"             mime-preview-scroll-down-entity)
+    (scroll-up  "Scroll-up"               mime-preview-scroll-up-entity)
+    (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)

     )
   "Menu for MIME Viewer")
 
     )
   "Menu for MIME Viewer")
 

-(cond (running-xemacs
+(cond ((featurep 'xemacs)

        (defvar mime-view-xemacs-popup-menu
         (cons mime-view-menu-title
               (mapcar (function
        (defvar mime-view-xemacs-popup-menu
         (cons mime-view-menu-title
               (mapcar (function

@@ -729,69 +1174,120 @@ The compressed face will be piped to this command.")
         (set-buffer (event-buffer event))
         (popup-menu 'mime-view-xemacs-popup-menu))
        (defvar mouse-button-2 'button2)
         (set-buffer (event-buffer event))
         (popup-menu 'mime-view-xemacs-popup-menu))
        (defvar mouse-button-2 'button2)

+       (defvar mouse-button-3 'button3)

        )
       (t
        )
       (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])
        (defvar mouse-button-2 [mouse-2])

+       (defvar mouse-button-3 [mouse-3])

        ))
 
 (defun mime-view-define-keymap (&optional default)
   (let ((mime-view-mode-map (if (keymapp default)
                                (copy-keymap default)
        ))
 
 (defun mime-view-define-keymap (&optional default)
   (let ((mime-view-mode-map (if (keymapp default)
                                (copy-keymap default)

-                             (make-sparse-keymap)
-                             )))
+                             (make-sparse-keymap))))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "u"        (function mime-view-up-content))
+      "u"        (function mime-preview-move-to-upper))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "p"        (function mime-view-previous-content))
+      "p"        (function mime-preview-move-to-previous))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "n"        (function mime-view-next-content))
+      "n"        (function mime-preview-move-to-next))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\e\t"     (function mime-view-previous-content))
+      "\e\t"     (function mime-preview-move-to-previous))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\t"       (function mime-view-next-content))
+      "\t"       (function mime-preview-move-to-next))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      " "        (function mime-view-scroll-up-content))
+      " "        (function mime-preview-scroll-up-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\M- "     (function mime-view-scroll-down-content))
+      "\M- "     (function mime-preview-scroll-down-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\177"     (function mime-view-scroll-down-content))
+      "\177"     (function mime-preview-scroll-down-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\C-m"     (function mime-view-next-line-content))
+      "\C-m"     (function mime-preview-next-line-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\C-\M-m"  (function mime-view-previous-line-content))
+      "\C-\M-m"  (function mime-preview-previous-line-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "v"        (function mime-view-play-current-entity))
+      "v"        (function mime-preview-play-current-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "e"        (function mime-view-extract-current-entity))
+      "e"        (function mime-preview-extract-current-entity))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\C-c\C-p" (function mime-view-print-current-entity))
+      "\C-c\C-p" (function mime-preview-print-current-entity))
+

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "a"        (function mime-view-follow-content))
+      "\C-c\C-t\C-f" (function mime-preview-toggle-header))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "q"        (function mime-view-quit))
+      "\C-c\C-th" (function mime-preview-toggle-header))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "h"        (function mime-view-show-summary))
+      "\C-c\C-t\C-c" (function mime-preview-toggle-content))
+

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "\C-c\C-x" (function mime-view-kill-buffer))
+      "\C-c\C-v\C-f" (function mime-preview-show-header))

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      "<"        (function beginning-of-buffer))
+      "\C-c\C-vh" (function mime-preview-show-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-v\C-c" (function mime-preview-show-content))
+

     (define-key mime-view-mode-map
     (define-key mime-view-mode-map

-      ">"        (function end-of-buffer))
+      "\C-c\C-d\C-f" (function mime-preview-hide-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-dh" (function mime-preview-hide-header))
+    (define-key mime-view-mode-map
+      "\C-c\C-d\C-c" (function mime-preview-hide-content))
+
+    (define-key mime-view-mode-map
+      "a"        (function mime-preview-follow-current-entity))
+    (define-key mime-view-mode-map
+      "q"        (function mime-preview-quit))
+    (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))
+    ;; (define-key mime-view-mode-map
+    ;;   ">"        (function end-of-buffer))

     (define-key mime-view-mode-map
       "?"        (function describe-mode))
     (define-key mime-view-mode-map
       "?"        (function describe-mode))

+    (define-key mime-view-mode-map
+      [tab] (function mime-preview-move-to-next))
+    (define-key mime-view-mode-map
+      [delete] (function mime-preview-scroll-down-entity))
+    (define-key mime-view-mode-map
+      [backspace] (function mime-preview-scroll-down-entity))

     (if (functionp default)
     (if (functionp default)

-       (setq mime-view-mode-map
-             (append mime-view-mode-map (list (cons t default)))
-             ))
+       (cond ((featurep 'xemacs)
+              (set-keymap-default-binding mime-view-mode-map default)
+              )
+             (t
+              (setq mime-view-mode-map
+                    (append mime-view-mode-map (list (cons t default))))
+              )))

     (if mouse-button-2
        (define-key mime-view-mode-map
          mouse-button-2 (function mime-button-dispatcher))
       )
     (if mouse-button-2
        (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-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)))
           (define-key mime-view-mode-map [menu-bar mime-view]
             (cons mime-view-menu-title
                   (make-sparse-keymap mime-view-menu-title)))

@@ -799,17 +1295,133 @@ The compressed face will be piped to this command.")
                    (lambda (item)
                      (define-key mime-view-mode-map
                        (vector 'menu-bar 'mime-view (car item))
                    (lambda (item)
                      (define-key mime-view-mode-map
                        (vector 'menu-bar 'mime-view (car item))

-                       (cons (nth 1 item)(nth 2 item))
-                       )
+                       (cons (nth 1 item)(nth 2 item)))

                      ))
                      ))

-                  (reverse mime-view-menu-list)
-                  )
+                  (reverse mime-view-menu-list))

           ))
           ))

-    (use-local-map mime-view-mode-map)
-    (run-hooks 'mime-view-define-keymap-hook)
-    ))
+    ;; (run-hooks 'mime-view-define-keymap-hook)
+    mime-view-mode-map))
+
+(defvar mime-view-mode-default-map (mime-view-define-keymap))
+

 
 

-(defun mime-view-mode (&optional mother ctl encoding ibuf obuf
+(defsubst mime-maybe-hide-echo-buffer ()
+  "Clear mime-echo buffer and delete window for it."
+  (let ((buf (get-buffer mime-echo-buffer-name)))
+    (if buf
+       (save-excursion
+         (set-buffer buf)
+         (erase-buffer)
+         (let ((win (get-buffer-window buf)))
+           (if win
+               (delete-window win)
+             ))
+         (bury-buffer buf)
+         ))))
+
+(defvar mime-view-redisplay nil)
+
+;;;###autoload
+(defun mime-display-message (message &optional preview-buffer
+                                    mother default-keymap-or-function
+                                    original-major-mode keymap)
+  "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.
+
+Optional argument ORIGINAL-MAJOR-MODE is major-mode of representation
+buffer of MESSAGE.  If it is nil, current `major-mode' is used.
+
+Optional argument KEYMAP is keymap of MIME-View mode.  If it is
+non-nil, DEFAULT-KEYMAP-OR-FUNCTION is ignored.  If it is nil,
+`mime-view-mode-default-map' is used."
+  (mime-maybe-hide-echo-buffer)
+  (let ((win-conf (current-window-configuration)))
+    (or preview-buffer
+       (setq preview-buffer
+             (concat "*Preview-" (mime-entity-name message) "*")))
+    (or original-major-mode
+       (setq original-major-mode major-mode))
+    (let ((inhibit-read-only t))
+      (set-buffer (get-buffer-create preview-buffer))
+      (widen)
+      (erase-buffer)
+      (if mother
+         (setq mime-mother-buffer mother))
+      (setq mime-preview-original-window-configuration win-conf)
+      (setq major-mode 'mime-view-mode)
+      (setq mode-name "MIME-View")
+      (mime-display-entity message nil
+                          `((entity-button . invisible)
+                            (header . visible)
+                            (major-mode . ,original-major-mode))
+                          preview-buffer)
+      (use-local-map
+       (or keymap
+          (if default-keymap-or-function
+              (mime-view-define-keymap default-keymap-or-function)
+            mime-view-mode-default-map)))
+      (let ((point
+            (next-single-property-change (point-min) 'mime-view-entity)))
+       (if point
+           (goto-char point)
+         (goto-char (point-min))
+         (search-forward "\n\n" nil t)))
+      (run-hooks 'mime-view-mode-hook)
+      (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
+                                  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)
+  (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

                                 default-keymap-or-function)
   "Major mode for viewing MIME message.
 
                                 default-keymap-or-function)
   "Major mode for viewing MIME message.
 

@@ -829,370 +1441,437 @@ 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.
 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)
 q              Quit
 button-2       Move to point under the mouse cursor
                and decode current content as `play mode'
 "
   (interactive)

-  (let ((buf (get-buffer mime/output-buffer-name)))
-    (if buf
-       (save-excursion
-         (set-buffer buf)
-         (erase-buffer)
-         )))
-  (let ((ret (mime-view-setup-buffer ctl encoding ibuf obuf))
-       (win-conf (current-window-configuration))
+  (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 mime-message-structure ctl))

        )
        )

-    (prog1
-       (switch-to-buffer (car ret))
-      (setq mime::preview/original-window-configuration win-conf)
-      (if mother
-         (progn
-           (setq mime::preview/mother-buffer mother)
-           ))
-      (mime-view-define-keymap default-keymap-or-function)
-      (setq mime::preview/content-list (nth 1 ret))
-      (goto-char
-       (let ((ce (mime::preview-content-info/point-max
-                 (car mime::preview/content-list)
-                 ))
-            e)
-        (goto-char (point-min))
-        (search-forward "\n\n" nil t)
-        (setq e (match-end 0))
-        (if (<= e ce)
-            e
-          ce)))
-      (run-hooks 'mime-view-mode-hook)
-      )))
+      (or (mime-entity-encoding mime-message-structure)
+         (mime-entity-set-encoding mime-message-structure encoding))
+      ))
+  (mime-display-message mime-message-structure preview-buffer
+                       mother default-keymap-or-function)
+  )

 
 

-(defun mime-preview/point-content-number (point)
-  (save-window-excursion
-    (let ((pc (mime-preview/point-pcinfo (point)))
-         cinfo)
-      (switch-to-buffer (mime::preview-content-info/buffer pc))
-      (setq cinfo (mime::preview-content-info/content-info pc))
-      (mime-article/point-content-number (mime::content-info/point-min cinfo))
-      )))

 
 

-(defun mime-preview/cinfo-to-pcinfo (cinfo)
-  (let ((rpcl mime::preview/content-list) cell)
-    (catch 'tag
-      (while rpcl
-       (setq cell (car rpcl))
-       (if (eq cinfo (mime::preview-content-info/content-info cell))
-           (throw 'tag cell)
-         )
-       (setq rpcl (cdr rpcl))
-       ))))
+;;; @@ utility
+;;;
+
+(defun mime-preview-find-boundary-info (&optional with-children)
+  "Return boundary information of current part.
+If WITH-CHILDREN, refer boundary surrounding current part and its branches."
+  (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))
+          )
+         (with-children
+          (save-excursion
+            (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 (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 (or (next-single-property-change
+                                   (point) 'mime-view-entity)
+                                  (point-max)))))
+              (setq p-end (point-max))))
+          ))
+    (vector p-beg p-end entity)))

 
 

-(autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t)

 
 

-(defun mime-view-extract-current-entity ()
+;;; @@ playing
+;;;
+
+(autoload 'mime-preview-play-current-entity "mime-play"
+  "Play current entity." t)
+
+(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
   "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/content-decoding-condition'."
-  (interactive)
-  (mime-view-play-current-entity "extract")
+`mime-acting-condition'."
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "extract")

   )
 
   )
 

-(defun mime-view-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
   "Print current entity (maybe).
 It decodes current entity to call internal or external method as
 \"print\" mode.  The method is selected from variable

-`mime/content-decoding-condition'."
-  (interactive)
-  (mime-view-play-current-entity "print")
+`mime-acting-condition'."
+  (interactive "P")
+  (mime-preview-play-current-entity ignore-examples "print")

   )
 
   )
 

-(defun mime-view-follow-content ()
-  (interactive)
-  (let ((root-cinfo
-        (mime::preview-content-info/content-info
-         (car mime::preview/content-list)))
-       pc p-beg p-end cinfo rcnum)
-    (let ((rest mime::preview/content-list)
-         b e cell len rc)
-      (if (catch 'tag
-           (while (setq cell (car rest))
-             (setq b (mime::preview-content-info/point-min cell)
-                   e (mime::preview-content-info/point-max cell))
-             (setq rest (cdr rest))
-             (if (and (<= b (point))(<= (point) e))
-                 (throw 'tag cell)
-               )
-             ))
-         (progn
-           (setq pc cell
-                 cinfo (mime::preview-content-info/content-info pc)
-                 rcnum (mime::content-info/rcnum cinfo))
-           (setq len (length rcnum))
-           (setq p-beg (mime::preview-content-info/point-min pc)
-                 p-end (mime::preview-content-info/point-max pc))
-           (while (and (setq cell (car rest))
-                       (progn
-                         (setq rc
-                               (mime::content-info/rcnum
-                                (mime::preview-content-info/content-info
-                                 cell)))
-                         (equal rcnum
-                                (nthcdr (- (length rc) len) rc))
-                         ))
-             (setq p-end (mime::preview-content-info/point-max cell))
-             (setq rest (cdr rest))
-             ))))
-    (if pc
-       (let* ((mode (mime-preview/get-original-major-mode))
-              (new-name (format "%s-%s" (buffer-name) (reverse rcnum)))
-              new-buf
-              (the-buf (current-buffer))
-              (a-buf mime::preview/article-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)
-           (goto-char (point-min))
-           (if (mime-view-header-visible-p rcnum root-cinfo)
-               (delete-region (goto-char (point-min))
-                              (if (re-search-forward "^$" nil t)
-                                  (match-end 0)
-                                (point-min)))
-             )
-           (goto-char (point-min))
-           (insert "\n")
-           (goto-char (point-min))
-           (let ((rcnum (mime::content-info/rcnum cinfo)) ci str)
-             (while (progn
-                      (setq str
-                            (save-excursion
-                              (set-buffer a-buf)
-                              (setq ci (mime-article/rcnum-to-cinfo rcnum))
-                              (save-restriction
-                                (narrow-to-region
-                                 (mime::content-info/point-min ci)
-                                 (mime::content-info/point-max ci)
-                                 )
-                                (std11-header-string-except
-                                 (concat "^"
-                                         (apply (function regexp-or) fields)
-                                         ":") ""))))
-                      (if (string= (mime::content-info/type ci)
-                                   "message/rfc822")
-                          nil
-                        (if str
-                            (insert str)
-                          )
-                        rcnum))
-               (setq fields (std11-collect-field-names)
-                     rcnum (cdr rcnum))
-               )
-             )
-           (let ((rest mime-view-following-required-fields-list))
-             (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::preview/mother-buffer)
-                                 (set-buffer mime::preview/article-buffer)
-                                 (std11-field-body field-name)
-                                 )
-                               "\n")))
-                     ))
-               (setq rest (cdr rest))
-               ))
-           (eword-decode-header)
-           )
-         (let ((f (cdr (assq mode mime-view-following-method-alist))))
-           (if (functionp f)
-               (funcall f new-buf)
-             (message
-              (format
-               "Sorry, following method for %s is not implemented yet."
-               mode))
-             ))
-         ))))

 
 

-(defun mime-view-display-x-face ()
+;;; @@ following
+;;;
+
+(defun mime-preview-follow-current-entity ()
+  "Write follow message to current entity.
+It calls following-method selected from variable
+`mime-preview-following-method-alist'."

   (interactive)
   (interactive)

-  (save-window-excursion
-    (set-buffer mime::preview/article-buffer)
-    (mime-view-x-face-function)
-    ))
+  (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))
+          (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)))
+         (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
+          "Sorry, following method for %s is not implemented yet."
+          mode)
+         ))
+      )))
+

 
 

-(defun mime-view-up-content ()
+;;; @@ moving
+;;;
+
+(defun mime-preview-move-to-upper ()
+  "Move to upper entity.
+If there is no upper entity, call function `mime-preview-quit'."

   (interactive)
   (interactive)

-  (let* ((pc (mime-preview/point-pcinfo (point)))
-        (cinfo (mime::preview-content-info/content-info pc))
-        (rcnum (mime::content-info/rcnum cinfo))
-        )
-    (if rcnum
-       (let ((r (save-excursion
-                  (set-buffer (mime::preview-content-info/buffer pc))
-                   (mime-article/rcnum-to-cinfo (cdr rcnum))
-                  ))
-             (rpcl mime::preview/content-list)
-             cell)
-         (while (and
-                 (setq cell (car rpcl))
-                 (not (eq r (mime::preview-content-info/content-info cell)))
-                 )
-           (setq rpcl (cdr rpcl))
+  (let (cinfo)
+    (while (null (setq cinfo
+                      (get-text-property (point) 'mime-view-entity)))
+      (backward-char)
+      )
+    (let ((r (mime-entity-parent cinfo))
+         point)
+      (catch 'tag
+       (while (setq point (previous-single-property-change
+                           (point) 'mime-view-entity))
+         (goto-char point)
+         (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)

            )
            )

-         (goto-char (mime::preview-content-info/point-min cell))

          )
          )

-      (mime-view-quit)
-      )))
+       (mime-preview-quit)
+       ))))

 
 

-(defun mime-view-previous-content ()
+(defun mime-preview-move-to-previous ()
+  "Move to previous entity.
+If there is no previous entity, it calls function registered in
+variable `mime-preview-over-to-previous-method-alist'."

   (interactive)
   (interactive)

-  (let* ((pcl mime::preview/content-list)
-        (p (point))
-        (i (- (length pcl) 1))
-        beg)
-    (catch 'tag
-      (while (> i 0)
-       (setq beg (mime::preview-content-info/point-min (nth i pcl)))
-       (if (> p beg)
-           (throw 'tag (goto-char beg))
+  (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 (and point
+            (>= point (point-min)))
+       (if (get-text-property (1- point) 'mime-view-entity)
+           (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)

          )
          )

-       (setq i (- i 1))
-       )
-      (let ((f (assq mime::preview/original-major-mode
-                    mime-view-over-to-previous-method-alist)))
+      (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))
          ))

-      )
-    ))
+      )))

 
 

-(defun mime-view-next-content ()
+(defun mime-preview-move-to-next ()
+  "Move to next entity.
+If there is no previous entity, it calls function registered in
+variable `mime-preview-over-to-next-method-alist'."

   (interactive)
   (interactive)

-  (let ((pcl mime::preview/content-list)
-       (p (point))
-       beg)
-    (catch 'tag
-      (while pcl
-       (setq beg (mime::preview-content-info/point-min (car pcl)))
-       (if (< p beg)
-           (throw 'tag (goto-char beg))
-         )
-       (setq pcl (cdr pcl))
-       )
-      (let ((f (assq mime::preview/original-major-mode
-                    mime-view-over-to-next-method-alist)))
+  (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 (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)))

        (if f
            (funcall (cdr f))
          ))
        (if f
            (funcall (cdr f))
          ))

-      )
-    ))
+      )))

 
 

-(defun mime-view-scroll-up-content (&optional h)
+(defun mime-preview-scroll-up-entity (&optional h)
+  "Scroll up current entity.
+If reached to (point-max), it calls function registered in variable
+`mime-preview-over-to-next-method-alist'."

   (interactive)
   (interactive)

-  (or h
-      (setq h (- (window-height) 1))
-      )
-  (if (= (point) (point-max))
-      (let ((f (assq mime::preview/original-major-mode
-                     mime-view-over-to-next-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
-    (let ((pcl mime::preview/content-list)
-          (p (point))
-          np beg)
-      (setq np
-            (or (catch 'tag
-                  (while pcl
-                    (setq beg (mime::preview-content-info/point-min (car pcl)))
-                    (if (< p beg)
-                        (throw 'tag beg)
-                      )
-                    (setq pcl (cdr pcl))
-                    ))
-                (point-max)))
-      (forward-line h)
-      (if (> (point) np)
-          (goto-char np)
-        )
-      ;;(show-subtree)
-      ))
-  )
+  (if (eobp)
+      (let ((f (assq (mime-preview-original-major-mode)
+                    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)))
+         (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-view-scroll-down-content (&optional h)
+(defun mime-preview-scroll-down-entity (&optional h)
+  "Scroll down current entity.
+If reached to (point-min), it calls function registered in variable
+`mime-preview-over-to-previous-method-alist'."

   (interactive)
   (interactive)

-  (or h
-      (setq h (- (window-height) 1))
-      )
-  (if (= (point) (point-min))
-      (let ((f (assq mime::preview/original-major-mode
-                     mime-view-over-to-previous-method-alist)))
-        (if f
-            (funcall (cdr f))
-          ))
-    (let ((pcl mime::preview/content-list)
-          (p (point))
-          pp beg)
-      (setq pp
-            (or (let ((i (- (length pcl) 1)))
-                  (catch 'tag
-                    (while (> i 0)
-                      (setq beg (mime::preview-content-info/point-min
-                                 (nth i pcl)))
-                      (if (> p beg)
-                          (throw 'tag beg)
-                        )
-                      (setq i (- i 1))
-                      )))
-                (point-min)))
-      (forward-line (- h))
-      (if (< (point) pp)
-          (goto-char pp)
-        )))
+  (if (bobp)
+      (let ((f (assq (mime-preview-original-major-mode)
+                    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)))
+         (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 (&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-view-next-line-content ()
-  (interactive)
-  (mime-view-scroll-up-content 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))

   )
 
   )
 

-(defun mime-view-previous-line-content ()
+
+;;; @@ display
+;;;
+
+(defun mime-preview-toggle-display (type &optional display)
+  (let ((situation (mime-preview-find-boundary-info t))
+       (sym (intern (concat "*" (symbol-name type))))
+       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))
+    (cond ((eq display 'invisible)
+          (setq display nil))
+         (display)
+         (t
+          (setq display
+                (eq (cdr (or (assq sym situation)
+                             (assq type situation)))
+                    'invisible))))
+    (setq situation (put-alist sym (if display
+                                      'visible
+                                    'invisible)
+                              situation))
+    (save-excursion
+      (let ((inhibit-read-only t))
+       (delete-region p-beg p-end)
+       (mime-display-entity entity 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))))))
+
+(defun mime-preview-toggle-header (&optional force-visible)
+  (interactive "P")
+  (mime-preview-toggle-display 'header force-visible))
+
+(defun mime-preview-toggle-content (&optional force-visible)
+  (interactive "P")
+  (mime-preview-toggle-display 'body force-visible))
+
+(defun mime-preview-show-header ()

   (interactive)
   (interactive)

-  (mime-view-scroll-down-content 1)
-  )
+  (mime-preview-toggle-display 'header 'visible))

 
 

-(defun mime-view-quit ()
+(defun mime-preview-show-content ()

   (interactive)
   (interactive)

-  (let ((r (save-excursion
-            (set-buffer (mime::preview-content-info/buffer
-                         (mime-preview/point-pcinfo (point))))
-            (assq major-mode mime-view-quitting-method-alist)
-            )))
-    (if r
-       (funcall (cdr r))
-      )))
+  (mime-preview-toggle-display 'body 'visible))

 
 

-(defun mime-view-show-summary ()
+(defun mime-preview-hide-header ()

   (interactive)
   (interactive)

-  (let ((r (save-excursion
-            (set-buffer
-             (mime::preview-content-info/buffer
-              (mime-preview/point-pcinfo (point)))
-             )
-            (assq major-mode mime-view-show-summary-method)
-            )))
+  (mime-preview-toggle-display 'header 'invisible))
+
+(defun mime-preview-hide-content ()
+  (interactive)
+  (mime-preview-toggle-display 'body 'invisible))
+
+    
+;;; @@ quitting
+;;;
+
+(defun mime-preview-quit ()
+  "Quit from MIME-preview buffer.
+It calls function registered in variable
+`mime-preview-quitting-method-alist'."
+  (interactive)
+  (let ((r (assq (mime-preview-original-major-mode)
+                mime-preview-quitting-method-alist)))

     (if r
        (funcall (cdr r))
       )))
 
     (if r
        (funcall (cdr r))
       )))
 

-(defun mime-view-kill-buffer ()
+(defun mime-preview-kill-buffer ()

   (interactive)
   (kill-buffer (current-buffer))
   )
   (interactive)
   (kill-buffer (current-buffer))
   )

@@ -1203,6 +1882,11 @@ It decodes current entity to call internal or external method as
 
 (provide 'mime-view)
 
 
 (provide 'mime-view)
 

-(run-hooks 'mime-view-load-hook)
+(eval-when-compile
+  (setq mime-situation-examples-file nil)
+  ;; to avoid to read situation-examples-file at compile time.
+  )
+
+(mime-view-read-situation-examples-file)

 
 ;;; mime-view.el ends here
 
 ;;; mime-view.el ends here