;; 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:
(eval-when-compile
(condition-case nil
(require 'bbdb)
- (error (defvar bbdb-buffer-name nil)))
- )
+ (error (defvar bbdb-buffer-name nil))))
(defcustom mime-save-directory "~/"
"*Name of the directory where MIME entity will be saved in.
: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
;;;
(setq situation
(cons (cons 'ignore-examples ignore-examples)
situation)))
- (mime-play-entity entity situation)
- ))))
+ (mime-play-entity entity situation)))))
;;;###autoload
(defun mime-play-entity (entity &optional situation ignored-method)
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 (select-menu-alist
- "Methods"
- (mapcar (function
- (lambda (situation)
- (cons
- (format "%s"
- (cdr (assq 'method situation)))
- situation)))
- ret)))
- (setq ret (mime-sort-situation ret))
- (add-to-list 'mime-acting-situation-example-list (cons ret 0))
- )
+ (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))
- ))
+ (setq ret (car ret))))
(setq method (cdr (assq 'method ret)))
(cond ((and (symbolp method)
(fboundp method))
- (funcall method entity ret)
- )
+ (funcall method entity ret))
((stringp method)
- (mime-activate-mailcap-method entity ret)
- )
+ (mime-activate-mailcap-method entity ret))
;; ((and (listp method)(stringp (car method)))
;; (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
- (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)
- )))
+ 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)
(defvar mime-echo-window-height
(function
(lambda ()
- (/ (window-height) 5)
- ))
+ (/ (window-height) 5)))
"*Size of mime-echo window.
It allows function or integer. If it is function,
`mime-show-echo-buffer' calls it to get height of mime-echo window.
(- (window-height)
(if (functionp mime-echo-window-height)
(funcall mime-echo-window-height)
- mime-echo-window-height)
- )))
- )
- (set-window-buffer win mime-echo-buffer-name)
- )
+ mime-echo-window-height)))))
+ (set-window-buffer win mime-echo-buffer-name))
(select-window win)
(goto-char (point-max))
(if forms
(let ((buffer-read-only nil))
- (insert (apply (function format) forms))
- ))
- (select-window the-win)
- ))
+ (insert (apply (function format) forms))))
+ (select-window the-win)))
;;; @ file name
(if (and subj
(or (string-match mime-view-file-name-regexp-1 subj)
(string-match mime-view-file-name-regexp-2 subj)))
- (substring subj (match-beginning 0)(match-end 0))
- )))))
+ (substring subj (match-beginning 0)(match-end 0)))))))
(if filename
- (replace-as-filename filename)
- )))
+ (replace-as-filename filename))))
;;; @ file extraction
(if (file-exists-p filename)
(or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
(error "")))
- (mime-write-entity-content entity (expand-file-name filename))
- ))
+ (mime-write-entity-content entity (expand-file-name filename))))
;;; @ file detection
("^II\\*\000" image tiff)
("^MM\000\\*" image tiff)
("^MThd" audio midi)
- ("^\000\000\001\263" video mpeg)
- )
+ ("^\000\000\001\263" video mpeg))
"*Alist of regexp about magic-number vs. corresponding media-types.
Each element looks like (REGEXP TYPE SUBTYPE).
REGEXP is a regular expression to match against the beginning of the
(if cell
(if (string-match (car cell) mdata)
(setq type (nth 1 cell)
- subtype (nth 2 cell))
- )
+ subtype (nth 2 cell)))
t)))
(setq rest (cdr rest))))
(setq situation (del-alist 'method (copy-alist situation)))
(defun mime-preview-quitting-method-for-mime-show-message-mode ()
"Quitting method for mime-view.
It is registered to variable `mime-preview-quitting-method-alist'."
- (let ((raw-buffer (mime-entity-buffer
- (get-text-property (point-min) 'mime-view-entity)))
- (mother mime-mother-buffer)
+ (let ((mother mime-mother-buffer)
(win-conf mime-preview-original-window-configuration))
- (kill-buffer raw-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)
- (pop-to-buffer mother)
- ))
+ (pop-to-buffer mother)))
(defun mime-view-message/rfc822 (entity situation)
(let* ((new-name
(let ((m-win (get-buffer-window mother)))
(if m-win
(set-window-buffer m-win preview-buffer)
- (switch-to-buffer preview-buffer)
- )))))
+ (switch-to-buffer preview-buffer))))))
;;; @ 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)
- (as-binary-input-file (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))
- )
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer full-buf))
(set-window-buffer pwin pbuf)
- (select-window pwin)
- )
+ (select-window pwin))
(setq file (concat root-dir "/" number))
(mime-write-entity-body entity file)
(let ((total-file (concat root-dir "/CT")))
(erase-buffer)
(insert total)
(write-region (point-min)(point-max) total-file)
- (kill-buffer (current-buffer))
- ))
- (string-to-number total)
- )
+ (kill-buffer (current-buffer))))
+ (string-to-number total))
(and (file-exists-p total-file)
(save-excursion
(set-buffer (find-file-noselect total-file))
(and (re-search-forward "[0-9]+" nil t)
(string-to-number
(buffer-substring (match-beginning 0)
- (match-end 0)))
- )
- (kill-buffer (current-buffer))
- )))
- )))
+ (match-end 0))))
+ (kill-buffer (current-buffer))))))))
(if (and total (> total 0)
(>= (length (directory-files root-dir nil "^[0-9]+$" t))
total))
(while (<= i total)
(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))
+ (throw 'tag nil))
+ (binary-insert-encoded-file file)
(goto-char (point-max))
- (setq i (1+ i))
- ))
- (as-binary-output-file
- (write-region (point-min)(point-max)
- (expand-file-name "FULL" root-dir)))
+ (setq i (1+ i))))
+ (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)))
(and (file-exists-p file)
- (delete-file file)
- ))
- (setq i (1+ i))
- ))
+ (delete-file file)))
+ (setq i (1+ i))))
(let ((file (expand-file-name "CT" root-dir)))
(and (file-exists-p file)
- (delete-file file)
- ))
- (let ((pwin (or (get-buffer-window mother)
+ (delete-file file)))
+ (let ((buf (current-buffer))
+ (pwin (or (get-buffer-window mother)
(get-largest-window)))
(pbuf (mime-display-message
(mime-open-entity 'buffer (current-buffer))
nil mother nil 'mime-show-message-mode)))
+ (with-current-buffer pbuf
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer buf))
(set-window-buffer pwin pbuf)
- (select-window pwin)
- )))))
- )))
+ (select-window pwin)))))))))
;;; @ message/external-body
(defvar mime-raw-dired-function
(if (and (>= emacs-major-version 19) window-system)
(function dired-other-frame)
- (function mime-raw-dired-function-for-one-frame)
- ))
+ (function mime-raw-dired-function-for-one-frame)))
(defun mime-raw-dired-function-for-one-frame (dir)
(let ((win (or (get-buffer-window mime-preview-buffer)
(get-largest-window))))
(select-window win)
- (dired dir)
- ))
+ (dired dir)))
(defun mime-view-message/external-anon-ftp (entity cal)
(let* ((site (cdr (assoc "site" cal)))
(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)
- ))
+ (search-forward name)))
(defvar mime-raw-browse-url-function mime-browse-url-function)
(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)))
(erase-buffer)
(mime-insert-text-content entity)
(mule-caesar-region (point-min) (point-max))
- (set-buffer-modified-p nil)
- )
+ (set-buffer-modified-p nil))
(let ((win (get-buffer-window (current-buffer))))
(or (eq (selected-window) win)
- (select-window (or win (get-largest-window)))
- ))
+ (select-window (or win (get-largest-window)))))
(view-buffer buf)
- (goto-char (point-min))
- ))
+ (goto-char (point-min))))
;;; @ end
projects / elisp / semi.git / blobdiff