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
507d74a0
Commit
507d74a0
authored
May 19, 2020
by
Eric Timmons
Browse files
Cleanup
parent
05730014
Changes
4
Hide whitespace changes
Inline
Side-by-side
cli/commands/bundle/common.lisp
View file @
507d74a0
...
...
@@ -50,8 +50,4 @@
:contents
(
list
*group-common*
*group-bundle*
)))
(
define-cli-command-folder
((
"bundle"
)
*default-ui*
)
(
thunk
ui
args
options
)
(
declare
(
ignore
ui
args
options
))
(
with-bundle-default-pathname-defaults
()
(
with-bundle-local-config
()
(
funcall
thunk
))))
(
define-cli-command-folder
((
"bundle"
)
*default-ui*
))
cli/entry.lisp
View file @
507d74a0
...
...
@@ -50,16 +50,14 @@ please report a bug and provide the stack trace.~%")
;; Print the help if requested.
(
when
(
gethash
:help
options
)
(
adopt:print-help-and-exit
ui
))
;; Immediately start a CLPM session.
(
with-clpm-session
()
;; Augment the config with options from the CLI.
(
with-config-source
(
:options-ht
options
)
;; Set the log level.
(
set-log-level
)
;; Give ourselves a reasonable default, since the spec doesn't *require*
;; this...
(
let
((
*default-pathname-defaults*
(
uiop:pathname-directory-pathname
(
uiop:getcwd
))))
(
funcall
thunk
)))))
;; Augment the config with options from the CLI.
(
with-config-source
(
:options-ht
options
)
;; Set the log level.
(
set-log-level
)
;; Give ourselves a reasonable default, since the spec doesn't *require*
;; this...
(
let
((
*default-pathname-defaults*
(
uiop:pathname-directory-pathname
(
uiop:getcwd
))))
(
funcall
thunk
))))
(
defun
main
()
...
...
clpm/bundle.lisp
View file @
507d74a0
...
...
@@ -20,16 +20,13 @@
#:clpm/session
#:clpm/source
#:do-urlencode
)
(
:export
#:bundle-clpmfile-pathname
#:bundle-context
#:bundle-exec
(
:export
#:bundle-exec
#:bundle-init
#:bundle-install
#:bundle-output-translations
#:bundle-source-registry
#:bundle-update
#:with-bundle-default-pathname-defaults
#:with-bundle-local-config
))
#:with-bundle-session
))
(
in-package
#:clpm/bundle
)
...
...
@@ -47,31 +44,6 @@
(
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
)))
(
defun
call-with-bundle-local-config
(
thunk
pn
)
"Call THUNK in a dynamic environment that has the local config for the
clpmfile located at PN added to the config."
(
with-clpm-session
()
(
with-config-source
(
:pathname
(
merge-pathnames
".clpm/bundle.conf"
(
uiop:pathname-directory-pathname
pn
)))
(
funcall
thunk
))))
(
defmacro
with-bundle-local-config
((
&optional
(
clpmfile-pn
'
(
bundle-clpmfile-pathname
)))
&body
body
)
`
(
call-with-bundle-local-config
(
lambda
()
,@
body
)
,
clpmfile-pn
))
(
defun
call-with-bundle-default-pathname-defaults
(
thunk
pn
)
"Call THUNK in a dynamic environment that has *DEFAULT-PATHNAME-DEFAULTS*
bound to PN's folder."
(
let
((
*default-pathname-defaults*
(
uiop:pathname-directory-pathname
pn
)))
(
funcall
thunk
)))
(
defmacro
with-bundle-default-pathname-defaults
((
&optional
(
clpmfile-pn
'
(
bundle-clpmfile-pathname
)))
&body
body
)
`
(
call-with-bundle-default-pathname-defaults
(
lambda
()
,@
body
)
,
clpmfile-pn
))
(
defun
create-empty-lockfile
(
clpmfile
)
(
aprog1
(
copy-context
clpmfile
)
(
setf
(
context-name
it
)
(
clpmfile-lockfile-pathname
clpmfile
))))
...
...
@@ -86,11 +58,6 @@ bound to PN's folder."
(
defun
load-lockfile
(
pathname
)
(
load-anonymous-context-from-pathname
pathname
))
(
defun
bundle-context
(
clpmfile-designator
)
(
let*
((
clpmfile
(
get-clpmfile
clpmfile-designator
))
(
lockfile-pathname
(
clpmfile-lockfile-pathname
clpmfile
)))
(
load-lockfile
lockfile-pathname
)))
(
defun
bundle-init
(
&key
clpmfile
(
if-exists
:error
)
asds
)
(
with-standard-io-syntax
(
let
((
*print-case*
:downcase
))
...
...
@@ -230,6 +197,6 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
`
((
"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
)
))
(
"CLPM_
EXEC_
BUNDLE_CLPMFILE"
.
,
(
uiop:native-namestring
clpmfile-pathname
))
(
"CLPM_
EXEC_IGNORE_INHERITED_SOURCE_REGISTRY"
.
"t"
))
t
))))))
clpm/clpmfile.lisp
View file @
507d74a0
...
...
@@ -53,6 +53,9 @@
(
defmethod
get-clpmfile
((
clpmfile-designator
string
))
(
get-clpmfile
(
pathname
clpmfile-designator
)))
(
defmethod
get-clpmfile
((
clpmfile-designator
(
eql
nil
)))
(
get-clpmfile
(
clpmfile-pathname
nil
)))
;; * 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