From bee6c88eaafde8f3fd80d5cc6fc3440c75f94acb Mon Sep 17 00:00:00 2001
From: David Botton <david@botton.com>
Date: Thu, 4 Apr 2024 23:48:15 -0400
Subject: [PATCH] restarts pop by default on the builder panel that launched
 the app

---
 source/clog-gui.lisp             |  7 +++++--
 source/clog-system.lisp          | 12 ++++++++----
 source/clog.lisp                 |  1 +
 tools/clog-builder-projects.lisp |  3 +++
 4 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp
index fa3b7a5..1cf4c80 100644
--- a/source/clog-gui.lisp
+++ b/source/clog-gui.lisp
@@ -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)))))))
diff --git a/source/clog-system.lisp b/source/clog-system.lisp
index f776c9f..1ee1d33 100644
--- a/source/clog-system.lisp
+++ b/source/clog-system.lisp
@@ -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
diff --git a/source/clog.lisp b/source/clog.lisp
index 44d2a06..027bfce 100644
--- a/source/clog.lisp
+++ b/source/clog.lisp
@@ -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)
diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp
index 445a6bb..5d902c1 100644
--- a/tools/clog-builder-projects.lisp
+++ b/tools/clog-builder-projects.lisp
@@ -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"