diff options
| -rw-r--r-- | lisp/xdg.el | 103 | ||||
| -rw-r--r-- | test/data/xdg/mimeapps.list | 9 | ||||
| -rw-r--r-- | test/data/xdg/mimeinfo.cache | 4 | ||||
| -rw-r--r-- | test/lisp/xdg-tests.el | 12 |
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 |