From e694c53738de4919b2245bc8b7773a914b1d9f15 Mon Sep 17 00:00:00 2001 From: Greg Cooper Date: Sun, 27 Aug 2006 23:45:19 +0000 Subject: [PATCH] aleks bromfield's patch for DrOCaml svn: r4161 --- collects/mztake/debug-tool.ss | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/collects/mztake/debug-tool.ss b/collects/mztake/debug-tool.ss index b5117f4b72..149eb10e29 100644 --- a/collects/mztake/debug-tool.ss +++ b/collects/mztake/debug-tool.ss @@ -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)