|
33821
|
1 ;;; mailcap.el --- MIME media types configuration
|
|
64754
|
2
|
|
|
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
|
79708
|
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
|
31717
|
5
|
|
|
6 ;; Author: William M. Perry <wmperry@aventail.com>
|
|
|
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
|
|
33821
|
8 ;; Keywords: news, mail, multimedia
|
|
31717
|
9
|
|
|
10 ;; This file is part of GNU Emacs.
|
|
|
11
|
|
94662
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
31717
|
13 ;; it under the terms of the GNU General Public License as published by
|
|
94662
|
14 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
15 ;; (at your option) any later version.
|
|
31717
|
16
|
|
|
17 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
94662
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
31717
|
20 ;; GNU General Public License for more details.
|
|
|
21
|
|
|
22 ;; You should have received a copy of the GNU General Public License
|
|
94662
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
31717
|
24
|
|
|
25 ;;; Commentary:
|
|
|
26
|
|
33821
|
27 ;; Provides configuration of MIME media types from directly from Lisp
|
|
|
28 ;; and via the usual mailcap mechanism (RFC 1524). Deals with
|
|
|
29 ;; mime.types similarly.
|
|
|
30
|
|
31717
|
31 ;;; Code:
|
|
|
32
|
|
|
33 (eval-when-compile (require 'cl))
|
|
87097
|
34 (autoload 'mail-header-parse-content-type "mail-parse")
|
|
|
35
|
|
|
36 ;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22.
|
|
|
37 (defalias 'mailcap-delete-duplicates
|
|
|
38 (if (fboundp 'delete-dups)
|
|
|
39 'delete-dups
|
|
|
40 (autoload 'mm-delete-duplicates "mm-util")
|
|
|
41 'mm-delete-duplicates))
|
|
31717
|
42
|
|
94616
|
43 ;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'.
|
|
|
44 (eval-and-compile
|
|
|
45 (cond
|
|
|
46 ((fboundp 'replace-regexp-in-string)
|
|
|
47 (defun mailcap-replace-in-string (string regexp newtext &optional literal)
|
|
|
48 "Replace all matches for REGEXP with NEWTEXT in STRING.
|
|
|
49 If LITERAL is non-nil, insert NEWTEXT literally. Return a new
|
|
|
50 string containing the replacements.
|
|
|
51 This is a compatibility function for different Emacsen."
|
|
|
52 (replace-regexp-in-string regexp newtext string nil literal)))
|
|
|
53 ((fboundp 'replace-in-string)
|
|
|
54 (defalias 'mailcap-replace-in-string 'replace-in-string))))
|
|
|
55
|
|
33821
|
56 (defgroup mailcap nil
|
|
|
57 "Definition of viewers for MIME types."
|
|
|
58 :version "21.1"
|
|
|
59 :group 'mime)
|
|
|
60
|
|
31717
|
61 (defvar mailcap-parse-args-syntax-table
|
|
|
62 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
|
|
|
63 (modify-syntax-entry ?' "\"" table)
|
|
|
64 (modify-syntax-entry ?` "\"" table)
|
|
|
65 (modify-syntax-entry ?{ "(" table)
|
|
|
66 (modify-syntax-entry ?} ")" table)
|
|
|
67 table)
|
|
56927
|
68 "A syntax table for parsing SGML attributes.")
|
|
|
69
|
|
|
70 (eval-and-compile
|
|
|
71 (when (featurep 'xemacs)
|
|
|
72 (condition-case nil
|
|
|
73 (require 'lpr)
|
|
|
74 (error nil))))
|
|
|
75
|
|
|
76 (defvar mailcap-print-command
|
|
|
77 (mapconcat 'identity
|
|
|
78 (cons (if (boundp 'lpr-command)
|
|
|
79 lpr-command
|
|
|
80 "lpr")
|
|
|
81 (when (boundp 'lpr-switches)
|
|
|
82 (if (stringp lpr-switches)
|
|
|
83 (list lpr-switches)
|
|
|
84 lpr-switches)))
|
|
|
85 " ")
|
|
|
86 "Shell command (including switches) used to print Postscript files.")
|
|
31717
|
87
|
|
33821
|
88 ;; Postpone using defcustom for this as it's so big and we essentially
|
|
|
89 ;; have to have two copies of the data around then. Perhaps just
|
|
|
90 ;; customize the Lisp viewers and rely on the normal configuration
|
|
|
91 ;; files for the rest? -- fx
|
|
31717
|
92 (defvar mailcap-mime-data
|
|
56927
|
93 `(("application"
|
|
|
94 ("vnd.ms-excel"
|
|
|
95 (viewer . "gnumeric %s")
|
|
|
96 (test . (getenv "DISPLAY"))
|
|
|
97 (type . "application/vnd.ms-excel"))
|
|
31717
|
98 ("x-x509-ca-cert"
|
|
|
99 (viewer . ssl-view-site-cert)
|
|
|
100 (test . (fboundp 'ssl-view-site-cert))
|
|
|
101 (type . "application/x-x509-ca-cert"))
|
|
|
102 ("x-x509-user-cert"
|
|
|
103 (viewer . ssl-view-user-cert)
|
|
|
104 (test . (fboundp 'ssl-view-user-cert))
|
|
|
105 (type . "application/x-x509-user-cert"))
|
|
|
106 ("octet-stream"
|
|
|
107 (viewer . mailcap-save-binary-file)
|
|
|
108 (non-viewer . t)
|
|
|
109 (type . "application/octet-stream"))
|
|
|
110 ("dvi"
|
|
56927
|
111 (viewer . "xdvi -safer %s")
|
|
|
112 (test . (eq window-system 'x))
|
|
31717
|
113 ("needsx11")
|
|
56927
|
114 (type . "application/dvi")
|
|
|
115 ("print" . "dvips -qRP %s"))
|
|
31717
|
116 ("dvi"
|
|
|
117 (viewer . "dvitty %s")
|
|
|
118 (test . (not (getenv "DISPLAY")))
|
|
56927
|
119 (type . "application/dvi")
|
|
|
120 ("print" . "dvips -qRP %s"))
|
|
31717
|
121 ("emacs-lisp"
|
|
|
122 (viewer . mailcap-maybe-eval)
|
|
|
123 (type . "application/emacs-lisp"))
|
|
56927
|
124 ("x-emacs-lisp"
|
|
|
125 (viewer . mailcap-maybe-eval)
|
|
|
126 (type . "application/x-emacs-lisp"))
|
|
31717
|
127 ("x-tar"
|
|
|
128 (viewer . mailcap-save-binary-file)
|
|
|
129 (non-viewer . t)
|
|
|
130 (type . "application/x-tar"))
|
|
|
131 ("x-latex"
|
|
|
132 (viewer . tex-mode)
|
|
|
133 (test . (fboundp 'tex-mode))
|
|
|
134 (type . "application/x-latex"))
|
|
|
135 ("x-tex"
|
|
|
136 (viewer . tex-mode)
|
|
|
137 (test . (fboundp 'tex-mode))
|
|
|
138 (type . "application/x-tex"))
|
|
|
139 ("latex"
|
|
|
140 (viewer . tex-mode)
|
|
|
141 (test . (fboundp 'tex-mode))
|
|
|
142 (type . "application/latex"))
|
|
|
143 ("tex"
|
|
|
144 (viewer . tex-mode)
|
|
|
145 (test . (fboundp 'tex-mode))
|
|
|
146 (type . "application/tex"))
|
|
|
147 ("texinfo"
|
|
|
148 (viewer . texinfo-mode)
|
|
|
149 (test . (fboundp 'texinfo-mode))
|
|
|
150 (type . "application/tex"))
|
|
|
151 ("zip"
|
|
|
152 (viewer . mailcap-save-binary-file)
|
|
|
153 (non-viewer . t)
|
|
|
154 (type . "application/zip")
|
|
|
155 ("copiousoutput"))
|
|
33821
|
156 ("pdf"
|
|
56927
|
157 (viewer . "gv -safer %s")
|
|
33821
|
158 (type . "application/pdf")
|
|
56927
|
159 (test . window-system)
|
|
|
160 ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
|
|
33821
|
161 ("pdf"
|
|
57294
|
162 (viewer . "gpdf %s")
|
|
33821
|
163 (type . "application/pdf")
|
|
56927
|
164 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
|
|
|
165 (test . (eq window-system 'x)))
|
|
31717
|
166 ("pdf"
|
|
57294
|
167 (viewer . "xpdf %s")
|
|
|
168 (type . "application/pdf")
|
|
|
169 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
|
|
|
170 (test . (eq window-system 'x)))
|
|
56927
|
171 ("pdf"
|
|
|
172 (viewer . ,(concat "pdftotext %s -"))
|
|
|
173 (type . "application/pdf")
|
|
|
174 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
|
|
|
175 ("copiousoutput"))
|
|
31717
|
176 ("postscript"
|
|
33821
|
177 (viewer . "gv -safer %s")
|
|
|
178 (type . "application/postscript")
|
|
|
179 (test . window-system)
|
|
56927
|
180 ("print" . ,(concat mailcap-print-command " %s"))
|
|
33821
|
181 ("needsx11"))
|
|
31717
|
182 ("postscript"
|
|
|
183 (viewer . "ghostview -dSAFER %s")
|
|
|
184 (type . "application/postscript")
|
|
56927
|
185 (test . (eq window-system 'x))
|
|
|
186 ("print" . ,(concat mailcap-print-command " %s"))
|
|
31717
|
187 ("needsx11"))
|
|
|
188 ("postscript"
|
|
|
189 (viewer . "ps2ascii %s")
|
|
|
190 (type . "application/postscript")
|
|
|
191 (test . (not (getenv "DISPLAY")))
|
|
56927
|
192 ("print" . ,(concat mailcap-print-command " %s"))
|
|
|
193 ("copiousoutput"))
|
|
|
194 ("sieve"
|
|
|
195 (viewer . sieve-mode)
|
|
|
196 (test . (fboundp 'sieve-mode))
|
|
|
197 (type . "application/sieve"))
|
|
|
198 ("pgp-keys"
|
|
|
199 (viewer . "gpg --import --interactive --verbose")
|
|
|
200 (type . "application/pgp-keys")
|
|
|
201 ("needsterminal")))
|
|
31717
|
202 ("audio"
|
|
|
203 ("x-mpeg"
|
|
|
204 (viewer . "maplay %s")
|
|
|
205 (type . "audio/x-mpeg"))
|
|
|
206 (".*"
|
|
|
207 (viewer . "showaudio")
|
|
|
208 (type . "audio/*")))
|
|
|
209 ("message"
|
|
|
210 ("rfc-*822"
|
|
|
211 (viewer . mm-view-message)
|
|
|
212 (test . (and (featurep 'gnus)
|
|
|
213 (gnus-alive-p)))
|
|
|
214 (type . "message/rfc822"))
|
|
|
215 ("rfc-*822"
|
|
|
216 (viewer . vm-mode)
|
|
|
217 (test . (fboundp 'vm-mode))
|
|
|
218 (type . "message/rfc822"))
|
|
|
219 ("rfc-*822"
|
|
|
220 (viewer . w3-mode)
|
|
|
221 (test . (fboundp 'w3-mode))
|
|
|
222 (type . "message/rfc822"))
|
|
|
223 ("rfc-*822"
|
|
|
224 (viewer . view-mode)
|
|
|
225 (type . "message/rfc822")))
|
|
|
226 ("image"
|
|
|
227 ("x-xwd"
|
|
|
228 (viewer . "xwud -in %s")
|
|
|
229 (type . "image/x-xwd")
|
|
|
230 ("compose" . "xwd -frame > %s")
|
|
56927
|
231 (test . (eq window-system 'x))
|
|
31717
|
232 ("needsx11"))
|
|
|
233 ("x11-dump"
|
|
|
234 (viewer . "xwud -in %s")
|
|
|
235 (type . "image/x-xwd")
|
|
|
236 ("compose" . "xwd -frame > %s")
|
|
56927
|
237 (test . (eq window-system 'x))
|
|
31717
|
238 ("needsx11"))
|
|
|
239 ("windowdump"
|
|
|
240 (viewer . "xwud -in %s")
|
|
|
241 (type . "image/x-xwd")
|
|
|
242 ("compose" . "xwd -frame > %s")
|
|
56927
|
243 (test . (eq window-system 'x))
|
|
31717
|
244 ("needsx11"))
|
|
|
245 (".*"
|
|
|
246 (viewer . "display %s")
|
|
|
247 (type . "image/*")
|
|
56927
|
248 (test . (eq window-system 'x))
|
|
31717
|
249 ("needsx11"))
|
|
|
250 (".*"
|
|
|
251 (viewer . "ee %s")
|
|
|
252 (type . "image/*")
|
|
56927
|
253 (test . (eq window-system 'x))
|
|
31717
|
254 ("needsx11")))
|
|
|
255 ("text"
|
|
|
256 ("plain"
|
|
|
257 (viewer . w3-mode)
|
|
|
258 (test . (fboundp 'w3-mode))
|
|
|
259 (type . "text/plain"))
|
|
|
260 ("plain"
|
|
|
261 (viewer . view-mode)
|
|
|
262 (test . (fboundp 'view-mode))
|
|
|
263 (type . "text/plain"))
|
|
|
264 ("plain"
|
|
|
265 (viewer . fundamental-mode)
|
|
|
266 (type . "text/plain"))
|
|
|
267 ("enriched"
|
|
56927
|
268 (viewer . enriched-decode)
|
|
31717
|
269 (test . (fboundp 'enriched-decode))
|
|
|
270 (type . "text/enriched"))
|
|
|
271 ("html"
|
|
|
272 (viewer . mm-w3-prepare-buffer)
|
|
|
273 (test . (fboundp 'w3-prepare-buffer))
|
|
85712
|
274 (type . "text/html"))
|
|
|
275 ("dns"
|
|
|
276 (viewer . dns-mode)
|
|
|
277 (test . (fboundp 'dns-mode))
|
|
|
278 (type . "text/dns")))
|
|
31717
|
279 ("video"
|
|
|
280 ("mpeg"
|
|
|
281 (viewer . "mpeg_play %s")
|
|
|
282 (type . "video/mpeg")
|
|
56927
|
283 (test . (eq window-system 'x))
|
|
31717
|
284 ("needsx11")))
|
|
|
285 ("x-world"
|
|
|
286 ("x-vrml"
|
|
|
287 (viewer . "webspace -remote %s -URL %u")
|
|
|
288 (type . "x-world/x-vrml")
|
|
|
289 ("description"
|
|
|
290 "VRML document")))
|
|
|
291 ("archive"
|
|
|
292 ("tar"
|
|
|
293 (viewer . tar-mode)
|
|
|
294 (type . "archive/tar")
|
|
|
295 (test . (fboundp 'tar-mode)))))
|
|
|
296 "The mailcap structure is an assoc list of assoc lists.
|
|
|
297 1st assoc list is keyed on the major content-type
|
|
|
298 2nd assoc list is keyed on the minor content-type (which can be a regexp)
|
|
|
299
|
|
|
300 Which looks like:
|
|
|
301 -----------------
|
|
|
302 ((\"application\"
|
|
|
303 (\"postscript\" . <info>))
|
|
|
304 (\"text\"
|
|
|
305 (\"plain\" . <info>)))
|
|
|
306
|
|
|
307 Where <info> is another assoc list of the various information
|
|
33821
|
308 related to the mailcap RFC 1524. This is keyed on the lowercase
|
|
31717
|
309 attribute name (viewer, test, etc). This looks like:
|
|
33821
|
310 ((viewer . VIEWERINFO)
|
|
|
311 (test . TESTINFO)
|
|
|
312 (xxxx . \"STRING\")
|
|
|
313 FLAG)
|
|
31717
|
314
|
|
33821
|
315 Where VIEWERINFO specifies how the content-type is viewed. Can be
|
|
31717
|
316 a string, in which case it is run through a shell, with
|
|
|
317 appropriate parameters, or a symbol, in which case the symbol is
|
|
33821
|
318 `funcall'ed, with the buffer as an argument.
|
|
31717
|
319
|
|
33821
|
320 TESTINFO is a test for the viewer's applicability, or nil. If nil, it
|
|
|
321 means the viewer is always valid. If it is a Lisp function, it is
|
|
|
322 called with a list of items from any extra fields from the
|
|
|
323 Content-Type header as argument to return a boolean value for the
|
|
|
324 validity. Otherwise, if it is a non-function Lisp symbol or list
|
|
|
325 whose car is a symbol, it is `eval'led to yield the validity. If it
|
|
|
326 is a string or list of strings, it represents a shell command to run
|
|
|
327 to return a true or false shell value for the validity.")
|
|
55046
|
328 (put 'mailcap-mime-data 'risky-local-variable t)
|
|
31717
|
329
|
|
33821
|
330 (defcustom mailcap-download-directory nil
|
|
34330
|
331 "*Directory to which `mailcap-save-binary-file' downloads files by default.
|
|
42206
|
332 nil means your home directory."
|
|
34330
|
333 :type '(choice (const :tag "Home directory" nil)
|
|
|
334 directory)
|
|
33821
|
335 :group 'mailcap)
|
|
31717
|
336
|
|
56927
|
337 (defvar mailcap-poor-system-types
|
|
|
338 '(ms-dos ms-windows windows-nt win32 w32 mswindows)
|
|
|
339 "Systems that don't have a Unix-like directory hierarchy.")
|
|
|
340
|
|
31717
|
341 ;;;
|
|
|
342 ;;; Utility functions
|
|
|
343 ;;;
|
|
|
344
|
|
|
345 (defun mailcap-save-binary-file ()
|
|
|
346 (goto-char (point-min))
|
|
|
347 (unwind-protect
|
|
|
348 (let ((file (read-file-name
|
|
|
349 "Filename to save as: "
|
|
|
350 (or mailcap-download-directory "~/")))
|
|
|
351 (require-final-newline nil))
|
|
|
352 (write-region (point-min) (point-max) file))
|
|
|
353 (kill-buffer (current-buffer))))
|
|
|
354
|
|
|
355 (defvar mailcap-maybe-eval-warning
|
|
|
356 "*** WARNING ***
|
|
|
357
|
|
33821
|
358 This MIME part contains untrusted and possibly harmful content.
|
|
31717
|
359 If you evaluate the Emacs Lisp code contained in it, a lot of nasty
|
|
|
360 things can happen. Please examine the code very carefully before you
|
|
|
361 instruct Emacs to evaluate it. You can browse the buffer containing
|
|
|
362 the code using \\[scroll-other-window].
|
|
|
363
|
|
|
364 If you are unsure what to do, please answer \"no\"."
|
|
|
365 "Text of warning message displayed by `mailcap-maybe-eval'.
|
|
|
366 Make sure that this text consists only of few text lines. Otherwise,
|
|
|
367 Gnus might fail to display all of it.")
|
|
49598
|
368
|
|
31717
|
369 (defun mailcap-maybe-eval ()
|
|
33821
|
370 "Maybe evaluate a buffer of Emacs Lisp code."
|
|
31717
|
371 (let ((lisp-buffer (current-buffer)))
|
|
|
372 (goto-char (point-min))
|
|
|
373 (when
|
|
|
374 (save-window-excursion
|
|
|
375 (delete-other-windows)
|
|
|
376 (let ((buffer (get-buffer-create (generate-new-buffer-name
|
|
|
377 "*Warning*"))))
|
|
|
378 (unwind-protect
|
|
|
379 (with-current-buffer buffer
|
|
33821
|
380 (insert (substitute-command-keys
|
|
31717
|
381 mailcap-maybe-eval-warning))
|
|
|
382 (goto-char (point-min))
|
|
|
383 (display-buffer buffer)
|
|
|
384 (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
|
|
|
385 (kill-buffer buffer))))
|
|
|
386 (eval-buffer (current-buffer)))
|
|
|
387 (when (buffer-live-p lisp-buffer)
|
|
|
388 (with-current-buffer lisp-buffer
|
|
|
389 (emacs-lisp-mode)))))
|
|
|
390
|
|
|
391
|
|
|
392 ;;;
|
|
|
393 ;;; The mailcap parser
|
|
|
394 ;;;
|
|
|
395
|
|
|
396 (defun mailcap-replace-regexp (regexp to-string)
|
|
|
397 ;; Quiet replace-regexp.
|
|
|
398 (goto-char (point-min))
|
|
|
399 (while (re-search-forward regexp nil t)
|
|
|
400 (replace-match to-string t nil)))
|
|
|
401
|
|
|
402 (defvar mailcap-parsed-p nil)
|
|
|
403
|
|
|
404 (defun mailcap-parse-mailcaps (&optional path force)
|
|
|
405 "Parse out all the mailcaps specified in a path string PATH.
|
|
|
406 Components of PATH are separated by the `path-separator' character
|
|
|
407 appropriate for this system. If FORCE, re-parse even if already
|
|
|
408 parsed. If PATH is omitted, use the value of environment variable
|
|
|
409 MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
|
|
|
410 /usr/local/etc/mailcap."
|
|
|
411 (interactive (list nil t))
|
|
|
412 (when (or (not mailcap-parsed-p)
|
|
|
413 force)
|
|
|
414 (cond
|
|
|
415 (path nil)
|
|
|
416 ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
|
|
56927
|
417 ((memq system-type mailcap-poor-system-types)
|
|
31717
|
418 (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
|
|
|
419 (t (setq path
|
|
|
420 ;; This is per RFC 1524, specifically
|
|
|
421 ;; with /usr before /usr/local.
|
|
|
422 '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
|
|
|
423 "/usr/local/etc/mailcap"))))
|
|
|
424 (let ((fnames (reverse
|
|
|
425 (if (stringp path)
|
|
32989
|
426 (delete "" (split-string path path-separator))
|
|
31717
|
427 path)))
|
|
|
428 fname)
|
|
|
429 (while fnames
|
|
|
430 (setq fname (car fnames))
|
|
|
431 (if (and (file-readable-p fname)
|
|
|
432 (file-regular-p fname))
|
|
|
433 (mailcap-parse-mailcap fname))
|
|
|
434 (setq fnames (cdr fnames))))
|
|
|
435 (setq mailcap-parsed-p t)))
|
|
|
436
|
|
|
437 (defun mailcap-parse-mailcap (fname)
|
|
33821
|
438 "Parse out the mailcap file specified by FNAME."
|
|
31717
|
439 (let (major ; The major mime type (image/audio/etc)
|
|
|
440 minor ; The minor mime type (gif, basic, etc)
|
|
|
441 save-pos ; Misc saved positions used in parsing
|
|
|
442 viewer ; How to view this mime type
|
|
|
443 info ; Misc info about this mime type
|
|
|
444 )
|
|
|
445 (with-temp-buffer
|
|
|
446 (insert-file-contents fname)
|
|
|
447 (set-syntax-table mailcap-parse-args-syntax-table)
|
|
|
448 (mailcap-replace-regexp "#.*" "") ; Remove all comments
|
|
|
449 (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
|
|
|
450 (mailcap-replace-regexp "\n+" "\n") ; And blank lines
|
|
|
451 (goto-char (point-max))
|
|
|
452 (skip-chars-backward " \t\n")
|
|
|
453 (delete-region (point) (point-max))
|
|
|
454 (while (not (bobp))
|
|
|
455 (skip-chars-backward " \t\n")
|
|
|
456 (beginning-of-line)
|
|
|
457 (setq save-pos (point)
|
|
|
458 info nil)
|
|
|
459 (skip-chars-forward "^/; \t\n")
|
|
|
460 (downcase-region save-pos (point))
|
|
|
461 (setq major (buffer-substring save-pos (point)))
|
|
|
462 (skip-chars-forward " \t")
|
|
|
463 (setq minor "")
|
|
|
464 (when (eq (char-after) ?/)
|
|
|
465 (forward-char)
|
|
|
466 (skip-chars-forward " \t")
|
|
|
467 (setq save-pos (point))
|
|
|
468 (skip-chars-forward "^; \t\n")
|
|
|
469 (downcase-region save-pos (point))
|
|
|
470 (setq minor
|
|
|
471 (cond
|
|
|
472 ((eq ?* (or (char-after save-pos) 0)) ".*")
|
|
|
473 ((= (point) save-pos) ".*")
|
|
|
474 (t (regexp-quote (buffer-substring save-pos (point)))))))
|
|
|
475 (skip-chars-forward " \t")
|
|
|
476 ;;; Got the major/minor chunks, now for the viewers/etc
|
|
|
477 ;;; The first item _must_ be a viewer, according to the
|
|
33821
|
478 ;;; RFC for mailcap files (#1524)
|
|
31717
|
479 (setq viewer "")
|
|
33821
|
480 (when (eq (char-after) ?\;)
|
|
31717
|
481 (forward-char)
|
|
|
482 (skip-chars-forward " \t")
|
|
|
483 (setq save-pos (point))
|
|
|
484 (skip-chars-forward "^;\n")
|
|
|
485 ;; skip \;
|
|
|
486 (while (eq (char-before) ?\\)
|
|
|
487 (backward-delete-char 1)
|
|
|
488 (forward-char)
|
|
|
489 (skip-chars-forward "^;\n"))
|
|
|
490 (if (eq (or (char-after save-pos) 0) ?')
|
|
|
491 (setq viewer (progn
|
|
|
492 (narrow-to-region (1+ save-pos) (point))
|
|
|
493 (goto-char (point-min))
|
|
|
494 (prog1
|
|
|
495 (read (current-buffer))
|
|
|
496 (goto-char (point-max))
|
|
|
497 (widen))))
|
|
|
498 (setq viewer (buffer-substring save-pos (point)))))
|
|
|
499 (setq save-pos (point))
|
|
|
500 (end-of-line)
|
|
33821
|
501 (unless (equal viewer "")
|
|
31717
|
502 (setq info (nconc (list (cons 'viewer viewer)
|
|
|
503 (cons 'type (concat major "/"
|
|
|
504 (if (string= minor ".*")
|
|
|
505 "*" minor))))
|
|
|
506 (mailcap-parse-mailcap-extras save-pos (point))))
|
|
|
507 (mailcap-mailcap-entry-passes-test info)
|
|
|
508 (mailcap-add-mailcap-entry major minor info))
|
|
|
509 (beginning-of-line)))))
|
|
|
510
|
|
|
511 (defun mailcap-parse-mailcap-extras (st nd)
|
|
33821
|
512 "Grab all the extra stuff from a mailcap entry."
|
|
31717
|
513 (let (
|
|
|
514 name ; From name=
|
|
|
515 value ; its value
|
|
|
516 results ; Assoc list of results
|
|
|
517 name-pos ; Start of XXXX= position
|
|
|
518 val-pos ; Start of value position
|
|
|
519 done ; Found end of \'d ;s?
|
|
|
520 )
|
|
|
521 (save-restriction
|
|
|
522 (narrow-to-region st nd)
|
|
|
523 (goto-char (point-min))
|
|
|
524 (skip-chars-forward " \n\t;")
|
|
|
525 (while (not (eobp))
|
|
|
526 (setq done nil)
|
|
|
527 (setq name-pos (point))
|
|
|
528 (skip-chars-forward "^ \n\t=;")
|
|
|
529 (downcase-region name-pos (point))
|
|
|
530 (setq name (buffer-substring name-pos (point)))
|
|
|
531 (skip-chars-forward " \t\n")
|
|
|
532 (if (not (eq (char-after (point)) ?=)) ; There is no value
|
|
|
533 (setq value t)
|
|
|
534 (skip-chars-forward " \t\n=")
|
|
|
535 (setq val-pos (point))
|
|
|
536 (if (memq (char-after val-pos) '(?\" ?'))
|
|
|
537 (progn
|
|
|
538 (setq val-pos (1+ val-pos))
|
|
|
539 (condition-case nil
|
|
|
540 (progn
|
|
|
541 (forward-sexp 1)
|
|
|
542 (backward-char 1))
|
|
|
543 (error (goto-char (point-max)))))
|
|
|
544 (while (not done)
|
|
|
545 (skip-chars-forward "^;")
|
|
|
546 (if (eq (char-after (1- (point))) ?\\ )
|
|
|
547 (progn
|
|
|
548 (subst-char-in-region (1- (point)) (point) ?\\ ? )
|
|
|
549 (skip-chars-forward ";"))
|
|
|
550 (setq done t))))
|
|
|
551 (setq value (buffer-substring val-pos (point))))
|
|
68380
|
552 ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
|
|
|
553 ;; strings
|
|
|
554 (setq results (cons (cons (if (string-equal name "test")
|
|
|
555 'test
|
|
|
556 name)
|
|
|
557 value) results))
|
|
31717
|
558 (skip-chars-forward " \";\n\t"))
|
|
|
559 results)))
|
|
|
560
|
|
|
561 (defun mailcap-mailcap-entry-passes-test (info)
|
|
78486
|
562 "Return non-nil if mailcap entry INFO passes its test clause.
|
|
33821
|
563 Also return non-nil if no test clause is present."
|
|
|
564 (let ((test (assq 'test info)) ; The test clause
|
|
|
565 status)
|
|
31717
|
566 (setq status (and test (split-string (cdr test) " ")))
|
|
|
567 (if (and (or (assoc "needsterm" info)
|
|
|
568 (assoc "needsterminal" info)
|
|
|
569 (assoc "needsx11" info))
|
|
|
570 (not (getenv "DISPLAY")))
|
|
|
571 (setq status nil)
|
|
|
572 (cond
|
|
|
573 ((and (equal (nth 0 status) "test")
|
|
|
574 (equal (nth 1 status) "-n")
|
|
|
575 (or (equal (nth 2 status) "$DISPLAY")
|
|
|
576 (equal (nth 2 status) "\"$DISPLAY\"")))
|
|
|
577 (setq status (if (getenv "DISPLAY") t nil)))
|
|
|
578 ((and (equal (nth 0 status) "test")
|
|
|
579 (equal (nth 1 status) "-z")
|
|
|
580 (or (equal (nth 2 status) "$DISPLAY")
|
|
|
581 (equal (nth 2 status) "\"$DISPLAY\"")))
|
|
|
582 (setq status (if (getenv "DISPLAY") nil t)))
|
|
|
583 (test nil)
|
|
|
584 (t nil)))
|
|
|
585 (and test (listp test) (setcdr test status))))
|
|
|
586
|
|
|
587 ;;;
|
|
|
588 ;;; The action routines.
|
|
|
589 ;;;
|
|
|
590
|
|
|
591 (defun mailcap-possible-viewers (major minor)
|
|
33821
|
592 "Return a list of possible viewers from MAJOR for minor type MINOR."
|
|
31717
|
593 (let ((exact '())
|
|
|
594 (wildcard '()))
|
|
|
595 (while major
|
|
|
596 (cond
|
|
|
597 ((equal (car (car major)) minor)
|
|
|
598 (setq exact (cons (cdr (car major)) exact)))
|
|
56927
|
599 ((and minor (string-match (concat "^" (car (car major)) "$") minor))
|
|
31717
|
600 (setq wildcard (cons (cdr (car major)) wildcard))))
|
|
|
601 (setq major (cdr major)))
|
|
|
602 (nconc exact wildcard)))
|
|
|
603
|
|
|
604 (defun mailcap-unescape-mime-test (test type-info)
|
|
|
605 (let (save-pos save-chr subst)
|
|
|
606 (cond
|
|
|
607 ((symbolp test) test)
|
|
|
608 ((and (listp test) (symbolp (car test))) test)
|
|
|
609 ((or (stringp test)
|
|
|
610 (and (listp test) (stringp (car test))
|
|
|
611 (setq test (mapconcat 'identity test " "))))
|
|
|
612 (with-temp-buffer
|
|
|
613 (insert test)
|
|
|
614 (goto-char (point-min))
|
|
|
615 (while (not (eobp))
|
|
|
616 (skip-chars-forward "^%")
|
|
|
617 (if (/= (- (point)
|
|
|
618 (progn (skip-chars-backward "\\\\")
|
|
|
619 (point)))
|
|
|
620 0) ; It is an escaped %
|
|
|
621 (progn
|
|
|
622 (delete-char 1)
|
|
|
623 (skip-chars-forward "%."))
|
|
|
624 (setq save-pos (point))
|
|
|
625 (skip-chars-forward "%")
|
|
|
626 (setq save-chr (char-after (point)))
|
|
33821
|
627 ;; Escapes:
|
|
|
628 ;; %s: name of a file for the body data
|
|
|
629 ;; %t: content-type
|
|
|
630 ;; %{<parameter name}: value of parameter in mailcap entry
|
|
|
631 ;; %n: number of sub-parts for multipart content-type
|
|
|
632 ;; %F: a set of content-type/filename pairs for multiparts
|
|
31717
|
633 (cond
|
|
|
634 ((null save-chr) nil)
|
|
|
635 ((= save-chr ?t)
|
|
|
636 (delete-region save-pos (progn (forward-char 1) (point)))
|
|
|
637 (insert (or (cdr (assq 'type type-info)) "\"\"")))
|
|
33821
|
638 ((memq save-chr '(?M ?n ?F))
|
|
31717
|
639 (delete-region save-pos (progn (forward-char 1) (point)))
|
|
|
640 (insert "\"\""))
|
|
|
641 ((= save-chr ?{)
|
|
|
642 (forward-char 1)
|
|
|
643 (skip-chars-forward "^}")
|
|
|
644 (downcase-region (+ 2 save-pos) (point))
|
|
|
645 (setq subst (buffer-substring (+ 2 save-pos) (point)))
|
|
|
646 (delete-region save-pos (1+ (point)))
|
|
|
647 (insert (or (cdr (assoc subst type-info)) "\"\"")))
|
|
|
648 (t nil))))
|
|
|
649 (buffer-string)))
|
|
33821
|
650 (t (error "Bad value to mailcap-unescape-mime-test: %s" test)))))
|
|
31717
|
651
|
|
|
652 (defvar mailcap-viewer-test-cache nil)
|
|
|
653
|
|
|
654 (defun mailcap-viewer-passes-test (viewer-info type-info)
|
|
78486
|
655 "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
|
|
56927
|
656 Also return non-nil if it has no test clause. TYPE-INFO is an argument
|
|
33821
|
657 to supply to the test."
|
|
31717
|
658 (let* ((test-info (assq 'test viewer-info))
|
|
|
659 (test (cdr test-info))
|
|
|
660 (otest test)
|
|
|
661 (viewer (cdr (assoc 'viewer viewer-info)))
|
|
|
662 (default-directory (expand-file-name "~/"))
|
|
|
663 status parsed-test cache result)
|
|
68521
|
664 (cond ((setq cache (assoc test mailcap-viewer-test-cache))
|
|
|
665 (cadr cache))
|
|
|
666 ((not test-info) t) ; No test clause
|
|
|
667 (t
|
|
|
668 (setq
|
|
|
669 result
|
|
|
670 (cond
|
|
|
671 ((not test) nil) ; Already failed test
|
|
|
672 ((eq test t) t) ; Already passed test
|
|
|
673 ((functionp test) ; Lisp function as test
|
|
|
674 (funcall test type-info))
|
|
|
675 ((and (symbolp test) ; Lisp variable as test
|
|
|
676 (boundp test))
|
|
|
677 (symbol-value test))
|
|
|
678 ((and (listp test) ; List to be eval'd
|
|
|
679 (symbolp (car test)))
|
|
|
680 (eval test))
|
|
|
681 (t
|
|
|
682 (setq test (mailcap-unescape-mime-test test type-info)
|
|
|
683 test (list shell-file-name nil nil nil
|
|
|
684 shell-command-switch test)
|
|
|
685 status (apply 'call-process test))
|
|
|
686 (eq 0 status))))
|
|
|
687 (push (list otest result) mailcap-viewer-test-cache)
|
|
|
688 result))))
|
|
31717
|
689
|
|
|
690 (defun mailcap-add-mailcap-entry (major minor info)
|
|
|
691 (let ((old-major (assoc major mailcap-mime-data)))
|
|
|
692 (if (null old-major) ; New major area
|
|
|
693 (setq mailcap-mime-data
|
|
|
694 (cons (cons major (list (cons minor info)))
|
|
|
695 mailcap-mime-data))
|
|
56927
|
696 (let ((cur-minor (assoc minor old-major)))
|
|
|
697 (cond
|
|
|
698 ((or (null cur-minor) ; New minor area, or
|
|
|
699 (assq 'test info)) ; Has a test, insert at beginning
|
|
|
700 (setcdr old-major (cons (cons minor info) (cdr old-major))))
|
|
|
701 ((and (not (assq 'test info)) ; No test info, replace completely
|
|
|
702 (not (assq 'test cur-minor))
|
|
31717
|
703 (equal (assq 'viewer info) ; Keep alternative viewer
|
|
|
704 (assq 'viewer cur-minor)))
|
|
56927
|
705 (setcdr cur-minor info))
|
|
|
706 (t
|
|
|
707 (setcdr old-major (cons (cons minor info) (cdr old-major))))))
|
|
31717
|
708 )))
|
|
|
709
|
|
|
710 (defun mailcap-add (type viewer &optional test)
|
|
|
711 "Add VIEWER as a handler for TYPE.
|
|
|
712 If TEST is not given, it defaults to t."
|
|
|
713 (let ((tl (split-string type "/")))
|
|
|
714 (when (or (not (car tl))
|
|
|
715 (not (cadr tl)))
|
|
|
716 (error "%s is not a valid MIME type" type))
|
|
|
717 (mailcap-add-mailcap-entry
|
|
|
718 (car tl) (cadr tl)
|
|
|
719 `((viewer . ,viewer)
|
|
|
720 (test . ,(if test test t))
|
|
|
721 (type . ,type)))))
|
|
|
722
|
|
|
723 ;;;
|
|
|
724 ;;; The main whabbo
|
|
|
725 ;;;
|
|
|
726
|
|
|
727 (defun mailcap-viewer-lessp (x y)
|
|
78486
|
728 "Return t if viewer X is more desirable than viewer Y."
|
|
31717
|
729 (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
|
|
|
730 (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
|
|
|
731 (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
|
|
|
732 (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
|
|
|
733 (cond
|
|
|
734 ((and x-wild (not y-wild))
|
|
|
735 nil)
|
|
|
736 ((and (not x-wild) y-wild)
|
|
|
737 t)
|
|
|
738 ((and (not y-lisp) x-lisp)
|
|
|
739 t)
|
|
|
740 (t nil))))
|
|
|
741
|
|
87097
|
742 (defun mailcap-mime-info (string &optional request no-decode)
|
|
31717
|
743 "Get the MIME viewer command for STRING, return nil if none found.
|
|
|
744 Expects a complete content-type header line as its argument.
|
|
|
745
|
|
|
746 Second argument REQUEST specifies what information to return. If it is
|
|
|
747 nil or the empty string, the viewer (second field of the mailcap
|
|
|
748 entry) will be returned. If it is a string, then the mailcap field
|
|
|
749 corresponding to that string will be returned (print, description,
|
|
|
750 whatever). If a number, then all the information for this specific
|
|
|
751 viewer is returned. If `all', then all possible viewers for
|
|
87097
|
752 this type is returned.
|
|
|
753
|
|
|
754 If NO-DECODE is non-nil, don't decode STRING."
|
|
|
755 ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
|
|
|
756 ;; `mail-parse.el'
|
|
31717
|
757 (let (
|
|
|
758 major ; Major encoding (text, etc)
|
|
|
759 minor ; Minor encoding (html, etc)
|
|
|
760 info ; Other info
|
|
|
761 save-pos ; Misc. position during parse
|
|
|
762 major-info ; (assoc major mailcap-mime-data)
|
|
|
763 minor-info ; (assoc minor major-info)
|
|
|
764 test ; current test proc.
|
|
|
765 viewers ; Possible viewers
|
|
|
766 passed ; Viewers that passed the test
|
|
|
767 viewer ; The one and only viewer
|
|
|
768 ctl)
|
|
|
769 (save-excursion
|
|
87097
|
770 (setq ctl
|
|
|
771 (if no-decode
|
|
|
772 (list (or string "text/plain"))
|
|
|
773 (mail-header-parse-content-type (or string "text/plain"))))
|
|
31717
|
774 (setq major (split-string (car ctl) "/"))
|
|
|
775 (setq minor (cadr major)
|
|
|
776 major (car major))
|
|
|
777 (when (setq major-info (cdr (assoc major mailcap-mime-data)))
|
|
|
778 (when (setq viewers (mailcap-possible-viewers major-info minor))
|
|
|
779 (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
|
|
|
780 (cdr a)))
|
|
|
781 (cdr ctl)))
|
|
|
782 (while viewers
|
|
|
783 (if (mailcap-viewer-passes-test (car viewers) info)
|
|
|
784 (setq passed (cons (car viewers) passed)))
|
|
|
785 (setq viewers (cdr viewers)))
|
|
|
786 (setq passed (sort passed 'mailcap-viewer-lessp))
|
|
|
787 (setq viewer (car passed))))
|
|
|
788 (when (and (stringp (cdr (assq 'viewer viewer)))
|
|
|
789 passed)
|
|
|
790 (setq viewer (car passed)))
|
|
|
791 (cond
|
|
|
792 ((and (null viewer) (not (equal major "default")) request)
|
|
87097
|
793 (mailcap-mime-info "default" request no-decode))
|
|
31717
|
794 ((or (null request) (equal request ""))
|
|
|
795 (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
|
|
|
796 ((stringp request)
|
|
56927
|
797 (mailcap-unescape-mime-test
|
|
|
798 (cdr-safe (assoc request viewer)) info))
|
|
31717
|
799 ((eq request 'all)
|
|
|
800 passed)
|
|
|
801 (t
|
|
|
802 ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
|
|
|
803 (setq viewer (copy-sequence viewer))
|
|
|
804 (let ((view (assq 'viewer viewer))
|
|
|
805 (test (assq 'test viewer)))
|
|
|
806 (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
|
|
|
807 (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
|
|
|
808 viewer)))))
|
|
|
809
|
|
|
810 ;;;
|
|
|
811 ;;; Experimental MIME-types parsing
|
|
|
812 ;;;
|
|
|
813
|
|
|
814 (defvar mailcap-mime-extensions
|
|
33821
|
815 '(("" . "text/plain")
|
|
|
816 (".abs" . "audio/x-mpeg")
|
|
|
817 (".aif" . "audio/aiff")
|
|
|
818 (".aifc" . "audio/aiff")
|
|
|
819 (".aiff" . "audio/aiff")
|
|
|
820 (".ano" . "application/x-annotator")
|
|
|
821 (".au" . "audio/ulaw")
|
|
|
822 (".avi" . "video/x-msvideo")
|
|
|
823 (".bcpio" . "application/x-bcpio")
|
|
|
824 (".bin" . "application/octet-stream")
|
|
|
825 (".cdf" . "application/x-netcdr")
|
|
|
826 (".cpio" . "application/x-cpio")
|
|
|
827 (".csh" . "application/x-csh")
|
|
|
828 (".css" . "text/css")
|
|
|
829 (".dvi" . "application/x-dvi")
|
|
|
830 (".diff" . "text/x-patch")
|
|
|
831 (".el" . "application/emacs-lisp")
|
|
|
832 (".eps" . "application/postscript")
|
|
|
833 (".etx" . "text/x-setext")
|
|
|
834 (".exe" . "application/octet-stream")
|
|
|
835 (".fax" . "image/x-fax")
|
|
|
836 (".gif" . "image/gif")
|
|
|
837 (".hdf" . "application/x-hdf")
|
|
|
838 (".hqx" . "application/mac-binhex40")
|
|
|
839 (".htm" . "text/html")
|
|
|
840 (".html" . "text/html")
|
|
|
841 (".icon" . "image/x-icon")
|
|
|
842 (".ief" . "image/ief")
|
|
|
843 (".jpg" . "image/jpeg")
|
|
|
844 (".macp" . "image/x-macpaint")
|
|
|
845 (".man" . "application/x-troff-man")
|
|
|
846 (".me" . "application/x-troff-me")
|
|
|
847 (".mif" . "application/mif")
|
|
|
848 (".mov" . "video/quicktime")
|
|
|
849 (".movie" . "video/x-sgi-movie")
|
|
|
850 (".mp2" . "audio/x-mpeg")
|
|
|
851 (".mp3" . "audio/x-mpeg")
|
|
|
852 (".mp2a" . "audio/x-mpeg2")
|
|
|
853 (".mpa" . "audio/x-mpeg")
|
|
|
854 (".mpa2" . "audio/x-mpeg2")
|
|
|
855 (".mpe" . "video/mpeg")
|
|
|
856 (".mpeg" . "video/mpeg")
|
|
|
857 (".mpega" . "audio/x-mpeg")
|
|
|
858 (".mpegv" . "video/mpeg")
|
|
|
859 (".mpg" . "video/mpeg")
|
|
|
860 (".mpv" . "video/mpeg")
|
|
|
861 (".ms" . "application/x-troff-ms")
|
|
|
862 (".nc" . "application/x-netcdf")
|
|
|
863 (".nc" . "application/x-netcdf")
|
|
|
864 (".oda" . "application/oda")
|
|
|
865 (".patch" . "text/x-patch")
|
|
|
866 (".pbm" . "image/x-portable-bitmap")
|
|
|
867 (".pdf" . "application/pdf")
|
|
|
868 (".pgm" . "image/portable-graymap")
|
|
|
869 (".pict" . "image/pict")
|
|
|
870 (".png" . "image/png")
|
|
|
871 (".pnm" . "image/x-portable-anymap")
|
|
|
872 (".ppm" . "image/portable-pixmap")
|
|
|
873 (".ps" . "application/postscript")
|
|
|
874 (".qt" . "video/quicktime")
|
|
|
875 (".ras" . "image/x-raster")
|
|
|
876 (".rgb" . "image/x-rgb")
|
|
|
877 (".rtf" . "application/rtf")
|
|
|
878 (".rtx" . "text/richtext")
|
|
|
879 (".sh" . "application/x-sh")
|
|
|
880 (".sit" . "application/x-stuffit")
|
|
56927
|
881 (".siv" . "application/sieve")
|
|
33821
|
882 (".snd" . "audio/basic")
|
|
85712
|
883 (".soa" . "text/dns")
|
|
33821
|
884 (".src" . "application/x-wais-source")
|
|
|
885 (".tar" . "archive/tar")
|
|
|
886 (".tcl" . "application/x-tcl")
|
|
|
887 (".tex" . "application/x-tex")
|
|
|
888 (".texi" . "application/texinfo")
|
|
|
889 (".tga" . "image/x-targa")
|
|
|
890 (".tif" . "image/tiff")
|
|
|
891 (".tiff" . "image/tiff")
|
|
|
892 (".tr" . "application/x-troff")
|
|
|
893 (".troff" . "application/x-troff")
|
|
|
894 (".tsv" . "text/tab-separated-values")
|
|
|
895 (".txt" . "text/plain")
|
|
|
896 (".vbs" . "video/mpeg")
|
|
|
897 (".vox" . "audio/basic")
|
|
|
898 (".vrml" . "x-world/x-vrml")
|
|
|
899 (".wav" . "audio/x-wav")
|
|
56927
|
900 (".xls" . "application/vnd.ms-excel")
|
|
33821
|
901 (".wrl" . "x-world/x-vrml")
|
|
|
902 (".xbm" . "image/xbm")
|
|
|
903 (".xpm" . "image/xpm")
|
|
|
904 (".xwd" . "image/windowdump")
|
|
|
905 (".zip" . "application/zip")
|
|
|
906 (".ai" . "application/postscript")
|
|
|
907 (".jpe" . "image/jpeg")
|
|
|
908 (".jpeg" . "image/jpeg"))
|
|
|
909 "An alist of file extensions and corresponding MIME content-types.
|
|
|
910 This exists for you to customize the information in Lisp. It is
|
|
|
911 merged with values from mailcap files by `mailcap-parse-mimetypes'.")
|
|
31717
|
912
|
|
|
913 (defvar mailcap-mimetypes-parsed-p nil)
|
|
|
914
|
|
|
915 (defun mailcap-parse-mimetypes (&optional path force)
|
|
33821
|
916 "Parse out all the mimetypes specified in a Unix-style path string PATH.
|
|
31717
|
917 Components of PATH are separated by the `path-separator' character
|
|
|
918 appropriate for this system. If PATH is omitted, use the value of
|
|
|
919 environment variable MIMETYPES if set; otherwise use a default path.
|
|
|
920 If FORCE, re-parse even if already parsed."
|
|
|
921 (interactive (list nil t))
|
|
|
922 (when (or (not mailcap-mimetypes-parsed-p)
|
|
|
923 force)
|
|
|
924 (cond
|
|
|
925 (path nil)
|
|
|
926 ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
|
|
56927
|
927 ((memq system-type mailcap-poor-system-types)
|
|
31717
|
928 (setq path '("~/mime.typ" "~/etc/mime.typ")))
|
|
|
929 (t (setq path
|
|
|
930 ;; mime.types seems to be the normal name, definitely so
|
|
|
931 ;; on current GNUish systems. The search order follows
|
|
|
932 ;; that for mailcap.
|
|
|
933 '("~/.mime.types"
|
|
|
934 "/etc/mime.types"
|
|
|
935 "/usr/etc/mime.types"
|
|
|
936 "/usr/local/etc/mime.types"
|
|
|
937 "/usr/local/www/conf/mime.types"
|
|
|
938 "~/.mime-types"
|
|
|
939 "/etc/mime-types"
|
|
|
940 "/usr/etc/mime-types"
|
|
|
941 "/usr/local/etc/mime-types"
|
|
|
942 "/usr/local/www/conf/mime-types"))))
|
|
|
943 (let ((fnames (reverse (if (stringp path)
|
|
32989
|
944 (delete "" (split-string path path-separator))
|
|
31717
|
945 path)))
|
|
|
946 fname)
|
|
|
947 (while fnames
|
|
|
948 (setq fname (car fnames))
|
|
|
949 (if (and (file-readable-p fname))
|
|
|
950 (mailcap-parse-mimetype-file fname))
|
|
|
951 (setq fnames (cdr fnames))))
|
|
|
952 (setq mailcap-mimetypes-parsed-p t)))
|
|
|
953
|
|
|
954 (defun mailcap-parse-mimetype-file (fname)
|
|
33821
|
955 "Parse out a mime-types file FNAME."
|
|
31717
|
956 (let (type ; The MIME type for this line
|
|
|
957 extns ; The extensions for this line
|
|
|
958 save-pos ; Misc. saved buffer positions
|
|
|
959 )
|
|
|
960 (with-temp-buffer
|
|
|
961 (insert-file-contents fname)
|
|
|
962 (mailcap-replace-regexp "#.*" "")
|
|
|
963 (mailcap-replace-regexp "\n+" "\n")
|
|
|
964 (mailcap-replace-regexp "[ \t]+$" "")
|
|
|
965 (goto-char (point-max))
|
|
|
966 (skip-chars-backward " \t\n")
|
|
|
967 (delete-region (point) (point-max))
|
|
|
968 (goto-char (point-min))
|
|
|
969 (while (not (eobp))
|
|
|
970 (skip-chars-forward " \t\n")
|
|
|
971 (setq save-pos (point))
|
|
|
972 (skip-chars-forward "^ \t\n")
|
|
|
973 (downcase-region save-pos (point))
|
|
|
974 (setq type (buffer-substring save-pos (point)))
|
|
|
975 (while (not (eolp))
|
|
|
976 (skip-chars-forward " \t")
|
|
|
977 (setq save-pos (point))
|
|
|
978 (skip-chars-forward "^ \t\n")
|
|
|
979 (setq extns (cons (buffer-substring save-pos (point)) extns)))
|
|
|
980 (while extns
|
|
|
981 (setq mailcap-mime-extensions
|
|
|
982 (cons
|
|
|
983 (cons (if (= (string-to-char (car extns)) ?.)
|
|
|
984 (car extns)
|
|
|
985 (concat "." (car extns))) type)
|
|
|
986 mailcap-mime-extensions)
|
|
|
987 extns (cdr extns)))))))
|
|
|
988
|
|
|
989 (defun mailcap-extension-to-mime (extn)
|
|
|
990 "Return the MIME content type of the file extensions EXTN."
|
|
|
991 (mailcap-parse-mimetypes)
|
|
|
992 (if (and (stringp extn)
|
|
|
993 (not (eq (string-to-char extn) ?.)))
|
|
|
994 (setq extn (concat "." extn)))
|
|
|
995 (cdr (assoc (downcase extn) mailcap-mime-extensions)))
|
|
|
996
|
|
33821
|
997 ;; Unused?
|
|
|
998 (defalias 'mailcap-command-p 'executable-find)
|
|
31717
|
999
|
|
|
1000 (defun mailcap-mime-types ()
|
|
|
1001 "Return a list of MIME media types."
|
|
|
1002 (mailcap-parse-mimetypes)
|
|
87097
|
1003 (mailcap-delete-duplicates
|
|
32989
|
1004 (nconc
|
|
|
1005 (mapcar 'cdr mailcap-mime-extensions)
|
|
|
1006 (apply
|
|
|
1007 'nconc
|
|
|
1008 (mapcar
|
|
|
1009 (lambda (l)
|
|
|
1010 (delq nil
|
|
|
1011 (mapcar
|
|
|
1012 (lambda (m)
|
|
|
1013 (let ((type (cdr (assq 'type (cdr m)))))
|
|
|
1014 (if (equal (cadr (split-string type "/"))
|
|
|
1015 "*")
|
|
|
1016 nil
|
|
|
1017 type)))
|
|
|
1018 (cdr l))))
|
|
|
1019 mailcap-mime-data)))))
|
|
31717
|
1020
|
|
94252
|
1021 ;;;
|
|
|
1022 ;;; Useful supplementary functions
|
|
|
1023 ;;;
|
|
|
1024
|
|
|
1025 (defun mailcap-file-default-commands (files)
|
|
|
1026 "Return a list of default commands for FILES."
|
|
|
1027 (mailcap-parse-mailcaps)
|
|
|
1028 (mailcap-parse-mimetypes)
|
|
|
1029 (let* ((all-mime-type
|
|
|
1030 ;; All unique MIME types from file extensions
|
|
94616
|
1031 (mailcap-delete-duplicates
|
|
|
1032 (mapcar (lambda (file)
|
|
|
1033 (mailcap-extension-to-mime
|
|
|
1034 (file-name-extension file t)))
|
|
|
1035 files)))
|
|
94252
|
1036 (all-mime-info
|
|
|
1037 ;; All MIME info lists
|
|
94616
|
1038 (mailcap-delete-duplicates
|
|
|
1039 (mapcar (lambda (mime-type)
|
|
|
1040 (mailcap-mime-info mime-type 'all))
|
|
|
1041 all-mime-type)))
|
|
94252
|
1042 (common-mime-info
|
|
|
1043 ;; Intersection of mime-infos from different mime-types;
|
|
|
1044 ;; or just the first MIME info for a single MIME type
|
|
|
1045 (if (cdr all-mime-info)
|
|
|
1046 (delq nil (mapcar (lambda (mi1)
|
|
|
1047 (unless (memq nil (mapcar
|
|
|
1048 (lambda (mi2)
|
|
|
1049 (member mi1 mi2))
|
|
|
1050 (cdr all-mime-info)))
|
|
|
1051 mi1))
|
|
|
1052 (car all-mime-info)))
|
|
|
1053 (car all-mime-info)))
|
|
|
1054 (commands
|
|
|
1055 ;; Command strings from `viewer' field of the MIME info
|
|
94616
|
1056 (mailcap-delete-duplicates
|
|
94252
|
1057 (delq nil (mapcar (lambda (mime-info)
|
|
|
1058 (let ((command (cdr (assoc 'viewer mime-info))))
|
|
|
1059 (if (stringp command)
|
|
94616
|
1060 (mailcap-replace-in-string
|
|
94252
|
1061 ;; Replace mailcap's `%s' placeholder
|
|
|
1062 ;; with dired's `?' placeholder
|
|
94616
|
1063 (mailcap-replace-in-string
|
|
94252
|
1064 ;; Remove the final filename placeholder
|
|
94616
|
1065 command "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" t)
|
|
|
1066 "%s" "?" t))))
|
|
94252
|
1067 common-mime-info)))))
|
|
|
1068 commands))
|
|
|
1069
|
|
31717
|
1070 (provide 'mailcap)
|
|
|
1071
|
|
93975
|
1072 ;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd
|
|
31717
|
1073 ;;; mailcap.el ends here
|
