X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=a0b1aa0967acb4fd9b52dcaa0972172ede94eb59;hb=20091643e936fa725d701d3b2a41e00da6c8144a;hp=6f6df668a9c8419a05af215c502cdad136490650;hpb=d3ecf9ba513e9908fbfb3ffc5eb7c8cd84faea4d;p=gnus diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 6f6df668a..a0b1aa096 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -221,7 +221,12 @@ before the external MIME handler is invoked." ("text/richtext" mm-inline-text identity) ("text/x-patch" mm-display-patch-inline (lambda (handle) - (locate-library "diff-mode"))) + ;; If the diff-mode.el package is installed, the function is + ;; autoloaded. Checking (locate-library "diff-mode") would be trying + ;; to cater to broken installations. OTOH checking the function + ;; makes it possible to install another package which provides an + ;; alternative implementation of diff-mode. --Stef + (fboundp 'diff-mode))) ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("text/dns" mm-display-dns-inline identity) @@ -278,7 +283,7 @@ before the external MIME handler is invoked." "List of media types that are to be displayed inline. See also `mm-inline-media-tests', which says how to display a media type inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-keep-viewer-alive-types @@ -287,11 +292,11 @@ type inline." "List of media types for which the external viewer will not be killed when selecting a different article." :version "22.1" - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-automatic-display - '("text/plain" "text/enriched" "text/richtext" "text/html" "text/verbatim" + '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim" "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*" "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature" "application/emacs-lisp" "application/x-emacs-lisp" @@ -299,7 +304,7 @@ when selecting a different article." "application/pkcs7-signature" "application/x-pkcs7-mime" "application/pkcs7-mime") "A list of MIME types to be displayed automatically." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-attachment-override-types '("text/x-vcard" @@ -308,17 +313,17 @@ when selecting a different article." "application/pkcs7-signature" "application/x-pkcs7-signature") "Types to have \"attachment\" ignored if they can be displayed inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-inline-override-types nil "Types to be treated as attachments even if they can be displayed inline." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-automatic-external-display nil "List of MIME type regexps that will be displayed externally automatically." - :type '(repeat string) + :type '(repeat regexp) :group 'mime-display) (defcustom mm-discouraged-alternatives nil @@ -330,8 +335,13 @@ for instance, text/html parts are very unwanted, and text/richtext are somewhat unwanted, then the value of this variable should be set to: - (\"text/html\" \"text/richtext\")" - :type '(repeat string) + (\"text/html\" \"text/richtext\") + +Adding \"image/.*\" might also be useful. Spammers use it as the +prefered part of multipart/alternative messages. See also +`gnus-buttonized-mime-types', to which adding \"multipart/alternative\" +enables you to choose manually one of two types those mails include." + :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. :group 'mime-display) (defcustom mm-tmp-directory @@ -451,21 +461,19 @@ If not set, `default-directory' will be used." (defvar mm-viewer-completion-map (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) (set-keymap-parent map minibuffer-local-completion-map) + ;; Should we bind other key to minibuffer-complete-word? + (define-key map " " 'self-insert-command) map) "Keymap for input viewer with completion.") -;; Should we bind other key to minibuffer-complete-word? -(define-key mm-viewer-completion-map " " 'self-insert-command) - (defvar mm-viewer-completion-map (let ((map (make-sparse-keymap 'mm-viewer-completion-map))) (set-keymap-parent map minibuffer-local-completion-map) + ;; Should we bind other key to minibuffer-complete-word? + (define-key map " " 'self-insert-command) map) "Keymap for input viewer with completion.") -;; Should we bind other key to minibuffer-complete-word? -(define-key mm-viewer-completion-map " " 'self-insert-command) - ;;; The functions. (defun mm-alist-to-plist (alist) @@ -560,7 +568,7 @@ Postpone undisplaying of viewers for types in ;; what really needs to be done here is a way to link a ;; MIME handle back to it's parent MIME handle (in a multilevel ;; MIME article). That would probably require changing - ;; the mm-handle API so we simply store the multipart buffert + ;; the mm-handle API so we simply store the multipart buffer ;; name as a text property of the "multipart/whatever" string. (add-text-properties 0 (length (car ctl)) (list 'buffer (mm-copy-to-buffer) @@ -752,7 +760,19 @@ external if displayed external." (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)) dir)) - (setq file (mm-make-temp-file (expand-file-name "mm." dir)))) + (setq file (mm-make-temp-file (expand-file-name "mm." dir))) + (let ((newname + ;; Use nametemplate (defined in RFC1524) if it is + ;; specified in mailcap. + (if (assoc "nametemplate" mime-info) + (format (cdr (assoc "nametemplate" mime-info)) file) + ;; Add a suffix according to `mailcap-mime-extensions'. + (concat file (car (rassoc (mm-handle-media-type handle) + mailcap-mime-extensions)))))) + (unless (string-equal file newname) + (when (file-exists-p file) + (rename-file file newname)) + (setq file newname)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) (message "Viewing with %s" method) @@ -801,8 +821,7 @@ external if displayed external." (mm-mailcap-command method file (mm-handle-type handle))) (if (buffer-live-p buffer) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (buffer-string)))) (progn (ignore-errors (delete-file file)) @@ -811,6 +830,9 @@ external if displayed external." (ignore-errors (kill-buffer buffer)))))) 'inline) (t + ;; Deleting the temp file should be postponed for some wrappers, + ;; shell scripts, and so on, which might exit right after having + ;; started a viewer command as a background job. (let ((command (mm-mailcap-command method file (mm-handle-type handle)))) (unwind-protect @@ -822,24 +844,38 @@ external if displayed external." shell-command-switch command) (set-process-sentinel (get-buffer-process buffer) - `(lambda (process state) - (when (eq 'exit (process-status process)) - ;; Don't use `ignore-errors'. - (condition-case nil - (delete-file ,file) - (error)) - (condition-case nil - (delete-directory ,(file-name-directory file)) - (error)) - (condition-case nil - (kill-buffer ,buffer) - (error)) - (condition-case nil - ,(macroexpand (list 'mm-handle-set-undisplayer - (list 'quote handle) - nil)) - (error)) - (message "Displaying %s...done" ,command))))) + (lexical-let ;; Don't use `let'. + ;; Function used to remove temp file and directory. + ((fn `(lambda nil + ;; Don't use `ignore-errors'. + (condition-case nil + (delete-file ,file) + (error)) + (condition-case nil + (delete-directory + ,(file-name-directory file)) + (error)))) + ;; Form uses to kill the process buffer and + ;; remove the undisplayer. + (fm `(progn + (kill-buffer ,buffer) + ,(macroexpand + (list 'mm-handle-set-undisplayer + (list 'quote handle) + nil)))) + ;; Message to be issued when the process exits. + (done (format "Displaying %s...done" command)) + ;; In particular, the timer object (which is + ;; a vector in Emacs but is a list in XEmacs) + ;; requires that it is lexically scoped. + (timer (run-at-time 2.0 nil 'ignore))) + (lambda (process state) + (when (eq 'exit (process-status process)) + (if (memq timer timer-list) + (timer-set-function timer fn) + (funcall fn)) + (ignore-errors (eval fm)) + (message "%s" done)))))) (mm-handle-set-external-undisplayer handle (cons file buffer))) (message "Displaying %s..." command)) @@ -1051,16 +1087,16 @@ external if displayed external." (defun mm-insert-part (handle) "Insert the contents of HANDLE in the current buffer." - (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))) - (save-excursion - (insert - (cond ((eq charset 'gnus-decoded) - (with-current-buffer (mm-handle-buffer handle) - (buffer-string))) - ((mm-multibyte-p) - (mm-string-as-multibyte (mm-get-part handle))) - (t - (mm-get-part handle))))))) + (save-excursion + (insert + (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset) + 'gnus-decoded) + (with-current-buffer (mm-handle-buffer handle) + (buffer-string))) + ((mm-multibyte-p) + (mm-string-as-multibyte (mm-get-part handle))) + (t + (mm-get-part handle)))))) (defun mm-file-name-delete-whitespace (file-name) "Remove all whitespace characters from FILE-NAME."