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

aleks bromfield's patch for DrOCaml

Browse Source 
svn: r4161
This commit is contained in:
Greg Cooper 2006-08-27 23:45:19 +00:00
parent d1353db107
commit e694c53738
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
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")
@ -877,12 +877,16 @@
(inner (void) on-tab-change old new))
(define/public (check-current-language-for-debugger)
(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))))
(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)))))
(send (get-button-panel) change-children
(lambda (_)
@ -891,6 +895,7 @@
; 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)