Updated the macro stepper to detect steppable languages via a "capability".

svn: r17932

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)))
     

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

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"))
+

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

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