mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

clog-builder-probe

Browse source
This commit is contained in:
David Botton 2024-05-28 17:20:06 -04:00
parent 22e980490c
commit 13077e6928
4 changed files with 102 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

1
clog.asd vendored
View file

@ -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")

1
source/clog-helpers.lisp
View file

@ -19,6 +19,7 @@
:clog-open
:add-supported-controls
:control-info
:clog-builder-probe
:clog-db-admin))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

92
tools/clog-builder-probe.lisp Normal file
View file

@ -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))))))

11
tools/clog-builder.lisp
View file

@ -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))