xdg.el 4.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152
  1. ;;; xdg.el --- XDG specification and standard support -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2017 Free Software Foundation, Inc.
  3. ;; Author: Mark Oteiza <mvoteiza@udel.edu>
  4. ;; Created: 27 January 2017
  5. ;; Keywords: files, data
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published
  9. ;; by the Free Software Foundation; either version 3 of the License,
  10. ;; or (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful, but
  12. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  14. ;; General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; Library providing some convenience functions for the following XDG
  19. ;; standards and specifications
  20. ;;
  21. ;; - XDG Base Directory Specification
  22. ;; - Thumbnail Managing Standard
  23. ;; - xdg-user-dirs configuration
  24. ;;; Code:
  25. ;; XDG Base Directory Specification
  26. ;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
  27. (defmacro xdg--dir-home (environ default-path)
  28. (declare (debug (stringp stringp)))
  29. (let ((env (make-symbol "env")))
  30. `(let ((,env (getenv ,environ)))
  31. (if (or (null ,env) (not (file-name-absolute-p ,env)))
  32. (expand-file-name ,default-path)
  33. ,env))))
  34. (defun xdg-config-home ()
  35. "Return the base directory for user specific configuration files."
  36. (xdg--dir-home "XDG_CONFIG_HOME" "~/.config"))
  37. (defun xdg-cache-home ()
  38. "Return the base directory for user specific cache files."
  39. (xdg--dir-home "XDG_CACHE_HOME" "~/.cache"))
  40. (defun xdg-data-home ()
  41. "Return the base directory for user specific data files."
  42. (xdg--dir-home "XDG_DATA_HOME" "~/.local/share"))
  43. (defun xdg-runtime-dir ()
  44. "Return the value of $XDG_RUNTIME_DIR."
  45. (getenv "XDG_RUNTIME_DIR"))
  46. (defun xdg-config-dirs ()
  47. "Return the config directory search path as a list."
  48. (let ((env (getenv "XDG_CONFIG_DIRS")))
  49. (if (or (null env) (string= env ""))
  50. '("/etc/xdg")
  51. (parse-colon-path env))))
  52. (defun xdg-data-dirs ()
  53. "Return the data directory search path as a list."
  54. (let ((env (getenv "XDG_DATA_DIRS")))
  55. (if (or (null env) (string= env ""))
  56. '("/usr/local/share/" "/usr/share/")
  57. (parse-colon-path env))))
  58. ;; Thumbnail Managing Standard
  59. ;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html
  60. (defun xdg-thumb-uri (filename)
  61. "Return the canonical URI for FILENAME.
  62. If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
  63. file:///foo/bar.jpg"
  64. (concat "file://" (expand-file-name filename)))
  65. (defun xdg-thumb-name (filename)
  66. "Return the appropriate thumbnail filename for FILENAME."
  67. (concat (md5 (xdg-thumb-uri filename)) ".png"))
  68. (defun xdg-thumb-mtime (filename)
  69. "Return modification time of FILENAME as integral seconds from the epoch."
  70. (floor (float-time (nth 5 (file-attributes filename)))))
  71. ;; XDG User Directories
  72. ;; https://www.freedesktop.org/wiki/Software/xdg-user-dirs/
  73. (defconst xdg-line-regexp
  74. (eval-when-compile
  75. (rx "XDG_"
  76. (group-n 1 (or "DESKTOP" "DOWNLOAD" "TEMPLATES" "PUBLICSHARE"
  77. "DOCUMENTS" "MUSIC" "PICTURES" "VIDEOS"))
  78. "_DIR=\""
  79. (group-n 2 (or "/" "$HOME/") (*? (or (not (any "\"")) "\\\"")))
  80. "\""))
  81. "Regexp matching non-comment lines in xdg-user-dirs config files.")
  82. (defvar xdg-user-dirs nil
  83. "Alist of directory keys and values.")
  84. (defun xdg--substitute-home-env (str)
  85. (if (file-name-absolute-p str) str
  86. (save-match-data
  87. (and (string-match "^$HOME/" str)
  88. (replace-match "~/" t nil str 0)))))
  89. (defun xdg--user-dirs-parse-line ()
  90. "Return pair of user-dirs key to directory value in LINE, otherwise nil.
  91. This should be called at the beginning of a line."
  92. (skip-chars-forward "[:blank:]")
  93. (when (and (/= (following-char) ?#)
  94. (looking-at xdg-line-regexp))
  95. (let ((k (match-string 1))
  96. (v (match-string 2)))
  97. (when (and k v) (cons k (xdg--substitute-home-env v))))))
  98. (defun xdg--user-dirs-parse-file (filename)
  99. "Return alist of xdg-user-dirs from FILENAME."
  100. (let (elt res)
  101. (with-temp-buffer
  102. (insert-file-contents filename)
  103. (goto-char (point-min))
  104. (while (not (eobp))
  105. (setq elt (xdg--user-dirs-parse-line))
  106. (when (consp elt) (push elt res))
  107. (forward-line)))
  108. res))
  109. (defun xdg-user-dir (name)
  110. "Return the path of user directory referred to by NAME."
  111. (when (null xdg-user-dirs)
  112. (setq xdg-user-dirs
  113. (xdg--user-dirs-parse-file
  114. (expand-file-name "user-dirs.dirs" (xdg-config-home)))))
  115. (let ((dir (cdr (assoc name xdg-user-dirs))))
  116. (when dir (expand-file-name dir))))
  117. (provide 'xdg)
  118. ;;; xdg.el ends here