Commit c6349a6b authored by Eric Timmons's avatar Eric Timmons
Browse files

Add *CONTEXT-DIFF-APPROVAL-METHOD*

parent 9058bfaf
Loading
Loading
Loading
Loading
+2 −0
Original line number Diff line number Diff line
@@ -120,6 +120,7 @@ recursion."
           (signal-missing-system system-name)
         (install-and-reload-config ()
           :report "Attempt to install the system and try again."
           :test (lambda (c) (declare (ignore c)) (not (context-bundle-p active-context)))
           (%install nil))
         (reresolve-requirements-and-reload-config ()
           :report "Reresolve requirements and try again."
@@ -133,6 +134,7 @@ recursion."
           (asdf:search-for-system-definition system-name))
         (install-without-dependencies-and-reload-config ()
           :report "Attempt to install the system without dependencies and try again."
           :test (lambda (c) (declare (ignore c)) (not (context-bundle-p active-context)))
           (%install t))))
      ((nil)
       nil))))
+1 −0
Original line number Diff line number Diff line
@@ -12,6 +12,7 @@
           #:*clpm-dribble-output-prefix*
           #:*clpm-error-dribble*
           #:*clpm-executable*
           #:*context-diff-approval-method*
           #:*default-context*
           #:asdf-integration-active-p
           #:activate-asdf-integration
+31 −1
Original line number Diff line number Diff line
@@ -5,6 +5,18 @@

(in-package #:clpm-client)

(defvar *context-diff-approval-method* :error
  "Controls how CLPM prompts the user to approve diffs before acting on
them. Can be one of:

+ :ERROR :: A condition of type CONTEXT-DIFF-NEEDS-APPROVAL is signaled using
ERROR. The APPROVE-DIFF and REJECT-DIFF restarts are made available.

+ :YES-OR-NO-P :: The diff is printed and the user asked to approve or not using
YES-OR-NO-P.

+ T :: The diff is accepted without prompting.")

(define-condition context-diff-needs-approval ()
  ((diff
    :initarg :diff
@@ -16,7 +28,7 @@
  (:documentation
   "Condition reporting that a CONTEXT-DIFF needs approval."))

(defun context-diff-approved-p (context-diff)
(defun context-diff-approved-p/error (context-diff)
  "Signal an error with a CONTEXT-DIFF-NEEDS-APPROVAL condition. Establish
APPROVE-DIFF and REJECT-DIFF restarts."
  (restart-case
@@ -30,6 +42,24 @@ APPROVE-DIFF and REJECT-DIFF restarts."
      :report "Reject diff"
      nil)))

(defun context-diff-approved-p/yes-or-no-p (context-diff)
  "Use YES-OR-NO-P to ask the user for approval."
  (let ((string
          (with-output-to-string (s)
            (format s "CLPM needs the following diff to be approved or denied:~%")
            (print-context-diff-to-stream context-diff s)
            (format s "~&Do you approve?"))))
    (yes-or-no-p "~A" string)))

(defun context-diff-approved-p (context-diff)
  "Ask the user to approve a diff, based on value of
*CONTEXT-DIFF-APPROVAL-METHOD."
  (ecase *context-diff-approval-method*
    (:error (context-diff-approved-p/error context-diff))
    (:yes-or-no-p (context-diff-approved-p/yes-or-no-p context-diff))
    (t t)))


(defun approve-diff (&optional condition)
  "Invoke the APPROVE-DIFF restart or return NIL if no such restart exists."
  (let ((restart (find-restart 'approve-diff condition)))