1 ;;; mailcap.el --- MIME media types configuration
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: William M. Perry <wmperry@aventail.com>
7 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; Keywords: news, mail, multimedia
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
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.
33 (eval-when-compile (require 'cl))
34 (autoload 'mail-header-parse-content-type "mail-parse")
36 ;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22.
37 (defalias 'mailcap-delete-duplicates
38 (if (fboundp 'delete-dups)
40 (autoload 'mm-delete-duplicates "mm-util")
41 'mm-delete-duplicates))
43 ;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'.
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))))
57 "Definition of viewers for MIME types."
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)
68 "A syntax table for parsing SGML attributes.")
71 (when (featurep 'xemacs)
76 (defvar mailcap-print-command
78 (cons (if (boundp 'lpr-command)
81 (when (boundp 'lpr-switches)
82 (if (stringp lpr-switches)
86 "Shell command (including switches) used to print Postscript files.")
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
92 (defvar mailcap-mime-data
95 (viewer . "gnumeric %s")
96 (test . (getenv "DISPLAY"))
97 (type . "application/vnd.ms-excel"))
99 (viewer . ssl-view-site-cert)
100 (test . (fboundp 'ssl-view-site-cert))
101 (type . "application/x-x509-ca-cert"))
103 (viewer . ssl-view-user-cert)
104 (test . (fboundp 'ssl-view-user-cert))
105 (type . "application/x-x509-user-cert"))
107 (viewer . mailcap-save-binary-file)
109 (type . "application/octet-stream"))
111 (viewer . "xdvi -safer %s")
112 (test . (eq window-system 'x))
114 (type . "application/dvi")
115 ("print" . "dvips -qRP %s"))
117 (viewer . "dvitty %s")
118 (test . (not (getenv "DISPLAY")))
119 (type . "application/dvi")
120 ("print" . "dvips -qRP %s"))
122 (viewer . mailcap-maybe-eval)
123 (type . "application/emacs-lisp"))
125 (viewer . mailcap-maybe-eval)
126 (type . "application/x-emacs-lisp"))
128 (viewer . mailcap-save-binary-file)
130 (type . "application/x-tar"))
133 (test . (fboundp 'tex-mode))
134 (type . "application/x-latex"))
137 (test . (fboundp 'tex-mode))
138 (type . "application/x-tex"))
141 (test . (fboundp 'tex-mode))
142 (type . "application/latex"))
145 (test . (fboundp 'tex-mode))
146 (type . "application/tex"))
148 (viewer . texinfo-mode)
149 (test . (fboundp 'texinfo-mode))
150 (type . "application/tex"))
152 (viewer . mailcap-save-binary-file)
154 (type . "application/zip")
157 (viewer . "gv -safer %s")
158 (type . "application/pdf")
159 (test . window-system)
160 ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
163 (type . "application/pdf")
164 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
165 (test . (eq window-system 'x)))
168 (type . "application/pdf")
169 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
170 (test . (eq window-system 'x)))
172 (viewer . ,(concat "pdftotext %s -"))
173 (type . "application/pdf")
174 ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
177 (viewer . "gv -safer %s")
178 (type . "application/postscript")
179 (test . window-system)
180 ("print" . ,(concat mailcap-print-command " %s"))
183 (viewer . "ghostview -dSAFER %s")
184 (type . "application/postscript")
185 (test . (eq window-system 'x))
186 ("print" . ,(concat mailcap-print-command " %s"))
189 (viewer . "ps2ascii %s")
190 (type . "application/postscript")
191 (test . (not (getenv "DISPLAY")))
192 ("print" . ,(concat mailcap-print-command " %s"))
195 (viewer . sieve-mode)
196 (test . (fboundp 'sieve-mode))
197 (type . "application/sieve"))
199 (viewer . "gpg --import --interactive --verbose")
200 (type . "application/pgp-keys")
204 (viewer . "maplay %s")
205 (type . "audio/x-mpeg"))
207 (viewer . "showaudio")
211 (viewer . mm-view-message)
212 (test . (and (featurep 'gnus)
214 (type . "message/rfc822"))
217 (test . (fboundp 'vm-mode))
218 (type . "message/rfc822"))
221 (test . (fboundp 'w3-mode))
222 (type . "message/rfc822"))
225 (type . "message/rfc822")))
228 (viewer . "xwud -in %s")
229 (type . "image/x-xwd")
230 ("compose" . "xwd -frame > %s")
231 (test . (eq window-system 'x))
234 (viewer . "xwud -in %s")
235 (type . "image/x-xwd")
236 ("compose" . "xwd -frame > %s")
237 (test . (eq window-system 'x))
240 (viewer . "xwud -in %s")
241 (type . "image/x-xwd")
242 ("compose" . "xwd -frame > %s")
243 (test . (eq window-system 'x))
246 (viewer . "display %s")
248 (test . (eq window-system 'x))
253 (test . (eq window-system 'x))
258 (test . (fboundp 'w3-mode))
259 (type . "text/plain"))
262 (test . (fboundp 'view-mode))
263 (type . "text/plain"))
265 (viewer . fundamental-mode)
266 (type . "text/plain"))
268 (viewer . enriched-decode)
269 (test . (fboundp 'enriched-decode))
270 (type . "text/enriched"))
272 (viewer . mm-w3-prepare-buffer)
273 (test . (fboundp 'w3-prepare-buffer))
274 (type . "text/html"))
277 (test . (fboundp 'dns-mode))
278 (type . "text/dns")))
281 (viewer . "mpeg_play %s")
282 (type . "video/mpeg")
283 (test . (eq window-system 'x))
287 (viewer . "webspace -remote %s -URL %u")
288 (type . "x-world/x-vrml")
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)
303 (\"postscript\" . <info>))
305 (\"plain\" . <info>)))
307 Where <info> is another assoc list of the various information
308 related to the mailcap RFC 1524. This is keyed on the lowercase
309 attribute name (viewer, test, etc). This looks like:
310 ((viewer . VIEWERINFO)
315 Where VIEWERINFO specifies how the content-type is viewed. Can be
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
318 `funcall'ed, with the buffer as an argument.
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.")
328 (put 'mailcap-mime-data 'risky-local-variable t)
330 (defcustom mailcap-download-directory nil
331 "*Directory to which `mailcap-save-binary-file' downloads files by default.
332 nil means your home directory."
333 :type '(choice (const :tag "Home directory" nil)
337 (defvar mailcap-poor-system-types
339 "Systems that don't have a Unix-like directory hierarchy.")
342 ;;; Utility functions
345 (defun mailcap-save-binary-file ()
346 (goto-char (point-min))
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))))
355 (defvar mailcap-maybe-eval-warning
358 This MIME part contains untrusted and possibly harmful content.
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].
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.")
369 (defun mailcap-maybe-eval ()
370 "Maybe evaluate a buffer of Emacs Lisp code."
371 (let ((lisp-buffer (current-buffer)))
372 (goto-char (point-min))
374 (save-window-excursion
375 (delete-other-windows)
376 (let ((buffer (get-buffer-create (generate-new-buffer-name
379 (with-current-buffer buffer
380 (insert (substitute-command-keys
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)))))
393 ;;; The mailcap parser
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)))
402 (defvar mailcap-parsed-p nil)
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)
416 ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
417 ((memq system-type mailcap-poor-system-types)
418 (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
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
426 (split-string path path-separator t)
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)))
437 (defun mailcap-parse-mailcap (fname)
438 "Parse out the mailcap file specified by FNAME."
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
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))
455 (skip-chars-backward " \t\n")
457 (setq save-pos (point)
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")
464 (when (eq (char-after) ?/)
466 (skip-chars-forward " \t")
467 (setq save-pos (point))
468 (skip-chars-forward "^; \t\n")
469 (downcase-region save-pos (point))
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
478 ;;; RFC for mailcap files (#1524)
480 (when (eq (char-after) ?\;)
482 (skip-chars-forward " \t")
483 (setq save-pos (point))
484 (skip-chars-forward "^;\n")
486 (while (eq (char-before) ?\\)
487 (backward-delete-char 1)
489 (skip-chars-forward "^;\n"))
490 (if (eq (or (char-after save-pos) 0) ?')
492 (narrow-to-region (1+ save-pos) (point))
493 (goto-char (point-min))
495 (read (current-buffer))
496 (goto-char (point-max))
498 (setq viewer (buffer-substring save-pos (point)))))
499 (setq save-pos (point))
501 (unless (equal viewer "")
502 (setq info (nconc (list (cons 'viewer viewer)
503 (cons 'type (concat major "/"
504 (if (string= 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)))))
511 (defun mailcap-parse-mailcap-extras (st nd)
512 "Grab all the extra stuff from a mailcap entry."
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?
522 (narrow-to-region st nd)
523 (goto-char (point-min))
524 (skip-chars-forward " \n\t;")
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
534 (skip-chars-forward " \t\n=")
535 (setq val-pos (point))
536 (if (memq (char-after val-pos) '(?\" ?'))
538 (setq val-pos (1+ val-pos))
543 (error (goto-char (point-max)))))
545 (skip-chars-forward "^;")
546 (if (eq (char-after (1- (point))) ?\\ )
548 (subst-char-in-region (1- (point)) (point) ?\\ ? )
549 (skip-chars-forward ";"))
551 (setq value (buffer-substring val-pos (point))))
552 ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
554 (setq results (cons (cons (if (string-equal name "test")
558 (skip-chars-forward " \";\n\t"))
561 (defun mailcap-mailcap-entry-passes-test (info)
562 "Return non-nil if mailcap entry INFO passes its test clause.
563 Also return non-nil if no test clause is present."
564 (let ((test (assq 'test info)) ; The test clause
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")))
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)))
585 (and test (listp test) (setcdr test status))))
588 ;;; The action routines.
591 (defun mailcap-possible-viewers (major minor)
592 "Return a list of possible viewers from MAJOR for minor type MINOR."
597 ((equal (car (car major)) minor)
598 (setq exact (cons (cdr (car major)) exact)))
599 ((and minor (string-match (concat "^" (car (car major)) "$") minor))
600 (setq wildcard (cons (cdr (car major)) wildcard))))
601 (setq major (cdr major)))
602 (nconc exact wildcard)))
604 (defun mailcap-unescape-mime-test (test type-