Synch with `t-gnus-6_14'.

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

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 0b5f57f..19a79cd 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.
 

@@ -64,7 +75,7 @@
   `(list ,buffer ,type ,encoding ,undisplayer
         ,disposition ,description ,cache ,id))
 
   `(list ,buffer ,type ,encoding ,undisplayer
         ,disposition ,description ,cache ,id))
 

-(defvar mm-inline-media-tests
+(defcustom mm-inline-media-tests

   '(("image/jpeg"
      mm-inline-image
      (lambda (handle)
   '(("image/jpeg"
      mm-inline-image
      (lambda (handle)

@@ -104,6 +115,10 @@
     ("text/plain" mm-inline-text identity)
     ("text/enriched" mm-inline-text identity)
     ("text/richtext" mm-inline-text identity)
     ("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)
     ("text/html"
      mm-inline-text
      (lambda (handle)

@@ -111,9 +126,11 @@
     ("text/x-vcard"
      mm-inline-text
      (lambda (handle)
     ("text/x-vcard"
      mm-inline-text
      (lambda (handle)

-       (locate-library "vcard")))
+       (or (featurep 'vcard)
+          (locate-library "vcard"))))

     ("message/delivery-status" mm-inline-text identity)
     ("message/rfc822" mm-inline-message identity)
     ("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
      (lambda (handle)
     ("text/.*" mm-inline-text identity)
     ("audio/wav" mm-inline-audio
      (lambda (handle)

@@ -124,38 +141,60 @@
      (lambda (handle)
        (and (or (featurep 'nas-sound) (featurep 'native-sound))
            (device-sound-enabled-p))))
      (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))
     ("multipart/alternative" ignore identity)
     ("multipart/mixed" ignore identity)
     ("multipart/related" ignore identity))

-  "Alist of media types/test that say whether the media types can be displayed inline.")
-
-(defvar mm-inlined-types
-  '("image/.*" "text/.*" "message/delivery-status" "message/rfc822")
-  "List of media types that are to be displayed inline.")
+  "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)

   
   

-(defvar mm-automatic-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")
-  "A list of MIME types to be displayed automatically.")
-
-(defvar mm-attachment-override-types
-  '("text/plain" "text/x-vcard")
-  "Types that should have \"attachment\" ignored if they can be displayed inline.")
-
-(defvar mm-automatic-external-display nil
-  "List of MIME type regexps that will be displayed externally automatically.")
-
-(defvar mm-discouraged-alternatives nil
+    "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,
   "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,

-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))

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

-(defvar mm-inline-large-images 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.
 

@@ -172,6 +213,11 @@ 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")
+

 ;;; The functions.
 
 (defun mm-dissect-buffer (&optional no-strict-mime)
 ;;; The functions.
 
 (defun mm-dissect-buffer (&optional no-strict-mime)

@@ -188,10 +234,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) "/"))

@@ -201,7 +253,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

@@ -219,7 +274,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)

@@ -234,14 +291,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

@@ -293,95 +351,137 @@ external if displayed external."
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
              (mm-display-external
                  (mm-insert-inline handle (mm-get-part handle))
                  'inline)
              (mm-display-external

-              handle (or 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
-                                   (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)))
-            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"
-                                    (mm-mailcap-command
-                                     method file (mm-handle-type handle)))
-                   (start-process "*display*"
-                                  (setq buffer (generate-new-buffer "*mm*"))
-                                  shell-file-name
-                                  "-c"
-                                  (mm-mailcap-command
-                                   method file (mm-handle-type handle)))))
-         (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)
 (defun mm-mailcap-command (method file type-list)
   (let ((ctl (cdr type-list))
        (beg 0)

+       (uses-stdin t)

        out sub total)
        out sub total)

-    (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t" method beg)
+    (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
       (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")
        ((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)
        (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)
     (mapconcat 'identity (nreverse out) "")))
     
 (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)

@@ -389,6 +489,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)))

@@ -397,7 +498,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)

@@ -405,6 +506,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)))

@@ -437,17 +539,22 @@ external if displayed external."
 
 (defun mm-display-inline (handle)
   (let* ((type (mm-handle-media-type handle))
 
 (defun mm-display-inline (handle)
   (let* ((type (mm-handle-media-type handle))

-        (function (cadr (assoc type mm-inline-media-tests))))
+        (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-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)
        (type (mm-handle-media-type handle))
        test)
     (while alist
 (defun mm-inlinable-p (handle)
   "Say whether HANDLE can be displayed inline."
   (let ((alist mm-inline-media-tests)
        (type (mm-handle-media-type handle))
        test)
     (while alist

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

        (setq test (caddar alist)
              alist nil)
        (setq test (funcall test handle)))
        (setq test (caddar alist)
              alist nil)
        (setq test (funcall test handle)))

@@ -460,7 +567,8 @@ external if displayed external."
        (type (mm-handle-media-type handle))
        method result)
     (while (setq method (pop methods))
        (type (mm-handle-media-type handle))
        method result)
     (while (setq method (pop methods))

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

                 (mm-inlinable-p handle))
        (setq result t
              methods nil)))
                 (mm-inlinable-p handle))
        (setq result t
              methods nil)))

@@ -472,7 +580,8 @@ external if displayed external."
        (type (mm-handle-media-type handle))
        method result)
     (while (setq method (pop methods))
        (type (mm-handle-media-type handle))
        method result)
     (while (setq method (pop methods))

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

                 (mm-inlinable-p handle))
        (setq result t
              methods nil)))
                 (mm-inlinable-p handle))
        (setq result t
              methods nil)))

@@ -489,6 +598,16 @@ external if displayed external."
                   (mm-inlinable-p handle))
          (throw 'found t))))))
 
                   (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."
   (let ((methods mm-automatic-external-display)
 (defun mm-automatic-external-display-p (type)
   "Return the user-defined method for TYPE."
   (let ((methods mm-automatic-external-display)

@@ -526,7 +645,7 @@ external if displayed external."
     (save-excursion
       (if (member (mm-handle-media-supertype handle) '("text" "message"))
          (with-temp-buffer
     (save-excursion
       (if (member (mm-handle-media-supertype handle) '("text" "message"))
          (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-handle-media-type handle))
            (mm-decode-content-transfer-encoding
             (mm-handle-encoding handle)
             (mm-handle-media-type handle))

@@ -566,21 +685,13 @@ external if displayed external."
 (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)

-    ;; Now every coding system is 100% binary within mm-with-unibyte-buffer
-    ;; Is text still special?
-    (let ((coding-system-for-write
-          (if (equal "text" (mm-handle-media-supertype handle))
-              buffer-file-coding-system
-            'binary))
+    (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
          ;; 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.
+         ;; ange-ftp, which is reasonable to use here.

          (inhibit-file-name-operation 'write-region)
          (inhibit-file-name-handlers
          (inhibit-file-name-operation 'write-region)
          (inhibit-file-name-handlers

-          (if (equal (mm-handle-media-type handle)
-                     "application/octet-stream")
-              (cons 'jka-compr-handler inhibit-file-name-handlers)
-            inhibit-file-name-handlers)))
+          (cons 'jka-compr-handler inhibit-file-name-handlers)))

       (write-region (point-min) (point-max) file))))
 
 (defun mm-pipe-part (handle)
       (write-region (point-min) (point-max) file))))
 
 (defun mm-pipe-part (handle)

@@ -599,6 +710,10 @@ external if displayed external."
          (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
                  (mailcap-mime-info type 'all)))
         (method (completing-read "Viewer: " methods)))
          (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
                  (mailcap-mime-info type 'all)))
         (method (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)

@@ -624,9 +739,8 @@ external if displayed external."
     result))
 
 (defun mm-preferred-alternative-precedence (handles)
     result))
 
 (defun mm-preferred-alternative-precedence (handles)

-  "Return the precedence based on HANDLES and mm-discouraged-alternatives."
-  (let ((seq (nreverse (mapcar (lambda (h)
-                                (mm-handle-media-type h))
+  "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))
                               handles))))
     (dolist (disc (reverse mm-discouraged-alternatives))
       (dolist (elem (copy-sequence seq))

@@ -656,38 +770,60 @@ external if displayed external."
          (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-inline-large-images
-       (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."

@@ -697,4 +833,4 @@ external if displayed external."
 
 (provide 'mm-decode)
 
 
 (provide 'mm-decode)
 

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