Import Oort Gnus v0.11.

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

diff --git a/lisp/mailcap.el b/lisp/mailcap.el
index bcfd238..5f77082 100644 (file)
--- a/lisp/mailcap.el
+++ b/lisp/mailcap.el
@@ -1,5 +1,5 @@
 ;;; mailcap.el --- MIME media types configuration
-;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
 
 ;; Author: William M. Perry <wmperry@aventail.com>
 ;;     Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -76,8 +76,8 @@
 ;;       (type   . "application/dvi")
 ;;       (test   . (eq (mm-device-type) 'ns)))
      ("dvi"
-      (viewer . "xdvi %s")
-      (test   . (eq (mm-device-type) 'x))
+      (viewer . "xdvi -safer %s")
+      (test   . (eq window-system 'x))
       ("needsx11")
       (type   . "application/dvi"))
      ("dvi"
@@ -87,6 +87,9 @@
      ("emacs-lisp"
       (viewer . mailcap-maybe-eval)
       (type   . "application/emacs-lisp"))
+     ("x-emacs-lisp"
+      (viewer . mailcap-maybe-eval)
+      (type   . "application/x-emacs-lisp"))
      ("x-tar"
       (viewer . mailcap-save-binary-file)
       (non-viewer . t)
@@ -118,13 +121,13 @@
       ("copiousoutput"))
      ;; Prefer free viewers.
      ("pdf"
-      (viewer . "gv %s")
+      (viewer . "gv -safer %s")
       (type . "application/pdf")
       (test . window-system))
      ("pdf"
       (viewer . "xpdf %s")
       (type . "application/pdf")
-      (test . (eq (mm-device-type) 'x)))
+      (test . (eq window-system 'x)))
      ("pdf"
       (viewer . "acroread %s")
       (type   . "application/pdf"))
@@ -141,7 +144,7 @@
      ("postscript"
       (viewer . "ghostview -dSAFER %s")
       (type . "application/postscript")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
      ("postscript"
       (viewer . "ps2ascii %s")
@@ -181,19 +184,19 @@
       (viewer  . "xwud -in %s")
       (type    . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test    . (eq (mm-device-type) 'x))
+      (test    . (eq window-system 'x))
       ("needsx11"))
      ("x11-dump"
       (viewer . "xwud -in %s")
       (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
      ("windowdump"
       (viewer . "xwud -in %s")
       (type . "image/x-xwd")
       ("compose" . "xwd -frame > %s")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
 ;;; XEmacs says `ns' device-type not implemented.
 ;;      (".*"
@@ -203,12 +206,12 @@
      (".*"
       (viewer . "display %s")
       (type . "image/*")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11"))
      (".*"
       (viewer . "ee %s")
       (type . "image/*")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("text"
      ("plain"
@@ -223,7 +226,7 @@
       (viewer  . fundamental-mode)
       (type    . "text/plain"))
      ("enriched"
-      (viewer . enriched-decode-region)
+      (viewer . enriched-decode)
       (test   . (fboundp 'enriched-decode))
       (type   . "text/enriched"))
      ("html"
@@ -234,7 +237,7 @@
      ("mpeg"
       (viewer . "mpeg_play %s")
       (type   . "video/mpeg")
-      (test   . (eq (mm-device-type) 'x))
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("x-world"
      ("x-vrml"
@@ -282,11 +285,15 @@ 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."
+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
 ;;;
@@ -314,7 +321,7 @@ 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."
   (let ((lisp-buffer (current-buffer)))
@@ -363,7 +370,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
     (cond
      (path nil)
      ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
-     ((memq system-type '(ms-dos ms-windows windows-nt))
+     ((memq system-type mailcap-poor-system-types)
       (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
      (t (setq path
              ;; This is per RFC 1524, specifically
@@ -636,18 +643,18 @@ to supply to the test."
        (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))
+      (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))))))
+         (setcdr cur-minor info))
+        (t
+         (setcdr old-major (cons (cons minor info) (cdr old-major))))))
       )))
 
 (defun mailcap-add (type viewer &optional test)
@@ -730,9 +737,8 @@ this type is returned."
        ((or (null request) (equal request ""))
        (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
        ((stringp request)
-       (if (or (eq request 'test) (eq request 'viewer))
-           (mailcap-unescape-mime-test
-            (cdr-safe (assoc request viewer)) info)))
+       (mailcap-unescape-mime-test
+        (cdr-safe (assoc request viewer)) info))
        ((eq request 'all)
        passed)
        (t
@@ -860,7 +866,7 @@ If FORCE, re-parse even if already parsed."
     (cond
      (path nil)
      ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
-     ((memq system-type '(ms-dos ms-windows windows-nt))
+     ((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