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

Simplify client's install and update

parent e4d11923

client/asdf.lisp

+4 −6
Original line number Diff line number Diff line
@@ -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

             (when (install :systems systems

                            :no-deps no-deps

                              :update-asdf-config t)))

               (when new-source-registry

                 (find-system-without-clpm system-name))))

                            :update-asdf-config t)

               (find-system-without-clpm system-name)))

           (%reresolve ()

             (%do-install nil nil))

           (%install (no-deps)

client/install.lisp

+11 −12
Original line number Diff line number Diff line
@@ -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,8 +54,8 @@ 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))))

    (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)))
@@ -64,4 +63,4 @@ source registry is updated with the results." 
          (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)))
 
        validate-result))))

client/update.lisp

+11 −11
Original line number Diff line number Diff line
@@ -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,8 +38,8 @@ 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))))

    (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)))
@@ -47,4 +47,4 @@ source registry is updated with the results." 
          (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)))
 
        validate-result))))