Importing Pterodactyl Gnus v0.95.

[elisp/gnus.git-] / lisp / mailcap.el

diff --git a/lisp/mailcap.el b/lisp/mailcap.el
index a38bee3..7a1c05b 100644 (file)
--- a/lisp/mailcap.el
+++ b/lisp/mailcap.el
@@ -1,5 +1,5 @@
 ;;; mailcap.el --- Functions for displaying MIME parts
 ;;; 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>
 
 ;; Author: William M. Perry <wmperry@aventail.com>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>

@@ -28,7 +28,7 @@
 
 (eval-and-compile
   (require 'cl))
 
 (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)))
 
 (defvar mailcap-parse-args-syntax-table
   (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))

@@ -40,176 +40,186 @@
   "A syntax table for parsing sgml attributes.")
 
 (defvar mailcap-mime-data
   "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"
      ("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"
      ("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"
      ("octet-stream"

-      ("viewer" . mailcap-save-binary-file)
-      ("type" ."application/octet-stream"))
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type ."application/octet-stream"))

      ("dvi"
      ("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"
      ("dvi"

-      ("viewer" . "xdvi %s")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "xdvi %s")
+      (test   . (eq (mm-device-type) 'x))

       ("needsx11")
       ("needsx11")

-      ("type"   . "application/dvi"))
+      (type   . "application/dvi"))

      ("dvi"
      ("dvi"

-      ("viewer" . "dvitty %s")
-      ("test"   . (not (getenv "DISPLAY")))
-      ("type"   . "application/dvi"))
+      (viewer . "dvitty %s")
+      (test   . (not (getenv "DISPLAY")))
+      (type   . "application/dvi"))

      ("emacs-lisp"
      ("emacs-lisp"

-      ("viewer" . mailcap-maybe-eval)
-      ("type"   . "application/emacs-lisp"))
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/emacs-lisp"))

      ("x-tar"
      ("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"
      ("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"
      ("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"
      ("latex"

-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/latex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/latex"))

      ("tex"
      ("tex"

-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/tex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/tex"))

      ("texinfo"
      ("texinfo"

-      ("viewer" . texinfo-mode)
-      ("test"   . (fboundp 'texinfo-mode))
-      ("type"   . "application/tex"))
+      (viewer . texinfo-mode)
+      (test   . (fboundp 'texinfo-mode))
+      (type   . "application/tex"))

      ("zip"
      ("zip"

-      ("viewer" . mailcap-save-binary-file)
-      ("type"   . "application/zip")
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/zip")

       ("copiousoutput"))
      ("pdf"
       ("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"
      ("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"
       ("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"
       ("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)))
                      (featurep 'native-sound)))

-      ("type"   . "audio/*"))
+      (type   . "audio/*"))

      (".*"
      (".*"

-      ("viewer" . "showaudio")
-      ("type"   . "audio/*")))
+      (viewer . "showaudio")
+      (type   . "audio/*")))

     ("message"
      ("rfc-*822"
     ("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"
      ("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"
      ("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"
     ("image"
      ("x-xwd"

-      ("viewer"  . "xwud -in %s")
-      ("type"    . "image/x-xwd")
+      (viewer  . "xwud -in %s")
+      (type    . "image/x-xwd")

       ("compose" . "xwd -frame > %s")
       ("compose" . "xwd -frame > %s")

-      ("test"    . (eq (mm-device-type) 'x))
+      (test    . (eq (mm-device-type) 'x))

       ("needsx11"))
      ("x11-dump"
       ("needsx11"))
      ("x11-dump"

-      ("viewer" . "xwud -in %s")
-      ("type" . "image/x-xwd")
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")

       ("compose" . "xwd -frame > %s")
       ("compose" . "xwd -frame > %s")

-      ("test"   . (eq (mm-device-type) 'x))
+      (test   . (eq (mm-device-type) 'x))

       ("needsx11"))
      ("windowdump"
       ("needsx11"))
      ("windowdump"

-      ("viewer" . "xwud -in %s")
-      ("type" . "image/x-xwd")
+      (viewer . "xwud -in %s")
+      (type . "image/x-xwd")

       ("compose" . "xwd -frame > %s")
       ("compose" . "xwd -frame > %s")

-      ("test"   . (eq (mm-device-type) 'x))
+      (test   . (eq (mm-device-type) 'x))

       ("needsx11"))
      (".*"
       ("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"
       ("needsx11")))
     ("text"
      ("plain"

-      ("viewer"  . w3-mode)
-      ("test"    . (fboundp 'w3-mode))
-      ("type"    . "text/plain"))
+      (viewer  . w3-mode)
+      (test    . (fboundp 'w3-mode))
+      (type    . "text/plain"))

      ("plain"
      ("plain"

-      ("viewer"  . view-mode)
-      ("test"    . (fboundp 'view-mode))
-      ("type"    . "text/plain"))
+      (viewer  . view-mode)
+      (test    . (fboundp 'view-mode))
+      (type    . "text/plain"))

      ("plain"
      ("plain"

-      ("viewer"  . fundamental-mode)
-      ("type"    . "text/plain"))
+      (viewer  . fundamental-mode)
+      (type    . "text/plain"))

      ("enriched"
      ("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"
      ("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"
     ("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"
       ("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"
       ("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)
 
 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:
 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
 
 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-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.")
 
 ;;;
   "*Where temporary files go.")
 
 ;;;

@@ -270,20 +283,13 @@ not.")
       (expand-file-name fname mailcap-temporary-directory))))
 
 (defun mailcap-save-binary-file ()
       (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 ()
     (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."
 (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))
   (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"
                            ";")))
      (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))
          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)))
            (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
        (downcase-region save-pos (point))
        (setq minor
              (cond

-              ((= ?* (or (char-after save-pos) 0)) ".*")
+              ((eq ?* (or (char-after save-pos) 0)) ".*")

               ((= (point) save-pos) ".*")
               ((= (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
        (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")
        (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))
            (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 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)))))
                          (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;")
       (while (not (eobp))
        (setq done nil)

-       (skip-chars-forward " \";\n\t")

        (setq name-pos (point))
        (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")
        (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) '(?\" ?'))
          (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 "^;")
                  (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))))
                  (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
 
 (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) " ")))
        )
     (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")
        (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)))
       (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))))
        (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)))
             ((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 "\"\""))
             ((= 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).
 (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)
         (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))
         (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
       (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))))
          (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)))))))))
 
          (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
 ;;;
 ;;; 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)
     (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.
 
 (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
 
 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
        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))
       (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))))
            (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
                 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-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)
        ((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)
            (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))
        (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)))))
          (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")
     (".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")
     (".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")
     (".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"))
     (".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
 
 (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)))
 
       (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
 (provide 'mailcap)
 
 ;;; mailcap.el ends here