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
81d7bfcd
Commit
81d7bfcd
authored
12 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
Use optima, not fare-matcher. Fix tests.
parent
a313e7a4
No related branches found
No related tags found
No related merge requests found
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
inferior-shell.asd
+2
-3
2 additions, 3 deletions
inferior-shell.asd
pkgdcl.lisp
+1
-1
1 addition, 1 deletion
pkgdcl.lisp
process-spec.lisp
+19
-8
19 additions, 8 deletions
process-spec.lisp
run-sbcl.lisp
+1
-1
1 addition, 1 deletion
run-sbcl.lisp
with
23 additions
and
13 deletions
inferior-shell.asd
+
2
−
3
View file @
81d7bfcd
;;; -*- Lisp -*-
;;; -*- Lisp -*-
#+
sbcl
(
require
:sb-posix
)
(
defsystem
:inferior-shell
(
defsystem
:inferior-shell
:defsystem-depends-on
(
:asdf-condition-control
)
:defsystem-depends-on
(
:asdf-condition-control
)
:depends-on
(
:asdf
:xcvb-driver
:fare-utils
:fare-matcher
:fare-quasiquote-readtable
:fare-mop
:alexandria
)
:depends-on
(
:asdf
:xcvb-utils
:fare-quasiquote-extras
:fare-mop
:alexandria
#+
sbcl
:sb-posix
)
:description
"spawn local or remote processes and shell pipes"
:description
"spawn local or remote processes and shell pipes"
:components
:components
((
:file
"pkgdcl"
)
((
:file
"pkgdcl"
)
...
...
This diff is collapsed.
Click to expand it.
pkgdcl.lisp
+
1
−
1
View file @
81d7bfcd
...
@@ -3,7 +3,7 @@
...
@@ -3,7 +3,7 @@
(
in-package
:cl
)
(
in-package
:cl
)
(
defpackage
:inferior-shell
(
defpackage
:inferior-shell
(
:use
:cl
:xcvb-utils
:
fare-matcher
:named-readtables
:fare-mop
)
(
:use
:cl
:xcvb-utils
:
optima
:named-readtables
:fare-mop
)
(
:export
(
:export
#:run
#:run/s
#:run/ss
#:run/lines
#:run
#:run/s
#:run/ss
#:run/lines
#:simple-command-line-token
#:token-string
#:simple-command-line-token
#:token-string
...
...
This diff is collapsed.
Click to expand it.
process-spec.lisp
+
19
−
8
View file @
81d7bfcd
#+
xcvb
(
module
(
:depends-on
(
"pkgdcl"
)))
#+
xcvb
(
module
(
:depends-on
(
"pkgdcl"
)))
(
in-package
:inferior-shell
)
(
in-package
:inferior-shell
)
(
in-readtable
:fare-quasiquote
)
(
in-readtable
:fare-quasiquote
)
(
defclass
process-spec
(
simple-print-object-mixin
)
())
(
defclass
process-spec
(
simple-print-object-mixin
)
())
...
@@ -193,12 +193,12 @@
...
@@ -193,12 +193,12 @@
(
make-sequence-instance
progn-spec
args
))
(
make-sequence-instance
progn-spec
args
))
(
`
(
fork
,@
args
)
(
`
(
fork
,@
args
)
(
make-sequence-instance
fork-spec
args
))
(
make-sequence-instance
fork-spec
args
))
(
`
(
,
*
,@
*
)
(
`
(
,
_
,@
_
)
(
let
((
c
(
make-instance
'command-parse
)))
(
let
((
c
(
make-instance
'command-parse
)))
(
dolist
(
elem
spec
)
(
dolist
(
elem
spec
)
(
parse-command-spec-top-token
c
elem
))
(
parse-command-spec-top-token
c
elem
))
(
command-parse-results
c
)))
(
command-parse-results
c
)))
(
*
(
_
(
error
"Invalid process spec ~S"
spec
)))))
(
error
"Invalid process spec ~S"
spec
)))))
(
deftype
simple-command-line-token
()
'
(
or
string
pathname
keyword
symbol
character
integer
))
(
deftype
simple-command-line-token
()
'
(
or
string
pathname
keyword
symbol
character
integer
))
...
@@ -206,20 +206,31 @@
...
@@ -206,20 +206,31 @@
(
defun
token-string
(
x
)
(
defun
token-string
(
x
)
(
with-safe-io-syntax
()
(
with-safe-io-syntax
()
(
typecase
x
(
typecase
x
(
null
""
)
(
character
(
format
nil
"-~A"
x
))
(
character
(
format
nil
"-~A"
x
))
(
keyword
(
format
nil
"--~(~A~)"
x
))
(
keyword
(
format
nil
"--~(~A~)"
x
))
(
symbol
(
string-downcase
x
))
(
symbol
(
string-downcase
x
))
(
string
x
)
(
string
x
)
(
pathname
(
native-namestring
(
translate-logical-pathname
x
)))
(
pathname
(
native-namestring
(
translate-logical-pathname
x
)))
(
list
(
w
r
it
e
-to-string
x
))
(
cons
(
wit
h-output
-to-string
(
s
)
(
mapcar
(
curry
'write-token-component
s
)
x
)
))
(
t
(
princ-to-string
x
)))))
(
t
(
princ-to-string
x
)))))
(
defun
write-token-component
(
s
x
)
(
typecase
x
(
null
nil
)
(
character
(
write-char
x
s
))
(
symbol
(
write-string
(
string-downcase
x
)
s
))
(
string
(
write-string
x
s
))
(
pathname
(
write-string
(
native-namestring
(
translate-logical-pathname
x
))
s
))
(
cons
(
mapcar
(
curry
'write-token-component
s
)
x
))
(
t
(
princ
x
s
))))
(
defun
parse-command-spec-top-token
(
c
x
)
(
defun
parse-command-spec-top-token
(
c
x
)
(
labels
(
labels
((
r
(
x
)
((
r
(
x
)
(
add-redirection
c
x
))
(
add-redirection
c
x
))
(
f
(
sym
fd
pn
flags
)
(
f
(
sym
fd
pn
flags
)
(
r
(
make-file-redirection
sym
fd
pn
flags
)))
(
r
(
make-file-redirection
sym
fd
(
token-string
pn
)
flags
)))
(
fd
(
old
new
)
(
fd
(
old
new
)
(
r
(
make-fd-redirection
old
new
)))
(
r
(
make-fd-redirection
old
new
)))
(
cl
(
old
)
(
cl
(
old
)
...
@@ -276,7 +287,7 @@
...
@@ -276,7 +287,7 @@
(
`
(
>>&!
,
pn
)
(
`
(
>>&!
,
pn
)
(
c
`
(
>>!
1
,
pn
))
(
c
`
(
>>!
1
,
pn
))
(
c
`
(
>&
2
1
)))
(
c
`
(
>&
2
1
)))
(
*
(
_
(
flush-argument
c
)
(
flush-argument
c
)
(
parse-command-spec-token
c
x
)
(
parse-command-spec-token
c
x
)
(
flush-argument
c
)))))
(
flush-argument
c
)))))
...
@@ -306,9 +317,9 @@
...
@@ -306,9 +317,9 @@
(
`
(
quote
,@
args
)
;; quote
(
`
(
quote
,@
args
)
;; quote
(
e
(
xcvb-driver:escape-command
(
e
(
xcvb-driver:escape-command
(
parse-command-spec-tokens
args
))))
(
parse-command-spec-tokens
args
))))
(
`
(
,
(
of-
type
simple-command-line-token
)
,@
*
)
;; recurse
(
`
(
,
(
type
p
simple-command-line-token
)
_
)
;; recurse
(
map
()
#'
p
x
))
(
map
()
#'
p
x
))
(
*
(
_
(
error
"Unrecognized command-spec token ~S"
x
)))))
(
error
"Unrecognized command-spec token ~S"
x
)))))
(
p
x
)))
(
p
x
)))
...
...
This diff is collapsed.
Click to expand it.
run-sbcl.lisp
+
1
−
1
View file @
81d7bfcd
...
@@ -57,6 +57,6 @@
...
@@ -57,6 +57,6 @@
(
let
((
collected
(
mapcar
#'
collect-threads
full-results
)))
(
let
((
collected
(
mapcar
#'
collect-threads
full-results
)))
(
case
output
(
case
output
(
:string
(
apply
#'
concatenate
'string
collected
))
(
:string
(
apply
#'
concatenate
'string
collected
))
(
:string/stripped
(
str
cat
collected
))
(
:string/stripped
(
str
ipln
(
apply
#'
concatenate
'string
collected
))
)
(
:lines
(
apply
#'
concatenate
'list
collected
))
(
:lines
(
apply
#'
concatenate
'list
collected
))
(
otherwise
collected
)))))))
(
otherwise
collected
)))))))
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