Commit 0ba00ac9 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Add ~/common-lisp/ as a default tree in the registry.

parent 22358808
......@@ -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))
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment