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

fixed a pair of bugs related to the anchor

Browse Source 
svn: r10950
This commit is contained in:
Robby Findler 2008-07-28 21:41:22 +00:00
parent 27375c0d5a
commit bbf51d2ab0
2 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1756,16 +1756,17 @@
(when text-to-search (when text-to-search
(let ([anchor-pos (send text-to-search get-anchor-pos)]) (let ([anchor-pos (send text-to-search get-anchor-pos)])
(when anchor-pos (when anchor-pos
(send text-to-search begin-edit-sequence) (cond
(send text-to-search set-position anchor-pos anchor-pos) [(equal? "" (get-text))
(search 'forward #t #t #f) (send text-to-search set-position anchor-pos anchor-pos)]
(send text-to-search end-edit-sequence))))))))) [else
(search 'forward #t #t #f anchor-pos)])))))))))
(define/private (get-searching-text) (define/private (get-searching-text)
(let ([frame (get-top-level-window)]) (let ([frame (get-top-level-window)])
(and frame (and frame
(send frame get-text-to-search)))) (send frame get-text-to-search))))
(define/public (search [searching-direction 'forward] [beep? #t] [wrap? #t] [move-anchor? #t]) (define/public (search [searching-direction 'forward] [beep? #t] [wrap? #t] [move-anchor? #t] [search-start-position #f])
(let* ([string (get-text)] (let* ([string (get-text)]
[top-searching-edit (get-searching-text)]) [top-searching-edit (get-searching-text)])
(when top-searching-edit (when top-searching-edit
@ -1828,12 +1829,15 @@
(not-found top-searching-edit #t) (not-found top-searching-edit #t)
(let-values ([(found-edit first-pos) (let-values ([(found-edit first-pos)
(find-string-embedded (find-string-embedded
searching-edit (if search-start-position
top-searching-edit
searching-edit)
string string
searching-direction searching-direction
(or search-start-position
(if (eq? 'forward searching-direction) (if (eq? 'forward searching-direction)
(send searching-edit get-end-position) (send searching-edit get-end-position)
(send searching-edit get-start-position)) (send searching-edit get-start-position)))
'eof #t 'eof #t
(get-case-sensitive-search?) (get-case-sensitive-search?)
#t)]) #t)])

8
collects/framework/private/text.ss
View File

@ -624,13 +624,19 @@ WARNING: printf is rebound in the body of the unit to always
(define clear-anchor void) (define clear-anchor void)
(define/public (set-search-anchor position) (define/public (set-search-anchor position)
(cond
[position
(when (preferences:get 'framework:anchored-search) (when (preferences:get 'framework:anchored-search)
(clear-anchor) (clear-anchor)
(set! anchor-pos position) (set! anchor-pos position)
(set! clear-anchor (set! clear-anchor
(let ([t1 (highlight-range anchor-pos anchor-pos "red" #f 'low 'dot)] (let ([t1 (highlight-range anchor-pos anchor-pos "red" #f 'low 'dot)]
[t2 (highlight-range anchor-pos anchor-pos "red")]) [t2 (highlight-range anchor-pos anchor-pos "red")])
(λ () (t1) (t2)))))) (λ () (t1) (t2)))))]
[else
(clear-anchor)
(set! clear-anchor void)
(set! anchor-pos #f)]))
(define/public (get-search-hits) search-hits) (define/public (get-search-hits) search-hits)