X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmailcap.el;h=aaa8104b9688470fbcb162f9d6611bb9365d3871;hb=1eec296eaf247f52c3d343e0efcc9375b496ccf3;hp=56eb75cf301ab332e64b9e08c237d2341518b43a;hpb=80b0f5c32fb35747f6449aa9d3b9bd0c40f1f12d;p=gnus

diff --git a/lisp/mailcap.el b/lisp/mailcap.el
index 56eb75cf3..aaa8104b9 100644
--- a/lisp/mailcap.el
+++ b/lisp/mailcap.el
@@ -1,9 +1,9 @@
-;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998-2000 Free Software Foundation, Inc.
+;;; mailcap.el --- MIME media types configuration
+;; Copyright (C) 1998, 1999, 2000, 2001 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.
 
@@ -24,12 +24,21 @@
 
 ;;; 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)
 
+(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)))
     (modify-syntax-entry ?' "\"" table)
@@ -39,8 +48,16 @@
     table)
   "A syntax table for parsing sgml attributes.")
 
+;; 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"
+     ("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,11 +69,12 @@
      ("octet-stream"
       (viewer . mailcap-save-binary-file)
       (non-viewer . t)
-      (type ."application/octet-stream"))
-     ("dvi"
-      (viewer . "open %s")
-      (type   . "application/dvi")
-      (test   . (eq (mm-device-type) 'ns)))
+      (type . "application/octet-stream"))
+;;; XEmacs says `ns' device-type not implemented.
+;;      ("dvi"
+;;       (viewer . "open %s")
+;;       (type   . "application/dvi")
+;;       (test   . (eq (mm-device-type) 'ns)))
      ("dvi"
       (viewer . "xdvi %s")
       (test   . (eq (mm-device-type) 'x))
@@ -98,13 +116,28 @@
       (non-viewer . t)
       (type   . "application/zip")
       ("copiousoutput"))
+     ;; Prefer free viewers.
+     ("pdf"
+      (viewer . "gv %s")
+      (type . "application/pdf")
+      (test . window-system))
+     ("pdf"
+      (viewer . "xpdf %s")
+      (type . "application/pdf")
+      (test . (eq (mm-device-type) 'x)))
      ("pdf"
       (viewer . "acroread %s")
       (type   . "application/pdf"))
+;;; XEmacs says `ns' device-type not implemented.
+;;      ("postscript"
+;;       (viewer . "open %s")
+;;       (type   . "application/postscript")
+;;       (test   . (eq (mm-device-type) 'ns)))
      ("postscript"
-      (viewer . "open %s")
-      (type   . "application/postscript")
-      (test   . (eq (mm-device-type) 'ns)))
+      (viewer . "gv -safer %s")
+      (type . "application/postscript")
+      (test   . window-system)
+      ("needsx11"))
      ("postscript"
       (viewer . "ghostview -dSAFER %s")
       (type . "application/postscript")
@@ -114,7 +147,11 @@
       (viewer . "ps2ascii %s")
       (type . "application/postscript")
       (test . (not (getenv "DISPLAY")))
-      ("copiousoutput")))
+      ("copiousoutput"))
+     ("sieve"
+      (viewer . sieve-mode)
+      (test   . (fboundp 'sieve-mode))
+      (type   . "application/sieve")))
     ("audio"
      ("x-mpeg"
       (viewer . "maplay %s")
@@ -138,10 +175,6 @@
       (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"
@@ -162,10 +195,11 @@
       ("compose" . "xwd -frame > %s")
       (test   . (eq (mm-device-type) 'x))
       ("needsx11"))
-     (".*"
-      (viewer . "aopen %s")
-      (type   . "image/*")
-      (test   . (eq (mm-device-type) 'ns)))
+;;; XEmacs says `ns' device-type not implemented.
+;;      (".*"
+;;       (viewer . "aopen %s")
+;;       (type   . "image/*")
+;;       (test   . (eq (mm-device-type) 'ns)))
      (".*"
       (viewer . "display %s")
       (type . "image/*")
@@ -225,57 +259,42 @@ 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.
-
-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.")
-
-(defvar mailcap-download-directory nil
-  "*Where downloaded files should go by default.")
-
-(defvar mailcap-temporary-directory
-  (cond ((fboundp 'temp-directory) (temp-directory))
-	((boundp 'temporary-file-directory) temporary-file-directory)
-	("/tmp/"))
-  "*Where temporary files go.")
+`funcall'ed, with the buffer as an argument.
+
+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.")
+
+(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-poor-system-types
+  '(ms-dos ms-windows windows-nt win32 w32 mswindows)
+  "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 +305,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 +355,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)
+		       (delete "" (split-string path path-separator))
+		     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 +399,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 +425,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 +451,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
@@ -456,11 +507,10 @@ If FORCE, re-parse even if already parsed."
       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
-	)
+  "Return non-nil iff mailcap entry INFO passes its test clause.
+Also return non-nil if no test clause is present."
+  (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 +537,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 +572,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,13 +595,14 @@ 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 iff viewer specified by VIEWER-INFO passes its test clause.
+Also retun 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)
@@ -566,8 +617,7 @@ If FORCE, re-parse even if already parsed."
 	((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))
+	((functionp test)		; Lisp function as test
 	 (funcall test type-info))
 	((and (symbolp test)		; Lisp variable as test
 	      (boundp test))
@@ -590,16 +640,19 @@ If FORCE, re-parse even if already parsed."
 	(setq mailcap-mime-data
 	      (cons (cons major (list (cons minor info)))
 		    mailcap-mime-data))
-      (let ((cur-minor (assoc minor old-major)))
-	(cond
-	 ((or (null cur-minor)		; New minor area, or
-	      (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)))
-	  (setcdr cur-minor info))
-	 (t
-	  (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
+       (let ((cur-minor (assoc minor old-major)))
+ 	(cond
+ 	 ((or (null cur-minor)		; New minor area, or
+ 	      (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))
+	       (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))))))
+      )))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
@@ -619,7 +672,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 iff 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)) ""))))
@@ -670,7 +723,7 @@ 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)
@@ -700,136 +753,146 @@ 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")
+    (".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")
+    (".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")
+    (".siv"   . "application/sieve")
+    (".snd"   . "audio/basic")
+    (".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"))
+  "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)
+			       (delete "" (split-string path path-separator))
+			     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 +909,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 +928,35 @@ 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)
+  (mm-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)))))
 
 (provide 'mailcap)