[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/mailcap.el,v
From: |
Juri Linkov |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/mailcap.el,v |
Date: |
Tue, 22 Apr 2008 19:51:01 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Juri Linkov <jurta> 08/04/22 19:51:00
Index: mailcap.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/gnus/mailcap.el,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- mailcap.el 10 Apr 2008 14:10:00 -0000 1.22
+++ mailcap.el 22 Apr 2008 19:51:00 -0000 1.23
@@ -1007,6 +1007,54 @@
(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
+ (delete-dups (mapcar (lambda (file)
+ (mailcap-extension-to-mime
+ (file-name-extension file t)))
+ files)))
+ (all-mime-info
+ ;; All MIME info lists
+ (delete-dups (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
+ (delete-dups
+ (delq nil (mapcar (lambda (mime-info)
+ (let ((command (cdr (assoc 'viewer mime-info))))
+ (if (stringp command)
+ (replace-regexp-in-string
+ ;; Replace mailcap's `%s' placeholder
+ ;; with dired's `?' placeholder
+ "%s" "?"
+ (replace-regexp-in-string
+ ;; Remove the final filename placeholder
+ "\s*\\('\\)?%s\\1?\s*\\'" "" command nil
t)
+ nil t))))
+ common-mime-info)))))
+ commands))
+
(provide 'mailcap)
;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd