Commit b2a6ca3b authored by Dave Cooper's avatar Dave Cooper
Browse files

not to late in release cycle to overhaul startup/init, right?

... errrm not to late in release cycle to overhaul startup/init,
right? right?
parent 13cc7a03
Pipeline #7252 failed with stages
in 1 minute and 51 seconds
......@@ -30,6 +30,8 @@ give to this object.
:input-slots
((build-level :runtime)
(application-class 'gendl-runtime-system) ;; useful for CCL, have to port to SBCL and others.
("String. The name which will be used for your
application's executable and possibly image file. Defaults to
\"gdl-test-runtime\"." application-name "gdl-test-runtime")
......@@ -129,7 +131,7 @@ This function will be run in the initiating image after the build is finished."
(save-appliction-and-die-form
(save-application-and-die-form
#+ccl
`(progn
(gendl::deinitialize)
......@@ -138,8 +140,8 @@ This function will be run in the initiating image after the build is finished."
:prepend-kernel t
;;:clear-clos-caches t
;;:purify t
:purify t
:application-class ,(the application-class)
:toplevel-function ,(the toplevel-function))
(ccl:quit))
......@@ -147,28 +149,22 @@ This function will be run in the initiating image after the build is finished."
(lisp-implementation-type)))
(toplevel-function ,(when (the restart-init-function)
`(progn
(funcall #',(the restart-init-function)))))
#+nil
(toplevel-function
`(lambda ()
,@(remove
nil
`((uiop:setup-temporary-directory)
#+(and mswindows allegro)
(let ((openssl-bin-path
(format nil "~a;"
(merge-pathnames "openssl-bin" (glisp:executable-homedir-pathname))))
(path (uiop:getenv "PATH")))
(unless (search openssl-bin-path path)
(setf (uiop:getenv "PATH") (string-append openssl-bin-path path))))
;;
;; FLAG -- sort out initialization so we don't have to do it
;; surgically/internally like this.
;;
(cl-user::setup-cl+ssl)
(gendl::initialize)
(setq glisp:*gdl-home* glisp:*gdl-program-home*)
;;
......@@ -283,7 +279,7 @@ This function will be run in the initiating image after the build is finished."
(when (the pre-load-form) (print (the pre-load-form) out))
(when (the load-fasls-expression) (print (the load-fasls-expression) out))
(when (the post-load-form) (print (the post-load-form) out))
(print (the save-appliction-and-die-form) out))
(print (the save-application-and-die-form) out))
......
......@@ -469,12 +469,18 @@
:load-toplevel
:execute)
(defclass gendl:gendl-development-system
(ccl::lisp-development-system) ()))
(ccl::lisp-development-system) ())
(defclass gendl:gendl-runtime-system
(gendl:gendl-development-system) ()))
#+ccl
(defmethod ccl:toplevel-function :before ((a gendl:gendl-development-system) init-file)
(declare (ignore init-file))
(gendl::initialize)(gwl::renew-wserver)(gendl::startup-banner))
(gendl::initialize :startup-banner? t))
......@@ -182,6 +182,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:gdl-skin-class
#:get-version
#:gendl-development-system
#:gendl-runtime-system
#:half
#:ignore-errors-with-backtrace
#:index-filter
......
......@@ -28,11 +28,11 @@
:yadd :robot :cl-lite :geysr))
(defun start-gendl! (&key (features *features-to-initialize*)
(banner? nil) (init-files? t)
(banner? nil)
(http-port gwl:*http-port*)(https-port gwl:*https-port*)(https? gwl:*https?*))
(glisp::set-gendl-source-home-if-known)
(glisp::set-genworks-source-home-if-known)
;;(glisp::set-gendl-source-home-if-known)
;;(glisp::set-genworks-source-home-if-known)
(let ((gwl:*http-port* http-port)
......@@ -63,26 +63,37 @@
(when banner? (startup-banner))
(when init-files? (load-gdl-init-files) )
;;(when init-files? (load-gdl-init-files) )
(values))
(defun start-gdl! (&rest args) (apply #'start-gendl! args))
(defun load-gdl-init-files ()
(let* ((user-homedir (user-homedir-pathname))
(current-directory (glisp:current-directory))
(homedir-init-file (or (probe-file (merge-pathnames ".gdlinit.cl" user-homedir))
(probe-file (merge-pathnames "gdlinit.cl" user-homedir))))
(current-init-file (when (not (equalp user-homedir current-directory))
(or (probe-file (merge-pathnames ".gdlinit.cl" current-directory))
(probe-file (merge-pathnames "gdlinit.cl" current-directory))))))
(let* ((command-args (glisp:basic-command-line-arguments))
(homedir-init? (and (not (member "-q" command-args :test #'string-equal))
(not (member "-qq" command-args :test #'string-equal))))
(current-dir-init? (not (member "-qq" command-args :test #'string-equal))))
(when (and current-dir-init? current-init-file) (load current-init-file))
(when (and homedir-init? homedir-init-file) (load homedir-init-file)))))
(let (loaded?)
(defun reset-gdl-init-files-flag! () (setf loaded? nil))
(defun set-gdl-init-files-flag! () (setf loaded? t))
(defun load-gdl-init-files (&key force?)
(unless (or (not loaded?) force?)
(let* ((user-homedir (user-homedir-pathname))
(current-directory (glisp:current-directory))
(homedir-init-file (or (probe-file (merge-pathnames ".gdlinit.cl" user-homedir))
(probe-file (merge-pathnames "gdlinit.cl" user-homedir))))
(current-init-file (when (not (equalp user-homedir current-directory))
(or (probe-file (merge-pathnames ".gdlinit.cl" current-directory))
(probe-file (merge-pathnames "gdlinit.cl" current-directory))))))
(format t "About to load homedir-init-file: ~a and current-init-file: ~a~%"
homedir-init-file current-init-file)
(let* ((command-args (glisp:basic-command-line-arguments))
(homedir-init? (and (not (member "-q" command-args :test #'string-equal))
(not (member "-qq" command-args :test #'string-equal))))
(current-dir-init? (not (member "-qq" command-args :test #'string-equal))))
(when (and current-dir-init? current-init-file) (load current-init-file))
(when (and homedir-init? homedir-init-file) (load homedir-init-file))))
(set-gdl-init-files-flag!))))
(defun quicklisp-copyright-string ()
......
......@@ -22,7 +22,7 @@
(in-package :gdl)
(defun initialize ()
(defun initialize (&key startup-banner?)
(setq glisp:*gdl-program-home* (probe-file (glisp:executable-homedir-pathname)))
(setq glisp:*gdl-home* (make-pathname :name nil
......@@ -56,7 +56,36 @@
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
(glisp:set-default-package)
(glisp:set-window-titles))
(glisp:set-window-titles)
(uiop:setup-temporary-directory)
(when (find-package :gwl) (funcall (read-from-string "gwl:renew-wserver")))
(when (find-package :pdf)
(setf (symbol-value (read-from-string "pdf::*cl-pdf-base-directory*")) glisp:*gdl-program-home*)
(setf (symbol-value (read-from-string "pdf::*afm-files-directories*"))
(list (merge-pathnames "afm/"
(symbol-value
(read-from-string "pdf::*cl-pdf-base-directory*"))))))
(when (find-package :cl-typesetting-hyphen)
(setf (symbol-value (read-from-string "cl-typesetting-hyphen::*cl-typesetting-base-directory*")) glisp:*gdl-program-home*)
(setf (symbol-value (read-from-string "cl-typesetting-hyphen::*hyphen-patterns-directory*"))
(merge-pathnames "hyphen-patterns/"
(symbol-value (read-from-string "cl-typesetting-hyphen::*cl-typesetting-base-directory*"))))
(funcall (read-from-string "cl-typesetting::initialize!")
:afm-files-directories
(symbol-value (read-from-string "pdf::*afm-files-directories*"))
:hyphen-patterns-directory
(symbol-value (read-from-string
"cl-typesetting-hyphen::*hyphen-patterns-directory*"))))
(load-gdl-init-files)
(when startup-banner? (gendl::startup-banner))
)
(defun deinitialize ()
......@@ -66,8 +95,8 @@
*quicklisp-home* nil
;; FLAG deal with ql:*quicklisp-home*
*genworks-source-home* nil
*gendl-source-home* nil
glisp:*genworks-source-home* nil
glisp:*gendl-source-home* nil
gwl::*fullchain-pem-path* nil
gwl::*privkey-pem-path* nil)
......
......@@ -211,9 +211,9 @@ Default nil."
(include-default-favicon? t)
("String. The title of the web page. Defaults to \"Genworks GDL -\"
("String. The title of the web page. Defaults to \"GendL Application -\"
.followed by the strings-for-display."
title (format nil "Genworks GDL - ~a" (the strings-for-display)))
title (format nil "GendL Application - ~a" (the strings-for-display)))
("String of valid HTML. Additional tag content to go into the page header,
if you use the default main-sheet message and just fill in your own main-sheet-body, as
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment