From c6caf11323d0199e0cb5e4bd80b33fb0da2ec20a Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 26 Oct 2012 09:43:49 -0500
Subject: [PATCH] Adjust online check syntax's trace replay code so that it:

- lets other events be handled based on how long it has been
  replaying the current trace (instead of based on the number of
  pieces in the trace that have been seen)

- breaks up the syncheck:add-rename-menu pieces of the trace to
  be more granular (to make the previous point work better)

This should make DrRacket more responsive when the trace is being
replayed
---
 collects/drracket/private/syncheck/gui.rkt    |  9 ++++++---
 .../drracket/private/syncheck/traversals.rkt  | 20 +++++++++++++++----
 2 files changed, 22 insertions(+), 7 deletions(-)

diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt
index f77ce27e48..245e34747a 100644
--- a/collects/drracket/private/syncheck/gui.rkt
+++ b/collects/drracket/private/syncheck/gui.rkt
@@ -1582,6 +1582,7 @@ If the namespace does not, they are colored the unbound color.
             (send (send defs-text get-tab) add-bkg-running-color 'syncheck "orchid" cs-syncheck-running)
             (send defs-text syncheck:init-arrows)
             (let loop ([val val]
+                       [start-time (current-inexact-milliseconds)]
                        [i 0])
               (cond
                 [(null? val)
@@ -1589,15 +1590,17 @@ If the namespace does not, they are colored the unbound color.
                  (send defs-text syncheck:update-drawn-arrows)
                  (send (send defs-text get-tab) remove-bkg-running-color 'syncheck)
                  (set-syncheck-running-mode #f)]
-                [(= i 500)
+                [(and (i . > . 0)  ;; check i just in case things are really strange
+                      (20 . <= . (- (current-inexact-milliseconds) start-time)))
                  (queue-callback
                   (λ ()
                     (when (unbox bx)
-                      (log-timeline "continuing replay-compile-comp-trace" (loop val 0))))
+                      (log-timeline "continuing replay-compile-comp-trace"
+                                    (loop val (current-inexact-milliseconds) 0))))
                   #f)]
                 [else
                  (process-trace-element defs-text (car val))
-                 (loop (cdr val) (+ i 1))]))))
+                 (loop (cdr val) start-time (+ i 1))]))))
         
         (define/private (process-trace-element defs-text x)
           ;; using 'defs-text' all the time is wrong in the case of embedded editors,
diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt
index abcb575df8..7675316bb6 100644
--- a/collects/drracket/private/syncheck/traversals.rkt
+++ b/collects/drracket/private/syncheck/traversals.rkt
@@ -1134,10 +1134,22 @@
                                   (for/or ([(level id-set) (in-hash phase-to-map)])
                                     (get-ids id-set new-id))))))))
                       #t))
-               (send defs-text syncheck:add-rename-menu
-                     id-as-sym
-                     loc-lst
-                     name-dup?)))))))
+               (define max-to-send-at-once 30)
+               (let loop ([loc-lst loc-lst]
+                          [len (length loc-lst)])
+                 (cond
+                   [(<= len max-to-send-at-once)
+                    (send defs-text syncheck:add-rename-menu
+                          id-as-sym
+                          loc-lst
+                          name-dup?)]
+                   [else
+                    (send defs-text syncheck:add-rename-menu
+                          id-as-sym
+                          (take loc-lst max-to-send-at-once)
+                          name-dup?)
+                    (loop (drop loc-lst max-to-send-at-once)
+                          (- len max-to-send-at-once))]))))))))
     
     ;; remove-duplicates-stx : (listof syntax[original]) -> (listof syntax[original])
     ;; removes duplicates, based on the source locations of the identifiers