X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmailcap.el;h=36a710d58c9c8302d948f6439bd12aaf368d6fe8;hp=e46045fe38e77d1f45d134f2e9d90fdeb16ef530;hb=a2556858067503fc6719a777279ace07db95735e;hpb=fe70196e10cdd849981dbd014882fb20237d0740 diff --git a/lisp/mailcap.el b/lisp/mailcap.el index e46045fe3..36a710d58 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -1,7 +1,7 @@ ;;; mailcap.el --- MIME media types configuration ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: William M. Perry ;; Lars Magne Ingebrigtsen @@ -9,20 +9,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 +31,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." @@ -318,7 +335,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 +423,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 +559,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 +652,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 +725,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 +739,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 +749,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 +767,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 +790,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 +812,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 +831,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 +873,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") @@ -917,7 +946,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 +1005,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 +1023,55 @@ 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)) + (provide 'mailcap) -;;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd ;;; mailcap.el ends here