suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

adjust the search bubbles so they flicker less when typing

Browse Source
This commit is contained in:
Robby Findler 2012-12-25 17:38:22 -06:00
parent b69573277c
commit fa85d30773
2 changed files with 141 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

130
collects/framework/private/text.rkt
View File

@ -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))

59
collects/scribblings/framework/text.scrbl
View File

@ -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?)))]{