Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
I
inferior-shell
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
qitab
inferior-shell
Commits
694579f0
Commit
694579f0
authored
11 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Simplify run so it's compatible with the new uiop:run-program and its :error-output
parent
7b4928b4
No related branches found
Branches containing commit
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
run.lisp
+12
-17
12 additions, 17 deletions
run.lisp
utilities.lisp
+33
-8
33 additions, 8 deletions
utilities.lisp
with
45 additions
and
25 deletions
run.lisp
+
12
−
17
View file @
694579f0
...
...
@@ -16,9 +16,7 @@
(
and
(
typep
spec
'command-spec
)
(
null
(
command-redirections
spec
))))
(
defun
run-spec
(
spec
&rest
keys
&key
ignore-error-status
output
element-type
external-format
&allow-other-keys
)
(
declare
(
ignore
ignore-error-status
element-type
external-format
))
(
defun
run-spec
(
spec
&rest
keys
&key
&allow-other-keys
)
(
let*
((
command
(
if
(
consp
spec
)
(
parse-process-spec
spec
)
...
...
@@ -31,40 +29,37 @@
(
print-process-spec
spec
))
(
string
spec
))))
(
apply
'run-program
command
:output
(
case
output
((
t
)
nil
)
(
otherwise
output
))
keys
)))
(
apply
'run-program
command
keys
)))
(
defun
run-process-spec
(
spec
&rest
keys
&key
ignore-error-status
output
host
backend
)
(
defun
run-process-spec
(
spec
&rest
keys
&key
host
backend
&allow-other-keys
)
(
etypecase
host
(
null
(
etypecase
spec
(
string
(
run-spec
spec
:ignore-error-status
ignore-error-status
:output
output
))
(
apply
'
run-spec
spec
keys
))
(
cons
(
apply
'run-process-spec
(
parse-process-spec
spec
)
keys
))
(
process-spec
(
ecase
(
or
backend
*backend*
)
#+
(
and
sbcl
sb-thread
unix
)
((
:sbcl
)
(
let
((
interactive
(
eq
:output
:interactive
)))
(
sbcl-run
spec
:input
interactive
:output
(
or
interactive
output
)
:error
t
:ignore-error-status
ignore-error-status
)))
(
apply
'sbcl-run
spec
keys
))
((
:auto
)
(
run-spec
spec
:ignore-error-status
ignore-error-status
:output
output
))))))
(
apply
'
run-spec
spec
keys
))))))
(
string
(
apply
'run-process-spec
(
on-host-spec
host
spec
)
:host
nil
keys
))
(
function
(
apply
'run-process-spec
(
funcall
host
spec
)
:host
nil
keys
))))
(
defun
run
(
cmd
&key
time
(
output
t
)
show
host
(
on-error
(
list
"Command ~S failed~@[ on ~A~]"
cmd
host
)))
(
defun
run
(
cmd
&rest
keys
&key
time
show
host
(
on-error
(
list
"Command ~S failed~@[ on ~A~]"
cmd
host
))
&allow-other-keys
)
(
labels
((
process-time
()
(
if
time
(
time
(
process-command
))
(
process-command
)))
(
process-command
()
(
handler-case
(
run-process-spec
cmd
:ignore-error-status
nil
:output
output
:host
host
)
(
subprocess-error
()
(
error-behavior
on-error
)))))
(
handler-bind
((
subprocess-error
#'
(
lambda
(
c
)
(
error-behavior
on-error
c
))))
(
apply
'run-process-spec
cmd
:ignore-error-status
nil
:host
host
keys
))))
(
when
show
(
format
*trace-output*
"; ~A~%"
(
print-process-spec
cmd
)))
(
process-time
)))
...
...
This diff is collapsed.
Click to expand it.
utilities.lisp
+
33
−
8
View file @
694579f0
...
...
@@ -40,11 +40,9 @@
(
with-input-from-string
(
stream
string
)
(
do-stream-lines
fun
stream
)))
(
defun
println
(
x
)
(
princ
x
)
(
terpri
)
(
values
))
(
defun
writeln
(
x
&rest
keys
)
(
apply
'write
x
keys
)
(
terpri
)
(
values
))
(
defvar
*cr*
(
coerce
#(
#\cr
)
'string
))
(
defvar
*lf*
(
coerce
#(
#\newline
)
'string
))
(
defvar
*crlf*
(
coerce
#(
#\cr
#\newline
)
'string
))
(
defun
stripln
(
x
)
(
check-type
x
string
)
...
...
@@ -53,9 +51,36 @@
(
endcrlfp
(
and
endlfp
(
<=
2
len
)
(
eql
(
char
x
(
-
len
2
))
#\return
)))
(
endcrp
(
equal
(
last-char
x
)
#\return
)))
(
cond
((
or
endlfp
endcrp
)
(
subseq
x
0
(
-
len
1
)))
(
endcrlfp
(
subseq
x
0
(
-
len
2
)))
(
t
x
))))
(
endlfp
(
values
(
subseq
x
0
(
-
len
1
))
*lf*
))
(
endcrp
(
values
(
subseq
x
0
(
-
len
1
))
*cr*
))
(
endcrlfp
(
values
(
subseq
x
0
(
-
len
2
))
*crlf*
))
(
t
(
values
x
nil
)))))
(
defun
read-line*
(
&optional
(
stream
*standard-input*
)
eof-error-p
eof-value
recursive-p
cr
lf
)
"Similar to READ-LINE, this function also returns as additional values the state about
whether CR or LF were read. CR, LF and CR+LF are accepted only.
Partial state accepted as input, too, for parsing in chunks."
(
loop
:with
eof
=
'
#:eof
:with
datap
=
nil
:with
out
=
(
make-string-output-stream
)
:for
char
=
(
read-char
stream
nil
eof
recursive-p
)
:do
(
labels
((
out
(
c
)
(
setf
datap
t
)
(
write-char
c
out
))
(
unpeek
()
(
unread-char
char
stream
))
(
done
()
(
return
(
values
(
get-output-stream-string
out
)
cr
lf
)))
(
unpeek-done
()
(
unpeek
)
(
done
)))
(
cond
((
eql
char
#\newline
)
(
if
lf
(
unpeek-done
)
(
setf
lf
t
)))
((
eql
char
#\cr
)
(
if
(
or
cr
lf
)
(
unpeek-done
)
(
setf
cr
t
)))
((
eql
char
eof
)
(
cond
(
eof-error-p
(
read-char
stream
eof-error-p
eof-value
recursive-p
))
(
datap
(
done
))
(
t
(
return
(
values
eof-value
nil
nil
)))))
(
t
(
out
char
))))))
(
defun
add-days
(
year
month
date
days
)
(
multiple-value-bind
(
sec
min
hr
d
m
y
dlsp
tz
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment