X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-decode.el;h=79fcadbfe4b446aaed2631940db10c6991094256;hb=9bff3e1ed66aee0c93773573fc662b10c4b72a1b;hp=4c4d23f7a8283424d2991c097c1ca2ee1d2ecacb;hpb=04c881031d5fb4ede1c190fe88f6b84c1663b66e;p=gnus

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 4c4d23f7a..79fcadbfe 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>
@@ -24,69 +24,164 @@
 
 ;;; Code:
 
-(require 'drums)
+(require 'mail-parse)
 (require 'mailcap)
 (require 'mm-bodies)
 
+;;; Convenience macros.
+
+(defmacro mm-handle-buffer (handle)
+  `(nth 0 ,handle))
+(defmacro mm-handle-type (handle)
+  `(nth 1 ,handle))
+(defmacro mm-handle-encoding (handle)
+  `(nth 2 ,handle))
+(defmacro mm-handle-undisplayer (handle)
+  `(nth 3 ,handle))
+(defmacro mm-handle-set-undisplayer (handle function)
+  `(setcar (nthcdr 3 ,handle) ,function))
+(defmacro mm-handle-disposition (handle)
+  `(nth 4 ,handle))
+(defmacro mm-handle-description (handle)
+  `(nth 5 ,handle))
+(defmacro mm-handle-cache (handle)
+  `(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
+				    id)
+  `(list ,buffer ,type ,encoding ,undisplayer
+	 ,disposition ,description ,cache ,id))
+
 (defvar mm-inline-media-tests
-  '(("image/jpeg" mm-inline-image (featurep 'jpeg))
-    ("image/png" mm-inline-image (featurep 'png))
-    ("image/gif" mm-inline-image (featurep 'gif))
-    ("image/tiff" mm-inline-image (featurep 'tiff))
-    ("image/xbm" mm-inline-image (eq (device-type) 'x))
-    ("image/xpm" mm-inline-image (featurep 'xpm))
-    ("image/bmp" mm-inline-image (featurep 'bmp))
+  '(("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/x-xbitmap" 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/html" mm-inline-text (featurep 'w3))
+    ("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)
+    ("text/.*" mm-inline-text t)
     ("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))))
+	  (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)))
+    ("text/.*" . inline)
+    ("message/delivery-status" . inline)))
 
 (defvar mm-user-automatic-display
-  '("text/plain" "image/gif"))
-
-(defvar mm-tmp-directory "/tmp/"
+  '("text/plain" "text/enriched" "text/richtext" "text/html"
+    "text/x-vcard" "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
+  "List of MIME type regexps that will be displayed externally automatically.")
+
+(defvar mm-alternative-precedence
+  '("multipart/related" "multipart/mixed" "multipart/alternative"
+    "image/jpeg" "image/gif" "text/html" "text/enriched"
+    "text/richtext" "text/plain")
+  "List that describes the precedence of alternative parts.")
+
+(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
+  "If non-nil, then all images fit in the buffer.")
+
 ;;; Internal variables.
 
 (defvar mm-dissection-list nil)
 (defvar mm-last-shell-command "")
+(defvar mm-content-id-alist nil)
+
+;;; The functions.
 
 (defun mm-dissect-buffer (&optional no-strict-mime)
   "Dissect the current buffer and return a list of MIME handles."
   (save-excursion
-    (let (ct ctl type subtype cte)
+    (let (ct ctl type subtype cte cd description id result)
       (save-restriction
-	(drums-narrow-to-header)
-	(when (and (or no-strict-mime
-		       (mail-fetch-field "mime-version"))
-		   (setq ct (mail-fetch-field "content-type")))
-	  (setq ctl (drums-parse-content-type ct))
-	  (setq cte (mail-fetch-field "content-transfer-encoding"))))
-      (when ctl
+	(mail-narrow-to-head)
+	(when (or no-strict-mime
+		  (mail-fetch-field "mime-version"))
+	  (setq ct (mail-fetch-field "content-type")
+		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 (or (not ctl)
+	      (not (string-match "/" (car ctl))))
+	  (mm-dissect-singlepart
+	   '("text/plain") nil no-strict-mime
+	   (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
+	   description)
 	(setq type (split-string (car ctl) "/"))
 	(setq subtype (cadr type)
 	      type (pop type))
-	(cond
-	 ((equal type "multipart")
-	  (mm-dissect-multipart ctl))
-	 (t
-	  (mm-dissect-singlepart ctl (and cte (intern cte))
-				 no-strict-mime)))))))
-
-(defun mm-dissect-singlepart (ctl cte &optional force)
+	(setq
+	 result
+	 (cond
+	  ((equal type "multipart")
+	   (cons (car ctl) (mm-dissect-multipart ctl)))
+	  (t
+	   (mm-dissect-singlepart
+	    ctl
+	    (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 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 id)
   (when (or force
 	    (not (equal "text/plain" (car ctl))))
-    (let ((res (list (list (mm-copy-to-buffer) ctl cte nil))))
+    (let ((res (mm-make-handle
+		(mm-copy-to-buffer) ctl cte nil cdl description nil id)))
       (push (car res) mm-dissection-list)
       res)))
 
@@ -98,17 +193,28 @@
 
 (defun mm-dissect-multipart (ctl)
   (goto-char (point-min))
-  (let ((boundary (concat "\n--" (drums-content-type-get ctl 'boundary)))
-	start parts end)
-    (while (search-forward boundary nil t)
-      (forward-line -1)
+  (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)
+      (goto-char (match-beginning 0))
       (when start
 	(save-excursion
 	  (save-restriction
 	    (narrow-to-region start (point))
-	    (setq parts (nconc (mm-dissect-buffer t) parts)))))
+	    (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
       (forward-line 2)
       (setq start (point)))
+    (when start
+      (save-excursion
+	(save-restriction
+	  (narrow-to-region start end)
+	  (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
     (nreverse parts)))
 
 (defun mm-copy-to-buffer ()
@@ -117,77 +223,171 @@
     (let ((obuf (current-buffer))
 	  beg)
       (goto-char (point-min))
-      (search-forward "\n\n" nil t)
+      (search-forward-regexp "^\n" nil t)
       (setq beg (point))
       (set-buffer (generate-new-buffer " *mm*"))
       (insert-buffer-substring obuf beg)
       (current-buffer))))
 
-(defun mm-display-part (handle)
-  "Display the MIME part represented by HANDLE."
+(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;
+external if displayed external."
   (save-excursion
     (mailcap-parse-mailcaps)
-    (if (nth 3 handle)
+    (if (mm-handle-displayed-p handle)
 	(mm-remove-part handle)
-      (let* ((type (caadr handle))
+      (let* ((type (car (mm-handle-type handle)))
 	     (method (mailcap-mime-info type))
 	     (user-method (mm-user-method type)))
 	(if (eq user-method 'inline)
 	    (progn
 	      (forward-line 1)
-	      (mm-display-inline handle))
-	  (mm-display-external handle (or user-method method)))))))
+	      (mm-display-inline handle)
+	      'inline)
+	  (when (or user-method
+		    method
+		    (not no-default))
+	    (if (and (not user-method)
+		     (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))
+	      'external)))))))
 
 (defun mm-display-external (handle method)
   "Display HANDLE using METHOD."
   (mm-with-unibyte-buffer
-    (insert-buffer-substring (car handle))
-    (mm-decode-content-transfer-encoding (nth 2 handle))
     (if (functionp method)
 	(let ((cur (current-buffer)))
-	  (switch-to-buffer (generate-new-buffer "*mm*"))
+	  (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)
-	  (funcall method)
-	  (setcar (nthcdr 3 handle) (current-buffer)))
-      (let* ((file (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
-	     process)
-	(write-region (point-min) (point-max)
-		      file nil 'nomesg nil 'no-conversion)
-	(setq process
-	      (start-process "*display*" nil shell-file-name
-			     "-c" (format method file)))
-	(setcar (nthcdr 3 handle) (cons file process))
+	  (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))))))
 
+(defun mm-remove-parts (handles)
+  "Remove the displayed MIME parts represented by HANDLE."
+  (if (and (listp handles)
+	   (bufferp (car handles)))
+      (mm-remove-part handles)
+    (let (handle)
+      (while (setq handle (pop handles))
+	(cond
+	 ((stringp handle)
+	  )
+	 ((and (listp handle)
+	       (stringp (car handle)))
+	  (mm-remove-parts (cdr handle)))
+	 (t
+	  (mm-remove-part handle)))))))
+
+(defun mm-destroy-parts (handles)
+  "Remove the displayed MIME parts represented by HANDLE."
+  (if (and (listp handles)
+	   (bufferp (car handles)))
+      (mm-destroy-part handles)
+    (let (handle)
+      (while (setq handle (pop handles))
+	(cond
+	 ((stringp handle)
+	  )
+	 ((and (listp handle)
+	       (stringp (car handle)))
+	  (mm-destroy-parts (cdr handle)))
+	 (t
+	  (mm-destroy-part handle)))))))
+
 (defun mm-remove-part (handle)
   "Remove the displayed MIME part represented by HANDLE."
-  (let ((object (nth 3 handle)))
-    (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 ()
-	  (kill-process (cdr object))
-	(error nil)))
-     ((bufferp object)
-      (when (buffer-live-p object)
-	(kill-buffer object))))
-    (setcar (nthcdr 3 handle) nil)))
+  (when (listp handle)
+    (let ((object (mm-handle-undisplayer handle)))
+      (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)
-  (let* ((type (caadr handle))
+  (let* ((type (car (mm-handle-type handle)))
 	 (function (cadr (assoc type mm-inline-media-tests))))
-    (funcall function handle)))
-	 
+    (funcall function handle)
+    (goto-char (point-min))))
+
 (defun mm-inlinable-p (type)
   "Say whether TYPE can be displayed inline."
   (let ((alist mm-inline-media-tests)
@@ -216,6 +416,27 @@
   "Return the user-defined method for TYPE."
   (let ((methods mm-user-automatic-display)
 	method result)
+    (while (setq method (pop methods))
+      (when (and (string-match method type)
+		 (mm-inlinable-p type))
+	(setq result t
+	      methods nil)))
+    result))
+
+(defun mm-attachment-override-p (type)
+  "Say whether TYPE should have attachment behavior overridden."
+  (let ((types mm-attachment-override-types)
+	ty)
+    (catch 'found
+      (while (setq ty (pop types))
+	(when (and (string-match ty type)
+		   (mm-inlinable-p 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)
+	method result)
     (while (setq method (pop methods))
       (when (string-match method type)
 	(setq result t
@@ -229,15 +450,20 @@ This overrides entries in the mailcap file."
 
 (defun mm-destroy-part (handle)
   "Destroy the data structures connected to HANDLE."
-  (mm-remove-part handle)
-  (when (buffer-live-p (car handle))
-    (kill-buffer (car handle))))
+  (when (listp handle)
+    (mm-remove-part handle)
+    (when (buffer-live-p (mm-handle-buffer handle))
+      (kill-buffer (mm-handle-buffer handle)))))
+
+(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))
+    (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)
@@ -246,86 +472,141 @@ This overrides entries in the mailcap file."
         arg
       (apply 'concat (nconc (nreverse accum) (list (substring arg pos)))))))
 
-;;;
-;;; Functions for displaying various formats inline
-;;;
-
-(defun mm-inline-image (handle)
-  (let ((type (cadr (split-string (caadr handle) "/")))
-	image)
-    (mm-with-unibyte-buffer
-      (insert-buffer-substring (car handle))
-      (mm-decode-content-transfer-encoding (nth 2 handle))
-      (setq image (make-image-specifier
-		   (vector (intern type) :data (buffer-string)))))
-    (let ((annot (make-annotation image nil 'text)))
-      (set-extent-property annot 'mm t)
-      (set-extent-property annot 'duplicable t)
-      (setcar (nthcdr 3 handle) annot))))
-
-(defun mm-inline-text (handle)
-  (let ((type (cadr (split-string (caadr handle) "/")))
-	text buffer-read-only)
-    (mm-with-unibyte-buffer
-      (insert-buffer-substring (car handle))
-      (mm-decode-content-transfer-encoding (nth 2 handle))
-      (setq text (buffer-string)))
-    (cond
-     ((equal type "plain")
-      (let ((b (point)))
-	(insert text)
-	(save-restriction
-	  (narrow-to-region b (point))
-	  (let ((charset (drums-content-type-get (nth 1 handle) 'charset)))
-	    (when charset
-	      (mm-decode-body charset nil)))
-	  (setcar
-	   (nthcdr 3 handle)
-	   `(lambda ()
-	      (let (buffer-read-only)
-		(delete-region ,(set-marker (make-marker) (point-min))
-			       ,(set-marker (make-marker) (point-max)))))))))
-     )))
-
-(defun mm-inline-audio (handle)
-  (message "Not implemented"))
-
 ;;;
 ;;; Functions for outputting parts
 ;;;
 
