Commit 08bc94bc authored by Eric Timmons's avatar Eric Timmons
Browse files

Simplify client's install and update

parent e4d11923
......@@ -100,12 +100,10 @@ recursion."
(defun handle-missing-system (system-name active-context)
(labels ((%do-install (systems no-deps)
(let ((new-source-registry
(install :systems systems
:no-deps no-deps
:update-asdf-config t)))
(when new-source-registry
(find-system-without-clpm system-name))))
(when (install :systems systems
:no-deps no-deps
:update-asdf-config t)
(find-system-without-clpm system-name)))
(%reresolve ()
(%do-install nil nil))
(%install (no-deps)
......
......@@ -14,8 +14,7 @@
(context (default-context))
(update-asdf-config (asdf-integration-active-p))
no-resolve)
"Install a set of projects and systems. Returns the source registry form for
the context.
"Install a set of projects and systems. Returns T if the diff was approved.
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
......@@ -55,13 +54,13 @@ source registry is updated with the results."
(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-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-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))
source-registry)))
(let ((validate-result (funcall validate (make-context-diff-from-description (clpm-proc-read proc)))))
(clpm-proc-print proc validate-result)
(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-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))
validate-result))))
......@@ -10,7 +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 the source registry form for the context.
"Update a set of projects and systems. Returns T if the diff was approved.
PROJECTS and SYSTEMS must be lists of strings. If none are specified, every
project in the CONTEXT is eligible for upgrading.
......@@ -38,13 +38,13 @@ source registry is updated with the results."
(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-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-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))
source-registry)))
(let ((validate-result (funcall validate (make-context-diff-from-description (clpm-proc-read proc)))))
(clpm-proc-print proc validate-result)
(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-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))
validate-result))))
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