lisp/xdg.el

   1 ;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Mark Oteiza <mvoteiza@udel.edu>
   6 ;; Created: 27 January 2017
   7 ;; Keywords: files, data
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published
  13 ;; by the Free Software Foundation; either version 3 of the License,
  14 ;; or (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; 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/>.
  23
  24 ;;; Commentary:
  25
  26 ;; Library providing some convenience functions for the following XDG
  27 ;; standards and specifications
  28 ;;
  29 ;; - XDG Base Directory Specification
  30 ;; - Thumbnail Managing Standard
  31 ;; - xdg-user-dirs configuration
  32 ;; - Desktop Entry Specification
  33
  34 ;;; Code:
  35
  36 (eval-when-compile
  37   (require 'subr-x))
  38
  39 \f
  40 ;; XDG Base Directory Specification
  41 ;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
  42
  43 (defmacro xdg--dir-home (environ default-path)
  44   (declare (debug (stringp stringp)))
  45   (let ((env (make-symbol "env")))
  46     `(let ((,env (getenv ,environ)))
  47        (if (or (null ,env) (not (file-name-absolute-p ,env)))
  48            (expand-file-name ,default-path)
  49          ,env))))
  50
  51 (defun xdg-config-home ()
  52   "Return the base directory for user specific configuration files."
  53   (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))
  54
  55 (defun xdg-cache-home ()
  56   "Return the base directory for user specific cache files."
  57   (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))
  58
  59 (defun xdg-data-home ()
  60   "Return the base directory for user specific data files."
  61   (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
  62
  63 (defun xdg-runtime-dir ()
  64   "Return the value of $XDG_RUNTIME_DIR."
  65   (getenv "XDG_RUNTIME_DIR"))
  66
  67 (defun xdg-config-dirs ()
  68   "Return the config directory search path as a list."
  69   (let ((env (getenv "XDG_CONFIG_DIRS")))
  70     (if (or (null env) (string= env ""))
  71         '("/etc/xdg")
  72       (parse-colon-path env))))
  73
  74 (defun xdg-data-dirs ()
  75   "Return the data directory search path as a list."
  76   (let ((env (getenv "XDG_DATA_DIRS")))
  77     (if (or (null env) (string= env ""))
  78         '("/usr/local/share/" "/usr/share/")
  79       (parse-colon-path env))))
  80
  81 \f
  82 ;; Thumbnail Managing Standard
  83 ;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
  84
  85 (defun xdg-thumb-uri (filename)
  86   "Return the canonical URI for FILENAME.
  87 If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is
  88 file:///foo/bar.jpg"
  89   (concat "file://" (expand-file-name filename)))
  90
  91 (defun xdg-thumb-name (filename)
  92   "Return the appropriate thumbnail filename for FILENAME."
  93   (concat (md5 (xdg-thumb-uri filename)) ".png"))
  94
  95 (defun xdg-thumb-mtime (filename)
  96   "Return modification time of FILENAME as integral seconds from the epoch."
  97   (floor (float-time (nth 5 (file-attributes filename)))))
  98
  99 \f
 100 ;; XDG User Directories
 101 ;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
 102
 103 (defconst xdg-line-regexp
 104   (eval-when-compile
 105     (rx "XDG_"
 106         (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
 107                        "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
 108         "_DIR=\""
 109         (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
 110         "\""))
 111   "Regexp matching non-comment lines in xdg-user-dirs config files.")
 112
 113 (defvar xdg-user-dirs nil
 114   "Alist of directory keys and values.")
 115
 116 (defun xdg--substitute-home-env (str)
 117   (if (file-name-absolute-p str) str
 118     (save-match-data
 119       (and (string-match "^$HOME/" str)
 120            (replace-match "~/" t nil str 0)))))
 121
 122 (defun xdg--user-dirs-parse-line ()
 123   "Return pair of user-dirs key to directory value in LINE, otherwise nil.
 124 This should be called at the beginning of a line."
 125   (skip-chars-forward "[:blank:]")
 126   (when (and (/= (following-char) ?#)
 127              (looking-at xdg-line-regexp))
 128     (let ((k (match-string 1))
 129           (v (match-string 2)))
 130       (when (and k v) (cons k (xdg--substitute-home-env v))))))
 131
 132 (defun xdg--user-dirs-parse-file (filename)
 133   "Return alist of xdg-user-dirs from FILENAME."
 134   (let (elt res)
 135     (when (file-readable-p filename)
 136       (with-temp-buffer
 137         (insert-file-contents filename)
 138         (goto-char (point-min))
 139         (while (not (eobp))
 140           (setq elt (xdg--user-dirs-parse-line))
 141           (when (consp elt) (push elt res))
 142           (forward-line))))
 143     res))
 144
 145 (defun xdg-user-dir (name)
 146   "Return the directory referred to by NAME."
 147   (when (null xdg-user-dirs)
 148     (setq xdg-user-dirs
 149           (xdg--user-dirs-parse-file
 150            (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
 151   (let ((dir (cdr (assoc name xdg-user-dirs))))
 152     (when dir (expand-file-name dir))))
 153
 154 \f
 155 ;; Desktop Entry Specification
 156 ;; https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html
 157
 158 (defconst xdg-desktop-group-regexp
 159   (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]")
 160   "Regexp matching desktop file group header names.")
 161
 162 ;; TODO Localized strings left out intentionally, as Emacs has no
 163 ;; notion of l10n/i18n
 164 (defconst xdg-desktop-entry-regexp
 165   (rx (group-n 1 (+ (in "A-Za-z0-9-")))
 166       ;; (? "[" (group-n 3 (+ nonl)) "]")
 167       (* blank) "=" (* blank)
 168       (group-n 2 (* nonl)))
 169   "Regexp matching desktop file entry key-value pairs.")
 170
 171 (defun xdg-desktop-read-group ()
 172   "Return hash table of group of desktop entries in the current buffer."
 173   (let ((res (make-hash-table :test #'equal)))
 174     (while (not (or (eobp) (looking-at xdg-desktop-group-regexp)))
 175       (skip-chars-forward "[:blank:]")
 176       (cond
 177        ((eolp))
 178        ((= (following-char) ?#))
 179        ((looking-at xdg-desktop-entry-regexp)
 180         (puthash (match-string 1) (match-string 2) res))
 181        ;; Filter localized strings
 182        ((looking-at (rx (group-n 1 (+ (in alnum "-"))) (* blank) "[")))
 183        (t (error "Malformed line: %s"
 184                  (buffer-substring (point) (point-at-eol)))))
 185       (forward-line))
 186     res))
 187
 188 (defun xdg-desktop-read-file (filename &optional group)
 189   "Return group contents of desktop file FILENAME as a hash table.
 190 Optional argument GROUP defaults to the string \"Desktop Entry\"."
 191   (with-temp-buffer
 192     (insert-file-contents-literally filename)
 193     (goto-char (point-min))
 194     (while (and (skip-chars-forward "[:blank:]" (line-end-position))
 195                 (or (eolp) (= (following-char) ?#)))
 196       (forward-line))
 197     (unless (looking-at xdg-desktop-group-regexp)
 198       (error "Expected group name!  Instead saw: %s"
 199              (buffer-substring (point) (point-at-eol))))
 200     (when group
 201       (while (and (re-search-forward xdg-desktop-group-regexp nil t)
 202                   (not (equal (match-string 1) group)))))
 203     (forward-line)
 204     (xdg-desktop-read-group)))
 205
 206 (defun xdg-desktop-strings (value)
 207   "Partition VALUE into elements delimited by unescaped semicolons."
 208   (let (res)
 209     (setq value (string-trim-left value))
 210     (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";"))
 211       (push (replace-regexp-in-string "\0" ";" x) res))
 212     (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
 213     (nreverse res)))
 214
 215 (provide 'xdg)
 216
 217 ;;; xdg.el ends here