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

add :continue for break

Browse source
This commit is contained in:
David Botton 2024-05-22 10:53:09 -04:00
parent f62ad6fdae
commit 5d3945daed
1 changed files with 18 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

34
source/clog-gui.lisp
View file

@ -257,24 +257,26 @@
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
(defun clog-break (&key clog-body run (modal t)) (defun clog-break (&key clog-body run (modal t))
"Stop execution, funcall run with CLOG-BODY. If CLOG-BODY not set use "Stop execution, funcall RUN with CLOG-BODY if set, if run returns :continue,
*clog-debug-instance*. Then confirm continue execution on current thread." the execution continues. If CLOG-BODY not set use *clog-debug-instance*. Then
confirm continue execution on current thread or (break)."
(unless clog-body (unless clog-body
(setf clog-body *clog-debug-instance*)) (setf clog-body *clog-debug-instance*))
(when run (let ((continue (when run
(funcall run clog-body)) (funcall run clog-body))))
(when (validp clog-body) (when (and (validp clog-body)
(confirm-dialog clog-body (not (eq continue :continue)))
(format nil "Continue thread ~A ?" (confirm-dialog clog-body
(bordeaux-threads:thread-name (format nil "Continue thread ~A ?"
(bordeaux-threads:current-thread))) (bordeaux-threads:thread-name
(lambda (result) (bordeaux-threads:current-thread)))
(unless result (lambda (result)
(break))) (unless result
:width 400 (break)))
:time-out 600 :width 400
:modal modal :time-out 600
:title "clog-break in execution"))) :modal modal
:title "clog-break in execution"))))
;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;
;; clog-probe ;; ;; clog-probe ;;