;;; mailcap.el --- MIME media types configuration
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(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."
:version "21.1"
(list lpr-switches)
lpr-switches)))
" ")
- "Shell command (including switches) used to print Postscript files.")
+ "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
;; files for the rest? -- fx
(defvar mailcap-mime-data
`(("application"
- ("vnd.ms-excel"
+ ("vnd\\.ms-excel"
(viewer . "gnumeric %s")
(test . (getenv "DISPLAY"))
(type . "application/vnd.ms-excel"))
:group 'mailcap)
(defvar mailcap-poor-system-types
- '(ms-dos ms-windows windows-nt win32 w32 mswindows)
+ '(ms-dos windows-nt)
"Systems that don't have a Unix-like directory hierarchy.")
;;;
"/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
;;;
(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")
(".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")
(".pict" . "image/pict")
(".png" . "image/png")
(".pnm" . "image/x-portable-anymap")
+ (".pod" . "text/plain")
(".ppm" . "image/portable-pixmap")
(".ps" . "application/postscript")
(".qt" . "video/quicktime")
(".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'.")
"/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
(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))
+
(provide 'mailcap)
-;;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd
;;; mailcap.el ends here
projects / gnus / blobdiff