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

improved the way the automatic scrolling works when searching

Browse Source 
svn: r8177
This commit is contained in:
Robby Findler 2008-01-01 21:47:13 +00:00
parent 8b20d62969
commit fca9c6b405
1 changed files with 30 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/framework/private/frame.ss
View File

@ -1962,15 +1962,38 @@
(bell)) (bell))
#f)] #f)]
[found [found
(λ (edit first-pos) (λ (text first-pos)
(let ([last-pos ((if (eq? searching-direction 'forward) + -) (let ([last-pos ((if (eq? searching-direction 'forward) + -)
first-pos (string-length string))]) first-pos (string-length string))])
(send* edit (send text begin-edit-sequence)
(set-caret-owner #f 'display) (send text set-caret-owner #f 'display)
(set-position (send text set-position
(min first-pos last-pos) (min first-pos last-pos)
(max first-pos last-pos) (max first-pos last-pos)
#f #t 'local)) #f #f 'local)
;; scroll to the middle if the search result isn't already visible
(let ([search-result-line (send text position-line (send text get-start-position))]
[bt (box 0)]
[bb (box 0)])
(send text get-visible-line-range bt bb #f)
(unless (<= (unbox bt) search-result-line (unbox bb))
(let* ([half (sub1 (quotient (- (unbox bb) (unbox bt)) 2))]
[last-pos (send text position-line (send text last-position))]
[top-pos (send text line-start-position
(max (min (- search-result-line half) last-pos) 0))]
[bottom-pos (send text line-start-position
(max 0
(min (+ search-result-line half)
last-pos)))])
(send text scroll-to-position
top-pos
#f
bottom-pos))))
(send text end-edit-sequence)
#t))]) #t))])
(if (string=? string "") (if (string=? string "")
(not-found top-searching-edit #t) (not-found top-searching-edit #t)