diff --git a/clog.asd b/clog.asd index 44f015f..712003c 100644 --- a/clog.asd +++ b/clog.asd @@ -14,7 +14,6 @@ :components ((:file "clog-connection") (:file "clog") (:file "clog-docs") - (:file "clog-system") (:file "clog-utilities") (:file "clog-base") (:file "clog-element") @@ -27,6 +26,7 @@ (:file "clog-location") (:file "clog-navigator") (:file "clog-body") + (:file "clog-system") (:file "clog-gui") (:file "clog-helpers"))) diff --git a/source/clog-base.lisp b/source/clog-base.lisp index e78ec34..b3102f7 100644 --- a/source/clog-base.lisp +++ b/source/clog-base.lisp @@ -412,7 +412,8 @@ result or if time out DEFAULT-ANSWER (Private)")) clog-obj that will persist regardless of thread. The event hooks are stored in this string based hash in the format of: \"html-id:event-name\" => #'event-handler. clog-* keys are reserved -for internal use of clog.")) +for internal use of clog. The key \"clog-body\" is set to the +clog-body of this connection.")) (defmethod connection-data ((obj clog-obj)) (cc:get-connection-data (connection-id obj))) diff --git a/source/clog-system.lisp b/source/clog-system.lisp index dff7af6..49b5fa6 100644 --- a/source/clog-system.lisp +++ b/source/clog-system.lisp @@ -35,8 +35,10 @@ same as the clog directy this overides the relative paths used in them.") (on-new-window (or (gethash path *url-to-on-new-window*) (gethash "default" *url-to-on-new-window*) (gethash "/" *url-to-on-new-window*)))) - (if on-new-window - (funcall on-new-window body) + (if on-new-window + (progn + (setf (connection-data-item body "clog-body") body) + (funcall on-new-window body)) (put-br (html-document body) "No route to on-new-window"))))) (defun initialize diff --git a/tools/clog-db-admin.lisp b/tools/clog-db-admin.lisp index d04d961..fd848cd 100644 --- a/tools/clog-db-admin.lisp +++ b/tools/clog-db-admin.lisp @@ -4,12 +4,46 @@ (in-package :clog-tools) -(defclass app-data () ()) +(defclass app-data () + ((body + :accessor body + :documentation "Top level access to browser window"))) + +(defun on-help-about (obj) + (let* ((app (connection-data-item obj "app-data")) + (about (create-gui-window obj + :title "About" + :content "
+
+
CLOG
+
The Common Lisp Omnificent GUI
+

CLOG DB Admin
+
(c) 2021 - David Botton

" + :left (- (/ (inner-width (window (body app))) 2.0) 100) + :top (- (/ (inner-height (window (body app))) 2.0) 100) + :width 200 + :height 200))) + (print (- (/ (inner-width (window (body app))) 2.0) 100)) + (set-on-window-can-size about (lambda (obj) + (declare (ignore obj))())))) (defun on-new-window (body) (let ((app (make-instance 'app-data))) - (setf (connection-data-item body "app-data") app)) - (create-div body :content "Hello") + (setf (connection-data-item body "app-data") app) + (setf (body app) body)) + (setf (title (html-document body)) "CLOG DB Admin") + (clog-gui-initialize body) + (add-class body "w3-blue-grey") + (let* ((menu (create-gui-menu-bar body)) + (tmp (create-gui-menu-icon menu :on-click #'on-help-about)) + (file (create-gui-menu-drop-down menu :content "File")) + (win (create-gui-menu-drop-down menu :content "Window")) + (tmp (create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)) + (tmp (create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)) + (tmp (create-gui-menu-window-select win)) + (help (create-gui-menu-drop-down menu :content "Help")) + (tmp (create-gui-menu-item help :content "About" :on-click #'on-help-about)) + (tmp (create-gui-menu-full-screen menu)))) (run body)) (defun clog-db-admin () diff --git a/tutorial/22-tutorial.lisp b/tutorial/22-tutorial.lisp index 6157dd4..9fd40d3 100644 --- a/tutorial/22-tutorial.lisp +++ b/tutorial/22-tutorial.lisp @@ -52,8 +52,9 @@ (window-keep-on-top win) (create-div win :content "I am pinned"))) -(defun on-help-about (body) - (let* ((about (create-gui-window body +(defun on-help-about (obj) + (let* ((body (connection-data-item obj "clog-body")) + (about (create-gui-window obj :title "About" :content "
@@ -61,6 +62,8 @@
The Common Lisp Omnificent GUI

Tutorial 22
(c) 2021 - David Botton

" + :left (- (/ (inner-width (window body)) 2.0) 100) + :top (- (/ (inner-height (window body)) 2.0) 100) :width 200 :height 200))) (set-on-window-can-size about (lambda (obj)