X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=0ca73219a72194725ccb4cc44dd746008f42a88d;hb=f9e54240fc63f1ead8962e2afbc9b75e53994cd5;hp=bc2b7b52e1c3eb683351c2d2d5bc0016c4987574;hpb=3d6243dbdead481b3be9282c5c2a436d441b56f2;p=elisp%2Fgnus.git- diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index bc2b7b5..0ca7321 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -22,6 +22,14 @@ ;;; Commentary: +;; Jaap-Henk Hoepman (jhh@xs4all.nl): +;; +;; Added support for delayed destroy of external MIME viewers. All external +;; viewers for mime types in mm-keep-viewer-alive-types will remain active +;; after switching articles or groups, and will only be removed when exiting +;; gnus. +;; + ;;; Code: (require 'mail-parse) @@ -34,6 +42,8 @@ (autoload 'mm-inline-external-body "mm-extern") (autoload 'mm-insert-inline "mm-view")) +(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list) + (defgroup mime-display () "Display of MIME in mail and news articles." :link '(custom-manual "(emacs-mime)Customization") @@ -183,6 +193,14 @@ "List of media types that are to be displayed inline." :type '(repeat string) :group 'mime-display) + +(defcustom mm-keep-viewer-alive-types + '("application/postscript" "application/msword" "application/vnd.ms-excel" + "application/pdf" "application/x-dvi") + "List of media types for which the external viewer will not be killed +when selecting a different article." + :type '(repeat string) + :group 'mime-display) (defcustom mm-automatic-display '("text/plain" "text/enriched" "text/richtext" "text/html" @@ -222,22 +240,31 @@ to: :type '(repeat string) :group 'mime-display) -(defvar mm-tmp-directory +(defcustom mm-tmp-directory (cond ((fboundp 'temp-directory) (temp-directory)) ((boundp 'temporary-file-directory) temporary-file-directory) ("/tmp/")) - "Where mm will store its temporary files.") + "Where mm will store its temporary files." + :type 'directory + :group 'mime-display) (defcustom mm-inline-large-images nil "If non-nil, then all images fit in the buffer." :type 'boolean :group 'mime-display) +(defcustom mm-default-directory nil + "The default directory where mm will save files. +If not set, `default-directory' will be used." + :type 'directory + :group 'mime-display) + ;;; Internal variables. (defvar mm-dissection-list nil) (defvar mm-last-shell-command "") (defvar mm-content-id-alist nil) +(defvar mm-postponed-undisplay-list nil) ;; According to RFC2046, in particular, in a digest, the default ;; Content-Type value for a body part is changed from "text/plain" to @@ -324,6 +351,30 @@ The original alist is not modified. See also `destructive-alist-to-plist'." (setq alist (cdr alist))) (nreverse plist))) +(defun mm-keep-viewer-alive-p (handle) + "Say whether external viewer for HANDLE should stay alive." + (let ((types mm-keep-viewer-alive-types) + (type (mm-handle-media-type handle)) + ty) + (catch 'found + (while (setq ty (pop types)) + (when (string-match ty type) + (throw 'found t)))))) + +(defun mm-handle-set-external-undisplayer (handle function) + "Set the undisplayer for this handle; postpone undisplaying of viewers +for types in mm-keep-viewer-alive-types." + (if (mm-keep-viewer-alive-p handle) + (let ((new-handle (copy-sequence handle))) + (mm-handle-set-undisplayer new-handle function) + (mm-handle-set-undisplayer handle nil) + (push new-handle mm-postponed-undisplay-list)) + (mm-handle-set-undisplayer handle function))) + +(defun mm-destroy-postponed-undisplay-list () + (message "Destroying external MIME viewers") + (mm-destroy-parts mm-postponed-undisplay-list)) + (defun mm-dissect-buffer (&optional no-strict-mime) "Dissect the current buffer and return a list of MIME handles." (save-excursion @@ -443,14 +494,18 @@ The original alist is not modified. See also `destructive-alist-to-plist'." (defun mm-copy-to-buffer () "Copy the contents of the current buffer to a fresh buffer." (save-excursion - (let ((obuf (current-buffer)) - beg) + (let ((flag enable-multibyte-characters) + (new-buffer (generate-new-buffer " *mm*"))) (goto-char (point-min)) (search-forward-regexp "^\n" nil t) - (setq beg (point)) - (set-buffer (generate-new-buffer " *mm*")) - (insert-buffer-substring obuf beg) - (current-buffer)))) + (save-restriction + (narrow-to-region (point) (point-max)) + (when flag + (set-buffer-multibyte nil)) + (copy-to-buffer new-buffer (point-min) (point-max)) + (when flag + (set-buffer-multibyte t))) + new-buffer))) (defun mm-display-parts (handle &optional no-default) (if (stringp (car handle)) @@ -548,7 +603,7 @@ external if displayed external." shell-command-switch (mm-mailcap-command method file (mm-handle-type handle))) - (mm-handle-set-undisplayer handle (cons file buffer))) + (mm-handle-set-external-undisplayer handle (cons file buffer))) (message "Displaying %s..." (format method file)) 'external) (copiousoutput @@ -584,7 +639,7 @@ external if displayed external." shell-command-switch (mm-mailcap-command method file (mm-handle-type handle))) - (mm-handle-set-undisplayer handle (cons file buffer))) + (mm-handle-set-external-undisplayer handle (cons file buffer))) (message "Displaying %s..." (format method file)) 'external))))))) @@ -801,8 +856,6 @@ external if displayed external." (set-buffer cur) (insert-buffer-substring temp))))))) -(defvar mm-default-directory nil) - (defun mm-save-part (handle) "Write HANDLE to a file." (let* ((name (mail-content-type-get (mm-handle-type handle) 'name)) @@ -843,7 +896,8 @@ external if displayed external." (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer (mm-insert-part handle) - (shell-command-on-region (point-min) (point-max) command nil)))) + (let ((coding-system-for-write 'binary)) + (shell-command-on-region (point-min) (point-max) command nil))))) (defun mm-interactively-view-part (handle) "Display HANDLE using METHOD."