update.

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

diff --git a/mime-play.el b/mime-play.el
index 11f904b..0c89895 100644 (file)
--- a/mime-play.el
+++ b/mime-play.el
@@ -1,8 +1,9 @@
 ;;; 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, 2000, 2002, 2003,
+;;   2004, 2010 Free Software Foundation, Inc.

 
 

-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>

 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 ;; Keywords: MIME, multimedia, mail, news
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 ;; Keywords: MIME, multimedia, mail, news

@@ -21,8 +22,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the

-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.

 
 ;;; Code:
 
 
 ;;; Code:
 

@@ -36,86 +37,29 @@
     (error (defvar bbdb-buffer-name nil)))
   )
 
     (error (defvar bbdb-buffer-name nil)))
   )
 

-(defvar mime-acting-situation-example-list nil)
-
-(defvar mime-acting-situation-example-list-max-size 16)
-
-(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 "\n\n")
-         (insert ";;; Code:\n\n")
-         (pp `(setq mime-acting-situation-example-list
-                    ',mime-acting-situation-example-list)
-             (current-buffer))
-         (insert "\n;;; "
-                  (file-name-nondirectory file)
-                  " ends here.\n")
-          (save-buffer))
-      (kill-buffer buffer))))
-
-(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples)
-
-(defun mime-reduce-acting-situation-examples ()
-  (let* ((rest mime-acting-situation-example-list)
-        (min-example (car rest))
-        (min-score (cdr min-example)))
-    (while rest
-      (let* ((example (car rest))
-            (score (cdr example)))
-       (cond ((< score min-score)
-              (setq min-score score
-                    min-example example)
-              )
-             ((= score min-score)
-              (if (<= (length (car example))(length (car min-example)))
-                  (setq min-example example)
-                ))
-             ))
-      (setq rest (cdr rest)))
-    (setq mime-acting-situation-example-list
-         (delq min-example mime-acting-situation-example-list))
-    (setq min-example (car min-example))
-    (let ((examples mime-acting-situation-example-list)
-         (max-score 0)
-         max-examples)
-      (while examples
-       (let* ((ret (mime-compare-situation-with-example min-example
-                                                        (caar examples)))
-              (ret-score (car ret)))
-         (cond ((> ret-score max-score)
-                (setq max-score ret-score
-                      max-examples (list (cdr ret)))
-                )
-               ((= ret-score max-score)
-                (setq max-examples (cons (cdr ret) max-examples))
-                )))
-       (setq examples (cdr examples)))
-      (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))
-       ))))
+(defcustom mime-save-directory "~/"
+  "*Name of the directory where MIME entity will be saved in.
+If t, it means current directory."
+  :group 'mime-view
+  :type '(choice (const :tag "Current directory" t)
+                (directory)))
+
+(defcustom mime-play-delete-file-immediately t
+  "If non-nil, delete played file immediately."
+  :group 'mime-view
+  :type 'boolean)
+
+(defvar mime-play-find-every-situations t
+  "*Find every available situations if non-nil.")
+
+(defvar mime-play-messages-coding-system nil
+  "Coding system to be used for external MIME playback method.")

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

-(defvar mime-preview-after-decoded-position nil)
-
+;;;###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
 (defun mime-preview-play-current-entity (&optional ignore-examples mode)
   "Play current entity.
 It decodes current entity to call internal or external method.  The

@@ -126,156 +70,39 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
   (interactive "P")
   (let ((entity (get-text-property (point) 'mime-view-entity)))
     (if entity
   (interactive "P")
   (let ((entity (get-text-property (point) 'mime-view-entity)))
     (if entity

-       (let ((the-buf (current-buffer))
-             (raw-buffer (mime-entity-buffer entity)))
-         (setq mime-preview-after-decoded-position (point))
-         (set-buffer raw-buffer)
-         (mime-raw-play-entity entity (or mode "play") nil ignore-examples)
-         (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)
-                          (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))
-             )))
-  )
-
-(defsubst mime-delq-null-situation (situations field
-                                              &optional ignored-value)
-  (let (dest)
-    (while situations
-      (let* ((situation (car situations))
-            (cell (assq field situation)))
-       (if cell
-           (or (eq (cdr cell) ignored-value)
-               (setq dest (cons situation dest))
-               )))
-      (setq situations (cdr situations)))
-    dest))
-
-(defun mime-compare-situation-with-example (situation example)
-  (let ((example (copy-alist example))
-       (match 0))
-    (while situation
-      (let* ((cell (car situation))
-            (key (car cell))
-            (ecell (assoc key example)))
-       (when ecell
-         (if (equal cell ecell)
-             (setq match (1+ match))
-           (setq example (delq ecell example))
-           ))
-       )
-      (setq situation (cdr situation))
-      )
-    (cons match example)
-    ))
-
-(defun mime-raw-play-entity (entity &optional mode situation ignore-examples
-                                   ignored-method)
+       (let ((situation
+              (get-text-property (point) 'mime-view-situation)))
+         (or mode
+             (setq mode "play"))
+         (setq situation 
+               (if (assq 'mode situation)
+                   (put-alist 'mode mode (copy-alist situation))
+                 (cons (cons 'mode mode)
+                       situation)))
+         (if ignore-examples
+             (setq situation
+                   (cons (cons 'ignore-examples ignore-examples)
+                         situation)))
+         (mime-play-entity entity situation)
+         ))))
+
+;;;###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\"."
   "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\"."

-  (let (method ret)
-    (or situation
-       (setq situation (mime-entity-situation entity)))
-    (if mode
-       (setq situation (cons (cons 'mode mode) situation))
-      )
-    (if ignore-examples
-       (or (assq 'ignore-examples situation)
-           (setq situation
-                 (cons (cons 'ignore-examples ignore-examples) situation)))
-      )
-    (setq ret
-         (mime-delq-null-situation
-          (ctree-find-calist mime-acting-condition situation
-                             mime-view-find-every-acting-situation)
-          'method ignored-method))
-    (or ignore-examples
-       (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))
-                 )))))
+  (let ((ret
+        (mime-unify-situations (mime-entity-situation entity situation)
+                               mime-acting-condition
+                               mime-acting-situation-example-list
+                               'method ignored-method
+                               mime-play-find-every-situations))
+       method)
+    (setq mime-acting-situation-example-list (cdr ret)
+         ret (car ret))

     (cond ((cdr ret)
     (cond ((cdr ret)

-          (setq ret (select-menu-alist
+          (setq ret (mime-select-menu-alist

                      "Methods"
                      (mapcar (function
                               (lambda (situation)
                      "Methods"
                      (mapcar (function
                               (lambda (situation)

@@ -303,7 +130,11 @@ specified, play as it.  Default MODE is \"play\"."
           ;;  )
          (t
           (mime-show-echo-buffer "No method are specified for %s\n"
           ;;  )
          (t
           (mime-show-echo-buffer "No method are specified for %s\n"

-                                 (mime-entity-type/subtype entity))
+                                 (mime-type/subtype-string
+                                  (cdr (assq 'type situation))
+                                  (cdr (assq 'subtype situation))))
+          (if (y-or-n-p "Do you want to save current entity to disk?")
+              (mime-save-content entity situation))

           ))
     ))
 
           ))
     ))
 

@@ -314,42 +145,43 @@ specified, play as it.  Default MODE is \"play\"."
 (defvar mime-mailcap-method-filename-alist nil)
 
 (defun mime-activate-mailcap-method (entity situation)
 (defvar mime-mailcap-method-filename-alist nil)
 
 (defun mime-activate-mailcap-method (entity situation)

-  (save-excursion
-    (save-restriction
-      (let ((start (mime-entity-point-min entity))
-           (end (mime-entity-point-max entity)))
-       (narrow-to-region start end)
-       (goto-char start)
-       (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)
-           )
-         )))))
+  (let ((method (cdr (assoc 'method situation)))
+       (name (mime-entity-safe-filename entity)))
+    (setq name (expand-file-name (if (and name (not (string= name "")))
+                                    name
+                                  (make-temp-name "EMI"))
+                                (make-temp-file "EMI" 'directory)))
+    (mime-write-entity-content entity name)
+    (message "External method is starting...")
+    (let ((process
+          (let ((command
+                 (mime-format-mailcap-command
+                  method
+                  (cons (cons 'filename name) situation)))
+                (coding-system-for-read mime-play-messages-coding-system))
+            (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)
 
 (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)))
+  (when mime-play-delete-file-immediately
+    (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
+      (when (file-exists-p file)
+       (ignore-errors
+         (delete-file file)
+         (delete-directory (file-name-directory file)))))
+    (remove-alist 'mime-mailcap-method-filename-alist process))
+  (message "%s %s" process event))
+
+(defun mime-mailcap-delete-played-files ()
+  (dolist (elem mime-mailcap-method-filename-alist)
+    (when (file-exists-p (cdr elem))
+      (ignore-errors
+       (delete-file (cdr elem))
+       (delete-directory (file-name-directory (cdr elem)))))))
+
+(add-hook 'kill-emacs-hook 'mime-mailcap-delete-played-files)

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

@@ -376,7 +208,8 @@ window.")
                   (condition-case nil
                       (setq win (get-buffer-window bbdb-buffer-name))
                     (error nil)))
                   (condition-case nil
                       (setq win (get-buffer-window bbdb-buffer-name))
                     (error nil)))

-       (select-window (get-buffer-window mime-preview-buffer))
+       (select-window (get-buffer-window (or mime-preview-buffer
+                                             (current-buffer))))

        (setq win (split-window-vertically
                   (- (window-height)
                      (if (functionp mime-echo-window-height)
        (setq win (split-window-vertically
                   (- (window-height)
                      (if (functionp mime-echo-window-height)

@@ -389,8 +222,9 @@ window.")
     (select-window win)
     (goto-char (point-max))
     (if forms
     (select-window win)
     (goto-char (point-max))
     (if forms

-       (insert (apply (function format) forms))
-      )
+       (let ((buffer-read-only nil))
+         (insert (apply (function format) forms))
+         ))

     (select-window the-win)
     ))
 
     (select-window the-win)
     ))
 

@@ -412,8 +246,8 @@ window.")
   (let ((filename
         (or (mime-entity-filename entity)
             (let ((subj
   (let ((filename
         (or (mime-entity-filename entity)
             (let ((subj

-                   (or (mime-read-field 'Content-Description entity)
-                       (mime-read-field 'Subject entity))))
+                   (or (mime-entity-read-field entity 'Content-Description)
+                       (mime-entity-read-field entity 'Subject))))

               (if (and subj
                        (or (string-match mime-view-file-name-regexp-1 subj)
                            (string-match mime-view-file-name-regexp-2 subj)))
               (if (and subj
                        (or (string-match mime-view-file-name-regexp-1 subj)
                            (string-match mime-view-file-name-regexp-2 subj)))

@@ -428,27 +262,26 @@ window.")
 ;;;
 
 (defun mime-save-content (entity situation)
 ;;;
 
 (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)))))))
-        )
+  (let ((name (or (mime-entity-safe-filename entity)
+                 (format "%s" (mime-entity-media-type entity))))
+       (dir (if (eq t mime-save-directory)
+                default-directory
+              mime-save-directory))
+       filename)
+    (setq filename (read-file-name
+                   (concat "File name: (default "
+                           (file-name-nondirectory name) ") ")
+                   dir
+                   (concat (file-name-as-directory dir)
+                           (file-name-nondirectory name))))
+    (if (file-directory-p filename)
+       (setq filename (concat (file-name-as-directory filename)
+                              (file-name-nondirectory name))))

     (if (file-exists-p filename)
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))
     (if (file-exists-p filename)
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))

-    (mime-write-entity-content entity filename)
-    ))
+    (mime-write-entity-content entity (expand-file-name filename))
+    filename))

 
 
 ;;; @ file detection
 
 
 ;;; @ file detection

@@ -472,16 +305,7 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 
 (defun mime-detect-content (entity situation)
   (let (type subtype)
 
 (defun mime-detect-content (entity situation)
   (let (type subtype)

-    (let ((mdata (save-excursion
-                  ;;(set-buffer (mime-entity-buffer entity))
-                  (let* ((start (mime-entity-body-start entity))
-                         (end (progn
-                                (goto-char start)
-                                (end-of-line)
-                                (point))))
-                    (mime-decode-string (buffer-substring start end)
-                                        (mime-entity-encoding entity))
-                    )))
+    (let ((mdata (mime-entity-content entity))

          (rest mime-magic-type-alist))
       (while (not (let ((cell (car rest)))
                    (if cell
          (rest mime-magic-type-alist))
       (while (not (let ((cell (car rest)))
                    (if cell

@@ -491,17 +315,14 @@ SUBTYPE is symbol to indicate subtype of media-type.")
                          )
                      t)))
        (setq rest (cdr rest))))
                          )
                      t)))
        (setq rest (cdr rest))))

-    (if type
-       (mime-raw-play-entity
-        entity nil
-        (put-alist 'type type
-                   (put-alist 'subtype subtype
-                              (del-alist 'method
-                                         (copy-alist situation))))
-        (cdr (assq 'ignore-examples situation))
-        'mime-detect-content)
-      ))
-  )
+    (setq situation (del-alist 'method (copy-alist situation)))
+    (mime-play-entity entity
+                     (if type
+                         (put-alist 'type type
+                                    (put-alist 'subtype subtype
+                                               situation))
+                       situation)
+                     'mime-detect-content)))

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

@@ -511,72 +332,98 @@ SUBTYPE is symbol to indicate subtype of media-type.")
   "Quitting method for mime-view.
 It is registered to variable `mime-preview-quitting-method-alist'."
   (let ((mother mime-mother-buffer)
   "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-raw-buffer)
+       (win-conf mime-preview-original-window-configuration))
+    (if (buffer-live-p mime-view-temp-message-buffer)
+       (kill-buffer mime-view-temp-message-buffer))

     (mime-preview-kill-buffer)
     (set-window-configuration win-conf)
     (mime-preview-kill-buffer)
     (set-window-configuration win-conf)

-    (pop-to-buffer mother)
-    ))
+    (pop-to-buffer mother)))

 
 (defun mime-view-message/rfc822 (entity situation)
   (let* ((new-name
          (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 
 (defun mime-view-message/rfc822 (entity situation)
   (let* ((new-name
          (format "%s-%s" (buffer-name) (mime-entity-number entity)))

-        (mother mime-preview-buffer)
-        (children (car (mime-entity-children entity))))
-    (set-buffer (get-buffer-create new-name))
-    (erase-buffer)
-    (insert-buffer-substring (mime-entity-buffer children)
-                            (mime-entity-point-min children)
-                            (mime-entity-point-max children))
-    (setq mime-message-structure children)
-    (setq major-mode 'mime-show-message-mode)
-    (mime-view-buffer (current-buffer) nil mother
-                     nil (if (mime-entity-cooked-p entity) 'cooked))
-    ))
+        (mother (current-buffer))
+        (children (car (mime-entity-children entity)))
+        (preview-buffer
+         (mime-display-message
+          children new-name mother nil
+          (cdr (assq 'major-mode
+                     (get-text-property (point) 'mime-view-situation))))))
+    (or (get-buffer-window preview-buffer)
+       (let ((m-win (get-buffer-window mother)))
+         (if m-win
+             (set-window-buffer m-win preview-buffer)
+           (switch-to-buffer preview-buffer)
+           )))))

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

+(defun mime-require-safe-directory (dir)
+  "Create a directory DIR safely.
+The permission of the created directory becomes `700' (for the owner only).
+If the directory already exists and is writable by other users, an error
+occurs."
+  (let ((attr (file-attributes dir))
+       (orig-modes (default-file-modes)))
+    (if (and attr (eq (car attr) t)) ; directory already exists.
+       (unless (or (memq system-type '(windows-nt ms-dos OS/2 emx))
+                   (and (eq (nth 2 attr) (user-real-uid))
+                        (eq (file-modes dir) 448)))
+         (error "Invalid owner or permission for %s" dir))
+      (unwind-protect
+         (progn
+           (set-default-file-modes 448)
+           (make-directory dir))
+       (set-default-file-modes orig-modes)))))
+
+(defvar mime-view-temp-message-buffer nil) ; buffer local variable
+

 (defun mime-store-message/partial-piece (entity cal)
 (defun mime-store-message/partial-piece (entity cal)

-  (goto-char (mime-entity-point-min entity))
-  (let* ((root-dir
-         (expand-file-name
-          (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
-        (mother mime-preview-buffer)
-        )
+  (let ((root-dir
+        (expand-file-name
+         (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
+       (mother (current-buffer))
+       (orig-modes (default-file-modes)))
+    (mime-require-safe-directory root-dir)

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

-       (make-directory root-dir)
-       )
+       (unwind-protect
+           (progn
+             (set-default-file-modes 448)
+             (make-directory root-dir))
+         (set-default-file-modes orig-modes)))

     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))
     (setq id (replace-as-filename id))
     (setq root-dir (concat root-dir "/" id))

+

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

-       (make-directory root-dir)
-       )
+       (unwind-protect
+           (progn
+             (set-default-file-modes 448)
+             (make-directory root-dir))
+         (set-default-file-modes orig-modes)))
+

     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
        (let ((full-buf (get-buffer-create "FULL"))
              (pwin (or (get-buffer-window mother)
                        (get-largest-window)))
     (setq file (concat root-dir "/FULL"))
     (if (file-exists-p file)
        (let ((full-buf (get-buffer-create "FULL"))
              (pwin (or (get-buffer-window mother)
                        (get-largest-window)))

-             )
+             pbuf)

          (save-window-excursion
            (set-buffer full-buf)
            (erase-buffer)
          (save-window-excursion
            (set-buffer full-buf)
            (erase-buffer)

-           (as-binary-input-file (insert-file-contents file))
+           (binary-insert-encoded-file file)

            (setq major-mode 'mime-show-message-mode)
            (mime-view-buffer (current-buffer) nil mother)
            (setq major-mode 'mime-show-message-mode)
            (mime-view-buffer (current-buffer) nil mother)

-           )
-         (set-window-buffer pwin
-                            (save-excursion
-                              (set-buffer full-buf)
-                              mime-preview-buffer))
-         (select-window pwin)
-         )
+           (setq pbuf (current-buffer))
+           (make-local-variable 'mime-view-temp-message-buffer)
+           (setq mime-view-temp-message-buffer full-buf))
+         (set-window-buffer pwin pbuf)
+         (select-window pwin))

       (setq file (concat root-dir "/" number))
       (mime-write-entity-body entity file)
       (let ((total-file (concat root-dir "/CT")))
       (setq file (concat root-dir "/" number))
       (mime-write-entity-body entity file)
       (let ((total-file (concat root-dir "/CT")))

@@ -606,7 +453,9 @@ It is registered to variable `mime-preview-quitting-method-alist'."
                         (kill-buffer (current-buffer))
                         )))
                )))
                         (kill-buffer (current-buffer))
                         )))
                )))

