adjust the search bubbles so they flicker less when typing

collects/framework/private/text.rkt

@@ -38,7 +38,13 @@
 
 ;; rectangles : (or/c #f (listof rectangle))
 ;;  #f => range information needs to be computed for this rectangle
-(define-struct range (start end caret-space? style color [rectangles #:mutable]) #:inspector #f)
+(define-struct range ([start #:mutable] 
+                      [end #:mutable]
+                      caret-space?
+                      style color 
+                      adjust-on-insert/delete?
+                      key
+                      [rectangles #:mutable]) #:inspector #f)
 (define-struct rectangle (left top right bottom style color) #:inspector #f)
 
 (define (build-rectangle left top right bottom style color [info (λ () "")])
@@ -82,6 +88,7 @@
     highlight-range
     unhighlight-range
     unhighlight-ranges
+    unhighlight-ranges/key
     get-highlighted-ranges
     get-styles-fixed
     get-fixed-style
@@ -279,6 +286,40 @@
                                 end-x bottom-end-y
                                 style color))]))
     
+    (define/augment (after-insert insert-start insert-len)
+      (for ([r (in-queue ranges-deq)])
+        (when (range-adjust-on-insert/delete? r)
+          (define rstart (range-start r))
+          (define rend (range-end r))
+          (cond
+            [(<= insert-start rstart) 
+             (set-range-start! r (+ rstart insert-len))
+             (set-range-end! r (+ rend insert-len))]
+            [(<= insert-start rend)
+             (set-range-end! r (+ rend insert-len))])))
+      (inner (void) after-insert insert-start insert-len))
+    (define/augment (after-delete delete-start delete-len)
+      (define delete-end (+ delete-start delete-len))
+      (for ([r (in-queue ranges-deq)])
+        (when (range-adjust-on-insert/delete? r)
+          (define rstart (range-start r))
+          (define rend (range-end r))
+          (cond
+            [(<= delete-end rstart)
+             (set-range-start! r (- rstart delete-len))
+             (set-range-end! r (- rend delete-len))]
+            [(<= delete-start rstart delete-end rend)
+             (define new-len (- rend delete-end))
+             (set-range-start! r delete-start)
+             (set-range-end! r (+ delete-start new-len))]
+            [(<= rstart delete-start delete-end rend)
+             (define new-len (- rend delete-end))
+             (set-range-start! r delete-start)
+             (set-range-end! r (- rend delete-len))]
+            [(<= rstart delete-start rend)
+             (set-range-end! r delete-end)])))
+      (inner (void) after-delete delete-start delete-len))
+   
     (define/augment (on-reflow)
       (recompute-range-rectangles)
       (inner (void) on-reflow))
@@ -287,8 +328,10 @@
       (inner (void) after-load-file success?)
       (when success?
         (set! ranges-deq (make-queue))))
-    
+        
-    (define/public (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle])
+    (define/public (highlight-range start end in-color [caret-space? #f] [priority 'low] [style 'rectangle] 
+                                    #:adjust-on-insert/delete? [adjust-on-insert/delete? #f]
+                                    #:key [key #f])
       (unless (let ([exact-pos-int?
                      (λ (x) (and (integer? x) (exact? x) (x . >= . 0)))])
                 (and (exact-pos-int? start)
@@ -304,11 +347,11 @@
         (error 'highlight-range
                "expected priority argument to be either 'high or 'low, got: ~e"
                priority))
-      (unless (or (is-a? color color%)
+      (unless (or (is-a? in-color color%)
-                  (and (string? color)
+                  (and (string? in-color)
-                       (send the-color-database find-color color)))
+                       (send the-color-database find-color in-color)))
         (error 'highlight-range
-               "expected a color or a string in the-color-database for the third argument, got ~e" color))
+               "expected a color or a string in the-color-database for the third argument, got ~e" in-color))
       (unless (memq style '(rectangle hollow-ellipse ellipse dot))
         (error 'highlight-range
                "expected one of 'rectangle, 'ellipse 'hollow-ellipse, or 'dot as the style, got ~e" style))
@@ -317,16 +360,18 @@
           (error 'highlight-range
                  "when the style is 'dot, the start and end regions must be the same")))
       
-      (let* ([color (if (is-a? color color%)
+      (define color (if (is-a? in-color color%)
-                        color
+                        in-color
-                        (send the-color-database find-color color))]
+                        (send the-color-database find-color in-color)))
-             [l (make-range start end caret-space? style color #f)])
+      (define l (make-range start end caret-space? style color adjust-on-insert/delete? key #f))
-        (if (eq? priority 'high)
+      (if (eq? priority 'high)
-            (enqueue! ranges-deq l)
+          (enqueue! ranges-deq l)
-            (enqueue-front! ranges-deq l))
+          (enqueue-front! ranges-deq l))
-        (set-range-rectangles! l (compute-rectangles l))
+      (set-range-rectangles! l (compute-rectangles l))
-        (invalidate-rectangles (range-rectangles l))
+      (invalidate-rectangles (range-rectangles l))
-        (λ () (unhighlight-range start end color caret-space? style))))
+      (unless adjust-on-insert/delete?
+        (λ () 
+          (unhighlight-range start end color caret-space? style))))
         
     (define/public (unhighlight-range start end in-color [caret-space? #f] [style 'rectangle])
       (define color (if (is-a? in-color color%)
@@ -334,7 +379,7 @@
                         (send the-color-database find-color in-color)))
       (define found-one? #f)
       (unhighlight-ranges
-       (λ (r-start r-end r-color r-caret-space? r-style)
+       (λ (r-start r-end r-color r-caret-space? r-style r-adjust-on-insert/delete? r-key)
          (cond
            [found-one? #f]
            [(and (equal? start r-start)
@@ -346,6 +391,11 @@
             #t]
            [else #f]))))
     
+    (define/public (unhighlight-ranges/key key)
+      (unhighlight-ranges
+       (λ (r-start r-end r-color r-caret-space? r-style r-adjust-on-insert/delete? r-key)
+         (equal? r-key key))))
+    
     (define/public (unhighlight-ranges pred)
       (define left #f)
       (define top #f)
@@ -359,7 +409,9 @@
                   (range-end a-range)
                   (range-color a-range)
                   (range-caret-space? a-range)
-                  (range-style a-range))
+                  (range-style a-range)
+                  (range-adjust-on-insert/delete? a-range)
+                  (range-key a-range))
             (for ([rect (in-list (range-rectangles a-range))])
               (set!-values (left top right bottom)
                 (join-rectangles left top right bottom rect)))
@@ -939,7 +991,7 @@
   (mixin (editor:basic<%> editor:keymap<%> basic<%>) (searching<%>)
     (inherit invalidate-bitmap-cache
              get-start-position get-end-position
-             unhighlight-ranges unhighlight-range highlight-range
+             unhighlight-ranges/key unhighlight-range highlight-range
              run-after-edit-sequence begin-edit-sequence end-edit-sequence
              find-string get-admin position-line
              in-edit-sequence? get-pos/text-dc-location
@@ -1280,15 +1332,8 @@
     (define/private (clear-all-regions) 
       (when to-replace-highlight 
         (unhighlight-replace))
-      (unless (zero? (hash-count search-bubble-table))
+      (unhighlight-ranges/key 'plt:framework:search-bubbles)
-        (unhighlight-ranges
+      (set! search-bubble-table (make-hash)))
-         (λ (r-start r-end r-color r-caret-space? r-style)
-           (and (not r-caret-space?)
-                (eq? r-style 'hollow-ellipse)
-                (or (eq? r-color light-search-color)
-                    (eq? r-color normal-search-color))
-                (hash-ref search-bubble-table (cons r-start r-end) #f))))
-        (set! search-bubble-table (make-hash))))
     
     (define/private (do-search start end) (find-string searching-str 'forward start end #t case-sensitive?))
     
@@ -1296,6 +1341,10 @@
     ;; the search-bubble-table has it mapped to #t
     ;; the two methods below contribute to this, but
     ;; so does the 'clear-all-regions' method above
+    
+    
+    ;; this method may be called with bogus inputs (ie a pair that has no highlight)
+    ;; but only when there is a pending "erase all highlights and recompute everything" callback
     (define/private (unhighlight-hit pair)
       (hash-remove! search-bubble-table pair)
       (unhighlight-range (car pair) (cdr pair) 
@@ -1308,7 +1357,9 @@
                        (if replace-mode? light-search-color normal-search-color)
                        #f
                        'low
-                       'hollow-ellipse))
+                       'hollow-ellipse
+                       #:key 'plt:framework:search-bubbles
+                       #:adjust-on-insert/delete? #t))
     
     ;; INVARIANT: the "next to replace" highlight is always
     ;; saved in 'to-replace-highlight'
@@ -1654,16 +1705,19 @@
       (send delegate lock #t)
       (send delegate end-edit-sequence))
     
-    (define/override (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle])
+    (define/override (highlight-range start end color [caret-space? #f] [priority 'low] [style 'rectangle] 
+                                      #:adjust-on-insert/delete? [adjust-on-insert/delete? #f]
+                                      #:key [key #f])
       (when 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))
+              #:adjust-on-insert/delete? adjust-on-insert/delete?
-    
+              #:key key))
-    (define/override (unhighlight-range start end color [caret-space? #f] [style 'rectangle])
+      (super highlight-range start end color caret-space? priority style 
-      (when delegate 
+             #:adjust-on-insert/delete? adjust-on-insert/delete?
-        (send delegate unhighlight-range start end color caret-space? style))
+             #:key key))
-      (super unhighlight-range start end color caret-space? style))
     
+    ;; only need to override this unhighlight-ranges, since 
+    ;; all the other unhighlighting variants call this one
     (define/override (unhighlight-ranges pred)
       (when delegate 
         (send delegate unhighlight-ranges pred))

collects/scribblings/framework/text.scrbl

@@ -7,13 +7,17 @@
 @definterface[text:basic<%> (editor:basic<%> text%)]{
   Classes matching this interface are expected to implement the basic
   functionality needed by the framework.
-  @defmethod*[(((highlight-range (start exact-nonnegative-integer?)
+  @defmethod[(highlight-range [start exact-nonnegative-integer?]
-                                 (end exact-nonnegative-integer?)
+                              [end exact-nonnegative-integer?]
-                                 (color (or/c string? (is-a?/c color%)))
+                              [color (or/c string? (is-a?/c color%))]
-                                 (caret-space boolean? #f)
+                              [caret-space boolean? #f]
-                                 (priority (or/c 'high 'low) 'low)
+                              [priority (or/c 'high 'low) 'low]
-                                 (style (or/c 'rectangle 'ellipse 'hollow-ellipse 'dot) 'rectangle))
+                              [style (or/c 'rectangle 'ellipse 'hollow-ellipse 'dot) 'rectangle]
-                (-> void?)))]{
+                              [#:adjust-on-insert/delete adjust-on-insert/delete boolean? #f]
+                              [#:key key any/c #f])
+             (if adjust-on-insert/delete
+                 void?
+                 (-> void?))]{
     This function highlights a region of text in the buffer.
 
     The range between @racket[start] and @racket[end] will be highlighted with
@@ -39,10 +43,31 @@
     the region with @racket['high] priority will be drawn second and only it
     will be visible in the overlapping region.
 
-    This method returns a thunk, which, when invoked, will turn off the
+    If @racket[adjust-on-insert/delete?] is @racket[#t], then insertions
+    and deletions to the text will adjust the @racket[start] and @racket[end]
+    of the range. Insertions and deletions before the range move the range forward
+    and backward; insertions and deletions after the range will be ignored. An insertion
+    in the middle of the range will enlarge the range and a deletion that overlaps
+    the range adjusts the range to reflect the deleted portion of the range and its
+    new position.
+    
+    The @racket[key] argument can be used with 
+    @method[text:basic<%> unhighlight-ranges/key]
+    and 
+    @method[text:basic<%> unhighlight-ranges]
+    to identify ranges whose start and end positions may have changed.
+    Symbols whose names begin with @litchar{plt:} are reserved
+    for internal use.
+    
+    If this method returns a thunk, invoking the thunk will turn off the
     highlighting from this range.
 
-    See also @method[text:basic<%> unhighlight-range].
+    Note that if @racket[adjust-on-insert/delete] is a true value, then
+    the result is not a thunk and instead 
+    @method[text:basic<%> unhighlight-range],
+    @method[text:basic<%> unhighlight-ranges/key], or
+    @method[text:basic<%> unhighlight-ranges]
+    must be called directly to remove the highlighting.
   }
 
   @defmethod[(unhighlight-range
@@ -63,16 +88,30 @@
     consider instead calling @method[text:basic<%> unhighlight-ranges].
   }
 
+  @defmethod[(unhighlight-ranges/key [key any/c]) void?]{
+    This method removes the highlight from regions in the buffer
+    that have the key @racket[key] 
+    (as passed to @method[text:basic<%> highlight-range]).
+  }
+
   @defmethod[(unhighlight-ranges
               [pred? (-> exact-nonnegative-integer?
                          exact-nonnegative-integer?
                          (is-a?/c color%)
                          boolean?
                          (or/c 'rectangle 'ellipse 'hollow-ellipse)
+                         (or/c boolean? exact-nonnegative-integer?)
+                         any/c
                          boolean?)])
                void?]{
     This method removes the highlight from regions in the buffer as 
-    selected by @racket[pred?].
+    selected by @racket[pred?]. The arguments to @racket[pred?] are the
+    same as the arguments to 
+    @method[text:basic<%> highlight-range] when it was originally called,
+    unless the @racket[_adjust-on-insert/delete] argument was a true value, in which case the 
+    first two arguments to the predicate will reflect the current state
+    of the bubble, if it is changed.
+
   }
 
   @defmethod*[(((get-highlighted-ranges) (listof text:range?)))]{