Commit 371901e0 authored by Eric Timmons's avatar Eric Timmons
Browse files

Update client for latest changes

parent b5536c14
......@@ -118,6 +118,9 @@ recursion."
;; Prevent RESTART-CASE from using WITH-CONDITION-RESTARTS,
;; otherwise things can get messed up for defsystem-depends-on
(signal-missing-system system-name)
(install-and-reload-config ()
:report "Attempt to install the system and try again."
(%install nil))
(reresolve-requirements-and-reload-config ()
:report "Reresolve requirements and try again."
(%reresolve))
......@@ -125,12 +128,9 @@ recursion."
:report "Reload the source registry for the context and try again."
(asdf-configure-source-registry (context-source-registry :context active-context))
(unless (context-bundle-p active-context)
(setf *active-context-installed-systems* (context-installed-system-names :context active-context)
(setf *active-context-installed-primary-system-names* (context-installed-primary-system-names :context active-context)
*active-context-visible-primary-system-names* (context-visible-primary-system-names :context active-context)))
(asdf:search-for-system-definition system-name))
(install-and-reload-config ()
:report "Attempt to install the system and try again."
(%install nil))
(install-without-dependencies-and-reload-config ()
:report "Attempt to install the system without dependencies and try again."
(%install t))))
......@@ -159,7 +159,7 @@ requirement."
(when (and active-context
(not (equal "asdf" primary-name))
(not (equal "uiop" primary-name))
(not (member system-name *active-context-installed-systems* :test #'equal))
(not (member primary-name *active-context-installed-primary-system-names* :test #'equal))
(not (member primary-name *active-context-editable-primary-system-names* :test #'equal))
(member primary-name *active-context-visible-primary-system-names* :test #'equal))
(handle-missing-system system-name active-context))))
......
......@@ -22,7 +22,7 @@ ignored.")
(defvar *active-context-editable-primary-system-names* nil
"List of systems installed in the active context via an editable requirement.")
(defvar *active-context-installed-systems* nil
(defvar *active-context-installed-primary-system-names* nil
"List of systems installed in the active context.")
(defvar *active-context-visible-primary-system-names* nil
......@@ -35,9 +35,9 @@ variables."
(env-context (uiop:getenvp "CLPM_EXEC_CONTEXT")))
(when (or env-clpmfile env-context)
(setf *active-context* (if env-clpmfile (pathname env-clpmfile) env-context))
(uiop:if-let ((installed-systems-string (uiop:getenvp "CLPM_EXEC_INSTALLED_SYSTEMS")))
(uiop:if-let ((installed-systems-string (uiop:getenvp "CLPM_EXEC_INSTALLED_PRIMARY_SYSTEMS")))
(uiop:with-safe-io-syntax ()
(setf *active-context-installed-systems* (read-from-string installed-systems-string))))
(setf *active-context-installed-primary-system-names* (read-from-string installed-systems-string))))
(uiop:if-let ((visible-systems-string (uiop:getenvp "CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS")))
(uiop:with-safe-io-syntax ()
(setf *active-context-visible-primary-system-names* (read-from-string visible-systems-string))))
......@@ -58,7 +58,7 @@ variables."
*active-context-ignore-inherited-source-registry* nil
*active-context-splice-source-registry* nil
*active-context-visible-primary-system-names* nil
*active-context-installed-systems* nil
*active-context-installed-primary-system-names* nil
*active-context-visible-primary-system-names* nil))
(uiop:register-image-dump-hook 'clear-active-context)
......@@ -119,6 +119,12 @@ directories containing the files."
(clpm-proc-print proc `(installed-system-names :context ,context))
(clpm-proc-read proc)))
(defun context-installed-primary-system-names (&key (context (default-context)))
"Return the names of primary systems installed in CONTEXT."
(with-clpm-proc (proc)
(clpm-proc-print proc `(installed-primary-system-names :context ,context))
(clpm-proc-read proc)))
(defun context-visible-primary-system-names (&key (context (default-context)))
"Return the names of primary systems visible to ASDF in CONTEXT."
(with-clpm-proc (proc)
......@@ -159,7 +165,7 @@ called."
(old-context (active-context)))
(setf *active-context* context
*active-context-ignore-inherited-source-registry* ignore-inherited-source-registry
*active-context-installed-systems* nil
*active-context-installed-primary-system-names* nil
*active-context-visible-primary-system-names* nil
*active-context-editable-primary-system-names* nil)
(unless old-context
......@@ -167,7 +173,7 @@ called."
(asdf-configure-source-registry source-registry)
(unless (context-bundle-p context)
(setf *active-context-editable-primary-system-names* (context-editable-primary-system-names :context context)
*active-context-installed-systems* (context-installed-system-names :context context)
*active-context-installed-primary-system-names* (context-installed-primary-system-names :context context)
*active-context-visible-primary-system-names* (context-visible-primary-system-names :context context)))
(when output-translations
(asdf:initialize-output-translations output-translations))
......
......@@ -13,11 +13,8 @@
(context (default-context))
(update-asdf-config (asdf-integration-active-p))
no-resolve)
"Install a set of projects and systems. If the install completed, returns four
values. The first is a source registry form, the second is a list of systems
installed in the context, the third is a list of primary system names visible
when that source registry form is used, and the fourth is a list of primary
system names that are editable in the context.
"Install a set of projects and systems. Returns the source registry form for
the context.
PROJECTS and SYSTEMS must be lists of dependency specifiers. VERSION, REF, and
SOURCE must be strings and are used as the default constraints on PROJECTS and
......@@ -53,16 +50,16 @@ source registry is updated with the results."
:ref ,ref
:source ,source))
(list (source-registry :context ,context)
(installed-system-names :context ,context)
(installed-primary-system-names :context ,context)
(visible-primary-system-names :context ,context)
(editable-primary-system-names :context ,context))))
(clpm-proc-print proc
(funcall validate (make-context-diff-from-description (clpm-proc-read proc))))
(destructuring-bind (source-registry installed-system-names visible-system-names editable-system-names)
(destructuring-bind (source-registry installed-primary-system-names visible-system-names editable-system-names)
(clpm-proc-read proc)
(when (and update-asdf-config (equal context (active-context)))
(asdf-configure-source-registry source-registry)
(setf *active-context-installed-systems* installed-system-names
(setf *active-context-installed-primary-system-names* installed-primary-system-names
*active-context-visible-primary-system-names* visible-system-names
*active-context-editable-primary-system-names* editable-system-names))
(values source-registry installed-system-names visible-system-names editable-system-names))))
source-registry)))
......@@ -10,11 +10,7 @@
(validate 'context-diff-approved-p)
(context (default-context))
(update-asdf-config (asdf-integration-active-p)))
"Update a set of projects and systems. Returns four values. The first is a
source registry form, the second is a list of systems installed in the context,
the third is a list of primary system names visible when that source registry
form is used, and the fourth is a list of primary system names that are editable
in the context.
"Update a set of projects and systems. Returns the source registry form for the context.
PROJECTS and SYSTEMS must be lists of strings. If none are specified, every
project in the CONTEXT is eligible for upgrading.
......@@ -39,16 +35,16 @@ source registry is updated with the results."
:context ,context
:validate ,(make-diff-validator-fun)))
(list (source-registry :context ,context)
(installed-system-names :context ,context)
(installed-primary-system-names :context ,context)
(visible-primary-system-names :context ,context)
(editable-primary-system-names :context ,context))))
(clpm-proc-print proc
(funcall validate (make-context-diff-from-description (clpm-proc-read proc))))
(destructuring-bind (source-registry installed-system-names visible-system-names editable-system-names)
(destructuring-bind (source-registry installed-primary-system-names visible-system-names editable-system-names)
(clpm-proc-read proc)
(when (and update-asdf-config (equal context (active-context)))
(asdf-configure-source-registry source-registry)
(setf *active-context-installed-systems* installed-system-names
(setf *active-context-installed-primary-system-names* installed-primary-system-names
*active-context-visible-primary-system-names* visible-system-names
*active-context-editable-primary-system-names* editable-system-names))
(values source-registry installed-system-names visible-system-names editable-system-names))))
source-registry)))
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