From 3ceb88b8a7ea76895b2cbda38b922bf020b882db Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 10 Jan 2009 23:49:03 +0000
Subject: [PATCH] fixed a bug intraces/ps

svn: r13062
---
 collects/redex/private/traces.ss | 45 ++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 19 deletions(-)

diff --git a/collects/redex/private/traces.ss b/collects/redex/private/traces.ss
index f2d67391c3..ebddb6617f 100644
--- a/collects/redex/private/traces.ss
+++ b/collects/redex/private/traces.ss
@@ -130,21 +130,21 @@
                    #:scheme-colors? [scheme-colors? #t]
                    #:colors [colors '()]
                    #:layout [layout void])
-  (let ([graph-pb
-         (traces reductions pre-exprs
-                 #:no-show-frame? #t
-                 #:multiple? multiple? 
-                 #:pred pred
-                 #:pp pp
-                 #:scheme-colors? scheme-colors?
-                 #:colors colors
-                 #:layout layout)]
-        [ps-setup (make-object ps-setup%)])
-    (send ps-setup copy-from (current-ps-setup))
-    (send ps-setup set-file filename)
-    (send ps-setup set-mode 'file)
-    (parameterize ([current-ps-setup ps-setup])
-      (send graph-pb print #f #f 'postscript #f #f #t))))
+  (let-values ([(graph-pb frame)
+                (traces reductions pre-exprs
+                        #:no-show-frame? #t
+                        #:multiple? multiple? 
+                        #:pred pred
+                        #:pp pp
+                        #:scheme-colors? scheme-colors?
+                        #:colors colors
+                        #:layout layout)])
+    (let ([ps-setup (make-object ps-setup%)])
+      (send ps-setup copy-from (current-ps-setup))
+      (send ps-setup set-file filename)
+      (send ps-setup set-mode 'file)
+      (parameterize ([current-ps-setup ps-setup])
+        (send graph-pb print #f #f 'postscript #f #f #t)))))
 
 (define (traces reductions pre-exprs 
                 #:multiple? [multiple? #f] 
@@ -471,10 +471,17 @@
   (insert-into init-rightmost-x 0 graph-pb frontier)
   (layout (map (lambda (y) (send y get-term-node)) frontier))
   (set-font-size (initial-font-size))
-  (reduce-button-callback)
-  (if no-show-frame?
-      graph-pb
-      (send f show #t)))
+  (cond
+    [no-show-frame?
+     (let ([s (make-semaphore)]) 
+       (thread (λ () 
+                 (do-some-reductions)
+                 (semaphore-post s)))
+       (yield s))
+     (values graph-pb f)]
+    [else
+     (reduce-button-callback)
+     (send f show #t)]))
 
 (define red-sem-frame%
   (class (frame:standard-menus-mixin (frame:basic-mixin frame%))