X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8dd59f01de203f3f02c3f898a7015bb522a0e4bc..4b36c6d4debd2fe02b6ce77e5e90c78655b6f37f:/lisp/gnus/mailcap.el

diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index 866e57fef3..524928586f 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -1,7 +1,7 @@
 ;;; mailcap.el --- MIME media types configuration
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: William M. Perry <wmperry@aventail.com>
 ;;	Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -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 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:
 
@@ -42,6 +40,19 @@
     (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"
@@ -324,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.")
 
 ;;;
@@ -412,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
@@ -930,7 +941,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
@@ -1007,7 +1018,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