X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=d3c6b9c6b5fbb9fa432a6ac61c82239bc29e7349;hb=c3e1fa9581a5bfd59386b25a438fbb6650441f79;hp=06d6e2942d158ef841dc2a809a1b66ddfceeed88;hpb=9e55d90f33d181194f5e1799b895fc3289152490;p=elisp%2Fgnus.git-

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 06d6e29..d3c6b9c 100644
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,5 +1,5 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;	MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -48,63 +48,114 @@
   `(nth 6 ,handle))
 (defmacro mm-handle-set-cache (handle contents)
   `(setcar (nthcdr 6 ,handle) ,contents))
+(defmacro mm-handle-id (handle)
+  `(nth 7 ,handle))
 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
-				    disposition description cache)
+				    disposition description cache
+				    id)
   `(list ,buffer ,type ,encoding ,undisplayer
-	 ,disposition ,description ,cache))
+	 ,disposition ,description ,cache ,id))
 
 (defvar mm-inline-media-tests
-  '(("image/jpeg" mm-inline-image
-     (and window-system (featurep 'jpeg) (mm-image-fit-p handle)))
-    ("image/png" mm-inline-image
-     (and window-system (featurep 'png) (mm-image-fit-p handle)))
-    ("image/gif" mm-inline-image
-     (and window-system (featurep 'gif) (mm-image-fit-p handle)))
-    ("image/tiff" mm-inline-image
-     (and window-system (featurep 'tiff) (mm-image-fit-p handle)))
-    ("image/xbm" mm-inline-image
-     (and window-system (fboundp 'device-type)
-	  (eq (device-type) 'x)))
-    ("image/xpm" mm-inline-image
-     (and window-system (featurep 'xpm)))
-    ("image/x-pixmap" mm-inline-image
-     (and window-system (featurep 'xpm)))
-    ("image/bmp" mm-inline-image
-     (and window-system (featurep 'bmp)))
-    ("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"))
-    ("message/delivery-status" mm-inline-text t)
+  '(("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/html"
+     mm-inline-text
+     (lambda (handle)
+       (locate-library "w3")))
+    ("text/x-vcard"
+     mm-inline-text
+     (lambda (handle)
+       (locate-library "vcard")))
+    ("message/delivery-status" mm-inline-text identity)
+    ("message/rfc822" mm-inline-message identity)
+    ("text/.*" mm-inline-text identity)
     ("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))))
+     (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))))
+    ("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-user-display-methods
-  '(("image/.*" . inline)
-    ("text/.*" . inline)
-    ("message/delivery-status" . inline)))
+(defvar mm-inlined-types
+  '("image/.*" "text/.*" "message/delivery-status" "message/rfc822")
+  "List of media types that are to be displayed inline.")
+  
+(defvar mm-automatic-display
+  '("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-user-automatic-display
-  '("text/plain" "text/enriched" "text/richtext" "text/html" 
-    "image/.*" "message/delivery-status" "multipart/.*"))
+(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
+(defvar mm-automatic-external-display nil
   "List of MIME type regexps that will be displayed externally automatically.")
 
-(defvar mm-alternative-precedence
-  '("image/jpeg" "image/gif" "text/html" "text/enriched"
-    "text/richtext" "text/plain")
-  "List that describes the precedence of alternative parts.")
-
-(defvar mm-tmp-directory "/tmp/"
+(defvar 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,
+for instance, text/html parts are very unwanted, and text/richtech are
+somewhat unwanted, then the value of this variable should be set
+to:
+
+ (\"text/html\" \"text/richtext\")")
+
+(defvar mm-tmp-directory
+  (cond ((fboundp 'temp-directory) (temp-directory))
+	((boundp 'temporary-file-directory) temporary-file-directory)
+	("/tmp/"))
   "Where mm will store its temporary files.")
 
-(defvar mm-all-images-fit nil
+(defvar mm-inline-large-images nil
   "If non-nil, then all images fit in the buffer.")
 
 ;;; Internal variables.
@@ -124,18 +175,16 @@
 	(when (or no-strict-mime
 		  (mail-fetch-field "mime-version"))
 	  (setq ct (mail-fetch-field "content-type")
-		ctl (condition-case () (mail-header-parse-content-type ct)
-		      (error nil))
+		ctl (ignore-errors (mail-header-parse-content-type ct))
 		cte (mail-fetch-field "content-transfer-encoding")
 		cd (mail-fetch-field "content-disposition")
 		description (mail-fetch-field "content-description")
 		id (mail-fetch-field "content-id"))))
-      (if (not ctl)
+      (if (or (not ctl)
+	      (not (string-match "/" (car ctl))))
 	  (mm-dissect-singlepart
 	   '("text/plain") nil no-strict-mime
-	   (and cd (condition-case ()
-		       (mail-header-parse-content-disposition cd)
-		     (error nil)))
+	   (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
 	   description)
 	(setq type (split-string (car ctl) "/"))
 	(setq subtype (cadr type)
@@ -152,21 +201,19 @@
 					(mail-header-remove-comments
 					 cte)))))
 	    no-strict-mime
-	    (and cd (condition-case ()
-			(mail-header-parse-content-disposition cd)
-		      (error nil)))
-	    description))))
+	    (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
+	    description id))))
 	(when id
 	  (when (string-match " *<\\(.*\\)> *" id)
 	    (setq id (match-string 1 id)))
 	  (push (cons id result) mm-content-id-alist))
 	result))))
 
-(defun mm-dissect-singlepart (ctl cte &optional force cdl description)
+(defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
   (when (or force
 	    (not (equal "text/plain" (car ctl))))
     (let ((res (mm-make-handle
-		(mm-copy-to-buffer) ctl cte nil cdl description)))
+		(mm-copy-to-buffer) ctl cte nil cdl description nil id)))
       (push (car res) mm-dissection-list)
       res)))
 
@@ -180,8 +227,8 @@
   (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	
+	start parts
+	(end (save-excursion
 	       (goto-char (point-max))
 	       (if (re-search-backward close-delimiter nil t)
 		   (match-beginning 0)
@@ -214,10 +261,6 @@
       (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;
@@ -227,38 +270,34 @@ external if displayed external."
     (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)
+	     (method (mailcap-mime-info type)))
+	(if (mm-inlined-p handle)
 	    (progn
 	      (forward-line 1)
-	      (mm-display-inline handle))
-	  (when (or user-method
-		    method
+	      (mm-display-inline handle)
+	      'inline)
+	  (when (or method
 		    (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
-	       handle (or user-method method
-			  'mailcap-save-binary-file))
+	       handle (or method 'mailcap-save-binary-file))
 	      'external)))))))
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
   (mm-with-unibyte-buffer
-    (insert-buffer-substring (mm-handle-buffer handle))
-    (mm-decode-content-transfer-encoding
-     (mm-handle-encoding handle) (car (mm-handle-type handle)))
     (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)))
@@ -267,19 +306,26 @@ external if displayed external."
 	  (mm-set-buffer-file-coding-system mm-binary-coding-system)
 	  (insert-buffer-substring cur)
 	  (message "Viewing with %s" method)
-	  (let ((mm (current-buffer)))
+	  (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))
-	      (mm-handle-set-undisplayer handle mm))))
+	      (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)
+	     process file buffer)
 	;; We create a private sub-directory where we store our files.
 	(make-directory dir)
 	(set-file-modes dir 448)
@@ -297,11 +343,12 @@ external if displayed external."
 				     "-e" shell-file-name "-c"
 				     (format method
 					     (mm-quote-arg file)))
-		    (start-process "*display*" (generate-new-buffer "*mm*")
+		    (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 process)))
+	  (mm-handle-set-undisplayer handle (cons file buffer)))
 	(message "Displaying %s..." (format method file))))))
 
 (defun mm-remove-parts (handles)
@@ -340,30 +387,23 @@ external if displayed external."
   "Remove the displayed MIME part represented by HANDLE."
   (when (listp handle)
     (let ((object (mm-handle-undisplayer handle)))
-      (condition-case ()
-	  (cond
-	   ;; Internally displayed part.
-	   ((mm-annotationp object)
-	    (delete-annotation object))
-	   ((or (functionp object)
-		(and (listp object)
-		     (eq (car object) 'lambda)))
-	    (funcall object))
-	   ;; Externally displayed part.
-	   ((consp object)
-	    (condition-case ()
-		(delete-file (car object))
-	      (error nil))
-	    (condition-case ()
-		(delete-directory (file-name-directory (car object)))
-	      (error nil))
-	    (condition-case ()
-		(kill-process (cdr object))
-	      (error nil)))
-	   ((bufferp object)
-	    (when (buffer-live-p object)
-	      (kill-buffer object))))
-	(error nil))
+      (ignore-errors
+	(cond
+	 ;; Internally displayed part.
+	 ((mm-annotationp object)
+	  (delete-annotation object))
+	 ((or (functionp object)
+	      (and (listp object)
+		   (eq (car object) 'lambda)))
+	  (funcall object))
+	 ;; Externally displayed part.
+	 ((consp object)
+	  (ignore-errors (delete-file (car object)))
+	  (ignore-errors (delete-directory (file-name-directory (car object))))
+	  (ignore-errors (kill-buffer (cdr object))))
+	 ((bufferp object)
+	  (when (buffer-live-p object)
+	    (kill-buffer object)))))
       (mm-handle-set-undisplayer handle nil))))
 
 (defun mm-display-inline (handle)
@@ -372,44 +412,57 @@ external if displayed external."
     (funcall function handle)
     (goto-char (point-min))))
 
-(defun mm-inlinable-p (type)
-  "Say whether TYPE can be displayed inline."
+(defun mm-inlinable-p (handle)
+  "Say whether HANDLE can be displayed inline."
   (let ((alist mm-inline-media-tests)
+	(type (car (mm-handle-type handle)))
 	test)
     (while alist
       (when (equal type (caar alist))
 	(setq test (caddar alist)
 	      alist nil)
-	(setq test (eval test)))
+	(setq test (funcall test handle)))
       (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 (car (mm-handle-type handle)))
 	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 (string-match method type)
+		 (mm-inlinable-p handle))
+	(setq result t
+	      methods nil)))
     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 (car (mm-handle-type handle)))
 	method result)
     (while (setq method (pop methods))
       (when (and (string-match method type)
-		 (mm-inlinable-p type))
+		 (mm-inlinable-p handle))
 	(setq result t
 	      methods nil)))
     result))
 
+(defun mm-attachment-override-p (handle)
+  "Say whether HANDLE should have attachment behavior overridden."
+  (let ((types mm-attachment-override-types)
+	(type (car (mm-handle-type handle)))
+	ty)
+    (catch 'found
+      (while (setq ty (pop types))
+	(when (and (string-match ty type)
+		   (mm-inlinable-p handle))
+	  (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)
@@ -417,11 +470,6 @@ external if displayed external."
 	      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)
@@ -432,19 +480,6 @@ This overrides entries in the mailcap file."
 (defun mm-handle-displayed-p (handle)
   "Say whether HANDLE is displayed or not."
   (mm-handle-undisplayer handle))
-  
-(defun mm-quote-arg (arg)
-  "Return a version of ARG that is safe to evaluate in a shell."
-  (let ((pos 0) new-pos accum)
-    ;; *** bug: we don't handle newline characters properly
-    (while (setq new-pos (string-match "[;!`\"$\\& \t{} ]" arg pos))
-      (push (substring arg pos new-pos) accum)
-      (push "\\" accum)
-      (push (list (aref arg new-pos)) accum)
-      (setq pos (1+ new-pos)))
-    (if (= pos 0)
-        arg
-      (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
 
 ;;;
 ;;; Functions for outputting parts
@@ -453,12 +488,32 @@ This overrides entries in the mailcap file."
 (defun mm-get-part (handle)
   "Return the contents of HANDLE as a string."
   (mm-with-unibyte-buffer
-    (insert-buffer-substring (mm-handle-buffer handle))
-    (mm-decode-content-transfer-encoding
-     (mm-handle-encoding handle)
-     (car (mm-handle-type handle)))
+    (mm-insert-part 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 (car (split-string (car (mm-handle-type handle)) "/"))
+		  '("text" "message"))
+	  (with-temp-buffer
+	    (insert-buffer-substring (mm-handle-buffer handle))
+	    (mm-decode-content-transfer-encoding
+	     (mm-handle-encoding handle)
+	     (car (mm-handle-type handle)))
+	    (let ((temp (current-buffer)))
+	      (set-buffer cur)
+	      (insert-buffer-substring temp)))
+	(mm-with-unibyte-buffer
+	  (insert-buffer-substring (mm-handle-buffer handle))
+	  (mm-decode-content-transfer-encoding
+	   (mm-handle-encoding handle)
+	   (car (mm-handle-type handle)))
+	  (let ((temp (current-buffer)))
+	    (set-buffer cur)
+	    (insert-buffer-substring temp)))))))
+
 (defvar mm-default-directory nil)
 
 (defun mm-save-part (handle)
@@ -475,22 +530,31 @@ This overrides entries in the mailcap file."
 			   (or filename name "")
 			   (or mm-default-directory default-directory))))
     (setq mm-default-directory (file-name-directory file))
-    (mm-with-unibyte-buffer
-      (insert-buffer-substring (mm-handle-buffer handle))
-      (mm-decode-content-transfer-encoding
-       (mm-handle-encoding handle)
-       (car (mm-handle-type 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)))
-        (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)
+    ;; 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))))
 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."
@@ -498,10 +562,7 @@ This overrides entries in the mailcap file."
 	 (command
 	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
     (mm-with-unibyte-buffer
-      (insert-buffer-substring (mm-handle-buffer handle))
-      (mm-decode-content-transfer-encoding
-       (mm-handle-encoding handle)
-       (car (mm-handle-type handle)))
+      (mm-insert-part handle)
       (shell-command-on-region (point-min) (point-max) command nil))))
 
 (defun mm-interactively-view-part (handle)
@@ -515,7 +576,8 @@ This overrides entries in the mailcap file."
 
 (defun mm-preferred-alternative (handles &optional preferred)
   "Say which of HANDLES are preferred."
-  (let ((prec (if preferred (list preferred) mm-alternative-precedence))
+  (let ((prec (if preferred (list preferred)
+		(mm-preferred-alternative-precedence handles)))
 	p h result type handle)
     (while (setq p (pop prec))
       (setq h handles)
@@ -526,7 +588,7 @@ This overrides entries in the mailcap file."
 		(car (mm-handle-type (car h)))))
 	(setq handle (car h))
 	(when (and (equal p type)
-		   (mm-automatic-display-p type)
+		   (mm-automatic-display-p (car h))
 		   (or (stringp (caar h))
 		       (not (mm-handle-disposition (car h)))
 		       (equal (car (mm-handle-disposition (car h)))
@@ -537,6 +599,16 @@ This overrides entries in the mailcap file."
 	(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))))
+    (dolist (disc (reverse mm-discouraged-alternatives))
+      (dolist (elem (copy-sequence seq))
+	(when (string-match disc elem)
+	  (setq seq (nconc (delete elem seq) (list elem))))))
+    seq))
+
 (defun mm-get-content-id (id)
   "Return the handle(s) referred to by ID."
   (cdr (assoc id mm-content-id-alist)))
@@ -550,25 +622,54 @@ This overrides entries in the mailcap file."
 	  (cond
 	   ((equal type "x-pixmap")
 	    "xpm")
+	   ((equal type "x-xbitmap")
+	    "xbm")
 	   (t type)))
     (or (mm-handle-cache handle)
 	(mm-with-unibyte-buffer
-	  (insert-buffer-substring (mm-handle-buffer handle))
-	  (mm-decode-content-transfer-encoding
-	   (mm-handle-encoding handle)
-	   (car (mm-handle-type handle)))
+	  (mm-insert-part handle)
 	  (prog1
 	      (setq spec
-		    (make-glyph `[,(intern type) :data ,(buffer-string)]))
+		    (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)))))))
 	    (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
+    (or mm-inline-large-images
 	(and (< (glyph-width image) (window-pixel-width))
 	     (< (glyph-height image) (window-pixel-height))))))
 
+(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)))
+
+(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)
+       (mm-image-fit-p handle)))
+
 (provide 'mm-decode)
 
 ;; mm-decode.el ends here