Synch with Gnus.

[elisp/gnus.git-] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 375efd6..737eb9d 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,5 +1,5 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 ;;; mm-decode.el --- Functions for decoding MIME things

-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.

 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>

@@ -25,8 +25,19 @@
 ;;; Code:
 
 (require 'mail-parse)
 ;;; Code:
 
 (require 'mail-parse)

-(require 'mailcap)
+(require 'gnus-mailcap)

 (require 'mm-bodies)
 (require 'mm-bodies)

+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+  (autoload 'mm-inline-partial "mm-partial"))
+
+(defgroup mime-display ()
+  "Display of MIME in mail and news articles."
+  :link '(custom-manual "(emacs-mime)Customization")
+  :group 'mail
+  :group 'news
+  :group 'multimedia)

 
 ;;; Convenience macros.
 
 
 ;;; Convenience macros.
 

@@ -34,6 +45,14 @@
   `(nth 0 ,handle))
 (defmacro mm-handle-type (handle)
   `(nth 1 ,handle))
   `(nth 0 ,handle))
 (defmacro mm-handle-type (handle)
   `(nth 1 ,handle))

+(defsubst mm-handle-media-type (handle)
+  (if (stringp (car handle))
+      (car handle)
+    (car (mm-handle-type handle))))
+(defsubst mm-handle-media-supertype (handle)
+  (car (split-string (mm-handle-media-type handle) "/")))
+(defsubst mm-handle-media-subtype (handle)
+  (cadr (split-string (mm-handle-media-type handle) "/")))

 (defmacro mm-handle-encoding (handle)
   `(nth 2 ,handle))
 (defmacro mm-handle-undisplayer (handle)
 (defmacro mm-handle-encoding (handle)
   `(nth 2 ,handle))
 (defmacro mm-handle-undisplayer (handle)

@@ -56,63 +75,126 @@
   `(list ,buffer ,type ,encoding ,undisplayer
         ,disposition ,description ,cache ,id))
 
   `(list ,buffer ,type ,encoding ,undisplayer
         ,disposition ,description ,cache ,id))
 

-(defvar mm-inline-media-tests
-  '(("image/jpeg" mm-inline-image (mm-valid-and-fit-image-p 'jpeg handle))
-    ("image/png" mm-inline-image (mm-valid-and-fit-image-p 'png handle))
-    ("image/gif" mm-inline-image (mm-valid-and-fit-image-p 'gif handle))
-    ("image/tiff" mm-inline-image (mm-valid-and-fit-image-p 'tiff handle)) 
-    ("image/xbm" mm-inline-image (mm-valid-and-fit-image-p 'xbm handle))
-    ("image/x-xbitmap" mm-inline-image (mm-valid-and-fit-image-p 'xbm handle))
-    ("image/xpm" mm-inline-image (mm-valid-and-fit-image-p 'xpm handle))
-    ("image/x-pixmap" mm-inline-image (mm-valid-and-fit-image-p 'xpm handle))
-    ("image/bmp" mm-inline-image (mm-valid-and-fit-image-p 'bmp handle))
-    ("text/plain" mm-inline-text t)
-    ("text/enriched" mm-inline-text t)
-    ("text/richtext" mm-inline-text t)
-    ("text/html" mm-inline-text (locate-library "w3"))
-    ("text/x-vcard" mm-inline-text (locate-library "vcard"))
-    ("message/delivery-status" mm-inline-text t)
-    ("message/rfc822" mm-inline-message t)
-    ("text/.*" mm-inline-text t)
+(defcustom mm-inline-media-tests
+  '(("image/jpeg"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'jpeg handle)))
+    ("image/png"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'png handle)))
+    ("image/gif"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'gif handle)))
+    ("image/tiff"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'tiff handle)) )
+    ("image/xbm"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'xbm handle)))
+    ("image/x-xbitmap"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'xbm handle)))
+    ("image/xpm"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'xpm handle)))
+    ("image/x-pixmap"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'xpm handle)))
+    ("image/bmp"
+     mm-inline-image
+     (lambda (handle)
+       (mm-valid-and-fit-image-p 'bmp handle)))
+    ("text/plain" mm-inline-text identity)
+    ("text/enriched" mm-inline-text identity)
+    ("text/richtext" mm-inline-text identity)
+    ("text/x-patch" mm-display-patch-inline
+     (lambda (handle)
+       (locate-library "diff-mode")))
+    ("application/emacs-lisp" mm-display-elisp-inline identity)
+    ("text/html"
+     mm-inline-text
+     (lambda (handle)
+       (locate-library "w3")))
+    ("text/x-vcard"
+     mm-inline-text
+     (lambda (handle)
+       (or (featurep 'vcard)
+          (locate-library "vcard"))))
+    ("message/delivery-status" mm-inline-text identity)
+    ("message/rfc822" mm-inline-message identity)
+    ("message/partial" mm-inline-partial identity)
+    ("text/.*" mm-inline-text identity)

     ("audio/wav" mm-inline-audio
     ("audio/wav" mm-inline-audio

-     (and (or (featurep 'nas-sound) (featurep 'native-sound))
-         (device-sound-enabled-p)))
-    ("audio/au" mm-inline-audio
-     (and (or (featurep 'nas-sound) (featurep 'native-sound))
-         (device-sound-enabled-p)))
-    ("multipart/alternative" ignore t)
-    ("multipart/mixed" ignore t)
-    ("multipart/related" ignore t))
-  "Alist of media types/test that say whether the media types can be displayed inline.")
-
-(defvar mm-user-display-methods
-  '(("image/.*" . inline)
-    ("text/.*" . inline)
-    ("message/delivery-status" . inline)
-    ("message/rfc822" . inline)))
-
-(defvar mm-user-automatic-display
+     (lambda (handle)
+       (and (or (featurep 'nas-sound) (featurep 'native-sound))
+           (device-sound-enabled-p))))
+    ("audio/au"
+     mm-inline-audio
+     (lambda (handle)
+       (and (or (featurep 'nas-sound) (featurep 'native-sound))
+           (device-sound-enabled-p))))
+    ("application/pgp-signature" ignore identity)
+    ("multipart/alternative" ignore identity)
+    ("multipart/mixed" ignore identity)
+    ("multipart/related" ignore identity))
+  "Alist of media types/tests saying whether types can be displayed inline."
+  :type '(repeat (list (string :tag "MIME type")
+                      (function :tag "Display function")
+                      (function :tag "Display test")))
+  :group 'mime-display)
+
+(defcustom mm-inlined-types
+  '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
+    "message/partial" "application/emacs-lisp"
+    "application/pgp-signature")
+  "List of media types that are to be displayed inline."
+  :type '(repeat string)
+  :group 'mime-display)
+  
+(defcustom mm-automatic-display

   '("text/plain" "text/enriched" "text/richtext" "text/html"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
   '("text/plain" "text/enriched" "text/richtext" "text/html"
     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"

-    "message/rfc822"))
-
-(defvar mm-attachment-override-types
-  '("text/plain" "text/x-vcard")
-  "Types that should have \"attachment\" ignored if they can be displayed inline.")
-
-(defvar mm-user-automatic-external-display nil
-  "List of MIME type regexps that will be displayed externally automatically.")
-
-(defvar mm-discouraged-alternatives nil
-  "List of MIME types that are discouraged when viewing multiapart/alternative.
+    "message/rfc822" "text/x-patch" "application/pgp-signature" 
+    "application/emacs-lisp")
+  "A list of MIME types to be displayed automatically."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-attachment-override-types '("text/x-vcard")
+  "Types to have \"attachment\" ignored if they can be displayed inline."
+  :type '(repeat string)
+  :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)
+  :group 'mime-display)
+
+(defcustom mm-automatic-external-display nil
+  "List of MIME type regexps that will be displayed externally automatically."
+  :type '(repeat string)
+  :group 'mime-display)
+
+(defcustom mm-discouraged-alternatives nil
+  "List of MIME types that are discouraged when viewing multipart/alternative.

 Viewing agents are supposed to view the last possible part of a message,
 as that is supposed to be the richest.  However, users may prefer other
 types instead, and this list says what types are most unwanted.  If,
 Viewing agents are supposed to view the last possible part of a message,
 as that is supposed to be the richest.  However, users may prefer other
 types instead, and this list says what types are most unwanted.  If,

-for instance, text/html parts are very unwanted, and text/richtech are
+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\")")
+ (\"text/html\" \"text/richtext\")"
+  :type '(repeat string)
+  :group 'mime-display)

 
 (defvar mm-tmp-directory
   (cond ((fboundp 'temp-directory) (temp-directory))
 
 (defvar mm-tmp-directory
   (cond ((fboundp 'temp-directory) (temp-directory))

@@ -120,8 +202,10 @@ to:
        ("/tmp/"))
   "Where mm will store its temporary files.")
 
        ("/tmp/"))
   "Where mm will store its temporary files.")
 

-(defvar mm-all-images-fit nil
-  "If non-nil, then all images fit in the buffer.")
+(defcustom mm-inline-large-images nil
+  "If non-nil, then all images fit in the buffer."
+  :type 'boolean
+  :group 'mime-display)

 
 ;;; Internal variables.
 
 
 ;;; Internal variables.
 

@@ -129,6 +213,50 @@ to:
 (defvar mm-last-shell-command "")
 (defvar mm-content-id-alist nil)
 
 (defvar mm-last-shell-command "")
 (defvar mm-content-id-alist nil)
 

+;; According to RFC2046, in particular, in a digest, the default
+;; Content-Type value for a body part is changed from "text/plain" to
+;; "message/rfc822".
+(defvar mm-dissect-default-type "text/plain")
+
+(autoload 'mml2015-verify "mml2015")
+
+(defvar mm-verify-function-alist
+  '(("application/pgp-signature" . mml2015-verify)))
+
+(defcustom mm-verify-option nil
+  "Option of verifying signed parts.
+`never', not verify; `always', always verify; 
+`known', only verify known protocols. Otherwise, ask user."
+  :type '(choice (item always)
+                (item never)
+                (item :tag "only known protocols" known)
+                (item :tag "ask" nil))
+  :group 'gnus-article)
+
+(autoload 'mml2015-decrypt "mml2015")
+
+(defvar mm-decrypt-function-alist
+  '(("application/pgp-encrypted" . mml2015-decrypt)))
+
+(defcustom mm-decrypt-option nil
+  "Option of decrypting signed parts.
+`never', not decrypt; `always', always decrypt; 
+`known', only decrypt known protocols. Otherwise, ask user."
+  :type '(choice (item always)
+                (item never)
+                (item :tag "only known protocols" known)
+                (item :tag "ask" nil))
+  :group 'gnus-article)
+
+(defvar mm-viewer-completion-map
+  (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
+    (set-keymap-parent map minibuffer-local-completion-map)
+    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-dissect-buffer (&optional no-strict-mime)
 ;;; The functions.
 
 (defun mm-dissect-buffer (&optional no-strict-mime)

@@ -145,10 +273,16 @@ to:
                cd (mail-fetch-field "content-disposition")
                description (mail-fetch-field "content-description")
                id (mail-fetch-field "content-id"))))
                cd (mail-fetch-field "content-disposition")
                description (mail-fetch-field "content-description")
                id (mail-fetch-field "content-id"))))

+      (when cte
+       (setq cte (mail-header-strip cte)))

       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart

-          '("text/plain") nil no-strict-mime
+          (list mm-dissect-default-type)
+          (and cte (intern (downcase (mail-header-remove-whitespace
+                                      (mail-header-remove-comments
+                                       cte)))))
+          no-strict-mime

           (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
           description)
        (setq type (split-string (car ctl) "/"))
           (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
           description)
        (setq type (split-string (car ctl) "/"))

@@ -158,7 +292,10 @@ to:
         result
         (cond
          ((equal type "multipart")
         result
         (cond
          ((equal type "multipart")

-          (cons (car ctl) (mm-dissect-multipart ctl)))
+          (let ((mm-dissect-default-type (if (equal subtype "digest")
+                                             "message/rfc822"
+                                           "text/plain")))
+            (cons (car ctl) (mm-dissect-multipart ctl))))

          (t
           (mm-dissect-singlepart
            ctl
          (t
           (mm-dissect-singlepart
            ctl

@@ -176,7 +313,9 @@ to:
 
 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
   (when (or force
 
 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
   (when (or force

-           (not (equal "text/plain" (car ctl))))
+           (if (equal "text/plain" (car ctl))
+               (assoc 'format ctl)
+             t))

     (let ((res (mm-make-handle
                (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
       (push (car res) mm-dissection-list)
     (let ((res (mm-make-handle
                (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
       (push (car res) mm-dissection-list)

@@ -191,14 +330,15 @@ to:
 (defun mm-dissect-multipart (ctl)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
 (defun mm-dissect-multipart (ctl)
   (goto-char (point-min))
   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))

-       (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
-       start parts
-       (end (save-excursion
-              (goto-char (point-max))
-              (if (re-search-backward close-delimiter nil t)
-                  (match-beginning 0)
-                (point-max)))))
-    (while (search-forward boundary end t)
+        (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+        start parts
+        (end (save-excursion
+               (goto-char (point-max))
+               (if (re-search-backward close-delimiter nil t)
+                   (match-beginning 0)
+                 (point-max)))))
+    (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
+    (while (re-search-forward boundary end t)

       (goto-char (match-beginning 0))
       (when start
        (save-excursion
       (goto-char (match-beginning 0))
       (when start
        (save-excursion

@@ -212,7 +352,7 @@ to:
        (save-restriction
          (narrow-to-region start end)
          (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
        (save-restriction
          (narrow-to-region start end)
          (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))

-    (nreverse 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."
 
 (defun mm-copy-to-buffer ()
   "Copy the contents of the current buffer to a fresh buffer."

@@ -226,10 +366,6 @@ to:
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 

-(defun mm-inlinable-part-p (type)
-  "Say whether TYPE can be displayed inline."
-  (eq (mm-user-method type) '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;
 (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;

@@ -238,94 +374,153 @@ 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 (car (mm-handle-type handle)))
-            (method (mailcap-mime-info type))
-            (user-method (mm-user-method type)))
-       (if (eq user-method 'inline)
+      (let* ((type (mm-handle-media-type handle))
+            (method (mailcap-mime-info type)))
+       (if (mm-inlined-p handle)

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

-         (when (or user-method
-                   method
+         (when (or method

                    (not no-default))
                    (not no-default))

-           (if (and (not user-method)
-                    (not method)
+           (if (and (not method)

                     (equal "text" (car (split-string type))))
                (progn
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
              (mm-display-external
                     (equal "text" (car (split-string type))))
                (progn
                  (forward-line 1)
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
              (mm-display-external

-              handle (or user-method method
-                         'mailcap-save-binary-file))
-             'external)))))))
+              handle (or method 'mailcap-save-binary-file)))))))))

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

-  (mm-with-unibyte-buffer
-    (if (functionp method)
-       (let ((cur (current-buffer)))
-         (if (eq method 'mailcap-save-binary-file)
-             (progn
-               (set-buffer (generate-new-buffer "*mm*"))
-               (setq method nil))
-           (mm-insert-part handle)
-           (let ((win (get-buffer-window cur t)))
-             (when win
-               (select-window win)))
-           (switch-to-buffer (generate-new-buffer "*mm*")))
-         (buffer-disable-undo)
-         (mm-set-buffer-file-coding-system mm-binary-coding-system)
-         (insert-buffer-substring cur)
+  (let ((outbuf (current-buffer)))
+    (mm-with-unibyte-buffer
+      (if (functionp method)
+         (let ((cur (current-buffer)))
+           (if (eq method 'mailcap-save-binary-file)
+               (progn
+                 (set-buffer (generate-new-buffer "*mm*"))
+                 (setq method nil))
+             (mm-insert-part handle)
+             (let ((win (get-buffer-window cur t)))
+               (when win
+                 (select-window win)))
+             (switch-to-buffer (generate-new-buffer "*mm*")))
+           (buffer-disable-undo)
+           (mm-set-buffer-file-coding-system mm-binary-coding-system)
+           (insert-buffer-substring cur)
+           (goto-char (point-min))
+           (message "Viewing with %s" method)
+           (let ((mm (current-buffer))
+                 (non-viewer (assq 'non-viewer
+                                   (mailcap-mime-info
+                                    (mm-handle-media-type handle) t))))
+             (unwind-protect
+                 (if method
+                     (funcall method)
+                   (mm-save-part handle))
+               (when (and (not non-viewer)
+                          method)
+                 (mm-handle-set-undisplayer handle mm)))))
+       ;; The function is a string to be executed.
+       (mm-insert-part handle)
+       (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
+              (filename (mail-content-type-get
+                         (mm-handle-disposition handle) 'filename))
+              (mime-info (mailcap-mime-info
+                          (mm-handle-media-type handle) t))
+              (needsterm (or (assoc "needsterm" mime-info)
+                             (assoc "needsterminal" mime-info)))
+              (copiousoutput (assoc "copiousoutput" mime-info))
+              file buffer)
+         ;; We create a private sub-directory where we store our files.
+         (make-directory dir)
+         (set-file-modes dir 448)
+         (if filename
+             (setq file (expand-file-name (file-name-nondirectory filename)
+                                          dir))
+           (setq file (make-temp-name (expand-file-name "mm." dir))))
+         (let ((coding-system-for-write mm-binary-coding-system))
+           (write-region (point-min) (point-max) file nil 'nomesg))

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

-         (let ((mm (current-buffer))
-               (non-viewer (assoc "non-viewer"
-                                  (mailcap-mime-info
-                                   (car (mm-handle-type handle)) t))))
-           (unwind-protect
-               (if method
-                   (funcall method)
-                 (mm-save-part handle))
-             (when (and (not non-viewer)
-                        method)
-               (mm-handle-set-undisplayer handle mm)))))
-      ;; The function is a string to be executed.
-      (mm-insert-part handle)
-      (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
-            (filename (mail-content-type-get
-                       (mm-handle-disposition handle) 'filename))
-            (needsterm (assoc "needsterm"
-                              (mailcap-mime-info
-                               (car (mm-handle-type handle)) t)))
-            process file buffer)
-       ;; We create a private sub-directory where we store our files.
-       (make-directory dir)
-       (set-file-modes dir 448)
-       (if filename
-           (setq file (expand-file-name (file-name-nondirectory filename)
-                                        dir))
-         (setq file (make-temp-name (expand-file-name "mm." dir))))
-       (write-region (point-min) (point-max) file nil 'nomesg)
-       (message "Viewing with %s" method)
-       (unwind-protect
-           (setq process
-                 (if needsterm
-                     (start-process "*display*" nil
-                                    "xterm"
-                                    "-e" shell-file-name "-c"
-                                    (format method
-                                            (mm-quote-arg file)))
-                   (start-process "*display*"
-                                  (setq buffer (generate-new-buffer "*mm*"))
-                                  shell-file-name
-                                  "-c" (format method
-                                               (mm-quote-arg file)))))
-         (mm-handle-set-undisplayer handle (cons file buffer)))
-       (message "Displaying %s..." (format method file))))))
-
+         (cond (needsterm
+                (unwind-protect
+                    (start-process "*display*" nil
+                                   "xterm"
+                                   "-e" shell-file-name
+                                   shell-command-switch
+                                   (mm-mailcap-command
+                                    method file (mm-handle-type handle)))
+                  (mm-handle-set-undisplayer handle (cons file buffer)))
+                (message "Displaying %s..." (format method file))
+                'external)
+               (copiousoutput
+                (with-current-buffer outbuf
+                  (forward-line 1)
+                  (mm-insert-inline
+                   handle
+                   (unwind-protect
+                       (progn
+                         (call-process shell-file-name nil
+                                       (setq buffer
+                                             (generate-new-buffer "*mm*"))
+                                       nil
+                                       shell-command-switch
+                                       (mm-mailcap-command
+                                        method file (mm-handle-type handle)))
+                         (if (buffer-live-p buffer)
+                             (save-excursion
+                               (set-buffer buffer)
+                               (buffer-string))))
+                     (progn
+                       (ignore-errors (delete-file file))
+                       (ignore-errors (delete-directory
+                                       (file-name-directory file)))
+                       (ignore-errors (kill-buffer buffer))))))
+                'inline)
+               (t
+                (unwind-protect
+                    (start-process "*display*"
+                                   (setq buffer
+                                         (generate-new-buffer "*mm*"))
+                                   shell-file-name
+                                   shell-command-switch
+                                   (mm-mailcap-command
+                                    method file (mm-handle-type handle)))
+                  (mm-handle-set-undisplayer handle (cons file buffer)))
+                (message "Displaying %s..." (format method file))
+                'external)))))))
+  
+(defun mm-mailcap-command (method file type-list)
+  (let ((ctl (cdr type-list))
+       (beg 0)
+       (uses-stdin t)
+       out sub total)
+    (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
+      (push (substring method beg (match-beginning 0)) out)
+      (setq beg (match-end 0)
+           total (match-string 0 method)
+           sub (match-string 1 method))
+      (cond
+       ((string= total "%%")
+       (push "%" out))
+       ((string= total "%s")
+       (setq uses-stdin nil)
+       (push (mm-quote-arg file) out))
+       ((string= total "%t")
+       (push (mm-quote-arg (car type-list)) out))
+       (t
+       (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
+    (push (substring method beg (length method)) out)
+    (if uses-stdin
+       (progn
+         (push "<" out)
+         (push (mm-quote-arg file) out)))
+    (mapconcat 'identity (nreverse out) "")))
+    

 (defun mm-remove-parts (handles)
 (defun mm-remove-parts (handles)

-  "Remove the displayed MIME parts represented by HANDLE."
+  "Remove the displayed MIME parts represented by HANDLES."

   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-remove-part handles)
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-remove-part handles)

@@ -333,6 +528,7 @@ external if displayed external."
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)

+         ;; Do nothing.

          )
         ((and (listp handle)
               (stringp (car handle)))
          )
         ((and (listp handle)
               (stringp (car handle)))

@@ -341,7 +537,7 @@ external if displayed external."
          (mm-remove-part handle)))))))
 
 (defun mm-destroy-parts (handles)
          (mm-remove-part handle)))))))
 
 (defun mm-destroy-parts (handles)

-  "Remove the displayed MIME parts represented by HANDLE."
+  "Remove the displayed MIME parts represented by HANDLES."

   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-destroy-part handles)
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-destroy-part handles)

@@ -349,6 +545,7 @@ external if displayed external."
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)
       (while (setq handle (pop handles))
        (cond
         ((stringp handle)

+         ;; Do nothing.

          )
         ((and (listp handle)
               (stringp (car handle)))
          )
         ((and (listp handle)
               (stringp (car handle)))

@@ -380,59 +577,79 @@ external if displayed external."
       (mm-handle-set-undisplayer handle nil))))
 
 (defun mm-display-inline (handle)
       (mm-handle-set-undisplayer handle nil))))
 
 (defun mm-display-inline (handle)

-  (let* ((type (car (mm-handle-type handle)))
-        (function (cadr (assoc type mm-inline-media-tests))))
+  (let* ((type (mm-handle-media-type handle))
+        (function (cadr (mm-assoc-string-match mm-inline-media-tests type))))

     (funcall function handle)
     (goto-char (point-min))))
 
     (funcall function handle)
     (goto-char (point-min))))
 

-(defun mm-inlinable-p (type)
-  "Say whether TYPE can be displayed inline."
+(defun mm-assoc-string-match (alist type)
+  (dolist (elem alist)
+    (when (string-match (car elem) type)
+      (return elem))))
+
+(defun mm-inlinable-p (handle)
+  "Say whether HANDLE can be displayed inline."

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

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

        test)
     (while alist
        test)
     (while alist

-      (when (equal type (caar alist))
+      (when (string-match (caar alist) type)

        (setq test (caddar alist)
              alist nil)
        (setq test (caddar alist)
              alist nil)

-       (setq test (eval test)))
+       (setq test (funcall test handle)))

       (pop alist))
     test))
 
       (pop alist))
     test))
 

-(defun mm-user-method (type)
-  "Return the user-defined method for TYPE."
-  (let ((methods mm-user-display-methods)
+(defun mm-automatic-display-p (handle)
+  "Say whether the user wants HANDLE to be displayed automatically."
+  (let ((methods mm-automatic-display)
+       (type (mm-handle-media-type handle))

        method result)
     (while (setq method (pop methods))
        method result)
     (while (setq method (pop methods))

-      (when (string-match (car method) type)
-       (when (or (not (eq (cdr method) 'inline))
-                 (mm-inlinable-p type))
-         (setq result (cdr method)
-               methods nil))))
+      (when (and (not (mm-inline-override-p handle))
+                (string-match method type)
+                (mm-inlinable-p handle))
+       (setq result t
+             methods nil)))

     result))
 
     result))
 

-(defun mm-automatic-display-p (type)
-  "Return the user-defined method for TYPE."
-  (let ((methods mm-user-automatic-display)
+(defun mm-inlined-p (handle)
+  "Say whether the user wants HANDLE to be displayed automatically."
+  (let ((methods mm-inlined-types)
+       (type (mm-handle-media-type handle))

        method result)
     (while (setq method (pop methods))
        method result)
     (while (setq method (pop methods))

-      (when (and (string-match method type)
-                (mm-inlinable-p type))
+      (when (and (not (mm-inline-override-p handle))
+                (string-match method type)
+                (mm-inlinable-p handle))

        (setq result t
              methods nil)))
     result))
 
        (setq result t
              methods nil)))
     result))
 

-(defun mm-attachment-override-p (type)
-  "Say whether TYPE should have attachment behavior overridden."
+(defun mm-attachment-override-p (handle)
+  "Say whether HANDLE should have attachment behavior overridden."

   (let ((types mm-attachment-override-types)
   (let ((types mm-attachment-override-types)

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

        ty)
     (catch 'found
       (while (setq ty (pop types))
        (when (and (string-match ty type)
        ty)
     (catch 'found
       (while (setq ty (pop types))
        (when (and (string-match ty type)

-                  (mm-inlinable-p type))
+                  (mm-inlinable-p handle))
+         (throw 'found t))))))
+
+(defun mm-inline-override-p (handle)
+  "Say whether HANDLE should have inline behavior overridden."
+  (let ((types mm-inline-override-types)
+       (type (mm-handle-media-type handle))
+       ty)
+    (catch 'found
+      (while (setq ty (pop types))
+       (when (string-match ty type)

          (throw 'found t))))))
 
 (defun mm-automatic-external-display-p (type)
   "Return the user-defined method for TYPE."
          (throw 'found t))))))
 
 (defun mm-automatic-external-display-p (type)
   "Return the user-defined method for TYPE."

-  (let ((methods mm-user-automatic-external-display)
+  (let ((methods mm-automatic-external-display)

        method result)
     (while (setq method (pop methods))
       (when (string-match method type)
        method result)
     (while (setq method (pop methods))
       (when (string-match method type)

@@ -440,11 +657,6 @@ external if displayed external."
              methods nil)))
     result))
 
              methods nil)))
     result))
 

-(defun add-mime-display-method (type method)
-  "Make parts of TYPE be displayed with METHOD.
-This overrides entries in the mailcap file."
-  (push (cons type method) mm-user-display-methods))
-

 (defun mm-destroy-part (handle)
   "Destroy the data structures connected to HANDLE."
   (when (listp handle)
 (defun mm-destroy-part (handle)
   "Destroy the data structures connected to HANDLE."
   (when (listp handle)

@@ -470,13 +682,12 @@ This overrides entries in the mailcap file."
   "Insert the contents of HANDLE in the current buffer."
   (let ((cur (current-buffer)))
     (save-excursion
   "Insert the contents of HANDLE in the current buffer."
   (let ((cur (current-buffer)))
     (save-excursion

-      (if (member (car (split-string (car (mm-handle-type handle)) "/"))
-                 '("text" "message"))
+      (if (member (mm-handle-media-supertype handle) '("text" "message"))

          (with-temp-buffer
          (with-temp-buffer

-           (insert-buffer-substring (mm-handle-buffer handle))
+           (insert-buffer-substring (mm-handle-buffer handle))

            (mm-decode-content-transfer-encoding
             (mm-handle-encoding handle)
            (mm-decode-content-transfer-encoding
             (mm-handle-encoding handle)

-            (car (mm-handle-type handle)))
+            (mm-handle-media-type handle))

            (let ((temp (current-buffer)))
              (set-buffer cur)
              (insert-buffer-substring temp)))
            (let ((temp (current-buffer)))
              (set-buffer cur)
              (insert-buffer-substring temp)))

@@ -484,7 +695,7 @@ This overrides entries in the mailcap file."
          (insert-buffer-substring (mm-handle-buffer handle))
          (mm-decode-content-transfer-encoding
           (mm-handle-encoding handle)
          (insert-buffer-substring (mm-handle-buffer handle))
          (mm-decode-content-transfer-encoding
           (mm-handle-encoding handle)

-          (car (mm-handle-type handle)))
+          (mm-handle-media-type handle))

          (let ((temp (current-buffer)))
            (set-buffer cur)
            (insert-buffer-substring temp)))))))
          (let ((temp (current-buffer)))
            (set-buffer cur)
            (insert-buffer-substring temp)))))))

@@ -505,28 +716,22 @@ This overrides entries in the mailcap file."
                           (or filename name "")
                           (or mm-default-directory default-directory))))
     (setq mm-default-directory (file-name-directory file))
                           (or filename name "")
                           (or mm-default-directory default-directory))))
     (setq mm-default-directory (file-name-directory file))

-    (mm-with-unibyte-buffer
-      (mm-insert-part handle)
-      (when (or (not (file-exists-p file))
-               (yes-or-no-p (format "File %s already exists; overwrite? "
-                                    file)))
-       ;; Now every coding system is 100% binary within mm-with-unibyte-buffer
-       ;; Is text still special?
-       (let ((coding-system-for-write
-              (if (equal "text" (car (split-string
-                                      (car (mm-handle-type handle)) "/")))
-                  buffer-file-coding-system
-                'binary))
-             ;; Don't re-compress .gz & al.  Arguably we should make
-             ;; `file-name-handler-alist' nil, but that would chop
-             ;; ange-ftp which it's reasonable to use here.
-             (inhibit-file-name-operation 'write-region)
-             (inhibit-file-name-handlers
-              (if (equal (car (mm-handle-type handle))
-                         "application/octet-stream")
-                  (cons 'jka-compr-handler inhibit-file-name-handlers)
-                inhibit-file-name-handlers)))
-         (write-region (point-min) (point-max) file))))))
+    (when (or (not (file-exists-p file))
+             (yes-or-no-p (format "File %s already exists; overwrite? "
+                                  file)))
+      (mm-save-part-to-file handle file))))
+
+(defun mm-save-part-to-file (handle file)
+  (mm-with-unibyte-buffer
+    (mm-insert-part handle)
+    (let ((coding-system-for-write 'binary)
+         ;; 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)))
+      (write-region (point-min) (point-max) file))))

 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."
 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."

@@ -539,11 +744,17 @@ This overrides entries in the mailcap file."
 
 (defun mm-interactively-view-part (handle)
   "Display HANDLE using METHOD."
 
 (defun mm-interactively-view-part (handle)
   "Display HANDLE using METHOD."

-  (let* ((type (car (mm-handle-type handle)))
+  (let* ((type (mm-handle-media-type handle))

         (methods
          (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
                  (mailcap-mime-info type 'all)))
         (methods
          (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
                  (mailcap-mime-info type 'all)))

-        (method (completing-read "Viewer: " methods)))
+        (method (let ((minibuffer-local-completion-map
+                       mm-viewer-completion-map))
+                  (completing-read "Viewer: " methods))))
+    (when (string= method "")
+      (error "No method given"))
+    (if (string-match "^[^% \t]+$" method) 
+       (setq method (concat method " %s")))

     (mm-display-external (copy-sequence handle) method)))
 
 (defun mm-preferred-alternative (handles &optional preferred)
     (mm-display-external (copy-sequence handle) method)))
 
 (defun mm-preferred-alternative (handles &optional preferred)

@@ -554,27 +765,24 @@ This overrides entries in the mailcap file."
     (while (setq p (pop prec))
       (setq h handles)
       (while h
     (while (setq p (pop prec))
       (setq h handles)
       (while h

-       (setq type
-             (if (stringp (caar h))
-                 (caar h)
-               (car (mm-handle-type (car h)))))

        (setq handle (car h))
        (setq handle (car h))

+       (setq type (mm-handle-media-type handle))

        (when (and (equal p type)
        (when (and (equal p type)

-                  (mm-automatic-display-p type)
-                  (or (stringp (caar h))
-                      (not (mm-handle-disposition (car h)))
-                      (equal (car (mm-handle-disposition (car h)))
+                  (mm-automatic-display-p handle)
+                  (or (stringp (car handle))
+                      (not (mm-handle-disposition handle))
+                      (equal (car (mm-handle-disposition handle))

                              "inline")))
                              "inline")))

-         (setq result (car h)
+         (setq result handle

                h nil
                prec nil))
        (pop h)))
     result))
 
 (defun mm-preferred-alternative-precedence (handles)
                h nil
                prec nil))
        (pop h)))
     result))
 
 (defun mm-preferred-alternative-precedence (handles)

-  "Return the precedence based on HANDLES and mm-discouraged-alternatives."
-  (let ((seq (nreverse (mapcar (lambda (h)
-                                (car (mm-handle-type h))) handles))))
+  "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
+  (let ((seq (nreverse (mapcar #'mm-handle-media-type
+                              handles))))

     (dolist (disc (reverse mm-discouraged-alternatives))
       (dolist (elem (copy-sequence seq))
        (when (string-match disc elem)
     (dolist (disc (reverse mm-discouraged-alternatives))
       (dolist (elem (copy-sequence seq))
        (when (string-match disc elem)

@@ -587,7 +795,7 @@ This overrides entries in the mailcap file."
 
 (defun mm-get-image (handle)
   "Return an image instance based on HANDLE."
 
 (defun mm-get-image (handle)
   "Return an image instance based on HANDLE."

-  (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+  (let ((type (mm-handle-media-subtype handle))

        spec)
     ;; Allow some common translations.
     (setq type
        spec)
     ;; Allow some common translations.
     (setq type

@@ -603,45 +811,159 @@ This overrides entries in the mailcap file."
          (prog1
              (setq spec
                    (ignore-errors
          (prog1
              (setq spec
                    (ignore-errors

-                     (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 (make-temp-name
-                                    (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 (intern type) :data (buffer-string)))))))
+                    ;; Avoid testing `make-glyph' since W3 may define
+                    ;; a bogus version of it.
+                     (if (fboundp 'create-image)
+                         (create-image (buffer-string) (intern type) 'data-p)
+                       (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 (make-temp-name
+                                      (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 (intern type) :data (buffer-string))))))))

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

-    (or mm-all-images-fit
-       (and (< (glyph-width image) (window-pixel-width))
-            (< (glyph-height image) (window-pixel-height))))))
+    (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))))))))

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

-  (and (fboundp 'valid-image-instantiator-format-p)
-       (valid-image-instantiator-format-p format)))
+  (cond
+   ;; Handle XEmacs
+   ((fboundp 'valid-image-instantiator-format-p)
+    (valid-image-instantiator-format-p format))
+   ;; Handle Emacs 21
+   ((fboundp 'image-type-available-p)
+    (and (display-graphic-p)
+        (image-type-available-p format)))
+   ;; Nobody else can do images yet.
+   (t
+    nil)))

 
 (defun mm-valid-and-fit-image-p (format handle)
   "Say whether FORMAT can be displayed natively and HANDLE fits the window."
 
 (defun mm-valid-and-fit-image-p (format handle)
   "Say whether FORMAT can be displayed natively and HANDLE fits the window."

-  (and window-system
-       (mm-valid-image-format-p format)
+  (and (mm-valid-image-format-p format)

        (mm-image-fit-p handle)))
 
        (mm-image-fit-p handle)))
 

+(defun mm-find-part-by-type (handles type &optional notp) 
+  (let (handle)
+    (while handles
+      (if (if notp
+             (not (equal (mm-handle-media-type (car handles)) type))
+           (equal (mm-handle-media-type (car handles)) type))
+         (setq handle (car handles)
+               handles nil))
+      (setq handles (cdr handles)))
+    handle))
+
+(defun mm-find-raw-part-by-type (ctl type &optional notp) 
+  (goto-char (point-min))
+  (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
+        (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+        start
+        (end (save-excursion
+               (goto-char (point-max))
+               (if (re-search-backward close-delimiter nil t)
+                   (match-beginning 0)
+                 (point-max))))
+        result)
+    (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
+    (while (and (not result)
+               (re-search-forward boundary end t))
+      (goto-char (match-beginning 0))
+      (when start
+       (save-excursion
+         (save-restriction
+           (narrow-to-region start (point))
+           (when (let ((ctl (ignore-errors 
+                              (mail-header-parse-content-type 
+                               (mail-fetch-field "content-type")))))
+                   (if notp
+                       (not (equal (car ctl) type))
+                     (equal (car ctl) type)))
+             (setq result (buffer-substring (point-min) (point-max)))))))
+      (forward-line 2)
+      (setq start (point)))
+    (when (and (not result) start)
+      (save-excursion
+       (save-restriction
+         (narrow-to-region start end)
+         (when (let ((ctl (ignore-errors 
+                            (mail-header-parse-content-type 
+                             (mail-fetch-field "content-type")))))
+                 (if notp
+                     (not (equal (car ctl) type))
+                   (equal (car ctl) type)))
+           (setq result (buffer-substring (point-min) (point-max)))))))
+    result))
+
+(defun mm-possibly-verify-or-decrypt (parts ctl)
+  (let ((subtype (cadr (split-string (car ctl) "/")))
+       protocol func)
+    (cond 
+     ((equal subtype "signed")
+      (setq protocol (mail-content-type-get ctl 'protocol))
+      (setq func (cdr (assoc protocol mm-verify-function-alist)))
+      (if (cond
+          ((eq mm-verify-option 'never) nil)
+          ((eq mm-verify-option 'always) t)
+          ((eq mm-verify-option 'known) func)
+          (t (y-or-n-p 
+              (format "Verify signed part(protocol=%s)?" protocol))))
+         (condition-case err
+             (save-excursion
+               (if func
+                   (funcall func parts ctl)
+                 (error (format "Unknown sign protocol(%s)" protocol))))
+           (error
+            (unless (y-or-n-p (format "%s, continue?" err))
+              (error "Verify failure."))))))
+     ((equal subtype "encrypted")
+      (setq protocol (mail-content-type-get ctl 'protocol))
+      (setq func (cdr (assoc protocol mm-decrypt-function-alist)))
+      (if (cond
+          ((eq mm-decrypt-option 'never) nil)
+          ((eq mm-decrypt-option 'always) t)
+          ((eq mm-decrypt-option 'known) func)
+          (t (y-or-n-p 
+              (format "Decrypt part (protocol=%s)?" protocol))))
+         (condition-case err
+             (save-excursion
+               (if func
+                   (setq parts (funcall func parts ctl))
+                 (error (format "Unknown encrypt protocol(%s)" protocol))))
+           (error
+            (unless (y-or-n-p (format "%s, continue?" err))
+              (error "Decrypt failure."))))))
+     (t nil))
+    parts))
+

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

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