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 "