Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
gendl
gendl
Commits
b96d5397
Commit
b96d5397
authored
Oct 30, 2022
by
Dave Cooper
Browse files
make it work like allegro with restart-app-function
and restart-init-function.
parent
ffcbff03
Pipeline
#7294
passed with stages
in 5 minutes and 45 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
base/rest/source/gdl-app.lisp
View file @
b96d5397
...
...
@@ -2,6 +2,10 @@
(
defparameter
*ci-info*
nil
)
(
defparameter
*restart-app-function*
nil
)
(
defparameter
*restart-init-function*
nil
)
#-
allegro
(
define-object
gdl-app
()
:documentation
(
:description
"
...
...
@@ -85,7 +89,14 @@ This function will be run in the initiating image after the build is finished."
application starts up. The alternative to using this to achieve
initializations is to put expressions in a gdlinit.cl or
.gdlinit.cl in the application directory or user home
directory. Defaults to nil."
restart-init-function
nil
)
directory. Defaults to nil."
restart-init-function
*restart-init-function*
)
(
"Lambda expression with empty argument list or symbol naming a
function with no arguments. This will be run when the runtime
application starts up. The alternative to using this to achieve
initializations is to put expressions in a gdlinit.cl or
.gdlinit.cl in the application directory or user home
directory. Defaults to nil."
restart-app-function
*restart-app-function*
)
(
"List of pathnames. This list should contain the pre-compiled
...
...
@@ -147,7 +158,8 @@ This function will be run in the initiating image after the build is finished."
,
(
when
branch
`
(
setf
(
getf
(
getf
*ci-info*
,
application-key
)
:branch
)
,
branch
(
getf
(
getf
*ci-info*
,
application-key
)
:sha
)
,
sha
))
(
setq
*restart-init-function*
,
(
the
restart-init-function
))
(
ccl:save-application
(
progn
(
ensure-directories-exist
,
(
the
destination-exe
))
,
(
the
destination-exe
))
:prepend-kernel
t
...
...
@@ -156,7 +168,7 @@ This function will be run in the initiating image after the build is finished."
:purify
t
:application-class
',
(
the
application-class
)
:toplevel-function
,
(
the
toplevel-function
))
(
ccl:quit
)))
(
ccl:quit
)))
#-
ccl
(
error
"Please implement save-application-and-die-form for ~a.~%"
(
lisp-implementation-type
))
...
...
@@ -164,10 +176,10 @@ This function will be run in the initiating image after the build is finished."
)
(
toplevel-function
(
when
(
the
restart-
init
-function
)
(
toplevel-function
(
when
(
the
restart-
app
-function
)
`
(
lambda
()
(
gendl::initialize
:startup-banner?
t
)
(
funcall
#'
,
(
the
restart-
init
-function
)))))
(
funcall
#'
,
(
the
restart-
app
-function
)))))
#+
nil
(
toplevel-function
...
...
base/source/genworks.lisp
View file @
b96d5397
...
...
@@ -482,12 +482,15 @@
#+
ccl
(
defmethod
ccl:toplevel-function
:before
((
a
gendl:gendl-development-system
)
init-file
)
(
declare
(
ignore
init-file
))
(
gendl::initialize
:startup-banner?
t
))
(
gendl::initialize
:startup-banner?
t
)
(
when
gdl::*restart-init-function*
(
funcall
#'
gdl::*restart-init-function*
)))
#+
ccl
(
defmethod
ccl:toplevel-function
:before
((
a
gendl:gendl-runtime-system
)
init-file
)
(
declare
(
ignore
init-file
))
(
gendl::initialize
:startup-banner?
t
))
(
gendl::initialize
:startup-banner?
t
)
(
when
gdl::*restart-init-function*
(
funcall
#'
gdl::*restart-init-function*
)))
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment