X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-mailcap.el;h=4e624e16da692db8711cbc05e87bc57ccaa2ee06;hb=779dd81d09cb6fa76e6a0fd64147099b7cf0119d;hp=2bdfec8f3b325e73f9f8f67d79197c28683bc378;hpb=1f2b93a24df7b9914dbbc1a26a6e76c8da6511d1;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 2bdfec8..4e624e1 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -1,5 +1,7 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. + +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -19,8 +21,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -36,6 +38,7 @@ (defgroup mailcap nil "Definition of viewers for MIME types." + :version "21.1" :group 'mime) (defvar mailcap-parse-args-syntax-table @@ -45,14 +48,36 @@ (modify-syntax-entry ?{ "(" table) (modify-syntax-entry ?} ")" table) table) - "A syntax table for parsing sgml attributes.") + "A syntax table for parsing SGML attributes.") + +(eval-and-compile + (when (featurep 'xemacs) + (condition-case nil + (require 'lpr) + (error nil)))) + +(defvar mailcap-print-command + (mapconcat 'identity + (cons (if (boundp 'lpr-command) + lpr-command + "lpr") + (when (boundp 'lpr-switches) + (if (stringp lpr-switches) + (list lpr-switches) + lpr-switches))) + " ") + "Shell command (including switches) used to print Postscript files.") ;; 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" + `(("application" + ("vnd.ms-excel" + (viewer . "gnumeric %s") + (test . (getenv "DISPLAY")) + (type . "application/vnd.ms-excel")) ("x-x509-ca-cert" (viewer . ssl-view-site-cert) (test . (fboundp 'ssl-view-site-cert)) @@ -65,23 +90,23 @@ (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)) + (viewer . "xdvi -safer %s") + (test . (eq window-system 'x)) ("needsx11") - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("dvi" (viewer . "dvitty %s") (test . (not (getenv "DISPLAY"))) - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("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) @@ -111,38 +136,52 @@ (non-viewer . t) (type . "application/zip") ("copiousoutput")) - ;; Prefer free viewers. ("pdf" - (viewer . "gv %s") + (viewer . "gv -safer %s") + (type . "application/pdf") + (test . window-system) + ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) + ("pdf" + (viewer . "gpdf %s") (type . "application/pdf") - (test . window-system)) + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system 'x))) ("pdf" (viewer . "xpdf %s") (type . "application/pdf") - (test . (eq (mm-device-type) 'x))) + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system '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))) + (viewer . ,(concat "pdftotext %s -")) + (type . "application/pdf") + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + ("copiousoutput")) ("postscript" (viewer . "gv -safer %s") (type . "application/postscript") (test . window-system) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ghostview -dSAFER %s") (type . "application/postscript") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ps2ascii %s") (type . "application/postscript") (test . (not (getenv "DISPLAY"))) - ("copiousoutput"))) + ("print" . ,(concat mailcap-print-command " %s")) + ("copiousoutput")) + ("sieve" + (viewer . sieve-mode) + (test . (fboundp 'sieve-mode)) + (type . "application/sieve")) + ("pgp-keys" + (viewer . "gpg --import --interactive --verbose") + (type . "application/pgp-keys") + ("needsterminal"))) ("audio" ("x-mpeg" (viewer . "maplay %s") @@ -172,34 +211,29 @@ (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. -;; (".*" -;; (viewer . "aopen %s") -;; (type . "image/*") -;; (test . (eq (mm-device-type) 'ns))) (".*" (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" @@ -214,18 +248,22 @@ (viewer . fundamental-mode) (type . "text/plain")) ("enriched" - (viewer . enriched-decode-region) + (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) ("html" (viewer . mm-w3-prepare-buffer) (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html"))) + (type . "text/html")) + ("dns" + (viewer . dns-mode) + (test . (fboundp 'dns-mode)) + (type . "text/dns"))) ("video" ("mpeg" (viewer . "mpeg_play %s") (type . "video/mpeg") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11"))) ("x-world" ("x-vrml" @@ -270,14 +308,19 @@ 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.") +(put 'mailcap-mime-data 'risky-local-variable t) (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 ;;; @@ -305,7 +348,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))) @@ -354,7 +397,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 @@ -372,7 +415,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (file-regular-p fname)) (mailcap-parse-mailcap fname)) (setq fnames (cdr fnames)))) - (setq mailcap-parsed-p t))) + (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) "Parse out the mailcap file specified by FNAME." @@ -588,7 +631,7 @@ Also return non-nil if no test clause is present." (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 +Also return 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)) @@ -617,7 +660,7 @@ to supply to the test." test (list shell-file-name nil nil nil shell-command-switch test) status (apply 'call-process test)) - (= 0 status)))) + (eq 0 status)))) (push (list otest result) mailcap-viewer-test-cache) result))) @@ -627,18 +670,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) @@ -721,9 +764,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 @@ -740,7 +782,7 @@ this type is returned." ;;; (defvar mailcap-mime-extensions - '(("" . "text/plain") + '(("" . "text/plain") (".abs" . "audio/x-mpeg") (".aif" . "audio/aiff") (".aifc" . "audio/aiff") @@ -806,7 +848,9 @@ this type is returned." (".rtx" . "text/richtext") (".sh" . "application/x-sh") (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") (".snd" . "audio/basic") + (".soa" . "text/dns") (".src" . "application/x-wais-source") (".tar" . "archive/tar") (".tcl" . "application/x-tcl") @@ -823,6 +867,7 @@ this type is returned." (".vox" . "audio/basic") (".vrml" . "x-world/x-vrml") (".wav" . "audio/x-wav") + (".xls" . "application/vnd.ms-excel") (".wrl" . "x-world/x-vrml") (".xbm" . "image/xbm") (".xpm" . "image/xpm") @@ -849,7 +894,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