restarts pop by default on the builder panel that launched the app

This commit is contained in:
David Botton 2024-04-04 23:48:15 -04:00
parent 011e28637f
commit bee6c88eaa
4 changed files with 17 additions and 6 deletions

View file

@ -214,14 +214,17 @@
;; with-clog-debugger ;;
;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro with-clog-debugger ((clog-obj) &body body)
(defmacro with-clog-debugger ((clog-obj &key title) &body body)
"body uses a clog-gui based debugged instead of the console"
`(with-open-stream (out-stream (make-instance 'dialog-out-stream))
(with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream))
(labels ((my-debugger (condition encapsulation)
(ignore-errors
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
:title "Available Restarts")))
:title (format nil "Available Restarts~A"
(if ,title
(format nil " for ~A" ,title)
"")))))
(when restart
(let ((*debugger-hook* encapsulation))
(invoke-restart-interactively restart)))))))

View file

@ -16,6 +16,10 @@
(defvar *clog-running* nil "If clog running.")
(defvar *clog-debug* nil
"Set a debug hook that is called for every event with (event data)
that must be (funcall event data).")
(defvar *overide-static-root* nil
"Override the static-root settings. This is not normally a good idea, but if
trying to run the tutorials or demos and unable to have your local directory
@ -57,10 +61,10 @@ the same as the clog directy this overides the relative paths used in them.")
(setf (connection-data-item body "clog-path") path)
(setf (connection-data-item body "clog-body") body)
(setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock))
;; clog-debug is called for every with (event data)
;; see clog-gui:clog-gui-initialize
(setf (connection-data-item body "clog-debug") nil)
(funcall on-new-window body))
(setf (connection-data-item body "clog-debug") *clog-debug*)
(if *clog-debug*
(funcall *clog-debug* on-new-window body)
(funcall on-new-window body)))
(put-br (html-document body) "No route to on-new-window")))))
(defun initialize

View file

@ -77,6 +77,7 @@ embedded in a native template application.)"
(initialize function)
(*static-root* variable)
(*clog-port* variable)
(*clog-debug* variable)
(set-on-new-window function)
(is-running-p function)
(shutdown function)

View file

@ -57,6 +57,9 @@
(defun projects-run (panel)
(let ((val (text-value (entry-point panel))))
(unless (equal val "")
(setf clog:*clog-debug* (lambda (event data)
(with-clog-debugger (panel :title val)
(funcall event data))))
(let ((result (capture-eval (format nil "(~A)" val) :clog-obj panel
:eval-in-package "clog-user")))
(clog-web-alert (connection-body panel) "Result"