attempt to try to make the contour window feel faster by delaying the work until nothing has happened for 250 msec

original commit: 24d11805ac25fcb3a0505009ff47ff8c95392f5e

collects/framework/private/text.rkt

@@ -1505,6 +1505,19 @@
         (send new-snip set-style (send snip get-style))
         new-snip))
     
+    (define todo '())
+    (define timer (new timer% 
+                       [notify-callback
+                        (λ ()
+                          (for ([th (in-list (reverse todo))])
+                            (th))
+                          (set! todo '()))]))
+    (define/private (to-delegate thunk)
+      (when delegate
+        (send timer stop)
+        (send timer start 250 #t)
+        (set! todo (cons thunk todo))))
+    
     (define delegate #f)
     (inherit get-highlighted-ranges)
     (define/public-final (get-delegate) delegate)
@@ -1516,7 +1529,10 @@
       (refresh-delegate))
     
     (define/private (refresh-delegate)
-      (when delegate
+      (set! todo '())
+      (to-delegate (λ () (refresh-delegate/do-work))))
+    
+    (define/private (refresh-delegate/do-work)
       (send delegate begin-edit-sequence)
       (send delegate lock #f)
       (when (is-a? this scheme:text<%>)
@@ -1552,16 +1568,18 @@
                (range-style range)))
        (reverse (get-highlighted-ranges)))
       (send delegate lock #t)
-        (send delegate end-edit-sequence)))
+      (send delegate end-edit-sequence))
     
     (define/override (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle])
-      (when delegate
+      (to-delegate
-        (send delegate highlight-range start end color caret-space? priority style))
+       (λ ()
+         (send delegate highlight-range start end color caret-space? priority style)))
       (super highlight-range start end color caret-space? priority style))
     
     (define/override (unhighlight-range start end color [caret-space? #f] [style 'rectangle])
-      (when delegate
+      (to-delegate
-        (send delegate unhighlight-range start end color caret-space? style))
+       (λ ()
+         (send delegate unhighlight-range start end color caret-space? style)))
       (super unhighlight-range start end color caret-space? style))
     
     (inherit get-canvases get-active-canvas has-focus?)
@@ -1570,29 +1588,36 @@
       (unless before?
         (let ([active-canvas (get-active-canvas)])
           (when active-canvas
-            (send (send active-canvas get-top-level-window) delegate-moved)))))
+            (to-delegate
+             (λ ()
+               (send (send active-canvas get-top-level-window) delegate-moved)))))))
     
     (define/augment (on-edit-sequence)
-      (when delegate
+      (to-delegate
-        (send delegate begin-edit-sequence))
+       (λ ()
+         (send delegate begin-edit-sequence)))
       (inner (void) on-edit-sequence))
 
     (define/augment (after-edit-sequence)
-      (when delegate
+      (to-delegate
-        (send delegate end-edit-sequence))
+       (λ ()
+         (send delegate end-edit-sequence)))
       (inner (void) after-edit-sequence))
     
     (define/override (resized snip redraw-now?)
       (super resized snip redraw-now?)
       (when (and delegate
-                 linked-snips
                  (not (is-a? snip string-snip%)))
+        (to-delegate
+         (λ ()
+           (when linked-snips
              (let ([delegate-copy (hash-ref linked-snips snip (λ () #f))])
                (when delegate-copy
-            (send delegate resized delegate-copy redraw-now?)))))
+                 (send delegate resized delegate-copy redraw-now?))))))))
     
     (define/augment (after-insert start len)
-      (when delegate
+      (to-delegate
+       (λ ()
          (send delegate begin-edit-sequence)
          (send delegate lock #f)
          (split-snip start)
@@ -1603,44 +1628,37 @@
                (send delegate insert (copy snip) start start)
                (loop (send snip previous)))))
          (send delegate lock #t)
-        (send delegate end-edit-sequence))
+         (send delegate end-edit-sequence)))
       (inner (void) after-insert start len))
     
     (define/augment (after-delete start len)
-      (when delegate
+      (to-delegate
+       (λ ()
          (send delegate lock #f)
          (send delegate begin-edit-sequence)
          (send delegate delete start (+ start len))
          (send delegate end-edit-sequence)
-        (send delegate lock #t))
+         (send delegate lock #t)))
       (inner (void) after-delete start len))
     
     (define/augment (after-change-style start len)
-      (when delegate
+      (to-delegate
+       (λ ()
          (send delegate begin-edit-sequence)
          (send delegate lock #f)
          (split-snip start)
          (let* ([snip (find-snip start 'after)]
-               [style (send snip get-style)]
+                [style (send snip get-style)])
-               [other-style 
-                '(send (send delegate get-style-list) find-or-create-style
-                       style delegate-style-delta)])
            (send delegate change-style style start (+ start len)))
          (send delegate lock #f)
-        (send delegate end-edit-sequence))
+         (send delegate end-edit-sequence)))
       (inner (void) after-change-style start len))
     
-    (define filename #f)
-    (define format #f)
-    (define/augment (on-load-file _filename _format)
-      (set! filename _filename)
-      (set! format _format)
-      (inner (void) on-load-file _filename _format))
     (define/augment (after-load-file success?)
       (when success?
         (refresh-delegate))
       (inner (void) after-load-file success?))
-    (super-instantiate ())))
+    (super-new)))
 
 (define info<%> (interface (basic<%>)))