X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=59c8bb67d8935a7c0ca178f2f127eac1dfceae94;hb=cfd4673f6df4e165aeb7337627d97c07a1445f0b;hp=a3bf08638ec24ae76fd68d1b2f5755c033a0e9ca;hpb=b184a5d453660cd595b026b95bef186276899d9e;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index a3bf086..59c8bb6 100644 --- a/mime-play.el +++ b/mime-play.el @@ -43,6 +43,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 +156,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.") @@ -346,6 +360,24 @@ 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))))) + (defun mime-store-message/partial-piece (entity cal) (let* ((root-dir (expand-file-name @@ -355,7 +387,8 @@ It is registered to variable `mime-preview-quitting-method-alist'." (total (cdr (assoc "total" cal))) file (mother (current-buffer)) - orig-modes (default-file-modes)) + (orig-modes (default-file-modes))) + (mime-require-safe-directory root-dir) (or (file-exists-p root-dir) (unwind-protect (progn