1 ;;; mailcap.el --- MIME media types configuration -*- lexical-binding: t -*-
3 ;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
5 ;; Author: William M. Perry <wmperry@aventail.com>
6 ;; Lars Magne Ingebrigtsen <larsi@gnus.org>
7 ;; Keywords: news, mail, multimedia
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
26 ;; Provides configuration of MIME media types from directly from Lisp
27 ;; and via the usual mailcap mechanism (RFC 1524). Deals with
28 ;; mime.types similarly.
32 (autoload 'mail-header-parse-content-type
"mail-parse")
35 "Definition of viewers for MIME types."
39 (defcustom mailcap-prefer-mailcap-viewers t
40 "If non-nil, prefer viewers specified in ~/.mailcap.
41 If nil, the most specific viewer will be chosen, even if there is
42 a general override in ~/.mailcap. For instance, if /etc/mailcap
43 has an entry for \"image/gif\", that one will be chosen even if
44 you have an entry for \"image/*\" in your ~/.mailcap file."
47 (defvar mailcap-parse-args-syntax-table
48 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table
)))
49 (modify-syntax-entry ?
' "\"" table
)
50 (modify-syntax-entry ?
` "\"" table
)
51 (modify-syntax-entry ?
{ "(" table
)
52 (modify-syntax-entry ?
} ")" table
)
54 "A syntax table for parsing SGML attributes.")
56 (defvar mailcap-print-command
58 (cons (if (boundp 'lpr-command
)
61 (when (boundp 'lpr-switches
)
62 (if (stringp lpr-switches
)
66 "Shell command (including switches) used to print PostScript files.")
68 (defun mailcap--get-user-mime-data (sym)
69 (let ((val (default-value sym
))
72 (push (list (cdr (assq 'viewer entry
))
73 (cdr (assq 'type entry
))
74 (cdr (assq 'test entry
)))
78 (defun mailcap--set-user-mime-data (sym val
)
80 (pcase-dolist (`(,viewer
,type
,test
) val
)
81 (push `((viewer .
,viewer
)
83 ,@(when test
`((test .
,test
))))
85 (set-default sym
(nreverse res
))))
87 (defcustom mailcap-user-mime-data nil
88 "A list of viewers preferred for different MIME types.
89 The elements of the list are alists of the following structure
95 where VIEWER is either a lisp command, e.g., a major-mode, or a
96 string containing a shell command for viewing files of the
97 defined MIME-TYPE. In case of a shell command, %s will be
98 replaced with the file.
100 MIME-TYPE is a regular expression being matched against the
101 actual MIME type. It is implicitly surrounded with ^ and $.
103 TEST is a lisp form which is evaluated in order to test if the
104 entry should be chosen. The `test' entry is optional.
106 When selecting a viewer for a given MIME type, the first viewer
107 in this list with a matching MIME-TYPE and successful TEST is
108 selected. Only if none matches, the standard `mailcap-mime-data'
113 (choice (function :tag
"Function or mode")
114 (string :tag
"Shell command"))
115 (regexp :tag
"MIME Type")
116 (sexp :tag
"Test (optional)")))
117 :get
#'mailcap--get-user-mime-data
118 :set
#'mailcap--set-user-mime-data
121 ;; Postpone using defcustom for this as it's so big and we essentially
122 ;; have to have two copies of the data around then. Perhaps just
123 ;; customize the Lisp viewers and rely on the normal configuration
124 ;; files for the rest? -- fx
125 (defvar mailcap-mime-data
128 (viewer .
"gnumeric %s")
129 (test .
(getenv "DISPLAY"))
130 (type .
"application/vnd.ms-excel"))
132 (viewer . mailcap-save-binary-file
)
134 (type .
"application/octet-stream"))
136 (viewer .
"xdvi -safer %s")
137 (test .
(eq window-system
'x
))
139 (type .
"application/dvi")
140 ("print" .
"dvips -qRP %s"))
142 (viewer .
"dvitty %s")
143 (test .
(not (getenv "DISPLAY")))
144 (type .
"application/dvi")
145 ("print" .
"dvips -qRP %s"))
147 (viewer . mailcap-maybe-eval
)
148 (type .
"application/emacs-lisp"))
150 (viewer . mailcap-maybe-eval
)
151 (type .
"application/x-emacs-lisp"))
153 (viewer . mailcap-save-binary-file
)
155 (type .
"application/x-tar"))
158 (type .
"application/x-latex"))
161 (type .
"application/x-tex"))
164 (type .
"application/latex"))
167 (type .
"application/tex"))
169 (viewer . texinfo-mode
)
170 (type .
"application/tex"))
172 (viewer . mailcap-save-binary-file
)
174 (type .
"application/zip")
177 (viewer . pdf-view-mode
)
178 (type .
"application/pdf")
179 (test . window-system
))
181 (viewer . doc-view-mode
)
182 (type .
"application/pdf")
183 (test . window-system
))
185 (viewer .
"gv -safer %s")
186 (type .
"application/pdf")
187 (test . window-system
)
188 ("print" .
,(concat "pdf2ps %s - | " mailcap-print-command
)))
191 (type .
"application/pdf")
192 ("print" .
,(concat "pdftops %s - | " mailcap-print-command
))
193 (test .
(eq window-system
'x
)))
196 (type .
"application/pdf")
197 ("print" .
,(concat "pdftops %s - | " mailcap-print-command
))
198 (test .
(eq window-system
'x
)))
200 (viewer .
,(concat "pdftotext %s -"))
201 (type .
"application/pdf")
202 ("print" .
,(concat "pdftops %s - | " mailcap-print-command
))
205 (viewer .
"gv -safer %s")
206 (type .
"application/postscript")
207 (test . window-system
)
208 ("print" .
,(concat mailcap-print-command
" %s"))
211 (viewer .
"ghostview -dSAFER %s")
212 (type .
"application/postscript")
213 (test .
(eq window-system
'x
))
214 ("print" .
,(concat mailcap-print-command
" %s"))
217 (viewer .
"ps2ascii %s")
218 (type .
"application/postscript")
219 (test .
(not (getenv "DISPLAY")))
220 ("print" .
,(concat mailcap-print-command
" %s"))
223 (viewer . sieve-mode
)
224 (type .
"application/sieve"))
226 (viewer .
"gpg --import --interactive --verbose")
227 (type .
"application/pgp-keys")
231 (viewer .
"maplay %s")
232 (type .
"audio/x-mpeg"))
234 (viewer .
"showaudio")
238 (viewer . mm-view-message
)
239 (test .
(and (featurep 'gnus
)
241 (type .
"message/rfc822"))
244 (type .
"message/rfc822"))
247 (type .
"message/rfc822")))
250 (viewer .
"xwud -in %s")
251 (type .
"image/x-xwd")
252 ("compose" .
"xwd -frame > %s")
253 (test .
(eq window-system
'x
))
256 (viewer .
"xwud -in %s")
257 (type .
"image/x-xwd")
258 ("compose" .
"xwd -frame > %s")
259 (test .
(eq window-system
'x
))
262 (viewer .
"xwud -in %s")
263 (type .
"image/x-xwd")
264 ("compose" .
"xwd -frame > %s")
265 (test .
(eq window-system
'x
))
268 (viewer .
"display %s")
270 (test .
(eq window-system
'x
))
275 (test .
(eq window-system
'x
))
280 (type .
"text/plain"))
282 (viewer . fundamental-mode
)
283 (type .
"text/plain"))
285 (viewer . enriched-decode
)
286 (type .
"text/enriched"))
289 (type .
"text/dns")))
292 (viewer .
"mpeg_play %s")
293 (type .
"video/mpeg")
294 (test .
(eq window-system
'x
))
298 (viewer .
"webspace -remote %s -URL %u")
299 (type .
"x-world/x-vrml")
305 (type .
"archive/tar"))))
306 "The mailcap structure is an assoc list of assoc lists.
307 1st assoc list is keyed on the major content-type
308 2nd assoc list is keyed on the minor content-type (which can be a regexp)
313 (\"postscript\" . <info>))
315 (\"plain\" . <info>)))
317 Where <info> is another assoc list of the various information
318 related to the mailcap RFC 1524. This is keyed on the lowercase
319 attribute name (viewer, test, etc). This looks like:
320 ((viewer . VIEWERINFO)
325 Where VIEWERINFO specifies how the content-type is viewed. Can be
326 a string, in which case it is run through a shell, with appropriate
327 parameters, or a symbol, in which case the symbol is `funcall'ed if
328 and only if it exists as a function, with the buffer as an argument.
330 TESTINFO is a test for the viewer's applicability, or nil. If nil, it
331 means the viewer is always valid. If it is a Lisp function, it is
332 called with a list of items from any extra fields from the
333 Content-Type header as argument to return a boolean value for the
334 validity. Otherwise, if it is a non-function Lisp symbol or list
335 whose car is a symbol, it is `eval'uated to yield the validity. If it
336 is a string or list of strings, it represents a shell command to run
337 to return a true or false shell value for the validity.")
338 (put 'mailcap-mime-data
'risky-local-variable t
)
340 (defcustom mailcap-download-directory nil
341 "Directory to which `mailcap-save-binary-file' downloads files by default.
342 nil means your home directory."
343 :type
'(choice (const :tag
"Home directory" nil
)
347 (defvar mailcap-poor-system-types
349 "Systems that don't have a Unix-like directory hierarchy.")
352 ;;; Utility functions
355 (defun mailcap-save-binary-file ()
356 (goto-char (point-min))
358 (let ((file (read-file-name
359 "Filename to save as: "
360 (or mailcap-download-directory
"~/")))
361 (require-final-newline nil
))
362 (write-region (point-min) (point-max) file
))
363 (kill-buffer (current-buffer))))
365 (defvar mailcap-maybe-eval-warning
368 This MIME part contains untrusted and possibly harmful content.
369 If you evaluate the Emacs Lisp code contained in it, a lot of nasty
370 things can happen. Please examine the code very carefully before you
371 instruct Emacs to evaluate it. You can browse the buffer containing
372 the code using \\[scroll-other-window].
374 If you are unsure what to do, please answer \"no\"."
375 "Text of warning message displayed by `mailcap-maybe-eval'.
376 Make sure that this text consists only of few text lines. Otherwise,
377 Gnus might fail to display all of it.")
379 (defun mailcap-maybe-eval ()
380 "Maybe evaluate a buffer of Emacs Lisp code."
381 (let ((lisp-buffer (current-buffer)))
382 (goto-char (point-min))
384 (save-window-excursion
385 (delete-other-windows)
386 (let ((buffer (get-buffer-create (generate-new-buffer-name
389 (with-current-buffer buffer
390 (insert (substitute-command-keys
391 mailcap-maybe-eval-warning
))
392 (goto-char (point-min))
393 (display-buffer buffer
)
394 (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
395 (kill-buffer buffer
))))
396 (eval-buffer (current-buffer)))
397 (when (buffer-live-p lisp-buffer
)
398 (with-current-buffer lisp-buffer
399 (emacs-lisp-mode)))))
403 ;;; The mailcap parser
406 (defun mailcap-replace-regexp (regexp to-string
)
407 ;; Quiet replace-regexp.
408 (goto-char (point-min))
409 (while (re-search-forward regexp nil t
)
410 (replace-match to-string t nil
)))
412 (defvar mailcap-parsed-p nil
)
414 (defun mailcap-parse-mailcaps (&optional path force
)
415 "Parse out all the mailcaps specified in a path string PATH.
416 Components of PATH are separated by the `path-separator' character
417 appropriate for this system. If FORCE, re-parse even if already
418 parsed. If PATH is omitted, use the value of environment variable
419 MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
420 /usr/local/etc/mailcap."
421 (interactive (list nil t
))
422 (when (or (not mailcap-parsed-p
)
426 ((getenv "MAILCAPS") (setq path
(getenv "MAILCAPS")))
427 ((memq system-type mailcap-poor-system-types
)
428 (setq path
'("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
430 ;; This is per RFC 1524, specifically with /usr before
433 ("/etc/mailcap" 'after
)
434 ("/usr/etc/mailcap" 'after
)
435 ("/usr/local/etc/mailcap" 'after
)))))
436 ;; We read the entries from ~/.mailcap before the built-in values,
437 ;; but place the rest of then afterwards as fallback values.
438 (dolist (spec (reverse
440 (split-string path path-separator t
)
442 (let ((afterp (and (consp spec
)
444 (file-name (if (stringp spec
)
447 (when (and (file-readable-p file-name
)
448 (file-regular-p file-name
))
449 (mailcap-parse-mailcap file-name afterp
))))
450 (setq mailcap-parsed-p t
)))
452 (defun mailcap-parse-mailcap (fname &optional after
)
453 "Parse out the mailcap file specified by FNAME.
454 If AFTER, place the entries from the file after the ones that are
456 (let (major ; The major mime type (image/audio/etc)
457 minor
; The minor mime type (gif, basic, etc)
458 save-pos
; Misc saved positions used in parsing
459 viewer
; How to view this mime type
460 info
; Misc info about this mime type
463 (insert-file-contents fname
)
464 (set-syntax-table mailcap-parse-args-syntax-table
)
465 (mailcap-replace-regexp "#.*" "") ; Remove all comments
466 (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
467 (mailcap-replace-regexp "\n+" "\n") ; And blank lines
468 (goto-char (point-max))
469 (skip-chars-backward " \t\n")
470 (delete-region (point) (point-max))
472 (skip-chars-backward " \t\n")
474 (setq save-pos
(point)
476 (skip-chars-forward "^/; \t\n")
477 (downcase-region save-pos
(point))
478 (setq major
(buffer-substring save-pos
(point)))
479 (skip-chars-forward " \t")
481 (when (eq (char-after) ?
/)
483 (skip-chars-forward " \t")
484 (setq save-pos
(point))
485 (skip-chars-forward "^; \t\n")
486 (downcase-region save-pos
(point))
489 ((eq ?
* (or (char-after save-pos
) 0)) ".*")
490 ((= (point) save-pos
) ".*")
491 (t (regexp-quote (buffer-substring save-pos
(point)))))))
492 (skip-chars-forward " \t")
493 ;;; Got the major/minor chunks, now for the viewers/etc
494 ;;; The first item _must_ be a viewer, according to the
495 ;;; RFC for mailcap files (#1524)
497 (when (eq (char-after) ?\
;)
499 (skip-chars-forward " \t")
500 (setq save-pos
(point))
501 (skip-chars-forward "^;\n")
503 (while (eq (char-before) ?
\\)
504 (backward-delete-char 1)
506 (skip-chars-forward "^;\n"))
507 (if (eq (or (char-after save-pos
) 0) ?
')
509 (narrow-to-region (1+ save-pos
) (point))
510 (goto-char (point-min))
512 (read (current-buffer))
513 (goto-char (point-max))
515 (setq viewer
(buffer-substring save-pos
(point)))))
516 (setq save-pos
(point))
518 (unless (equal viewer
"")
519 (setq info
(nconc (list (cons 'viewer viewer
)
520 (cons 'type
(concat major
"/"
521 (if (string= minor
".*")
523 (mailcap-parse-mailcap-extras save-pos
(point))))
524 (mailcap-mailcap-entry-passes-test info
)
525 (mailcap-add-mailcap-entry major minor info after
))
526 (beginning-of-line)))))
528 (defun mailcap-parse-mailcap-extras (st nd
)
529 "Grab all the extra stuff from a mailcap entry."
533 results
; Assoc list of results
534 name-pos
; Start of XXXX= position
535 val-pos
; Start of value position
536 done
; Found end of \'d ;s?
539 (narrow-to-region st nd
)
540 (goto-char (point-min))
541 (skip-chars-forward " \n\t;")
544 (setq name-pos
(point))
545 (skip-chars-forward "^ \n\t=;")
546 (downcase-region name-pos
(point))
547 (setq name
(buffer-substring name-pos
(point)))
548 (skip-chars-forward " \t\n")
549 (if (not (eq (char-after (point)) ?
=)) ; There is no value
551 (skip-chars-forward " \t\n=")
552 (setq val-pos
(point))
553 (if (memq (char-after val-pos
) '(?
\" ?
'))
555 (setq val-pos
(1+ val-pos
))
560 (error (goto-char (point-max)))))
562 (skip-chars-forward "^;")
563 (if (eq (char-after (1- (point))) ?
\\ )
565 (subst-char-in-region (1- (point)) (point) ?
\\ ?
)
566 (skip-chars-forward ";"))
568 (setq value
(buffer-substring val-pos
(point))))
569 ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
571 (push (cons (if (string-equal name
"test") 'test name
) value
) results
)
572 (skip-chars-forward " \";\n\t"))
575 (defun mailcap-mailcap-entry-passes-test (info)
576 "Replace the test clause of INFO itself with a boolean for some cases.
577 This function supports only `test -n $DISPLAY' and `test -z $DISPLAY',
578 replaces them with t or nil. As for others or if INFO has an interactive
579 spec (needsterm, needsterminal, or needsx11) but DISPLAY is not set,
580 the test clause will be unchanged."
581 (let ((test (assq 'test info
)) ; The test clause
583 (setq status
(and test
(split-string (cdr test
) " ")))
584 (if (and (or (assoc "needsterm" info
)
585 (assoc "needsterminal" info
)
586 (assoc "needsx11" info
))
587 (not (getenv "DISPLAY")))
590 ((and (equal (nth 0 status
) "test")
591 (equal (nth 1 status
) "-n")
592 (or (equal (nth 2 status
) "$DISPLAY")
593 (equal (nth 2 status
) "\"$DISPLAY\"")))
594 (setq status
(if (getenv "DISPLAY") t nil
)))
595 ((and (equal (nth 0 status
) "test")
596 (equal (nth 1 status
) "-z")
597 (or (equal (nth 2 status
) "$DISPLAY")
598 (equal (nth 2 status
) "\"$DISPLAY\"")))
599 (setq status
(if (getenv "DISPLAY") nil t
)))
602 (and test
(listp test
) (setcdr test status
))))
605 ;;; The action routines.
608 (defun mailcap-possible-viewers (major minor
)
609 "Return a list of possible viewers from MAJOR for minor type MINOR."
612 (pcase-dolist (`(,type .
,attrs
) major
)
616 ((and minor
(string-match (concat "^" type
"$") minor
))
617 (push attrs wildcard
))))
618 (nconc exact wildcard
)))
620 (defun mailcap-unescape-mime-test (test type-info
)
621 (let (save-pos save-chr subst
)
623 ((symbolp test
) test
)
624 ((and (listp test
) (symbolp (car test
))) test
)
626 (and (listp test
) (stringp (car test
))
627 (setq test
(mapconcat 'identity test
" "))))
630 (goto-char (point-min))
632 (skip-chars-forward "^%")
634 (progn (skip-chars-backward "\\\\")
636 0) ; It is an escaped %
639 (skip-chars-forward "%."))
640 (setq save-pos
(point))
641 (skip-chars-forward "%")
642 (setq save-chr
(char-after (point)))
644 ;; %s: name of a file for the body data
646 ;; %{<parameter name}: value of parameter in mailcap entry
647 ;; %n: number of sub-parts for multipart content-type
648 ;; %F: a set of content-type/filename pairs for multiparts
650 ((null save-chr
) nil
)
652 (delete-region save-pos
(progn (forward-char 1) (point)))
653 (insert (or (cdr (assq 'type type-info
)) "\"\"")))
654 ((memq save-chr
'(?M ?n ?F
))
655 (delete-region save-pos
(progn (forward-char 1) (point)))
659 (skip-chars-forward "^}")
660 (downcase-region (+ 2 save-pos
) (point))
661 (setq subst
(buffer-substring (+ 2 save-pos
) (point)))
662 (delete-region save-pos
(1+ (point)))
663 (insert (or (cdr (assoc subst type-info
)) "\"\"")))
666 (t (error "Bad value to mailcap-unescape-mime-test: %s" test
)))))
668 (defvar mailcap-viewer-test-cache nil
)
670 (defun mailcap-viewer-passes-test (viewer-info type-info
)
671 "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
672 Also return non-nil if it has no test clause. TYPE-INFO is an argument
673 to supply to the test."
674 (let* ((test-info (assq 'test viewer-info
))
675 (test (cdr test-info
))
677 (viewer (cdr (assq 'viewer viewer-info
)))
678 (default-directory (expand-file-name "~/"))
680 (cond ((not (or (stringp viewer
) (fboundp viewer
)))
681 nil
) ; Non-existent Lisp function
682 ((setq cache
(assoc test mailcap-viewer-test-cache
))
684 ((not test-info
) t
) ; No test clause
689 ((not test
) nil
) ; Already failed test
690 ((eq test t
) t
) ; Already passed test
691 ((functionp test
) ; Lisp function as test
692 (funcall test type-info
))
693 ((and (symbolp test
) ; Lisp variable as test
696 ((and (listp test
) ; List to be eval'd
697 (symbolp (car test
)))
700 (setq test
(mailcap-unescape-mime-test test type-info
)
701 test
(list shell-file-name nil nil nil
702 shell-command-switch test
)
703 status
(apply 'call-process test
))
705 (push (list otest result
) mailcap-viewer-test-cache
)
708 (defun mailcap-add-mailcap-entry (major minor info
&optional after
)
709 (let ((old-major (assoc major mailcap-mime-data
)))
710 (if (null old-major
) ; New major area
711 (push (cons major
(list (cons minor info
))) mailcap-mime-data
)
712 (let ((cur-minor (assoc minor old-major
)))
714 ((or (null cur-minor
) ; New minor area, or
715 (assq 'test info
)) ; Has a test, insert at beginning
717 (if after
; Or after, if specified.
718 (nconc (cdr old-major
)
719 (list (cons minor info
)))
720 (cons (cons minor info
) (cdr old-major
)))))
721 ((and (not (assq 'test info
)) ; No test info, replace completely
722 (not (assq 'test cur-minor
))
723 (equal (assq 'viewer info
) ; Keep alternative viewer
724 (assq 'viewer cur-minor
)))
726 (setcdr cur-minor info
)))
730 (nconc (cdr old-major
) (list (cons minor info
)))
732 (cons (cons minor info
) (cdr old-major
)))))))))))
734 (defun mailcap-add (type viewer
&optional test
)
735 "Add VIEWER as a handler for TYPE.
736 If TEST is not given, it defaults to t."
737 (let ((tl (split-string type
"/")))
738 (when (or (not (car tl
))
740 (error "%s is not a valid MIME type" type
))
741 (mailcap-add-mailcap-entry
744 (test .
,(if test test t
))
751 (defun mailcap-viewer-lessp (x y
)
752 "Return t if viewer X is more desirable than viewer Y."
753 (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x
)) "")))
754 (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y
)) "")))
755 (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x
)) ""))))
756 (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y
)) "")))))
758 ((and x-wild
(not y-wild
))
760 ((and (not x-wild
) y-wild
)
762 ((and (not y-lisp
) x-lisp
)
766 (defun mailcap-select-preferred-viewer (type-info)
767 "Return an applicable viewer entry from `mailcap-user-mime-data'."
768 (let ((info (mapcar (lambda (a) (cons (symbol-name (car a
))
772 (dolist (entry mailcap-user-mime-data
)
773 (when (and (null viewer
)
774 (string-match (concat "^" (cdr (assq 'type entry
)) "$")
776 (mailcap-viewer-passes-test entry info
))
777 (setq viewer entry
)))
780 (defun mailcap-mime-info (string &optional request no-decode
)
781 "Get the MIME viewer command for STRING, return nil if none found.
782 Expects a complete content-type header line as its argument.
784 Second argument REQUEST specifies what information to return. If it is
785 nil or the empty string, the viewer (second field of the mailcap
786 entry) will be returned. If it is a string, then the mailcap field
787 corresponding to that string will be returned (print, description,
788 whatever). If a number, then all the information for this specific
789 viewer is returned. If `all', then all possible viewers for
790 this type is returned.
792 If NO-DECODE is non-nil, don't decode STRING."
793 ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
796 major
; Major encoding (text, etc)
797 minor
; Minor encoding (html, etc)
799 major-info
; (assoc major mailcap-mime-data)
800 viewers
; Possible viewers
801 passed
; Viewers that passed the test
802 viewer
; The one and only viewer
807 (list (or string
"text/plain"))
808 (mail-header-parse-content-type (or string
"text/plain"))))
809 ;; Check if there's a user-defined viewer from `mailcap-user-mime-data'.
810 (setq viewer
(mailcap-select-preferred-viewer ctl
))
812 (setq passed
(list viewer
))
813 ;; None found, so heuristically select some applicable viewer
814 ;; from `mailcap-mime-data'.
815 (mailcap-parse-mailcaps)
816 (setq major
(split-string (car ctl
) "/"))
817 (setq minor
(cadr major
)
819 (when (setq major-info
(cdr (assoc major mailcap-mime-data
)))
820 (when (setq viewers
(mailcap-possible-viewers major-info minor
))
821 (setq info
(mapcar (lambda (a)
822 (cons (symbol-name (car a
)) (cdr a
)))
824 (dolist (entry viewers
)
825 (when (mailcap-viewer-passes-test entry info
)
826 (push entry passed
)))
827 ;; The data is in "logical" order; entries from ~/.mailcap
828 ;; are first, so we don't need to do any sorting if the
829 ;; user wants ~/.mailcap to be preferred.
830 (unless mailcap-prefer-mailcap-viewers
831 (setq passed
(sort passed
'mailcap-viewer-lessp
)))
832 (setq viewer
(car passed
))))
833 (when (and (stringp (cdr (assq 'viewer viewer
)))
835 (setq viewer
(car passed
))))
837 ((and (null viewer
) (not (equal major
"default")) request
)
838 (mailcap-mime-info "default" request no-decode
))
839 ((or (null request
) (equal request
""))
840 (mailcap-unescape-mime-test (cdr (assq 'viewer viewer
)) info
))
842 (mailcap-unescape-mime-test
843 (cdr-safe (assoc request viewer
)) info
))
847 ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
848 (setq viewer
(copy-sequence viewer
))
849 (let ((view (assq 'viewer viewer
))
850 (test (assq 'test viewer
)))
851 (if view
(setcdr view
(mailcap-unescape-mime-test (cdr view
) info
)))
852 (if test
(setcdr test
(mailcap-unescape-mime-test (cdr test
) info
))))
856 ;;; Experimental MIME-types parsing
859 (defvar mailcap-mime-extensions
860 '(("" .
"text/plain")
861 (".1" .
"text/plain") ;; Manual pages
862 (".3" .
"text/plain")
863 (".8" .
"text/plain")
864 (".abs" .
"audio/x-mpeg")
865 (".aif" .
"audio/aiff")
866 (".aifc" .
"audio/aiff")
867 (".aiff" .
"audio/aiff")
868 (".ano" .
"application/x-annotator")
869 (".au" .
"audio/ulaw")
870 (".avi" .
"video/x-msvideo")
871 (".bcpio" .
"application/x-bcpio")
872 (".bin" .
"application/octet-stream")
873 (".cdf" .
"application/x-netcdr")
874 (".cpio" .
"application/x-cpio")
875 (".csh" .
"application/x-csh")
876 (".css" .
"text/css")
877 (".dvi" .
"application/x-dvi")
878 (".diff" .
"text/x-patch")
879 (".dpatch".
"text/x-patch")
880 (".el" .
"application/emacs-lisp")
881 (".eps" .
"application/postscript")
882 (".etx" .
"text/x-setext")
883 (".exe" .
"application/octet-stream")
884 (".fax" .
"image/x-fax")
885 (".gif" .
"image/gif")
886 (".hdf" .
"application/x-hdf")
887 (".hqx" .
"application/mac-binhex40")
888 (".htm" .
"text/html")
889 (".html" .
"text/html")
890 (".icon" .
"image/x-icon")
891 (".ief" .
"image/ief")
892 (".jpg" .
"image/jpeg")
893 (".macp" .
"image/x-macpaint")
894 (".man" .
"application/x-troff-man")
895 (".me" .
"application/x-troff-me")
896 (".mif" .
"application/mif")
897 (".mov" .
"video/quicktime")
898 (".movie" .
"video/x-sgi-movie")
899 (".mp2" .
"audio/x-mpeg")
900 (".mp3" .
"audio/x-mpeg")
901 (".mp2a" .
"audio/x-mpeg2")
902 (".mpa" .
"audio/x-mpeg")
903 (".mpa2" .
"audio/x-mpeg2")
904 (".mpe" .
"video/mpeg")
905 (".mpeg" .
"video/mpeg")
906 (".mpega" .
"audio/x-mpeg")
907 (".mpegv" .
"video/mpeg")
908 (".mpg" .
"video/mpeg")
909 (".mpv" .
"video/mpeg")
910 (".ms" .
"application/x-troff-ms")
911 (".nc" .
"application/x-netcdf")
912 (".nc" .
"application/x-netcdf")
913 (".oda" .
"application/oda")
914 (".patch" .
"text/x-patch")
915 (".pbm" .
"image/x-portable-bitmap")
916 (".pdf" .
"application/pdf")
917 (".pgm" .
"image/portable-graymap")
918 (".pict" .
"image/pict")
919 (".png" .
"image/png")
920 (".pnm" .
"image/x-portable-anymap")
921 (".pod" .
"text/plain")
922 (".ppm" .
"image/portable-pixmap")
923 (".ps" .
"application/postscript")
924 (".qt" .
"video/quicktime")
925 (".ras" .
"image/x-raster")
926 (".rgb" .
"image/x-rgb")
927 (".rtf" .
"application/rtf")
928 (".rtx" .
"text/richtext")
929 (".sh" .
"application/x-sh")
930 (".sit" .
"application/x-stuffit")
931 (".siv" .
"application/sieve")
932 (".snd" .
"audio/basic")
933 (".soa" .
"text/dns")
934 (".src" .
"application/x-wais-source")
935 (".tar" .
"archive/tar")
936 (".tcl" .
"application/x-tcl")
937 (".tex" .
"application/x-tex")
938 (".texi" .
"application/texinfo")
939 (".tga" .
"image/x-targa")
940 (".tif" .
"image/tiff")
941 (".tiff" .
"image/tiff")
942 (".tr" .
"application/x-troff")
943 (".troff" .
"application/x-troff")
944 (".tsv" .
"text/tab-separated-values")
945 (".txt" .
"text/plain")
946 (".vbs" .
"video/mpeg")
947 (".vox" .
"audio/basic")
948 (".vrml" .
"x-world/x-vrml")
949 (".wav" .
"audio/x-wav")
950 (".xls" .
"application/vnd.ms-excel")
951 (".wrl" .
"x-world/x-vrml")
952 (".xbm" .
"image/xbm")
953 (".xpm" .
"image/xpm")
954 (".xwd" .
"image/windowdump")
955 (".zip" .
"application/zip")
956 (".ai" .
"application/postscript")
957 (".jpe" .
"image/jpeg")
958 (".jpeg" .
"image/jpeg")
959 (".org" .
"text/x-org"))
960 "An alist of file extensions and corresponding MIME content-types.
961 This exists for you to customize the information in Lisp. It is
962 merged with values from mailcap files by `mailcap-parse-mimetypes'.")
964 (defvar mailcap-mimetypes-parsed-p nil
)
966 (defun mailcap-parse-mimetypes (&optional path force
)
967 "Parse out all the mimetypes specified in a Unix-style path string PATH.
968 Components of PATH are separated by the `path-separator' character
969 appropriate for this system. If PATH is omitted, use the value of
970 environment variable MIMETYPES if set; otherwise use a default path.
971 If FORCE, re-parse even if already parsed."
972 (interactive (list nil t
))
973 (when (or (not mailcap-mimetypes-parsed-p
)
977 ((getenv "MIMETYPES") (setq path
(getenv "MIMETYPES")))
978 ((memq system-type mailcap-poor-system-types
)
979 (setq path
'("~/mime.typ" "~/etc/mime.typ")))
981 ;; mime.types seems to be the normal name, definitely so
982 ;; on current GNUish systems. The search order follows
986 "/usr/etc/mime.types"
987 "/usr/local/etc/mime.types"
988 "/usr/local/www/conf/mime.types"
991 "/usr/etc/mime-types"
992 "/usr/local/etc/mime-types"
993 "/usr/local/www/conf/mime-types"))))
994 (dolist (fname (reverse (if (stringp path
)
995 (split-string path path-separator t
)
997 (when (file-readable-p fname
)
998 (mailcap-parse-mimetype-file fname
)))
999 (setq mailcap-mimetypes-parsed-p t
)))
1001 (defun mailcap-parse-mimetype-file (fname)
1002 "Parse out a mime-types file FNAME."
1003 (let (type ; The MIME type for this line
1004 extns
; The extensions for this line
1005 save-pos
; Misc. saved buffer positions
1008 (insert-file-contents fname
)
1009 (mailcap-replace-regexp "#.*" "")
1010 (mailcap-replace-regexp "\n+" "\n")
1011 (mailcap-replace-regexp "[ \t]+$" "")
1012 (goto-char (point-max))
1013 (skip-chars-backward " \t\n")
1014 (delete-region (point) (point-max))
1015 (goto-char (point-min))
1017 (skip-chars-forward " \t\n")
1018 (setq save-pos
(point))
1019 (skip-chars-forward "^ \t\n")
1020 (downcase-region save-pos
(point))
1021 (setq type
(buffer-substring save-pos
(point)))
1023 (skip-chars-forward " \t")
1024 (setq save-pos
(point))
1025 (skip-chars-forward "^ \t\n")
1026 (setq save-extn
(buffer-substring save-pos
(point)))
1027 (push (cons (if (= (string-to-char save-extn
) ?.
)
1028 save-extn
(concat "." save-extn
))
1031 (setq mailcap-mime-extensions
(append extns mailcap-mime-extensions
)
1034 (defun mailcap-extension-to-mime (extn)
1035 "Return the MIME content type of the file extensions EXTN."
1036 (mailcap-parse-mimetypes)
1037 (if (and (stringp extn
)
1038 (not (eq (string-to-char extn
) ?.
)))
1039 (setq extn
(concat "." extn
)))
1040 (cdr (assoc (downcase extn
) mailcap-mime-extensions
)))
1042 (defun mailcap-file-name-to-mime-type (file-name)
1043 "Return the MIME content type based on the FILE-NAME's extension.
1044 For instance, \"foo.png\" will result in \"image/png\"."
1045 (mailcap-extension-to-mime
1046 (if (string-match "\\(\\.[^.]+\\)\\'" file-name
)
1047 (match-string 1 file-name
)
1050 (defun mailcap-mime-types ()
1051 "Return a list of MIME media types."
1052 (mailcap-parse-mimetypes)
1055 (mapcar 'cdr mailcap-mime-extensions
)
1057 (dolist (data mailcap-mime-data
)
1058 (dolist (info (cdr data
))
1059 (setq type
(cdr (assq 'type
(cdr info
))))
1060 (unless (string-match-p "\\*" type
)
1065 ;;; Useful supplementary functions
1068 (defun mailcap-file-default-commands (files)
1069 "Return a list of default commands for FILES."
1070 (mailcap-parse-mailcaps)
1071 (mailcap-parse-mimetypes)
1072 (let* ((all-mime-type
1073 ;; All unique MIME types from file extensions
1075 (mapcar (lambda (file)
1076 (mailcap-extension-to-mime
1077 (file-name-extension file t
)))
1080 ;; All MIME info lists
1082 (mapcar (lambda (mime-type)
1083 (mailcap-mime-info mime-type
'all
))
1086 ;; Intersection of mime-infos from different mime-types;
1087 ;; or just the first MIME info for a single MIME type
1088 (if (cdr all-mime-info
)
1090 (dolist (mi1 (car all-mime-info
))
1091 (dolist (mi2 (cdr all-mime-info
))
1092 (when (member mi1 mi2
)
1095 (car all-mime-info
))))
1096 ;; Command strings from `viewer' field of the MIME info
1099 (dolist (mime-info common-mime-info
)
1100 (setq command
(cdr (assq 'viewer mime-info
)))
1101 (when (stringp command
)
1103 (replace-regexp-in-string
1104 ;; Replace mailcap's `%s' placeholder
1105 ;; with dired's `?' placeholder
1107 (replace-regexp-in-string
1108 ;; Remove the final filename placeholder
1109 "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" ""
1115 (defun mailcap-view-mime (type)
1116 "View the data in the current buffer that has MIME type TYPE.
1117 `mailcap-mime-data' determines the method to use."
1118 (let ((method (mailcap-mime-info type
)))
1119 (if (stringp method
)
1120 (shell-command-on-region (point-min) (point-max)
1121 ;; Use stdin as the "%s".
1129 ;;; mailcap.el ends here