Commit 2a410925 authored by Eric Timmons's avatar Eric Timmons
Browse files

context source-registry cli now allows for more fine grained control

parent 9aedf03a
......@@ -161,6 +161,7 @@ the lock file if necessary."
(mapcar (compose #'project-name #'release-project) missing-releases)))))
(context-to-asdf-source-registry-form
lockfile
:extra-forms
(when include-client-p
`((:directory ,(uiop:pathname-directory-pathname (client-asd-pathname))))))))
......
......@@ -14,19 +14,49 @@
(in-package #:clpm/cli/context/source-registry)
(defparameter *option-context-source-registry-ignore-inherited-configuration*
(adopt:make-option
:context-source-registry-ignore-inherited
:long "ignore-inherited-configuration"
:short #\i
:help "Print a source registry form configured to ignore inherited configuration"
:reduce (constantly t)))
(defparameter *option-context-source-registry-inherit-env-var*
(adopt:make-option
:context-source-registry-inherit-env-var
:long "splice-environment"
:short #\e
:help "Print a source registry form that has the contents of the CL_SOURCE_REGISTRY environment variable cpliced in. No effect if inherited configuration is ignored."
:reduce (constantly t)))
(defparameter *option-context-source-registry-with-client*
(adopt:make-option
:context-source-registry-with-client
:long "with-client"
:help "Print a source registry form that has the CLPM client included."
:reduce (constantly t)))
(defparameter *context-source-registry-ui*
(adopt:make-interface
:name "clpm context source-registry"
:summary "Common Lisp Package Manager Context Source-Registry"
:usage "context source-registry [options] CONTEXT-NAME"
:help "Print an ASDF source-registry form using the projects installed in a context"
:contents (list *group-common*)))
:contents (list *group-common*
*option-context-source-registry-ignore-inherited-configuration*
*option-context-source-registry-inherit-env-var*
*option-context-source-registry-with-client*)))
(define-cli-command (("context" "source-registry") *context-source-registry-ui*) (args options)
(declare (ignore options))
(assert (length= 1 args))
(with-standard-io-syntax
(let ((*print-case* :downcase))
(prin1 (context-to-asdf-source-registry-form (first args))))
(prin1 (context-to-asdf-source-registry-form
(first args)
:with-client (gethash :context-source-registry-with-client options)
:ignore-inherited (gethash :context-source-registry-ignore-inherited options)
:splice-inherited (and (gethash :context-source-registry-inherit-env-var options)
(uiop:getenv "CL_SOURCE_REGISTRY")))))
(terpri))
t)
......@@ -38,6 +38,7 @@
(define-cli-command (("exec") *exec-ui*) (args options)
(let ((source-registry (context-to-asdf-source-registry-form
(config-value :context)
:extra-forms
(when (gethash :exec-with-client options)
`((:directory ,(uiop:pathname-directory-pathname (client-asd-pathname)))))))
(output-translations (context-output-translations (config-value :context))))
......
......@@ -8,6 +8,7 @@
#:alexandria
#:cl-ansi-text
#:clpm/cache
#:clpm/client
#:clpm/config
#:clpm/data
#:clpm/log
......@@ -145,11 +146,24 @@ in place with the same name. Return the new requirement if it was modified."
:test #'uiop:pathname-equal)))
(mapcar (lambda (x) (list :directory x)) system-file-directories)))
(defun context-to-asdf-source-registry-form (context &optional extra-forms)
(defun context-to-asdf-source-registry-form (context &key extra-forms
ignore-inherited
splice-inherited
with-client)
`(:source-registry
:ignore-inherited-configuration
,@(context-to-asdf-source-registry.d-forms context)
,@extra-forms))
,@(when with-client
`((:directory ,(uiop:pathname-directory-pathname (client-asd-pathname)))))
,@extra-forms
,@(cond
(ignore-inherited
(list :ignore-inherited-configuration))
((and (stringp splice-inherited) (not (equal splice-inherited "")))
(rest (asdf/source-registry:parse-source-registry-string splice-inherited)))
((and splice-inherited (listp splice-inherited))
(rest splice-inherited))
(t
(list :inherit-configuration)))))
(defun context-find-system-asd-pathname (context system-name)
(when-let* ((context (get-context context))
......
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