Add MIME apps spec utilities

Facilitates finding associations between MIME types and desktop files
that report an association with that type.  Combined with mailcap.el's
MIME facilities, it should be easy to use desktop files.
* lisp/xdg.el (xdg-mime-table): New variable.
(xdg-mime-apps-files, xdg-mime-collect-associations, xdg-mime-apps):
New functions.
* test/data/xdg/mimeapps.list: New file.
* test/data/xdg/mimeinfo.cache: New file.
* test/lisp/xdg-tests.el (xdg-mime-associations): New test.

diff --git a/lisp/xdg.el b/lisp/xdg.el
index 76106f42586ea1106529e84b9ed8e8cf1961ac81..4250faaeb4bb164dcef4675a36346e8f4de66ae9 100644 (file)
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -34,6 +34,7 @@
 ;;; Code:
 
 (eval-when-compile
+  (require 'cl-lib)
   (require 'subr-x))
 
 \f
@@ -212,6 +213,108 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"."
     (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
     (nreverse res)))
 
+\f
+;; MIME apps specification
+;; https://standards.freedesktop.org/mime-apps-spec/mime-apps-spec-1.0.1.html
+
+(defvar xdg-mime-table nil
+  "Table of MIME type to desktop file associations.
+The table is an alist with keys being MIME major types (\"application\",
+\"audio\", etc.), and values being hash tables.  Each hash table has
+MIME subtypes as keys and lists of desktop file absolute filenames.")
+
+(defun xdg-mime-apps-files ()
+  "Return a list of files containing MIME/Desktop associations.
+The list is in order of descending priority: user config, then
+admin config, and finally system cached associations."
+  (let ((xdg-data-dirs (xdg-data-dirs))
+        (desktop (getenv "XDG_CURRENT_DESKTOP"))
+        res)
+    (when desktop
+      (setq desktop (format "%s-mimeapps.list" desktop)))
+    (dolist (name (cons "mimeapps.list" desktop))
+      (push (expand-file-name name (xdg-config-home)) res)
+      (push (expand-file-name (format "applications/%s" name) (xdg-data-home))
+            res)
+      (dolist (dir (xdg-config-dirs))
+        (push (expand-file-name name dir) res))
+      (dolist (dir xdg-data-dirs)
+        (push (expand-file-name (format "applications/%s" name) dir) res)))
+    (dolist (dir xdg-data-dirs)
+      (push (expand-file-name "applications/mimeinfo.cache" dir) res))
+    (nreverse res)))
+
+(defun xdg-mime-collect-associations (mime files)
+  "Return a list of desktop file names associated with MIME.
+The associations are searched in the list of file names FILES,
+which is expected to be ordered by priority as in
+`xdg-mime-apps-files'."
+  (let ((regexp (concat (regexp-quote mime) "=\\([^[:cntrl:]]*\\)$"))
+        res sec defaults added removed cached)
+    (with-temp-buffer
+      (dolist (f (reverse files))
+        (when (file-readable-p f)
+          (insert-file-contents-literally f nil nil nil t)
+          (goto-char (point-min))
+          (let (end)
+            (while (not (or (eobp) end))
+              (if (= (following-char) ?\[)
+                  (progn (setq sec (char-after (1+ (point))))
+                         (forward-line))
+                (if (not (looking-at regexp))
+                    (forward-line)
+                  (dolist (str (xdg-desktop-strings (match-string 1)))
+                    (cl-pushnew str
+                                (cond ((eq sec ?D) defaults)
+                                      ((eq sec ?A) added)
+                                      ((eq sec ?R) removed)
+                                      ((eq sec ?M) cached))
+                                :test #'equal))
+                  (while (and (zerop (forward-line))
+                              (/= (following-char) ?\[)))))))
+          ;; Accumulate results into res
+          (dolist (f cached)
+            (when (not (member f removed)) (cl-pushnew f res :test #'equal)))
+          (dolist (f added)
+            (when (not (member f removed)) (push f res)))
+          (dolist (f removed)
+            (setq res (delete f res)))
+          (dolist (f defaults)
+            (push f res))
+          (setq defaults nil added nil removed nil cached nil))))
+    (delete-dups res)))
+
+(defun xdg-mime-apps (mime)
+  "Return list of desktop files associated with MIME, otherwise nil.
+The list is in order of descending priority, and each element is
+an absolute file name of a readable file.
+Results are cached in `xdg-mime-table'."
+  (pcase-let ((`(,type ,subtype) (split-string mime "/"))
+              (xdg-data-dirs (xdg-data-dirs))
+              (caches (xdg-mime-apps-files))
+              (files ()))
+    (let ((mtim1 (get 'xdg-mime-table 'mtime))
+          (mtim2 (cl-loop for f in caches when (file-readable-p f)
+                          maximize (float-time (nth 5 (file-attributes f))))))
+      ;; If one of the MIME/Desktop cache files has been modified:
+      (when (or (null mtim1) (time-less-p mtim1 mtim2))
+        (setq xdg-mime-table nil)))
+    (when (null (assoc type xdg-mime-table))
+      (push (cons type (make-hash-table :test #'equal)) xdg-mime-table))
+    (if (let ((def (make-symbol "def"))
+              (table (cdr (assoc type xdg-mime-table))))
+          (not (eq (setq files (gethash subtype table def)) def)))
+        files
+      (and files (setq files nil))
+      (let ((dirs (mapcar (lambda (dir) (expand-file-name "applications" dir))
+                          (cons (xdg-data-home) xdg-data-dirs))))
+        ;; Not being particular about desktop IDs
+        (dolist (f (nreverse (xdg-mime-collect-associations mime caches)))
+          (push (locate-file f dirs) files))
+        (when files
+          (put 'xdg-mime-table 'mtime (current-time)))
+        (puthash subtype (delq nil files) (cdr (assoc type xdg-mime-table)))))))
+
 (provide 'xdg)
 
 ;;; xdg.el ends here

diff --git a/test/data/xdg/mimeapps.list b/test/data/xdg/mimeapps.list
new file mode 100644 (file)
index 0000000..27fbd94
--- /dev/null
+++ b/test/data/xdg/mimeapps.list
@@ -0,0 +1,9 @@
+[Default Applications]
+x-test/foo=a.desktop
+
+[Added Associations]
+x-test/foo=b.desktop
+x-test/baz=a.desktop
+
+[Removed Associations]
+x-test/foo=c.desktop;d.desktop

diff --git a/test/data/xdg/mimeinfo.cache b/test/data/xdg/mimeinfo.cache
new file mode 100644 (file)
index 0000000..6e54f60
--- /dev/null
+++ b/test/data/xdg/mimeinfo.cache
@@ -0,0 +1,4 @@
+[MIME Cache]
+x-test/foo=c.desktop;d.desktop
+x-test/bar=a.desktop;c.desktop
+x-test/baz=b.desktop;d.desktop

diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
index b80f5e85524129fdc5570a8b867e4487c16bb26c..eaf03ab9a03d9af828cc0f13642d578bfffea795 100644 (file)
--- a/test/lisp/xdg-tests.el
+++ b/test/lisp/xdg-tests.el
@@ -65,4 +65,16 @@
   (should (equal (xdg-desktop-strings " ") nil))
   (should (equal (xdg-desktop-strings "a; ;") '("a" " "))))
 
+(ert-deftest xdg-mime-associations ()
+  "Test reading MIME associations from files."
+  (let* ((apps (expand-file-name "mimeapps.list" xdg-tests-data-dir))
+         (cache (expand-file-name "mimeinfo.cache" xdg-tests-data-dir))
+         (fs (list apps cache)))
+    (should (equal (xdg-mime-collect-associations "x-test/foo" fs)
+                   '("a.desktop" "b.desktop")))
+    (should (equal (xdg-mime-collect-associations "x-test/bar" fs)
+                   '("a.desktop" "c.desktop")))
+    (should (equal (xdg-mime-collect-associations "x-test/baz" fs)
+                   '("a.desktop" "b.desktop" "d.desktop")))))
+
 ;;; xdg-tests.el ends here