X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmailcap.el;h=8e491d7d312268ab492c193da1859e5ada8752be;hp=d99dc91a42cbcdfe3f3e711fea6da1f46a6b0873;hb=HEAD;hpb=e932cc43052e10b18579bb6615486cffd19074bf diff --git a/lisp/mailcap.el b/lisp/mailcap.el index d99dc91a4..8e491d7d3 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -1,5 +1,6 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc. + +;; Copyright (C) 1998-2016 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -7,20 +8,18 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -31,8 +30,27 @@ ;;; Code: (eval-when-compile (require 'cl)) -(require 'mail-parse) -(require 'mm-util) +(autoload 'mail-header-parse-content-type "mail-parse") + +;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22. +(defalias 'mailcap-delete-duplicates + (if (fboundp 'delete-dups) + 'delete-dups + (autoload 'mm-delete-duplicates "mm-util") + 'mm-delete-duplicates)) + +;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'. +(eval-and-compile + (cond + ((fboundp 'replace-regexp-in-string) + (defun mailcap-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. +This is a compatibility function for different Emacsen." + (replace-regexp-in-string regexp newtext string nil literal))) + ((fboundp 'replace-in-string) + (defalias 'mailcap-replace-in-string 'replace-in-string)))) (defgroup mailcap nil "Definition of viewers for MIME types." @@ -46,108 +64,140 @@ (modify-syntax-entry ?{ "(" table) (modify-syntax-entry ?} ")" table) table) - "A syntax table for parsing sgml attributes.") + "A syntax table for parsing SGML attributes.") + +(eval-and-compile + (when (featurep 'xemacs) + (condition-case nil + (require 'lpr) + (error nil)))) + +(defvar mailcap-print-command + (mapconcat 'identity + (cons (if (boundp 'lpr-command) + lpr-command + "lpr") + (when (boundp 'lpr-switches) + (if (stringp lpr-switches) + (list lpr-switches) + lpr-switches))) + " ") + "Shell command (including switches) used to print PostScript files.") ;; Postpone using defcustom for this as it's so big and we essentially ;; have to have two copies of the data around then. Perhaps just ;; customize the Lisp viewers and rely on the normal configuration ;; files for the rest? -- fx (defvar mailcap-mime-data - '(("application" - ("vnd.ms-excel" + `(("application" + ("vnd\\.ms-excel" (viewer . "gnumeric %s") (test . (getenv "DISPLAY")) (type . "application/vnd.ms-excel")) ("x-x509-ca-cert" (viewer . ssl-view-site-cert) - (test . (fboundp 'ssl-view-site-cert)) (type . "application/x-x509-ca-cert")) ("x-x509-user-cert" (viewer . ssl-view-user-cert) - (test . (fboundp 'ssl-view-user-cert)) (type . "application/x-x509-user-cert")) ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) (type . "application/octet-stream")) -;;; XEmacs says `ns' device-type not implemented. -;; ("dvi" -;; (viewer . "open %s") -;; (type . "application/dvi") -;; (test . (eq (mm-device-type) 'ns))) ("dvi" - (viewer . "xdvi %s") - (test . (eq (mm-device-type) 'x)) + (viewer . "xdvi -safer %s") + (test . (eq window-system 'x)) ("needsx11") - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("dvi" (viewer . "dvitty %s") (test . (not (getenv "DISPLAY"))) - (type . "application/dvi")) + (type . "application/dvi") + ("print" . "dvips -qRP %s")) ("emacs-lisp" (viewer . mailcap-maybe-eval) (type . "application/emacs-lisp")) + ("x-emacs-lisp" + (viewer . mailcap-maybe-eval) + (type . "application/x-emacs-lisp")) ("x-tar" (viewer . mailcap-save-binary-file) (non-viewer . t) (type . "application/x-tar")) ("x-latex" (viewer . tex-mode) - (test . (fboundp 'tex-mode)) (type . "application/x-latex")) ("x-tex" (viewer . tex-mode) - (test . (fboundp 'tex-mode)) (type . "application/x-tex")) ("latex" (viewer . tex-mode) - (test . (fboundp 'tex-mode)) (type . "application/latex")) ("tex" (viewer . tex-mode) - (test . (fboundp 'tex-mode)) (type . "application/tex")) ("texinfo" (viewer . texinfo-mode) - (test . (fboundp 'texinfo-mode)) (type . "application/tex")) ("zip" (viewer . mailcap-save-binary-file) (non-viewer . t) (type . "application/zip") ("copiousoutput")) - ;; Prefer free viewers. ("pdf" - (viewer . "gv %s") + (viewer . pdf-view-mode) + (type . "application/pdf") + (test . (eq window-system 'x))) + ("pdf" + (viewer . doc-view-mode) (type . "application/pdf") - (test . window-system)) + (test . (eq window-system 'x))) + ("pdf" + (viewer . "gv -safer %s") + (type . "application/pdf") + (test . window-system) + ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command))) + ("pdf" + (viewer . "gpdf %s") + (type . "application/pdf") + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system 'x))) ("pdf" (viewer . "xpdf %s") (type . "application/pdf") - (test . (eq (mm-device-type) 'x))) + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + (test . (eq window-system 'x))) ("pdf" - (viewer . "acroread %s") - (type . "application/pdf")) -;;; XEmacs says `ns' device-type not implemented. -;; ("postscript" -;; (viewer . "open %s") -;; (type . "application/postscript") -;; (test . (eq (mm-device-type) 'ns))) + (viewer . ,(concat "pdftotext %s -")) + (type . "application/pdf") + ("print" . ,(concat "pdftops %s - | " mailcap-print-command)) + ("copiousoutput")) ("postscript" (viewer . "gv -safer %s") (type . "application/postscript") (test . window-system) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ghostview -dSAFER %s") (type . "application/postscript") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) + ("print" . ,(concat mailcap-print-command " %s")) ("needsx11")) ("postscript" (viewer . "ps2ascii %s") (type . "application/postscript") (test . (not (getenv "DISPLAY"))) - ("copiousoutput"))) + ("print" . ,(concat mailcap-print-command " %s")) + ("copiousoutput")) + ("sieve" + (viewer . sieve-mode) + (type . "application/sieve")) + ("pgp-keys" + (viewer . "gpg --import --interactive --verbose") + (type . "application/pgp-keys") + ("needsterminal"))) ("audio" ("x-mpeg" (viewer . "maplay %s") @@ -163,11 +213,6 @@ (type . "message/rfc822")) ("rfc-*822" (viewer . vm-mode) - (test . (fboundp 'vm-mode)) - (type . "message/rfc822")) - ("rfc-*822" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) (type . "message/rfc822")) ("rfc-*822" (viewer . view-mode) @@ -177,60 +222,48 @@ (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) ("x11-dump" (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) ("windowdump" (viewer . "xwud -in %s") (type . "image/x-xwd") ("compose" . "xwd -frame > %s") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) -;;; XEmacs says `ns' device-type not implemented. -;; (".*" -;; (viewer . "aopen %s") -;; (type . "image/*") -;; (test . (eq (mm-device-type) 'ns))) (".*" (viewer . "display %s") (type . "image/*") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11")) (".*" (viewer . "ee %s") (type . "image/*") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11"))) ("text" - ("plain" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "text/plain")) ("plain" (viewer . view-mode) - (test . (fboundp 'view-mode)) (type . "text/plain")) ("plain" (viewer . fundamental-mode) (type . "text/plain")) ("enriched" - (viewer . enriched-decode-region) - (test . (fboundp 'enriched-decode)) + (viewer . enriched-decode) (type . "text/enriched")) - ("html" - (viewer . mm-w3-prepare-buffer) - (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html"))) + ("dns" + (viewer . dns-mode) + (type . "text/dns"))) ("video" ("mpeg" (viewer . "mpeg_play %s") (type . "video/mpeg") - (test . (eq (mm-device-type) 'x)) + (test . (eq window-system 'x)) ("needsx11"))) ("x-world" ("x-vrml" @@ -241,8 +274,7 @@ ("archive" ("tar" (viewer . tar-mode) - (type . "archive/tar") - (test . (fboundp 'tar-mode))))) + (type . "archive/tar")))) "The mailcap structure is an assoc list of assoc lists. 1st assoc list is keyed on the major content-type 2nd assoc list is keyed on the minor content-type (which can be a regexp) @@ -263,9 +295,9 @@ attribute name (viewer, test, etc). This looks like: FLAG) Where VIEWERINFO specifies how the content-type is viewed. Can be -a string, in which case it is run through a shell, with -appropriate parameters, or a symbol, in which case the symbol is -`funcall'ed, with the buffer as an argument. +a string, in which case it is run through a shell, with appropriate +parameters, or a symbol, in which case the symbol is `funcall'ed if +and only if it exists as a function, with the buffer as an argument. TESTINFO is a test for the viewer's applicability, or nil. If nil, it means the viewer is always valid. If it is a Lisp function, it is @@ -275,14 +307,19 @@ validity. Otherwise, if it is a non-function Lisp symbol or list whose car is a symbol, it is `eval'led to yield the validity. If it is a string or list of strings, it represents a shell command to run to return a true or false shell value for the validity.") +(put 'mailcap-mime-data 'risky-local-variable t) (defcustom mailcap-download-directory nil "*Directory to which `mailcap-save-binary-file' downloads files by default. -Nil means your home directory." +nil means your home directory." :type '(choice (const :tag "Home directory" nil) directory) :group 'mailcap) +(defvar mailcap-poor-system-types + '(ms-dos windows-nt) + "Systems that don't have a Unix-like directory hierarchy.") + ;;; ;;; Utility functions ;;; @@ -310,7 +347,7 @@ If you are unsure what to do, please answer \"no\"." "Text of warning message displayed by `mailcap-maybe-eval'. Make sure that this text consists only of few text lines. Otherwise, Gnus might fail to display all of it.") - + (defun mailcap-maybe-eval () "Maybe evaluate a buffer of Emacs Lisp code." (let ((lisp-buffer (current-buffer))) @@ -359,7 +396,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (cond (path nil) ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) + ((memq system-type mailcap-poor-system-types) (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) (t (setq path ;; This is per RFC 1524, specifically @@ -368,7 +405,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus "/usr/local/etc/mailcap")))) (let ((fnames (reverse (if (stringp path) - (delete "" (split-string path path-separator)) + (split-string path path-separator t) path))) fname) (while fnames @@ -494,13 +531,21 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (skip-chars-forward ";")) (setq done t)))) (setq value (buffer-substring val-pos (point)))) - (setq results (cons (cons name value) results)) + ;; `test' as symbol, others like "copiousoutput" and "needsx11" as + ;; strings + (setq results (cons (cons (if (string-equal name "test") + 'test + name) + value) results)) (skip-chars-forward " \";\n\t")) results))) (defun mailcap-mailcap-entry-passes-test (info) - "Return non-nil iff mailcap entry INFO passes its test clause. -Also return non-nil if no test clause is present." + "Replace the test clause of INFO itself with a boolean for some cases. +This function supports only `test -n $DISPLAY' and `test -z $DISPLAY', +replaces them with t or nil. As for others or if INFO has a interactive +spec (needsterm, needsterminal, or needsx11) but DISPLAY is not set, +the test clause will be unchanged." (let ((test (assq 'test info)) ; The test clause status) (setq status (and test (split-string (cdr test) " "))) @@ -592,39 +637,42 @@ Also return non-nil if no test clause is present." (defvar mailcap-viewer-test-cache nil) (defun mailcap-viewer-passes-test (viewer-info type-info) - "Return non-nil iff viewer specified by VIEWER-INFO passes its test clause. -Also retun non-nil if it has no test clause. TYPE-INFO is an argument + "Return non-nil if viewer specified by VIEWER-INFO passes its test clause. +Also return non-nil if it has no test clause. TYPE-INFO is an argument to supply to the test." (let* ((test-info (assq 'test viewer-info)) (test (cdr test-info)) (otest test) - (viewer (cdr (assoc 'viewer viewer-info))) + (viewer (cdr (assq 'viewer viewer-info))) (default-directory (expand-file-name "~/")) - status parsed-test cache result) - (if (setq cache (assoc test mailcap-viewer-test-cache)) - (cadr cache) - (setq - result - (cond - ((not test-info) t) ; No test clause - ((not test) nil) ; Already failed test - ((eq test t) t) ; Already passed test - ((functionp test) ; Lisp function as test - (funcall test type-info)) - ((and (symbolp test) ; Lisp variable as test - (boundp test)) - (symbol-value test)) - ((and (listp test) ; List to be eval'd - (symbolp (car test))) - (eval test)) - (t - (setq test (mailcap-unescape-mime-test test type-info) - test (list shell-file-name nil nil nil - shell-command-switch test) - status (apply 'call-process test)) - (= 0 status)))) - (push (list otest result) mailcap-viewer-test-cache) - result))) + status cache result) + (cond ((not (or (stringp viewer) (fboundp viewer))) + nil) ; Non-existent Lisp function + ((setq cache (assoc test mailcap-viewer-test-cache)) + (cadr cache)) + ((not test-info) t) ; No test clause + (t + (setq + result + (cond + ((not test) nil) ; Already failed test + ((eq test t) t) ; Already passed test + ((functionp test) ; Lisp function as test + (funcall test type-info)) + ((and (symbolp test) ; Lisp variable as test + (boundp test)) + (symbol-value test)) + ((and (listp test) ; List to be eval'd + (symbolp (car test))) + (eval test)) + (t + (setq test (mailcap-unescape-mime-test test type-info) + test (list shell-file-name nil nil nil + shell-command-switch test) + status (apply 'call-process test)) + (eq 0 status)))) + (push (list otest result) mailcap-viewer-test-cache) + result)))) (defun mailcap-add-mailcap-entry (major minor info) (let ((old-major (assoc major mailcap-mime-data))) @@ -632,18 +680,18 @@ to supply to the test." (setq mailcap-mime-data (cons (cons major (list (cons minor info))) mailcap-mime-data)) - (let ((cur-minor (assoc minor old-major))) - (cond - ((or (null cur-minor) ; New minor area, or - (assq 'test info)) ; Has a test, insert at beginning - (setcdr old-major (cons (cons minor info) (cdr old-major)))) - ((and (not (assq 'test info)) ; No test info, replace completely - (not (assq 'test cur-minor)) + (let ((cur-minor (assoc minor old-major))) + (cond + ((or (null cur-minor) ; New minor area, or + (assq 'test info)) ; Has a test, insert at beginning + (setcdr old-major (cons (cons minor info) (cdr old-major)))) + ((and (not (assq 'test info)) ; No test info, replace completely + (not (assq 'test cur-minor)) (equal (assq 'viewer info) ; Keep alternative viewer (assq 'viewer cur-minor))) - (setcdr cur-minor info)) - (t - (setcdr old-major (cons (cons minor info) (cdr old-major)))))) + (setcdr cur-minor info)) + (t + (setcdr old-major (cons (cons minor info) (cdr old-major)))))) ))) (defun mailcap-add (type viewer &optional test) @@ -664,7 +712,7 @@ If TEST is not given, it defaults to t." ;;; (defun mailcap-viewer-lessp (x y) - "Return t iff viewer X is more desirable than viewer Y." + "Return t if viewer X is more desirable than viewer Y." (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) ""))) (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) ""))) (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) "")))) @@ -678,7 +726,7 @@ If TEST is not given, it defaults to t." t) (t nil)))) -(defun mailcap-mime-info (string &optional request) +(defun mailcap-mime-info (string &optional request no-decode) "Get the MIME viewer command for STRING, return nil if none found. Expects a complete content-type header line as its argument. @@ -688,21 +736,28 @@ entry) will be returned. If it is a string, then the mailcap field corresponding to that string will be returned (print, description, whatever). If a number, then all the information for this specific viewer is returned. If `all', then all possible viewers for -this type is returned." +this type is returned. + +If NO-DECODE is non-nil, don't decode STRING." + ;; NO-DECODE avoids calling `mail-header-parse-content-type' from + ;; `mail-parse.el' (let ( major ; Major encoding (text, etc) minor ; Minor encoding (html, etc) info ; Other info - save-pos ; Misc. position during parse + ; save-pos ; Misc. position during parse (unused?) major-info ; (assoc major mailcap-mime-data) - minor-info ; (assoc minor major-info) - test ; current test proc. + ; minor-info ; (assoc minor major-info) (unused?) + ; test ; current test proc. (unused?) viewers ; Possible viewers passed ; Viewers that passed the test viewer ; The one and only viewer ctl) (save-excursion - (setq ctl (mail-header-parse-content-type (or string "text/plain"))) + (setq ctl + (if no-decode + (list (or string "text/plain")) + (mail-header-parse-content-type (or string "text/plain")))) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) @@ -722,13 +777,12 @@ this type is returned." (setq viewer (car passed))) (cond ((and (null viewer) (not (equal major "default")) request) - (mailcap-mime-info "default" request)) + (mailcap-mime-info "default" request no-decode)) ((or (null request) (equal request "")) (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info)) ((stringp request) - (if (or (eq request 'test) (eq request 'viewer)) - (mailcap-unescape-mime-test - (cdr-safe (assoc request viewer)) info))) + (mailcap-unescape-mime-test + (cdr-safe (assoc request viewer)) info)) ((eq request 'all) passed) (t @@ -745,7 +799,10 @@ this type is returned." ;;; (defvar mailcap-mime-extensions - '(("" . "text/plain") + '(("" . "text/plain") + (".1" . "text/plain") ;; Manual pages + (".3" . "text/plain") + (".8" . "text/plain") (".abs" . "audio/x-mpeg") (".aif" . "audio/aiff") (".aifc" . "audio/aiff") @@ -761,6 +818,7 @@ this type is returned." (".css" . "text/css") (".dvi" . "application/x-dvi") (".diff" . "text/x-patch") + (".dpatch". "test/x-patch") (".el" . "application/emacs-lisp") (".eps" . "application/postscript") (".etx" . "text/x-setext") @@ -802,6 +860,7 @@ this type is returned." (".pict" . "image/pict") (".png" . "image/png") (".pnm" . "image/x-portable-anymap") + (".pod" . "text/plain") (".ppm" . "image/portable-pixmap") (".ps" . "application/postscript") (".qt" . "video/quicktime") @@ -811,7 +870,9 @@ this type is returned." (".rtx" . "text/richtext") (".sh" . "application/x-sh") (".sit" . "application/x-stuffit") + (".siv" . "application/sieve") (".snd" . "audio/basic") + (".soa" . "text/dns") (".src" . "application/x-wais-source") (".tar" . "archive/tar") (".tcl" . "application/x-tcl") @@ -828,6 +889,7 @@ this type is returned." (".vox" . "audio/basic") (".vrml" . "x-world/x-vrml") (".wav" . "audio/x-wav") + (".xls" . "application/vnd.ms-excel") (".wrl" . "x-world/x-vrml") (".xbm" . "image/xbm") (".xpm" . "image/xpm") @@ -835,7 +897,8 @@ this type is returned." (".zip" . "application/zip") (".ai" . "application/postscript") (".jpe" . "image/jpeg") - (".jpeg" . "image/jpeg")) + (".jpeg" . "image/jpeg") + (".org" . "text/x-org")) "An alist of file extensions and corresponding MIME content-types. This exists for you to customize the information in Lisp. It is merged with values from mailcap files by `mailcap-parse-mimetypes'.") @@ -854,7 +917,7 @@ If FORCE, re-parse even if already parsed." (cond (path nil) ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES"))) - ((memq system-type '(ms-dos ms-windows windows-nt)) + ((memq system-type mailcap-poor-system-types) (setq path '("~/mime.typ" "~/etc/mime.typ"))) (t (setq path ;; mime.types seems to be the normal name, definitely so @@ -871,7 +934,7 @@ If FORCE, re-parse even if already parsed." "/usr/local/etc/mime-types" "/usr/local/www/conf/mime-types")))) (let ((fnames (reverse (if (stringp path) - (delete "" (split-string path path-separator)) + (split-string path path-separator t) path))) fname) (while fnames @@ -930,7 +993,7 @@ If FORCE, re-parse even if already parsed." (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) - (mm-delete-duplicates + (mailcap-delete-duplicates (nconc (mapcar 'cdr mailcap-mime-extensions) (apply @@ -948,6 +1011,67 @@ If FORCE, re-parse even if already parsed." (cdr l)))) mailcap-mime-data))))) +;;; +;;; Useful supplementary functions +;;; + +(defun mailcap-file-default-commands (files) + "Return a list of default commands for FILES." + (mailcap-parse-mailcaps) + (mailcap-parse-mimetypes) + (let* ((all-mime-type + ;; All unique MIME types from file extensions + (mailcap-delete-duplicates + (mapcar (lambda (file) + (mailcap-extension-to-mime + (file-name-extension file t))) + files))) + (all-mime-info + ;; All MIME info lists + (mailcap-delete-duplicates + (mapcar (lambda (mime-type) + (mailcap-mime-info mime-type 'all)) + all-mime-type))) + (common-mime-info + ;; Intersection of mime-infos from different mime-types; + ;; or just the first MIME info for a single MIME type + (if (cdr all-mime-info) + (delq nil (mapcar (lambda (mi1) + (unless (memq nil (mapcar + (lambda (mi2) + (member mi1 mi2)) + (cdr all-mime-info))) + mi1)) + (car all-mime-info))) + (car all-mime-info))) + (commands + ;; Command strings from `viewer' field of the MIME info + (mailcap-delete-duplicates + (delq nil (mapcar (lambda (mime-info) + (let ((command (cdr (assoc 'viewer mime-info)))) + (if (stringp command) + (mailcap-replace-in-string + ;; Replace mailcap's `%s' placeholder + ;; with dired's `?' placeholder + (mailcap-replace-in-string + ;; Remove the final filename placeholder + command "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" t) + "%s" "?" t)))) + common-mime-info))))) + commands)) + +(defun mailcap-view-mime (type) + "View the data in the current buffer that has MIME type TYPE. +`mailcap-mime-data' determines the method to use." + (let ((method (mailcap-mime-info type))) + (if (stringp method) + (shell-command-on-region (point-min) (point-max) + ;; Use stdin as the "%s". + (format method "-") + (current-buffer) + t) + (funcall method)))) + (provide 'mailcap) ;;; mailcap.el ends here