Update.

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

diff --git a/mime-play.el b/mime-play.el
index 95d93e1..70fb849 100644 (file)
--- a/mime-play.el
+++ b/mime-play.el
@@ -1,6 +1,6 @@
 ;;; mime-play.el --- Playback processing module for mime-view.el
 
 ;;; mime-play.el --- Playback processing module for mime-view.el
 

-;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc.

 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/9/26 (separated from tm-view.el)
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/9/26 (separated from tm-view.el)

@@ -30,10 +30,15 @@
 (require 'alist)
 (require 'filename)
 
 (require 'alist)
 (require 'filename)
 

-(eval-when-compile (require 'mime-text))
+(eval-when-compile
+  (condition-case nil
+      (require 'bbdb)
+    (error (defvar bbdb-buffer-name nil)))
+  )

 
 

+(defvar mime-acting-situation-example-list nil)

 
 

-(defvar mime-acting-situation-examples nil)
+(defvar mime-acting-situation-example-list-max-size 16)

 
 (defun mime-save-acting-situation-examples ()
   (let* ((file mime-acting-situation-examples-file)
 
 (defun mime-save-acting-situation-examples ()
   (let* ((file mime-acting-situation-examples-file)

@@ -45,10 +50,10 @@
           (erase-buffer)
           (insert ";;; " (file-name-nondirectory file) "\n")
           (insert "\n;; This file is generated automatically by "
           (erase-buffer)
           (insert ";;; " (file-name-nondirectory file) "\n")
           (insert "\n;; This file is generated automatically by "

-                  mime-view-version-string "\n\n")
+                  mime-view-version "\n\n")

          (insert ";;; Code:\n\n")
          (insert ";;; Code:\n\n")

-         (pp `(setq mime-acting-situation-examples
-                    ',mime-acting-situation-examples)
+         (pp `(setq mime-acting-situation-example-list
+                    ',mime-acting-situation-example-list)

              (current-buffer))
          (insert "\n;;; "
                   (file-name-nondirectory file)
              (current-buffer))
          (insert "\n;;; "
                   (file-name-nondirectory file)

@@ -58,31 +63,109 @@
 
 (add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
 
 
 (add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
 

-  
+(defun mime-reduce-acting-situation-examples ()
+  (let ((len (length mime-acting-situation-example-list))
+       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 mime-acting-situation-example-list)
+    (while (< i len)
+      (setq ic (car ir)
+           j 0
+           jr mime-acting-situation-example-list)
+      (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) mime-acting-situation-example-list))
+    (setcdr jr (cddr jr))
+    (if (= d-i 0)
+       (setq mime-acting-situation-example-list
+             (cdr mime-acting-situation-example-list))
+      (setq ir (nthcdr (1- d-i) mime-acting-situation-example-list))
+      (setcdr ir (cddr ir))
+      )
+    (if (setq ir (assoc (car dest) mime-acting-situation-example-list))
+       (setcdr ir (+ (cdr ir)(cdr dest)))
+      (setq mime-acting-situation-example-list
+           (cons dest mime-acting-situation-example-list))
+      )))
+
+

 ;;; @ content decoder
 ;;;
 
 ;;; @ content decoder
 ;;;
 

-(defvar mime-preview-after-decoded-position nil)
-
-(defun mime-preview-play-current-entity (&optional mode)
+;;;###autoload
+(defun mime-preview-play-current-entity (&optional ignore-examples mode)

   "Play current entity.
 It decodes current entity to call internal or external method.  The
 method is selected from variable `mime-acting-condition'.
   "Play current entity.
 It decodes current entity to call internal or external method.  The
 method is selected from variable `mime-acting-condition'.

+If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores
+`mime-acting-situation-example-list'.

 If MODE is specified, play as it.  Default MODE is \"play\"."
 If MODE is specified, play as it.  Default MODE is \"play\"."

-  (interactive)
-  (or mode
-      (setq mode "play"))
-  (let ((entity-info (get-text-property (point) 'mime-view-entity)))
-    (if entity-info
-       (let ((the-buf (current-buffer))
-             (raw-buffer (get-text-property (point) 'mime-view-raw-buffer)))
-         (setq mime-preview-after-decoded-position (point))
-         (set-buffer raw-buffer)
-         (mime-raw-play-entity entity-info mode)
-         (when (eq (current-buffer) raw-buffer)
-           (set-buffer the-buf)
-           (goto-char mime-preview-after-decoded-position)
-           )))))
+  (interactive "P")
+  (let ((entity (get-text-property (point) 'mime-view-entity)))
+    (if entity
+       (let ((situation (list (cons 'mode (or mode "play")))))
+         (if ignore-examples
+             (setq situation
+                   (cons (cons 'ignore-examples ignore-examples)
+                         situation)))
+         (mime-play-entity entity situation)
+         ))))

 
 (defun mime-sort-situation (situation)
   (sort situation
 
 (defun mime-sort-situation (situation)
   (sort situation

@@ -92,23 +175,26 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
                  (order '((type . 1)
                           (subtype . 2)
                           (mode . 3)
                  (order '((type . 1)
                           (subtype . 2)
                           (mode . 3)

-                          (major-mode . 4)))
+                          (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))
                  a-order b-order)
              (if (symbolp a-t)
                  (let ((ret (assq a-t order)))
                    (if ret
                        (setq a-order (cdr ret))

-                     (setq a-order 5)
+                     (setq a-order 7)

                      ))
                      ))

-               (setq a-order 6)
+               (setq a-order 8)

                )
              (if (symbolp b-t)
                  (let ((ret (assq b-t order)))
                    (if ret
                        (setq b-order (cdr ret))
                )
              (if (symbolp b-t)
                  (let ((ret (assq b-t order)))
                    (if ret
                        (setq b-order (cdr ret))

-                     (setq b-order 5)
+                     (setq b-order 7)

                      ))
                      ))

-               (setq b-order 6)
+               (setq b-order 8)

                )
              (if (= a-order b-order)
                  (string< (format "%s" a-t)(format "%s" b-t))
                )
              (if (= a-order b-order)
                  (string< (format "%s" a-t)(format "%s" b-t))

@@ -116,166 +202,174 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
              )))
   )
 
              )))
   )
 

-(defun mime-raw-play-entity (entity-info &optional mode)
-  "Play entity specified by ENTITY-INFO.
+(defsubst mime-delq-null-situation (situations field
+                                              &optional ignored-value)
+  (let (dest)
+    (while situations
+      (let* ((situation (car situations))
+            (cell (assq field situation)))
+       (if cell
+           (or (eq (cdr cell) ignored-value)
+               (setq dest (cons situation dest))
+               )))
+      (setq situations (cdr situations)))
+    dest))
+
+(defun mime-compare-situation-with-example (situation example)
+  (let ((example (copy-alist example))
+       (match 0))
+    (while situation
+      (let* ((cell (car situation))
+            (key (car cell))
+            (ecell (assoc key example)))
+       (when ecell
+         (if (equal cell ecell)
+             (setq match (1+ match))
+           (setq example (delq ecell example))
+           ))
+       )
+      (setq situation (cdr situation))
+      )
+    (cons match example)
+    ))
+
+;;;###autoload
+(defun mime-play-entity (entity &optional situation ignored-method)
+  "Play entity specified by ENTITY.

 It decodes the entity to call internal or external method.  The method
 is selected from variable `mime-acting-condition'.  If MODE is
 specified, play as it.  Default MODE is \"play\"."
 It decodes the entity to call internal or external method.  The method
 is selected from variable `mime-acting-condition'.  If MODE is
 specified, play as it.  Default MODE is \"play\"."

-  (let ((beg (mime-entity-point-min entity-info))
-       (end (mime-entity-point-max entity-info))
-       (c-type (mime-entity-media-type entity-info))
-       (c-subtype (mime-entity-media-subtype entity-info))
-       (params (mime-entity-parameters entity-info))
-       (encoding (mime-entity-encoding entity-info))
-       )
-    (or c-type
-       (setq c-type 'text
-             c-subtype 'plain))
-    ;; Check for VM
-    (if (< beg (point-min))
-       (setq beg (point-min))
-      )
-    (if (< (point-max) end)
-       (setq end (point-max))
-      )
-    (let (method cal ret)
-      (setq cal (list* (cons 'type c-type)
-                      (cons 'subtype c-subtype)
-                      (cons 'encoding encoding)
-                      (cons 'major-mode major-mode)
-                      params))
-      (if mode
-         (setq cal (cons (cons 'mode mode) cal))
-       )
-      (setq ret
-           (or (ctree-match-calist mime-acting-situation-examples cal)
-               (ctree-match-calist-partially mime-acting-situation-examples
-                                             cal)
-               cal))
-      (setq ret
-           (or (ctree-find-calist mime-acting-condition ret
-                                  mime-view-find-every-acting-situation)
-               (ctree-find-calist mime-acting-condition cal
-                                  mime-view-find-every-acting-situation)
-               ))
-      (cond ((cdr ret)
-            (setq ret (select-menu-alist
-                       "Methods"
-                       (mapcar (function
-                                (lambda (situation)
-                                  (cons
-                                   (format "%s"
-                                           (cdr (assq 'method situation)))
-                                   situation)))
-                               ret)))
-            (setq ret (mime-sort-situation ret))
-            (ctree-set-calist-strictly 'mime-acting-situation-examples ret)
-            )
-           (t
-            (setq ret (car ret))
-            ))
-      (setq method (cdr (assq 'method ret)))
-      (cond ((and (symbolp method)
-                 (fboundp method))
-            (funcall method beg end ret)
-            )
-           ((stringp method)
-            (mime-activate-mailcap-method beg end ret)
-            )
-           ((and (listp method)(stringp (car method)))
-            (mime-activate-external-method beg end ret)
-            )
-           (t
-            (mime-show-echo-buffer
-             "No method are specified for %s\n"
-             (mime-type/subtype-string c-type c-subtype))
-            ))
-      )
+  (let (method ret)
+    (in-calist-package 'mime-view)
+    (setq ret
+         (mime-delq-null-situation
+          (ctree-find-calist mime-acting-condition
+                             (mime-entity-situation entity situation)
+                             mime-view-find-every-acting-situation)
+          'method ignored-method))
+    (or (assq 'ignore-examples situation)
+       (if (cdr ret)
+           (let ((rest ret)
+                 (max-score 0)
+                 (max-escore 0)
+                 max-examples
+                 max-situations)
+             (while rest
+               (let ((situation (car rest))
+                     (examples mime-acting-situation-example-list))
+                 (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 mime-acting-situation-example-list)))
+                   (if cell
+                       (setcdr cell (1+ (cdr cell)))
+                     (setq mime-acting-situation-example-list
+                           (cons (cons example 0)
+                                 mime-acting-situation-example-list))
+                     ))
+                 (setq max-examples (cdr max-examples))
+                 )))))
+    (cond ((cdr ret)
+          (setq ret (select-menu-alist
+                     "Methods"
+                     (mapcar (function
+                              (lambda (situation)
+                                (cons
+                                 (format "%s"
+                                         (cdr (assq 'method situation)))
+                                 situation)))
+                             ret)))
+          (setq ret (mime-sort-situation ret))
+          (add-to-list 'mime-acting-situation-example-list (cons ret 0))
+          )
+         (t
+          (setq ret (car ret))
+          ))
+    (setq method (cdr (assq 'method ret)))
+    (cond ((and (symbolp method)
+               (fboundp method))
+          (funcall method entity ret)
+          )
+         ((stringp method)
+          (mime-activate-mailcap-method entity ret)
+          )
+          ;; ((and (listp method)(stringp (car method)))
+          ;;  (mime-activate-external-method entity ret)
+          ;;  )
+         (t
+          (mime-show-echo-buffer "No method are specified for %s\n"
+                                 (mime-entity-type/subtype entity))
+          ))

     ))
 
 
 ;;; @ external decoder
 ;;;
 
     ))
 
 
 ;;; @ external decoder
 ;;;
 

-(defun mime-activate-mailcap-method (start end situation)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let ((method (cdr (assoc 'method situation)))
-           (name (mime-raw-get-filename situation)))
-       (mime-write-decoded-region (if (re-search-forward "^$" end t)
-                                      (1+ (match-end 0))
-                                    (point-min))
-                                  end name
-                                  (cdr (assq 'encoding situation)))
-       (message "External method is starting...")
-       (let ((command
-              (mailcap-format-command
-               method
-               (cons (cons 'filename name) situation))))
-         (start-process command mime-echo-buffer-name
-                        shell-file-name shell-command-switch command)
-         )
-       (mime-show-echo-buffer)
-       ))))
-
-(defun mime-activate-external-method (beg end cal)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char beg)
-      (let ((method (cdr (assoc 'method cal)))
-           (name (mime-raw-get-filename cal))
-           )
-       (if method
-           (let ((file (make-temp-name
-                        (expand-file-name "TM" mime-temp-directory)))
-                 b args)
-             (if (nth 1 method)
-                 (setq b beg)
-               (setq b
-                     (if (re-search-forward "^$" nil t)
-                         (1+ (match-end 0))
-                       (point-min)
-                       ))
-               )
-             (goto-char b)
-             (write-region b end file)
-             (message "External method is starting...")
-             (setq cal (put-alist
-                        'name (replace-as-filename name) cal))
-             (setq cal (put-alist 'file file cal))
-             (setq args (nconc
-                         (list (car method)
-                               mime-echo-buffer-name (car method)
-                               )
-                         (mime-make-external-method-args
-                          cal (cdr (cdr method)))
-                         ))
-             (apply (function start-process) args)
-             (mime-show-echo-buffer)
-             ))
-       ))))
-
-(defun mime-make-external-method-args (cal format)
-  (mapcar (function
-          (lambda (arg)
-            (if (stringp arg)
-                arg
-              (let* ((item (eval arg))
-                     (ret (cdr (assoc item cal)))
-                     )
-                (if ret
-                    ret
-                  (if (eq item 'encoding)
-                      "7bit"
-                    ""))
-                ))
-            ))
-         format))
+(defvar mime-mailcap-method-filename-alist nil)
+
+(defun mime-activate-mailcap-method (entity situation)
+  (let ((method (cdr (assoc 'method situation)))
+       (name (mime-entity-safe-filename entity)))
+    (setq name
+         (if (and name (not (string= name "")))
+             (expand-file-name name temporary-file-directory)
+           (make-temp-name
+            (expand-file-name "EMI" temporary-file-directory))
+           ))
+    (mime-write-entity-content entity name)
+    (message "External method is starting...")
+    (let ((process
+          (let ((command
+                 (mailcap-format-command
+                  method
+                  (cons (cons 'filename name) situation))))
+            (start-process command mime-echo-buffer-name
+                           shell-file-name shell-command-switch command)
+            )))
+      (set-alist 'mime-mailcap-method-filename-alist process name)
+      (set-process-sentinel process 'mime-mailcap-method-sentinel)
+      )
+    ))
+
+(defun mime-mailcap-method-sentinel (process event)
+  (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
+    (if (file-exists-p file)
+       (delete-file file)
+      ))
+  (remove-alist 'mime-mailcap-method-filename-alist process)
+  (message (format "%s %s" process event)))

 
 

-(defvar mime-echo-window-is-shared-with-bbdb t
+(defvar mime-echo-window-is-shared-with-bbdb
+  (module-installed-p 'bbdb)

   "*If non-nil, mime-echo window is shared with BBDB window.")
 
 (defvar mime-echo-window-height
   "*If non-nil, mime-echo window is shared with BBDB window.")
 
 (defvar mime-echo-window-height

@@ -290,33 +384,46 @@ Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
 window.")
 
 (defun mime-show-echo-buffer (&rest forms)
 window.")
 
 (defun mime-show-echo-buffer (&rest forms)

-  "Show mime-echo buffer to display MIME-playing information."
+  "Show mime-echo buffer to display MIME-playing information.
+It returns the list of window, start and end positions of inserted text.
+A window height of the buffer `mime-echo-buffer-name' will be determined
+by `mime-echo-window-height' (its value or its return value) whenever
+this function is called."

   (get-buffer-create mime-echo-buffer-name)
   (let ((the-win (selected-window))
        (win (get-buffer-window mime-echo-buffer-name))
   (get-buffer-create mime-echo-buffer-name)
   (let ((the-win (selected-window))
        (win (get-buffer-window mime-echo-buffer-name))

-       )
-    (or win
-       (if (and mime-echo-window-is-shared-with-bbdb
-                (boundp 'bbdb-buffer-name)
-                (setq win (get-buffer-window bbdb-buffer-name))
-                )
-           (set-window-buffer win mime-echo-buffer-name)
-         (select-window (get-buffer-window mime-preview-buffer))
-         (setq win (split-window-vertically
-                    (- (window-height)
-                       (if (functionp mime-echo-window-height)
-                           (funcall mime-echo-window-height)
-                         mime-echo-window-height)
-                       )))
-         (set-window-buffer win mime-echo-buffer-name)
-         ))
-    (select-window win)
-    (goto-char (point-max))
+       (height (if (functionp mime-echo-window-height)
+                   (funcall mime-echo-window-height)
+                 mime-echo-window-height))
+       start)
+    (if win
+       (progn
+         (select-window win)
+         (enlarge-window (- height (window-height)))
+         )
+      (unless (and mime-echo-window-is-shared-with-bbdb
+                  (condition-case nil
+                      (select-window
+                       (setq win (get-buffer-window bbdb-buffer-name))
+                       )
+                    (error nil)))
+       (select-window (get-buffer-window (or mime-preview-buffer
+                                             (current-buffer))))
+       (let ((window-min-height 1))
+         (setq win (split-window-vertically (- (window-height) height)))
+         )
+       (set-window-buffer win mime-echo-buffer-name)
+       (select-window win)
+       ))
+    (goto-char (setq start (point-max)))

     (if forms
     (if forms

-       (insert (apply (function format) forms))
-      )
-    (select-window the-win)
-    ))
+       (let ((buffer-read-only nil))
+         (insert (apply (function format) forms))
+         ))
+    (prog1
+       (list win start (point))
+      (select-window the-win)
+      )))

 
 
 ;;; @ file name
 
 
 ;;; @ file name

@@ -332,67 +439,92 @@ window.")
   (concat (regexp-* mime-view-file-name-char-regexp)
          "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 
   (concat (regexp-* mime-view-file-name-char-regexp)
          "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
 

-(defun mime-raw-get-original-filename (param &optional encoding)
-  (or (mime-raw-get-uu-filename param encoding)
-      (let (ret)
-       (or (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))
-             )
-           (if (setq ret
-                     (std11-find-field-body '("Content-Description"
-                                              "Subject")))
-               (if (or (string-match mime-view-file-name-regexp-1 ret)
-                       (string-match mime-view-file-name-regexp-2 ret))
-                   (substring ret (match-beginning 0)(match-end 0))
-                 ))
-           ))
-      ))
-
-(defun mime-raw-get-filename (param)
-  (replace-as-filename (mime-raw-get-original-filename param))
-  )
+(defun mime-entity-safe-filename (entity)
+  (let ((filename
+        (or (mime-entity-filename entity)
+            (let ((subj
+                   (or (mime-read-field 'Content-Description entity)
+                       (mime-read-field 'Subject entity))))
+              (if (and subj
+                       (or (string-match mime-view-file-name-regexp-1 subj)
+                           (string-match mime-view-file-name-regexp-2 subj)))
+                  (substring subj (match-beginning 0)(match-end 0))
+                )))))
+    (if filename
+       (replace-as-filename filename)
+      )))

 
 
 ;;; @ file extraction
 ;;;
 
 
 
 ;;; @ file extraction
 ;;;
 

-(defun mime-method-to-save (beg end cal)
-  (goto-char beg)
-  (let* ((name
-         (save-restriction
-           (narrow-to-region beg end)
-           (mime-raw-get-filename cal)
-           ))
-        (encoding (or (cdr (assq 'encoding cal)) "7bit"))
-        (filename
-          (if (and name (not (string-equal name "")))
-             (expand-file-name name
-                               (save-window-excursion
-                                 (call-interactively
-                                  (function
-                                   (lambda (dir)
-                                     (interactive "DDirectory: ")
-                                     dir)))))
-           (save-window-excursion
-             (call-interactively
-              (function
-               (lambda (file)
-                 (interactive "FFilename: ")
-                 (expand-file-name file)))))))
+(defun mime-save-content (entity situation)
+  (let* ((name (mime-entity-safe-filename entity))
+        (filename (if (and name (not (string-equal name "")))
+                      (expand-file-name name
+                                        (save-window-excursion
+                                          (call-interactively
+                                           (function
+                                            (lambda (dir)
+                                              (interactive "DDirectory: ")
+                                              dir)))))
+                    (save-window-excursion
+                      (call-interactively
+                       (function
+                        (lambda (file)
+                          (interactive "FFilename: ")
+                          (expand-file-name file)))))))

         )
     (if (file-exists-p filename)
         )
     (if (file-exists-p filename)

-        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
-            (error "")))
-    (re-search-forward "\n\n")
-    (mime-write-decoded-region (match-end 0) end filename encoding)
+       (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
+           (error "")))
+    (mime-write-entity-content entity filename)

     ))
 
 
     ))
 
 

+;;; @ file detection
+;;;
+
+(defvar mime-magic-type-alist
+  '(("^\377\330\377[\340\356]..JFIF"   image jpeg)
+    ("^\211PNG"                                image png)
+    ("^GIF8[79]"                       image gif)
+    ("^II\\*\000"                      image tiff)
+    ("^MM\000\\*"                      image tiff)
+    ("^MThd"                           audio midi)
+    ("^\000\000\001\263"               video mpeg)
+    )
+  "*Alist of regexp about magic-number vs. corresponding media-types.
+Each element looks like (REGEXP TYPE SUBTYPE).
+REGEXP is a regular expression to match against the beginning of the
+content of entity.
+TYPE is symbol to indicate primary type of media-type.
+SUBTYPE is symbol to indicate subtype of media-type.")
+
+(defun mime-detect-content (entity situation)
+  (let (type subtype)
+    (let ((mdata (mime-entity-content entity))
+         (rest mime-magic-type-alist))
+      (while (not (let ((cell (car rest)))
+                   (if cell
+                       (if (string-match (car cell) mdata)
+                           (setq type (nth 1 cell)
+                                 subtype (nth 2 cell))
+                         )
+                     t)))
+       (setq rest (cdr rest))))
+    (if type
+       (mime-play-entity
+        entity
+        (put-alist 'type type
+                   (put-alist 'subtype subtype
+                              (del-alist 'method
+                                         (copy-alist situation))))
+        'mime-detect-content)
+      ))
+  )
+
+

 ;;; @ mail/news message
 ;;;
 
 ;;; @ mail/news message
 ;;;
 

@@ -408,56 +540,34 @@ It is registered to variable `mime-preview-quitting-method-alist'."
     (pop-to-buffer mother)
     ))
 
     (pop-to-buffer mother)
     ))
 

-(defun mime-method-to-display-message/rfc822 (beg end cal)
-  (let* ((cnum (mime-raw-point-to-entity-number beg))
-        (new-name (format "%s-%s" (buffer-name) cnum))
-        (mother mime-preview-buffer)
-        (text-decoder
-         (cdr (or (assq major-mode mime-text-decoder-alist)
-                  (assq t mime-text-decoder-alist))))
-        str)
-    (setq str (buffer-substring beg end))
-    (switch-to-buffer new-name)
+(defun mime-view-message/rfc822 (entity situation)
+  (let* ((new-name
+         (format "%s-%s" (buffer-name) (mime-entity-number entity)))
+        (mother (current-buffer))
+        (children (car (mime-entity-children entity))))
+    (set-buffer (get-buffer-create new-name))

     (erase-buffer)
     (erase-buffer)

-    (insert str)
-    (goto-char (point-min))
-    (if (re-search-forward "^\n" nil t)
-       (delete-region (point-min) (match-end 0))
-      )
+    (mime-insert-entity children)
+    (setq mime-message-structure children)

     (setq major-mode 'mime-show-message-mode)
     (setq major-mode 'mime-show-message-mode)

-    (setq mime-text-decoder text-decoder)
-    (mime-view-mode mother)
+    (mime-view-buffer (current-buffer) nil mother
+                     nil (if (mime-entity-cooked-p entity) 'cooked))

     ))
 
 
 ;;; @ message/partial
 ;;;
 
     ))
 
 
 ;;; @ message/partial
 ;;;
 

-(defun mime-raw-write-region (start end filename)
-  "Write current region into specified file.
-When called from a program, takes three arguments:
-START, END and FILENAME.  START and END are buffer positions.
-It refer `mime-raw-buffer-coding-system-alist' to choose coding-system
-to write."
-  (let ((coding-system-for-write
-        (cdr
-         (or (assq major-mode mime-raw-buffer-coding-system-alist)
-             (assq t mime-raw-buffer-coding-system-alist)
-             ))))
-    (write-region start end filename)
-    ))
-
-(defun mime-method-to-store-message/partial (beg end cal)
-  (goto-char beg)
+(defun mime-store-message/partial-piece (entity cal)

   (let* ((root-dir
          (expand-file-name
   (let* ((root-dir
          (expand-file-name

-          (concat "m-prts-" (user-login-name)) mime-temp-directory))
+          (concat "m-prts-" (user-login-name)) temporary-file-directory))

         (id (cdr (assoc "id" cal)))
         (number (cdr (assoc "number" cal)))
         (total (cdr (assoc "total" cal)))
         file
         (id (cdr (assoc "id" cal)))
         (number (cdr (assoc "number" cal)))
         (total (cdr (assoc "total" cal)))
         file

-        (mother mime-preview-buffer)
-         )
+        (mother (current-buffer))
+        )

     (or (file-exists-p root-dir)
        (make-directory root-dir)
        )
     (or (file-exists-p root-dir)
        (make-directory root-dir)
        )

@@ -477,7 +587,7 @@ to write."
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))
            (setq major-mode 'mime-show-message-mode)
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))
            (setq major-mode 'mime-show-message-mode)

-           (mime-view-mode mother)
+           (mime-view-buffer (current-buffer) nil mother)

            )
          (set-window-buffer pwin
                             (save-excursion
            )
          (set-window-buffer pwin
                             (save-excursion

@@ -485,10 +595,8 @@ to write."
                               mime-preview-buffer))
          (select-window pwin)
          )
                               mime-preview-buffer))
          (select-window pwin)
          )

-      (re-search-forward "^$")
-      (goto-char (1+ (match-end 0)))

       (setq file (concat root-dir "/" number))
       (setq file (concat root-dir "/" number))

-      (mime-raw-write-region (point) end file)
+      (mime-write-entity-body entity file)

       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total
       (let ((total-file (concat root-dir "/CT")))
        (setq total
              (if total

@@ -533,8 +641,8 @@ to write."
                    (setq i (1+ i))
                    ))
                (as-binary-output-file
                    (setq i (1+ i))
                    ))
                (as-binary-output-file

-                 (write-region (point-min)(point-max)
-                               (expand-file-name "FULL" root-dir)))
+                (write-region (point-min)(point-max)
+                              (expand-file-name "FULL" root-dir)))

                (let ((i 1))
                  (while (<= i total)
                    (let ((file (format "%s/%d" root-dir i)))
                (let ((i 1))
                  (while (<= i total)
                    (let ((file (format "%s/%d" root-dir i)))

@@ -549,11 +657,10 @@ to write."
                       ))
                (save-window-excursion
                  (setq major-mode 'mime-show-message-mode)
                       ))
                (save-window-excursion
                  (setq major-mode 'mime-show-message-mode)

-                 (mime-view-mode mother)
+                 (mime-view-buffer (current-buffer) nil mother)

                  )
                (let ((pwin (or (get-buffer-window mother)
                  )
                (let ((pwin (or (get-buffer-window mother)

-                               (get-largest-window)
-                               ))
+                               (get-largest-window)))

                      (pbuf (save-excursion
                              (set-buffer full-buf)
                              mime-preview-buffer)))
                      (pbuf (save-excursion
                              (set-buffer full-buf)
                              mime-preview-buffer)))

@@ -567,7 +674,7 @@ to write."
 ;;;
 
 (defvar mime-raw-dired-function
 ;;;
 
 (defvar mime-raw-dired-function

-  (if mime/use-multi-frame
+  (if (and (>= emacs-major-version 19) window-system)

       (function dired-other-frame)
     (function mime-raw-dired-function-for-one-frame)
     ))
       (function dired-other-frame)
     (function mime-raw-dired-function-for-one-frame)
     ))

@@ -579,57 +686,45 @@ to write."
     (dired dir)
     ))
 
     (dired dir)
     ))
 

-(defun mime-method-to-display-message/external-ftp (beg end cal)
+(defun mime-view-message/external-anon-ftp (entity cal)

   (let* ((site (cdr (assoc "site" cal)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
   (let* ((site (cdr (assoc "site" cal)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))

-        ;;(mode (cdr (assoc "mode" cal)))
-        (pathname (concat "/anonymous@" site ":" directory))
-        )
-    (message (concat "Accessing " (expand-file-name name pathname) "..."))
+        (pathname (concat "/anonymous@" site ":" directory)))
+    (message (concat "Accessing " (expand-file-name name pathname) " ..."))

     (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
     (search-forward name)
     ))
 
     (funcall mime-raw-dired-function pathname)
     (goto-char (point-min))
     (search-forward name)
     ))
 

+(defvar mime-raw-browse-url-function mime-browse-url-function)
+
+(defun mime-view-message/external-url (entity cal)
+  (let ((url (cdr (assoc "url" cal))))
+    (message (concat "Accessing " url " ..."))
+    (funcall mime-raw-browse-url-function url)))
+

 
 ;;; @ rot13-47
 ;;;
 
 
 ;;; @ rot13-47
 ;;;
 

-(defun mime-method-to-display-caesar (start end cal)
+(defun mime-view-caesar (entity situation)

   "Internal method for mime-view to display ROT13-47-48 message."
   "Internal method for mime-view to display ROT13-47-48 message."

-  (let* ((cnum (mime-raw-point-to-entity-number start))
-        (new-name (format "%s-%s" (buffer-name) cnum))
-        (the-buf (current-buffer))
-        (mother mime-preview-buffer)
-        (charset (cdr (assoc "charset" cal)))
-        (encoding (cdr (assq 'encoding cal)))
-        (mode major-mode)
-        )
-    (let ((pwin (or (get-buffer-window mother)
-                   (get-largest-window)))
-         (buf (get-buffer-create new-name))
-         )
-      (set-window-buffer pwin buf)
-      (set-buffer buf)
-      (select-window pwin)
+  (let ((buf (get-buffer-create
+             (format "%s-%s" (buffer-name) (mime-entity-number entity)))))
+    (with-current-buffer buf
+      (setq buffer-read-only nil)
+      (erase-buffer)
+      (mime-insert-text-content entity)
+      (mule-caesar-region (point-min) (point-max))
+      (set-buffer-modified-p nil)

       )
       )

-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (insert-buffer-substring the-buf start end)
+    (let ((win (get-buffer-window (current-buffer))))
+      (or (eq (selected-window) win)
+         (select-window (or win (get-largest-window)))
+         ))
+    (view-buffer buf)

     (goto-char (point-min))
     (goto-char (point-min))

-    (if (re-search-forward "^\n" nil t)
-       (delete-region (point-min) (match-end 0))
-      )
-    (let ((m (cdr (or (assq mode mime-text-decoder-alist)
-                     (assq t mime-text-decoder-alist)))))
-      (and (functionp m)
-          (funcall m charset encoding)
-          ))
-    (mule-caesar-region (point-min) (point-max))
-    (set-buffer-modified-p nil)
-    (set-buffer mother)
-    (view-buffer new-name)

     ))
 
 
     ))
 
 

@@ -646,10 +741,17 @@ to write."
            (set-buffer buffer)
            (erase-buffer)
            (insert-file-contents file)
            (set-buffer buffer)
            (erase-buffer)
            (insert-file-contents file)

-           (eval-current-buffer)
+           (eval-buffer)

            ;; format check
            ;; format check

-           (or (eq (car mime-acting-situation-examples) 'type)
-               (setq mime-acting-situation-examples nil))
+           (condition-case nil
+               (let ((i 0))
+                 (while (and (> (length mime-acting-situation-example-list)
+                                mime-acting-situation-example-list-max-size)
+                             (< i 16))
+                   (mime-reduce-acting-situation-examples)
+                   (setq i (1+ i))
+                   ))
+             (error (setq mime-acting-situation-example-list nil)))

            )
        (kill-buffer buffer))))
 
            )
        (kill-buffer buffer))))