.

svn: r107

collects/mztake/debugger-tool.ss

@@ -2,7 +2,7 @@
   (require (lib "contract.ss")
            (lib "tool.ss" "drscheme")
            (lib "mred.ss" "mred")  
-           (prefix frame: (lib "framework.ss" "framework"))
+           (lib "framework.ss" "framework")
            (lib "unitsig.ss")
            (lib "class.ss")
            (lib "list.ss"))
@@ -14,7 +14,9 @@
       (import drscheme:tool^)
       
       (define (phase1) (void))
-      (define (phase2) (void))
+      (define (phase2)
+        (print ((drscheme:language:get-default-mixin)) #;(drscheme:language:get-language-extensions)
+               #;(preferences:get (drscheme:language-configuration:get-settings-preferences-symbol))))
       
       (define debugger-bitmap
         (drscheme:unit:make-bitmap
@@ -41,7 +43,45 @@
                   (message-box "Syntax Offset"
                                (format "Line: ~a~nColumn: ~a~nOffset: ~a" (add1 line) column pos))))))
           
+          (define test-button
+            (make-object button%
+              "test-me"
+              (get-button-panel)
+              (lambda (button evt)
+                ((lambda (iter)
+                   (let* ([lang-settings
+                           (preferences:get
+                            (drscheme:language-configuration:get-settings-preferences-symbol))]
+                          [lang (drscheme:language-configuration:language-settings-language lang-settings)]
+                          [settings (drscheme:language-configuration:language-settings-settings lang-settings)])
+                     (drscheme:eval:expand-program
+                      (drscheme:language:make-text/pos (get-definitions-text)
+                                                       0
+                                                       (send (get-definitions-text) last-position))
+                      lang-settings
+                      #f
+                      (lambda ()
+                        ;TODO error handler for exceptions
+                        (error-value->string-handler
+                         (lambda (val len)
+                           (let ([sp (open-output-string)])
+                             (send lang render-value val settings sp #f)
+                             (let ([str (get-output-string sp)])
+                               (if ((string-length str) . <= . len)
+                                   str
+                                   (string-append (substring str 0 (max 0 (- len 3))) "..."))))))
+                        (drscheme:teachpack:install-teachpacks 
+                         (preferences:get 'drscheme:teachpacks)))
+                      void ; kill
+                      iter)))
+                 (lambda (stx thunk)
+                   (unless (eof-object? stx)
+                     (eval stx)
+                     (printf ">> ~a~n~n" (syntax-object->datum stx))
+                     (thunk)))))))
+          
           (send (get-button-panel) change-children
-            (lambda (_) (cons debugger-button (remq debugger-button _))))))
+            (lambda (_) (cons test-button (remq test-button 
+                                                (cons debugger-button (remq debugger-button _))))))))
       
-      (drscheme:get/extend:extend-unit-frame debugger-unit-frame-mixin))))
+      (drscheme:get/extend:extend-unit-frame debugger-unit-frame-mixin))))

collects/mztake/mztake.ss

@@ -1,4 +1,6 @@
 #| TODO
+exceptions thrown in anonymous threads spawned by the target, are caught by the default drs handler, and not by frtime or mztake. they get printed out in the interaction window and there is nothing we can do about them for now -- if you want you can parameterize and rethrow the exceptions. just be aware of that.
+
 CAN I CATCH FRTIME EXCEPTIONS AND RETHROW THOSE TOO?