Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
clpm
clpm
Commits
c6349a6b
Commit
c6349a6b
authored
May 20, 2020
by
Eric Timmons
Browse files
Add *CONTEXT-DIFF-APPROVAL-METHOD*
parent
9058bfaf
Changes
3
Hide whitespace changes
Inline
Side-by-side
client/asdf.lisp
View file @
c6349a6b
...
@@ -120,6 +120,7 @@ recursion."
...
@@ -120,6 +120,7 @@ recursion."
(
signal-missing-system
system-name
)
(
signal-missing-system
system-name
)
(
install-and-reload-config
()
(
install-and-reload-config
()
:report
"Attempt to install the system and try again."
:report
"Attempt to install the system and try again."
:test
(
lambda
(
c
)
(
declare
(
ignore
c
))
(
not
(
context-bundle-p
active-context
)))
(
%install
nil
))
(
%install
nil
))
(
reresolve-requirements-and-reload-config
()
(
reresolve-requirements-and-reload-config
()
:report
"Reresolve requirements and try again."
:report
"Reresolve requirements and try again."
...
@@ -133,6 +134,7 @@ recursion."
...
@@ -133,6 +134,7 @@ recursion."
(
asdf:search-for-system-definition
system-name
))
(
asdf:search-for-system-definition
system-name
))
(
install-without-dependencies-and-reload-config
()
(
install-without-dependencies-and-reload-config
()
:report
"Attempt to install the system without dependencies and try again."
: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
))))
(
%install
t
))))
((
nil
)
((
nil
)
nil
))))
nil
))))
...
...
client/package.lisp
View file @
c6349a6b
...
@@ -12,6 +12,7 @@
...
@@ -12,6 +12,7 @@
#:*clpm-dribble-output-prefix*
#:*clpm-dribble-output-prefix*
#:*clpm-error-dribble*
#:*clpm-error-dribble*
#:*clpm-executable*
#:*clpm-executable*
#:*context-diff-approval-method*
#:*default-context*
#:*default-context*
#:asdf-integration-active-p
#:asdf-integration-active-p
#:activate-asdf-integration
#:activate-asdf-integration
...
...
client/ui.lisp
View file @
c6349a6b
...
@@ -5,6 +5,18 @@
...
@@ -5,6 +5,18 @@
(
in-package
#:clpm-client
)
(
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
()
(
define-condition
context-diff-needs-approval
()
((
diff
((
diff
:initarg
:diff
:initarg
:diff
...
@@ -16,7 +28,7 @@
...
@@ -16,7 +28,7 @@
(
:documentation
(
:documentation
"Condition reporting that a CONTEXT-DIFF needs approval."
))
"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
"Signal an error with a CONTEXT-DIFF-NEEDS-APPROVAL condition. Establish
APPROVE-DIFF and REJECT-DIFF restarts."
APPROVE-DIFF and REJECT-DIFF restarts."
(
restart-case
(
restart-case
...
@@ -30,6 +42,24 @@ APPROVE-DIFF and REJECT-DIFF restarts."
...
@@ -30,6 +42,24 @@ APPROVE-DIFF and REJECT-DIFF restarts."
:report
"Reject diff"
:report
"Reject diff"
nil
)))
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
)
(
defun
approve-diff
(
&optional
condition
)
"Invoke the APPROVE-DIFF restart or return NIL if no such restart exists."
"Invoke the APPROVE-DIFF restart or return NIL if no such restart exists."
(
let
((
restart
(
find-restart
'approve-diff
condition
)))
(
let
((
restart
(
find-restart
'approve-diff
condition
)))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment