Commit 61c9e3dd authored by Eric Timmons's avatar Eric Timmons
Browse files

Record the source of configuration directives in the source-registry config

The source registry configuration is described by a bunch of forms in a DSL
that allows for inheritance. Before constructing the actual source
registry (mapping from primary system names to pathnames), the configuration
DSL is expanded into a list of directories to search and flattened.

Previously, the flattening process left no indication of *why* a particular
directory was being searched. We now record that information as a list of
locations, ordered from most specific to least specific. This list can contain
any of the following:

+ A symbol: The directive was generated by calling the symbol as a function
with zero arguments.

+ A directory pathname: The directive came from one of the files located in
this directory ending with .conf.

+ A file pathname: The directive came from the named file.

+ NIL: The directive came from a literal NIL (simplifies to just an inherit
directive).

+ :INHERIT: The directive resulted from inheriting configuration.

So a source list such as:
(#P"/home/USER/.config/common-lisp/source-registry.conf.d/"
 USER-SOURCE-REGISTRY-DIRECTORY :INHERIT
 USER-SOURCE-REGISTRY :INHERIT
 ENVIRONMENT-SOURCE-REGISTRY :INHERIT
 NIL :INHERIT
 WRAPPING-SOURCE-REGISTRY)

Should be interpretted as: The specified search directory is being searched
because it was named in one of the files
/home/USER/.config/common-lisp/source-registry.conf.d/*.conf, which was
searched as part of the user's source registry directory, which was included
because the user's source registry conf file was empty or included a
:inherit-configuration directive, which was included because CL_SOURCE_REGISTRY
was parsed to something that contained a :inherit-configuration directive,
which was included because the user did not manually specify a configuration to
use, which was then included by the wrappign source registry which can never be
overridden.
parent a5882874
Pipeline #2621 passed with stages
in 35 minutes and 53 seconds
......@@ -233,11 +233,13 @@ after having found a .asd file? True by default.")
(defgeneric process-source-registry (spec &key inherit register))
(defun* (inherit-source-registry) (inherit &key register)
(defun* (inherit-source-registry) (inherit &key register source)
(when inherit
(process-source-registry (first inherit) :register register :inherit (rest inherit))))
(process-source-registry (first inherit)
:register register :inherit (rest inherit)
:source (when source (cons :inherit source)))))
(defun* (process-source-registry-directive) (directive &key inherit register)
(defun* (process-source-registry-directive) (directive &key inherit register source)
(destructuring-bind (kw &rest rest) (if (consp directive) directive (list directive))
(ecase kw
((:include)
......@@ -246,48 +248,51 @@ after having found a .asd file? True by default.")
((:directory)
(destructuring-bind (pathname) rest
(when pathname
(funcall register (resolve-location pathname :ensure-directory t)))))
(funcall register (resolve-location pathname :ensure-directory t) :source source))))
((:tree)
(destructuring-bind (pathname) rest
(when pathname
(funcall register (resolve-location pathname :ensure-directory t)
:recurse t :exclude *source-registry-exclusions*))))
:recurse t :exclude *source-registry-exclusions* :source source))))
((:exclude)
(setf *source-registry-exclusions* rest))
((:also-exclude)
(appendf *source-registry-exclusions* rest))
((:default-registry)
(inherit-source-registry
'(default-user-source-registry default-system-source-registry) :register register))
'(default-user-source-registry default-system-source-registry)
:register register :source (cons :default-registry source)))
((:inherit-configuration)
(inherit-source-registry inherit :register register))
(inherit-source-registry inherit :register register :source source))
((:ignore-inherited-configuration)
nil)))
nil)
(defmethod process-source-registry ((x symbol) &key inherit register)
(process-source-registry (funcall x) :inherit inherit :register register))
(defmethod process-source-registry ((pathname pathname) &key inherit register)
(defmethod process-source-registry ((x symbol) &key inherit register source)
(process-source-registry (funcall x)
:inherit inherit :register register :source (cons x source)))
(defmethod process-source-registry ((pathname pathname) &key inherit register source)
(cond
((directory-pathname-p pathname)
(let ((*here-directory* (resolve-symlinks* pathname)))
(process-source-registry (validate-source-registry-directory pathname)
:inherit inherit :register register)))
:inherit inherit :register register :source (cons pathname source))))
((probe-file* pathname :truename *resolve-symlinks*)
(let ((*here-directory* (pathname-directory-pathname pathname)))
(process-source-registry (validate-source-registry-file pathname)
:inherit inherit :register register)))
:inherit inherit :register register :source (cons pathname source))))
(t
(inherit-source-registry inherit :register register))))
(defmethod process-source-registry ((string string) &key inherit register)
(inherit-source-registry inherit :register register :source (cons pathname source)))))
(defmethod process-source-registry ((string string) &key inherit register source)
(process-source-registry (parse-source-registry-string string)
:inherit inherit :register register))
(defmethod process-source-registry ((x null) &key inherit register)
(inherit-source-registry inherit :register register))
(defmethod process-source-registry ((form cons) &key inherit register)
:inherit inherit :register register :source source))
(defmethod process-source-registry ((x null) &key inherit register source)
(inherit-source-registry inherit :register register :source source))
(defmethod process-source-registry ((form cons) &key inherit register source)
(let ((*source-registry-exclusions* *default-source-registry-exclusions*))
(dolist (directive (cdr (validate-source-registry-form form)))
(process-source-registry-directive directive :inherit inherit :register register))))
(process-source-registry-directive directive
:inherit inherit :register register :source (cons nil source)))))
;; Flatten the user-provided configuration into an ordered list of directories and trees
......@@ -299,8 +304,8 @@ after having found a .asd file? True by default.")
`(wrapping-source-registry
,parameter
,@*default-source-registries*)
:register #'(lambda (directory &key recurse exclude)
(collect (list directory :recurse recurse :exclude exclude))))))
:register #'(lambda (directory &key recurse exclude source)
(collect (list directory :recurse recurse :exclude exclude :source source))))))
:test 'equal :from-end t))
;; MAYBE: move this utility function to uiop/pathname and export it?
......@@ -320,7 +325,7 @@ after having found a .asd file? True by default.")
(defun compute-source-registry (&optional (parameter *source-registry-parameter*)
(registry *source-registry*))
(dolist (entry (flatten-source-registry parameter))
(destructuring-bind (directory &key recurse exclude) entry
(destructuring-bind (directory &key recurse exclude &allow-other-keys) entry
(let* ((h (make-hash-table :test 'equal))) ; table to detect duplicates
(register-asd-directory
directory :recurse recurse :exclude exclude :collect
......
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