suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added a separate debugger callback, instead of overriding execute-callback

Browse Source 
svn: r10695
This commit is contained in:
Robby Findler 2008-07-09 11:30:26 +00:00
parent e957b25ff1
commit f65e0ffeb1
1 changed files with 26 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
collects/gui-debugger/debug-tool.ss
View File

@ -1055,20 +1055,31 @@
(when (not (string=? msg (send mouse-over-message get-label)))
(send mouse-over-message set-label msg)))
(define/override execute-callback
(lambda ()
(let* ([tab (get-current-tab)])
(define/public (debug-callback)
(let ([tab (get-current-tab)])
(cond
[(eq? tab (send tab get-master))
(set! debug? #t)
(send (get-current-tab) prepare-execution debug?)
(set! debug? #f)
(execute-callback)]
[else
(already-debugging tab)])))
(define/override (execute-callback)
(let ([tab (get-current-tab)])
(cond
[(eq? tab (send tab get-master))
(super execute-callback)]
[else
(already-debugging tab)])))
(define/private (already-debugging tab)
(message-box
"Message from Debugger"
"Debugger"
(format "This file is involved in a debugging session. To run/debug this file, finish the session for ~a and close or re-run it."
(send (send (send tab get-master) get-defs) get-filename/untitled-name))
this '(ok))]))))
this '(ok)))
(define expr-positions empty)
(define expr-lengths empty)
@ -1263,7 +1274,7 @@
(label (string-constant debug-tool-button-name))
(bitmap debug-bitmap)
(parent (make-object vertical-pane% (get-button-panel)))
(callback (λ (button) (set! debug? #t) (execute-callback)))))
(callback (λ (button) (debug-callback)))))
(inherit register-toolbar-button)
(register-toolbar-button debug-button)