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

fixed a stupid bug in handler for right-clicking on program counter

Browse Source 
(introduced by an unsound refactoring)

svn: r4189
This commit is contained in:
Greg Cooper 2006-08-30 03:57:43 +00:00
parent d9ac9270a8
commit 690005c9b2
1 changed files with 13 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,7 +5,7 @@
;(lib "math.ss")
(lib "class.ss")
(lib "unitsig.ss")
(lib "contract.ss")
;(lib "contract.ss")
(lib "mred.ss" "mred")
(prefix drscheme:arrow: (lib "arrow.ss" "drscheme"))
(lib "tool.ss" "drscheme")
@ -277,10 +277,12 @@
(if (and pc (= pos pc))
(let* ([stat (send (get-tab) get-break-status)]
[f (get-top-level-window)]
[rendered-value (if (= 2 (length stat))
(render (cadr stat))
(format "~a" (cons 'values
(map (lambda (v) (render v)) (rest stat)))))])
[rendered-value (if (cons? stat)
(if (= 2 (length stat))
(render (cadr stat))
(format "~a" (cons 'values
(map (lambda (v) (render v)) (rest stat)))))
"")])
(when (cons? stat)
#;(send (make-object menu-item%
(clean-status (format "expr -> ~a" rendered-value))
@ -877,16 +879,12 @@
(inner (void) on-tab-change old new))
(define/public (check-current-language-for-debugger)
(let* ([settings (send (get-definitions-text) get-next-settings)]
[lang (drscheme:language-configuration:language-settings-language settings)]
[visible? (and (send lang capability-value 'mztake:debug-button)
(not (debugger-does-not-work-for?
(extract-language-level settings))))])
(if visible?
(unless (send debug-button is-shown?)
(send (send debug-button get-parent) add-child debug-button))
(when (send debug-button is-shown?)
(send (send debug-button get-parent) delete-child debug-button)))))
(if (debugger-does-not-work-for? (extract-language-level
(send (get-definitions-text) get-next-settings)))
(when (send debug-button is-shown?)
(send (send debug-button get-parent) delete-child debug-button))
(unless (send debug-button is-shown?)
(send (send debug-button get-parent) add-child debug-button))))
(send (get-button-panel) change-children
(lambda (_)
@ -895,7 +893,6 @@
; hide debug button if it's not supported for the initial language:
(check-current-language-for-debugger)))
(drscheme:language:register-capability 'mztake:debug-button (flat-contract boolean?) #t)
(drscheme:get/extend:extend-definitions-text debug-definitions-text-mixin)
(drscheme:get/extend:extend-interactions-text debug-interactions-text-mixin)
(drscheme:get/extend:extend-unit-frame debug-unit-frame-mixin)