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.

4 files changed, 128 insertions, 0 deletions

diff --git a/lisp/xdg.el b/lisp/xdg.el
index 76106f42586..4250faaeb4b 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -34,6 +34,7 @@
 ;;; Code:
 
 (eval-when-compile
+  (require 'cl-lib)
   (require 'subr-x))
 
 
@@ -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)))
 
+
+;; 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
index 00000000000..27fbd94b16b
--- /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
index 00000000000..6e54f604fa0
--- /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 b80f5e85524..eaf03ab9a03 100644
--- 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