(gnus-uu-digest-mail-forward): Fix comment.
[gnus] / lisp / mm-decode.el
index 0ec0070..a0b1aa0 100644 (file)
@@ -1,6 +1,7 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 ;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002,
-;;        2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -18,8 +19,8 @@
 
 ;; 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
 
 ;; 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.
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 
                   (require 'term))
 
 (eval-and-compile
                   (require 'term))
 
 (eval-and-compile
-  (autoload 'executable-find "executable")
   (autoload 'mm-inline-partial "mm-partial")
   (autoload 'mm-inline-external-body "mm-extern")
   (autoload 'mm-insert-inline "mm-view"))
 
   (autoload 'mm-inline-partial "mm-partial")
   (autoload 'mm-inline-external-body "mm-extern")
   (autoload 'mm-insert-inline "mm-view"))
 
+(defvar gnus-current-window-configuration)
+
 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
 
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
 (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")
+  :link '(custom-manual "(emacs-mime)Display Customization")
   :version "21.1"
   :group 'mail
   :group 'news
   :version "21.1"
   :group 'mail
   :group 'news
@@ -49,7 +51,7 @@
 
 (defgroup mime-security ()
   "MIME security in mail and news articles."
 
 (defgroup mime-security ()
   "MIME security in mail and news articles."
-  :link '(custom-manual "(emacs-mime)Customization")
+  :link '(custom-manual "(emacs-mime)Display Customization")
   :group 'mail
   :group 'news
   :group 'multimedia)
   :group 'mail
   :group 'news
   :group 'multimedia)
 
 (defcustom mm-text-html-renderer
   (cond ((locate-library "w3") 'w3)
 
 (defcustom mm-text-html-renderer
   (cond ((locate-library "w3") 'w3)
-       ((locate-library "w3m") 'w3m)
+       ((executable-find "w3m") (if (locate-library "w3m")
+                                    'w3m
+                                  'w3m-standalone))
        ((executable-find "links") 'links)
        ((executable-find "lynx") 'lynx)
        (t 'html2text))
   "Render of HTML contents.
 It is one of defined renderer types, or a rendering function.
 The defined renderer types are:
        ((executable-find "links") 'links)
        ((executable-find "lynx") 'lynx)
        (t 'html2text))
   "Render of HTML contents.
 It is one of defined renderer types, or a rendering function.
 The defined renderer types are:
-`w3'   : using Emacs/W3;
-`w3m'  : using emacs-w3m;
-`links': using links;
-`lynx' : using lynx;
-`html2text' : using html2text;
-nil    : using external viewer."
+`w3'   : use Emacs/W3;
+`w3m'  : use emacs-w3m;
+`w3m-standalone': use w3m;
+`links': use links;
+`lynx' : use lynx;
+`html2text' : use html2text;
+nil    : use external viewer."
+  :version "22.1"
   :type '(choice (const w3)
                 (const w3m)
   :type '(choice (const w3)
                 (const w3m)
+                (const w3m-standalone)
                 (const links)
                 (const lynx)
                 (const html2text)
                 (const nil)
                 (function))
                 (const links)
                 (const lynx)
                 (const html2text)
                 (const nil)
                 (function))
-  :version "21.3"
   :group 'mime-display)
 
 (defvar mm-inline-text-html-renderer nil
   :group 'mime-display)
 
 (defvar mm-inline-text-html-renderer nil
@@ -130,6 +136,7 @@ It is suggested to customize `mm-text-html-renderer' instead.")
   "If non-nil, Gnus will allow retrieving images in HTML contents with
 the <img> tags.  It has no effect on Emacs/w3.  See also the
 documentation for the `mm-w3m-safe-url-regexp' variable."
   "If non-nil, Gnus will allow retrieving images in HTML contents with
 the <img> tags.  It has no effect on Emacs/w3.  See also the
 documentation for the `mm-w3m-safe-url-regexp' variable."
+  :version "22.1"
   :type 'boolean
   :group 'mime-display)
 
   :type 'boolean
   :group 'mime-display)
 
@@ -145,17 +152,31 @@ when displaying the image.  The default value is \"\\\\`cid:\" which only
 matches parts embedded to the Multipart/Related type MIME contents and
 Gnus will never connect to the spammer's site arbitrarily.  You may
 set this variable to nil if you consider all urls to be safe."
 matches parts embedded to the Multipart/Related type MIME contents and
 Gnus will never connect to the spammer's site arbitrarily.  You may
 set this variable to nil if you consider all urls to be safe."
+  :version "22.1"
   :type '(choice (regexp :tag "Regexp")
                 (const :tag "All URLs are safe" nil))
   :group 'mime-display)
 
 (defcustom mm-inline-text-html-with-w3m-keymap t
   "If non-nil, use emacs-w3m command keys in the article buffer."
   :type '(choice (regexp :tag "Regexp")
                 (const :tag "All URLs are safe" nil))
   :group 'mime-display)
 
 (defcustom mm-inline-text-html-with-w3m-keymap t
   "If non-nil, use emacs-w3m command keys in the article buffer."
+  :version "22.1"
   :type 'boolean
   :group 'mime-display)
 
   :type 'boolean
   :group 'mime-display)
 
+(defcustom mm-enable-external t
+  "Indicate whether external MIME handlers should be used.
+
+If t, all defined external MIME handlers are used.  If nil, files are saved by
+`mailcap-save-binary-file'.  If it is the symbol `ask', you are prompted
+before the external MIME handler is invoked."
+  :version "22.1"
+  :type '(choice (const :tag "Always" t)
+                (const :tag "Never" nil)
+                (const :tag "Ask" ask))
+  :group 'mime-display)
+
 (defcustom mm-inline-media-tests
 (defcustom mm-inline-media-tests
-  '(("image/jpeg"
+  '(("image/p?jpeg"
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'jpeg handle)))
      mm-inline-image
      (lambda (handle)
        (mm-valid-and-fit-image-p 'jpeg handle)))
@@ -200,9 +221,15 @@ set this variable to nil if you consider all urls to be safe."
     ("text/richtext" mm-inline-text identity)
     ("text/x-patch" mm-display-patch-inline
      (lambda (handle)
     ("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)
     ("application/emacs-lisp" mm-display-elisp-inline identity)
     ("application/x-emacs-lisp" mm-display-elisp-inline identity)
+    ("text/dns" mm-display-dns-inline identity)
     ("text/html"
      mm-inline-text-html
      (lambda (handle)
     ("text/html"
      mm-inline-text-html
      (lambda (handle)
@@ -241,7 +268,7 @@ set this variable to nil if you consider all urls to be safe."
     ;; Default to displaying as text
     (".*" mm-inline-text mm-readable-p))
   "Alist of media types/tests saying whether types can be displayed inline."
     ;; Default to displaying as text
     (".*" mm-inline-text mm-readable-p))
   "Alist of media types/tests saying whether types can be displayed inline."
-  :type '(repeat (list (string :tag "MIME type")
+  :type '(repeat (list (regexp :tag "MIME type")
                       (function :tag "Display function")
                       (function :tag "Display test")))
   :group 'mime-display)
                       (function :tag "Display function")
                       (function :tag "Display test")))
   :group 'mime-display)
@@ -256,7 +283,7 @@ set this variable to nil if you consider all urls to be safe."
   "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."
   "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
   :group 'mime-display)
 
 (defcustom mm-keep-viewer-alive-types
@@ -264,19 +291,20 @@ type inline."
     "application/pdf" "application/x-dvi")
   "List of media types for which the external viewer will not be killed
 when selecting a different article."
     "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)
+  :version "22.1"
+  :type '(repeat regexp)
   :group 'mime-display)
 
 (defcustom mm-automatic-display
   :group 'mime-display)
 
 (defcustom mm-automatic-display
-  '("text/plain" "text/enriched" "text/richtext" "text/html"
+  '("text/plain" "text/enriched" "text/richtext" "text/html" "text/x-verbatim"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
-    "message/rfc822" "text/x-patch" "application/pgp-signature"
+    "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
     "application/emacs-lisp" "application/x-emacs-lisp"
     "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime")
   "A list of MIME types to be displayed automatically."
     "application/emacs-lisp" "application/x-emacs-lisp"
     "application/x-pkcs7-signature"
     "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"
   :group 'mime-display)
 
 (defcustom mm-attachment-override-types '("text/x-vcard"
@@ -285,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."
                                          "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."
   :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."
   :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
   :group 'mime-display)
 
 (defcustom mm-discouraged-alternatives nil
@@ -307,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:
 
 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
   :group 'mime-display)
 
 (defcustom mm-tmp-directory
@@ -360,11 +393,13 @@ If not set, `default-directory' will be used."
 
 (defcustom mm-attachment-file-modes 384
   "Set the mode bits of saved attachments to this integer."
 
 (defcustom mm-attachment-file-modes 384
   "Set the mode bits of saved attachments to this integer."
+  :version "22.1"
   :type 'integer
   :group 'mime-display)
 
 (defcustom mm-external-terminal-program "xterm"
   "The program to start an external terminal."
   :type 'integer
   :group 'mime-display)
 
 (defcustom mm-external-terminal-program "xterm"
   "The program to start an external terminal."
+  :version "22.1"
   :type 'string
   :group 'mime-display)
 
   :type 'string
   :group 'mime-display)
 
@@ -397,6 +432,7 @@ If not set, `default-directory' will be used."
   "Option of verifying signed parts.
 `never', not verify; `always', always verify;
 `known', only verify known protocols.  Otherwise, ask user."
   "Option of verifying signed parts.
 `never', not verify; `always', always verify;
 `known', only verify known protocols.  Otherwise, ask user."
+  :version "22.1"
   :type '(choice (item always)
                 (item never)
                 (item :tag "only known protocols" known)
   :type '(choice (item always)
                 (item never)
                 (item :tag "only known protocols" known)
@@ -415,6 +451,7 @@ If not set, `default-directory' will be used."
   "Option of decrypting encrypted parts.
 `never', not decrypt; `always', always decrypt;
 `known', only decrypt known protocols.  Otherwise, ask user."
   "Option of decrypting encrypted parts.
 `never', not decrypt; `always', always decrypt;
 `known', only decrypt known protocols.  Otherwise, ask user."
+  :version "22.1"
   :type '(choice (item always)
                 (item never)
                 (item :tag "only known protocols" known)
   :type '(choice (item always)
                 (item never)
                 (item :tag "only known protocols" known)
@@ -424,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)
 (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.")
 
     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)
 (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.")
 
     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)
 ;;; The functions.
 
 (defun mm-alist-to-plist (alist)
@@ -485,10 +520,10 @@ Postpone undisplaying of viewers for types in
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
     (message "Destroying external MIME viewers")
     (mm-destroy-parts mm-postponed-undisplay-list)))
 
-(defun mm-dissect-buffer (&optional no-strict-mime loose-mime)
+(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
-    (let (ct ctl type subtype cte cd description id result from)
+    (let (ct ctl type subtype cte cd description id result)
       (save-restriction
        (mail-narrow-to-head)
        (when (or no-strict-mime
       (save-restriction
        (mail-narrow-to-head)
        (when (or no-strict-mime
@@ -499,23 +534,20 @@ Postpone undisplaying of viewers for types in
                cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")
                description (mail-fetch-field "content-description")
                cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")
                description (mail-fetch-field "content-description")
-               from (mail-fetch-field "from")
                id (mail-fetch-field "content-id"))
                id (mail-fetch-field "content-id"))
+         (unless from
+               (setq from (mail-fetch-field "from")))
          ;; FIXME: In some circumstances, this code is running within
          ;; an unibyte macro.  mail-extract-address-components
          ;; creates unibyte buffers. This `if', though not a perfect
          ;; solution, avoids most of them.
          (if from
              (setq from (cadr (mail-extract-address-components from))))))
          ;; FIXME: In some circumstances, this code is running within
          ;; an unibyte macro.  mail-extract-address-components
          ;; creates unibyte buffers. This `if', though not a perfect
          ;; solution, avoids most of them.
          (if from
              (setq from (cadr (mail-extract-address-components from))))))
-      (when cte
-       (setq cte (mail-header-strip cte)))
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
           (list mm-dissect-default-type)
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
           (list mm-dissect-default-type)
-          (and cte (intern (downcase (mail-header-remove-whitespace
-                                      (mail-header-remove-comments
-                                       cte)))))
+          (and cte (intern (downcase (mail-header-strip cte))))
           no-strict-mime
           (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
           description)
           no-strict-mime
           (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
           description)
@@ -528,29 +560,27 @@ Postpone undisplaying of viewers for types in
          ((equal type "multipart")
           (let ((mm-dissect-default-type (if (equal subtype "digest")
                                              "message/rfc822"
          ((equal type "multipart")
           (let ((mm-dissect-default-type (if (equal subtype "digest")
                                              "message/rfc822"
-                                           "text/plain")))
+                                           "text/plain"))
+                (start (cdr (assq 'start (cdr ctl)))))
             (add-text-properties 0 (length (car ctl))
                                  (mm-alist-to-plist (cdr ctl)) (car ctl))
 
             ;; 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
             (add-text-properties 0 (length (car ctl))
                                  (mm-alist-to-plist (cdr ctl)) (car ctl))
 
             ;; 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))
             ;; name as a text property of the "multipart/whatever" string.
             (add-text-properties 0 (length (car ctl))
-                                 (list 'buffer (mm-copy-to-buffer))
-                                 (car ctl))
-            (add-text-properties 0 (length (car ctl))
-                                 (list 'from from)
+                                 (list 'buffer (mm-copy-to-buffer)
+                                       'from from
+                                       'start start)
                                  (car ctl))
                                  (car ctl))
-            (cons (car ctl) (mm-dissect-multipart ctl))))
+            (cons (car ctl) (mm-dissect-multipart ctl from))))
          (t
           (mm-possibly-verify-or-decrypt
            (mm-dissect-singlepart
             ctl
          (t
           (mm-possibly-verify-or-decrypt
            (mm-dissect-singlepart
             ctl
-            (and cte (intern (downcase (mail-header-remove-whitespace
-                                        (mail-header-remove-comments
-                                         cte)))))
+            (and cte (intern (downcase (mail-header-strip cte))))
             no-strict-mime
             (and cd (ignore-errors
                       (mail-header-parse-content-disposition cd)))
             no-strict-mime
             (and cd (ignore-errors
                       (mail-header-parse-content-disposition cd)))
@@ -570,7 +600,7 @@ Postpone undisplaying of viewers for types in
     (mm-make-handle
      (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 
     (mm-make-handle
      (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 
-(defun mm-dissect-multipart (ctl)
+(defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
         (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
         (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
@@ -587,7 +617,7 @@ Postpone undisplaying of viewers for types in
        (save-excursion
          (save-restriction
            (narrow-to-region start (point))
        (save-excursion
          (save-restriction
            (narrow-to-region start (point))
-           (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
+           (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
       (end-of-line 2)
       (or (looking-at boundary)
          (forward-line 1))
       (end-of-line 2)
       (or (looking-at boundary)
          (forward-line 1))
@@ -596,7 +626,7 @@ Postpone undisplaying of viewers for types in
       (save-excursion
        (save-restriction
          (narrow-to-region start end)
       (save-excursion
        (save-restriction
          (narrow-to-region start end)
-         (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
+         (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 
 (defun mm-copy-to-buffer ()
     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 
 (defun mm-copy-to-buffer ()
@@ -607,7 +637,10 @@ Postpone undisplaying of viewers for types in
       (goto-char (point-min))
       (search-forward-regexp "^\n" nil t)
       (setq beg (point))
       (goto-char (point-min))
       (search-forward-regexp "^\n" nil t)
       (setq beg (point))
-      (set-buffer (generate-new-buffer " *mm*"))
+      (set-buffer
+       ;; Preserve the data's unibyteness (for url-insert-file-contents).
+       (let ((default-enable-multibyte-characters (mm-multibyte-p)))
+        (generate-new-buffer " *mm*")))
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
@@ -630,7 +663,13 @@ external if displayed external."
     (if (mm-handle-displayed-p handle)
        (mm-remove-part handle)
       (let* ((type (mm-handle-media-type handle))
     (if (mm-handle-displayed-p handle)
        (mm-remove-part handle)
       (let* ((type (mm-handle-media-type handle))
-            (method (mailcap-mime-info type)))
+            (method (mailcap-mime-info type))
+            (filename (or (mail-content-type-get
+                           (mm-handle-disposition handle) 'filename)
+                          (mail-content-type-get
+                           (mm-handle-type handle) 'name)
+                          "<file>"))
+            (external mm-enable-external))
        (if (and (mm-inlinable-p handle)
                 (mm-inlined-p handle))
            (progn
        (if (and (mm-inlinable-p handle)
                 (mm-inlined-p handle))
            (progn
@@ -645,8 +684,27 @@ external if displayed external."
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
-             (mm-display-external
-              handle (or method 'mailcap-save-binary-file)))))))))
+             (if (and method ;; If nil, we always use "save".
+                      (stringp method) ;; 'mailcap-save-binary-file
+                      (or (eq mm-enable-external t)
+                          (and (eq mm-enable-external 'ask)
+                               (y-or-n-p
+                                (concat
+                                 "Display part (" type
+                                 ") using external program"
+                                 ;; Can non-string method ever happen?
+                                 (if (stringp method)
+                                     (concat
+                                      " \"" (format method filename) "\"")
+                                   "")
+                                 "? ")))))
+                 (setq external t)
+               (setq external nil))
+             (if external
+                 (mm-display-external
+                  handle (or method 'mailcap-save-binary-file))
+               (mm-display-external
+                handle 'mailcap-save-binary-file)))))))))
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
@@ -667,7 +725,8 @@ external if displayed external."
            (mm-set-buffer-file-coding-system mm-binary-coding-system)
            (insert-buffer-substring cur)
            (goto-char (point-min))
            (mm-set-buffer-file-coding-system mm-binary-coding-system)
            (insert-buffer-substring cur)
            (goto-char (point-min))
-           (message "Viewing with %s" method)
+           (when method
+             (message "Viewing with %s" method))
            (let ((mm (current-buffer))
                  (non-viewer (assq 'non-viewer
                                    (mailcap-mime-info
            (let ((mm (current-buffer))
                  (non-viewer (assq 'non-viewer
                                    (mailcap-mime-info
@@ -701,7 +760,19 @@ external if displayed external."
                          (gnus-map-function mm-file-name-rewrite-functions
                                             (file-name-nondirectory filename))
                          dir))
                          (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)
          (let ((coding-system-for-write mm-binary-coding-system))
            (write-region (point-min) (point-max) file nil 'nomesg))
          (message "Viewing with %s" method)
@@ -750,8 +821,7 @@ external if displayed external."
                                   (mm-mailcap-command
                                    method file (mm-handle-type handle)))
                     (if (buffer-live-p buffer)
                                   (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))
                           (buffer-string))))
                 (progn
                   (ignore-errors (delete-file file))
@@ -760,14 +830,52 @@ external if displayed external."
                   (ignore-errors (kill-buffer buffer))))))
            'inline)
           (t
                   (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
            (let ((command (mm-mailcap-command
                            method file (mm-handle-type handle))))
              (unwind-protect
-                 (start-process "*display*"
-                                (setq buffer
-                                      (generate-new-buffer " *mm*"))
-                                shell-file-name
-                                shell-command-switch command)
+                 (progn
+                   (start-process "*display*"
+                                  (setq buffer
+                                        (generate-new-buffer " *mm*"))
+                                  shell-file-name
+                                  shell-command-switch command)
+                   (set-process-sentinel
+                    (get-buffer-process buffer)
+                    (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))
                (mm-handle-set-external-undisplayer
                 handle (cons file buffer)))
              (message "Displaying %s..." command))
@@ -792,16 +900,16 @@ external if displayed external."
            (string= total "'%s'")
            (string= total "\"%s\""))
        (setq uses-stdin nil)
            (string= total "'%s'")
            (string= total "\"%s\""))
        (setq uses-stdin nil)
-       (push (mm-quote-arg
+       (push (shell-quote-argument
               (gnus-map-function mm-path-name-rewrite-functions file)) out))
        ((string= total "%t")
               (gnus-map-function mm-path-name-rewrite-functions file)) out))
        ((string= total "%t")
-       (push (mm-quote-arg (car type-list)) out))
+       (push (shell-quote-argument (car type-list)) out))
        (t
        (t
-       (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
+       (push (shell-quote-argument (or (cdr (assq (intern sub) ctl)) "")) out))))
     (push (substring method beg (length method)) out)
     (when uses-stdin
       (push "<" out)
     (push (substring method beg (length method)) out)
     (when uses-stdin
       (push "<" out)
-      (push (mm-quote-arg
+      (push (shell-quote-argument
             (gnus-map-function mm-path-name-rewrite-functions file))
            out))
     (mapconcat 'identity (nreverse out) "")))
             (gnus-map-function mm-path-name-rewrite-functions file))
            out))
     (mapconcat 'identity (nreverse out) "")))
@@ -979,27 +1087,16 @@ external if displayed external."
 
 (defun mm-insert-part (handle)
   "Insert the contents of HANDLE in the current buffer."
 
 (defun mm-insert-part (handle)
   "Insert the contents of HANDLE in the current buffer."
-  (let ((cur (current-buffer)))
-    (save-excursion
-      (if (member (mm-handle-media-supertype handle) '("text" "message"))
-         (with-temp-buffer
-           (insert-buffer-substring (mm-handle-buffer handle))
-           (prog1
-               (mm-decode-content-transfer-encoding
-                (mm-handle-encoding handle)
-                (mm-handle-media-type handle))
-             (let ((temp (current-buffer)))
-               (set-buffer cur)
-               (insert-buffer-substring temp))))
-       (mm-with-unibyte-buffer
-         (insert-buffer-substring (mm-handle-buffer handle))
-         (prog1
-             (mm-decode-content-transfer-encoding
-              (mm-handle-encoding handle)
-              (mm-handle-media-type handle))
-           (let ((temp (current-buffer)))
-             (set-buffer cur)
-             (insert-buffer-substring temp))))))))
+  (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."
 
 (defun mm-file-name-delete-whitespace (file-name)
   "Remove all whitespace characters from FILE-NAME."
@@ -1039,8 +1136,9 @@ string if you do not like underscores."
   (setq filename (gnus-replace-in-string filename "[<>|]" ""))
   (gnus-replace-in-string filename "^[.-]+" ""))
 
   (setq filename (gnus-replace-in-string filename "[<>|]" ""))
   (gnus-replace-in-string filename "^[.-]+" ""))
 
-(defun mm-save-part (handle)
-  "Write HANDLE to a file."
+(defun mm-save-part (handle &optional prompt)
+  "Write HANDLE to a file.
+PROMPT overrides the default one used to ask user for a file name."
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
         (filename (mail-content-type-get
                    (mm-handle-disposition handle) 'filename))
   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
         (filename (mail-content-type-get
                    (mm-handle-disposition handle) 'filename))
@@ -1049,9 +1147,10 @@ string if you do not like underscores."
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file
-         (read-file-name "Save MIME part to: "
-                         (or mm-default-directory default-directory)
-                         nil nil (or filename name "")))
+         (mm-with-multibyte
+           (read-file-name (or prompt "Save MIME part to: ")
+                           (or mm-default-directory default-directory)
+                           nil nil (or filename name ""))))
     (setq mm-default-directory (file-name-directory file))
     (and (or (not (file-exists-p file))
             (yes-or-no-p (format "File %s already exists; overwrite? "
     (setq mm-default-directory (file-name-directory file))
     (and (or (not (file-exists-p file))
             (yes-or-no-p (format "File %s already exists; overwrite? "
@@ -1410,6 +1509,12 @@ If RECURSIVE, search recursively."
     parts))
 
 (defun mm-multiple-handles (handles)
     parts))
 
 (defun mm-multiple-handles (handles)
+  (and (listp handles)
+       (> (length handles) 1)
+       (or (listp (car handles))
+          (stringp (car handles)))))
+
+(defun mm-complicated-handles (handles)
   (and (listp (car handles))
        (> (length handles) 1)))
 
   (and (listp (car handles))
        (> (length handles) 1)))
 
@@ -1433,4 +1538,5 @@ If RECURSIVE, search recursively."
 
 (provide 'mm-decode)
 
 
 (provide 'mm-decode)
 
+;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b
 ;;; mm-decode.el ends here
 ;;; mm-decode.el ends here