X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=984e36f1b954a198a9e45f6e16a1ce315b1a4aae;hb=8dcd38a161c8cf5862a8ca53f50e01612010f314;hp=250a4d4f6e12fa0b45d8bd81faabd65384cf5e50;hpb=e428eb5383955e548bfbdc1889f3434a64166c7b;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index 250a4d4..984e36f 100644 --- a/mime-play.el +++ b/mime-play.el @@ -21,8 +21,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 +43,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 +101,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,39 +143,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 + (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)))) - (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) @@ -319,8 +332,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) @@ -347,21 +359,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")) @@ -473,7 +517,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) @@ -483,7 +527,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)))