+(defun mm-get-part (handle)
+  "Return the contents of HANDLE as a string."
+  (mm-with-unibyte-buffer
+    (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
+      (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)
   "Write HANDLE to a file."
-  (let* ((name (drums-content-type-get (cadr handle) 'name))
-	 (file (read-file-name "Save MIME part to: "
-			       (expand-file-name
-				(or name "") default-directory))))
+  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
+	 (filename (mail-content-type-get
+		    (mm-handle-disposition handle) 'filename))
+	 file)
+    (when filename
+      (setq filename (file-name-nondirectory filename)))
+    (setq file
+	  (read-file-name "Save MIME part to: "
+			  (expand-file-name
+			   (or filename name "")
+			   (or mm-default-directory default-directory))))
+    (setq mm-default-directory (file-name-directory file))
     (mm-with-unibyte-buffer
-      (insert-buffer-substring (car handle))
-      (mm-decode-content-transfer-encoding (nth 2 handle))
+      (mm-insert-part handle)
       (when (or (not (file-exists-p file))
-		(yes-or-no-p (format "File %s already exists; overwrite? ")))
-	(write-region (point-min) (point-max) 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))))))
 
 (defun mm-pipe-part (handle)
   "Pipe HANDLE to a process."
-  (let* ((name (drums-content-type-get (cadr handle) 'name))
+  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
 	 (command
 	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
     (mm-with-unibyte-buffer
-      (insert-buffer-substring (car handle))
-      (mm-decode-content-transfer-encoding (nth 2 handle))
+      (mm-insert-part handle)
       (shell-command-on-region (point-min) (point-max) command nil))))
 
 (defun mm-interactively-view-part (handle)
   "Display HANDLE using METHOD."
-  (let* ((type (caadr handle))
+  (let* ((type (car (mm-handle-type handle)))
 	 (methods
-	  (mapcar (lambda (i) (list (cdr (assoc "viewer" i))))
+	  (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
 		  (mailcap-mime-info type 'all)))
 	 (method (completing-read "Viewer: " methods)))
     (mm-display-external (copy-sequence handle) method)))
 
+(defun mm-preferred-alternative (handles &optional preferred)
+  "Say which of HANDLES are preferred."
+  (let ((prec (if preferred (list preferred) mm-alternative-precedence))
+	p h result type handle)
+    (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))
+	(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)))
+			      "inline")))
+	  (setq result (car h)
+		h nil
+		prec nil))
+	(pop h)))
+    result))
+
+(defun mm-get-content-id (id)
+  "Return the handle(s) referred to by ID."
+  (cdr (assoc id mm-content-id-alist)))
+
+(defun mm-get-image (handle)
+  "Return an image instance based on HANDLE."
+  (let ((type (cadr (split-string (car (mm-handle-type handle)) "/")))
+	spec)
+    ;; Allow some common translations.
+    (setq type
+	  (cond
+	   ((equal type "x-pixmap")
+	    "xpm")
+	   ((equal type "x-xbitmap")
+	    "xbm")
+	   (t type)))
+    (or (mm-handle-cache handle)
+	(mm-with-unibyte-buffer
+	  (mm-insert-part handle)
+	  (prog1
+	      (setq spec
+		    (make-glyph `[,(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
+	(and (< (glyph-width image) (window-pixel-width))
+	     (< (glyph-height image) (window-pixel-height))))))
+
 (provide 'mm-decode)
 
 ;; mm-decode.el ends here