From fa85d30773beed1d7136683dbac94d5efb90a462 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 25 Dec 2012 17:38:22 -0600 Subject: [PATCH] adjust the search bubbles so they flicker less when typing --- collects/framework/private/text.rkt | 130 +++++++++++++++------- collects/scribblings/framework/text.scrbl | 59 ++++++++-- 2 files changed, 141 insertions(+), 48 deletions(-) diff --git a/collects/framework/private/text.rkt b/collects/framework/private/text.rkt index eac3adf19b..2c9a43b2fc 100644 --- a/collects/framework/private/text.rkt +++ b/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%) - (and (string? color) - (send the-color-database find-color color))) + (unless (or (is-a? in-color color%) + (and (string? in-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%) - color - (send the-color-database find-color color))] - [l (make-range start end caret-space? style color #f)]) - (if (eq? priority 'high) - (enqueue! ranges-deq l) - (enqueue-front! ranges-deq l)) - (set-range-rectangles! l (compute-rectangles l)) - (invalidate-rectangles (range-rectangles l)) - (λ () (unhighlight-range start end color caret-space? style)))) + (define color (if (is-a? in-color color%) + in-color + (send the-color-database find-color in-color))) + (define l (make-range start end caret-space? style color adjust-on-insert/delete? key #f)) + (if (eq? priority 'high) + (enqueue! ranges-deq l) + (enqueue-front! ranges-deq l)) + (set-range-rectangles! l (compute-rectangles l)) + (invalidate-rectangles (range-rectangles l)) + (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 - (λ (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)))) + (unhighlight-ranges/key 'plt:framework:search-bubbles) + (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)) - (super highlight-range start end color caret-space? priority style)) - - (define/override (unhighlight-range start end color [caret-space? #f] [style 'rectangle]) - (when delegate - (send delegate unhighlight-range start end color caret-space? style)) - (super unhighlight-range start end color caret-space? style)) + (send delegate highlight-range start end color caret-space? priority style + #:adjust-on-insert/delete? adjust-on-insert/delete? + #:key key)) + (super highlight-range start end color caret-space? priority style + #:adjust-on-insert/delete? adjust-on-insert/delete? + #:key key)) + ;; 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)) diff --git a/collects/scribblings/framework/text.scrbl b/collects/scribblings/framework/text.scrbl index 92d7f7480d..3235228ef3 100644 --- a/collects/scribblings/framework/text.scrbl +++ b/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?) - (end exact-nonnegative-integer?) - (color (or/c string? (is-a?/c color%))) - (caret-space boolean? #f) - (priority (or/c 'high 'low) 'low) - (style (or/c 'rectangle 'ellipse 'hollow-ellipse 'dot) 'rectangle)) - (-> void?)))]{ + @defmethod[(highlight-range [start exact-nonnegative-integer?] + [end exact-nonnegative-integer?] + [color (or/c string? (is-a?/c color%))] + [caret-space boolean? #f] + [priority (or/c 'high 'low) 'low] + [style (or/c 'rectangle 'ellipse 'hollow-ellipse 'dot) 'rectangle] + [#: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?)))]{