Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
79ee29aa
Commit
79ee29aa
authored
Dec 06, 2016
by
Francois-Rene Rideau
Browse files
launch-program: avoid consing by run-time append
Replace ugly runtime append by a nicer read-time append.
parent
9edd4725
Changes
1
Hide whitespace changes
Inline
Side-by-side
uiop/launch-program.lisp
View file @
79ee29aa
...
...
@@ -540,6 +540,9 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(
error-output
(
%normalize-io-specifier
error-output
:error-output
))
#+
(
and
allegro
os-windows
)
(
interactive
(
%interactivep
input
output
error-output
))
(
command
(
%normalize-command
command
))))
#+
(
or
abcl
(
and
allegro
os-unix
)
clozure
cmucl
ecl
mkcl
sbcl
)
(
let
((
program
(
car
command
))
#-
allegro
(
arguments
(
cdr
command
))))
#-
(
or
allegro
mkcl
sbcl
)
(
with-current-directory
(
directory
))
(
multiple-value-bind
#+
(
or
abcl
clozure
cmucl
sbcl
scl
)
(
process
)
...
...
@@ -547,34 +550,29 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#+
ecl
(
stream
code
process
)
#+
lispworks
(
io-or-pid
err-or-nil
#-
lispworks7+
pid-or-nil
)
#+
mkcl
(
stream
process
code
)
(
apply
#+
abcl
#'
sys:run-program
#+
allegro
'excl:run-shell-command
#+
(
and
allegro
os-unix
)
(
coerce
(
cons
(
first
command
)
command
)
'vector
)
#+
(
and
allegro
os-windows
)
command
#+
clozure
'ccl:run-program
#+
(
or
cmucl
ecl
scl
)
'ext:run-program
#+
lispworks
'system:run-shell-command
#+
lispworks
(
cons
"/usr/bin/env"
command
)
; LW wants a full path
#+
mkcl
'mk-ext:run-program
#+
sbcl
'sb-ext:run-program
(
append
#+
(
or
abcl
clozure
cmucl
ecl
mkcl
sbcl
scl
)
`
(
,
(
car
command
)
,
(
cdr
command
))
`
(
:input
,
input
:output
,
output
#.
(
or
#+
(
or
allegro
lispworks
)
:error-output
:error
)
,
error-output
:wait
nil
:element-type
,
element-type
:external-format
,
external-format
:if-input-does-not-exist
:error
:if-output-exists
:append
#-
(
or
allegro
lispworks
)
:if-error-exists
#+
(
or
allegro
lispworks
)
:if-error-output-exists
:append
:allow-other-keys
t
)
#+
allegro
`
(
:directory
,
directory
)
#+
(
and
allegro
os-windows
)
`
(
:show-window
,
(
if
interactive
nil
:hide
))
#+
lispworks
`
(
:save-exit-status
t
)
#+
mkcl
`
(
:directory
,
(
native-namestring
directory
))
#+
sbcl
`
(
:search
t
)
#-
sbcl
keys
;; on SBCL, don't pass :directory nil but remove it from the keys
#+
sbcl
(
if
directory
keys
(
remove-plist-key
:directory
keys
)))))
#.`
(
apply
#+
abcl
'sys:run-program
#+
allegro
,@'
(
'excl:run-shell-command
#+
os-unix
(
coerce
(
cons
program
command
)
'vector
)
#+
os-windows
command
)
#+
clozure
'ccl:run-program
#+
(
or
cmucl
ecl
scl
)
'ext:run-program
#+
lispworks
,@'
(
'system:run-shell-command
`
(
"/usr/bin/env"
,@
command
))
; full path needed
#+
mkcl
'mk-ext:run-program
#+
sbcl
'sb-ext:run-program
#+
(
or
abcl
clozure
cmucl
ecl
mkcl
sbcl
)
,@'
(
program
arguments
)
:input
input
:if-input-does-not-exist
:error
:output
output
:if-output-exists
:append
,
(
or
#+
(
or
allegro
lispworks
)
:error-output
:error
)
error-output
,
(
or
#+
(
or
allegro
lispworks
)
:if-error-output-exists
:if-error-exists
)
:append
:wait
nil
:element-type
element-type
:external-format
external-format
:allow-other-keys
t
#+
allegro
,@`
(
:directory
directory
#+
os-windows
,@'
(
:show-window
(
if
interactive
nil
:hide
)))
#+
lispworks
,@'
(
:save-exit-status
t
)
#+
mkcl
,@'
(
:directory
(
native-namestring
directory
))
#-
sbcl
keys
;; on SBCL, don't pass :directory nil but remove it from the keys
#+
sbcl
,@'
(
:search
t
(
if
directory
keys
(
remove-plist-key
:directory
keys
)))))
(
labels
((
prop
(
key
value
)
(
setf
(
slot-value
process-info
key
)
value
)))
#+
allegro
(
cond
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment