X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-mailcap.el;h=232b0193190e1bf4d36c5bab1317ee40a1e4eb6b;hb=e2696774a2e225ea60d46cc665d4232c80412731;hp=2bdfec8f3b325e73f9f8f67d79197c28683bc378;hpb=1f2b93a24df7b9914dbbc1a26a6e76c8da6511d1;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-mailcap.el b/lisp/gnus-mailcap.el index 2bdfec8..232b019 100644 --- a/lisp/gnus-mailcap.el +++ b/lisp/gnus-mailcap.el @@ -1,5 +1,6 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -36,6 +37,7 @@ (defgroup mailcap nil "Definition of viewers for MIME types." + :version "21.1" :group 'mime) (defvar mailcap-parse-args-syntax-table @@ -45,14 +47,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 +89,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) @@ -113,36 +137,52 @@ ("copiousoutput")) ;; Prefer free viewers. ("pdf" - (viewer . "gv %s") + (viewer . "gv -safer %s") (type . "application/pdf") - (test . window-system)) + (test . window-system) + ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) ("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))) + (type . "application/pdf") + ("print" . ,(concat "cat %s | acroread -toPostScript | " + mailcap-print-command)) + (test . window-system)) + ("pdf" + (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 +212,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,7 +249,7 @@ (viewer . fundamental-mode) (type . "text/plain")) ("enriched" - (viewer . enriched-decode-region) + (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) ("html" @@ -225,7 +260,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" @@ -273,11 +308,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 ;;; @@ -305,7 +344,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 +393,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 +411,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 +627,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 +656,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 +666,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 +760,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 +778,7 @@ this type is returned." ;;; (defvar mailcap-mime-extensions - '(("" . "text/plain") + '(("" . "text/plain") (".abs" . "audio/x-mpeg") (".aif" . "audio/aiff") (".aifc" . "audio/aiff") @@ -806,6 +844,7 @@ this type is returned." (".rtx" . "text/richtext") (".sh" . "application/x-sh") (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") (".snd" . "audio/basic") (".src" . "application/x-wais-source") (".tar" . "archive/tar") @@ -823,6 +862,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 +889,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