Hi Faré, The only windows machine I have is running XP, will that be sufficient? -Jason On 03:34 Sat 28 Mar , Faré wrote:
Dear Jason,
I've re-read http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html And indeed you're right that I failed to follow it properly.
Please try this patch and tell me if it works for you on Windows (NB: I don't have Windows).
—♯ƒ • François-René ÐVB Rideau •Reflection&Cybernethics• http://fare.tunes.org The last ten percent of any reform is the most difficult to achieve. Moreover, it is often harmful. — John McCarthy
On Fri, Mar 27, 2015 at 1:42 PM, Jason Miller <jason@milr.com> wrote:
Hi,
With $XDG_CONFIG_DIRS unset, (uiop:user-configuration-directories) returns only $XDG_CONFIG_HOME/common-lisp/
However, with it set to "/etc/xdg" it returns a list that starts with "/etc/xdg/common-lisp"
There are two problems with this:
1) The XDG Base Directory Specification says that "If $XDG_CONFIG_DIRS is either not set or empty, a value equal to /etc/xdg should be used."
2) My understanding of uiop:user-configuration-directories is that it's listed in order of importance, but, from the XDG spec:
"The base directory defined by $XDG_CONFIG_HOME is considered more important than any of the base directories defined by $XDG_CONFIG_DIRS"
So, what I think is correct is that with $XDG_CONFIG_DIRS set it should return a list starting with $XDG_CONFIG_HOME, followed by the lists in $XDG_CONFIG_DIRS, and with it not set, should return a list of $XDG_CONFIG_HOME followed by /etc/xdg/common-lisp/
Even if that's not correct, due to #1 the current implementation is definitely wrong.
Regards, Jason
From 4c5cc83a3833d2c977bd69a80b65b5ddd1b4968b Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sat, 28 Mar 2015 03:31:21 -0400 Subject: [PATCH] Fix configuration search paths
Make it more XDG compliant on Unix, and play nicer with Windows. --- bundle.lisp | 8 +-- output-translations.lisp | 18 ++++-- source-registry.lisp | 39 +++++++------ uiop/configuration.lisp | 142 ++++++++++++++++++++++++++++++----------------- uiop/os.lisp | 5 ++ uiop/pathname.lisp | 15 +++-- uiop/run-program.lisp | 2 +- uiop/stream.lisp | 10 ++-- 8 files changed, 149 insertions(+), 90 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp index 72f4a6e..b6d40ed 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -160,10 +160,10 @@ itself.")) ;; operation on a system and its dependencies ((member :dll :lib :shared-library :static-library :program :object :program) (compile-file-type :type bundle-type)) ((member :image) #-allegro "image" #+allegro "dxl") - ((member :dll :shared-library) (cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) - ((member :lib :static-library) (cond ((os-unix-p) "a") - ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) - ((eql :program) (cond ((os-unix-p) nil) ((os-windows-p) "exe"))))) + ((member :dll :shared-library) (os-cond ((os-macosx-p) "dylib") ((os-unix-p) "so") ((os-windows-p) "dll"))) + ((member :lib :static-library) (os-cond ((os-unix-p) "a") + ((os-windows-p) (if (featurep '(:or :mingw32 :mingw64)) "a" "lib")))) + ((eql :program) (os-cond ((os-unix-p) nil) ((os-windows-p) "exe")))))
(defun bundle-output-files (o c) (let ((bundle-type (bundle-type o))) diff --git a/output-translations.lisp b/output-translations.lisp index c5d8721..e3cabca 100644 --- a/output-translations.lisp +++ b/output-translations.lisp @@ -155,13 +155,23 @@ and the order is by decreasing length of namestring of the source pathname.") (defparameter *output-translations-directory* (parse-unix-namestring "asdf-output-translations.conf.d/"))
(defun user-output-translations-pathname (&key (direction :input)) - (in-user-configuration-directory *output-translations-file* :direction direction)) + (if (eq direction :output) + (config-home-pathname "common-lisp" *output-translations-file*) + (find-config-pathname "common-lisp" *output-translations-file*))) (defun system-output-translations-pathname (&key (direction :input)) - (in-system-configuration-directory *output-translations-file* :direction direction)) + (let ((files (config-system-pathnames "common-lisp" *output-translations-file*))) + (if (eq direction :output) + (first files) + (find-if 'probe-file* files)))) (defun user-output-translations-directory-pathname (&key (direction :input)) - (in-user-configuration-directory *output-translations-directory* :direction direction)) + (if (eq direction :output) + (config-home-pathname "common-lisp" *output-translations-directory*)) + (find-config-pathname "common-lisp" *output-translations-directory*)) (defun system-output-translations-directory-pathname (&key (direction :input)) - (in-system-configuration-directory *output-translations-directory* :direction direction)) + (let ((files (config-system-pathnames "common-lisp" *output-translations-directory*))) + (if (eq direction :output) + (first files) + (find-if 'probe-file* files)))) (defun environment-output-translations () (getenv "ASDF_OUTPUT_TRANSLATIONS"))
diff --git a/source-registry.lisp b/source-registry.lisp index 3e6a162..3c56637 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -184,34 +184,33 @@ after having found a .asd file? True by default.") `(:source-registry (:tree (:home "common-lisp/")) #+sbcl (:directory (:home ".sbcl/systems/")) - ,@(loop :for dir :in - `(,@(when (os-unix-p) - `(,(or (getenv-absolute-directory "XDG_DATA_HOME") - (subpathname (user-homedir-pathname) ".local/share/")))) - ,@(when (os-windows-p) - (mapcar 'get-folder-path '(:local-appdata :appdata)))) - :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) - :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) + (:directory ,(data-home-pathname "common-lisp" "systems/")) + (:tree ,(data-home-pathname "common-lisp" "source/")) :inherit-configuration)) (defun default-system-source-registry () `(:source-registry - ,@(loop :for dir :in - `(,@(when (os-unix-p) - (or (getenv-absolute-directories "XDG_DATA_DIRS") - '("/usr/local/share" "/usr/share"))) - ,@(when (os-windows-p) - (list (get-folder-path :common-appdata)))) - :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) - :collect `(:tree ,(subpathname* dir "common-lisp/source/"))) + ,@(loop :for dir :in (data-search-pathnames "common-lisp") + :collect `(:directory (,dir "systems/")) + :collect `(:tree (,dir "source/"))) :inherit-configuration)) (defun user-source-registry (&key (direction :input)) - (in-user-configuration-directory *source-registry-file* :direction direction)) + (if (eq direction :output) + (config-home-pathname "common-lisp" *source-registry-file*) + (find-config-pathname "common-lisp" *source-registry-file*))) (defun system-source-registry (&key (direction :input)) - (in-system-configuration-directory *source-registry-file* :direction direction)) + (let ((files (config-system-pathnames "common-lisp" *source-registry-file*))) + (if (eq direction :output) + (first files) + (find-if 'probe-file* files)))) (defun user-source-registry-directory (&key (direction :input)) - (in-user-configuration-directory *source-registry-directory* :direction direction)) + (if (eq direction :output) + (config-home-pathname "common-lisp" *source-registry-directory*)) + (find-config-pathname "common-lisp" *source-registry-directory*)) (defun system-source-registry-directory (&key (direction :input)) - (in-system-configuration-directory *source-registry-directory* :direction direction)) + (let ((files (config-system-pathnames "common-lisp" *source-registry-directory*))) + (if (eq direction :output) + (first files) + (find-if 'probe-file* files)))) (defun environment-source-registry () (getenv "CL_SOURCE_REGISTRY"))
diff --git a/uiop/configuration.lisp b/uiop/configuration.lisp index 07e90e6..039438c 100644 --- a/uiop/configuration.lisp +++ b/uiop/configuration.lisp @@ -8,12 +8,14 @@ :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build) (:export #:get-folder-path - #:user-configuration-directories #:system-configuration-directories - #:in-first-directory - #:in-user-configuration-directory #:in-system-configuration-directory + #: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-data-pathname #:find-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* + #:report-invalid-form #:invalid-configuration + #:*ignored-configuration-form* #:*user-cache* #:*clear-configuration-hook* #:clear-configuration #:register-clear-configuration-hook #:resolve-location #:location-designator-p #:location-function-p #:*here-directory* #:resolve-relative-location #:resolve-absolute-location #:upgrade-configuration)) @@ -38,48 +40,89 @@ this function tries to locate the Windows FOLDER for one of (or #+(and lispworks mswindows) (sys:get-folder-path folder) ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData (ecase folder - (:local-appdata (getenv-absolute-directory "LOCALAPPDATA")) + (:local-appdata (or (getenv-absolute-directory "LOCALAPPDATA") + (subpathname* (getenv-absolute-directory "APPDATA") "Local"))) (:appdata (getenv-absolute-directory "APPDATA")) (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA") (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
- (defun user-configuration-directories () - "Determine user configuration directories" - (let ((dirs - `(,@(when (os-unix-p) - (cons - (subpathname* (getenv-absolute-directory "XDG_CONFIG_HOME") "common-lisp/") - (loop :for dir :in (getenv-absolute-directories "XDG_CONFIG_DIRS") - :collect (subpathname* dir "common-lisp/")))) - ,@(when (os-windows-p) - `(,(subpathname* (get-folder-path :local-appdata) "common-lisp/config/") - ,(subpathname* (get-folder-path :appdata) "common-lisp/config/"))) - ,(subpathname (user-homedir-pathname) ".config/common-lisp/")))) - (remove-duplicates (remove-if-not #'absolute-pathname-p dirs) - :from-end t :test 'equal))) - - (defun system-configuration-directories () - "Determine system user configuration directories" - (cond - ((os-unix-p) '(#p"/etc/common-lisp/")) - ((os-windows-p) - (if-let (it (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")) - (list it))))) + ;; Support for the XDG Base Directory Specification + (defun data-home-pathname (&optional app &rest more) + "path for user specific data files" + (resolve-location + `(,(os-cond + ((os-windows-p) (or (get-folder-path :local-appdata) + (subpath (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) + "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") + (subpath (user-homedir-pathname) ".config/")) + ,app ,more))))) + + (defun data-search-pathnames (&optional app &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/" "/usr/share/"))))))) + + (defun config-search-pathnames (&optional app &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") + (list (parse-unix-namestring '("/etc/xdg/")))))))) + + (defun cache-home-pathname (&optional app &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") + (subpath (user-homedir-pathname) ".cache/")) ,app ,more))))) + + (defun runtime-dir-pathname (&optional app &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)))))
- (defun in-first-directory (dirs x &key (direction :input)) + (defun config-system-pathnames (&optional app &rest more) "Determine system user configuration directories" - (loop :with fun = (ecase direction - ((nil :input :probe) 'probe-file*) - ((:output :io) 'identity)) - :for dir :in dirs - :thereis (and dir (funcall fun (subpathname (ensure-directory-pathname dir) x))))) - - (defun in-user-configuration-directory (x &key (direction :input)) - "return pathname under user configuration directory, subpathname X" - (in-first-directory (user-configuration-directories) x :direction direction)) - (defun in-system-configuration-directory (x &key (direction :input)) - "return pathname under system configuration directory, subpathname X" - (in-first-directory (system-configuration-directories) x :direction direction)) + (when (os-unix-p) (list (resolve-location `(,(parse-unix-namestring "/etc/") ,app ,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) + "Determine pathnames for user configuration" + (clean-search-pathnames + (cons (apply 'data-home-pathname app more) + (apply 'data-search-pathnames app more)))) + + (defun config-pathnames (&optional app &rest more) + "Determine pathnames for user configuration" + (clean-search-pathnames + `(,(apply 'config-home-pathname app more) + ,@(apply 'config-search-pathnames app more)))) + + (defun find-data-pathname (&optional app &rest more) + (find-if 'probe-file* (apply 'data-pathnames app more))) + + (defun find-config-pathname (&optional app &rest more) + (find-if 'probe-file* (apply 'config-pathnames app more)))
(defun configuration-inheritance-directive-p (x) "Is X a configuration inheritance directive?" @@ -173,6 +216,7 @@ values of TAG include :source-registry and :output-translations." "Given a designator X for an relative location, resolve it to a pathname" (ensure-pathname (etypecase x + (null nil) (pathname x) (string (parse-unix-namestring x :ensure-directory ensure-directory)) @@ -210,21 +254,14 @@ directive.")
(defun compute-user-cache () "Compute the location of the default user-cache for translate-output objects" - (setf *user-cache* - (flet ((try (x &rest sub) (and x `(,x ,@sub)))) - (or - (try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation) - (when (os-windows-p) - (try (or (get-folder-path :local-appdata) - (get-folder-path :appdata)) - "common-lisp" "cache" :implementation)) - '(:home ".cache" "common-lisp" :implementation))))) + (setf *user-cache* (cache-home-pathname "common-lisp" :implementation))) (register-image-restore-hook 'compute-user-cache)
(defun resolve-absolute-location (x &key ensure-directory wilden) "Given a designator X for an absolute location, resolve it to a pathname" (ensure-pathname (etypecase x + (null nil) (pathname x) (string (let ((p #-mcl (parse-namestring x) @@ -267,9 +304,10 @@ directive.") ;; :directory backward compatibility, until 2014-01-16: accept directory as well as ensure-directory (loop* :with dirp = (or directory ensure-directory) :with (first . rest) = (if (atom x) (list x) x) - :with path = (resolve-absolute-location - first :ensure-directory (and (or dirp rest) t) - :wilden (and wilden (null rest))) + :with path = (or (resolve-absolute-location + first :ensure-directory (and (or dirp rest) t) + :wilden (and wilden (null rest))) + (return nil)) :for (element . morep) :on rest :for dir = (and (or morep dirp) t) :for wild = (and wilden (not morep)) diff --git a/uiop/os.lisp b/uiop/os.lisp index 1c5a9d9..052b1a5 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -7,6 +7,7 @@ (:use :uiop/common-lisp :uiop/package :uiop/utility) (:export #:featurep #:os-unix-p #:os-macosx-p #:os-windows-p #:os-genera-p #:detect-os ;; features + #:os-cond #:getenv #:getenvp ;; environment variables #:implementation-identifier ;; implementation identifier #:implementation-type #:*implementation-type* @@ -73,6 +74,10 @@ except on ABCL where it might change between FASL compilation and runtime." (return (or o (error "Congratulations for trying ASDF on an operating system~%~ that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port it.")))))
+ (defmacro os-cond (&rest clauses) + #+abcl `(cond ,@clauses) + #-abcl (loop* :for (test . body) :in clauses :when (eval test) :return `(progn ,@body))) + (detect-os))
;;;; Environment variables: getting them, and parsing them. diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 19cbf13..5e3fabb 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -25,7 +25,7 @@ #:split-name-type #:parse-unix-namestring #:unix-namestring #:split-unix-namestring-directory-components ;; Absolute and relative pathnames - #:subpathname #:subpathname* + #:subpathname #:subpathname* #:subpath #:subpath* #:ensure-absolute-pathname #:pathname-root #:pathname-host-pathname #:subpathp #:enough-pathname #:with-enough-pathname #:call-with-enough-pathname @@ -404,9 +404,9 @@ For an empty type, *UNSPECIFIC-PATHNAME-TYPE* is returned." "Coerce NAME into a PATHNAME using standard Unix syntax.
Unix syntax is used whether or not the underlying system is Unix; -on such non-Unix systems it is only usable but for relative pathnames; -but especially to manipulate relative pathnames portably, it is of crucial -to possess a portable pathname syntax independent of the underlying OS. +on such non-Unix systems it is reliably usable only for relative pathnames. +This function is especially useful to manipulate relative pathnames portably, +where it is of crucial to possess a portable pathname syntax independent of the underlying OS. This is what PARSE-UNIX-NAMESTRING provides, and why we use it in ASDF.
When given a PATHNAME object, just return it untouched. @@ -530,6 +530,13 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME." (and pathname (subpathname (ensure-directory-pathname pathname) subpath :type type)))
+ (defun subpath (pathname &rest components) + (if (null components) pathname + (apply 'subpath (subpathname pathname (first components)) (rest components)))) + + (defun subpath* (pathname &rest components) + (and pathname (apply 'subpath pathname components))) + (defun pathname-root (pathname) "return the root directory for the host and device of given PATHNAME" (make-pathname* :directory '(:absolute) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 1e43cd0..7fdaf81 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -104,7 +104,7 @@ for use within a POSIX Bourne shell, outputing to S."
(defun escape-shell-token (token &optional s) "Escape a token for the current operating system shell" - (cond + (os-cond ((os-unix-p) (escape-sh-token token s)) ((os-windows-p) (escape-windows-token token s))))
diff --git a/uiop/stream.lisp b/uiop/stream.lisp index 9a6ceef..6c18401 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -277,7 +277,7 @@ and return that" (defun null-device-pathname () "Pathname to a bit bucket device that discards any information written to it and always returns EOF when read from" - (cond + (os-cond ((os-unix-p) #p"/dev/null") ((os-windows-p) #p"NUL") ;; Q: how many Lisps accept the #p"NUL:" syntax? (t (error "No /dev/null on your OS")))) @@ -528,13 +528,13 @@ If a string, repeatedly read and evaluate from it, returning the last values." (with-upgradability () (defun default-temporary-directory () "Return a default directory to use for temporary files" - (or - (when (os-unix-p) + (os-cond + ((os-unix-p) (or (getenv-pathname "TMPDIR" :ensure-directory t) (parse-native-namestring "/tmp/"))) - (when (os-windows-p) + ((os-windows-p) (getenv-pathname "TEMP" :ensure-directory t)) - (subpathname (user-homedir-pathname) "tmp/"))) + (t (subpathname (user-homedir-pathname) "tmp/"))))
(defvar *temporary-directory* nil "User-configurable location for temporary files")
-- 2.2.0.rc0.207.ga3a616c