(mime-save-content): Return filename.
[elisp/semi.git] / mime-play.el
index c766828..0c89895 100644 (file)
@@ -1,6 +1,7 @@
 ;;; mime-play.el --- Playback processing module for mime-view.el
 
-;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003,
+;;   2004, 2010 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1995/9/26 (separated from tm-view.el)
@@ -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
-;; 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:
 
@@ -43,6 +44,11 @@ If t, it means current directory."
   :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.")
 
@@ -151,23 +157,32 @@ specified, play as it.  Default MODE is \"play\"."
           (let ((command
                  (mime-format-mailcap-command
                   method
-                  (cons (cons 'filename name) situation))))
-            (binary-to-text-funcall
-             mime-play-messages-coding-system
-             #'start-process command mime-echo-buffer-name
+                  (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)
-  (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)
+  (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)
   "*If non-nil, mime-echo window is shared with BBDB window.")
@@ -266,7 +281,7 @@ window.")
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))
     (mime-write-entity-content entity (expand-file-name filename))
-    ))
+    filename))
 
 
 ;;; @ file detection
@@ -318,8 +333,7 @@ SUBTYPE is symbol to indicate subtype of media-type.")
 It is registered to variable `mime-preview-quitting-method-alist'."
   (let ((mother mime-mother-buffer)
        (win-conf mime-preview-original-window-configuration))
-    (if (and (boundp 'mime-view-temp-message-buffer)
-            (buffer-live-p mime-view-temp-message-buffer))
+    (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)
@@ -351,27 +365,31 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 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 ((orig-modes (default-file-modes)))
-    (if (file-directory-p dir)
+  (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))
-                   (eq (file-modes dir) 448))
-         (error "Invalid permission for %s" dir))
+                   (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)
-  (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)))
+  (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)
        (unwind-protect