X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmailcap.el;h=01d8587f06a66e1b579b12f92586d24bb9d443fc;hp=015e2535dc1fc7e1561b6138348bd07d37b416c2;hb=b83561e18ceb438203812786590893bd5fc2a6cc;hpb=c752324952c23de3b4f12734e1fcae3ebe46af95 diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 015e2535d..01d8587f0 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -1,7 +1,6 @@ ;;; mailcap.el --- MIME media types configuration -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 1998-2015 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -9,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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -33,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." @@ -66,7 +82,7 @@ (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 @@ -74,7 +90,7 @@ ;; 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")) @@ -136,6 +152,10 @@ (non-viewer . t) (type . "application/zip") ("copiousoutput")) + ("pdf" + (viewer . doc-view-mode) + (type . "application/pdf") + (test . (eq window-system 'x))) ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") @@ -199,10 +219,6 @@ (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) (type . "message/rfc822"))) @@ -236,10 +252,6 @@ (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)) @@ -251,10 +263,6 @@ (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) - ("html" - (viewer . mm-w3-prepare-buffer) - (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html")) ("dns" (viewer . dns-mode) (test . (fboundp 'dns-mode)) @@ -318,7 +326,7 @@ nil means your home directory." :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.") ;;; @@ -406,7 +414,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 @@ -542,7 +550,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus results))) (defun mailcap-mailcap-entry-passes-test (info) - "Return non-nil iff mailcap entry INFO passes its test clause. + "Return non-nil if mailcap entry INFO passes its test clause. Also return non-nil if no test clause is present." (let ((test (assq 'test info)) ; The test clause status) @@ -635,7 +643,7 @@ 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. + "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)) @@ -708,7 +716,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)) "")))) @@ -722,7 +730,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. @@ -732,7 +740,11 @@ 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) @@ -746,7 +758,10 @@ this type is returned." 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)) @@ -766,7 +781,7 @@ 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) @@ -788,7 +803,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") @@ -804,6 +822,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") @@ -845,6 +864,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") @@ -881,7 +901,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'.") @@ -917,7 +938,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 @@ -976,7 +997,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 @@ -994,7 +1015,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) -;;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd ;;; mailcap.el ends here