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
22d69ec1
Commit
22d69ec1
authored
May 19, 2020
by
Eric Timmons
Browse files
cli less work: bundle exec
parent
fae748aa
Changes
6
Hide whitespace changes
Inline
Side-by-side
cli/commands/bundle/exec.lisp
View file @
22d69ec1
...
...
@@ -5,23 +5,14 @@
(
uiop:define-package
#:clpm-cli/commands/bundle/exec
(
:use
#:cl
#:clpm/bundle
#:clpm-cli/commands/bundle/common
#:clpm-cli/common-args
#:clpm-cli/interface-defs
#:clpm/clpmfile
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/log
#:clpm/source
#:clpm/utils
)
(
:import-from
#:adopt
))
#:clpm-cli/interface-defs
)
(
:import-from
#:adopt
)
(
:import-from
#:clpm
))
(
in-package
#:clpm-cli/commands/bundle/exec
)
(
setup-logger
)
(
defparameter
*option-with-client*
(
adopt:make-option
:bundle-exec-with-client
...
...
@@ -40,32 +31,5 @@
*option-with-client*
)))
(
define-cli-command
((
"bundle"
"exec"
)
*bundle-exec-ui*
)
(
args
options
)
(
let*
((
clpmfile-pathname
(
bundle-clpmfile-pathname
))
(
clpmfile
(
get-clpmfile
clpmfile-pathname
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
))
(
include-client-p
(
gethash
:bundle-exec-with-client
options
))
(
cl-source-registry-form
(
bundle-source-registry
clpmfile-pathname
:include-client-p
include-client-p
))
(
output-translations-form
(
bundle-output-translations
clpmfile-pathname
))
(
lockfile
(
bundle-context
clpmfile
))
(
installed-system-names
(
sort
(
mapcar
#'
system-name
(
context-installed-systems
lockfile
))
#'
string<
))
(
visible-primary-system-names
(
sort
(
context-visible-primary-system-names
lockfile
)
#'
string<
))
(
command
args
))
(
log:debug
"Computed CL_SOURCE_REGISTRY:~%~S"
cl-source-registry-form
)
(
with-standard-io-syntax
(
execvpe
(
first
command
)
(
rest
command
)
`
((
"CL_SOURCE_REGISTRY"
.
,
(
prin1-to-string
cl-source-registry-form
))
,@
(
when
output-translations-form
`
((
"ASDF_OUTPUT_TRANSLATIONS"
.
,
(
prin1-to-string
output-translations-form
))))
,@
(
if
*live-script-location*
`
((
"CLPM_BUNDLE_BIN_LIVE_SCRIPT"
.
,
(
uiop:native-namestring
*live-script-location*
))
(
"CLPM_BUNDLE_BIN_LISP_IMPLEMENTATION"
.
,
(
lisp-implementation-type
)))
`
((
"CLPM_BUNDLE_BIN"
.
,
(
uiop:argv0
))))
(
"CLPM_BUNDLE_INSTALLED_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
installed-system-names
))
(
"CLPM_BUNDLE_VISIBLE_PRIMARY_SYSTEMS"
.
,
(
format
nil
"~{~A~^ ~}"
visible-primary-system-names
))
(
"CLPM_BUNDLE_CLPMFILE"
.
,
(
uiop:native-namestring
clpmfile-pathname
))
(
"CLPM_BUNDLE_CLPMFILE_LOCK"
.
,
(
uiop:native-namestring
lockfile-pathname
)))
t
))
;; We got here, there is some .asd file not present. Tell the user!
;; (format *error-output* "The following system files are missing! Please run `clpm bundle install` and try again!~%~A" missing-pathnames)
nil
))
(
clpm:bundle-exec
(
first
args
)
(
rest
args
)
:with-client-p
(
gethash
:bundle-exec-with-client
options
))
nil
)
clpm/bundle.lisp
View file @
22d69ec1
...
...
@@ -12,6 +12,7 @@
#:clpm/clpmfile
#:clpm/config
#:clpm/context
#:clpm/execvpe
#:clpm/install
#:clpm/log
#:clpm/repos
...
...
@@ -21,6 +22,7 @@
#:do-urlencode
)
(
:export
#:bundle-clpmfile-pathname
#:bundle-context
#:bundle-exec
#:bundle-init
#:bundle-install
#:bundle-output-translations
...
...
@@ -33,6 +35,18 @@
(
setup-logger
)
(
defun
call-with-bundle-session
(
thunk
&key
clpmfile
)
(
with-clpm-session
()
(
with-config-source
(
:pathname
(
merge-pathnames
".clpm/bundle.conf"
(
uiop:pathname-directory-pathname
(
clpmfile-pathname
clpmfile
))))
(
let
((
*default-pathname-defaults*
(
uiop:pathname-directory-pathname
(
clpmfile-pathname
clpmfile
)))
(
*vcs-project-override-fun*
(
make-vcs-override-fun
(
clpmfile-pathname
clpmfile
))))
(
funcall
thunk
)))))
(
defmacro
with-bundle-session
((
clpmfile
)
&body
body
)
`
(
call-with-bundle-session
(
lambda
()
,@
body
)
:clpmfile
,
clpmfile
))
(
defun
bundle-clpmfile-pathname
()
(
merge-pathnames
(
config-value
:bundle
:clpmfile
)
(
uiop:getcwd
)))
...
...
@@ -204,3 +218,36 @@ the lock file if necessary."
:update-projects
(
or
update-projects
t
)))
(
when
changedp
(
save-context
lockfile
))))
(
defun
bundle-exec
(
command
args
&key
clpmfile
with-client-p
)
"exec(3) (or approximate if system doesn't have exec) a COMMAND in bundle's 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-bundle-session
(
clpmfile
)
(
with-sources-using-installed-only
()
(
let*
((
*fetch-repo-automatically*
nil
)
(
clpmfile-pathname
(
clpmfile-pathname
clpmfile
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
))
(
lockfile
(
load-lockfile
lockfile-pathname
))
(
cl-source-registry-form
(
context-to-asdf-source-registry-form
lockfile
:with-client
with-client-p
))
(
output-translations
(
context-output-translations
lockfile
))
(
installed-system-names
(
sort
(
mapcar
#'
system-name
(
context-installed-systems
lockfile
))
#'
string<
))
(
visible-primary-system-names
(
sort
(
context-visible-primary-system-names
lockfile
)
#'
string<
)))
(
with-standard-io-syntax
(
execvpe
command
args
`
((
"CL_SOURCE_REGISTRY"
.
,
(
format
nil
"~S"
cl-source-registry-form
))
,@
(
when
output-translations
`
((
"ASDF_OUTPUT_TRANSLATIONS"
.
,
(
format
nil
"~S"
output-translations
))))
(
"CLPM_EXEC_INSTALLED_SYSTEMS"
.
,
(
format
nil
"~S"
installed-system-names
))
(
"CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS"
.
,
(
format
nil
"~S"
visible-primary-system-names
))
(
"CLPM_BUNDLE_CLPMFILE"
.
,
(
uiop:native-namestring
clpmfile-pathname
))
(
"CLPM_BUNLDE_CLPMFILE_LOCK"
.
,
(
uiop:native-namestring
lockfile-pathname
)))
t
))))))
clpm/clpm.lisp
View file @
22d69ec1
...
...
@@ -18,6 +18,8 @@
#:clpm/sync
#:clpm/update
#:clpm/version
)
;; From bundle
(
:export
#:bundle-exec
)
;; From client
(
:export
#:client-asd-pathname
)
;; From config
...
...
clpm/clpmfile.lisp
View file @
22d69ec1
...
...
@@ -21,12 +21,23 @@
(
in-package
#:clpm/clpmfile
)
;; * Class Definitions
(
defun
clpmfile-pathname
(
clpmfile
)
(
defgeneric
clpmfile-pathname
(
clpmfile
))
(
defmethod
clpmfile-pathname
((
clpmfile
context
))
(
assert
(
context-anonymous-p
clpmfile
))
(
context-name
clpmfile
))
(
defmethod
clpmfile-pathname
((
clpmfile
pathname
))
clpmfile
)
(
defmethod
clpmfile-pathname
((
clpmfile
string
))
clpmfile
)
(
defmethod
clpmfile-pathname
((
clpmfile
(
eql
nil
)))
(
merge-pathnames
(
config-value
:bundle
:clpmfile
)
(
uiop:getcwd
)))
(
defun
clpmfile-lockfile-pathname
(
clpmfile
)
(
merge-pathnames
(
make-pathname
:type
"lock"
)
(
clpmfile-pathname
clpmfile
)))
...
...
clpm/config.lisp
View file @
22d69ec1
...
...
@@ -80,7 +80,7 @@ rebind *CONFIG-SOURCES* with CONFIG-SOURCE placed in the appropriate position
and then call THUNK."
(
assert
(
xor
config-source
pathname
options-ht
))
(
when
pathname
(
setf
config-source
(
list
'config-file-source
:pathname
pathname
)))
(
setf
config-source
(
list
'config-file-source
:pathname
(
pathname
pathname
)
)))
(
when
options-ht
(
setf
config-source
(
list
'config-cli-source
:arg-ht
options-ht
)))
(
if
(
member
config-source
*config-sources*
:test
#'
equal
)
...
...
clpm/context.lisp
View file @
22d69ec1
...
...
@@ -14,7 +14,8 @@
#:clpm/data
#:clpm/log
#:clpm/requirement
#:clpm/source
)
#:clpm/source
#:do-urlencode
)
(
:export
#:context
#:context-add-requirement!
#:context-anonymous-p
...
...
@@ -270,16 +271,32 @@ in place with the same name. Return the new requirement if it was modified."
(
terpri
s
)))))))))
(
defun
context-output-translations
(
context
)
(
assert
(
not
(
context-anonymous-p
context
)))
(
let*
((
context
(
get-context
context
))
(
name
(
context-name
context
))
(
config-value
(
config-value
:contexts
name
:output-translation
)))
(
when
config-value
`
(
:output-translations
:ignore-inherited-configuration
(
t
(
:root
,@
(
rest
(
pathname-directory
(
clpm-cache-pathname
`
(
"contexts"
,
name
"fasl-cache"
)
:ensure-directory
t
)))
:implementation
:**/
:*.*.*
))))))
(
if
(
context-anonymous-p
context
)
(
let
((
pathname
(
context-name
context
)))
(
case
(
config-value
:bundle
:output-translation
)
((
t
)
`
(
:output-translations
:ignore-inherited-configuration
(
t
(
:root
,@
(
rest
(
pathname-directory
(
clpm-cache-pathname
'
(
"bundle"
"fasl-cache"
)
:ensure-directory
t
)))
,
(
urlencode
(
format
nil
"~{~A~^/~}"
(
rest
(
pathname-directory
pathname
))))
:implementation
:**
:*.*.*
))))
(
:local
`
(
:output-translations
:ignore-inherited-configuration
(
t
(
,
(
uiop:pathname-directory-pathname
pathname
)
".clpm"
"fasl-cache"
:implementation
:**/
:*.*.*
))))
(
t
nil
)))
(
let*
((
context
(
get-context
context
))
(
name
(
context-name
context
))
(
config-value
(
config-value
:contexts
name
:output-translation
)))
(
when
config-value
`
(
:output-translations
:ignore-inherited-configuration
(
t
(
:root
,@
(
rest
(
pathname-directory
(
clpm-cache-pathname
`
(
"contexts"
,
name
"fasl-cache"
)
:ensure-directory
t
)))
:implementation
:**/
:*.*.*
)))))))
;; * Deserializing
...
...
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