[Emacs-diffs] Changes to emacs/lisp/gnus/mailcap.el,v

[Juri Linkov]

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