* nnshimbun.el (nnshimbun-request-expire-articles): Don't refer to the
[elisp/gnus.git-] / lisp / mm-decode.el
index bc2b7b5..0ca7321 100644 (file)
 
 ;;; 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")
   "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."