X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmailcap.el;h=d8881104af8acb07c5739a91965361eca80b52bb;hp=ba2bfb7f5aca95b65906f73fcbd908dc3de03b15;hb=d20dda5b1d899018825f1f3e7099f22455d83afe;hpb=6012f8d1ee972cfa2dcde9bb1495abbc752ad44a

diff --git a/lisp/mailcap.el b/lisp/mailcap.el
index ba2bfb7f5..d8881104a 100644
--- a/lisp/mailcap.el
+++ b/lisp/mailcap.el
@@ -1,34 +1,61 @@
-;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;;; mailcap.el --- MIME media types configuration
+
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author: William M. Perry <wmperry@aventail.com>
 ;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
+;; Keywords: news, mail, multimedia
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
+;; Provides configuration of MIME media types from directly from Lisp
+;; and via the usual mailcap mechanism (RFC 1524).  Deals with
+;; mime.types similarly.
+
 ;;; Code:
 
 (eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mm-util)
+(autoload 'mail-header-parse-content-type "mail-parse")
+
+;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22.
+(defalias 'mailcap-delete-duplicates
+  (if (fboundp 'delete-dups)
+      'delete-dups
+    (autoload 'mm-delete-duplicates "mm-util")
+    'mm-delete-duplicates))
+
+;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'.
+(eval-and-compile
+  (cond
+   ((fboundp 'replace-regexp-in-string)
+    (defun mailcap-replace-in-string  (string regexp newtext &optional literal)
+      "Replace all matches for REGEXP with NEWTEXT in STRING.
+If LITERAL is non-nil, insert NEWTEXT literally.  Return a new
+string containing the replacements.
+This is a compatibility function for different Emacsen."
+      (replace-regexp-in-string regexp newtext string nil literal)))
+   ((fboundp 'replace-in-string)
+    (defalias 'mailcap-replace-in-string 'replace-in-string))))
+
+(defgroup mailcap nil
+  "Definition of viewers for MIME types."
+  :version "21.1"
+  :group 'mime)
 
 (defvar mailcap-parse-args-syntax-table
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
@@ -37,10 +64,36 @@
     (modify-syntax-entry ?{ "(" table)
     (modify-syntax-entry ?} ")" table)
     table)
-  "A syntax table for parsing sgml attributes.")
+  "A syntax table for parsing SGML attributes.")
+
+(eval-and-compile
+  (when (featurep 'xemacs)
+    (condition-case nil
+	(require 'lpr)
+      (error nil))))
 
+(defvar mailcap-print-command
+  (mapconcat 'identity
+	     (cons (if (boundp 'lpr-command)
+		       lpr-command
+		     "lpr")
+		   (when (boundp 'lpr-switches)
+		     (if (stringp lpr-switches)
+			 (list lpr-switches)
+		       lpr-switches)))
+	     " ")
+  "Shell command (including switches) used to print PostScript files.")
+
+;; Postpone using defcustom for this as it's so big and we essentially
+;; have to have two copies of the data around then.  Perhaps just
+;; customize the Lisp viewers and rely on the normal configuration
+;; files for the rest?  -- fx
 (defvar mailcap-mime-data
-  '(("application"
+  `(("application"
+     ("vnd\\.ms-excel"
+      (viewer . "gnumeric %s")
+      (test   . (getenv "DISPLAY"))
+      (type . "application/vnd.ms-excel"))
      ("x-x509-ca-cert"
       (viewer . ssl-view-site-cert)
       (test . (fboundp 'ssl-view-site-cert))
@@ -52,23 +105,24 @@
      ("octet-stream"
       (viewer . mailcap-save-binary-file)
       (non-viewer . t)
-      (type ."application/octet-stream"))
+      (type . "application/octet-stream"))
      ("dvi"
-      (viewer . "open %s")
-      (type   . "application/dvi")
-      (test   . (eq (mm-device-type) 'ns)))
-     ("dvi"
-      (viewer . "xdvi %s")
-      (test   . (eq (mm-device-type) 'x))
+      (viewer . "xdvi -safer %s")
+      (test   . (eq window-system 'x))
       ("needsx11")
-      (type   . "application/dvi"))
+      (type   . "application/dvi")
+      ("print" . "dvips -qRP %s"))
      ("dvi"
       (viewer . "dvitty %s")
       (test   . (not (getenv "DISPLAY")))
-      (type   . "application/dvi"))
+      (type   . "application/dvi")
+      ("print" . "dvips -qRP %s"))
      ("emacs-lisp"
       (viewer . mailcap-maybe-eval)
       (type   . "application/emacs-lisp"))
+     ("x-emacs-lisp"
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/x-emacs-lisp"))
      ("x-tar"
       (viewer . mailcap-save-binary-file)
       (non-viewer . t)
@@ -99,22 +153,61 @@
       (type   . "application/zip")
       ("copiousoutput"))
      ("pdf"
-      (viewer . "acroread %s")
-      (type   . "application/pdf"))
+      (viewer . pdf-view-mode)
+      (type . "application/pdf")
+      (test . (and (fboundp 'pdf-view-mode)
+		   (eq window-system 'x))))
+     ("pdf"
+      (viewer . doc-view-mode)
+      (type . "application/pdf")
+      (test . (and (fboundp 'doc-view-mode)
+		   (eq window-system 'x))))
+     ("pdf"
+      (viewer . "gv -safer %s")
+      (type . "application/pdf")
+      (test . window-system)
+      ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
+     ("pdf"
+      (viewer . "gpdf %s")
+      (type . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . "xpdf %s")
+      (type . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      (test . (eq window-system 'x)))
+     ("pdf"
+      (viewer . ,(concat "pdftotext %s -"))
+      (type   . "application/pdf")
+      ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+      ("copiousoutput"))
      ("postscript"
-      (viewer . "open %s")
-      (type   . "application/postscript")
-      (test   . (eq (mm-device-type) 'ns)))
+      (viewer . "gv -safer %s")
+      (type . "application/postscript")
+      (test   . window-system)
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("needsx11"))
      ("postscript"
       (viewer . "ghostview -dSAFER %s")
       (type . "application/postscript")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
+      ("print" . ,(concat mailcap-print-command " %s"))
       ("needsx11"))
      ("postscript"
       (viewer . "ps2ascii %s")
       (type . "application/postscript")
       (test . (not (getenv "DISPLAY")))
-      ("copiousoutput")))
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("copiousoutput"))
+     ("sieve"
+      (viewer . sieve-mode)
+      (test   . (fboundp 'sieve-mode))
+      (type   . "application/sieve"))
+     ("pgp-keys"
+      (viewer . "gpg --import --interactive --verbose")
+      (type   . "application/pgp-keys")
+      ("needsterminal")))
     ("audio"
      ("x-mpeg"
       (viewer . "maplay %s")
@@ -132,55 +225,39 @@
       (viewer . vm-mode)
       (test   . (fboundp 'vm-mode))
       (type   . "message/rfc822"))
-     ("rfc-*822"
-      (viewer . w3-mode)
-      (test   . (fboundp 'w3-mode))
-      (type   . "message/rfc822"))
      ("rfc-*822"
       (viewer . view-mode)
-      (test   . (fboundp 'view-mode))
-      (type   . "message/rfc822"))
-     ("rfc-*822"
-      (viewer . fundamental-mode)
       (type   . "message/rfc822")))
     ("image"
      ("x-xwd"
       (viewer  . "xwud -in %s")
       (type    . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test    . (eq (mm-device-type) 'x))
+      (test    . (eq window-system 'x))
       ("needsx11"))
      ("x11-dump"
       (viewer . "xwud -in %s")
       (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
      ("windowdump"
       (viewer . "xwud -in %s")
       (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
-     (".*"
-      (viewer . "aopen %s")
-      (type   . "image/*")
-      (test   . (eq (mm-device-type) 'ns)))
      (".*"
       (viewer . "display %s")
       (type . "image/*")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
      (".*"
       (viewer . "ee %s")
       (type . "image/*")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("text"
-     ("plain"
-      (viewer  . w3-mode)
-      (test    . (fboundp 'w3-mode))
-      (type    . "text/plain"))
      ("plain"
       (viewer  . view-mode)
       (test    . (fboundp 'view-mode))
@@ -189,18 +266,18 @@
       (viewer  . fundamental-mode)
       (type    . "text/plain"))
      ("enriched"
-      (viewer . enriched-decode-region)
+      (viewer . enriched-decode)
       (test   . (fboundp 'enriched-decode))
       (type   . "text/enriched"))
-     ("html"
-      (viewer . mm-w3-prepare-buffer)
-      (test   . (fboundp 'w3-prepare-buffer))
-      (type   . "text/html")))
+     ("dns"
+      (viewer . dns-mode)
+      (test   . (fboundp 'dns-mode))
+      (type   . "text/dns")))
     ("video"
      ("mpeg"
       (viewer . "mpeg_play %s")
       (type   . "video/mpeg")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("x-world"
      ("x-vrml"
@@ -225,57 +302,43 @@ Which looks like:
    (\"plain\" . <info>)))
 
 Where <info> is another assoc list of the various information
-related to the mailcap RFC.  This is keyed on the lowercase
+related to the mailcap RFC 1524.  This is keyed on the lowercase
 attribute name (viewer, test, etc).  This looks like:
- ((viewer . viewerinfo)
-  (test   . testinfo)
-  (xxxx   . \"string\"))
+ ((viewer . VIEWERINFO)
+  (test   . TESTINFO)
+  (xxxx   . \"STRING\")
+  FLAG)
 
-Where viewerinfo specifies how the content-type is viewed.  Can be
+Where VIEWERINFO specifies how the content-type is viewed.  Can be
 a string, in which case it is run through a shell, with
 appropriate parameters, or a symbol, in which case the symbol is
-funcall'd, with the buffer as an argument.
+`funcall'ed, with the buffer as an argument.
 
-testinfo is a list of strings, or nil.  If nil, it means the
-viewer specified is always valid.  If it is a list of strings,
-these are used to determine whether a viewer passes the 'test' or
-not.")
+TESTINFO is a test for the viewer's applicability, or nil.  If nil, it
+means the viewer is always valid.  If it is a Lisp function, it is
+called with a list of items from any extra fields from the
+Content-Type header as argument to return a boolean value for the
+validity.  Otherwise, if it is a non-function Lisp symbol or list
+whose car is a symbol, it is `eval'led to yield the validity.  If it
+is a string or list of strings, it represents a shell command to run
+to return a true or false shell value for the validity.")
+(put 'mailcap-mime-data 'risky-local-variable t)
 
-(defvar mailcap-download-directory nil
-  "*Where downloaded files should go by default.")
+(defcustom mailcap-download-directory nil
+  "*Directory to which `mailcap-save-binary-file' downloads files by default.
+nil means your home directory."
+  :type '(choice (const :tag "Home directory" nil)
+		 directory)
+  :group 'mailcap)
 
-(defvar mailcap-temporary-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp/"))
-  "*Where temporary files go.")
+(defvar mailcap-poor-system-types
+  '(ms-dos windows-nt)
+  "Systems that don't have a Unix-like directory hierarchy.")
 
 ;;;
 ;;; Utility functions
 ;;;
 
-(defun mailcap-generate-unique-filename (&optional fmt)
-  "Generate a unique filename in mailcap-temporary-directory."
-  (if (not fmt)
-      (let ((base (format "mailcap-tmp.%d" (user-real-uid)))
-	    (fname "")
-	    (x 0))
-	(setq fname (format "%s%d" base x))
-	(while (file-exists-p
-		(expand-file-name fname mailcap-temporary-directory))
-	  (setq x (1+ x)
-		fname (concat base (int-to-string x))))
-	(expand-file-name fname mailcap-temporary-directory))
-    (let ((base (concat "mm" (int-to-string (user-real-uid))))
-	  (fname "")
-	  (x 0))
-      (setq fname (format fmt (concat base (int-to-string x))))
-      (while (file-exists-p
-	      (expand-file-name fname mailcap-temporary-directory))
-	(setq x (1+ x)
-	      fname (format fmt (concat base (int-to-string x)))))
-      (expand-file-name fname mailcap-temporary-directory))))
-
 (defun mailcap-save-binary-file ()
   (goto-char (point-min))
   (unwind-protect
@@ -286,11 +349,42 @@ not.")
 	(write-region (point-min) (point-max) file))
     (kill-buffer (current-buffer))))
 
+(defvar mailcap-maybe-eval-warning
+  "*** WARNING ***
+
+This MIME part contains untrusted and possibly harmful content.
+If you evaluate the Emacs Lisp code contained in it, a lot of nasty
+things can happen.  Please examine the code very carefully before you
+instruct Emacs to evaluate it.  You can browse the buffer containing
+the code using \\[scroll-other-window].
+
+If you are unsure what to do, please answer \"no\"."
+  "Text of warning message displayed by `mailcap-maybe-eval'.
+Make sure that this text consists only of few text lines.  Otherwise,
+Gnus might fail to display all of it.")
+
 (defun mailcap-maybe-eval ()
-  "Maybe evaluate a buffer of emacs lisp code."
-  (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
-      (eval-buffer (current-buffer))
-    (emacs-lisp-mode)))
+  "Maybe evaluate a buffer of Emacs Lisp code."
+  (let ((lisp-buffer (current-buffer)))
+    (goto-char (point-min))
+    (when
+	(save-window-excursion
+	  (delete-other-windows)
+	  (let ((buffer (get-buffer-create (generate-new-buffer-name
+					    "*Warning*"))))
+	    (unwind-protect
+		(with-current-buffer buffer
+		  (insert (substitute-command-keys
+			   mailcap-maybe-eval-warning))
+		  (goto-char (point-min))
+		  (display-buffer buffer)
+		  (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
+	      (kill-buffer buffer))))
+      (eval-buffer (current-buffer)))
+    (when (buffer-live-p lisp-buffer)
+      (with-current-buffer lisp-buffer
+	(emacs-lisp-mode)))))
+
 
 ;;;
 ;;; The mailcap parser
@@ -305,39 +399,40 @@ not.")
 (defvar mailcap-parsed-p nil)
 
 (defun mailcap-parse-mailcaps (&optional path force)
-  "Parse out all the mailcaps specified in a unix-style path string PATH.
-If FORCE, re-parse even if already parsed."
+  "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system.  If FORCE, re-parse even if already
+parsed.  If PATH is omitted, use the value of environment variable
+MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
+/usr/local/etc/mailcap."
   (interactive (list nil t))
   (when (or (not mailcap-parsed-p)
 	    force)
     (cond
      (path nil)
      ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
-     ((memq system-type '(ms-dos ms-windows windows-nt))
-      (setq path (mapconcat 'expand-file-name
-			    '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
-			    ";")))
-     (t (setq path (mapconcat 'expand-file-name
-			      '("~/.mailcap"
-				"/etc/mailcap:/usr/etc/mailcap"
-				"/usr/local/etc/mailcap") ":"))))
+     ((memq system-type mailcap-poor-system-types)
+      (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
+     (t (setq path
+	      ;; This is per RFC 1524, specifically
+	      ;; with /usr before /usr/local.
+	      '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
+		"/usr/local/etc/mailcap"))))
     (let ((fnames (reverse
-		   (split-string
-		    path (if (memq system-type
-				   '(ms-dos ms-windows windows-nt))
-			     ";"
-			   ":"))))
+		   (if (stringp path)
+		       (split-string path path-separator t)
+		     path)))
 	  fname)
       (while fnames
 	(setq fname (car fnames))
-	(if (and (file-exists-p fname) (file-readable-p fname)
+	(if (and (file-readable-p fname)
 		 (file-regular-p fname))
-	    (mailcap-parse-mailcap (car fnames)))
+	    (mailcap-parse-mailcap fname))
 	(setq fnames (cdr fnames))))
-    (setq mailcap-parsed-p t)))
+      (setq mailcap-parsed-p t)))
 
 (defun mailcap-parse-mailcap (fname)
-  ;; Parse out the mailcap file specified by FNAME
+  "Parse out the mailcap file specified by FNAME."
   (let (major				; The major mime type (image/audio/etc)
 	minor				; The minor mime type (gif, basic, etc)
 	save-pos			; Misc saved positions used in parsing
@@ -348,25 +443,24 @@ If FORCE, re-parse even if already parsed."
       (insert-file-contents fname)
       (set-syntax-table mailcap-parse-args-syntax-table)
       (mailcap-replace-regexp "#.*" "")	; Remove all comments
+      (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
       (mailcap-replace-regexp "\n+" "\n") ; And blank lines
-      (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces
-      (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "")
       (goto-char (point-max))
       (skip-chars-backward " \t\n")
       (delete-region (point) (point-max))
-      (goto-char (point-min))
-      (while (not (eobp))
-	(skip-chars-forward " \t\n")
+      (while (not (bobp))
+	(skip-chars-backward " \t\n")
+	(beginning-of-line)
 	(setq save-pos (point)
 	      info nil)
 	(skip-chars-forward "^/; \t\n")
 	(downcase-region save-pos (point))
 	(setq major (buffer-substring save-pos (point)))
-	(skip-chars-forward " \t\n")
+	(skip-chars-forward " \t")
 	(setq minor "")
 	(when (eq (char-after) ?/)
 	  (forward-char)
-	  (skip-chars-forward " \t\n")
+	  (skip-chars-forward " \t")
 	  (setq save-pos (point))
 	  (skip-chars-forward "^; \t\n")
 	  (downcase-region save-pos (point))
@@ -375,14 +469,14 @@ If FORCE, re-parse even if already parsed."
 		 ((eq ?* (or (char-after save-pos) 0)) ".*")
 		 ((= (point) save-pos) ".*")
 		 (t (regexp-quote (buffer-substring save-pos (point)))))))
-	(skip-chars-forward " \t\n")
+	(skip-chars-forward " \t")
 	;;; Got the major/minor chunks, now for the viewers/etc
 	;;; The first item _must_ be a viewer, according to the
-	;;; RFC for mailcap files (#1343)
+	;;; RFC for mailcap files (#1524)
 	(setq viewer "")
-	(when (eq (char-after) ?\;) 
+	(when (eq (char-after) ?\;)
 	  (forward-char)
-	  (skip-chars-forward " \t\n")
+	  (skip-chars-forward " \t")
 	  (setq save-pos (point))
 	  (skip-chars-forward "^;\n")
 	  ;; skip \;
@@ -401,17 +495,18 @@ If FORCE, re-parse even if already parsed."
 	    (setq viewer (buffer-substring save-pos (point)))))
 	(setq save-pos (point))
 	(end-of-line)
-	(unless (equal viewer "") 
+	(unless (equal viewer "")
 	  (setq info (nconc (list (cons 'viewer viewer)
 				  (cons 'type (concat major "/"
 						      (if (string= minor ".*")
 							  "*" minor))))
 			    (mailcap-parse-mailcap-extras save-pos (point))))
 	  (mailcap-mailcap-entry-passes-test info)
-	  (mailcap-add-mailcap-entry major minor info))))))
+	  (mailcap-add-mailcap-entry major minor info))
+	(beginning-of-line)))))
 
 (defun mailcap-parse-mailcap-extras (st nd)
-  ;; Grab all the extra stuff from a mailcap entry
+  "Grab all the extra stuff from a mailcap entry."
   (let (
 	name				; From name=
 	value				; its value
@@ -451,16 +546,23 @@ If FORCE, re-parse even if already parsed."
 		    (skip-chars-forward ";"))
 		(setq done t))))
 	  (setq	value (buffer-substring val-pos (point))))
-	(setq results (cons (cons name value) results))
+	;; `test' as symbol, others like "copiousoutput" and "needsx11" as
+	;; strings
+	(setq results (cons (cons (if (string-equal name "test")
+                                      'test
+                                    name)
+                                  value) results))
 	(skip-chars-forward " \";\n\t"))
       results)))
 
 (defun mailcap-mailcap-entry-passes-test (info)
-  ;; Return t iff a mailcap entry passes its test clause or no test
-  ;; clause is present.
-  (let (status				; Call-process-regions return value
-	(test (assq 'test info))	; The test clause
-	)
+  "Replace the test clause of INFO itself with a boolean for some cases.
+This function supports only `test -n $DISPLAY' and `test -z $DISPLAY',
+replaces them with t or nil.  As for others or if INFO has a interactive
+spec (needsterm, needsterminal, or needsx11) but DISPLAY is not set,
+the test clause will be unchanged."
+  (let ((test (assq 'test info))	; The test clause
+	status)
     (setq status (and test (split-string (cdr test) " ")))
     (if (and (or (assoc "needsterm" info)
 		 (assoc "needsterminal" info)
@@ -487,17 +589,17 @@ If FORCE, re-parse even if already parsed."
 ;;;
 
 (defun mailcap-possible-viewers (major minor)
-  ;; Return a list of possible viewers from MAJOR for minor type MINOR
+  "Return a list of possible viewers from MAJOR for minor type MINOR."
   (let ((exact '())
 	(wildcard '()))
     (while major
       (cond
        ((equal (car (car major)) minor)
 	(setq exact (cons (cdr (car major)) exact)))
-       ((and minor (string-match (car (car major)) minor))
+       ((and minor (string-match (concat "^" (car (car major)) "$") minor))
 	(setq wildcard (cons (cdr (car major)) wildcard))))
       (setq major (cdr major)))
-    (nconc (nreverse exact) (nreverse wildcard))))
+    (nconc exact wildcard)))
 
 (defun mailcap-unescape-mime-test (test type-info)
   (let (save-pos save-chr subst)
@@ -522,18 +624,18 @@ If FORCE, re-parse even if already parsed."
 	    (setq save-pos (point))
 	    (skip-chars-forward "%")
 	    (setq save-chr (char-after (point)))
+	    ;; Escapes:
+	    ;; %s: name of a file for the body data
+	    ;; %t: content-type
+	    ;; %{<parameter name}: value of parameter in mailcap entry
+	    ;; %n: number of sub-parts for multipart content-type
+	    ;; %F: a set of content-type/filename pairs for multiparts
 	    (cond
 	     ((null save-chr) nil)
 	     ((= save-chr ?t)
 	      (delete-region save-pos (progn (forward-char 1) (point)))
 	      (insert (or (cdr (assq 'type type-info)) "\"\"")))
-	     ((= save-chr ?M)
-	      (delete-region save-pos (progn (forward-char 1) (point)))
-	      (insert "\"\""))
-	     ((= save-chr ?n)
-	      (delete-region save-pos (progn (forward-char 1) (point)))
-	      (insert "\"\""))
-	     ((= save-chr ?F)
+	     ((memq save-chr '(?M ?n ?F))
 	      (delete-region save-pos (progn (forward-char 1) (point)))
 	      (insert "\"\""))
 	     ((= save-chr ?{)
@@ -545,44 +647,45 @@ If FORCE, re-parse even if already parsed."
 	      (insert (or (cdr (assoc subst type-info)) "\"\"")))
 	     (t nil))))
 	(buffer-string)))
-     (t (error "Bad value to mailcap-unescape-mime-test. %s" test)))))
+     (t (error "Bad value to mailcap-unescape-mime-test: %s" test)))))
 
 (defvar mailcap-viewer-test-cache nil)
 
 (defun mailcap-viewer-passes-test (viewer-info type-info)
-  ;; Return non-nil iff the viewer specified by VIEWER-INFO passes its
-  ;; test clause (if any).
+  "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
+Also return non-nil if it has no test clause.  TYPE-INFO is an argument
+to supply to the test."
   (let* ((test-info (assq 'test viewer-info))
 	 (test (cdr test-info))
 	 (otest test)
 	 (viewer (cdr (assoc 'viewer viewer-info)))
 	 (default-directory (expand-file-name "~/"))
 	 status parsed-test cache result)
-    (if (setq cache (assoc test mailcap-viewer-test-cache))
-	(cadr cache)
-      (setq
-       result
-       (cond
-	((not test-info) t)		; No test clause
-	((not test) nil)		; Already failed test
-	((eq test t) t)			; Already passed test
-	((and (symbolp test)		; Lisp function as test
-	      (fboundp test))
-	 (funcall test type-info))
-	((and (symbolp test)		; Lisp variable as test
-	      (boundp test))
-	 (symbol-value test))
-	((and (listp test)		; List to be eval'd
-	      (symbolp (car test)))
-	 (eval test))
-	(t
-	 (setq test (mailcap-unescape-mime-test test type-info)
-	       test (list shell-file-name nil nil nil
-			  shell-command-switch test)
-	       status (apply 'call-process test))
-	 (= 0 status))))
-      (push (list otest result) mailcap-viewer-test-cache)
-      result)))
+    (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+	   (cadr cache))
+	  ((not test-info) t)		; No test clause
+	  (t
+	   (setq
+	    result
+	    (cond
+	     ((not test) nil)		; Already failed test
+	     ((eq test t) t)		; Already passed test
+	     ((functionp test)		; Lisp function as test
+	      (funcall test type-info))
+	     ((and (symbolp test)	; Lisp variable as test
+		   (boundp test))
+	      (symbol-value test))
+	     ((and (listp test)		; List to be eval'd
+		   (symbolp (car test)))
+	      (eval test))
+	     (t
+	      (setq test (mailcap-unescape-mime-test test type-info)
+		    test (list shell-file-name nil nil nil
+			       shell-command-switch test)
+		    status (apply 'call-process test))
+	      (eq 0 status))))
+	   (push (list otest result) mailcap-viewer-test-cache)
+	   result))))
 
 (defun mailcap-add-mailcap-entry (major minor info)
   (let ((old-major (assoc major mailcap-mime-data)))
@@ -596,10 +699,13 @@ If FORCE, re-parse even if already parsed."
 	      (assq 'test info))	; Has a test, insert at beginning
 	  (setcdr old-major (cons (cons minor info) (cdr old-major))))
 	 ((and (not (assq 'test info))	; No test info, replace completely
-	       (not (assq 'test cur-minor)))
+	       (not (assq 'test cur-minor))
+	       (equal (assq 'viewer info)  ; Keep alternative viewer
+		      (assq 'viewer cur-minor)))
 	  (setcdr cur-minor info))
 	 (t
-	  (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
+	  (setcdr old-major (cons (cons minor info) (cdr old-major))))))
+      )))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
@@ -619,7 +725,7 @@ If TEST is not given, it defaults to t."
 ;;;
 
 (defun mailcap-viewer-lessp (x y)
-  ;; Return t iff viewer X is more desirable than viewer Y
+  "Return t if viewer X is more desirable than viewer Y."
   (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
 	(y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
 	(x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
@@ -633,7 +739,7 @@ If TEST is not given, it defaults to t."
       t)
      (t nil))))
 
-(defun mailcap-mime-info (string &optional request)
+(defun mailcap-mime-info (string &optional request no-decode)
   "Get the MIME viewer command for STRING, return nil if none found.
 Expects a complete content-type header line as its argument.
 
@@ -643,7 +749,11 @@ entry) will be returned.  If it is a string, then the mailcap field
 corresponding to that string will be returned (print, description,
 whatever).  If a number, then all the information for this specific
 viewer is returned.  If `all', then all possible viewers for
-this type is returned."
+this type is returned.
+
+If NO-DECODE is non-nil, don't decode STRING."
+  ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
+  ;; `mail-parse.el'
   (let (
 	major				; Major encoding (text, etc)
 	minor				; Minor encoding (html, etc)
@@ -657,7 +767,10 @@ this type is returned."
 	viewer				; The one and only viewer
 	ctl)
     (save-excursion
-      (setq ctl (mail-header-parse-content-type (or string "text/plain")))
+      (setq ctl
+	    (if no-decode
+		(list (or string "text/plain"))
+	      (mail-header-parse-content-type (or string "text/plain"))))
       (setq major (split-string (car ctl) "/"))
       (setq minor (cadr major)
 	    major (car major))
@@ -670,20 +783,19 @@ this type is returned."
 	    (if (mailcap-viewer-passes-test (car viewers) info)
 		(setq passed (cons (car viewers) passed)))
 	    (setq viewers (cdr viewers)))
-	  (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
+	  (setq passed (sort passed 'mailcap-viewer-lessp))
 	  (setq viewer (car passed))))
       (when (and (stringp (cdr (assq 'viewer viewer)))
 		 passed)
 	(setq viewer (car passed)))
       (cond
        ((and (null viewer) (not (equal major "default")) request)
-	(mailcap-mime-info "default" request))
+	(mailcap-mime-info "default" request no-decode))
        ((or (null request) (equal request ""))
 	(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
        ((stringp request)
-	(if (or (eq request 'test) (eq request 'viewer))
-	    (mailcap-unescape-mime-test
-	     (cdr-safe (assoc request viewer)) info)))
+	(mailcap-unescape-mime-test
+	 (cdr-safe (assoc request viewer)) info))
        ((eq request 'all)
 	passed)
        (t
@@ -700,136 +812,153 @@ this type is returned."
 ;;;
 
 (defvar mailcap-mime-extensions
-  '((""          . "text/plain")
-    (".abs"      . "audio/x-mpeg")
-    (".aif"      . "audio/aiff")
-    (".aifc"     . "audio/aiff")
-    (".aiff"     . "audio/aiff")
-    (".ano"      . "application/x-annotator")
-    (".au"       . "audio/ulaw")
-    (".avi"      . "video/x-msvideo")
-    (".bcpio"    . "application/x-bcpio")
-    (".bin"      . "application/octet-stream")
-    (".cdf"      . "application/x-netcdr")
-    (".cpio"     . "application/x-cpio")
-    (".csh"      . "application/x-csh")
-    (".dvi"      . "application/x-dvi")
-    (".diff"     . "text/x-patch")
-    (".el"       . "application/emacs-lisp")
-    (".eps"      . "application/postscript")
-    (".etx"      . "text/x-setext")
-    (".exe"      . "application/octet-stream")
-    (".fax"      . "image/x-fax")
-    (".gif"      . "image/gif")
-    (".hdf"      . "application/x-hdf")
-    (".hqx"      . "application/mac-binhex40")
-    (".htm"      . "text/html")
-    (".html"     . "text/html")
-    (".icon"     . "image/x-icon")
-    (".ief"      . "image/ief")
-    (".jpg"      . "image/jpeg")
-    (".macp"     . "image/x-macpaint")
-    (".man"      . "application/x-troff-man")
-    (".me"       . "application/x-troff-me")
-    (".mif"      . "application/mif")
-    (".mov"      . "video/quicktime")
-    (".movie"    . "video/x-sgi-movie")
-    (".mp2"      . "audio/x-mpeg")
-    (".mp3"      . "audio/x-mpeg")
-    (".mp2a"     . "audio/x-mpeg2")
-    (".mpa"      . "audio/x-mpeg")
-    (".mpa2"     . "audio/x-mpeg2")
-    (".mpe"      . "video/mpeg")
-    (".mpeg"     . "video/mpeg")
-    (".mpega"    . "audio/x-mpeg")
-    (".mpegv"    . "video/mpeg")
-    (".mpg"      . "video/mpeg")
-    (".mpv"      . "video/mpeg")
-    (".ms"       . "application/x-troff-ms")
-    (".nc"       . "application/x-netcdf")
-    (".nc"       . "application/x-netcdf")
-    (".oda"      . "application/oda")
-    (".patch"    . "text/x-patch")
-    (".pbm"      . "image/x-portable-bitmap")
-    (".pdf"      . "application/pdf")
-    (".pgm"      . "image/portable-graymap")
-    (".pict"     . "image/pict")
-    (".png"      . "image/png")
-    (".pnm"      . "image/x-portable-anymap")
-    (".ppm"      . "image/portable-pixmap")
-    (".ps"       . "application/postscript")
-    (".qt"       . "video/quicktime")
-    (".ras"      . "image/x-raster")
-    (".rgb"      . "image/x-rgb")
-    (".rtf"      . "application/rtf")
-    (".rtx"      . "text/richtext")
-    (".sh"       . "application/x-sh")
-    (".sit"      . "application/x-stuffit")
-    (".snd"      . "audio/basic")
-    (".src"      . "application/x-wais-source")
-    (".tar"      . "archive/tar")
-    (".tcl"      . "application/x-tcl")
-    (".tcl"      . "application/x-tcl")
-    (".tex"      . "application/x-tex")
-    (".texi"     . "application/texinfo")
-    (".tga"      . "image/x-targa")
-    (".tif"      . "image/tiff")
-    (".tiff"     . "image/tiff")
-    (".tr"       . "application/x-troff")
-    (".troff"    . "application/x-troff")
-    (".tsv"      . "text/tab-separated-values")
-    (".txt"      . "text/plain")
-    (".vbs"      . "video/mpeg")
-    (".vox"      . "audio/basic")
-    (".vrml"     . "x-world/x-vrml")
-    (".wav"      . "audio/x-wav")
-    (".wrl"      . "x-world/x-vrml")
-    (".xbm"      . "image/xbm")
-    (".xpm"      . "image/xpm")
-    (".xwd"      . "image/windowdump")
-    (".zip"      . "application/zip")
-    (".ai"       . "application/postscript")
-    (".jpe"      . "image/jpeg")
-    (".jpeg"     . "image/jpeg"))
-  "An assoc list of file extensions and corresponding MIME content-types.")
-
-(defun mailcap-parse-mimetypes (&optional path)
-  ;; Parse out all the mimetypes specified in a unix-style path string PATH
-  (cond
-   (path nil)
-   ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
-   ((memq system-type '(ms-dos ms-windows windows-nt))
-    (setq path (mapconcat 'expand-file-name
-			  '("~/mime.typ" "~/etc/mime.typ") ";")))
-   (t (setq path (mapconcat
-		  'expand-file-name
-		  ;; mime.types seems to be the normal name,
-		  ;; definitely so on current GNUish systems.  The
-		  ;; ordering follows that for mailcap.
-		  '("~/.mime.types"
-		    "/etc/mime.types"
-		    "/usr/etc/mime.types"
-		    "/usr/local/etc/mime.types"
-		    "/usr/local/www/conf/mime.types"
-		    "~/.mime-types"
-		    "/etc/mime-types"
-		    "/usr/etc/mime-types"
-		    "/usr/local/etc/mime-types"
-		    "/usr/local/www/conf/mime-types") ":"))))
-  (let ((fnames (reverse
-		 (split-string path
-			       (if (memq system-type
-					 '(ms-dos ms-windows windows-nt))
-				   ";" ":"))))
-	fname)
-    (while fnames
-      (setq fname (car fnames))
-      (if (and (file-exists-p fname) (file-readable-p fname))
-	  (mailcap-parse-mimetype-file (car fnames)))
-      (setq fnames (cdr fnames)))))
+  '((""       . "text/plain")
+    (".1"     . "text/plain")  ;; Manual pages
+    (".3"     . "text/plain")
+    (".8"     . "text/plain")
+    (".abs"   . "audio/x-mpeg")
+    (".aif"   . "audio/aiff")
+    (".aifc"  . "audio/aiff")
+    (".aiff"  . "audio/aiff")
+    (".ano"   . "application/x-annotator")
+    (".au"    . "audio/ulaw")
+    (".avi"   . "video/x-msvideo")
+    (".bcpio" . "application/x-bcpio")
+    (".bin"   . "application/octet-stream")
+    (".cdf"   . "application/x-netcdr")
+    (".cpio"  . "application/x-cpio")
+    (".csh"   . "application/x-csh")
+    (".css"   . "text/css")
+    (".dvi"   . "application/x-dvi")
+    (".diff"  . "text/x-patch")
+    (".dpatch". "test/x-patch")
+    (".el"    . "application/emacs-lisp")
+    (".eps"   . "application/postscript")
+    (".etx"   . "text/x-setext")
+    (".exe"   . "application/octet-stream")
+    (".fax"   . "image/x-fax")
+    (".gif"   . "image/gif")
+    (".hdf"   . "application/x-hdf")
+    (".hqx"   . "application/mac-binhex40")
+    (".htm"   . "text/html")
+    (".html"  . "text/html")
+    (".icon"  . "image/x-icon")
+    (".ief"   . "image/ief")
+    (".jpg"   . "image/jpeg")
+    (".macp"  . "image/x-macpaint")
+    (".man"   . "application/x-troff-man")
+    (".me"    . "application/x-troff-me")
+    (".mif"   . "application/mif")
+    (".mov"   . "video/quicktime")
+    (".movie" . "video/x-sgi-movie")
+    (".mp2"   . "audio/x-mpeg")
+    (".mp3"   . "audio/x-mpeg")
+    (".mp2a"  . "audio/x-mpeg2")
+    (".mpa"   . "audio/x-mpeg")
+    (".mpa2"  . "audio/x-mpeg2")
+    (".mpe"   . "video/mpeg")
+    (".mpeg"  . "video/mpeg")
+    (".mpega" . "audio/x-mpeg")
+    (".mpegv" . "video/mpeg")
+    (".mpg"   . "video/mpeg")
+    (".mpv"   . "video/mpeg")
+    (".ms"    . "application/x-troff-ms")
+    (".nc"    . "application/x-netcdf")
+    (".nc"    . "application/x-netcdf")
+    (".oda"   . "application/oda")
+    (".patch" . "text/x-patch")
+    (".pbm"   . "image/x-portable-bitmap")
+    (".pdf"   . "application/pdf")
+    (".pgm"   . "image/portable-graymap")
+    (".pict"  . "image/pict")
+    (".png"   . "image/png")
+    (".pnm"   . "image/x-portable-anymap")
+    (".pod"   . "text/plain")
+    (".ppm"   . "image/portable-pixmap")
+    (".ps"    . "application/postscript")
+    (".qt"    . "video/quicktime")
+    (".ras"   . "image/x-raster")
+    (".rgb"   . "image/x-rgb")
+    (".rtf"   . "application/rtf")
+    (".rtx"   . "text/richtext")
+    (".sh"    . "application/x-sh")
+    (".sit"   . "application/x-stuffit")
+    (".siv"   . "application/sieve")
+    (".snd"   . "audio/basic")
+    (".soa"   . "text/dns")
+    (".src"   . "application/x-wais-source")
+    (".tar"   . "archive/tar")
+    (".tcl"   . "application/x-tcl")
+    (".tex"   . "application/x-tex")
+    (".texi"  . "application/texinfo")
+    (".tga"   . "image/x-targa")
+    (".tif"   . "image/tiff")
+    (".tiff"  . "image/tiff")
+    (".tr"    . "application/x-troff")
+    (".troff" . "application/x-troff")
+    (".tsv"   . "text/tab-separated-values")
+    (".txt"   . "text/plain")
+    (".vbs"   . "video/mpeg")
+    (".vox"   . "audio/basic")
+    (".vrml"  . "x-world/x-vrml")
+    (".wav"   . "audio/x-wav")
+    (".xls"   . "application/vnd.ms-excel")
+    (".wrl"   . "x-world/x-vrml")
+    (".xbm"   . "image/xbm")
+    (".xpm"   . "image/xpm")
+    (".xwd"   . "image/windowdump")
+    (".zip"   . "application/zip")
+    (".ai"    . "application/postscript")
+    (".jpe"   . "image/jpeg")
+    (".jpeg"  . "image/jpeg")
+    (".org"   . "text/x-org"))
+  "An alist of file extensions and corresponding MIME content-types.
+This exists for you to customize the information in Lisp.  It is
+merged with values from mailcap files by `mailcap-parse-mimetypes'.")
+
+(defvar mailcap-mimetypes-parsed-p nil)
+
+(defun mailcap-parse-mimetypes (&optional path force)
+  "Parse out all the mimetypes specified in a Unix-style path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system.  If PATH is omitted, use the value of
+environment variable MIMETYPES if set; otherwise use a default path.
+If FORCE, re-parse even if already parsed."
+  (interactive (list nil t))
+  (when (or (not mailcap-mimetypes-parsed-p)
+	    force)
+    (cond
+     (path nil)
+     ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
+     ((memq system-type mailcap-poor-system-types)
+      (setq path '("~/mime.typ" "~/etc/mime.typ")))
+     (t (setq path
+	      ;; mime.types seems to be the normal name, definitely so
+	      ;; on current GNUish systems.  The search order follows
+	      ;; that for mailcap.
+	      '("~/.mime.types"
+		"/etc/mime.types"
+		"/usr/etc/mime.types"
+		"/usr/local/etc/mime.types"
+		"/usr/local/www/conf/mime.types"
+		"~/.mime-types"
+		"/etc/mime-types"
+		"/usr/etc/mime-types"
+		"/usr/local/etc/mime-types"
+		"/usr/local/www/conf/mime-types"))))
+    (let ((fnames (reverse (if (stringp path)
+			       (split-string path path-separator t)
+			     path)))
+	  fname)
+      (while fnames
+	(setq fname (car fnames))
+	(if (and (file-readable-p fname))
+	    (mailcap-parse-mimetype-file fname))
+	(setq fnames (cdr fnames))))
+    (setq mailcap-mimetypes-parsed-p t)))
 
 (defun mailcap-parse-mimetype-file (fname)
-  ;; Parse out a mime-types file
+  "Parse out a mime-types file FNAME."
   (let (type				; The MIME type for this line
 	extns				; The extensions for this line
 	save-pos			; Misc. saved buffer positions
@@ -846,7 +975,7 @@ this type is returned."
       (while (not (eobp))
 	(skip-chars-forward " \t\n")
 	(setq save-pos (point))
-	(skip-chars-forward "^ \t")
+	(skip-chars-forward "^ \t\n")
 	(downcase-region save-pos (point))
 	(setq type (buffer-substring save-pos (point)))
 	(while (not (eolp))
@@ -865,35 +994,96 @@ this type is returned."
 
 (defun mailcap-extension-to-mime (extn)
   "Return the MIME content type of the file extensions EXTN."
+  (mailcap-parse-mimetypes)
   (if (and (stringp extn)
 	   (not (eq (string-to-char extn) ?.)))
       (setq extn (concat "." extn)))
   (cdr (assoc (downcase extn) mailcap-mime-extensions)))
 
-(defvar mailcap-binary-suffixes
-  (if (memq system-type '(ms-dos windows-nt))
-      '(".exe" ".com" ".bat" ".cmd" ".btm" "")
-    '("")))
-
-(defun mailcap-command-p (command)
-  "Say whether COMMAND is in the exec path.
-The path of COMMAND will be returned iff COMMAND is a command."
-  (let ((path (if (file-name-absolute-p command) '(nil) exec-path))
- 	file dir)
-    (catch 'found
-      (while (setq dir (pop path))
-	(let ((suffixes mailcap-binary-suffixes))
-	  (while suffixes
-	    (when (and (file-executable-p
-			(setq file (expand-file-name
-				    (concat command (pop suffixes))
-				    dir)))
-		       (not (file-directory-p file)))
-	      (throw 'found file))))))))
+;; Unused?
+(defalias 'mailcap-command-p 'executable-find)
 
 (defun mailcap-mime-types ()
   "Return a list of MIME media types."
-  (mm-delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+  (mailcap-parse-mimetypes)
+  (mailcap-delete-duplicates
+   (nconc
+    (mapcar 'cdr mailcap-mime-extensions)
+    (apply
+     'nconc
+     (mapcar
+      (lambda (l)
+	(delq nil
+	      (mapcar
+	       (lambda (m)
+		 (let ((type (cdr (assq 'type (cdr m)))))
+		   (if (equal (cadr (split-string type "/"))
+			      "*")
+		       nil
+		     type)))
+	       (cdr l))))
+      mailcap-mime-data)))))
+
+;;;
+;;; Useful supplementary functions
+;;;
+
+(defun mailcap-file-default-commands (files)
+  "Return a list of default commands for FILES."
+  (mailcap-parse-mailcaps)
+  (mailcap-parse-mimetypes)
+  (let* ((all-mime-type
+	  ;; All unique MIME types from file extensions
+	  (mailcap-delete-duplicates
+	   (mapcar (lambda (file)
+		     (mailcap-extension-to-mime
+		      (file-name-extension file t)))
+		   files)))
+	 (all-mime-info
+	  ;; All MIME info lists
+	  (mailcap-delete-duplicates
+	   (mapcar (lambda (mime-type)
+		     (mailcap-mime-info mime-type 'all))
+		   all-mime-type)))
+	 (common-mime-info
+	  ;; Intersection of mime-infos from different mime-types;
+	  ;; or just the first MIME info for a single MIME type
+	  (if (cdr all-mime-info)
+	      (delq nil (mapcar (lambda (mi1)
+				  (unless (memq nil (mapcar
+						     (lambda (mi2)
+						       (member mi1 mi2))
+						     (cdr all-mime-info)))
+				    mi1))
+				(car all-mime-info)))
+	    (car all-mime-info)))
+	 (commands
+	  ;; Command strings from `viewer' field of the MIME info
+	  (mailcap-delete-duplicates
+	   (delq nil (mapcar (lambda (mime-info)
+			       (let ((command (cdr (assoc 'viewer mime-info))))
+				 (if (stringp command)
+				     (mailcap-replace-in-string
+				      ;; Replace mailcap's `%s' placeholder
+				      ;; with dired's `?' placeholder
+				      (mailcap-replace-in-string
+				       ;; Remove the final filename placeholder
+				       command "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" t)
+				      "%s" "?" t))))
+			     common-mime-info)))))
+    commands))
+
+(defun mailcap-view-mime (type)
+  "View the data in the current buffer that has MIME type TYPE.
+`mailcap-mime-data' determines the method to use."
+  (let ((method (mailcap-mime-info type)))
+    (if (stringp method)
+	(shell-command-on-region (point-min) (point-max)
+				 ;; Use stdin as the "%s".
+				 (format method "-")
+				 (current-buffer)
+				 t)
+      (funcall method))))
 
 (provide 'mailcap)