From 8947374ff219ad896757d50dd068073ad694b392 Mon Sep 17 00:00:00 2001
From: Jono Spiro <jono.spiro@gmail.com>
Date: Thu, 22 Jul 2004 17:13:40 +0000
Subject: [PATCH] .

svn: r107
---
 collects/mztake/debugger-tool.ss | 48 +++++++++++++++++++++++++++++---
 collects/mztake/mztake.ss        |  2 ++
 2 files changed, 46 insertions(+), 4 deletions(-)

diff --git a/collects/mztake/debugger-tool.ss b/collects/mztake/debugger-tool.ss
index ce5f5d8560..7282e620e2 100644
--- a/collects/mztake/debugger-tool.ss
+++ b/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))))
\ No newline at end of file
+      (drscheme:get/extend:extend-unit-frame debugger-unit-frame-mixin))))
diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss
index 3bb433be11..793454a33e 100644
--- a/collects/mztake/mztake.ss
+++ b/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?