fixed a pair of bugs related to the anchor

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

View File

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

View File

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