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

allow nil for clog-obj on with-clog-debugger

Browse source
This commit is contained in:
David Botton 2024-05-29 22:01:19 -04:00
parent 977364eff2
commit b5c5e52bd4
1 changed files with 25 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

47
source/clog-gui.lisp
View file

@ -228,30 +228,33 @@
standard-output
standard-input)
&body body)
"body uses a clog-gui based debugger instead of the console"
"body uses a clog-gui based debugger instead of the console, if clog-obj is
nil uses *clog-debug-instance*"
`(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)
(handler-case
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
:title (format nil "Available Restarts~A"
(if ,title
(format nil " for ~A" ,title)
"")))))
(when restart
(let ((*debugger-hook* encapsulation))
(invoke-restart-interactively restart))))
(end-of-file () ; no reset chosen
nil))))
(let* ((*standard-output* (or ,standard-output
*standard-output*))
(*standard-input* (or ,standard-input
(unless clog-body
(setf clog-body *clog-debug-instance*))
(with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream))
(labels ((my-debugger (condition encapsulation)
(handler-case
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
:title (format nil "Available Restarts~A"
(if ,title
(format nil " for ~A" ,title)
"")))))
(when restart
(let ((*debugger-hook* encapsulation))
(invoke-restart-interactively restart))))
(end-of-file () ; no reset chosen
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*
#'my-debugger)))
,@body)))))
(*query-io* (make-two-way-stream in-stream out-stream))
(*debugger-hook* (if clog-connection:*disable-clog-debugging*
*debugger-hook*
#'my-debugger)))
,@body)))))
;;;;;;;;;;;;;;;;
;; clog-break ;;