Importing Pterodactyl Gnus v0.95.
[elisp/gnus.git-] / lisp / mailcap.el
index 1145c64..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>
@@ -51,6 +51,7 @@
       (type . "application/x-x509-user-cert"))
      ("octet-stream"
       (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
       (type ."application/octet-stream"))
      ("dvi"
       (viewer . "open %s")
@@ -70,6 +71,7 @@
       (type   . "application/emacs-lisp"))
      ("x-tar"
       (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
       (type   . "application/x-tar"))
      ("x-latex"
       (viewer . tex-mode)
@@ -93,6 +95,7 @@
       (type   . "application/tex"))
      ("zip"
       (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
       (type   . "application/zip")
       ("copiousoutput"))
      ("pdf"
       (type   . "application/postscript")
       (test   . (eq (mm-device-type) 'ns)))
      ("postscript"
-      (viewer . "ghostview %s")
+      (viewer . "ghostview -dSAFER %s")
       (type . "application/postscript")
       (test   . (eq (mm-device-type) 'x))
       ("needsx11"))
       (type   . "audio/x-mpeg"))
      (".*"
       (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
       (test   . (or (featurep 'nas-sound)
                      (featurep 'native-sound)))
       (type   . "audio/*"))
       (type   . "audio/*")))
     ("message"
      ("rfc-*822"
-      (viewer . gnus-article-prepare-display)
+      (viewer . mm-view-message)
       (test   . (and (featurep 'gnus)
                     (gnus-alive-p)))
-      (type   . "message/rfc-822"))
+      (type   . "message/rfc822"))
      ("rfc-*822"
       (viewer . vm-mode)
       (test   . (fboundp 'vm-mode))
-      (type   . "message/rfc-822"))
+      (type   . "message/rfc822"))
      ("rfc-*822"
       (viewer . w3-mode)
       (test   . (fboundp 'w3-mode))
-      (type   . "message/rfc-822"))
+      (type   . "message/rfc822"))
      ("rfc-*822"
       (viewer . view-mode)
       (test   . (fboundp 'view-mode))
-      (type   . "message/rfc-822"))
+      (type   . "message/rfc822"))
      ("rfc-*822"
       (viewer . fundamental-mode)
-      (type   . "message/rfc-822")))
+      (type   . "message/rfc822")))
     ("image"
      ("x-xwd"
       (viewer  . "xwud -in %s")
       (type   . "image/*")
       (test   . (eq (mm-device-type) 'ns)))
      (".*"
-      (viewer . "xv -perfect %s")
+      (viewer . "display %s")
+      (type . "image/*")
+      (test   . (eq (mm-device-type) 'x))
+      ("needsx11"))
+     (".*"
+      (viewer . "ee %s")
       (type . "image/*")
       (test   . (eq (mm-device-type) 'x))
       ("needsx11")))
       (viewer . tar-mode)
       (type . "archive/tar")
       (test . (fboundp 'tar-mode)))))
-     "*The mailcap structure is an assoc list of assoc lists.
+     "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)
 
@@ -241,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.")
 
 ;;;
@@ -308,7 +320,8 @@ If FORCE, re-parse even if already parsed."
      (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"
@@ -363,7 +376,7 @@ If FORCE, re-parse even if already parsed."
              (cond
               ((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
@@ -371,6 +384,11 @@ If FORCE, re-parse even if already parsed."
        (skip-chars-forward "; \t\n")
        (setq save-pos (point))
        (skip-chars-forward "^;\n")
+       ;;; 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))
@@ -406,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 (not (eq (char-after (point)) ?=)) ; There is no value
-           (setq value nil)
+           (setq value t)
          (skip-chars-forward " \t\n=")
          (setq val-pos (point))
          (if (memq (char-after val-pos) '(?\" ?'))
@@ -432,7 +449,8 @@ If FORCE, re-parse even if already parsed."
                    (skip-chars-forward ";"))
                (setq done t))))
          (setq value (buffer-substring val-pos (point))))
-       (setq results (cons (cons name value) results)))
+       (setq results (cons (cons name value) results))
+       (skip-chars-forward " \";\n\t"))
       results)))
 
 (defun mailcap-mailcap-entry-passes-test (info)
@@ -443,6 +461,7 @@ If FORCE, re-parse even if already parsed."
        )
     (setq status (and test (split-string (cdr test) " ")))
     (if (and (or (assoc "needsterm" info)
+                (assoc "needsterminal" info)
                 (assoc "needsx11" info))
             (not (getenv "DISPLAY")))
        (setq status nil)
@@ -580,6 +599,19 @@ If FORCE, re-parse even if already parsed."
         (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
 ;;;
@@ -714,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")
@@ -755,8 +788,7 @@ this type is returned."
     (".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
@@ -846,6 +878,10 @@ The path of COMMAND will be returned iff COMMAND is a command."
                       (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