From 13077e6928b5a52b66a23d6b8bf4a1510b8c78e6 Mon Sep 17 00:00:00 2001 From: David Botton Date: Tue, 28 May 2024 17:20:06 -0400 Subject: [PATCH] clog-builder-probe --- clog.asd | 1 + source/clog-helpers.lisp | 1 + tools/clog-builder-probe.lisp | 92 +++++++++++++++++++++++++++++++++++ tools/clog-builder.lisp | 11 +++-- 4 files changed, 102 insertions(+), 3 deletions(-) create mode 100644 tools/clog-builder-probe.lisp diff --git a/clog.asd b/clog.asd index 6a1df1c..603917e 100644 --- a/clog.asd +++ b/clog.asd @@ -95,6 +95,7 @@ (:file "clog-builder-sys-browser") (:file "clog-builder-project-tree") (:file "clog-builder-dir-tree") + (:file "clog-builder-probe") (:file "clog-builder-repl") (:file "clog-builder-shell") (:file "clog-builder-images") diff --git a/source/clog-helpers.lisp b/source/clog-helpers.lisp index 6d11708..881a989 100644 --- a/source/clog-helpers.lisp +++ b/source/clog-helpers.lisp @@ -19,6 +19,7 @@ :clog-open :add-supported-controls :control-info + :clog-builder-probe :clog-db-admin)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/tools/clog-builder-probe.lisp b/tools/clog-builder-probe.lisp new file mode 100644 index 0000000..bd9592a --- /dev/null +++ b/tools/clog-builder-probe.lisp @@ -0,0 +1,92 @@ +(in-package :clog-tools) + +(defun on-probe-panel (obj) + (let ((app (connection-data-item obj "builder-app-data"))) + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window obj :title "CLOG Probe Table" + :width 300 + :has-pinner t + :keep-on-top t + :client-movement *client-side-movement*))) + (create-div (window-content win) :style "left:0px;right:0px" :class "w3-tiny w3-center" + :content "use CLOG-TOOL:CLOG-BUILDER-PROBE to add probes") + (setf (probe-win app) win) + (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "") + (set-on-window-move win (lambda (obj) + (setf (height obj) (height obj)))) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (setf (probe-win app) nil))) + (set-on-click (create-span (window-icon-area win) :content "← " :auto-place :top) + (lambda (obj) + (declare (ignore obj)) + (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "")))))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;; clog-builder-probe ;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defmacro clog-builder-probe (symbol &key clog-body + (title "") + auto-probe) + "Display symbol's value in Probe Table in Builder, value is changed when OK +pressed. Probe again in auto-probe seconds. If not tile is set, the symbol is +used for title." + `(let* ((body (or ,clog-body + *clog-debug-instance*)) + (app (connection-data-item body "builder-app-data")) + (title (if (equal ,title "") + (format nil "~s" ',symbol) + ,title)) + (freq ,auto-probe) + probe + entry) + (unless (probe-win app) + (on-probe-panel body)) + (setf probe (create-div (window-content (probe-win app)) + :style "border-style:solid;overflow:auto;" + :class "w3-small")) + (setf entry (create-div probe + :class "w3-small;")) + (flet ((refresh () + (let ((value (format nil "~A" ,symbol))) + (setf (text entry) (format nil "~A : ~A" + title + value))))) + (refresh) + (set-on-click (create-button probe :content "Refresh") + (lambda (obj) + (declare (ignore obj)) + (refresh))) + (set-on-click (create-button probe :content "Change") + (lambda (obj) + (declare (ignore obj)) + (input-dialog body (format nil "New value for ~A?" title) + (lambda (result) + (when (and result + (not (equal result ""))) + (setf ,symbol (eval (read-from-string result)))) + (refresh))))) + (set-on-click (create-button probe :content "Inspect") + (lambda (obj) + (declare (ignore obj)) + (on-open-console body) + (let ((*standard-input* (make-instance 'console-in-stream :clog-obj body))) + (inspect ,symbol)))) + (set-on-click (create-button probe :content "Remove") + (lambda (obj) + (declare (ignore obj)) + (setf (hiddenp probe) t))) + (when freq + (bordeaux-threads:make-thread + (lambda () + (loop + (sleep freq) + (when (or (not (validp probe)) + (hiddenp probe) + (not (visiblep probe))) + (return)) + (refresh))) + :name (format nil "clog-builder-probe ~A" title)))))) + diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index c4936f8..2aefe54 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -71,6 +71,10 @@ clog-builder window.") :accessor project-tree-win :initform nil :documentation "Project Tree window") + (probe-win + :accessor probe-win + :initform nil + :documentation "Probe window") (project-win :accessor project-win :initform nil @@ -396,12 +400,13 @@ clog-builder window.") (create-gui-menu-item src :content "New System Source Browser" :on-click 'on-new-sys-browser) (create-gui-menu-item src :content "New Loaded ASDF System Browser" :on-click 'on-new-asdf-browser) ;; Menu -> Tools + (create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl) + (create-gui-menu-item tools :content "CLOG Builder Console" :on-click 'on-open-console) + (create-gui-menu-item tools :content "CLOG Probe Panel" :on-click 'on-probe-panel) + (create-gui-menu-item tools :content "OS Pseudo Shell" :on-click 'on-shell) (create-gui-menu-item tools :content "List Callers" :on-click 'on-show-callers) (create-gui-menu-item tools :content "List Callees" :on-click 'on-show-callees) (create-gui-menu-item tools :content "Thread Viewer" :on-click 'on-show-thread-viewer) - (create-gui-menu-item tools :content "CLOG Builder REPL" :on-click 'on-repl) - (create-gui-menu-item tools :content "CLOG Builder Console" :on-click 'on-open-console) - (create-gui-menu-item tools :content "OS Pseudo Shell" :on-click 'on-shell) (create-gui-menu-item tools :content "Copy/Cut History" :on-click 'on-show-copy-history-win) (unless *clogframe-mode* (create-gui-menu-item tools :content "Image to HTML Data" :on-click 'on-image-to-data))