(shr-make-table): Tweak table generation.

[gnus] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 5e651e7..ab96e34 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,40 +1,48 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 ;;; mm-decode.el --- Functions for decoding MIME things

-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;;        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 '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)
 
 
 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
 


@@ -97,31 +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)
-       ((executable-find "w3m") (if (locate-library "w3m")
-                                    'w3m
-                                  'w3m-standalone))
+  (cond ((fboundp 'libxml-parse-html-region) 'mm-shr)
+       ((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'   : use Emacs/W3;
+`gnus-article-html' : use Gnus renderer based on w3m;

 `w3m'  : use emacs-w3m;
 `w3m-standalone': use w3m;
 `links': use links;
 `lynx' : use lynx;
 `w3m'  : use emacs-w3m;
 `w3m-standalone': use w3m;
 `links': use links;
 `lynx' : use lynx;

+`w3'   : use Emacs/W3;

 `html2text' : use html2text;
 `html2text' : use html2text;

-nil    : use external viewer."
-  :version "21.4"
-  :type '(choice (const w3)
-                (const w3m)
-                (const w3m-standalone)
+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))
   :group 'mime-display)
 
                 (function))
   :group 'mime-display)
 


@@ -133,7 +143,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 "21.4"
+  :version "22.1"

   :type 'boolean
   :group 'mime-display)
 
   :type 'boolean
   :group 'mime-display)
 


@@ -149,12 +159,14 @@ 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)
 


@@ -164,7 +176,7 @@ set this variable to nil if you consider all urls to be safe."
 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."
 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 "21.4"
+  :version "22.1"

   :type '(choice (const :tag "Always" t)
                 (const :tag "Never" nil)
                 (const :tag "Ask" ask))
   :type '(choice (const :tag "Always" t)
                 (const :tag "Never" nil)
                 (const :tag "Ask" ask))


