mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-07 11:10:18 -08:00
Code Issues Projects Releases Wiki Activity

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

7
source/clog-gui.lisp
View file

@ -214,14 +214,17 @@
;; with-clog-debugger ;; ;; 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" "body uses a clog-gui based debugged instead of the console"
`(with-open-stream (out-stream (make-instance 'dialog-out-stream)) `(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)) (with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream))
(labels ((my-debugger (condition encapsulation) (labels ((my-debugger (condition encapsulation)
(ignore-errors (ignore-errors
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts) (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 (when restart
(let ((*debugger-hook* encapsulation)) (let ((*debugger-hook* encapsulation))
(invoke-restart-interactively restart))))))) (invoke-restart-interactively restart)))))))

12
source/clog-system.lisp
View file

@ -16,6 +16,10 @@
(defvar *clog-running* nil "If clog running.") (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 (defvar *overide-static-root* nil
"Override the static-root settings. This is not normally a good idea, but if "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 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-path") path)
(setf (connection-data-item body "clog-body") body) (setf (connection-data-item body "clog-body") body)
(setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock)) (setf (connection-data-item body "clog-sync") (bordeaux-threads:make-lock))
;; clog-debug is called for every with (event data) (setf (connection-data-item body "clog-debug") *clog-debug*)
;; see clog-gui:clog-gui-initialize (if *clog-debug*
(setf (connection-data-item body "clog-debug") nil) (funcall *clog-debug* on-new-window body)
(funcall on-new-window body)) (funcall on-new-window body)))
(put-br (html-document body) "No route to on-new-window"))))) (put-br (html-document body) "No route to on-new-window")))))
(defun initialize (defun initialize

1
source/clog.lisp
View file

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

3
tools/clog-builder-projects.lisp
View file

@ -57,6 +57,9 @@
(defun projects-run (panel) (defun projects-run (panel)
(let ((val (text-value (entry-point panel)))) (let ((val (text-value (entry-point panel))))
(unless (equal val "") (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 (let ((result (capture-eval (format nil "(~A)" val) :clog-obj panel
:eval-in-package "clog-user"))) :eval-in-package "clog-user")))
(clog-web-alert (connection-body panel) "Result" (clog-web-alert (connection-body panel) "Result"