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
xcvb
cl-launch
Commits
ab81cc87
Commit
ab81cc87
authored
Apr 01, 2015
by
Francois-Rene Rideau
Browse files
4.1.1.1: buildapp-like --dispatch-entry
parent
d37c6149
Changes
4
Hide whitespace changes
Inline
Side-by-side
cl-launch-dispatch.asd
0 → 100644
View file @
ab81cc87
(
defsystem
"cl-launch-dispatch"
:depends-on
(
#-
asdf3.1
(
:version
"uiop"
"3.1"
))
:components
((
:file
"dispatch"
)))
cl-launch.sh
View file @
ab81cc87
#!/bin/sh
#| cl-launch.sh -- shell wrapper for Common Lisp -*- Lisp -*-
CL_LAUNCH_VERSION
=
'4.1.1'
CL_LAUNCH_VERSION
=
'4.1.1
.1
'
license_information
()
{
AUTHOR_NOTE
=
"
\
# Please send your improvements to the author:
...
...
@@ -54,7 +54,7 @@ unset \
EXEC_LISP DO_LISP DUMP LOAD_IMAGE RESTART RESTART_PACKAGE IMAGE IMAGE_OPT
\
EXTRA_CONFIG_VARIABLES
\
EXECUTABLE_IMAGE STANDALONE_EXECUTABLE CL_LAUNCH_STANDALONE
\
CL_LAUNCH_FILE __CL_ARGV0 IS_X_SCRIPT
\
CL_LAUNCH_FILE __CL_ARGV0 IS_X_SCRIPT
DISPATCH_ENTRY_P
\
TEST_SHELLS TORIG IMPL
LISPS
=
"
$DEFAULT_LISPS
"
...
...
@@ -138,6 +138,7 @@ Software specification
--require MODULE require MODULE while building
-r FUNC --restart FUNC restart from build by calling (FUNC)
-E FUNC --entry FUNC restart from build by calling (FUNC argv)
-DE N/F --dispatched-entry N/F if exec'ed as N, restart from (F argv)
-i FORM --init FORM evaluate FORM after restart
-ip FORM --print FORM evaluate and princ FORM after restart
-iw FORM --write FORM evaluate and write FORM after restart
...
...
@@ -313,6 +314,20 @@ at which point it happens when you invoke the executable output file:
the primary return value of result is generalized boolean true, and
with status 1 if this value is
\`
NIL
\`
.
See documentation for
\`
UIOP:RESTORE-IMAGE
\`
for details.
* If option `-DE --dispatch-entry` is used, then the next argument must follow
the format `NAME/ENTRY`, where `NAME` is a name that the program may be
invoked as (the basename of the `uiop:argv0` argument), and `ENTRY` is
a function to be invoked as if by --entry when that is the case.
Support for option `-DE --dispatch-entry` is delegated to a dispatch library,
distributed with `cl-launch` but not part of `cl-launch` itself, by
(1) registering a dependency on the dispatch library as if
`--system cl-launch-dispatch` had been specified (if not already)
(2) if neither `--restart` nor `--entry` was specified yet, registering a
default entry function as if by `--entry cl-launch-dispatch:dispatch-entry'.
(3) registering an init-form that registers the dispatch entry as if
`(cl-launch-dispatch:register-name/entry "NAME/ENTRY" :PACKAGE)` had been
specified where PACKAGE is the current package.
See the documentation of said library for further details.
The current package can be controlled by option
\`
-p --package
\`
and its variant
\`
-sp --system-package
\`
that also behaves like
\`
-s --system
\`
.
...
...
@@ -1096,6 +1111,16 @@ process_options () {
set_restart
"
$1
"
;
shift
;;
-E
|
--entry
)
set_restart
"(lambda()(
$1
uiop:*command-line-arguments*))"
;
shift
;;
-DE
|
--dispatch-entry
)
if
[
-z
"
$DISPATCH_ENTRY_P
"
]
;
then
add_build_form
"(:load-system
\"
cl-launch-dispatch
\"
)"
DISPATCH_ENTRY_P
=
t
fi
if
[
-z
"
$RESTART
"
]
;
then
set_entry
"cl-launch-dispatch:dispatch-entry"
fi
add_init_form
"(cl-launch-dispatch:register-name/entry
\"
$(
kwote
"
$1
"
)
\"
:
$PACKAGE
)"
shift
;;
-B
|
--backdoor
)
"
$@
"
;
exit
;;
--
)
...
...
@@ -1151,6 +1176,9 @@ in_package () {
set_restart
()
{
RESTART
=
"
$1
"
RESTART_PACKAGE
=
"
$PACKAGE
"
}
set_entry
()
{
set_restart
"(cl:lambda()(
$1
uiop:*command-line-arguments*))"
}
add_build_form
()
{
SOFTWARE_BUILD_FORMS
=
"
$SOFTWARE_BUILD_FORMS
${
SOFTWARE_BUILD_FORMS
+
}
$1
"
...
...
debian/rules
View file @
ab81cc87
...
...
@@ -43,7 +43,8 @@ install: build
dh_clean
dh_installdirs -p ${debpkg} $(include_dir) $(doc-dir)
dh_install -i cl-launch usr/bin
dh_install -i launcher.lisp wrapper.sh cl-launch.asd build.xcvb ${include_dir}
dh_install -i launcher.lisp wrapper.sh cl-launch.asd build.xcvb \
cl-launch-dispatch.asd dispatch.lisp ${include_dir}
dh_installman -i debian/*.1
...
...
dispatch.lisp
0 → 100644
View file @
ab81cc87
(
defpackage
:cl-launch-dispatch
(
:use
:uiop
:cl
)
(
:export
#:dispatch-entry
#:get-entry
#:register-name/entry
#:register-entry
#:dispatch-entry-error
#:get-name
#:basename
#:all-entry-names
#:dispatcher
#:not-found
))
(
in-package
:cl-launch-dispatch
)
(
defvar
*default-behavior*
'dispatcher
"the default behavior if the argv0 invocation name is not recognized."
)
(
defvar
*entries*
(
make-hash-table
:test
'equal
)
"a table of entries, associating strings (basename of a command) to entry"
)
(
define-condition
dispatch-entry-error
(
simple-error
)
())
(
defun
dispatch-entry-error
(
format
&rest
arguments
)
(
error
'dispatch-entry-error
:format-control
format
:format-arguments
arguments
))
(
defun
split-name/entry
(
name/entry
&optional
(
package
*package*
))
"split name and entry from a name-entry specification"
(
if-let
((
slash
(
position
#\/
name/entry
)))
(
values
(
let
((
name
(
subseq
name/entry
0
slash
)))
(
and
(
not
(
emptyp
name
))
name
))
(
ensure-function
(
subseq
name/entry
(
1+
slash
))
:package
package
))
(
dispatch-entry-error
"malformed entry ~S"
name/entry
)))
(
defun
register-entry
(
name
entry
)
(
if
name
(
setf
(
gethash
name
*entries*
)
entry
)
(
setf
*default-behavior*
entry
)))
(
defun
register-name/entry
(
name/entry
&optional
(
package
*package*
))
(
multiple-value-call
'register-entry
(
split-name/entry
name/entry
)))
(
defun
get-entry
(
name
)
"Given a string NAME, return the dispatch entry registered for that NAME.
If NAME is NIL, return the value of *DEFAULT-BEHAVIOR*."
(
if
name
(
gethash
name
*entries*
)
*default-behavior*
))
(
defun
basename
(
name
)
(
let
((
base
(
if-let
((
slash
(
position
#\/
name
:from-end
t
)))
(
subseq
name
(
1+
slash
))
name
)))
(
and
(
not
(
emptyp
base
))
base
)))
(
defun
get-name
()
(
basename
(
uiop:argv0
)))
(
defun
all-entry-names
()
(
sort
(
loop
:for
k
:being
:the
:hash-keys
:of
*entries*
:collect
k
)
'string<
))
(
defun
dispatcher
(
argv
)
(
if
(
null
argv
)
(
die
2
"~A available commands: ~{~A~^ ~}"
(
get-name
)
(
all-entry-names
))
(
dispatch-entry
(
rest
argv
)
(
first
argv
))))
(
defun
not-found
(
argv
)
(
declare
(
ignore
argv
))
(
if-let
((
name
(
get-name
)))
(
die
3
"~A command not found."
(
get-name
))
(
die
4
"could not determine command name"
)))
(
defun
dispatch-entry
(
argv
&optional
(
name
(
get-name
)))
(
funcall
(
or
(
get-entry
name
)
*default-behavior*
)
argv
))
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