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 <http://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
  33 ;;; Code:
  34
  35 \f
  36 ;; XDG Base Directory Specification
  37 ;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
  38
  39 (defmacro xdg--dir-home (environ default-path)
  40   (declare (debug (stringp stringp)))
  41   (let ((env (make-symbol "env")))
  42     `(let ((,env (getenv ,environ)))
  43        (if (or (null ,env) (not (file-name-absolute-p ,env)))
  44            (expand-file-name ,default-path)
  45          ,env))))
  46
  47 (defun xdg-config-home ()
  48   "Return the base directory for user specific configuration files."
  49   (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))
  50
  51 (defun xdg-cache-home ()
  52   "Return the base directory for user specific cache files."
  53   (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))
  54
  55 (defun xdg-data-home ()
  56   "Return the base directory for user specific data files."
  57   (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
  58
  59 (defun xdg-runtime-dir ()
  60   "Return the value of $XDG_RUNTIME_DIR."
  61   (getenv "XDG_RUNTIME_DIR"))
  62
  63 (defun xdg-config-dirs ()
  64   "Return the config directory search path as a list."
  65   (let ((env (getenv "XDG_CONFIG_DIRS")))
  66     (if (or (null env) (string= env ""))
  67         '("/etc/xdg")
  68       (parse-colon-path env))))
  69
  70 (defun xdg-data-dirs ()
  71   "Return the data directory search path as a list."
  72   (let ((env (getenv "XDG_DATA_DIRS")))
  73     (if (or (null env) (string= env ""))
  74         '("/usr/local/share/" "/usr/share/")
  75       (parse-colon-path env))))
  76
  77 \f
  78 ;; Thumbnail Managing Standard
  79 ;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
  80
  81 (defun xdg-thumb-uri (filename)
  82   "Return the canonical URI for FILENAME.
  83 If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
  84 file:///foo/bar.jpg"
  85   (concat "file://" (expand-file-name filename)))
  86
  87 (defun xdg-thumb-name (filename)
  88   "Return the appropriate thumbnail filename for FILENAME."
  89   (concat (md5 (xdg-thumb-uri filename)) ".png"))
  90
  91 (defun xdg-thumb-mtime (filename)
  92   "Return modification time of FILENAME as integral seconds from the epoch."
  93   (floor (float-time (nth 5 (file-attributes filename)))))
  94
  95 \f
  96 ;; XDG User Directories
  97 ;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
  98
  99 (defconst xdg-line-regexp
 100   (eval-when-compile
 101     (rx "XDG_"
 102         (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
 103                        "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
 104         "_DIR=\""
 105         (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
 106         "\""))
 107   "Regexp matching non-comment lines in xdg-user-dirs config files.")
 108
 109 (defvar xdg-user-dirs nil
 110   "Alist of directory keys and values.")
 111
 112 (defun xdg--substitute-home-env (str)
 113   (if (file-name-absolute-p str) str
 114     (save-match-data
 115       (and (string-match "^$HOME/" str)
 116            (replace-match "~/" t nil str 0)))))
 117
 118 (defun xdg--user-dirs-parse-line ()
 119   "Return pair of user-dirs key to directory value in LINE, otherwise nil.
 120 This should be called at the beginning of a line."
 121   (skip-chars-forward "[:blank:]")
 122   (when (and (/= (following-char) ?#)
 123              (looking-at xdg-line-regexp))
 124     (let ((k (match-string 1))
 125           (v (match-string 2)))
 126       (when (and k v) (cons k (xdg--substitute-home-env v))))))
 127
 128 (defun xdg--user-dirs-parse-file (filename)
 129   "Return alist of xdg-user-dirs from FILENAME."
 130   (let (elt res)
 131     (with-temp-buffer
 132       (insert-file-contents filename)
 133       (goto-char (point-min))
 134       (while (not (eobp))
 135         (setq elt (xdg--user-dirs-parse-line))
 136         (when (consp elt) (push elt res))
 137         (forward-line)))
 138     res))
 139
 140 (defun xdg-user-dir (name)
 141   "Return the path of user directory referred to by NAME."
 142   (when (null xdg-user-dirs)
 143     (setq xdg-user-dirs
 144           (xdg--user-dirs-parse-file
 145            (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
 146   (let ((dir (cdr (assoc name xdg-user-dirs))))
 147     (when dir (expand-file-name dir))))
 148
 149 (provide 'xdg)
 150
 151 ;;; xdg.el ends here