-      (if (and total (> total 0))
+      (if (and total (> total 0)
+              (>= (length (directory-files root-dir nil "^[0-9]+$" t))
+                  total))

          (catch 'tag
            (save-excursion
              (set-buffer (get-buffer-create mime-temp-buffer-name))
          (catch 'tag
            (save-excursion
              (set-buffer (get-buffer-create mime-temp-buffer-name))

@@ -618,34 +467,30 @@ It is registered to variable `mime-preview-quitting-method-alist'."
                    (or (file-exists-p file)
                        (throw 'tag nil)
                        )
                    (or (file-exists-p file)
                        (throw 'tag nil)
                        )

-                   (as-binary-input-file (insert-file-contents file))
+                   (binary-insert-encoded-file file)

                    (goto-char (point-max))
                    (goto-char (point-max))

-                   (setq i (1+ i))
-                   ))
-               (as-binary-output-file
-                (write-region (point-min)(point-max)
-                              (expand-file-name "FULL" root-dir)))
+                   (setq i (1+ i))))
+               (binary-write-decoded-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)))
                      (and (file-exists-p file)
                (let ((i 1))
                  (while (<= i total)
                    (let ((file (format "%s/%d" root-dir i)))
                      (and (file-exists-p file)

-                          (delete-file file)
-                          ))
-                   (setq i (1+ i))
-                   ))
+                          (delete-file file)))
+                   (setq i (1+ i))))

                (let ((file (expand-file-name "CT" root-dir)))
                  (and (file-exists-p file)
                (let ((file (expand-file-name "CT" root-dir)))
                  (and (file-exists-p file)

-                      (delete-file file)
-                      ))
-               (save-window-excursion
-                 (setq major-mode 'mime-show-message-mode)
-                 (mime-view-buffer (current-buffer) nil mother)
-                 )
-               (let ((pwin (or (get-buffer-window mother)
+                      (delete-file file)))
+               (let ((buf (current-buffer))
+                     (pwin (or (get-buffer-window mother)

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

-                     (pbuf (save-excursion
-                             (set-buffer full-buf)
-                             mime-preview-buffer)))
+                     (pbuf (mime-display-message
+                            (mime-open-entity 'buffer (current-buffer))
+                            nil mother nil 'mime-show-message-mode)))
+                 (with-current-buffer pbuf
+                   (make-local-variable 'mime-view-temp-message-buffer)
+                   (setq mime-view-temp-message-buffer buf))

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

@@ -673,17 +518,17 @@ It is registered to variable `mime-preview-quitting-method-alist'."
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
         (pathname (concat "/anonymous@" site ":" directory)))
         (directory (cdr (assoc "directory" cal)))
         (name (cdr (assoc "name" cal)))
         (pathname (concat "/anonymous@" site ":" directory)))

-    (message (concat "Accessing " (expand-file-name name pathname) " ..."))
+    (message "%s" (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 (function mime-browse-url))
+(defvar mime-raw-browse-url-function mime-browse-url-function)

 
 (defun mime-view-message/external-url (entity cal)
   (let ((url (cdr (assoc "url" cal))))
 
 (defun mime-view-message/external-url (entity cal)
   (let ((url (cdr (assoc "url" cal))))

-    (message (concat "Accessing " url " ..."))
+    (message "%s" (concat "Accessing " url "..."))

     (funcall mime-raw-browse-url-function url)))
 
 
     (funcall mime-raw-browse-url-function url)))
 
 

@@ -692,23 +537,21 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 
 (defun mime-view-caesar (entity situation)
   "Internal method for mime-view to display ROT13-47-48 message."
 
 (defun mime-view-caesar (entity situation)
   "Internal method for mime-view to display ROT13-47-48 message."

-  (let* ((new-name (format "%s-%s" (buffer-name)
-                          (mime-entity-number entity)))
-        (mother mime-preview-buffer))
-    (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)
-    (mime-insert-text-content entity)
-    (mule-caesar-region (point-min) (point-max))
-    (set-buffer-modified-p nil)
-    (set-buffer mother)
-    (view-buffer new-name)
+    (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))

     ))
 
 
     ))
 
 

@@ -717,26 +560,4 @@ It is registered to variable `mime-preview-quitting-method-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-buffer)
-           ;; format check
-           (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))))
-

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