Importing Pterodactyl Gnus v0.95.
[elisp/gnus.git-] / lisp / mailcap.el
index a38bee3..7a1c05b 100644 (file)
@@ -1,5 +1,5 @@
 ;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,99 Free Software Foundation, Inc.
 
 ;; Author: William M. Perry <wmperry@aventail.com>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -28,7 +28,7 @@
 
 (eval-and-compile
   (require 'cl))
-(require 'drums)
+(require 'mail-parse)
 
 (defvar mailcap-parse-args-syntax-table
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
   "A syntax table for parsing sgml attributes.")
 
 (defvar mailcap-mime-data
-  '(("multipart"
-     (".*"
-      ("viewer" . mailcap-save-binary-file)
-      ("type"   . "multipart/*")))
-    ("application"
+  '(("application"
      ("x-x509-ca-cert"
-      ("viewer" . ssl-view-site-cert)
-      ("test" . (fboundp 'ssl-view-site-cert))
-      ("type" . "application/x-x509-ca-cert"))
+      (viewer . ssl-view-site-cert)
+      (test . (fboundp 'ssl-view-site-cert))
+      (type . "application/x-x509-ca-cert"))
      ("x-x509-user-cert"
-      ("viewer" . ssl-view-user-cert)
-      ("test" . (fboundp 'ssl-view-user-cert))
-      ("type" . "application/x-x509-user-cert"))
+      (viewer . ssl-view-user-cert)
+      (test . (fboundp 'ssl-view-user-cert))
+      (type . "application/x-x509-user-cert"))
      ("octet-stream"
-      ("viewer" . mailcap-save-binary-file)
-      ("type" ."application/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)))
+      (viewer . "open %s")
+      (type   . "application/dvi")
+      (test   . (eq (mm-device-type) 'ns)))
      ("dvi"
-      ("viewer" . "xdvi %s")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "xdvi %s")
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11")
-      ("type"   . "application/dvi"))
+      (type   . "application/dvi"))
      ("dvi"
-      ("viewer" . "dvitty %s")
-      ("test"   . (not (getenv "DISPLAY")))
-      ("type"   . "application/dvi"))
+      (viewer . "dvitty %s")
+      (test   . (not (getenv "DISPLAY")))
+      (type   . "application/dvi"))
      ("emacs-lisp"
-      ("viewer" . mailcap-maybe-eval)
-      ("type"   . "application/emacs-lisp"))
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/emacs-lisp"))
      ("x-tar"
-      ("viewer" . mailcap-save-binary-file)
-      ("type"   . "application/x-tar"))
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/x-tar"))
      ("x-latex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/x-latex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/x-latex"))
      ("x-tex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/x-tex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/x-tex"))
      ("latex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/latex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/latex"))
      ("tex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/tex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/tex"))
      ("texinfo"
-      ("viewer" . texinfo-mode)
-      ("test"   . (fboundp 'texinfo-mode))
-      ("type"   . "application/tex"))
+      (viewer . texinfo-mode)
+      (test   . (fboundp 'texinfo-mode))
+      (type   . "application/tex"))
      ("zip"
-      ("viewer" . mailcap-save-binary-file)
-      ("type"   . "application/zip")
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/zip")
       ("copiousoutput"))
      ("pdf"
-      ("viewer" . "acroread %s")
-      ("type"   . "application/pdf"))
+      (viewer . "acroread %s")
+      (type   . "application/pdf"))
+     ("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)))
-     ("postscript" 
-      ("viewer" . "ghostview %s")
-      ("type" . "application/postscript")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "ghostview -dSAFER %s")
+      (type . "application/postscript")
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11"))
      ("postscript"
-      ("viewer" . "ps2ascii %s")
-      ("type" . "application/postscript")
-      ("test" . (not (getenv "DISPLAY")))
+      (viewer . "ps2ascii %s")
+      (type . "application/postscript")
+      (test . (not (getenv "DISPLAY")))
       ("copiousoutput")))
     ("audio"
      ("x-mpeg"
-      ("viewer" . "maplay %s")
-      ("type"   . "audio/x-mpeg"))
+      (viewer . "maplay %s")
+      (type   . "audio/x-mpeg"))
      (".*"
-      ("viewer" . mailcap-play-sound-file)
-      ("test"   . (or (featurep 'nas-sound)
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (test   . (or (featurep 'nas-sound)
                      (featurep 'native-sound)))
-      ("type"   . "audio/*"))
+      (type   . "audio/*"))
      (".*"
-      ("viewer" . "showaudio")
-      ("type"   . "audio/*")))
+      (viewer . "showaudio")
+      (type   . "audio/*")))
     ("message"
      ("rfc-*822"
-      ("viewer" . vm-mode)
-      ("test"   . (fboundp 'vm-mode))
-      ("type"   . "message/rfc-822"))
+      (viewer . mm-view-message)
+      (test   . (and (featurep 'gnus)
+                    (gnus-alive-p)))
+      (type   . "message/rfc822"))
+     ("rfc-*822"
+      (viewer . vm-mode)
+      (test   . (fboundp 'vm-mode))
+      (type   . "message/rfc822"))
      ("rfc-*822"
-      ("viewer" . w3-mode)
-      ("test"   . (fboundp 'w3-mode))
-      ("type"   . "message/rfc-822"))
+      (viewer . w3-mode)
+      (test   . (fboundp 'w3-mode))
+      (type   . "message/rfc822"))
      ("rfc-*822"
-      ("viewer" . view-mode)
-      ("test"   . (fboundp 'view-mode))
-      ("type"   . "message/rfc-822"))
-     ("rfc-*822" 
-      ("viewer" . fundamental-mode)
-      ("type"   . "message/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")
+      (viewer  . "xwud -in %s")
+      (type    . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      ("test"    . (eq (mm-device-type) 'x))
+      (test    . (eq (mm-device-type) 'x))
       ("needsx11"))
      ("x11-dump"
-      ("viewer" . "xwud -in %s")
-      ("type" . "image/x-xwd")
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      ("test"   . (eq (mm-device-type) 'x))
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11"))
      ("windowdump"
-      ("viewer" . "xwud -in %s")
-      ("type" . "image/x-xwd")
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      ("test"   . (eq (mm-device-type) 'x))
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11"))
      (".*"
-      ("viewer" . "aopen %s")
-      ("type"   . "image/*")
-      ("test"   . (eq (mm-device-type) 'ns)))
+      (viewer . "aopen %s")
+      (type   . "image/*")
+      (test   . (eq (mm-device-type) 'ns)))
      (".*"
-      ("viewer" . "xv -perfect %s")
-      ("type" . "image/*")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "display %s")
+      (type . "image/*")
+      (test   . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     (".*"
+      (viewer . "ee %s")
+      (type . "image/*")
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11")))
     ("text"
      ("plain"
-      ("viewer"  . w3-mode)
-      ("test"    . (fboundp 'w3-mode))
-      ("type"    . "text/plain"))
+      (viewer  . w3-mode)
+      (test    . (fboundp 'w3-mode))
+      (type    . "text/plain"))
      ("plain"
-      ("viewer"  . view-mode)
-      ("test"    . (fboundp 'view-mode))
-      ("type"    . "text/plain"))
+      (viewer  . view-mode)
+      (test    . (fboundp 'view-mode))
+      (type    . "text/plain"))
      ("plain"
-      ("viewer"  . fundamental-mode)
-      ("type"    . "text/plain"))
+      (viewer  . fundamental-mode)
+      (type    . "text/plain"))
      ("enriched"
-      ("viewer" . enriched-decode-region)
-      ("test"   . (fboundp 'enriched-decode-region))
-      ("type"   . "text/enriched"))
+      (viewer . enriched-decode-region)
+      (test   . (fboundp 'enriched-decode))
+      (type   . "text/enriched"))
      ("html"
-      ("viewer" . w3-prepare-buffer)
-      ("test"   . (fboundp 'w3-prepare-buffer))
-      ("type"   . "text/html")))
+      (viewer . mm-w3-prepare-buffer)
+      (test   . (fboundp 'w3-prepare-buffer))
+      (type   . "text/html")))
     ("video"
      ("mpeg"
-      ("viewer" . "mpeg_play %s")
-      ("type"   . "video/mpeg")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "mpeg_play %s")
+      (type   . "video/mpeg")
+      (test   . (eq (mm-device-type) 'x))
       ("needsx11")))
     ("x-world"
      ("x-vrml"
-      ("viewer"  . "webspace -remote %s -URL %u")
-      ("type"    . "x-world/x-vrml")
+      (viewer  . "webspace -remote %s -URL %u")
+      (type    . "x-world/x-vrml")
       ("description"
        "VRML document")))
     ("archive"
      ("tar"
-      ("viewer" . tar-mode)
-      ("type" . "archive/tar")
-      ("test" . (fboundp 'tar-mode)))))
-     "*The mailcap structure is an assoc list of assoc lists.
+      (viewer . tar-mode)
+      (type . "archive/tar")
+      (test . (fboundp 'tar-mode)))))
+     "The mailcap structure is an assoc list of assoc lists.
 1st assoc list is keyed on the major content-type
 2nd assoc list is keyed on the minor content-type (which can be a regexp)
 
@@ -223,9 +233,9 @@ Which looks like:
 Where <info> is another assoc list of the various information
 related to the mailcap RFC.  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\"))
 
 Where viewerinfo specifies how the content-type is viewed.  Can be
 a string, in which case it is run through a shell, with
@@ -240,7 +250,10 @@ not.")
 (defvar mailcap-download-directory nil
   "*Where downloaded files should go by default.")
 
-(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
+(defvar mailcap-temporary-directory
+  (cond ((fboundp 'temp-directory) (temp-directory))
+       ((boundp 'temporary-file-directory) temporary-file-directory)
+       ("/tmp/"))
   "*Where temporary files go.")
 
 ;;;
@@ -270,20 +283,13 @@ not.")
       (expand-file-name fname mailcap-temporary-directory))))
 
 (defun mailcap-save-binary-file ()
-  ;; Ok, this is truly fucked.  In XEmacs, if you use the mouse to select
-  ;; a URL that gets saved via this function, read-file-name will pop up a
-  ;; dialog box for file selection.  For some reason which buffer we are in
-  ;; gets royally screwed (even with save-excursions and the whole nine
-  ;; yards).  SO, we just keep the old buffer name around and away we go.
-  (let ((old-buff (current-buffer))
-       (file (read-file-name "Filename to save as: "
-                             (or mailcap-download-directory "~/")
-                             (file-name-nondirectory (url-view-url t))
-                             nil
-                             (file-name-nondirectory (url-view-url t))))
-       (require-final-newline nil))
-    (set-buffer old-buff)
-    (mule-write-region-no-coding-system (point-min) (point-max) file)
+  (goto-char (point-min))
+  (unwind-protect
+      (let ((file (read-file-name
+                  "Filename to save as: "
+                  (or mailcap-download-directory "~/")))
+           (require-final-newline nil))
+       (write-region (point-min) (point-max) file))
     (kill-buffer (current-buffer))))
 
 (defun mailcap-maybe-eval ()
@@ -307,13 +313,15 @@ not.")
 (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."
+  (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")
+      (setq path (mapconcat 'expand-file-name
+                           '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
                            ";")))
      (t (setq path (mapconcat 'expand-file-name
                              '("~/.mailcap"
@@ -328,7 +336,8 @@ If FORCE, re-parse even if already parsed."
          fname)
       (while fnames
        (setq fname (car fnames))
-       (if (and (file-exists-p fname) (file-readable-p fname))
+       (if (and (file-exists-p fname) (file-readable-p fname)
+                (file-regular-p fname))
            (mailcap-parse-mailcap (car fnames)))
        (setq fnames (cdr fnames))))
     (setq mailcap-parsed-p t)))
@@ -365,9 +374,9 @@ If FORCE, re-parse even if already parsed."
        (downcase-region save-pos (point))
        (setq minor
              (cond
-              ((= ?* (or (char-after save-pos) 0)) ".*")
+              ((eq ?* (or (char-after save-pos) 0)) ".*")
               ((= (point) save-pos) ".*")
-              (t (buffer-substring save-pos (point)))))
+              (t (regexp-quote (buffer-substring save-pos (point))))))
        (skip-chars-forward "; \t\n")
        ;;; Got the major/minor chunks, now for the viewers/etc
        ;;; The first item _must_ be a viewer, according to the
@@ -375,7 +384,12 @@ If FORCE, re-parse even if already parsed."
        (skip-chars-forward "; \t\n")
        (setq save-pos (point))
        (skip-chars-forward "^;\n")
-       (if (= (or (char-after save-pos) 0) ?')
+       ;;; skip \;
+       (while (eq (char-before) ?\\)
+         (backward-delete-char 1)
+         (skip-chars-forward ";")
+         (skip-chars-forward "^;\n"))
+       (if (eq (or (char-after save-pos) 0) ?')
            (setq viewer (progn
                           (narrow-to-region (1+ save-pos) (point))
                           (goto-char (point-min))
@@ -386,10 +400,10 @@ If FORCE, re-parse even if already parsed."
          (setq viewer (buffer-substring save-pos (point))))
        (setq save-pos (point))
        (end-of-line)
-       (setq info (nconc (list (cons "viewer" viewer)
-                               (cons "type" (concat major "/"
-                                                    (if (string= minor ".*")
-                                                        "*" minor))))
+       (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)))))
@@ -410,14 +424,13 @@ If FORCE, re-parse even if already parsed."
       (skip-chars-forward " \n\t;")
       (while (not (eobp))
        (setq done nil)
-       (skip-chars-forward " \";\n\t")
        (setq name-pos (point))
-       (skip-chars-forward "^ \n\t=")
+       (skip-chars-forward "^ \n\t=;")
        (downcase-region name-pos (point))
        (setq name (buffer-substring name-pos (point)))
        (skip-chars-forward " \t\n")
-       (if (/= (or (char-after (point)) 0)  ?=) ; There is no value
-           (setq value nil)
+       (if (not (eq (char-after (point)) ?=)) ; There is no value
+           (setq value t)
          (skip-chars-forward " \t\n=")
          (setq val-pos (point))
          (if (memq (char-after val-pos) '(?\" ?'))
@@ -430,23 +443,27 @@ If FORCE, re-parse even if already parsed."
                  (error (goto-char (point-max)))))
            (while (not done)
              (skip-chars-forward "^;")
-             (if (= (or (char-after (1- (point))) 0) ?\\ )
+             (if (eq (char-after (1- (point))) ?\\ )
                  (progn
                    (subst-char-in-region (1- (point)) (point) ?\\ ? )
                    (skip-chars-forward ";"))
                (setq done t))))
          (setq value (buffer-substring val-pos (point))))
-       (setq results (cons (cons name value) results)))
-      results)))  
+       (setq results (cons (cons 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 (assoc "test" info))      ; The test clause
+       (test (assq 'test info))        ; The test clause
        )
     (setq status (and test (split-string (cdr test) " ")))
-    (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
+    (if (and (or (assoc "needsterm" info)
+                (assoc "needsterminal" info)
+                (assoc "needsx11" info))
+            (not (getenv "DISPLAY")))
        (setq status nil)
       (cond
        ((and (equal (nth 0 status) "test")
@@ -475,7 +492,7 @@ If FORCE, re-parse even if already parsed."
       (cond
        ((equal (car (car major)) minor)
        (setq exact (cons (cdr (car major)) exact)))
-       ((string-match (car (car major)) minor)
+       ((and minor (string-match (car (car major)) minor))
        (setq wildcard (cons (cdr (car major)) wildcard))))
       (setq major (cdr major)))
     (nconc (nreverse exact) (nreverse wildcard))))
@@ -507,7 +524,7 @@ If FORCE, re-parse even if already parsed."
             ((null save-chr) nil)
             ((= save-chr ?t)
              (delete-region save-pos (progn (forward-char 1) (point)))
-             (insert (or (cdr (assoc "type" type-info)) "\"\"")))
+             (insert (or (cdr (assq 'type type-info)) "\"\"")))
             ((= save-chr ?M)
              (delete-region save-pos (progn (forward-char 1) (point)))
              (insert "\"\""))
@@ -533,10 +550,10 @@ If FORCE, re-parse even if already parsed."
 (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).
-  (let* ((test-info   (assoc "test"   viewer-info))
+  (let* ((test-info (assq 'test viewer-info))
         (test (cdr test-info))
         (otest test)
-        (viewer (cdr (assoc "viewer" viewer-info)))
+        (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))
@@ -574,24 +591,37 @@ If FORCE, re-parse even if already parsed."
       (let ((cur-minor (assoc minor old-major)))
        (cond
         ((or (null cur-minor)          ; New minor area, or
-             (assoc "test" info))      ; Has a test, insert at beginning
+             (assq 'test info))        ; Has a test, insert at beginning
          (setcdr old-major (cons (cons minor info) (cdr old-major))))
-        ((and (not (assoc "test" info)) ; No test info, replace completely
-              (not (assoc "test" cur-minor)))
+        ((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)))))))))
 
+(defun mailcap-add (type viewer &optional test)
+  "Add VIEWER as a handler for TYPE.
+If TEST is not given, it defaults to t."
+  (let ((tl (split-string type "/")))
+    (when (or (not (car tl))
+             (not (cadr tl)))
+      (error "%s is not a valid MIME type" type))
+    (mailcap-add-mailcap-entry
+     (car tl) (cadr tl)
+     `((viewer . ,viewer)
+       (test . ,(if test test t))
+       (type . ,type)))))
+
 ;;;
 ;;; The main whabbo
 ;;;
 
 (defun mailcap-viewer-lessp (x y)
   ;; Return t iff viewer X is more desirable than viewer Y
-  (let ((x-wild (string-match "[*?]" (or (cdr-safe (assoc "type" x)) "")))
-       (y-wild (string-match "[*?]" (or (cdr-safe (assoc "type" y)) "")))
-       (x-lisp (not (stringp (or (cdr-safe (assoc "viewer" x)) ""))))
-       (y-lisp (not (stringp (or (cdr-safe (assoc "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)) ""))))
+       (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
     (cond
      ((and x-lisp (not y-lisp))
       t)
@@ -603,7 +633,7 @@ If FORCE, re-parse even if already parsed."
 
 (defun mailcap-mime-info (string &optional request)
   "Get the MIME viewer command for STRING, return nil if none found.
-Expects a complete content-type header line as its argument. 
+Expects a complete content-type header line as its argument.
 
 Second argument REQUEST specifies what information to return.  If it is
 nil or the empty string, the viewer (second field of the mailcap
@@ -625,7 +655,7 @@ this type is returned."
        viewer                          ; The one and only viewer
        ctl)
     (save-excursion
-      (setq ctl (drums-parse-content-type (or string "text/plain")))
+      (setq ctl (mail-header-parse-content-type (or string "text/plain")))
       (setq major (split-string (car ctl) "/"))
       (setq minor (cadr major)
            major (car major))
@@ -640,16 +670,16 @@ this type is returned."
            (setq viewers (cdr viewers)))
          (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
          (setq viewer (car passed))))
-      (when (and (stringp (cdr (assoc "viewer" viewer)))
+      (when (and (stringp (cdr (assq 'viewer viewer)))
                 passed)
        (setq viewer (car passed)))
       (cond
-       ((and (null viewer) (not (equal major "default")))
+       ((and (null viewer) (not (equal major "default")) request)
        (mailcap-mime-info "default" request))
        ((or (null request) (equal request ""))
-       (mailcap-unescape-mime-test (cdr (assoc "viewer" viewer)) info))
+       (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
        ((stringp request)
-       (if (or (string= request "test") (string= request "viewer"))
+       (if (or (eq request 'test) (eq request 'viewer))
            (mailcap-unescape-mime-test
             (cdr-safe (assoc request viewer)) info)))
        ((eq request 'all)
@@ -657,8 +687,8 @@ this type is returned."
        (t
        ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
        (setq viewer (copy-tree viewer))
-       (let ((view (assoc "viewer" viewer))
-             (test (assoc "test" viewer)))
+       (let ((view (assq 'viewer viewer))
+             (test (assq 'test viewer)))
          (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
          (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
        viewer)))))
@@ -716,6 +746,7 @@ this type is returned."
     (".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")
@@ -751,14 +782,13 @@ this type is returned."
     (".wav"      . "audio/x-wav")
     (".wrl"      . "x-world/x-vrml")
     (".xbm"      . "image/xbm")
-    (".xpm"      . "image/x-pixmap")
+    (".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 the MIME content-types they
-correspond to.")
+  "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
@@ -827,6 +857,31 @@ correspond to.")
       (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))))))))
+
+(defun mailcap-mime-types ()
+  "Return a list of MIME media types."
+  (delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+
 (provide 'mailcap)
 
 ;;; mailcap.el ends here