X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=f15f8165c8033be9855a50a83656265aad8a695c;hb=ed6d70aaa4d35c0f0c50df469b886d03931d6fbd;hp=0f8288e72b73dfaf9e324016ab77546aebe793d7;hpb=19fe876c999fe0d44e6d07c5cbaf36d4a2dc5db7;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index 0f8288e..f15f816 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: @@ -42,9 +42,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 ;;; @@ -81,27 +89,26 @@ If MODE is specified, play as it. Default MODE is \"play\"." 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 ((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) + (let* ((entity-situation (mime-entity-situation entity situation)) + (ret (mime-unify-situations entity-situation + mime-acting-condition + mime-acting-situation-example-list + 'method ignored-method + mime-play-find-every-situations)) + method menu s) (setq mime-acting-situation-example-list (cdr ret) ret (car ret)) (cond ((cdr ret) - (setq ret (mime-popup-menu-select - (cons - "Methods" - (mapcar - (lambda (situation) - (vector - (format "%s" - (cdr (assq 'method situation))) - situation t)) - ret)))) - (setq ret (mime-sort-situation ret)) + (while ret + (or (vassoc (setq method + (format "%s" + (cdr (assq 'method + (setq s (pop ret)))))) + menu) + (push (vector method s t) menu))) + (setq ret (mime-sort-situation + (mime-menu-select "Play entity with: " + (cons "Methods" menu)))) (add-to-list 'mime-acting-situation-example-list (cons ret 0))) (t (setq ret (car ret)))) @@ -115,12 +122,13 @@ specified, play as it. Default MODE is \"play\"." ;; (mime-activate-external-method entity ret) ;; ) (t - (mime-show-echo-buffer "No method are specified for %s\n" + (mime-show-echo-buffer "No method is specified for %s\n" (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)))))) + (cdr (assq 'type entity-situation)) + (cdr (assq 'subtype entity-situation)))) + (when (y-or-n-p "Do you want to save current entity to disk?") + (message "") + (mime-save-content entity entity-situation)))))) ;;; @ external decoder @@ -131,29 +139,41 @@ specified, play as it. Default MODE is \"play\"." (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 - (mailcap-format-command + (mime-format-mailcap-command method - (cons (cons 'filename name) situation)))) + (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) @@ -294,8 +314,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) @@ -321,21 +340,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")) @@ -345,7 +396,7 @@ It is registered to variable `mime-preview-quitting-method-alist'." (save-window-excursion (set-buffer full-buf) (erase-buffer) - (insert-file-contents-as-binary file) + (binary-insert-encoded-file file) (setq major-mode 'mime-show-message-mode) (mime-view-buffer (current-buffer) nil mother) (setq pbuf (current-buffer)) @@ -390,11 +441,12 @@ It is registered to variable `mime-preview-quitting-method-alist'." (setq file (concat root-dir "/" (int-to-string i))) (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)) (setq i (1+ i)))) - (write-region-as-binary (point-min)(point-max) - (expand-file-name "FULL" root-dir)) + (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))) @@ -436,7 +488,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))) @@ -445,7 +497,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)))