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 <ja...@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 <tu...@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 >
