auto-probe added to clog-probe

This commit is contained in:
David Botton 2024-05-21 15:52:37 -04:00
parent a033cce0b6
commit 954f1d8062

View file

@ -281,18 +281,20 @@
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
(defmacro clog-probe (symbol &key clog-body (defmacro clog-probe (symbol &key clog-body
(symbol-title "") (title "")
(time-out 600) (time-out 600)
auto-probe
(modal t)) (modal t))
"Pause thread of execution for time-out numnber of seconds or nil to not "Pause thread of execution for time-out numnber of seconds or nil to not
block execution, display symbol's value, value is changed if OK pressed at block execution, display symbol's value, value is changed if OK pressed at
the moment pressed. When time-out is nil, :q quits the probe and cancel the moment pressed. When time-out is nil, :q quits the probe and cancel
repeats the probe with out changing value. When time-out is nil modal is repeats the probe with out changing value. When time-out is nil modal is
always nil." always nil. If auto-probe is set, modal and time-out is set to nil and the
probe is run again in auto-probe seconds."
`(let ((body (or ,clog-body `(let ((body (or ,clog-body
*clog-debug-instance*))) *clog-debug-instance*)))
(when (validp body) (when (validp body)
(if ,time-out (if (and ,time-out (not ,auto-probe))
(input-dialog body (input-dialog body
(format nil "Probe in thread ~A : ~A New Value?" (format nil "Probe in thread ~A : ~A New Value?"
(bordeaux-threads:thread-name (bordeaux-threads:thread-name
@ -305,7 +307,7 @@ always nil."
:width 400 :width 400
:height 300 :height 300
:modal ,modal :modal ,modal
:title (format nil "clog-probe ~A" ,symbol-title)) :title (format nil "clog-probe ~A" ,title))
(bordeaux-threads:make-thread (bordeaux-threads:make-thread
(lambda () (lambda ()
(loop (loop
@ -317,14 +319,14 @@ always nil."
(if (equalp result ":q") (if (equalp result ":q")
:q :q
(setf ,symbol (eval (read-from-string result)))))) (setf ,symbol (eval (read-from-string result))))))
:time-out 999 :time-out (or ,auto-probe 999)
:width 400 :width 400
:height 300 :height 300
:modal nil :modal nil
:title (format nil "clog-probe ~A" ,symbol-title)) :title (format nil "clog-probe ~A" ,title))
:q) :q)
(return)))) (return))))
:name (format nil "clog-probe ~A" ,symbol-title)))))) :name (format nil "clog-probe ~A" ,title))))))
;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;
;; clog-gui-initialize ;; ;; clog-gui-initialize ;;