1 |
;;; mailcap.el --- MIME media types configuration |
;;; mailcap.el --- MIME media types configuration |
2 |
;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc. |
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 |
3 |
|
;; Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: William M. Perry <wmperry@aventail.com> |
;; Author: William M. Perry <wmperry@aventail.com> |
6 |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
47 |
(modify-syntax-entry ?{ "(" table) |
(modify-syntax-entry ?{ "(" table) |
48 |
(modify-syntax-entry ?} ")" table) |
(modify-syntax-entry ?} ")" table) |
49 |
table) |
table) |
50 |
"A syntax table for parsing sgml attributes.") |
"A syntax table for parsing SGML attributes.") |
51 |
|
|
52 |
|
(eval-and-compile |
53 |
|
(when (featurep 'xemacs) |
54 |
|
(condition-case nil |
55 |
|
(require 'lpr) |
56 |
|
(error nil)))) |
57 |
|
|
58 |
|
(defvar mailcap-print-command |
59 |
|
(mapconcat 'identity |
60 |
|
(cons (if (boundp 'lpr-command) |
61 |
|
lpr-command |
62 |
|
"lpr") |
63 |
|
(when (boundp 'lpr-switches) |
64 |
|
(if (stringp lpr-switches) |
65 |
|
(list lpr-switches) |
66 |
|
lpr-switches))) |
67 |
|
" ") |
68 |
|
"Shell command (including switches) used to print Postscript files.") |
69 |
|
|
70 |
;; Postpone using defcustom for this as it's so big and we essentially |
;; Postpone using defcustom for this as it's so big and we essentially |
71 |
;; have to have two copies of the data around then. Perhaps just |
;; have to have two copies of the data around then. Perhaps just |
72 |
;; customize the Lisp viewers and rely on the normal configuration |
;; customize the Lisp viewers and rely on the normal configuration |
73 |
;; files for the rest? -- fx |
;; files for the rest? -- fx |
74 |
(defvar mailcap-mime-data |
(defvar mailcap-mime-data |
75 |
'(("application" |
`(("application" |
76 |
|
("vnd.ms-excel" |
77 |
|
(viewer . "gnumeric %s") |
78 |
|
(test . (getenv "DISPLAY")) |
79 |
|
(type . "application/vnd.ms-excel")) |
80 |
("x-x509-ca-cert" |
("x-x509-ca-cert" |
81 |
(viewer . ssl-view-site-cert) |
(viewer . ssl-view-site-cert) |
82 |
(test . (fboundp 'ssl-view-site-cert)) |
(test . (fboundp 'ssl-view-site-cert)) |
89 |
(viewer . mailcap-save-binary-file) |
(viewer . mailcap-save-binary-file) |
90 |
(non-viewer . t) |
(non-viewer . t) |
91 |
(type . "application/octet-stream")) |
(type . "application/octet-stream")) |
|
;;; XEmacs says `ns' device-type not implemented. |
|
|
;; ("dvi" |
|
|
;; (viewer . "open %s") |
|
|
;; (type . "application/dvi") |
|
|
;; (test . (eq (mm-device-type) 'ns))) |
|
92 |
("dvi" |
("dvi" |
93 |
(viewer . "xdvi %s") |
(viewer . "xdvi -safer %s") |
94 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
95 |
("needsx11") |
("needsx11") |
96 |
(type . "application/dvi")) |
(type . "application/dvi") |
97 |
|
("print" . "dvips -qRP %s")) |
98 |
("dvi" |
("dvi" |
99 |
(viewer . "dvitty %s") |
(viewer . "dvitty %s") |
100 |
(test . (not (getenv "DISPLAY"))) |
(test . (not (getenv "DISPLAY"))) |
101 |
(type . "application/dvi")) |
(type . "application/dvi") |
102 |
|
("print" . "dvips -qRP %s")) |
103 |
("emacs-lisp" |
("emacs-lisp" |
104 |
(viewer . mailcap-maybe-eval) |
(viewer . mailcap-maybe-eval) |
105 |
(type . "application/emacs-lisp")) |
(type . "application/emacs-lisp")) |
106 |
|
("x-emacs-lisp" |
107 |
|
(viewer . mailcap-maybe-eval) |
108 |
|
(type . "application/x-emacs-lisp")) |
109 |
("x-tar" |
("x-tar" |
110 |
(viewer . mailcap-save-binary-file) |
(viewer . mailcap-save-binary-file) |
111 |
(non-viewer . t) |
(non-viewer . t) |
137 |
("copiousoutput")) |
("copiousoutput")) |
138 |
;; Prefer free viewers. |
;; Prefer free viewers. |
139 |
("pdf" |
("pdf" |
140 |
(viewer . "gv %s") |
(viewer . "gv -safer %s") |
141 |
(type . "application/pdf") |
(type . "application/pdf") |
142 |
(test . window-system)) |
(test . window-system) |
143 |
|
("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) |
144 |
("pdf" |
("pdf" |
145 |
(viewer . "xpdf %s") |
(viewer . "xpdf %s") |
146 |
(type . "application/pdf") |
(type . "application/pdf") |
147 |
(test . (eq (mm-device-type) 'x))) |
("print" . ,(concat "pdftops %s - | " mailcap-print-command)) |
148 |
|
(test . (eq window-system 'x))) |
149 |
("pdf" |
("pdf" |
150 |
(viewer . "acroread %s") |
(viewer . "acroread %s") |
151 |
(type . "application/pdf")) |
(type . "application/pdf") |
152 |
;;; XEmacs says `ns' device-type not implemented. |
("print" . ,(concat "cat %s | acroread -toPostScript | " |
153 |
;; ("postscript" |
mailcap-print-command)) |
154 |
;; (viewer . "open %s") |
(test . window-system)) |
155 |
;; (type . "application/postscript") |
("pdf" |
156 |
;; (test . (eq (mm-device-type) 'ns))) |
(viewer . ,(concat "pdftotext %s -")) |
157 |
|
(type . "application/pdf") |
158 |
|
("print" . ,(concat "pdftops %s - | " mailcap-print-command)) |
159 |
|
("copiousoutput")) |
160 |
("postscript" |
("postscript" |
161 |
(viewer . "gv -safer %s") |
(viewer . "gv -safer %s") |
162 |
(type . "application/postscript") |
(type . "application/postscript") |
163 |
(test . window-system) |
(test . window-system) |
164 |
|
("print" . ,(concat mailcap-print-command " %s")) |
165 |
("needsx11")) |
("needsx11")) |
166 |
("postscript" |
("postscript" |
167 |
(viewer . "ghostview -dSAFER %s") |
(viewer . "ghostview -dSAFER %s") |
168 |
(type . "application/postscript") |
(type . "application/postscript") |
169 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
170 |
|
("print" . ,(concat mailcap-print-command " %s")) |
171 |
("needsx11")) |
("needsx11")) |
172 |
("postscript" |
("postscript" |
173 |
(viewer . "ps2ascii %s") |
(viewer . "ps2ascii %s") |
174 |
(type . "application/postscript") |
(type . "application/postscript") |
175 |
(test . (not (getenv "DISPLAY"))) |
(test . (not (getenv "DISPLAY"))) |
176 |
("copiousoutput"))) |
("print" . ,(concat mailcap-print-command " %s")) |
177 |
|
("copiousoutput")) |
178 |
|
("sieve" |
179 |
|
(viewer . sieve-mode) |
180 |
|
(test . (fboundp 'sieve-mode)) |
181 |
|
(type . "application/sieve")) |
182 |
|
("pgp-keys" |
183 |
|
(viewer . "gpg --import --interactive --verbose") |
184 |
|
(type . "application/pgp-keys") |
185 |
|
("needsterminal"))) |
186 |
("audio" |
("audio" |
187 |
("x-mpeg" |
("x-mpeg" |
188 |
(viewer . "maplay %s") |
(viewer . "maplay %s") |
212 |
(viewer . "xwud -in %s") |
(viewer . "xwud -in %s") |
213 |
(type . "image/x-xwd") |
(type . "image/x-xwd") |
214 |
("compose" . "xwd -frame > %s") |
("compose" . "xwd -frame > %s") |
215 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
216 |
("needsx11")) |
("needsx11")) |
217 |
("x11-dump" |
("x11-dump" |
218 |
(viewer . "xwud -in %s") |
(viewer . "xwud -in %s") |
219 |
(type . "image/x-xwd") |
(type . "image/x-xwd") |
220 |
("compose" . "xwd -frame > %s") |
("compose" . "xwd -frame > %s") |
221 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
222 |
("needsx11")) |
("needsx11")) |
223 |
("windowdump" |
("windowdump" |
224 |
(viewer . "xwud -in %s") |
(viewer . "xwud -in %s") |
225 |
(type . "image/x-xwd") |
(type . "image/x-xwd") |
226 |
("compose" . "xwd -frame > %s") |
("compose" . "xwd -frame > %s") |
227 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
228 |
("needsx11")) |
("needsx11")) |
|
;;; XEmacs says `ns' device-type not implemented. |
|
|
;; (".*" |
|
|
;; (viewer . "aopen %s") |
|
|
;; (type . "image/*") |
|
|
;; (test . (eq (mm-device-type) 'ns))) |
|
229 |
(".*" |
(".*" |
230 |
(viewer . "display %s") |
(viewer . "display %s") |
231 |
(type . "image/*") |
(type . "image/*") |
232 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
233 |
("needsx11")) |
("needsx11")) |
234 |
(".*" |
(".*" |
235 |
(viewer . "ee %s") |
(viewer . "ee %s") |
236 |
(type . "image/*") |
(type . "image/*") |
237 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
238 |
("needsx11"))) |
("needsx11"))) |
239 |
("text" |
("text" |
240 |
("plain" |
("plain" |
249 |
(viewer . fundamental-mode) |
(viewer . fundamental-mode) |
250 |
(type . "text/plain")) |
(type . "text/plain")) |
251 |
("enriched" |
("enriched" |
252 |
(viewer . enriched-decode-region) |
(viewer . enriched-decode) |
253 |
(test . (fboundp 'enriched-decode)) |
(test . (fboundp 'enriched-decode)) |
254 |
(type . "text/enriched")) |
(type . "text/enriched")) |
255 |
("html" |
("html" |
260 |
("mpeg" |
("mpeg" |
261 |
(viewer . "mpeg_play %s") |
(viewer . "mpeg_play %s") |
262 |
(type . "video/mpeg") |
(type . "video/mpeg") |
263 |
(test . (eq (mm-device-type) 'x)) |
(test . (eq window-system 'x)) |
264 |
("needsx11"))) |
("needsx11"))) |
265 |
("x-world" |
("x-world" |
266 |
("x-vrml" |
("x-vrml" |
305 |
whose car is a symbol, it is `eval'led to yield the validity. If it |
whose car is a symbol, it is `eval'led to yield the validity. If it |
306 |
is a string or list of strings, it represents a shell command to run |
is a string or list of strings, it represents a shell command to run |
307 |
to return a true or false shell value for the validity.") |
to return a true or false shell value for the validity.") |
|
(put 'mailcap-mime-data 'risky-local-variable t) |
|
308 |
|
|
309 |
(defcustom mailcap-download-directory nil |
(defcustom mailcap-download-directory nil |
310 |
"*Directory to which `mailcap-save-binary-file' downloads files by default. |
"*Directory to which `mailcap-save-binary-file' downloads files by default. |
313 |
directory) |
directory) |
314 |
:group 'mailcap) |
:group 'mailcap) |
315 |
|
|
316 |
|
(defvar mailcap-poor-system-types |
317 |
|
'(ms-dos ms-windows windows-nt win32 w32 mswindows) |
318 |
|
"Systems that don't have a Unix-like directory hierarchy.") |
319 |
|
|
320 |
;;; |
;;; |
321 |
;;; Utility functions |
;;; Utility functions |
322 |
;;; |
;;; |
393 |
(cond |
(cond |
394 |
(path nil) |
(path nil) |
395 |
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) |
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) |
396 |
((memq system-type '(ms-dos ms-windows windows-nt)) |
((memq system-type mailcap-poor-system-types) |
397 |
(setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) |
(setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) |
398 |
(t (setq path |
(t (setq path |
399 |
;; This is per RFC 1524, specifically |
;; This is per RFC 1524, specifically |
570 |
(cond |
(cond |
571 |
((equal (car (car major)) minor) |
((equal (car (car major)) minor) |
572 |
(setq exact (cons (cdr (car major)) exact))) |
(setq exact (cons (cdr (car major)) exact))) |
573 |
((and minor (string-match (car (car major)) minor)) |
((and minor (string-match (concat "^" (car (car major)) "$") minor)) |
574 |
(setq wildcard (cons (cdr (car major)) wildcard)))) |
(setq wildcard (cons (cdr (car major)) wildcard)))) |
575 |
(setq major (cdr major))) |
(setq major (cdr major))) |
576 |
(nconc exact wildcard))) |
(nconc exact wildcard))) |
627 |
|
|
628 |
(defun mailcap-viewer-passes-test (viewer-info type-info) |
(defun mailcap-viewer-passes-test (viewer-info type-info) |
629 |
"Return non-nil iff viewer specified by VIEWER-INFO passes its test clause. |
"Return non-nil iff viewer specified by VIEWER-INFO passes its test clause. |
630 |
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 |
631 |
to supply to the test." |
to supply to the test." |
632 |
(let* ((test-info (assq 'test viewer-info)) |
(let* ((test-info (assq 'test viewer-info)) |
633 |
(test (cdr test-info)) |
(test (cdr test-info)) |
656 |
test (list shell-file-name nil nil nil |
test (list shell-file-name nil nil nil |
657 |
shell-command-switch test) |
shell-command-switch test) |
658 |
status (apply 'call-process test)) |
status (apply 'call-process test)) |
659 |
(= 0 status)))) |
(eq 0 status)))) |
660 |
(push (list otest result) mailcap-viewer-test-cache) |
(push (list otest result) mailcap-viewer-test-cache) |
661 |
result))) |
result))) |
662 |
|
|
666 |
(setq mailcap-mime-data |
(setq mailcap-mime-data |
667 |
(cons (cons major (list (cons minor info))) |
(cons (cons major (list (cons minor info))) |
668 |
mailcap-mime-data)) |
mailcap-mime-data)) |
669 |
(let ((cur-minor (assoc minor old-major))) |
(let ((cur-minor (assoc minor old-major))) |
670 |
(cond |
(cond |
671 |
((or (null cur-minor) ; New minor area, or |
((or (null cur-minor) ; New minor area, or |
672 |
(assq 'test info)) ; Has a test, insert at beginning |
(assq 'test info)) ; Has a test, insert at beginning |
673 |
(setcdr old-major (cons (cons minor info) (cdr old-major)))) |
(setcdr old-major (cons (cons minor info) (cdr old-major)))) |
674 |
((and (not (assq 'test info)) ; No test info, replace completely |
((and (not (assq 'test info)) ; No test info, replace completely |
675 |
(not (assq 'test cur-minor)) |
(not (assq 'test cur-minor)) |
676 |
(equal (assq 'viewer info) ; Keep alternative viewer |
(equal (assq 'viewer info) ; Keep alternative viewer |
677 |
(assq 'viewer cur-minor))) |
(assq 'viewer cur-minor))) |
678 |
(setcdr cur-minor info)) |
(setcdr cur-minor info)) |
679 |
(t |
(t |
680 |
(setcdr old-major (cons (cons minor info) (cdr old-major)))))) |
(setcdr old-major (cons (cons minor info) (cdr old-major)))))) |
681 |
))) |
))) |
682 |
|
|
683 |
(defun mailcap-add (type viewer &optional test) |
(defun mailcap-add (type viewer &optional test) |
760 |
((or (null request) (equal request "")) |
((or (null request) (equal request "")) |
761 |
(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) |
(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) |
762 |
((stringp request) |
((stringp request) |
763 |
(if (or (eq request 'test) (eq request 'viewer)) |
(mailcap-unescape-mime-test |
764 |
(mailcap-unescape-mime-test |
(cdr-safe (assoc request viewer)) info)) |
|
(cdr-safe (assoc request viewer)) info))) |
|
765 |
((eq request 'all) |
((eq request 'all) |
766 |
passed) |
passed) |
767 |
(t |
(t |
844 |
(".rtx" . "text/richtext") |
(".rtx" . "text/richtext") |
845 |
(".sh" . "application/x-sh") |
(".sh" . "application/x-sh") |
846 |
(".sit" . "application/x-stuffit") |
(".sit" . "application/x-stuffit") |
847 |
|
(".siv" . "application/sieve") |
848 |
(".snd" . "audio/basic") |
(".snd" . "audio/basic") |
849 |
(".src" . "application/x-wais-source") |
(".src" . "application/x-wais-source") |
850 |
(".tar" . "archive/tar") |
(".tar" . "archive/tar") |
862 |
(".vox" . "audio/basic") |
(".vox" . "audio/basic") |
863 |
(".vrml" . "x-world/x-vrml") |
(".vrml" . "x-world/x-vrml") |
864 |
(".wav" . "audio/x-wav") |
(".wav" . "audio/x-wav") |
865 |
|
(".xls" . "application/vnd.ms-excel") |
866 |
(".wrl" . "x-world/x-vrml") |
(".wrl" . "x-world/x-vrml") |
867 |
(".xbm" . "image/xbm") |
(".xbm" . "image/xbm") |
868 |
(".xpm" . "image/xpm") |
(".xpm" . "image/xpm") |
889 |
(cond |
(cond |
890 |
(path nil) |
(path nil) |
891 |
((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) |
((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) |
892 |
((memq system-type '(ms-dos ms-windows windows-nt)) |
((memq system-type mailcap-poor-system-types) |
893 |
(setq path '("~/mime.typ" "~/etc/mime.typ"))) |
(setq path '("~/mime.typ" "~/etc/mime.typ"))) |
894 |
(t (setq path |
(t (setq path |
895 |
;; mime.types seems to be the normal name, definitely so |
;; mime.types seems to be the normal name, definitely so |