X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=0c89895ddf327708146a6889e7b7a81a06c7b25f;hb=a418e1c8b54f1dfb2e4f648b30107c0e9b5ae98b;hp=6f642c6f9946b9213b69e114e5c85689d6a8b549;hpb=ae67ae2641ec07e7f8492146ce0776991ed11b80;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index 6f642c6..0c89895 100644 --- a/mime-play.el +++ b/mime-play.el @@ -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 ;; 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,9 +44,17 @@ 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.") +(defvar mime-play-messages-coding-system nil + "Coding system to be used for external MIME playback method.") + ;;; @ content decoder ;;; @@ -93,7 +102,7 @@ specified, play as it. Default MODE is \"play\"." (setq mime-acting-situation-example-list (cdr ret) ret (car ret)) (cond ((cdr ret) - (setq ret (select-menu-alist + (setq ret (mime-select-menu-alist "Methods" (mapcar (function (lambda (situation) @@ -135,42 +144,44 @@ specified, play as it. Default MODE is \"play\"." (defvar mime-mailcap-method-filename-alist nil) -(defvar mime-mailcap-method-messages-coding-system 'undecided - "Coding system for an external mailcap method.") - (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)) - )) + (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)))) - (binary-to-text-funcall - #'mime-mailcap-method-messages-coding-system - #'start-process command mime-echo-buffer-name - shell-file-name shell-command-switch command) - ))) + (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) - ) - )) + (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))) + (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) @@ -270,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 @@ -322,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) @@ -350,21 +360,53 @@ It is registered to variable `mime-preview-quitting-method-alist'." ;;; @ 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) - (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))) + (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) - (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)) + (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")) @@ -476,7 +518,7 @@ 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))) - (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) @@ -486,7 +528,7 @@ It is registered to variable `mime-preview-quitting-method-alist'." (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)))