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

a better version of deac3fa2b3

Browse Source 
This time with test cases, and also without changing the
semantics of unhighlight-range

related to PR 13488
(cherry picked from commit e7e64f4006)
This commit is contained in:
Robby Findler 2013-02-05 20:49:30 -06:00 committed by Eli Barzilay
parent 09f16e9df6
commit bba1afb5cb
2 changed files with 32 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -383,22 +383,25 @@
(equal? end r-end)
(equal? color r-color)
(equal? caret-space? r-caret-space?)
(equal? style r-style)))))
(equal? style r-style)))
#t))
(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/public (unhighlight-ranges pred [just-one? #f])
(define left #f)
(define top #f)
(define right #f)
(define bottom #f)
(define found-one? #f)
(queue-filter!
ranges-deq
(λ (a-range)
(cond
[(and just-one? found-one?) #t]
[(pred (range-start a-range)
(range-end a-range)
(range-color a-range)
@ -406,6 +409,7 @@
(range-style a-range)
(range-adjust-on-insert/delete? a-range)
(range-key a-range))
(set! found-one? #t)
(for ([rect (in-list (range-rectangles a-range))])
(set!-values (left top right bottom)
(join-rectangles left top right bottom rect)))
@ -1712,10 +1716,10 @@
;; only need to override this unhighlight-ranges, since
;; all the other unhighlighting variants call this one
(define/override (unhighlight-ranges pred)
(define/override (unhighlight-ranges pred [just-one? #f])
(when delegate
(send delegate unhighlight-ranges pred))
(super unhighlight-ranges pred))
(send delegate unhighlight-ranges pred just-one?))
(super unhighlight-ranges pred just-one?))
(inherit get-canvases get-active-canvas has-focus?)
(define/override (on-paint before? dc left top right bottom dx dy draw-caret?)

23
collects/tests/framework/text.rkt
View File

@ -160,6 +160,29 @@
(send t load-file)
(length (send t get-highlighted-ranges)))))))
(test
'highlight-range-delegate-1
(lambda (x) (equal? x 0))
(λ ()
(queue-sexp-to-mred
`(let ([t (new text:delegate%)])
(send t insert "abc")
(send t highlight-range 1 2 "red")
(send t unhighlight-range 1 2 "red")
(length (send t get-highlighted-ranges))))))
(test
'highlight-range-delegate-1
(lambda (x) (equal? x 0))
(λ ()
(queue-sexp-to-mred
`(let ([t (new text:delegate%)])
(send t set-delegate (new text:basic%))
(send t insert "abc")
(send t highlight-range 1 2 "red")
(send t unhighlight-range 1 2 "red")
(length (send t get-highlighted-ranges))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;