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
74761f6a
Commit
74761f6a
authored
May 18, 2020
by
Eric Timmons
Browse files
cli less work: exec
parent
8d708b8b
Changes
3
Hide whitespace changes
Inline
Side-by-side
cli/commands/exec.lisp
View file @
74761f6a
...
...
@@ -6,19 +6,12 @@
(
uiop:define-package
#:clpm-cli/commands/exec
(
:use
#:cl
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/client
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/log
#:clpm/source
)
(
:import-from
#:adopt
))
#:clpm-cli/interface-defs
)
(
:import-from
#:adopt
)
(
:import-from
#:clpm
))
(
in-package
#:clpm-cli/commands/exec
)
(
setup-logger
)
(
defparameter
*option-with-client*
(
adopt:make-option
:exec-with-client
...
...
@@ -37,29 +30,4 @@
*option-with-client*
)))
(
define-cli-command
((
"exec"
)
*exec-ui*
)
(
args
options
)
(
let*
((
context-name
(
config-value
:context
))
(
context
(
get-context
context-name
))
(
with-client
(
gethash
:exec-with-client
options
))
(
ignore-inherited
(
config-value
:contexts
context-name
:ignore-inherited-source-registry
))
(
splice-inherited
(
uiop:getenvp
"CL_SOURCE_REGISTRY"
))
(
source-registry
(
context-to-asdf-source-registry-form
context
:with-client
with-client
:ignore-inherited
ignore-inherited
:splice-inherited
splice-inherited
))
(
output-translations
(
context-output-translations
context
))
(
installed-system-names
(
sort
(
mapcar
#'
system-name
(
context-installed-systems
context
))
#'
string<
))
(
visible-primary-system-names
(
sort
(
context-visible-primary-system-names
context
)
#'
string<
)))
(
with-standard-io-syntax
(
execvpe
(
first
args
)
(
rest
args
)
`
((
"CL_SOURCE_REGISTRY"
.
,
(
prin1-to-string
source-registry
))
,@
(
when
output-translations
`
((
"ASDF_OUTPUT_TRANSLATIONS"
.
,
(
prin1-to-string
output-translations
))))
(
"CLPM_EXEC_CONTEXT"
.
,
context-name
)
(
"CLPM_EXEC_INSTALLED_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
installed-system-names
))
(
"CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
visible-primary-system-names
))
,@
(
when
ignore-inherited
'
((
"CLPM_EXEC_IGNORE_INHERITED_SOURCE_REGISTRY"
.
"t"
)))
,@
(
when
(
and
(
not
ignore-inherited
)
splice-inherited
)
`
((
"CLPM_EXEC_SPLICE_INHERITED_SOURCE_REGISTRY"
.
,
splice-inherited
))))
t
))))
(
clpm:exec
(
first
args
)
(
rest
args
)
:with-client-p
(
gethash
:exec-with-client
options
)))
clpm/clpm.lisp
View file @
74761f6a
...
...
@@ -10,6 +10,7 @@
#:clpm/config
#:clpm/context
#:clpm/context-diff
#:clpm/exec
#:clpm/install
#:clpm/source
#:clpm/sync
...
...
@@ -17,12 +18,10 @@
#:clpm/version
)
;; From config
(
:export
#:config-value
)
;; From exec
(
:export
#:exec
)
;; From install
(
:export
#:install
)
;; From source
(
:export
#:source-name
#:sources
#:sync-source
)
;; From sync
(
:export
#:sync
)
;; From update
...
...
clpm/exec.lisp
0 → 100644
View file @
74761f6a
;;;; Exec'ing commands in a context
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(
uiop:define-package
#:clpm/exec
(
:use
#:cl
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/session
#:clpm/source
)
(
:export
#:exec
))
(
in-package
#:clpm/exec
)
(
defun
exec
(
command
args
&key
context
with-client-p
)
"exec(3) (or approximate if system doesn't have exec) a COMMAND in a CONTEXT.
COMMAND must be a string naming the command to run.
ARGS must be a list of strings containing the arguments to pass to the command.
If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
(
unless
(
stringp
command
)
(
error
"COMMAND must be a string."
))
(
with-clpm-session
()
(
let*
((
context
(
get-context
context
))
(
context-name
(
context-name
context
))
(
ignore-inherited-source-registry
(
config-value
:contexts
context-name
:ignore-inherited-source-registry
))
(
splice-inherited
(
uiop:getenvp
"CL_SOURCE_REGISTRY"
))
(
source-registry
(
context-to-asdf-source-registry-form
context
:with-client
with-client-p
:ignore-inherited
ignore-inherited-source-registry
:splice-inherited
splice-inherited
))
(
output-translations
(
context-output-translations
context
))
(
installed-system-names
(
sort
(
mapcar
#'
system-name
(
context-installed-systems
context
))
#'
string<
))
(
visible-primary-system-names
(
sort
(
context-visible-primary-system-names
context
)
#'
string<
)))
(
with-standard-io-syntax
(
execvpe
command
args
`
((
"CL_SOURCE_REGISTRY"
.
,
(
format
nil
"~S"
source-registry
))
,@
(
when
output-translations
`
((
"ASDF_OUTPUT_TRANSLATIONS"
.
(
format
nil
"~S"
output-translations
))))
(
"CLPM_EXEC_CONTEXT"
.
,
context-name
)
(
"CLPM_EXEC_INSTALLED_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
installed-system-names
))
(
"CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
visible-primary-system-names
))
,@
(
when
ignore-inherited-source-registry
'
((
"CLPM_EXEC_IGNORE_INHERITED_SOURCE_REGISTRY"
.
"t"
)))
,@
(
when
(
and
(
not
ignore-inherited-source-registry
)
splice-inherited
)
`
((
"CLPM_EXEC_SPLICE_INHERITED_SOURCE_REGISTRY"
.
,
splice-inherited
))))
t
)))))
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