xdg.el 12 KB
Newer Older
Mark Oteiza's avatar
Mark Oteiza committed
1 2
;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
Mark Oteiza's avatar
Mark Oteiza committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

;; Author: Mark Oteiza <mvoteiza@udel.edu>
;; Created: 27 January 2017
;; Keywords: files, data

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation; either version 3 of the License,
;; or (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Mark Oteiza's avatar
Mark Oteiza committed
23 24 25 26 27 28 29 30 31

;;; Commentary:

;; Library providing some convenience functions for the following XDG
;; standards and specifications
;;
;; - XDG Base Directory Specification
;; - Thumbnail Managing Standard
;; - xdg-user-dirs configuration
32
;; - Desktop Entry Specification
Mark Oteiza's avatar
Mark Oteiza committed
33 34 35

;;; Code:

36
(eval-when-compile
Mark Oteiza's avatar
Mark Oteiza committed
37
  (require 'cl-lib)
38 39
  (require 'subr-x))

Mark Oteiza's avatar
Mark Oteiza committed
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76

;; XDG Base Directory Specification
;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html

(defmacro xdg--dir-home (environ default-path)
  (declare (debug (stringp stringp)))
  (let ((env (make-symbol "env")))
    `(let ((,env (getenv ,environ)))
       (if (or (null ,env) (not (file-name-absolute-p ,env)))
           (expand-file-name ,default-path)
         ,env))))

(defun xdg-config-home ()
  "Return the base directory for user specific configuration files."
  (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))

(defun xdg-cache-home ()
  "Return the base directory for user specific cache files."
  (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))

(defun xdg-data-home ()
  "Return the base directory for user specific data files."
  (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))

(defun xdg-runtime-dir ()
  "Return the value of $XDG_RUNTIME_DIR."
  (getenv "XDG_RUNTIME_DIR"))

(defun xdg-config-dirs ()
  "Return the config directory search path as a list."
  (let ((env (getenv "XDG_CONFIG_DIRS")))
    (if (or (null env) (string= env ""))
        '("/etc/xdg")
      (parse-colon-path env))))

(defun xdg-data-dirs ()
  "Return the data directory search path as a list."
77
  (let ((env (getenv "XDG_DATA_DIRS")))
Mark Oteiza's avatar
Mark Oteiza committed
78 79 80 81 82 83 84 85 86 87
    (if (or (null env) (string= env ""))
        '("/usr/local/share/" "/usr/share/")
      (parse-colon-path env))))


;; Thumbnail Managing Standard
;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html

(defun xdg-thumb-uri (filename)
  "Return the canonical URI for FILENAME.
88
If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is
Mark Oteiza's avatar
Mark Oteiza committed
89 90 91 92 93 94 95 96
file:///foo/bar.jpg"
  (concat "file://" (expand-file-name filename)))

(defun xdg-thumb-name (filename)
  "Return the appropriate thumbnail filename for FILENAME."
  (concat (md5 (xdg-thumb-uri filename)) ".png"))

(defun xdg-thumb-mtime (filename)
97 98
  "Return modification time of FILENAME as an Emacs timestamp."
  (file-attribute-modification-time (file-attributes filename)))
Mark Oteiza's avatar
Mark Oteiza committed
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116


;; XDG User Directories
;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/

(defconst xdg-line-regexp
  (eval-when-compile
    (rx "XDG_"
        (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
                       "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
        "_DIR=\""
        (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
        "\""))
  "Regexp matching non-comment lines in xdg-user-dirs config files.")

(defvar xdg-user-dirs nil
  "Alist of directory keys and values.")

117 118 119
(defun xdg--substitute-home-env (str)
  (if (file-name-absolute-p str) str
    (save-match-data
120
      (and (string-match "^\\$HOME/" str)
121 122
           (replace-match "~/" t nil str 0)))))

Mark Oteiza's avatar
Mark Oteiza committed
123 124 125 126 127 128 129 130
(defun xdg--user-dirs-parse-line ()
  "Return pair of user-dirs key to directory value in LINE, otherwise nil.
This should be called at the beginning of a line."
  (skip-chars-forward "[:blank:]")
  (when (and (/= (following-char) ?#)
             (looking-at xdg-line-regexp))
    (let ((k (match-string 1))
          (v (match-string 2)))
131
      (when (and k v) (cons k (xdg--substitute-home-env v))))))
Mark Oteiza's avatar
Mark Oteiza committed
132 133 134 135

(defun xdg--user-dirs-parse-file (filename)
  "Return alist of xdg-user-dirs from FILENAME."
  (let (elt res)
136 137 138 139 140 141 142 143
    (when (file-readable-p filename)
      (with-temp-buffer
        (insert-file-contents filename)
        (goto-char (point-min))
        (while (not (eobp))
          (setq elt (xdg--user-dirs-parse-line))
          (when (consp elt) (push elt res))
          (forward-line))))
Mark Oteiza's avatar
Mark Oteiza committed
144 145 146
    res))

(defun xdg-user-dir (name)
Mark Oteiza's avatar
Mark Oteiza committed
147
  "Return the directory referred to by NAME."
Mark Oteiza's avatar
Mark Oteiza committed
148
  (when (null xdg-user-dirs)
Mark Oteiza's avatar
Mark Oteiza committed
149 150 151
    (setq xdg-user-dirs
          (xdg--user-dirs-parse-file
           (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
152 153
  (let ((dir (cdr (assoc name xdg-user-dirs))))
    (when dir (expand-file-name dir))))
Mark Oteiza's avatar
Mark Oteiza committed
154

155 156 157 158 159 160 161 162 163 164 165 166

;; Desktop Entry Specification
;; https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html

(defconst xdg-desktop-group-regexp
  (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]")
  "Regexp matching desktop file group header names.")

;; TODO Localized strings left out intentionally, as Emacs has no
;; notion of l10n/i18n
(defconst xdg-desktop-entry-regexp
  (rx (group-n 1 (+ (in "A-Za-z0-9-")))
Mark Oteiza's avatar
Mark Oteiza committed
167
      ;; (? "[" (group-n 3 (+ nonl)) "]")
168 169 170 171
      (* blank) "=" (* blank)
      (group-n 2 (* nonl)))
  "Regexp matching desktop file entry key-value pairs.")

172 173 174 175 176 177 178 179 180 181
(defun xdg-desktop-read-group ()
  "Return hash table of group of desktop entries in the current buffer."
  (let ((res (make-hash-table :test #'equal)))
    (while (not (or (eobp) (looking-at xdg-desktop-group-regexp)))
      (skip-chars-forward "[:blank:]")
      (cond
       ((eolp))
       ((= (following-char) ?#))
       ((looking-at xdg-desktop-entry-regexp)
        (puthash (match-string 1) (match-string 2) res))
182 183
       ;; Filter localized strings
       ((looking-at (rx (group-n 1 (+ (in alnum "-"))) (* blank) "[")))
184 185 186
       (t (error "Malformed line: %s"
                 (buffer-substring (point) (point-at-eol)))))
      (forward-line))
187 188
    res))

189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206
(defun xdg-desktop-read-file (filename &optional group)
  "Return group contents of desktop file FILENAME as a hash table.
Optional argument GROUP defaults to the string \"Desktop Entry\"."
  (with-temp-buffer
    (insert-file-contents-literally filename)
    (goto-char (point-min))
    (while (and (skip-chars-forward "[:blank:]" (line-end-position))
                (or (eolp) (= (following-char) ?#)))
      (forward-line))
    (unless (looking-at xdg-desktop-group-regexp)
      (error "Expected group name!  Instead saw: %s"
             (buffer-substring (point) (point-at-eol))))
    (when group
      (while (and (re-search-forward xdg-desktop-group-regexp nil t)
                  (not (equal (match-string 1) group)))))
    (forward-line)
    (xdg-desktop-read-group)))

207 208 209
(defun xdg-desktop-strings (value)
  "Partition VALUE into elements delimited by unescaped semicolons."
  (let (res)
Mark Oteiza's avatar
Mark Oteiza committed
210 211 212
    (setq value (string-trim-left value))
    (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";"))
      (push (replace-regexp-in-string "\0" ";" x) res))
213 214 215
    (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
    (nreverse res)))

Mark Oteiza's avatar
Mark Oteiza committed
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297

;; 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)
Paul Eggert's avatar
Paul Eggert committed
298 299 300
                          maximize (float-time
				    (file-attribute-modification-time
				     (file-attributes f))))))
Mark Oteiza's avatar
Mark Oteiza committed
301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
      ;; 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)))))))

Mark Oteiza's avatar
Mark Oteiza committed
320 321 322
(provide 'xdg)

;;; xdg.el ends here