comparison lisp/gnus/mailcap.el @ 33821:61905a6a0029

Doc fixes. (mailcap-mime-data): Various adjustments. (mailcap): New group. (mailcap-download-directory): Customize. (mailcap-generate-unique-filename, mailcap-binary-suffixes) (mailcap-temporary-directory): Deleted (unused). (mailcap-unescape-mime-test): Simplify slightly. (mailcap-viewer-passes-test): Use functionp. (mailcap-command-p): Aliased to executable-find.

33820:962073a4240a

;;; mailcap.el --- Functions for displaying MIME parts
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.

;; Author: William M. Perry <[e-mail]>
;;	Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news, mail

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))
(require 'mail-parse)
(require 'mm-util)

(defvar mailcap-parse-args-syntax-table
  (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
    (modify-syntax-entry ?' "\"" table)
    (modify-syntax-entry ?` "\"" table)
    (modify-syntax-entry ?{ "(" table)
    (modify-syntax-entry ?} ")" table)
    table)
  "A syntax table for parsing sgml attributes.")

(defvar mailcap-mime-data
  '(("application"
     ("x-x509-ca-cert"
      (viewer . ssl-view-site-cert)
      (test . (fboundp 'ssl-view-site-cert))

      (type . "application/x-x509-user-cert"))
     ("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)))
     ("dvi"
      (viewer . "xdvi %s")
      (test   . (eq (mm-device-type) 'x))
      ("needsx11")
      (type   . "application/dvi"))

     ("zip"
      (viewer . mailcap-save-binary-file)
      (non-viewer . t)
      (type   . "application/zip")
      ("copiousoutput"))
     ("pdf"
      (viewer . "acroread %s")
      (type   . "application/pdf"))
     ("postscript"
      (viewer . "open %s")
      (type   . "application/postscript")
      (test   . (eq (mm-device-type) 'ns)))
     ("postscript"
      (viewer . "ghostview -dSAFER %s")
      (type . "application/postscript")
      (test   . (eq (mm-device-type) 'x))
      ("needsx11"))

      (viewer . w3-mode)
      (test   . (fboundp 'w3-mode))
      (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"
      (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))
      ("needsx11"))
     (".*"
      (viewer . "aopen %s")
      (type   . "image/*")
      (test   . (eq (mm-device-type) 'ns)))
     (".*"
      (viewer . "display %s")
      (type . "image/*")
      (test   . (eq (mm-device-type) 'x))
      ("needsx11"))

   (\"postscript\" . <info>))
  (\"text\"
   (\"plain\" . <info>)))

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\"))

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.")

;;;
;;; 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
      (let ((file (read-file-name

    (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].

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

	    (mailcap-parse-mailcap fname))
	(setq fnames (cdr fnames))))
      (setq mailcap-parsed-p t)))

(defun mailcap-parse-mailcap (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
	viewer				; How to view this mime type
	info				; Misc info about this mime type

		 ((= (point) save-pos) ".*")
		 (t (regexp-quote (buffer-substring save-pos (point)))))))
	(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)
	(setq viewer "")
	(when (eq (char-after) ?\;) 
	  (forward-char)
	  (skip-chars-forward " \t")
	  (setq save-pos (point))
	  (skip-chars-forward "^;\n")
	  ;; skip \;

			       (goto-char (point-max))
			       (widen))))
	    (setq viewer (buffer-substring save-pos (point)))))
	(setq save-pos (point))
	(end-of-line)
	(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))
	(beginning-of-line)))))

(defun mailcap-parse-mailcap-extras (st nd)
  ;; Grab all the extra stuff from a mailcap entry
  (let (
	name				; From name=
	value				; its value
	results				; Assoc list of results
	name-pos			; Start of XXXX= position

	(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 (assq 'test info))	; The test clause
	)
    (setq status (and test (split-string (cdr test) " ")))
    (if (and (or (assoc "needsterm" info)
		 (assoc "needsterminal" info)
		 (assoc "needsx11" info))
	     (not (getenv "DISPLAY")))

;;;
;;; The action routines.
;;;

(defun mailcap-possible-viewers (major minor)
  ;; Return a list of possible viewers from MAJOR for minor type MINOR
  (let ((exact '())
	(wildcard '()))
    (while major
      (cond
       ((equal (car (car major)) minor)

		(delete-char 1)
		(skip-chars-forward "%."))
	    (setq save-pos (point))
	    (skip-chars-forward "%")
	    (setq save-chr (char-after (point)))
	    (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)
	      (delete-region save-pos (progn (forward-char 1) (point)))
	      (insert "\"\""))
	     ((= save-chr ?{)
	      (forward-char 1)
	      (skip-chars-forward "^}")

	      (setq subst (buffer-substring (+ 2 save-pos) (point)))
	      (delete-region save-pos (1+ (point)))
	      (insert (or (cdr (assoc subst type-info)) "\"\"")))
	     (t nil))))
	(buffer-string)))
     (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).
  (let* ((test-info (assq 'test viewer-info))
	 (test (cdr test-info))
	 (otest test)
	 (viewer (cdr (assoc 'viewer viewer-info)))
	 (default-directory (expand-file-name "~/"))

       result
       (cond
	((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))
	 (funcall test type-info))
	((and (symbolp test)		; Lisp variable as test
	      (boundp test))
	 (symbol-value test))
	((and (listp test)		; List to be eval'd

;;;
;;; 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 (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

;;;
;;; Experimental MIME-types parsing
;;;

(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")
    (".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")
    (".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.")

(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))

	    (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
  (let (type				; The MIME type for this line
	extns				; The extensions for this line
	save-pos			; Misc. saved buffer positions
	)
    (with-temp-buffer

  (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))))))))

(defun mailcap-mime-types ()
  "Return a list of MIME media types."
  (mailcap-parse-mimetypes)
  (mm-delete-duplicates

33821:61905a6a0029

;;; mailcap.el --- MIME media types configuration
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.

;; Author: William M. Perry <[e-mail]>
;;	Lars Magne Ingebrigtsen <[e-mail]>
;; Keywords: news, mail, multimedia

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; 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)
    (modify-syntax-entry ?` "\"" table)
    (modify-syntax-entry ?{ "(" table)
    (modify-syntax-entry ?} ")" table)
    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"
     ("x-x509-ca-cert"
      (viewer . ssl-view-site-cert)
      (test . (fboundp 'ssl-view-site-cert))

      (type . "application/x-x509-user-cert"))
     ("octet-stream"
      (viewer . mailcap-save-binary-file)
      (non-viewer . t)
      (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))
      ("needsx11")
      (type   . "application/dvi"))

     ("zip"
      (viewer . mailcap-save-binary-file)
      (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 . "gv -safer %s")
      (type . "application/postscript")
      (test   . window-system)
      ("needsx11"))
     ("postscript"
      (viewer . "ghostview -dSAFER %s")
      (type . "application/postscript")
      (test   . (eq (mm-device-type) 'x))
      ("needsx11"))

      (viewer . w3-mode)
      (test   . (fboundp 'w3-mode))
      (type   . "message/rfc822"))
     ("rfc-*822"
      (viewer . view-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))
      ("needsx11"))
;;; XEmacs says `ns' device-type not implemented.
;;      (".*"
;;       (viewer . "aopen %s")
;;       (type   . "image/*")
;;       (test   . (eq (mm-device-type) 'ns)))
     (".*"
      (viewer . "display %s")
      (type . "image/*")
      (test   . (eq (mm-device-type) 'x))
      ("needsx11"))

   (\"postscript\" . <info>))
  (\"text\"
   (\"plain\" . <info>)))

Where <info> is another assoc list of the various information
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\")
  FLAG)

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'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
  "*Where downloaded files should go by default."
  :type 'directory
  :group 'mailcap)

;;;
;;; Utility functions
;;;

(defun mailcap-save-binary-file ()
  (goto-char (point-min))
  (unwind-protect
      (let ((file (read-file-name

    (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].

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

	    (mailcap-parse-mailcap fname))
	(setq fnames (cdr fnames))))
      (setq mailcap-parsed-p t)))

(defun mailcap-parse-mailcap (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
	viewer				; How to view this mime type
	info				; Misc info about this mime type

		 ((= (point) save-pos) ".*")
		 (t (regexp-quote (buffer-substring save-pos (point)))))))
	(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 (#1524)
	(setq viewer "")
	(when (eq (char-after) ?\;)
	  (forward-char)
	  (skip-chars-forward " \t")
	  (setq save-pos (point))
	  (skip-chars-forward "^;\n")
	  ;; skip \;

			       (goto-char (point-max))
			       (widen))))
	    (setq viewer (buffer-substring save-pos (point)))))
	(setq save-pos (point))
	(end-of-line)
	(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))
	(beginning-of-line)))))

(defun mailcap-parse-mailcap-extras (st nd)
  "Grab all the extra stuff from a mailcap entry."
  (let (
	name				; From name=
	value				; its value
	results				; Assoc list of results
	name-pos			; Start of XXXX= position

	(setq results (cons (cons name value) results))
	(skip-chars-forward " \";\n\t"))
      results)))

(defun mailcap-mailcap-entry-passes-test (info)
  "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)
		 (assoc "needsx11" info))
	     (not (getenv "DISPLAY")))

;;;
;;; The action routines.
;;;

(defun mailcap-possible-viewers (major minor)
  "Return a list of possible viewers from MAJOR for minor type MINOR."
  (let ((exact '())
	(wildcard '()))
    (while major
      (cond
       ((equal (car (car major)) minor)

		(delete-char 1)
		(skip-chars-forward "%."))
	    (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)) "\"\"")))
	     ((memq save-chr '(?M ?n ?F))
	      (delete-region save-pos (progn (forward-char 1) (point)))
	      (insert "\"\""))
	     ((= save-chr ?{)
	      (forward-char 1)
	      (skip-chars-forward "^}")

	      (setq subst (buffer-substring (+ 2 save-pos) (point)))
	      (delete-region save-pos (1+ (point)))
	      (insert (or (cdr (assoc subst type-info)) "\"\"")))
	     (t nil))))
	(buffer-string)))
     (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 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)
	 (viewer (cdr (assoc 'viewer viewer-info)))
	 (default-directory (expand-file-name "~/"))

       result
       (cond
	((not test-info) t)		; No test clause
	((not test) nil)		; Already failed test
	((eq test t) t)			; Already passed test
	((functionp test)		; Lisp function as test
	 (funcall test type-info))
	((and (symbolp test)		; Lisp variable as test
	      (boundp test))
	 (symbol-value test))
	((and (listp test)		; List to be eval'd

;;;
;;; 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 (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

;;;
;;; Experimental MIME-types parsing
;;;

(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")
    (".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")
    (".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")
    (".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))

	    (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 FNAME."
  (let (type				; The MIME type for this line
	extns				; The extensions for this line
	save-pos			; Misc. saved buffer positions
	)
    (with-temp-buffer

  (if (and (stringp extn)
	   (not (eq (string-to-char extn) ?.)))
      (setq extn (concat "." extn)))
  (cdr (assoc (downcase extn) mailcap-mime-extensions)))

;; Unused?
(defalias 'mailcap-command-p 'executable-find)

(defun mailcap-mime-types ()
  "Return a list of MIME media types."
  (mailcap-parse-mimetypes)
  (mm-delete-duplicates