@@ -216,7 +228,15 @@ before the external MIME handler is invoked."
     ("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)
     ("text/dns" mm-display-dns-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)


@@ -269,11 +289,13 @@ before the external MIME handler is invoked."
     "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


@@ -281,20 +303,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."

-  :version "21.4"
-  :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/.*"
     "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"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
     "message/rfc822" "text/x-patch" "text/dns" "application/pgp-signature"
     "application/emacs-lisp" "application/x-emacs-lisp"
     "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"


@@ -303,17 +327,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


@@ -325,8 +349,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


@@ -340,24 +369,42 @@ to:
   :group 'mime-display)
 
 (defcustom mm-inline-large-images nil
   :group 'mime-display)
 
 (defcustom mm-inline-large-images nil

-  "If non-nil, then all images fit in the buffer."
-  :type 'boolean
+  "If t, then all images fit in the buffer.
+If 'resize, try to resize the images so they fit."
+  :type '(radio
+          (const :tag "Inline large images as they are." t)
+          (const :tag "Resize large images." resize)
+          (const :tag "Do not inline large images." nil))

   :group 'mime-display)
 
   :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.


@@ -378,12 +425,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 "21.4"
+  :version "22.1"

   :type 'string
   :group 'mime-display)
 
   :type 'string
   :group 'mime-display)
 


@@ -415,8 +463,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."
-  :version "21.4"
+`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)


@@ -435,6 +487,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)


@@ -444,21 +497,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)


@@ -505,39 +556,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))))))
+             (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)
           (and cte (intern (downcase (mail-header-strip cte))))
           no-strict-mime
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
           (list mm-dissect-default-type)
           (and cte (intern (downcase (mail-header-strip cte))))
           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


@@ -552,22 +611,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
             (and cte (intern (downcase (mail-header-strip cte))))
             no-strict-mime
          (t
           (mm-possibly-verify-or-decrypt
            (mm-dissect-singlepart
             ctl
             (and cte (intern (downcase (mail-header-strip cte))))
             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


@@ -579,16 +637,12 @@ Postpone undisplaying of viewers for types in
 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
   (when (or force
            (if (equal "text/plain" (car ctl))
 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
   (when (or force
            (if (equal "text/plain" (car ctl))

-               ;; FIXME: This is a kludge.  Proper fix is to make
-               ;; gnus-display-mime invoke mm-uu-dissect on all
-               ;; textual MIME parts, and stop using mm-fill-flowed
-               ;; here.
-               (and mm-fill-flowed (assoc 'format ctl))
+               (assoc 'format ctl)

              t))
     (mm-make-handle
      (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 
              t))
     (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]*$"))


@@ -605,7 +659,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))


@@ -614,21 +668,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))
-         (multibyte enable-multibyte-characters)
-         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).
       ;; Preserve the data's unibyteness (for url-insert-file-contents).

-      (set-buffer-multibyte multibyte)
+      (mm-set-buffer-multibyte mb)

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


@@ -642,6 +696,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;


@@ -650,7 +707,14 @@ 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))
+      (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)
             (method (mailcap-mime-info type))
             (filename (or (mail-content-type-get
                            (mm-handle-disposition handle) 'filename)


@@ -658,8 +722,8 @@ external if displayed external."
                            (mm-handle-type handle) 'name)
                           "<file>"))
             (external mm-enable-external))
                            (mm-handle-type handle) 'name)
                           "<file>"))
             (external mm-enable-external))

-       (if (and (mm-inlinable-p handle)
-                (mm-inlined-p handle))
+       (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)


@@ -667,12 +731,13 @@ 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)

-             (if (and method ;; If nil, we always use "save".
+             (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)
                       (stringp method) ;; 'mailcap-save-binary-file
                       (or (eq mm-enable-external t)
                           (and (eq mm-enable-external 'ask)


@@ -685,15 +750,16 @@ external if displayed external."
                                      (concat
                                       " \"" (format method filename) "\"")
                                    "")
                                      (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)))))))))
 
              (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."
   (let ((outbuf (current-buffer)))
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
   (let ((outbuf (current-buffer)))


@@ -705,6 +771,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)))


@@ -728,6 +795,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


@@ -742,15 +810,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


@@ -797,8 +880,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))


@@ -807,14 +889,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))
+                            (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))


@@ -895,7 +1023,8 @@ external if displayed external."
        (cond
         ;; Internally displayed part.
         ((mm-annotationp object)
        (cond
         ;; Internally displayed part.
         ((mm-annotationp object)

-         (delete-annotation object))
+          (if (featurep 'xemacs)
+              (delete-annotation object)))

         ((or (functionp object)
              (and (listp object)
                   (eq (car object) 'lambda)))
         ((or (functionp object)
              (and (listp object)
                   (eq (car object) 'lambda)))


@@ -942,10 +1071,12 @@ external if displayed external."
              methods nil)))
     result))
 
              methods nil)))
     result))
 

-(defun mm-inlinable-p (handle)
-  "Say whether HANDLE can be displayed inline."
+(defun mm-inlinable-p (handle &optional type)
+  "Say whether HANDLE can be displayed inline.
+TYPE is the mime-type of the object; it defaults to the one given
+in HANDLE."
+  (unless type (setq type (mm-handle-media-type handle)))

   (let ((alist mm-inline-media-tests)
   (let ((alist mm-inline-media-tests)

-       (type (mm-handle-media-type handle))

        test)
     (while alist
       (when (string-match (caar alist) type)
        test)
     (while alist
       (when (string-match (caar alist) type)


@@ -1013,40 +1144,64 @@ external if displayed external."
 ;;; Functions for outputting parts
 ;;;
 
 ;;; Functions for outputting parts
 ;;;
 

-(defun mm-get-part (handle)
-  "Return the contents of HANDLE as a string."
-  (mm-with-unibyte-buffer
-    (insert (with-current-buffer (mm-handle-buffer handle)
-             (mm-with-unibyte-current-buffer
-               (buffer-string))))
-    (mm-decode-content-transfer-encoding
-     (mm-handle-encoding handle)
-     (mm-handle-media-type handle))
-    (buffer-string)))
-
-(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))))))))
+(defmacro mm-with-part (handle &rest forms)
+  "Run FORMS in the temp buffer containing the contents of HANDLE."
+  ;; The handle-buffer's content is a sequence of bytes, not a sequence of
+  ;; chars, so the buffer should be unibyte.  It may happen that the
+  ;; handle-buffer is multibyte for some reason, in which case now is a good
+  ;; time to adjust it, since we know at this point that it should
+  ;; be unibyte.
+  `(let* ((handle ,handle))
+     (when (and (mm-handle-buffer handle)
+               (buffer-name (mm-handle-buffer handle)))
+       (with-temp-buffer
+        (mm-disable-multibyte)
+        (insert-buffer-substring (mm-handle-buffer handle))
+        (mm-decode-content-transfer-encoding
+         (mm-handle-encoding handle)
+         (mm-handle-media-type handle))
+        ,@forms))))
+(put 'mm-with-part 'lisp-indent-function 1)
+(put 'mm-with-part 'edebug-form-spec '(body))
+
+(defun mm-get-part (handle &optional no-cache)
+  "Return the contents of HANDLE as a string.
+If NO-CACHE is non-nil, cached contents of a message/external-body part
+are ignored."
+  (if (and (not no-cache)
+          (equal (mm-handle-media-type handle) "message/external-body"))
+      (progn
+       (unless (mm-handle-cache handle)
+         (mm-extern-cache-contents handle))
+       (with-current-buffer (mm-handle-buffer (mm-handle-cache handle))
+         (buffer-string)))
+    (mm-with-part handle
+      (buffer-string))))
+
+(defun mm-insert-part (handle &optional no-cache)
+  "Insert the contents of HANDLE in the current buffer.
+If NO-CACHE is non-nil, cached contents of a message/external-body part
+are ignored."
+  (let ((text (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-to-multibyte (mm-get-part handle no-cache)))
+                   (t
+                    (mm-get-part handle no-cache)))))
+    (save-restriction
+      (widen)
+      (goto-char
+       (prog1
+          (point)
+        (if (and (eq (get-char-property (max (point-min) (1- (point))) 'face)
+                     'mm-uu-extract)
+                 (eq (get-char-property 0 'face text) 'mm-uu-extract))
+            ;; Separate the extracted parts that have the same faces.
+            (insert "\n" text)
+          (insert text)))))))

 
 (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."


@@ -1086,20 +1241,25 @@ 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."
-  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
-        (filename (mail-content-type-get
-                   (mm-handle-disposition handle) 'filename))
-        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 ((filename (or (mail-content-type-get
+                      (mm-handle-disposition handle) 'filename)
+                     (mail-content-type-get
+                      (mm-handle-type handle) 'name)))
+       file)

     (when filename
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file
     (when filename
       (setq filename (gnus-map-function mm-file-name-rewrite-functions
                                        (file-name-nondirectory filename))))
     (setq file

-         (mm-with-multibyte
-           (read-file-name "Save MIME part to: "
-                           (or mm-default-directory default-directory)
-                           nil nil (or filename name ""))))
+          (read-file-name (or prompt
+                             (format "Save MIME part to (default %s): "
+                                     (or filename "")))
+                          (or mm-default-directory default-directory)
+                         (or filename "")))
+    (when (file-directory-p file)
+      (setq file (expand-file-name filename file)))

     (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? "


@@ -1108,29 +1268,59 @@ string if you do not like underscores."
           (mm-save-part-to-file handle file)
           file))))
 
           (mm-save-part-to-file handle file)
           file))))
 

+(defun mm-add-meta-html-tag (handle &optional charset force-charset)
+  "Add meta html tag to specify CHARSET of HANDLE in the current buffer.
+CHARSET defaults to the one HANDLE specifies.  Existing meta tag that
+specifies charset will not be modified unless FORCE-CHARSET is non-nil.
+Return t if meta tag is added or replaced."
+  (when (equal (mm-handle-media-type handle) "text/html")
+    (when (or charset
+             (setq charset (mail-content-type-get (mm-handle-type handle)
+                                                  'charset)))
+      (setq charset (format "\
+<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset))
+      (let ((case-fold-search t))
+       (goto-char (point-min))
+       (if (re-search-forward "\
+<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
+text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+\\)\\)?[\"'][^>]*>" nil t)
+           (if (and (not force-charset)
+                    (match-beginning 2)
+                    (string-match "\\`html\\'" (match-string 1)))
+               ;; Don't modify existing meta tag.
+               nil
+             ;; Replace it with the one specifying charset.
+             (replace-match charset)
+             t)
+         (if (re-search-forward "<head>\\s-*" nil t)
+             (insert charset "\n")
+           (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
+           (insert "<head>\n" charset "\n</head>\n"))
+         t)))))
+

 (defun mm-save-part-to-file (handle file)
   (mm-with-unibyte-buffer
     (mm-insert-part handle)
 (defun mm-save-part-to-file (handle file)
   (mm-with-unibyte-buffer
     (mm-insert-part handle)

-    (let ((coding-system-for-write 'binary)
-         (current-file-modes (default-file-modes))
+    (mm-add-meta-html-tag handle)
+    (let ((current-file-modes (default-file-modes)))
+      (set-default-file-modes mm-attachment-file-modes)
+      (unwind-protect

          ;; Don't re-compress .gz & al.  Arguably we should make
          ;; `file-name-handler-alist' nil, but that would chop
          ;; ange-ftp, which is reasonable to use here.
          ;; Don't re-compress .gz & al.  Arguably we should make
          ;; `file-name-handler-alist' nil, but that would chop
          ;; ange-ftp, which is reasonable to use here.

-         (inhibit-file-name-operation 'write-region)
-         (inhibit-file-name-handlers
-          (cons 'jka-compr-handler inhibit-file-name-handlers)))
-      (set-default-file-modes mm-attachment-file-modes)
-      (unwind-protect
-         (write-region (point-min) (point-max) file)
+         (mm-write-region (point-min) (point-max) file nil nil nil 'binary t)

        (set-default-file-modes current-file-modes)))))
 
        (set-default-file-modes current-file-modes)))))
 

-(defun mm-pipe-part (handle)
-  "Pipe HANDLE to a process."
-  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
-        (command
-         (read-string "Shell command on MIME part: " mm-last-shell-command)))
+(defun mm-pipe-part (handle &optional cmd)
+  "Pipe HANDLE to a process.
+Use CMD as the process."
+  (let ((name (mail-content-type-get (mm-handle-type handle) 'name))
+       (command (or cmd
+                    (gnus-read-shell-command
+                     "Shell command on MIME part: " mm-last-shell-command))))

     (mm-with-unibyte-buffer
       (mm-insert-part handle)
     (mm-with-unibyte-buffer
       (mm-insert-part handle)

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

       (let ((coding-system-for-write 'binary))
        (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)))))
 


@@ -1138,11 +1328,11 @@ string if you do not like underscores."
   "Display HANDLE using METHOD."
   (let* ((type (mm-handle-media-type handle))
         (methods
   "Display HANDLE using METHOD."
   (let* ((type (mm-handle-media-type handle))
         (methods

-         (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
+         (mapcar (lambda (i) (cdr (assoc 'viewer i)))

                  (mailcap-mime-info type 'all)))
         (method (let ((minibuffer-local-completion-map
                        mm-viewer-completion-map))
                  (mailcap-mime-info type 'all)))
         (method (let ((minibuffer-local-completion-map
                        mm-viewer-completion-map))

-                  (completing-read "Viewer: " methods))))
+                  (gnus-completing-read "Viewer" methods))))

     (when (string= method "")
       (error "No method given"))
     (if (string-match "^[^% \t]+$" method)
     (when (string= method "")
       (error "No method given"))
     (if (string-match "^[^% \t]+$" method)


@@ -1245,44 +1435,48 @@ be determined."
            (mm-handle-set-cache handle spec))))))
 
 (defun mm-create-image-xemacs (type)
            (mm-handle-set-cache handle spec))))))
 
 (defun mm-create-image-xemacs (type)

-  (cond
-   ((equal type "xbm")
-    ;; xbm images require special handling, since
-    ;; the only way to create glyphs from these
-    ;; (without a ton of work) is to write them
-    ;; out to a file, and then create a file
-    ;; specifier.
-    (let ((file (mm-make-temp-file
-                (expand-file-name "emm.xbm"
-                                  mm-tmp-directory))))
-      (unwind-protect
-         (progn
-           (write-region (point-min) (point-max) file)
-           (make-glyph (list (cons 'x file))))
-       (ignore-errors
-         (delete-file file)))))
-   (t
-    (make-glyph
-     (vector
-      (or (mm-image-type-from-buffer)
-         (intern type))
-      :data (buffer-string))))))
+  (when (featurep 'xemacs)
+    (cond
+     ((equal type "xbm")
+      ;; xbm images require special handling, since
+      ;; the only way to create glyphs from these
+      ;; (without a ton of work) is to write them
+      ;; out to a file, and then create a file
+      ;; specifier.
+      (let ((file (mm-make-temp-file
+                  (expand-file-name "emm" mm-tmp-directory)
+                  nil ".xbm")))
+       (unwind-protect
+           (progn
+             (write-region (point-min) (point-max) file)
+             (make-glyph (list (cons 'x file))))
+         (ignore-errors
+           (delete-file file)))))
+     (t
+      (make-glyph
+       (vector
+       (or (mm-image-type-from-buffer)
+           (intern type))
+       :data (buffer-string)))))))
+
+(declare-function image-size "image.c" (spec &optional pixels frame))

 
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))
 
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))

-    (if (fboundp 'glyph-width)
-       ;; XEmacs' glyphs can actually tell us about their width, so
-       ;; lets be nice and smart about them.
-       (or mm-inline-large-images
-           (and (< (glyph-width image) (window-pixel-width))
-                (< (glyph-height image) (window-pixel-height))))
-      (let* ((size (image-size image))
-            (w (car size))
-            (h (cdr size)))
-       (or mm-inline-large-images
-           (and (< h (1- (window-height))) ; Don't include mode line.
-                (< w (window-width))))))))
+    (or (not image)
+       (if (featurep 'xemacs)
+           ;; XEmacs' glyphs can actually tell us about their width, so
+           ;; lets be nice and smart about them.
+           (or mm-inline-large-images
+               (and (<= (glyph-width image) (window-pixel-width))
+                    (<= (glyph-height image) (window-pixel-height))))
+         (let* ((size (image-size image))
+                (w (car size))
+                (h (cdr size)))
+           (or mm-inline-large-images
+               (and (<= h (1- (window-height))) ; Don't include mode line.
+                    (<= w (window-width)))))))))

 
 (defun mm-valid-image-format-p (format)
   "Say whether FORMAT can be displayed natively by Emacs."
 
 (defun mm-valid-image-format-p (format)
   "Say whether FORMAT can be displayed natively by Emacs."


@@ -1290,7 +1484,7 @@ be determined."
    ;; Handle XEmacs
    ((fboundp 'valid-image-instantiator-format-p)
     (valid-image-instantiator-format-p format))
    ;; Handle XEmacs
    ((fboundp 'valid-image-instantiator-format-p)
     (valid-image-instantiator-format-p format))

-   ;; Handle Emacs 21
+   ;; Handle Emacs

    ((fboundp 'image-type-available-p)
     (and (display-graphic-p)
         (image-type-available-p format)))
    ((fboundp 'image-type-available-p)
     (and (display-graphic-p)
         (image-type-available-p format)))


@@ -1341,9 +1535,8 @@ If RECURSIVE, search recursively."
        (save-excursion
          (save-restriction
            (narrow-to-region start (1- (point)))
        (save-excursion
          (save-restriction
            (narrow-to-region start (1- (point)))

-           (when (let ((ctl (ignore-errors
-                              (mail-header-parse-content-type
-                               (mail-fetch-field "content-type")))))
+           (when (let* ((ct (mail-fetch-field "content-type"))
+                        (ctl (and ct (mail-header-parse-content-type ct))))

                    (if notp
                        (not (equal (car ctl) type))
                      (equal (car ctl) type)))
                    (if notp
                        (not (equal (car ctl) type))
                      (equal (car ctl) type)))


@@ -1354,9 +1547,8 @@ If RECURSIVE, search recursively."
       (save-excursion
        (save-restriction
          (narrow-to-region start end)
       (save-excursion
        (save-restriction
          (narrow-to-region start end)

-         (when (let ((ctl (ignore-errors
-                            (mail-header-parse-content-type
-                             (mail-fetch-field "content-type")))))
+         (when (let* ((ct (mail-fetch-field "content-type"))
+                      (ctl (and ct (mail-header-parse-content-type ct))))

                  (if notp
                      (not (equal (car ctl) type))
                    (equal (car ctl) type)))
                  (if notp
                      (not (equal (car ctl) type))
                    (equal (car ctl) type)))


@@ -1371,6 +1563,8 @@ If RECURSIVE, search recursively."
     (put-text-property 0 (length (car handle)) parameter value
                       (car handle))))
 
     (put-text-property 0 (length (car handle)) parameter value
                       (car handle))))
 

+(autoload 'mm-view-pkcs7 "mm-view")
+

 (defun mm-possibly-verify-or-decrypt (parts ctl)
   (let ((type (car ctl))
        (subtype (cadr (split-string (car ctl) "/")))
 (defun mm-possibly-verify-or-decrypt (parts ctl)
   (let ((type (car ctl))
        (subtype (cadr (split-string (car ctl) "/")))


@@ -1418,7 +1612,7 @@ If RECURSIVE, search recursively."
                           (format "protocol=%s" protocol))))))
        (save-excursion
          (if func
                           (format "protocol=%s" protocol))))))
        (save-excursion
          (if func

-             (funcall func parts ctl)
+             (setq parts (funcall func parts ctl))

            (mm-set-handle-multipart-parameter
             mm-security-handle 'gnus-details
             (format "Unknown sign protocol (%s)" protocol))))))
            (mm-set-handle-multipart-parameter
             mm-security-handle 'gnus-details
             (format "Unknown sign protocol (%s)" protocol))))))


@@ -1485,7 +1679,16 @@ If RECURSIVE, search recursively."
         (and (eq (mm-body-7-or-8) '7bit)
              (not (mm-long-lines-p 76))))))
 
         (and (eq (mm-body-7-or-8) '7bit)
              (not (mm-long-lines-p 76))))))
 

+(defun mm-shr (handle)
+  (let ((article-buffer (current-buffer)))
+    (unless handle
+      (setq handle (mm-dissect-buffer t)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (shr-insert-document
+       (mm-with-part handle
+        (libxml-parse-html-region (point-min) (point-max)))))))
+

 (provide 'mm-decode)
 
 (provide 'mm-decode)
 

-;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b

 ;;; mm-decode.el ends here
 ;;; mm-decode.el ends here