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

changed serching text notification from pull-style to push-style, ie the text now notifies the frame when it wants to be actived for searching instead of waiting for the frame to ask

Browse Source 
svn: r10858
This commit is contained in:
Robby Findler 2008-07-22 03:51:26 +00:00
parent a690f715c5
commit bd6ed2dfc2
5 changed files with 266 additions and 247 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/drscheme/private/multi-file-search.ss
View File

@ -356,11 +356,6 @@
(frame:searchable-mixin (frame:searchable-mixin
frame:standard-menus%)) frame:standard-menus%))
(init-field name) (init-field name)
(field [text-to-search #f])
(define/public (set-text-to-search text) (set! text-to-search text))
(define/override (get-text-to-search) text-to-search)
(define/override (on-size w h) (define/override (on-size w h)
(preferences:set 'drscheme:multi-file-search:frame-size (cons w h)) (preferences:set 'drscheme:multi-file-search:frame-size (cons w h))
(super on-size w h)) (super on-size w h))

13
collects/drscheme/private/unit.ss
View File

@ -1577,10 +1577,6 @@ module browser threading seems wrong.
(define/public (make-searchable canvas) (define/public (make-searchable canvas)
(update-info) (update-info)
(set! search-canvas canvas)) (set! search-canvas canvas))
(define/override (get-text-to-search)
(if search-canvas
(send search-canvas get-editor)
(get-editor)))
(define was-locked? #f) (define was-locked? #f)
@ -2497,6 +2493,7 @@ module browser threading seems wrong.
(list x y w h))) (list x y w h)))
(send txt get-canvases))) (send txt get-canvases)))
(inherit set-text-to-search)
(define/private (restore-visible-tab-regions) (define/private (restore-visible-tab-regions)
(define (set-visible-regions txt regions ints?) (define (set-visible-regions txt regions ints?)
(when regions (when regions
@ -2543,8 +2540,12 @@ module browser threading seems wrong.
(set-visible-regions definitions-text vd #f) (set-visible-regions definitions-text vd #f)
(set-visible-regions interactions-text vi #t)) (set-visible-regions interactions-text vi #t))
(case (send current-tab get-focus-d/i) (case (send current-tab get-focus-d/i)
[(defs) (send (car definitions-canvases) focus)] [(defs)
[(ints) (send (car interactions-canvases) focus)])) (send (car definitions-canvases) focus)
(set-text-to-search (send (car definitions-canvases) get-editor))]
[(ints)
(send (car interactions-canvases) focus)
(set-text-to-search (send (car interactions-canvases) get-editor))]))
(define/private (pathname-equal? p1 p2) (define/private (pathname-equal? p1 p2)
(with-handlers ([exn:fail:filesystem? (λ (x) #f)]) (with-handlers ([exn:fail:filesystem? (λ (x) #f)])

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

@ -1670,111 +1670,112 @@
(init-find/replace-edits) (init-find/replace-edits)
(keymap:call/text-keymap-initializer (keymap:call/text-keymap-initializer
(λ () (λ ()
(let* ([to-be-searched-text (send frame get-text-to-search)] (let ([to-be-searched-text (send frame get-text-to-search)])
[to-be-searched-canvas (send to-be-searched-text get-canvas)] (when to-be-searched-text
(let* ([to-be-searched-canvas (send to-be-searched-text get-canvas)]
[allow-replace? (not (send to-be-searched-text is-locked?))]
[allow-replace? (not (send to-be-searched-text is-locked?))]
[dialog (new dialog%
(label (if allow-replace? [dialog (new dialog%
(string-constant find-and-replace) (label (if allow-replace?
(string-constant find))) (string-constant find-and-replace)
(parent frame) (string-constant find)))
(style '(no-sheet)))] (parent frame)
(style '(no-sheet)))]
[copy-text
(λ (from to) [copy-text
(send to erase) (λ (from to)
(let loop ([snip (send from find-first-snip)]) (send to erase)
(when snip (let loop ([snip (send from find-first-snip)])
(send to insert (send snip copy)) (when snip
(loop (send snip next)))))] (send to insert (send snip copy))
(loop (send snip next)))))]
[text-keymap/editor%
(class text:keymap% [text-keymap/editor%
(define/override (get-keymaps) (class text:keymap%
(if (preferences:get 'framework:menu-bindings) (define/override (get-keymaps)
(append (list (keymap:get-editor)) (if (preferences:get 'framework:menu-bindings)
(super get-keymaps)) (append (list (keymap:get-editor))
(append (super get-keymaps) (super get-keymaps))
(list (keymap:get-editor))))) (append (super get-keymaps)
(inherit set-styles-fixed) (list (keymap:get-editor)))))
(super-new) (inherit set-styles-fixed)
(set-styles-fixed #t))] (super-new)
(set-styles-fixed #t))]
[find-panel (make-object horizontal-panel% dialog)]
[find-message (make-object message% (string-constant find) find-panel)] [find-panel (make-object horizontal-panel% dialog)]
[f-text (make-object text-keymap/editor%)] [find-message (make-object message% (string-constant find) find-panel)]
[find-canvas (make-object editor-canvas% find-panel f-text [f-text (make-object text-keymap/editor%)]
'(hide-hscroll hide-vscroll))] [find-canvas (make-object editor-canvas% find-panel f-text
'(hide-hscroll hide-vscroll))]
[replace-panel (make-object horizontal-panel% dialog)]
[replace-message (make-object message% (string-constant replace) replace-panel)] [replace-panel (make-object horizontal-panel% dialog)]
[r-text (make-object text-keymap/editor%)] [replace-message (make-object message% (string-constant replace) replace-panel)]
[replace-canvas (make-object editor-canvas% replace-panel r-text [r-text (make-object text-keymap/editor%)]
'(hide-hscroll hide-vscroll))] [replace-canvas (make-object editor-canvas% replace-panel r-text
'(hide-hscroll hide-vscroll))]
[button-panel (make-object horizontal-panel% dialog)]
[button-panel (make-object horizontal-panel% dialog)]
[prefs-panel (make-object horizontal-panel% dialog)]
[sensitive-check-box-callback (λ () (send find-edit toggle-case-sensitive))] [prefs-panel (make-object horizontal-panel% dialog)]
[sensitive-check-box (make-object check-box% [sensitive-check-box-callback (λ () (send find-edit toggle-case-sensitive))]
(string-constant find-case-sensitive) [sensitive-check-box (make-object check-box%
prefs-panel (λ (x y) (sensitive-check-box-callback)))] (string-constant find-case-sensitive)
[dummy (begin (send sensitive-check-box set-value (send find-edit get-case-sensitive?)) prefs-panel (λ (x y) (sensitive-check-box-callback)))]
(send prefs-panel set-alignment 'center 'center))] [dummy (begin (send sensitive-check-box set-value (send find-edit get-case-sensitive?))
[update-texts (send prefs-panel set-alignment 'center 'center))]
(λ () [update-texts
(send find-edit stop-searching) (λ ()
(copy-text f-text find-edit) (send find-edit stop-searching)
(send find-edit start-searching) (copy-text f-text find-edit)
(copy-text r-text replace-edit))] (send find-edit start-searching)
(copy-text r-text replace-edit))]
[find-button (make-object button% (string-constant find) button-panel
(λ x [find-button (make-object button% (string-constant find) button-panel
(update-texts) (λ x
(send frame search-again)) (update-texts)
'(border))] (send frame search-again))
[replace-button (make-object button% (string-constant replace) button-panel '(border))]
(λ x [replace-button (make-object button% (string-constant replace) button-panel
(update-texts) (λ x
(send frame replace)))] (update-texts)
[replace-and-find-button (make-object button% (string-constant replace&find-again) (send frame replace)))]
button-panel [replace-and-find-button (make-object button% (string-constant replace&find-again)
(λ x button-panel
(update-texts) (λ x
(send frame replace&search)))] (update-texts)
[replace-to-end-button (send frame replace&search)))]
(make-object button% (string-constant replace-to-end) button-panel [replace-to-end-button
(λ x (make-object button% (string-constant replace-to-end) button-panel
(update-texts) (λ x
(send frame replace-all)))] (update-texts)
(send frame replace-all)))]
[dock-button (make-object button%
(string-constant dock) [dock-button (make-object button%
button-panel (string-constant dock)
(λ (btn evt) button-panel
(update-texts) (λ (btn evt)
(preferences:set 'framework:search-using-dialog? #f) (update-texts)
(send frame unhide-search)))] (preferences:set 'framework:search-using-dialog? #f)
(send frame unhide-search)))]
[close
(λ () [close
(when to-be-searched-canvas (λ ()
(send to-be-searched-canvas force-display-focus #f)) (when to-be-searched-canvas
(send dialog show #f))] (send to-be-searched-canvas force-display-focus #f))
(send dialog show #f))]
[close-button (make-object button% (string-constant close) button-panel
(λ (x y) [close-button (make-object button% (string-constant close) button-panel
(close)))] (λ (x y)
(close)))]
[remove-pref-callback
(preferences:add-callback [remove-pref-callback
'framework:search-using-dialog? (preferences:add-callback
(λ (p v) 'framework:search-using-dialog?
(unless v (λ (p v)
(close))))]) (unless v
(close))))])
(unless allow-replace? (unless allow-replace?
(send button-panel change-children (send button-panel change-children
@ -1811,10 +1812,11 @@
(when to-be-searched-canvas (when to-be-searched-canvas
(send to-be-searched-canvas force-display-focus #t)) (send to-be-searched-canvas force-display-focus #t))
(send dialog show #t) (send dialog show #t)
(remove-pref-callback))))) (remove-pref-callback)))))))
(define searchable<%> (interface (basic<%>) (define searchable<%> (interface (basic<%>)
get-text-to-search get-text-to-search
set-text-to-search
hide-search hide-search
unhide-search unhide-search
set-search-direction set-search-direction
@ -1951,54 +1953,54 @@
(lambda ([reset-search-anchor? #t] [beep? #t] [wrap? #t]) (lambda ([reset-search-anchor? #t] [beep? #t] [wrap? #t])
(when searching-frame (when searching-frame
(let* ([string (get-text)] (let* ([string (get-text)]
[top-searching-edit (get-searching-edit)] [top-searching-edit (get-searching-edit)])
(when top-searching-edit
[searching-edit (let ([focus-snip (send top-searching-edit get-focus-snip)]) (let ([searching-edit (let ([focus-snip (send top-searching-edit get-focus-snip)])
(if focus-snip (if focus-snip
(send focus-snip get-editor) (send focus-snip get-editor)
top-searching-edit))] top-searching-edit))]
[not-found [not-found
(λ (found-edit skip-beep?) (λ (found-edit skip-beep?)
(send found-edit set-position search-anchor) (send found-edit set-position search-anchor)
(when (and beep? (when (and beep?
(not skip-beep?)) (not skip-beep?))
(bell)) (bell))
#f)] #f)]
[found [found
(λ (text 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 text begin-edit-sequence) (send text begin-edit-sequence)
(send text set-caret-owner #f 'display) (send text set-caret-owner #f 'display)
(send text 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 #f 'local) #f #f 'local)
;; scroll to the middle if the search result isn't already visible ;; 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))] (let ([search-result-line (send text position-line (send text get-start-position))]
[bt (box 0)] [bt (box 0)]
[bb (box 0)]) [bb (box 0)])
(send text get-visible-line-range bt bb #f) (send text get-visible-line-range bt bb #f)
(unless (<= (unbox bt) search-result-line (unbox bb)) (unless (<= (unbox bt) search-result-line (unbox bb))
(let* ([half (sub1 (quotient (- (unbox bb) (unbox bt)) 2))] (let* ([half (sub1 (quotient (- (unbox bb) (unbox bt)) 2))]
[last-pos (send text position-line (send text last-position))] [last-pos (send text position-line (send text last-position))]
[top-pos (send text line-start-position [top-pos (send text line-start-position
(max (min (- search-result-line half) last-pos) 0))] (max (min (- search-result-line half) last-pos) 0))]
[bottom-pos (send text line-start-position [bottom-pos (send text line-start-position
(max 0 (max 0
(min (+ search-result-line half) (min (+ search-result-line half)
last-pos)))]) last-pos)))])
(send text scroll-to-position (send text scroll-to-position
top-pos top-pos
#f #f
bottom-pos)))) bottom-pos))))
(send text end-edit-sequence) (send text end-edit-sequence)
#t))]) #t))])
#; #;
(send (get-searching-edit) (send (get-searching-edit)
@ -2039,7 +2041,7 @@
(found found-edit pos)))) (found found-edit pos))))
(not-found found-edit #f))] (not-found found-edit #f))]
[else [else
(found found-edit first-pos)])))))))) (found found-edit first-pos)]))))))))))
(field [dont-search #f] (field [dont-search #f]
[case-sensitive? (preferences:get 'framework:case-sensitive-search?)]) [case-sensitive? (preferences:get 'framework:case-sensitive-search?)])
(define/public (toggle-case-sensitive) (define/public (toggle-case-sensitive)
@ -2055,7 +2057,7 @@
(when on? (when on?
(let ([edit (get-searching-edit)]) (let ([edit (get-searching-edit)])
(when edit (when edit
(reset-search-anchor (get-searching-edit))))) (reset-search-anchor edit))))
(super on-focus on?)) (super on-focus on?))
(define/augment (after-insert x y) (define/augment (after-insert x y)
(unless dont-search (unless dont-search
@ -2142,12 +2144,15 @@
(define/override (on-activate on?) (define/override (on-activate on?)
(unless hidden? (unless hidden?
(if on? (if on?
(reset-search-anchor (get-text-to-search)) (let ([txt (get-text-to-search)])
(when txt
(reset-search-anchor txt)))
(clear-search-highlight))) (clear-search-highlight)))
(super on-activate on?)) (super on-activate on?))
(define/public (get-text-to-search) (define text-to-search #f)
(error 'get-text-to-search "abstract method in searchable-mixin")) (define/public (set-text-to-search txt) (set! text-to-search txt))
(define/public-final (get-text-to-search) text-to-search)
(define/public hide-search (define/public hide-search
(lambda ([startup? #f]) (lambda ([startup? #f])
@ -2156,13 +2161,14 @@
(λ (l) (λ (l)
(remove search-panel l)))) (remove search-panel l))))
(clear-search-highlight) (clear-search-highlight)
#; (let ([txt (get-text-to-search)])
(send (get-text-to-search) set-searching-str #f #f) (when txt
(unless startup? #;(send txt set-searching-str #f #f)
(let ([canvas (send (get-text-to-search) get-canvas)]) (unless startup?
(when canvas (let ([canvas (send txt get-canvas)])
(send canvas force-display-focus #f) (when canvas
(send canvas focus)))) (send canvas force-display-focus #f)
(send canvas focus))))))
(set! hidden? #t))) (set! hidden? #t)))
(define/public (unhide-search) (define/public (unhide-search)
@ -2172,21 +2178,24 @@
(build-search-gui-in-frame) (build-search-gui-in-frame)
(let ([canvas (send (get-text-to-search) get-canvas)]) (let ([txt (get-text-to-search)])
(when canvas (when txt
(send canvas force-display-focus #t))) (let ([canvas (send txt get-canvas)])
(show/hide-replace (send (get-text-to-search) is-locked?)) (when canvas
(send search-panel focus) (send canvas force-display-focus #t))))
(send find-edit set-position 0 (send find-edit last-position)) (show/hide-replace (and txt (send txt is-locked?)))
(send search-panel focus)
#; (send find-edit set-position 0 (send find-edit last-position))
(send (get-text-to-search) set-searching-str
(send find-edit get-text) #;
(send find-edit get-case-sensitive?)) (send txt set-searching-str
(send find-edit get-text)
(unless (memq search-panel (send super-root get-children)) (send find-edit get-case-sensitive?))
(send super-root add-child search-panel))
(reset-search-anchor (get-text-to-search)))) (unless (memq search-panel (send super-root get-children))
(send super-root add-child search-panel))
(when txt
(reset-search-anchor txt)))))
(define/private (undock) (define/private (undock)
(preferences:set 'framework:search-using-dialog? #t) (preferences:set 'framework:search-using-dialog? #t)
@ -2252,46 +2261,51 @@
(send find-edit get-text 0 (send find-edit last-position))))))) (send find-edit get-text 0 (send find-edit last-position)))))))
(define (replace&search) (define (replace&search)
(let ([text (get-text-to-search)]) (let ([text (get-text-to-search)])
(send text begin-edit-sequence) (when text
(when (replace) (send text begin-edit-sequence)
(search-again)) (when (replace)
(send text end-edit-sequence))) (search-again))
(send text end-edit-sequence))))
(define (replace-all) (define (replace-all)
(let* ([replacee-edit (get-text-to-search)] (let ([replacee-edit (get-text-to-search)])
[embeded-replacee-edit (find-embedded-focus-editor replacee-edit)] (when replacee-edit
[pos (if (eq? searching-direction 'forward) (let* ([embeded-replacee-edit (find-embedded-focus-editor replacee-edit)]
(send embeded-replacee-edit get-start-position) [pos (if (eq? searching-direction 'forward)
(send embeded-replacee-edit get-end-position))] (send embeded-replacee-edit get-start-position)
[done? (if (eq? 'forward searching-direction) (send embeded-replacee-edit get-end-position))]
(λ (x) (>= x (send replacee-edit last-position))) [done? (if (eq? 'forward searching-direction)
(λ (x) (<= x 0)))]) (λ (x) (>= x (send replacee-edit last-position)))
(send replacee-edit begin-edit-sequence) (λ (x) (<= x 0)))])
(when (search-again) (send replacee-edit begin-edit-sequence)
(send embeded-replacee-edit set-position pos) (when (search-again)
(let loop () (send embeded-replacee-edit set-position pos)
(when (send find-edit search #t #f #f) (let loop ()
(replace) (when (send find-edit search #t #f #f)
(loop)))) (replace)
(send replacee-edit end-edit-sequence))) (loop))))
(send replacee-edit end-edit-sequence)))))
(define (replace) (define (replace)
(let* ([search-text (send find-edit get-text)] (let ([search-text (send find-edit get-text)]
[replacee-edit (find-embedded-focus-editor (get-text-to-search))] [replacee-edit (let ([txt (get-text-to-search)])
[replacee-start (send replacee-edit get-start-position)] (and txt
[new-text (send replace-edit get-text)] (find-embedded-focus-editor txt)))])
[replacee (send replacee-edit get-text (and replacee-edit
replacee-start (let* ([replacee-start (send replacee-edit get-start-position)]
(send replacee-edit get-end-position))] [new-text (send replace-edit get-text)]
[cmp [replacee (send replacee-edit get-text
(if (send find-edit get-case-sensitive?) replacee-start
string=? (send replacee-edit get-end-position))]
string-ci=?)]) [cmp
(if (cmp replacee search-text) (if (send find-edit get-case-sensitive?)
(begin (send replacee-edit insert new-text) string=?
(send replacee-edit set-position string-ci=?)])
replacee-start (if (cmp replacee search-text)
(+ replacee-start (string-length new-text))) (begin (send replacee-edit insert new-text)
#t) (send replacee-edit set-position
#f))) replacee-start
(+ replacee-start (string-length new-text)))
#t)
#f)))))
(define/private (find-embedded-focus-editor editor) (define/private (find-embedded-focus-editor editor)
(let loop ([editor editor]) (let loop ([editor editor])
@ -2308,14 +2322,15 @@
(when find-canvas (when find-canvas
(set-searching-frame this) (set-searching-frame this)
(unhide-search) (unhide-search)
(send (cond (cond
[(send find-canvas has-focus?) [(send find-canvas has-focus?)
replace-canvas] (send replace-canvas focus)]
[(send replace-canvas has-focus?) [(send replace-canvas has-focus?)
(send (get-text-to-search) get-canvas)] (let ([txt (get-text-to-search)])
[else (when txt
find-canvas]) (send (send txt get-canvas) focus)))]
focus))) [else
(send find-canvas focus)])))
(define (move-to-search-or-search) (define (move-to-search-or-search)
(set-searching-frame this) (set-searching-frame this)
(unhide-search) (unhide-search)
@ -2422,7 +2437,9 @@
'forward 'forward
'backward)]) 'backward)])
(set-search-direction forward) (set-search-direction forward)
(reset-search-anchor (get-text-to-search))))))) (let ([txt (get-text-to-search)])
(when txt
(reset-search-anchor txt))))))))
(define _10 (define _10
(begin (begin
@ -2472,8 +2489,6 @@
(define searchable-text-mixin (define searchable-text-mixin
(mixin (text<%> searchable<%>) (searchable-text<%>) (mixin (text<%> searchable<%>) (searchable-text<%>)
(inherit get-editor) (inherit get-editor)
(define/override (get-text-to-search)
(get-editor))
(define/override (get-editor<%>) text:searching<%>) (define/override (get-editor<%>) text:searching<%>)
(define/override (get-editor%) text:searching%) (define/override (get-editor%) text:searching%)
(super-new))) (super-new)))

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

@ -578,6 +578,14 @@ WARNING: printf is rebound in the body of the unit to always
(redo-search) (redo-search)
(inner (void) after-delete start len)) (inner (void) after-delete start len))
(inherit get-top-level-window)
(define/override (on-focus on?)
(let ([f (get-top-level-window)])
(when (is-a? f frame:searchable<%>)
(when on?
(send f set-text-to-search this))))
(super on-focus on?))
(inherit highlight-range begin-edit-sequence end-edit-sequence find-string) (inherit highlight-range begin-edit-sequence end-edit-sequence find-string)
(define clear-regions void) (define clear-regions void)

12
collects/scribblings/framework/frame.scrbl
View File

@ -886,12 +886,12 @@
} }
@definterface[frame:searchable<%> (frame:basic<%>)]{ @definterface[frame:searchable<%> (frame:basic<%>)]{
Frames that implement this interface support searching. Frames that implement this interface support searching.
@defmethod*[(((get-text-to-search) (instance (subclass?/c text%))))]{ @defmethod*[(((get-text-to-search) (is-a?/c (subclass?/c text%))))]{
Override this method to specify which text to search. Returns the last value passed to
@method[frame:searchable<%> set-text-to-search].
}
Returns the result of @defmethod[(set-text-to-search [txt (or/c false/c (is-a?/c (subclass?/c text%)))]) void?]{
@method[frame:editor<%> get-editor]. Sets the current text to be searched.
} }
@defmethod*[(((hide-search) void))]{ @defmethod*[(((hide-search) void))]{
This method hides the searching information on the bottom of the This method hides the searching information on the bottom of the