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-probe

Browse source
This commit is contained in:
David Botton 2024-05-20 21:48:26 -04:00
parent 1b9cc4304a
commit 5333d6f039
3 changed files with 66 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

58
source/clog-gui.lisp
View file

@ -96,6 +96,7 @@
(dialog-in-stream class)
(dialog-out-stream class)
(clog-break function)
(clog-probe function)
(*clog-debug-instance* variable)
"CLOG-GUI - Look and Feel"
@ -222,7 +223,10 @@
;; with-clog-debugger ;;
;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro with-clog-debugger ((clog-obj &key title standard-output) &body body)
(defmacro with-clog-debugger ((clog-obj &key title
standard-output
standard-input)
&body body)
"body uses a clog-gui based debugger 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))
@ -240,6 +244,8 @@
nil))))
(let* ((*standard-output* (or ,standard-output
*standard-output*))
(*standard-input* (or ,standard-input
*standard-input*))
(*query-io* (make-two-way-stream in-stream out-stream))
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
*debugger-hook*
@ -265,10 +271,60 @@
(lambda (result)
(unless result
(break)))
:width 400
:time-out 600
:modal modal
:title "clog-break in execution")))
;;;;;;;;;;;;;;;;
;; clog-probe ;;
;;;;;;;;;;;;;;;;
(defmacro clog-probe (symbol &key clog-body
(symbol-title "")
(time-out 600)
(modal t))
"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
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
always nil."
`(let ((body (or ,clog-body
*clog-debug-instance*)))
(when (validp body)
(if ,time-out
(input-dialog body
(format nil "Probe in thread ~A : ~A New Value?"
(bordeaux-threads:thread-name
(bordeaux-threads:current-thread))
,symbol)
(lambda (result)
(when result
(setf ,symbol (eval (read-from-string result)))))
:time-out ,time-out
:width 400
:height 300
:modal ,modal
:title (format nil "clog-probe ~A" ,symbol-title))
(bordeaux-threads:make-thread
(lambda ()
(loop
(when (eq (input-dialog body
(format nil "Probe result ~A - New Value or :q to quit?"
,symbol)
(lambda (result)
(when result
(if (equalp result ":q")
:q
(setf ,symbol (eval (read-from-string result))))))
:time-out 999
:width 400
:height 300
:modal nil
:title (format nil "clog-probe ~A" ,symbol-title))
:q)
(return))))
:name (format nil "clog-probe ~A" ,symbol-title))))))
;;;;;;;;;;;;;;;;;;;;;;;;;
;; clog-gui-initialize ;;

3
tools/clog-builder-project-tree.lisp
View file

@ -86,7 +86,8 @@
(setf entry-point result)
(setf clog:*clog-debug*
(lambda (event data)
(with-clog-debugger (panel :standard-output (stdout app))
(with-clog-debugger (panel :standard-output (stdout app)
:standard-input (stdin app))
(funcall event data))))
(capture-eval result
:clog-obj obj

7
tools/clog-builder.lisp
View file

@ -28,6 +28,10 @@ clog-builder window.")
:accessor stdout
:initform nil
:documentation "The standard-output for this instance")
(stdin
:accessor stdin
:initform nil
:documentation "The standard-input for this instance")
(copy-buf
:accessor copy-buf
:initform nil
@ -332,6 +336,9 @@ clog-builder window.")
(setf (stdout app) (if clog-connection:*disable-clog-debugging*
*standard-output*
(make-instance 'console-out-stream :clog-obj body)))
(setf (stdin app) (if clog-connection:*disable-clog-debugging*
*standard-input*
(make-instance 'console-in-stream :clog-obj body)))
(clog-gui-initialize body :use-clog-debugger t :standard-output (stdout app))
(add-class body *builder-window-desktop-class*)
(with-clog-debugger (body :standard-output (stdout app))