From 79f537d50c6b3b025185765e50c6859e41231492 Mon Sep 17 00:00:00 2001 From: Carl Eastlund Date: Mon, 1 Feb 2010 20:39:46 +0000 Subject: [PATCH] Updated the macro stepper to detect steppable languages via a "capability". svn: r17932 --- .../private/language-configuration.ss | 21 +++++++++--- collects/drscheme/private/module-language.ss | 2 ++ collects/macro-debugger/capability.ss | 7 ++++ collects/macro-debugger/tool.ss | 34 ++++--------------- collects/swindle/tool.ss | 6 ++++ 5 files changed, 39 insertions(+), 31 deletions(-) create mode 100644 collects/macro-debugger/capability.ss diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index 6d6eeaecc3..b4e127dace 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -6,6 +6,7 @@ scheme/string scheme/list "drsig.ss" + macro-debugger/capability string-constants mred framework @@ -1332,6 +1333,15 @@ (define-struct (simple-settings+assume drscheme:language:simple-settings) (no-redef?)) (define simple-settings+assume->vector (make-->vector simple-settings+assume)) + (define (macro-stepper-mixin %) + (class % + (super-new) + (define/augment (capability-value key) + (cond + [(eq? key macro-stepper-capability-key) #t] + [else (inner (drscheme:language:get-capability-default key) + capability-value key)])))) + (define (assume-mixin %) (class % (define/override (default-settings) @@ -1445,7 +1455,9 @@ (cond [(eq? key 'drscheme:autocomplete-words) (get-all-manual-keywords)] - [else (drscheme:language:get-capability-default key)])) + [else (inner + (drscheme:language:get-capability-default key) + capability-value key)])) (define/override (create-executable setting parent program-filename) (let ([executable-fn (drscheme:language:put-executable @@ -1488,7 +1500,7 @@ (list -200 3) #t (string-constant pretty-big-scheme-one-line-summary) - (λ (%) (assume-mixin (add-errortrace-key-mixin %))))) + (λ (%) (macro-stepper-mixin (assume-mixin (add-errortrace-key-mixin %)))))) (add-language (make-simple '(lib "r5rs/lang.ss") "plt:r5rs" @@ -1497,7 +1509,7 @@ (list -200 -1000) #f (string-constant r5rs-one-line-summary) - (lambda (%) (r5rs-mixin (assume-mixin (add-errortrace-key-mixin %)))))) + (lambda (%) (r5rs-mixin (macro-stepper-mixin (assume-mixin (add-errortrace-key-mixin %))))))) (add-language (make-simple 'mzscheme @@ -1527,7 +1539,8 @@ (define/augment (capability-value v) (case v [(drscheme:check-syntax-button) #f] - [else (drscheme:language:get-capability-default v)])) + [else (inner (drscheme:language:get-capability-default v) + capability-value v)])) (super-new))) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index ff09b119ed..ebefb4a619 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -13,6 +13,7 @@ framework string-constants planet/config + macro-debugger/capability "drsig.ss" "rep.ss") @@ -85,6 +86,7 @@ (cond [(eq? key 'drscheme:autocomplete-words) (drscheme:language-configuration:get-all-manual-keywords)] + [(eq? key macro-stepper-capability-key) #t] [else (drscheme:language:get-capability-default key)])) ;; config-panel : as in super class diff --git a/collects/macro-debugger/capability.ss b/collects/macro-debugger/capability.ss new file mode 100644 index 0000000000..506f1afbbc --- /dev/null +++ b/collects/macro-debugger/capability.ss @@ -0,0 +1,7 @@ +#lang scheme/base + +(provide macro-stepper-capability-key) + +(define macro-stepper-capability-key + (string->uninterned-symbol "Enable Macro Stepper")) + diff --git a/collects/macro-debugger/tool.ss b/collects/macro-debugger/tool.ss index 3dceaa0f33..7b864cc291 100644 --- a/collects/macro-debugger/tool.ss +++ b/collects/macro-debugger/tool.ss @@ -8,6 +8,7 @@ drscheme/tool mrlib/switchable-button string-constants + "capability.ss" "model/trace.ss" "model/deriv.ss" "model/deriv-util.ss" @@ -16,12 +17,7 @@ "view/stepper.ss" "view/prefs.ss") -(provide tool@ - language/macro-stepper<%>) - -(define language/macro-stepper<%> - (interface () - enable-macro-stepper?)) +(provide tool@) (define-local-member-name allow-macro-stepper?) (define-local-member-name run-macro-stepper) @@ -85,13 +81,10 @@ (export drscheme:tool-exports^) (define (phase1) - (drscheme:language:extend-language-interface - language/macro-stepper<%> - (mixin (drscheme:language:language<%>) (language/macro-stepper<%>) - (inherit get-language-position) - (define/public (enable-macro-stepper?) - (macro-stepper-works-for? (get-language-position))) - (super-new)))) + (drscheme:language:register-capability + macro-stepper-capability-key + boolean? + #f)) (define (phase2) (void)) (define drscheme-eventspace (current-eventspace)) @@ -170,7 +163,7 @@ (let ([lang (drscheme:language-configuration:language-settings-language (send (get-definitions-text) get-next-settings))]) - (send lang enable-macro-stepper?))) + (send lang capability-value macro-stepper-capability-key))) (define/private (enable/disable-stuff enable?) (if enable? @@ -304,19 +297,6 @@ (send director add-trace events)) )) - ;; Borrowed from mztake/debug-tool.ss - - (define (macro-stepper-works-for? lang) - (let ([main-group (car lang)] - [second (and (pair? (cdr lang)) (cadr lang))] - [third (and (pair? (cdr lang)) (pair? (cddr lang)) (caddr lang))]) - (or (equal? main-group (string-constant module-language-name)) - (and (equal? main-group (string-constant legacy-languages)) - (or (member second - (list (string-constant r5rs-language-name) - "Swindle" - (string-constant pretty-big-scheme)))))))) - ;; Macro debugger code (drscheme:get/extend:extend-unit-frame diff --git a/collects/swindle/tool.ss b/collects/swindle/tool.ss index dd9fa09615..ee8673c16a 100644 --- a/collects/swindle/tool.ss +++ b/collects/swindle/tool.ss @@ -9,6 +9,7 @@ mzlib/list mred net/sendurl + macro-debugger/capability string-constants) (provide tool@) @@ -34,6 +35,11 @@ v (namespace-syntax-introduce v))))) (super-instantiate ())))) + (define/augment (capability-value key) + (cond + [(eq? key macro-stepper-capability-key) #t] + [else (inner (drscheme:language:get-capability-default key) + capability-value key)])) (define/override (use-namespace-require/copy?) #t) (define/override (default-settings) (drscheme:language:make-simple-settings