improve rackunit gui performance

original commit: 755b3d2df24401dee60f419fdd79393cef7e5c99

collects/rackunit/gui.rkt

@@ -4,7 +4,9 @@
          "private/gui/gui.rkt")
 
 (define (test/gui . tests)
-  (apply (make-gui-runner) tests))
+  (let ([runner (make-gui-runner)])
+    (sleep 0.1) ;; give the gui a chance to initialize
+    (apply runner tests)))
 
 (define test/c (or/c rackunit-test-case? rackunit-test-suite?))
 

collects/rackunit/private/gui/controller.rkt

@@ -52,8 +52,8 @@
 
     ;; on-model-status-change : model<%> -> void
     (define/public (on-model-status-change model)
-      ;; (check-ready) ;; allow completion of tests to change status
-      (send view queue-for-update model)
+      (let ([view view]) ;; view field is async. mutable!
+        (when view (send view queue-for-update model)))
       (let [(parent (send model get-parent))]
         (when parent (send parent on-child-status-change model))))
 

collects/rackunit/private/gui/view.rkt

@@ -83,6 +83,10 @@ still be there, just not visible?
     ;; update-lock : semaphore
     (define update-lock (make-semaphore 1))
 
+    ;; update-timer : timer%
+    (define update-timer
+      (new timer% (notify-callback (lambda () (process-updates)))))
+
     (send editor lock #t)
     (with-handlers ([exn:fail? void])
       (send -hpane set-percentages VIEW-PANE-PERCENTS))
@@ -115,26 +119,30 @@ still be there, just not visible?
       (let ([proc (lambda () (send tree-view create-view-link model parent))])
         (semaphore-wait update-lock)
         (set! add-queue (cons proc add-queue))
-        (semaphore-post update-lock)
-        (process-updates)))
+        (updates-pending!)
+        (semaphore-post update-lock)))
 
     ;; queue-for-update : model -> void
     (define/public (queue-for-update model)
       (semaphore-wait update-lock)
       (set! update-queue (hash-set update-queue model #t))
-      (semaphore-post update-lock)
-      (process-updates))
+      (updates-pending!)
+      (semaphore-post update-lock))
+
+    ;; updates-pending! : -> void
+    (define/private (updates-pending!)
+      (send update-timer start 50 #t))
 
     ;; process-updates : -> void
+    ;; ** Must be called from eventspace thread.
     (define/private (process-updates)
-      (parameterize ((current-eventspace eventspace))
-        (queue-callback
-         (lambda ()
-           (let-values ([(adds updates) (grab+clear-update-queue)])
-             (for ([add (in-list adds)])
-               (add))
-             (for ([model (in-hash-keys updates)])
-               (do-model-update model)))))))
+      (let-values ([(adds updates) (grab+clear-update-queue)])
+        (send (send tree-view get-editor) begin-edit-sequence #f)
+        (for ([add (in-list adds)])
+          (add))
+        (for ([model (in-hash-keys updates)])
+          (do-model-update model))
+        (send (send tree-view get-editor) end-edit-sequence)))
 
     ;; grab+clear-update-queue : -> (values list hash)
     ;; ** Must be called from eventspace thread.