mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-15 15:00:24 -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-output
standard-input) standard-input)
&body body) &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 (out-stream (make-instance 'dialog-out-stream))
(with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream)) (unless clog-body
(labels ((my-debugger (condition encapsulation) (setf clog-body *clog-debug-instance*))
(handler-case (with-open-stream (in-stream (make-instance 'dialog-in-stream :clog-obj ,clog-obj :source out-stream))
(let ((restart (one-of-dialog ,clog-obj condition (compute-restarts) (labels ((my-debugger (condition encapsulation)
:title (format nil "Available Restarts~A" (handler-case
(if ,title (let ((restart (one-of-dialog ,clog-obj condition (compute-restarts)
(format nil " for ~A" ,title) :title (format nil "Available Restarts~A"
""))))) (if ,title
(when restart (format nil " for ~A" ,title)
(let ((*debugger-hook* encapsulation)) "")))))
(invoke-restart-interactively restart)))) (when restart
(end-of-file () ; no reset chosen (let ((*debugger-hook* encapsulation))
nil)))) (invoke-restart-interactively restart))))
(let* ((*standard-output* (or ,standard-output (end-of-file () ; no reset chosen
*standard-output*)) nil))))
(*standard-input* (or ,standard-input (let* ((*standard-output* (or ,standard-output
*standard-output*))
(*standard-input* (or ,standard-input
*standard-input*)) *standard-input*))
(*query-io* (make-two-way-stream in-stream out-stream)) (*query-io* (make-two-way-stream in-stream out-stream))
(*debugger-hook* (if clog-connection:*disable-clog-debugging* (*debugger-hook* (if clog-connection:*disable-clog-debugging*
*debugger-hook* *debugger-hook*
#'my-debugger))) #'my-debugger)))
,@body))))) ,@body)))))
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
;; clog-break ;; ;; clog-break ;;