Put back the nnimal autoloads needed to do the acl stuff.

[gnus] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index d443289..948fc08 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,47 +1,54 @@
 ;;; 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, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; This file is part of GNU Emacs.
 
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; This file is part of GNU Emacs.
 

-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify

 ;; it under the terms of the GNU General Public License as published by
 ;; it under the terms of the GNU General Public License as published by

-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.

 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.         See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; GNU General Public License for more details.
 
 ;; 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.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

 
 ;;; Commentary:
 
 ;;; Code:
 
 
 ;;; Commentary:
 
 ;;; Code:
 

+;; For Emacs < 22.2.
+(eval-and-compile
+  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+

 (require 'mail-parse)
 (require 'mail-parse)

-(require 'mailcap)

 (require 'mm-bodies)
 (eval-when-compile (require 'cl)
                   (require 'term))
 
 (require 'mm-bodies)
 (eval-when-compile (require 'cl)
                   (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 'gnus-map-function "gnus-util")
+(autoload 'gnus-replace-in-string "gnus-util")
+(autoload 'gnus-read-shell-command "gnus-util")
+
+(autoload 'mm-inline-partial "mm-partial")
+(autoload 'mm-inline-external-body "mm-extern")
+(autoload 'mm-extern-cache-contents "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 +56,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)


@@ -98,28 +105,33 @@
         ,disposition ,description ,cache ,id))
 
 (defcustom mm-text-html-renderer
         ,disposition ,description ,cache ,id))
 
 (defcustom mm-text-html-renderer

-  (cond ((locate-library "w3") 'w3)
-       ((locate-library "w3m") 'w3m)
+  (cond ((executable-find "w3m") 'gnus-article-html)

        ((executable-find "links") 'links)
        ((executable-find "lynx") 'lynx)
        ((executable-find "links") 'links)
        ((executable-find "lynx") 'lynx)

-       (t 'html2text))
+       ((locate-library "w3") 'w3)
+       ((locate-library "html2text") 'html2text)
+       (t nil))

   "Render of HTML contents.
 It is one of defined renderer types, or a rendering function.
 The defined renderer types are:
   "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."
-  :type '(choice (const w3)
-                (const w3m)
+`gnus-article-html' : use Gnus renderer based on w3m;
+`w3m'  : use emacs-w3m;
+`w3m-standalone': use w3m;
+`links': use links;
+`lynx' : use lynx;
+`w3'   : use Emacs/W3;
+`html2text' : use html2text;
+nil    : use external viewer (default web browser)."
+  :version "24.1"
+  :type '(choice (const gnus-article-html)
+                 (const w3)
+                 (const w3m :tag "emacs-w3m")
+                (const w3m-standalone :tag "standalone w3m" )

                 (const links)
                 (const lynx)
                 (const html2text)
                 (const links)
                 (const lynx)
                 (const html2text)

-                (const nil)
+                (const nil :tag "External viewer")

                 (function))
                 (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 +142,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,15 +158,29 @@ 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
   '(("image/p?jpeg"
      mm-inline-image
 (defcustom mm-inline-media-tests
   '(("image/p?jpeg"
      mm-inline-image


@@ -200,9 +227,18 @@ 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)))
+    ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40).
+    ("text/x-diff" mm-display-patch-inline
+     (lambda (handle) (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)


@@ -252,11 +288,13 @@ set this variable to nil if you consider all urls to be safe."
     "application/x-emacs-lisp"
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/x-emacs-lisp"
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"

-    "application/pkcs7-mime")
+    "application/pkcs7-mime"
+    ;; Mutt still uses this even though it has already been withdrawn.
+    "application/pgp")

   "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 +302,22 @@ 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/emacs-lisp" "application/x-emacs-lisp"
     "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"

-    "application/pkcs7-mime")
+    "application/pkcs7-mime"
+    ;; Mutt still uses this even though it has already been withdrawn.
+    "application/pgp\\'")

   "A list of MIME types to be displayed automatically."
   "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 +326,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 +348,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


@@ -326,20 +372,34 @@ to:
   :type 'boolean
   :group 'mime-display)
 
   :type 'boolean
   :group 'mime-display)
 

-(defvar mm-file-name-rewrite-functions
+(defcustom mm-file-name-rewrite-functions

   '(mm-file-name-delete-control mm-file-name-delete-gotchas)
   '(mm-file-name-delete-control mm-file-name-delete-gotchas)

-  "*List of functions used for rewriting file names of MIME parts.
+  "List of functions used for rewriting file names of MIME parts.

 Each function takes a file name as input and returns a file name.
 
 Each function takes a file name as input and returns a file name.
 

-Ready-made functions include
-`mm-file-name-delete-control'
-`mm-file-name-delete-gotchas'
-`mm-file-name-delete-whitespace',
-`mm-file-name-trim-whitespace',
-`mm-file-name-collapse-whitespace',
-`mm-file-name-replace-whitespace',
-`capitalize', `downcase', `upcase', and
-`upcase-initials'.")
+Ready-made functions include `mm-file-name-delete-control',
+`mm-file-name-delete-gotchas' (you should not remove these two
+functions), `mm-file-name-delete-whitespace',
+`mm-file-name-trim-whitespace', `mm-file-name-collapse-whitespace',
+`mm-file-name-replace-whitespace', `capitalize', `downcase',
+`upcase', and `upcase-initials'."
+  :type '(list (set :inline t
+                   (const mm-file-name-delete-control)
+                   (const mm-file-name-delete-gotchas)
+                   (const mm-file-name-delete-whitespace)
+                   (const mm-file-name-trim-whitespace)
+                   (const mm-file-name-collapse-whitespace)
+                   (const mm-file-name-replace-whitespace)
+                   (const capitalize)
+                   (const downcase)
+                   (const upcase)
+                   (const upcase-initials)
+              (repeat :inline t
+                      :tag "Function"
+                      function)))
+  :version "23.1" ;; No Gnus
+  :group 'mime-display)
+

 
 (defvar mm-path-name-rewrite-functions nil
   "*List of functions for rewriting the full file names of MIME parts.
 
 (defvar mm-path-name-rewrite-functions nil
   "*List of functions for rewriting the full file names of MIME parts.


@@ -360,11 +420,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)
 


@@ -396,7 +458,12 @@ If not set, `default-directory' will be used."
 (defcustom mm-verify-option 'never
   "Option of verifying signed parts.
 `never', not verify; `always', always verify;
 (defcustom mm-verify-option 'never
   "Option of verifying signed parts.
 `never', not verify; `always', always verify;

-`known', only verify known protocols.  Otherwise, ask user."
+`known', only verify known protocols.  Otherwise, ask user.
+
+When set to `always' or `known', you should add
+\"multipart/signed\" to `gnus-buttonized-mime-types' to see
+result of the verification."
+  :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 +482,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 +492,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,43 +551,47 @@ 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)
+(autoload 'message-fetch-field "message")
+
+(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
                  loose-mime
                  (mail-fetch-field "mime-version"))
          (setq ct (mail-fetch-field "content-type")
       (save-restriction
        (mail-narrow-to-head)
        (when (or no-strict-mime
                  loose-mime
                  (mail-fetch-field "mime-version"))
          (setq ct (mail-fetch-field "content-type")

-               ctl (ignore-errors (mail-header-parse-content-type ct))
+               ctl (and ct (mail-header-parse-content-type ct))

                cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")
                cte (mail-fetch-field "content-transfer-encoding")
                cd (mail-fetch-field "content-disposition")

-               description (mail-fetch-field "content-description")
-               from (mail-fetch-field "from")
+               ;; Newlines in description should be stripped so as
+               ;; not to break the MIME tag into two or more lines.
+               description (message-fetch-field "content-description")

                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
          ;; 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)))
+             (setq from (cadr (mail-extract-address-components from))))
+         (if description
+             (setq description (mail-decode-encoded-word-string
+                                description)))))

       (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
           no-strict-mime

-          (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
+          (and cd (mail-header-parse-content-disposition cd))

           description)
        (setq type (split-string (car ctl) "/"))
        (setq subtype (cadr type)
           description)
        (setq type (split-string (car ctl) "/"))
        (setq subtype (cadr type)

-             type (pop type))
+             type (car type))

        (setq
         result
         (cond
        (setq
         result
         (cond


@@ -536,24 +606,21 @@ 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
             ;; 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)
                                        'from from
                                        'start start)
                                  (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)
                                        'from from
                                        'start start)
                                  (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
             no-strict-mime

-            (and cd (ignore-errors
-                      (mail-header-parse-content-disposition cd)))
+            (and cd (mail-header-parse-content-disposition cd))

             description id)
            ctl))))
        (when id
             description id)
            ctl))))
        (when id


@@ -570,7 +637,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 +654,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,18 +663,21 @@ 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 ()
   "Copy the contents of the current buffer to a fresh buffer."
     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 
 (defun mm-copy-to-buffer ()
   "Copy the contents of the current buffer to a fresh buffer."

-  (save-excursion
-    (let ((obuf (current-buffer))
-         beg)
-      (goto-char (point-min))
-      (search-forward-regexp "^\n" nil t)
-      (setq beg (point))
-      (set-buffer (generate-new-buffer " *mm*"))
+  (let ((obuf (current-buffer))
+        (mb (mm-multibyte-p))
+        beg)
+    (goto-char (point-min))
+    (search-forward-regexp "^\n" nil t)
+    (setq beg (point))
+    (with-current-buffer
+          (generate-new-buffer " *mm*")
+      ;; Preserve the data's unibyteness (for url-insert-file-contents).
+      (mm-set-buffer-multibyte mb)

       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 


@@ -621,6 +691,9 @@ Postpone undisplaying of viewers for types in
          (goto-char (point-max)))
       (mapcar 'mm-display-parts handle))))
 
          (goto-char (point-max)))
       (mapcar 'mm-display-parts handle))))
 

+(autoload 'mailcap-parse-mailcaps "mailcap")
+(autoload 'mailcap-mime-info "mailcap")
+

 (defun mm-display-part (handle &optional no-default)
   "Display the MIME part represented by HANDLE.
 Returns nil if the part is removed; inline if displayed inline;
 (defun mm-display-part (handle &optional no-default)
   "Display the MIME part represented by HANDLE.
 Returns nil if the part is removed; inline if displayed inline;


@@ -629,10 +702,23 @@ external if displayed external."
     (mailcap-parse-mailcaps)
     (if (mm-handle-displayed-p handle)
        (mm-remove-part handle)
     (mailcap-parse-mailcaps)
     (if (mm-handle-displayed-p handle)
        (mm-remove-part handle)

-      (let* ((type (mm-handle-media-type handle))
-            (method (mailcap-mime-info type)))
-       (if (and (mm-inlinable-p handle)
-                (mm-inlined-p handle))
+      (let* ((ehandle (if (equal (mm-handle-media-type handle)
+                                "message/external-body")
+                         (progn
+                           (unless (mm-handle-cache handle)
+                             (mm-extern-cache-contents handle))
+                           (mm-handle-cache handle))
+                       handle))
+            (type (mm-handle-media-type ehandle))
+            (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 ehandle)
+                (mm-inlined-p ehandle))

            (progn
              (forward-line 1)
              (mm-display-inline handle)
            (progn
              (forward-line 1)
              (mm-display-inline handle)


@@ -640,13 +726,34 @@ external if displayed external."
          (when (or method
                    (not no-default))
            (if (and (not method)
          (when (or method
                    (not no-default))
            (if (and (not method)

-                    (equal "text" (car (split-string type))))
+                    (equal "text" (car (split-string type "/"))))

                (progn
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
                (progn
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)

-             (mm-display-external
-              handle (or method 'mailcap-save-binary-file)))))))))
+             (setq external
+                    (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) "\"")
+                                   "")
+                                    "? "))))))
+             (if external
+                 (mm-display-external
+                  handle (or method 'mailcap-save-binary-file))
+               (mm-display-external
+                handle 'mailcap-save-binary-file)))))))))
+
+(declare-function gnus-configure-windows "gnus-win" (setting &optional force))
+(defvar mailcap-mime-extensions)       ; mailcap-mime-info autoloads

 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."


@@ -659,6 +766,7 @@ external if displayed external."
                  (set-buffer (generate-new-buffer " *mm*"))
                  (setq method nil))
              (mm-insert-part handle)
                  (set-buffer (generate-new-buffer " *mm*"))
                  (setq method nil))
              (mm-insert-part handle)

+             (mm-add-meta-html-tag handle)

              (let ((win (get-buffer-window cur t)))
                (when win
                  (select-window win)))
              (let ((win (get-buffer-window cur t)))
                (when win
                  (select-window win)))


@@ -667,7 +775,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


@@ -681,6 +790,7 @@ external if displayed external."
                  (mm-handle-set-undisplayer handle mm)))))
        ;; The function is a string to be executed.
        (mm-insert-part handle)
                  (mm-handle-set-undisplayer handle mm)))))
        ;; The function is a string to be executed.
        (mm-insert-part handle)

+       (mm-add-meta-html-tag handle)

        (let* ((dir (mm-make-temp-file
                     (expand-file-name "emm." mm-tmp-directory) 'dir))
               (filename (or
        (let* ((dir (mm-make-temp-file
                     (expand-file-name "emm." mm-tmp-directory) 'dir))
               (filename (or


@@ -695,15 +805,30 @@ external if displayed external."
               (copiousoutput (assoc "copiousoutput" mime-info))
               file buffer)
          ;; We create a private sub-directory where we store our files.
               (copiousoutput (assoc "copiousoutput" mime-info))
               file buffer)
          ;; We create a private sub-directory where we store our files.

-         (set-file-modes dir 448)
+         (set-file-modes dir #o700)

          (if filename
              (setq file (expand-file-name
                          (gnus-map-function mm-file-name-rewrite-functions
                                             (file-name-nondirectory filename))
                          dir))
          (if filename
              (setq file (expand-file-name
                          (gnus-map-function mm-file-name-rewrite-functions
                                             (file-name-nondirectory filename))
                          dir))

-           (setq file (mm-make-temp-file (expand-file-name "mm." dir))))
+           ;; Use nametemplate (defined in RFC1524) if it is specified
+           ;; in mailcap.
+           (let ((suffix (cdr (assoc "nametemplate" mime-info))))
+             (if (and suffix
+                      (string-match "\\`%s\\(\\..+\\)\\'" suffix))
+                 (setq suffix (match-string 1 suffix))
+               ;; Otherwise, use a suffix according to
+               ;; `mailcap-mime-extensions'.
+               (setq suffix (car (rassoc (mm-handle-media-type handle)
+                                         mailcap-mime-extensions))))
+             (setq file (mm-make-temp-file (expand-file-name "mm." dir)
+                                           nil suffix))))

          (let ((coding-system-for-write mm-binary-coding-system))
            (write-region (point-min) (point-max) file nil 'nomesg))
          (let ((coding-system-for-write mm-binary-coding-system))
            (write-region (point-min) (point-max) file nil 'nomesg))

+         ;; The file is deleted after the viewer exists.  If the users edits
+         ;; the file, changes will be lost.  Set file to read-only to make it
+         ;; clear.
+         (set-file-modes file #o400)

          (message "Viewing with %s" method)
          (cond
           (needsterm
          (message "Viewing with %s" method)
          (cond
           (needsterm


@@ -750,8 +875,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 +884,60 @@ 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)))
+                      (if (featurep 'xemacs)
+                          (lambda (process state)
+                            (when (eq 'exit (process-status process))
+                              (if (memq timer itimer-list)
+                                  (set-itimer-function timer fn)
+                                (funcall fn))
+                              (ignore-errors (eval fm))
+                              (message "%s" done)))
+                        (lambda (process state)
+                          (when (eq 'exit (process-status process))
+                            (if (memq timer timer-list)
+                                (timer-set-function timer fn)
+                              (funcall fn))