mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-06 14:22:31 -07:00
Code Issues Projects Releases Wiki Activity

(mailcap-file-default-commands): New function.

Browse source
This commit is contained in:
Juri Linkov 2008-04-22 19:51:27 +00:00
parent a98a2fe87a
commit a837fe74bf
2 changed files with 52 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
lisp/gnus/ChangeLog
View file

@ -1,3 +1,7 @@
2008-04-22 Juri Linkov <juri@jurta.org>
* mailcap.el (mailcap-file-default-commands): New function.
2008-04-13 Reiner Steib <Reiner.Steib@gmx.de>
* message.el (message-signature-separator, message-cite-function):

48
lisp/gnus/mailcap.el
View file

@ -1007,6 +1007,54 @@ 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
(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