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

make debugger's execute-callback nullary

Browse Source 
svn: r7107
This commit is contained in:
Greg Cooper 2007-08-17 02:02:08 +00:00
parent 33d7e3ded3
commit 5f8dcab176
1 changed files with 5 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/mztake/debug-tool.ss
View File

@ -950,16 +950,18 @@
(define current-language-settings #f) (define current-language-settings #f)
(define control-panel #f) (define control-panel #f)
(define debug? #f)
(define/public (set-mouse-over-msg msg) (define/public (set-mouse-over-msg msg)
(when (not (string=? msg (send mouse-over-message get-label))) (when (not (string=? msg (send mouse-over-message get-label)))
(send mouse-over-message set-label msg))) (send mouse-over-message set-label msg)))
(define/override execute-callback (define/override execute-callback
(opt-lambda ([debug #f]) (lambda ()
(let* ([tab (get-current-tab)]) (let* ([tab (get-current-tab)])
(if (eq? tab (send tab get-master)) (if (eq? tab (send tab get-master))
(begin (begin
(send (get-current-tab) prepare-execution debug) (send (get-current-tab) prepare-execution debug?)
(set! debug? #f)
(super execute-callback)) (super execute-callback))
(message-box (message-box
"Message from Debugger" "Message from Debugger"
@ -1006,7 +1008,7 @@
(string-constant debug-tool-button-name) (string-constant debug-tool-button-name)
(build-path (collection-path "mztake" "icons") "icon-small.png")) this) (build-path (collection-path "mztake" "icons") "icon-small.png")) this)
(make-object vertical-pane% (get-button-panel)) (make-object vertical-pane% (get-button-panel))
(lambda (button evt) (execute-callback #t)))) (lambda (button evt) (set! debug? #t) (execute-callback))))
(define pause-button (define pause-button
(instantiate button% () (instantiate button% ()