From 0ba00ac9b41860908505a40130432980b6b0df34 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 21 Mar 2014 16:20:44 -0400 Subject: [PATCH] Add ~/common-lisp/ as a default tree in the registry. --- source-registry.lisp | 29 +++++++++++++++++++++-------- upgrade.lisp | 17 ++++++++--------- 2 files changed, 29 insertions(+), 17 deletions(-) diff --git a/source-registry.lisp b/source-registry.lisp index ee83e48d..d85285fd 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -16,7 +16,8 @@ #:collect-asds-in-directory #:collect-sub*directories-asd-files #:validate-source-registry-directive #:validate-source-registry-form #:validate-source-registry-file #:validate-source-registry-directory - #:parse-source-registry-string #:wrapping-source-registry #:default-source-registry + #:parse-source-registry-string #:wrapping-source-registry + #:default-user-source-registry #:default-system-source-registry #:user-source-registry #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory #:environment-source-registry #:process-source-registry @@ -145,9 +146,11 @@ system names to pathnames of .asd files") '(environment-source-registry user-source-registry user-source-registry-directory + default-user-source-registry system-source-registry system-source-registry-directory - default-source-registry)) + 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/")) @@ -159,17 +162,27 @@ system names to pathnames of .asd files") #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) #+cmu (:tree #p"modules:") #+scl (:tree #p"file://modules/"))) - (defun default-source-registry () + (defun default-user-source-registry () `(:source-registry - #+sbcl (:directory ,(subpathname (user-homedir-pathname) ".sbcl/systems/")) + (: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/")) - ,@(or (getenv-absolute-directories "XDG_DATA_DIRS") - '("/usr/local/share" "/usr/share")))) + (subpathname (user-homedir-pathname) ".local/share/")))) ,@(when (os-windows-p) - (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata)))) + (mapcar 'get-folder-path '(:local-appdata :appdata)))) + :collect `(:directory ,(subpathname* dir "common-lisp/systems/")) + :collect `(:tree ,(subpathname* dir "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/"))) :inherit-configuration)) diff --git a/upgrade.lisp b/upgrade.lisp index 23212d21..c08d1fc1 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -34,15 +34,6 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (defvar *asdf-version* nil) ;; We need to clear systems from versions yet older than the below: (defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component. - (defmacro defparameter* (var value &optional docstring) - (let* ((name (string-trim "*" var)) - (valfun (intern (format nil "%~A-~A-~A" :compute name :value))) - (clearfun (intern (format nil "%~A-~A" :clear name)))) - `(progn - (defun ,valfun () ,value) - (defvar ,var (,valfun) ,@(ensure-list docstring)) - (defun ,clearfun () (setf ,var (,valfun))) - (register-hook-function '*post-upgrade-cleanup-hook* ',clearfun)))) (defvar *verbose-out* nil) (defun asdf-message (format-string &rest format-args) (when *verbose-out* (apply 'format *verbose-out* format-string format-args))) @@ -51,6 +42,14 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (defun upgrading-p (&optional (oldest-compatible-version *oldest-forward-compatible-asdf-version*)) (and *previous-asdf-versions* (version< (first *previous-asdf-versions*) oldest-compatible-version))) + (defmacro defparameter* (var value &optional docstring (version *oldest-forward-compatible-asdf-version*)) + (let* ((name (string-trim "*" var)) + (valfun (intern (format nil "%~A-~A-~A" :compute name :value)))) + `(progn + (defun ,valfun () ,value) + (defvar ,var (,valfun) ,@(ensure-list docstring)) + (when (upgrading-p ,version) + (setf ,var (,valfun)))))) (defmacro when-upgrading ((&key (version *oldest-forward-compatible-asdf-version*) (upgrading-p `(upgrading-p ,version)) when) &body body) "A wrapper macro for code that should only be run when upgrading a -- GitLab