: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
;;;
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))))
;; (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
(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))))
+ (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)
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)
;;; @ 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"))
(save-window-excursion
(set-buffer full-buf)
(erase-buffer)
- (binary-insert-file-contents file)
+ (binary-insert-encoded-file file)
(setq major-mode 'mime-show-message-mode)
(mime-view-buffer (current-buffer) nil mother)
(setq pbuf (current-buffer))
(setq file (concat root-dir "/" (int-to-string i)))
(or (file-exists-p file)
(throw 'tag nil))
- (binary-insert-file-contents file)
+ (binary-insert-encoded-file file)
(goto-char (point-max))
(setq i (1+ i))))
- (binary-write-region (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)))
(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)))
(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)))