From ba7a0af917da82580a1dccc7c024375c7405ce30 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Tue, 28 Apr 2015 08:47:50 -0700 Subject: [PATCH] configuration: Adopt XDG wholesale, even on Windows. Rename functions accordingly. --- output-translations.lisp | 12 ++-- source-registry.lisp | 18 +++--- uiop/backward-driver.lisp | 10 ++-- uiop/configuration.lisp | 117 ++++++++++++++++++-------------------- 4 files changed, 76 insertions(+), 81 deletions(-) diff --git a/output-translations.lisp b/output-translations.lisp index aeb6773e..9ba06ca7 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -151,18 +151,18 @@ and the order is by decreasing length of namestring of the source pathname.") ;; We enable the user cache by default, and here is the place we do: :enable-user-cache)) - (defparameter *output-translations-file* (parse-unix-namestring "asdf-output-translations.conf")) - (defparameter *output-translations-directory* (parse-unix-namestring "asdf-output-translations.conf.d/")) + (defparameter *output-translations-file* (parse-unix-namestring "common-lisp/asdf-output-translations.conf")) + (defparameter *output-translations-directory* (parse-unix-namestring "common-lisp/asdf-output-translations.conf.d/")) (defun user-output-translations-pathname (&key (direction :input)) - (find-config-pathname "common-lisp" *output-translations-file* direction)) + (xdg-config-pathname *output-translations-file* direction)) (defun system-output-translations-pathname (&key (direction :input)) - (find-preferred-file (config-system-pathnames "common-lisp" *output-translations-file*) + (find-preferred-file (system-config-pathnames *output-translations-file*) :direction direction)) (defun user-output-translations-directory-pathname (&key (direction :input)) - (find-config-pathname "common-lisp" *output-translations-directory* direction)) + (xdg-config-pathname *output-translations-directory* direction)) (defun system-output-translations-directory-pathname (&key (direction :input)) - (find-preferred-file (config-system-pathnames "common-lisp" *output-translations-directory*) + (find-preferred-file (system-config-pathnames *output-translations-directory*) :direction direction)) (defun environment-output-translations () (getenv "ASDF_OUTPUT_TRANSLATIONS")) diff --git a/source-registry.lisp b/source-registry.lisp index a8c49db2..91bf043f 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -170,8 +170,8 @@ after having found a .asd file? True by default.") default-system-source-registry) "List of default source registries" "3.1.0.102") - (defparameter *source-registry-file* (parse-unix-namestring "source-registry.conf")) - (defparameter *source-registry-directory* (parse-unix-namestring "source-registry.conf.d/")) + (defparameter *source-registry-file* (parse-unix-namestring "common-lisp/source-registry.conf")) + (defparameter *source-registry-directory* (parse-unix-namestring "common-lisp/source-registry.conf.d/")) (defun wrapping-source-registry () `(:source-registry @@ -184,24 +184,24 @@ after having found a .asd file? True by default.") `(:source-registry (:tree (:home "common-lisp/")) #+sbcl (:directory (:home ".sbcl/systems/")) - (:directory ,(data-home-pathname "common-lisp" "systems/")) - (:tree ,(data-home-pathname "common-lisp" "source/")) + (:directory ,(xdg-data-home "common-lisp/systems/")) + (:tree ,(xdg-data-home "common-lisp/source/")) :inherit-configuration)) (defun default-system-source-registry () `(:source-registry - ,@(loop :for dir :in (data-search-pathnames "common-lisp") + ,@(loop :for dir :in (xdg-data-dirs "common-lisp/") :collect `(:directory (,dir "systems/")) :collect `(:tree (,dir "source/"))) :inherit-configuration)) (defun user-source-registry (&key (direction :input)) - (find-config-pathname "common-lisp" *source-registry-file* direction)) + (xdg-config-pathname *source-registry-file* direction)) (defun system-source-registry (&key (direction :input)) - (find-preferred-file (config-system-pathnames "common-lisp" *source-registry-file*) + (find-preferred-file (system-config-pathnames *source-registry-file*) :direction direction)) (defun user-source-registry-directory (&key (direction :input)) - (find-config-pathname "common-lisp" *source-registry-directory* direction)) + (xdg-config-pathname *source-registry-directory* direction)) (defun system-source-registry-directory (&key (direction :input)) - (find-preferred-file (config-system-pathnames "common-lisp" *source-registry-directory*) + (find-preferred-file (system-config-pathnames *source-registry-directory*) :direction direction)) (defun environment-source-registry () (getenv "CL_SOURCE_REGISTRY")) diff --git a/uiop/backward-driver.lisp b/uiop/backward-driver.lisp index 1f67d91c..b2bc3019 100644 --- a/uiop/backward-driver.lisp +++ b/uiop/backward-driver.lisp @@ -45,12 +45,12 @@ (defun user-configuration-directories () "Return the current user's list of user configuration directories for configuring common-lisp. - DEPRECATED. Use uiop:config-pathnames instead." - (config-pathnames "common-lisp")) + DEPRECATED. Use uiop:xdg-config-pathnames instead." + (xdg-config-pathnames "common-lisp")) (defun system-configuration-directories () "Return the list of system configuration directories for common-lisp. DEPRECATED. Use uiop:config-system-pathnames instead." - (config-system-pathnames "common-lisp")) + (system-config-pathnames "common-lisp")) (defun in-first-directory (dirs x &key (direction :input)) "Finds the first appropriate file named X in the list of DIRS for I/O in DIRECTION \(which may be :INPUT, :OUTPUT, :IO, or :PROBE). @@ -64,8 +64,8 @@ first element of DIRS that exists. DEPRECATED." (defun in-user-configuration-directory (x &key (direction :input)) "Return the file named X in the user configuration directory for common-lisp. DEPRECATED." - (find-config-pathname "common-lisp" x direction)) + (xdg-config-pathname "common-lisp" x direction)) (defun in-system-configuration-directory (x &key (direction :input)) "Return the pathname for the file named X under the system configuration directory for common-lisp. DEPRECATED." - (find-preferred-file (config-system-pathnames "common-lisp" x) :direction direction))) + (find-preferred-file (system-config-pathnames "common-lisp" x) :direction direction))) diff --git a/uiop/configuration.lisp b/uiop/configuration.lisp index 776475aa..ce7c32a9 100644 --- a/uiop/configuration.lisp +++ b/uiop/configuration.lisp @@ -10,10 +10,10 @@ #:user-configuration-directories #:system-configuration-directories ;; implemented in backward-driver #:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory ;; idem #:get-folder-path - #:data-home-pathname #:config-home-pathname #:data-search-pathnames #:config-search-pathnames - #:cache-home-pathname #:runtime-dir-pathname #:config-system-pathnames - #:clean-search-pathnames #:data-pathnames #:config-pathnames - #:find-preferred-file #:find-data-pathname #:find-config-pathname + #:xdg-data-home #:xdg-config-home #:xdg-data-dirs #:xdg-config-dirs + #:xdg-cache-home #:xdg-runtime-dir #:system-config-pathnames + #:clean-search-pathnames #:xdg-data-pathnames #:xdg-config-pathnames + #:find-preferred-file #:xdg-data-pathname #:xdg-config-pathname #:validate-configuration-form #:validate-configuration-file #:validate-configuration-directory #:configuration-inheritance-directive-p #:report-invalid-form #:invalid-configuration #:*ignored-configuration-form* #:*user-cache* @@ -269,89 +269,84 @@ this function tries to locate the Windows FOLDER for one of ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData (ecase folder (:local-appdata (or (getenv-absolute-directory "LOCALAPPDATA") - (subpathname* (getenv-absolute-directory "APPDATA") "Local"))) + (subpathname* (get-folder-path :appdata) "Local"))) (:appdata (getenv-absolute-directory "APPDATA")) (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA") (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))) ;; Support for the XDG Base Directory Specification - (defun data-home-pathname (&optional app &rest more) + (defun xdg-data-home (&rest more) "path for user specific data files" - (resolve-location - `(,(os-cond - ((os-windows-p) (or (get-folder-path :local-appdata) - (subpathname* (get-folder-path :appdata) "Local/"))) - (t (or (getenv-absolute-directory "XDG_DATA_HOME") - (subpathname (user-homedir-pathname) ".local/share/")))) - ,app ,more))) - - (defun config-home-pathname (&optional app &rest more) + (resolve-absolute-location + `(,(or (getenv-absolute-directory "XDG_DATA_HOME") + (os-cond + ((os-windows-p) (get-folder-path :local-appdata)) + (t (subpathname (user-homedir-pathname) ".local/share/")))) + ,more))) + + (defun xdg-config-home (&rest more) "path for user specific configuration files" - (os-cond - ((os-windows-p) (apply 'data-home-path app "config/" more)) - (t (resolve-absolute-location - `(,(or (getenv-absolute-directory "XDG_CONFIG_HOME") - (subpathname (user-homedir-pathname) ".config/")) - ,app ,more))))) + (resolve-absolute-location + `(,(or (getenv-absolute-directory "XDG_CONFIG_HOME") + (os-cond + ((os-windows-p) (xdg-data-home "config/")) + (t (subpathname (user-homedir-pathname) ".config/")))) + ,more))) - (defun data-search-pathnames (&optional app &rest more) + (defun xdg-data-dirs (&rest more) "the preference-ordered set of additional paths to search for data files" - (mapcar #'(lambda (d) (resolve-location `(,d ,app ,more))) - (os-cond - ((os-windows-p) (mapcar 'get-folder-path '(:appdata :common-appdata))) - (t (or (getenv-absolute-directories "XDG_DATA_DIRS") - (mapcar 'parse-unix-namestring '("/usr/local/share/" "/opt/local/share/" "/usr/share/"))))))) + (mapcar #'(lambda (d) (resolve-location `(,d ,more))) + (or (getenv-absolute-directories "XDG_DATA_DIRS") + (os-cond + ((os-windows-p) (mapcar 'get-folder-path '(:appdata :common-appdata))) + (t (mapcar 'parse-unix-namestring '("/usr/local/share/" "/usr/share/"))))))) - (defun config-search-pathnames (&optional app &rest more) + (defun xdg-config-dirs (&rest more) "the preference-ordered set of additional base paths to search for configuration files" - (os-cond - ((os-windows-p) (apply 'data-search-pathnames app "config/" more)) - (t (mapcar #'(lambda (d) (resolve-location `(,d ,app ,more))) - (or (getenv-absolute-directories "XDG_CONFIG_DIRS") - (mapcar 'parse-unix-namestring - (list "/etc/xdg/" - "/usr/local/etc/" - "/opt/local/etc/"))))))) - - (defun cache-home-pathname (&optional app &rest more) + (mapcar #'(lambda (d) (resolve-location `(,d ,more))) + (or (getenv-absolute-directories "XDG_CONFIG_DIRS") + (os-cond + ((os-windows-p) (xdg-data-dirs "config/" more)) + (t (mapcar 'parse-unix-namestring '("/etc/xdg/"))))))) + + (defun xdg-cache-home (&rest more) "the base directory relative to which user specific non-essential data files should be stored" - (os-cond - ((os-windows-p) (data-home-pathname app "cache" more)) - (t (resolve-location `(,(or (getenv-absolute-directory "XDG_CACHE_HOME") - (subpathname* (user-homedir-pathname) ".cache/")) ,app ,more))))) + (resolve-absolute-location + `(,(or (getenv-absolute-directory "XDG_CACHE_HOME") + (os-cond + ((os-windows-p) (xdg-data-home "cache")) + (t (subpathname* (user-homedir-pathname) ".cache/")))) + ,more))) - (defun runtime-dir-pathname (&optional app &rest more) + (defun xdg-runtime-dir (&rest more) "pathname for user-specific non-essential runtime files and other file objects" ;; (such as sockets, named pipes, ...) ;; The XDG spec says that if not provided by the login system, the application should ;; issue a warning and provide a replacement. UIOP is not equipped to do that and returns NIL. - (os-cond - ((not (os-windows-p)) - (resolve-location `(,(getenv-absolute-directory "XDG_RUNTIME_DIR") ,app ,more))))) + (resolve-absolute-location `(,(getenv-absolute-directory "XDG_RUNTIME_DIR") ,more))) - (defun config-system-pathnames (&optional app &rest more) + (defun system-config-pathnames (&rest more) "Determine system user configuration directories" (os-cond - ((os-unix-p) (list (resolve-location `(,(parse-unix-namestring "/etc/") ,app ,more)))))) + ((os-unix-p) (list (resolve-absolute-location `(,(parse-unix-namestring "/etc/") ,more)))))) (defun clean-search-pathnames (dirs) "Parse strings as unix namestrings and remove duplicates and non absolute-pathnames in a list" (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) :from-end t :test 'equal)) - (defun data-pathnames (&optional app &rest more) + (defun xdg-data-pathnames (&rest more) "Return a list of absolute pathnames for application data directories. With APP, returns directory for data for that application, without APP, returns the set of directories for storing all application configurations." (clean-search-pathnames - `(,(data-home-pathname app more) - ,@(data-search-pathnames app more)))) + `(,(xdg-data-home more) + ,@(xdg-data-dirs more)))) - (defun config-pathnames (&optional app &rest more) - "Return a list of pathnames for application configuration. Without the APP argument, -returns pathnames for directories that contain all of the configuration information." + (defun xdg-config-pathnames (&rest more) + "Return a list of pathnames for application configuration." (clean-search-pathnames - `(,(config-home-pathname app more) - ,@(config-search-pathnames app more)))) + `(,(xdg-config-home more) + ,@(xdg-config-dirs more)))) ;; FIXME: AFAICT although this says "find FILE," it is often used to find a DIRECTORY. (defun find-preferred-file (files &key (direction :input)) @@ -359,14 +354,14 @@ returns pathnames for directories that contain all of the configuration informat or just the first one (for direction :output or :io)." (find-if (ecase direction ((:probe :input) 'probe-file*) ((:output :io) 'identity)) files)) - (defun find-data-pathname (&optional app more (direction :input)) - (find-preferred-file (data-pathnames app more) :direction direction)) + (defun xdg-data-pathname (&optional more (direction :input)) + (find-preferred-file (xdg-data-pathnames more) :direction direction)) - (defun find-config-pathname (&optional app more (direction :input)) - (find-preferred-file (config-pathnames app more) :direction direction)) + (defun xdg-config-pathname (&optional more (direction :input)) + (find-preferred-file (xdg-config-pathnames more) :direction direction)) (defun compute-user-cache () "Compute (and return) the location of the default user-cache for translate-output objects. Side-effects for cached file location computation." - (setf *user-cache* (cache-home-pathname "common-lisp" :implementation))) + (setf *user-cache* (xdg-cache-home "common-lisp" :implementation))) (register-image-restore-hook 'compute-user-cache)) -- GitLab