update.

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

diff --git a/mime-play.el b/mime-play.el
index 1e05d79..a7326a0 100644 (file)
--- a/mime-play.el
+++ b/mime-play.el
@@ -1,14 +1,13 @@
-;;; mime-play.el --- decoder for mime-view.el
+;;; mime-play.el --- Playback processing module for mime-view.el

 
 

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

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

-;; Version: $Id: mime-play.el,v 0.5 1997-02-28 02:16:31 tmorioka Exp $

 ;; 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 (Secretariat of Emacs 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,304 +27,213 @@
 ;;; Code:
 
 (require 'mime-view)
 ;;; Code:
 
 (require 'mime-view)

+(require 'alist)
+(require 'filename)
+
+(eval-when-compile (require 'mime-text))
+
+
+(defvar mime-acting-situation-examples nil)
+
+(defun mime-save-acting-situation-examples ()
+  (let* ((file mime-acting-situation-examples-file)
+        (buffer (get-buffer-create " *mime-example*")))
+    (unwind-protect
+        (save-excursion
+          (set-buffer buffer)
+          (setq buffer-file-name file)
+          (erase-buffer)
+          (insert ";;; " (file-name-nondirectory file) "\n")
+          (insert "\n;; This file is generated automatically by "
+                  mime-view-version-string "\n\n")
+         (insert ";;; Code:\n\n")
+         (pp `(setq mime-acting-situation-examples
+                    ',mime-acting-situation-examples)
+             (current-buffer))
+         (insert "\n;;; "
+                  (file-name-nondirectory file)
+                  " ends here.\n")
+          (save-buffer))
+      (kill-buffer buffer))))
+
+(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)

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

-(defvar mime-preview/after-decoded-position nil)
+(defvar mime-preview-after-decoded-position nil)

 
 

-(defun mime-preview/decode-content ()
+(defun mime-preview-play-current-entity (&optional mode)
+  "Play current entity.
+It decodes current 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\"."

   (interactive)
   (interactive)

-  (let ((pc (mime-preview/point-pcinfo (point))))
-    (if pc
-       (let ((the-buf (current-buffer)))
-         (setq mime-preview/after-decoded-position (point))
-         (set-buffer (mime::preview-content-info/buffer pc))
-         (mime-article/decode-content
-          (mime::preview-content-info/content-info pc))
-         (if (eq (current-buffer)
-                 (mime::preview-content-info/buffer pc))
-             (progn
-               (set-buffer the-buf)
-               (goto-char mime-preview/after-decoded-position)
-               ))
-         ))))
-
-(defun mime-article/decode-content (cinfo)
-  (let ((beg (mime::content-info/point-min cinfo))
-       (end (mime::content-info/point-max cinfo))
-       (ctype (or (mime::content-info/type cinfo) "text/plain"))
-       (params (mime::content-info/parameters cinfo))
-       (encoding (mime::content-info/encoding cinfo))
-       )
-    ;; Check for VM
-    (if (< beg (point-min))
-       (setq beg (point-min))
-      )
-    (if (< (point-max) end)
-       (setq end (point-max))
-      )
+  (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)
+           )))))
+
+(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)
+                          (major-mode . 4)))
+                 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 6)
+               )
+             (if (symbolp b-t)
+                 (let ((ret (assq b-t order)))
+                   (if ret
+                       (setq b-order (cdr ret))
+                     (setq b-order 5)
+                     ))
+               (setq b-order 6)
+               )
+             (if (= a-order b-order)
+                 (string< (format "%s" a-t)(format "%s" b-t))
+               (< a-order b-order))
+             )))
+  )
+
+(defun mime-raw-play-entity (entity-info &optional mode)
+  "Play entity specified by ENTITY-INFO.
+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))
+       (content-type (mime-entity-content-type entity-info))
+       (encoding (mime-entity-encoding entity-info)))
+    (or content-type
+       (setq content-type (make-mime-content-type 'text 'plain)))

     (let (method cal ret)
     (let (method cal ret)

-      (setq cal (list* (cons 'type ctype)
+      (setq cal (list* (cons 'major-mode major-mode)

                       (cons 'encoding encoding)
                       (cons 'encoding encoding)

-                      (cons 'major-mode major-mode)
-                      params))
-      (if mime-view-decoding-mode
-         (setq cal (cons
-                    (cons 'mode mime-view-decoding-mode)
-                    cal))
+                      content-type))
+      (if mode
+         (setq cal (cons (cons 'mode mode) cal))

        )
        )

-      (setq ret (mime/get-content-decoding-alist 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)
             )
       (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)))
            ((and (listp method)(stringp (car method)))

-            (mime-article/start-external-method-region beg end ret)
+            (mime-activate-external-method beg end ret)

             )
            (t
             )
            (t

-            (mime-article/show-output-buffer
-             "No method are specified for %s\n" ctype)
-            ))
-      )
-    ))
-
-
-;;; @ method selector
-;;;
-
-;;; @@ alist
-;;;
-
-(defun put-alist (item value alist)
-  "Modify ALIST to set VALUE to ITEM.
-If there is a pair whose car is ITEM, replace its cdr by VALUE.
-If there is not such pair, create new pair (ITEM . VALUE) and
-return new alist whose car is the new pair and cdr is ALIST.
-\[tomo's ELIS like function]"
-  (let ((pair (assoc item alist)))
-    (if pair
-       (progn
-         (setcdr pair value)
-         alist)
-      (cons (cons item value) alist)
-      )))
-
-(defun del-alist (item alist)
-  "If there is a pair whose key is ITEM, delete it from ALIST.
-\[tomo's ELIS emulating function]"
-  (if (equal item (car (car alist)))
-      (cdr alist)
-    (let ((pr alist)
-         (r (cdr alist))
-         )
-      (catch 'tag
-       (while (not (null r))
-         (if (equal item (car (car r)))
-             (progn
-               (rplacd pr (cdr r))
-               (throw 'tag alist)))
-         (setq pr r)
-         (setq r (cdr r))
-         )
-       alist))))
-
-
-;;; @@ field
-;;;
-
-(defun put-fields (tp c)
-  (catch 'tag
-    (let ((r tp) f ret)
-      (while r
-       (setq f (car r))
-       (if (not (if (setq ret (assoc (car f) c))
-                    (equal (cdr ret)(cdr f))
-                  (setq c (cons f c))
-                  ))
-           (throw 'tag 'error))
-       (setq r (cdr r))
-       ))
-    c))
-
-
-;;; @@ field unifier
-;;;
-
-(defun field-unifier-for-default (a b)
-  (let ((ret
-        (cond ((equal a b)    a)
-              ((null (cdr b)) a)
-              ((null (cdr a)) b)
-              )))
-    (if ret
-       (list nil ret nil)
-      )))
-
-(defun field-unifier-for-mode (a b)
-  (let ((va (cdr a)))
-    (if (if (consp va)
-           (member (cdr b) va)
-         (equal va (cdr b))
-         )
-       (list nil b nil)
+            (mime-show-echo-buffer
+             "No method are specified for %s\n"
+             (mime-type/subtype-string
+              (mime-content-type-primary-type content-type)
+              (mime-content-type-subtype content-type))
+             )))

       )))
 
       )))
 

-(defun field-unify (a b)
-  (let ((sym (intern (concat "field-unifier-for-" (intern (car a))))))
-    (if (not (fboundp sym))
-       (setq sym (function field-unifier-for-default))
-      )
-    (funcall sym a b)
-    ))
-

 
 

-;;; @@ type unifier
+;;; @ external decoder

 ;;;
 
 ;;;
 

-(defun assoc-unify (class instance)
-  (catch 'tag
-    (let ((cla (copy-alist class))
-         (ins (copy-alist instance))
-         (r class)
-         cell aret ret prev rest)
-      (while r
-       (setq cell (car r))
-       (setq aret (assoc (car cell) ins))
-       (if aret
-           (if (setq ret (field-unify cell aret))
-               (progn
-                 (if (car ret)
-                     (setq prev (put-alist (car (car ret))
-                                           (cdr (car ret))
-                                           prev))
-                   )
-                 (if (nth 2 ret)
-                     (setq rest (put-alist (car (nth 2 ret))
-                                           (cdr (nth 2 ret))
-                                           rest))
-                   )
-                 (setq cla (put-alist (car cell)(cdr (nth 1 ret)) cla))
-                 (setq ins (del-alist (car cell) ins))
-                 )
-             (throw 'tag nil)
-             ))
-       (setq r (cdr r))
-       )
-      (setq r (copy-alist ins))
-      (while r
-       (setq cell (car r))
-       (setq aret (assoc (car cell) cla))
-       (if aret
-           (if (setq ret (field-unify cell aret))
-               (progn
-                 (if (car ret)
-                     (setq prev (put-alist (car (car ret))
-                                           (cdr (car ret))
-                                           prev))
-                   )
-                 (if (nth 2 ret)
-                     (setq rest (put-alist (car (nth 2 ret))
-                                           (cdr (nth 2 ret))
-                                           rest))
-                   )
-                 (setq cla (del-alist (car cell) cla))
-                 (setq ins (put-alist (car cell)(cdr (nth 1 ret)) ins))
-                 )
-             (throw 'tag nil)
-             ))
-       (setq r (cdr r))
-       )
-      (list prev (append cla ins) rest)
-      )))
+(defvar mime-mailcap-method-filename-alist nil)

 
 

-(defun get-unified-alist (db al)
-  (let ((r db) ret)
-    (catch 'tag
-      (while r
-       (if (setq ret (nth 1 (assoc-unify (car r) al)))
-           (throw 'tag ret)
+(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 (expand-file-name (mime-raw-get-filename situation)
+                                   mime-temp-directory)))
+       (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 ((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)

          )
          )

-       (setq r (cdr r))
+       ;;(mime-show-echo-buffer)

        ))))
 
        ))))
 

-(defun delete-atype (atl al)
-  (let* ((r atl) ret oal)
-    (setq oal
-         (catch 'tag
-           (while r
-             (if (setq ret (nth 1 (assoc-unify (car r) al)))
-                 (throw 'tag (car r))
-               )
-             (setq r (cdr r))
-             )))
-    (delete oal atl)
-    ))
-
-(defun remove-atype (sym al)
-  (and (boundp sym)
-       (set sym (delete-atype (eval sym) al))
-       ))
-
-(defun replace-atype (atl old-al new-al)
-  (let* ((r atl) ret oal)
-    (if (catch 'tag
-         (while r
-           (if (setq ret (nth 1 (assoc-unify (car r) old-al)))
-               (throw 'tag (rplaca r new-al))
-             )
-           (setq r (cdr r))
-           ))
-       atl)))
-
-(defun set-atype (sym al &rest options)
-  (if (null (boundp sym))
-      (set sym al)
-    (let* ((replacement (memq 'replacement options))
-          (ignore-fields (car (cdr (memq 'ignore options))))
-          (remove (or (car (cdr (memq 'remove options)))
-                      (let ((ral (copy-alist al)))
-                        (mapcar (function
-                                 (lambda (type)
-                                   (setq ral (del-alist type ral))
-                                   ))
-                                ignore-fields)
-                        ral)))
-          )
-      (set sym
-          (or (if replacement
-                  (replace-atype (eval sym) remove al)
-                )
-              (cons al
-                    (delete-atype (eval sym) remove)
-                    )
-              )))))
-
-
-;;; @@ main selector
-;;;
-
-(defun mime/get-content-decoding-alist (al)
-  (get-unified-alist mime/content-decoding-condition al)
-  )
-
-
-;;; @ external decoder
-;;;
+(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)))

 
 

-(defun mime-article/start-external-method-region (beg end cal)
+(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)))
   (save-excursion
     (save-restriction
       (narrow-to-region beg end)
       (goto-char beg)
       (let ((method (cdr (assoc 'method cal)))

-           (name (mime-article/get-filename cal))
+           (name (mime-raw-get-filename cal))

            )
        (if method
            (let ((file (make-temp-name
            )
        (if method
            (let ((file (make-temp-name

-                        (expand-file-name "TM" mime/tmp-dir)))
+                        (expand-file-name "TM" mime-temp-directory)))

                  b args)
              (if (nth 1 method)
                  (setq b beg)
                  b args)
              (if (nth 1 method)
                  (setq b beg)

@@ -343,17 +251,17 @@ return new alist whose car is the new pair and cdr is ALIST.
              (setq cal (put-alist 'file file cal))
              (setq args (nconc
                          (list (car method)
              (setq cal (put-alist 'file file cal))
              (setq args (nconc
                          (list (car method)

-                               mime/output-buffer-name (car method)
+                               mime-echo-buffer-name (car method)

                                )
                                )

-                         (mime-article/make-method-args cal
-                                                        (cdr (cdr method)))
+                         (mime-make-external-method-args
+                          cal (cdr (cdr method)))

                          ))
              (apply (function start-process) args)
                          ))
              (apply (function start-process) args)

-             (mime-article/show-output-buffer)
+             (mime-show-echo-buffer)

              ))
        ))))
 
              ))
        ))))
 

-(defun mime-article/make-method-args (cal format)
+(defun mime-make-external-method-args (cal format)

   (mapcar (function
           (lambda (arg)
             (if (stringp arg)
   (mapcar (function
           (lambda (arg)
             (if (stringp arg)

@@ -370,20 +278,40 @@ return new alist whose car is the new pair and cdr is ALIST.
             ))
          format))
 
             ))
          format))
 

-(defun mime-article/show-output-buffer (&rest forms)
-  (get-buffer-create mime/output-buffer-name)
+(defvar mime-echo-window-is-shared-with-bbdb t
+  "*If non-nil, mime-echo window is shared with BBDB window.")
+
+(defvar mime-echo-window-height
+  (function
+   (lambda ()
+     (/ (window-height) 5)
+     ))
+  "*Size of mime-echo window.
+It allows function or integer.  If it is function,
+`mime-show-echo-buffer' calls it to get height of mime-echo window.
+Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
+window.")
+
+(defun mime-show-echo-buffer (&rest forms)
+  "Show mime-echo buffer to display MIME-playing information."
+  (get-buffer-create mime-echo-buffer-name)

   (let ((the-win (selected-window))
   (let ((the-win (selected-window))

-       (win (get-buffer-window mime/output-buffer-name))
+       (win (get-buffer-window mime-echo-buffer-name))

        )
     (or win
        )
     (or win

-       (if (and mime/output-buffer-window-is-shared-with-bbdb
+       (if (and mime-echo-window-is-shared-with-bbdb

                 (boundp 'bbdb-buffer-name)
                 (setq win (get-buffer-window bbdb-buffer-name))
                 )
                 (boundp 'bbdb-buffer-name)
                 (setq win (get-buffer-window bbdb-buffer-name))
                 )

-           (set-window-buffer win mime/output-buffer-name)
-         (select-window (get-buffer-window mime::article/preview-buffer))
-         (setq win (split-window-vertically (/ (* (window-height) 3) 4)))
-         (set-window-buffer win mime/output-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))
          ))
     (select-window win)
     (goto-char (point-max))

@@ -407,11 +335,16 @@ return new alist whose car is the new pair and cdr is ALIST.
   (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-article/get-original-filename (param &optional encoding)
-  (or (mime-article/get-uu-filename param encoding)
+(defun mime-raw-get-original-filename (param)
+  (or (if (member (cdr (assq 'encoding param))
+                 mime-view-uuencode-encoding-name-list)
+         (mime-raw-get-uu-filename))

       (let (ret)
       (let (ret)

-       (or (if (or (and (setq ret (mime/Content-Disposition))
-                        (setq ret (assoc "filename" (cdr ret)))
+       (or (if (or (and (setq ret (mime-read-Content-Disposition))
+                        (setq ret
+                              (assoc
+                               "filename"
+                               (mime-content-disposition-parameters ret)))

                         )
                    (setq ret (assoc "name" param))
                    (setq ret (assoc "x-name" param))
                         )
                    (setq ret (assoc "name" param))
                    (setq ret (assoc "x-name" param))

@@ -428,35 +361,68 @@ return new alist whose car is the new pair and cdr is ALIST.
            ))
       ))
 
            ))
       ))
 

-(defun mime-article/get-filename (param)
-  (replace-as-filename (mime-article/get-original-filename param))
+(defun mime-raw-get-filename (param)
+  (replace-as-filename (mime-raw-get-original-filename param))

   )
 
 
   )
 
 

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

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

-(defun mime-view-quitting-method-for-mime/show-message-mode ()
-  (let ((mother mime::preview/mother-buffer)
-       (win-conf mime::preview/original-window-configuration)
+(defun mime-preview-quitting-method-for-mime-show-message-mode ()
+  "Quitting method for mime-view.
+It is registered to variable `mime-preview-quitting-method-alist'."
+  (let ((mother mime-mother-buffer)
+       (win-conf mime-preview-original-window-configuration)

        )
        )

-    (kill-buffer
-     (mime::preview-content-info/buffer (car mime::preview/content-list)))
-    (mime-view-kill-buffer)
+    (kill-buffer mime-raw-buffer)
+    (mime-preview-kill-buffer)

     (set-window-configuration win-conf)
     (pop-to-buffer mother)
     (set-window-configuration win-conf)
     (pop-to-buffer mother)

-    ;;(goto-char (point-min))
-    ;;(mime-view-up-content)

     ))
 
     ))
 

-(defun mime-article/view-message/rfc822 (beg end cal)
-  (let* ((cnum (mime-article/point-content-number beg))
-        (cur-buf (current-buffer))
+(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))
         (new-name (format "%s-%s" (buffer-name) cnum))

-        (mother mime::article/preview-buffer)
-        (code-converter
-         (or (cdr (assq major-mode mime-text-decoder-alist))
-             'mime-view-default-code-convert-region))
+        (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)
         str)
     (setq str (buffer-substring beg end))
     (switch-to-buffer new-name)

@@ -466,8 +432,8 @@ return new alist whose car is the new pair and cdr is ALIST.
     (if (re-search-forward "^\n" nil t)
        (delete-region (point-min) (match-end 0))
       )
     (if (re-search-forward "^\n" nil t)
        (delete-region (point-min) (match-end 0))
       )

-    (setq major-mode 'mime/show-message-mode)
-    (setq mime::article/code-converter code-converter)
+    (setq major-mode 'mime-show-message-mode)
+    (setq mime-text-decoder text-decoder)

     (mime-view-mode mother)
     ))
 
     (mime-view-mode mother)
     ))
 

@@ -475,55 +441,30 @@ return new alist whose car is the new pair and cdr is ALIST.
 ;;; @ message/partial
 ;;;
 
 ;;; @ message/partial
 ;;;
 

-(defvar mime-article/coding-system-alist
-  (list '(mh-show-mode . no-conversion)
-       (cons t (mime-charset-to-coding-system default-mime-charset))
-       ))
-
-(cond (running-mule-merged-emacs
-       (defun mime-article::write-region (start end file)
-        (let ((coding-system-for-write
-               (cdr
-                (or (assq major-mode mime-article/coding-system-alist)
-                    (assq t mime-article/coding-system-alist)
-                    ))))
-          (write-region start end file)
-          ))
-       )
-      ((or (boundp 'MULE)
-          running-xemacs-with-mule)
-       (defun mime-article::write-region (start end file)
-        (let ((file-coding-system
-               (cdr
-                (or (assq major-mode mime-article/coding-system-alist)
-                    (assq t mime-article/coding-system-alist)
-                    ))))
-          (write-region start end file)
-          ))
-       )
-      ((boundp 'NEMACS)
-       (defun mime-article::write-region (start end file)
-        (let ((kanji-fileio-code
-               (cdr
-                (or (assq major-mode mime-article/kanji-code-alist)
-                    (assq t mime-article/kanji-code-alist)
-                    ))))
-          (write-region start end file)
-          ))
-       )
-      (t
-       (defalias 'mime-article::write-region 'write-region)
-       ))
+(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-article/decode-message/partial (beg end cal)
+(defun mime-method-to-store-message/partial (beg end cal)

   (goto-char beg)
   (goto-char beg)

-  (let* ((root-dir (expand-file-name
-                   (concat "m-prts-" (user-login-name)) mime/tmp-dir))
+  (let* ((root-dir
+         (expand-file-name
+          (concat "m-prts-" (user-login-name)) mime-temp-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::article/preview-buffer)
+        (mother mime-preview-buffer)

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

@@ -543,19 +484,19 @@ return new alist whose car is the new pair and cdr is ALIST.
            (set-buffer full-buf)
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))
            (set-buffer full-buf)
            (erase-buffer)
            (as-binary-input-file (insert-file-contents file))

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

            (mime-view-mode mother)
            )
          (set-window-buffer pwin
                             (save-excursion
                               (set-buffer full-buf)
            (mime-view-mode mother)
            )
          (set-window-buffer pwin
                             (save-excursion
                               (set-buffer full-buf)

-                              mime::article/preview-buffer))
+                              mime-preview-buffer))

          (select-window pwin)
          )
       (re-search-forward "^$")
       (goto-char (1+ (match-end 0)))
       (setq file (concat root-dir "/" number))
          (select-window pwin)
          )
       (re-search-forward "^$")
       (goto-char (1+ (match-end 0)))
       (setq file (concat root-dir "/" number))

-      (mime-article::write-region (point) (point-max) file)
+      (mime-raw-write-region (point) end file)

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

@@ -563,10 +504,10 @@ return new alist whose car is the new pair and cdr is ALIST.
                    (or (file-exists-p total-file)
                        (save-excursion
                          (set-buffer
                    (or (file-exists-p total-file)
                        (save-excursion
                          (set-buffer

-                          (get-buffer-create mime/temp-buffer-name))
+                          (get-buffer-create mime-temp-buffer-name))

                          (erase-buffer)
                          (insert total)
                          (erase-buffer)
                          (insert total)

-                         (write-file total-file)
+                         (write-region (point-min)(point-max) total-file)

                          (kill-buffer (current-buffer))
                          ))
                    (string-to-number total)
                          (kill-buffer (current-buffer))
                          ))
                    (string-to-number total)

@@ -586,7 +527,7 @@ return new alist whose car is the new pair and cdr is ALIST.
       (if (and total (> total 0))
          (catch 'tag
            (save-excursion
       (if (and total (> total 0))
          (catch 'tag
            (save-excursion

-             (set-buffer (get-buffer-create mime/temp-buffer-name))
+             (set-buffer (get-buffer-create mime-temp-buffer-name))

              (let ((full-buf (current-buffer)))
                (erase-buffer)
                (let ((i 1))
              (let ((full-buf (current-buffer)))
                (erase-buffer)
                (let ((i 1))

@@ -599,7 +540,9 @@ return new alist whose car is the new pair and cdr is ALIST.
                    (goto-char (point-max))
                    (setq i (1+ i))
                    ))
                    (goto-char (point-max))
                    (setq i (1+ i))
                    ))

-               (as-binary-output-file (write-file (concat root-dir "/FULL")))
+               (as-binary-output-file
+                 (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)))

@@ -613,7 +556,7 @@ return new alist whose car is the new pair and cdr is ALIST.
                       (delete-file file)
                       ))
                (save-window-excursion
                       (delete-file file)
                       ))
                (save-window-excursion

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

                  (mime-view-mode mother)
                  )
                (let ((pwin (or (get-buffer-window mother)
                  (mime-view-mode mother)
                  )
                (let ((pwin (or (get-buffer-window mother)

@@ -621,45 +564,56 @@ return new alist whose car is the new pair and cdr is ALIST.
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)
                                ))
                      (pbuf (save-excursion
                              (set-buffer full-buf)

-                             mime::article/preview-buffer)))
+                             mime-preview-buffer)))

                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
       )))
 
 
                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
       )))
 
 

-;;; @ rot13-47
+;;; @ message/external-body

 ;;;
 
 ;;;
 

-(require 'view)
+(defvar mime-raw-dired-function
+  (if (and (>= emacs-major-version 19) window-system)
+      (function dired-other-frame)
+    (function mime-raw-dired-function-for-one-frame)
+    ))

 
 

-(defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map))
-(define-key mime-view-text/plain-mode-map
-  "q" (function mime-view-text/plain-exit))
+(defun mime-raw-dired-function-for-one-frame (dir)
+  (let ((win (or (get-buffer-window mime-preview-buffer)
+                (get-largest-window))))
+    (select-window win)
+    (dired dir)
+    ))

 
 

-(defun mime-view-text/plain-mode ()
-  "\\{mime-view-text/plain-mode-map}"
-  (setq buffer-read-only t)
-  (setq major-mode 'mime-view-text/plain-mode)
-  (setq mode-name "MIME-View text/plain")
-  (use-local-map mime-view-text/plain-mode-map)
-  )
+(defun mime-method-to-display-message/external-ftp (beg end 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) "..."))
+    (funcall mime-raw-dired-function pathname)
+    (goto-char (point-min))
+    (search-forward name)
+    ))

 
 

-(defun mime-view-text/plain-exit ()
-  (interactive)
-  (kill-buffer (current-buffer))
-  )

 
 

-(defun mime-article/decode-caesar (beg end cal)
-  (let* ((cnum (mime-article/point-content-number beg))
-        (cur-buf (current-buffer))
+;;; @ rot13-47
+;;;
+
+(defun mime-method-to-display-caesar (start end cal)
+  "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))
         (new-name (format "%s-%s" (buffer-name) cnum))

-        (mother mime::article/preview-buffer)
+        (the-buf (current-buffer))
+        (mother mime-preview-buffer)

         (charset (cdr (assoc "charset" cal)))
         (encoding (cdr (assq 'encoding cal)))
         (mode major-mode)
         (charset (cdr (assoc "charset" cal)))
         (encoding (cdr (assq 'encoding cal)))
         (mode major-mode)

-        str)
-    (setq str (buffer-substring beg end))
+        )

     (let ((pwin (or (get-buffer-window mother)
                    (get-largest-window)))
          (buf (get-buffer-create new-name))
     (let ((pwin (or (get-buffer-window mother)
                    (get-largest-window)))
          (buf (get-buffer-create new-name))

@@ -670,7 +624,7 @@ return new alist whose car is the new pair and cdr is ALIST.
       )
     (setq buffer-read-only nil)
     (erase-buffer)
       )
     (setq buffer-read-only nil)
     (erase-buffer)

-    (insert str)
+    (insert-buffer-substring the-buf start end)

     (goto-char (point-min))
     (if (re-search-forward "^\n" nil t)
        (delete-region (point-min) (match-end 0))
     (goto-char (point-min))
     (if (re-search-forward "^\n" nil t)
        (delete-region (point-min) (match-end 0))

@@ -680,13 +634,10 @@ return new alist whose car is the new pair and cdr is ALIST.
       (and (functionp m)
           (funcall m charset encoding)
           ))
       (and (functionp m)
           (funcall m charset encoding)
           ))

-    (save-excursion
-      (set-mark (point-min))
-      (goto-char (point-max))
-      (tm:caesar-region)
-      )
+    (mule-caesar-region (point-min) (point-max))

     (set-buffer-modified-p nil)
     (set-buffer-modified-p nil)

-    (mime-view-text/plain-mode)
+    (set-buffer mother)
+    (view-buffer new-name)

     ))
 
 
     ))
 
 

@@ -695,4 +646,19 @@ return new alist whose car is the new pair and cdr is ALIST.
 
 (provide 'mime-play)
 
 
 (provide 'mime-play)
 

+(let* ((file mime-acting-situation-examples-file)
+       (buffer (get-buffer-create " *mime-example*")))
+  (if (file-readable-p file)
+      (unwind-protect
+         (save-excursion
+           (set-buffer buffer)
+           (erase-buffer)
+           (insert-file-contents file)
+           (eval-current-buffer)
+           ;; format check
+           (or (eq (car mime-acting-situation-examples) 'type)
+               (setq mime-acting-situation-examples nil))
+           )
+       (kill-buffer buffer))))
+

 ;;; mime-play.el ends here
 ;;; mime-play.el ends here