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

more adjustments to searching and related things

Browse Source 
svn: r10939

original commit: b088ac9c7451ebc5677205a7eb5225d2645a908f
This commit is contained in:
Robby Findler 2008-07-28 03:48:23 +00:00
parent 867379a910
commit 4c89307ee6
5 changed files with 167 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1829,12 +1829,14 @@
[else [else
(found found-edit first-pos)])))))))) (found found-edit first-pos)]))))))))
(define callback-queued? #f)
(define/private (update-searching-str) (define/private (update-searching-str)
(let ([tlw (get-top-level-window)]) (let ([tlw (get-top-level-window)])
(when tlw (when tlw
(let ([txt (send tlw get-text-to-search)]) (let ([txt (send tlw get-text-to-search)])
(when txt (when txt
(update-searching-str/cs txt (get-case-sensitive-search?))))))) (update-searching-str/cs txt (get-case-sensitive-search?)))))))
(define/public (text-to-search-changed old new) (define/public (text-to-search-changed old new)
(when old (when old
@ -1895,6 +1897,17 @@
(set-styles-fixed #t))) (set-styles-fixed #t)))
(define search/replace-keymap (new keymap%)) (define search/replace-keymap (new keymap%))
(send search/replace-keymap map-function "tab" "switch-between-search-and-replace")
(send search/replace-keymap add-function "switch-between-search-and-replace"
(λ (text evt)
(let ([find-txt (send (send text get-top-level-window) get-find-edit)]
[replace-txt (send (send text get-top-level-window) get-replace-edit)])
(cond
[(eq? find-txt text)
(send (send replace-txt get-canvas) focus)]
[(eq? replace-txt text)
(send (send find-txt get-canvas) focus)]))))
(send search/replace-keymap map-function "return" "find") (send search/replace-keymap map-function "return" "find")
(send search/replace-keymap add-function "find" (send search/replace-keymap add-function "find"
(λ (text evt) (λ (text evt)
@ -1928,7 +1941,10 @@
(super on-paint)) (super on-paint))
(super-new))) (super-new)))
(define-local-member-name update-matches) (define-local-member-name
update-matches
get-find-edit
get-replace-edit)
(define searchable-mixin (define searchable-mixin
(mixin (standard-menus<%>) (searchable<%>) (mixin (standard-menus<%>) (searchable<%>)
@ -1937,20 +1953,35 @@
(define case-sensitive-search? (preferences:get 'framework:case-sensitive-search?)) (define case-sensitive-search? (preferences:get 'framework:case-sensitive-search?))
(define/public (get-case-sensitive-search?) case-sensitive-search?) (define/public (get-case-sensitive-search?) case-sensitive-search?)
(define/override (edit-menu:find-callback menu evt) (search 'forward) #t) (define/override (edit-menu:find-callback menu evt)
(cond
[hidden?
(unhide-search #t)]
[(or (not text-to-search)
(send (send text-to-search get-canvas) has-focus?))
(send find-edit set-position 0 (send find-edit last-position))
(send find-canvas focus)]
[else
(let ([canvas (send text-to-search get-canvas)])
(when canvas
(send canvas focus)))])
#t)
(define/override (edit-menu:create-find?) #t) (define/override (edit-menu:create-find?) #t)
(define/override (edit-menu:find-backwards-callback menu evt) (search 'backward) #t) (define/override (edit-menu:find-again-callback menu evt) (search 'forward) #t)
(define/override (edit-menu:create-find-backwards?) #t) (define/override (edit-menu:create-find-again?) #t)
(define/override (edit-menu:replace-and-find-callback menu evt) (replace&search 'forward) #t) (define/override (edit-menu:find-again-backwards-callback menu evt) (search 'backward) #t)
(define/override (edit-menu:replace-and-find-on-demand item) (send item enable (can-replace?))) (define/override (edit-menu:create-find-again-backwards?) #t)
(define/override (edit-menu:create-replace-and-find?) #t)
(define/override (edit-menu:replace-and-find-backwards-callback menu evt) (replace&search 'backward) #t) (define/override (edit-menu:replace-and-find-again-callback menu evt) (replace&search 'forward) #t)
(define/override (edit-menu:replace-and-find-backwards-on-demand item) (define/override (edit-menu:replace-and-find-again-on-demand item) (send item enable (can-replace?)))
(define/override (edit-menu:create-replace-and-find-again?) #t)
(define/override (edit-menu:replace-and-find-again-backwards-callback menu evt) (replace&search 'backward) #t)
(define/override (edit-menu:replace-and-find-again-backwards-on-demand item)
(send item enable (can-replace?))) (send item enable (can-replace?)))
(define/override edit-menu:create-replace-and-find-backwards? (λ () #t)) (define/override edit-menu:create-replace-and-find-again-backwards? (λ () #t))
(define/override (edit-menu:find-case-sensitive-callback menu evt) (define/override (edit-menu:find-case-sensitive-callback menu evt)
(set! case-sensitive-search? (not case-sensitive-search?)) (set! case-sensitive-search? (not case-sensitive-search?))
@ -1965,19 +1996,6 @@
(define/override (edit-menu:replace-all-on-demand item) (send item enable (can-replace?))) (define/override (edit-menu:replace-all-on-demand item) (send item enable (can-replace?)))
(define/override (edit-menu:create-replace-all?) #t) (define/override (edit-menu:create-replace-all?) #t)
(define/override (edit-menu:create-toggle-find-focus?) #t)
(define/override (edit-menu:toggle-find-focus-callback menu evt)
(cond
[hidden?
(unhide-search #t)]
[(or (not text-to-search)
(send (send text-to-search get-canvas) has-focus?))
(send find-canvas focus)]
[else
(let ([canvas (send text-to-search get-canvas)])
(when canvas
(send canvas focus)))]))
(define/override make-root-area-container (define/override make-root-area-container
(λ (% parent) (λ (% parent)
(let* ([s-root (super make-root-area-container (let* ([s-root (super make-root-area-container
@ -2026,11 +2044,11 @@
(when hidden? (when hidden?
(set! hidden? #f) (set! hidden? #f)
(build-search-gui-in-frame) (build-search-gui-in-frame)
(send find-edit set-position 0 (send find-edit last-position))
(send find-edit text-to-search-changed #f text-to-search) (send find-edit text-to-search-changed #f text-to-search)
(unless (memq search/replace-panel (send super-root get-children)) (unless (memq search/replace-panel (send super-root get-children))
(send super-root add-child search/replace-panel)) (send super-root add-child search/replace-panel))
(when focus? (when focus?
(send find-edit set-position 0 (send find-edit last-position))
(send (send find-edit get-canvas) focus)))) (send (send find-edit get-canvas) focus))))
(define/public (can-replace?) (define/public (can-replace?)
@ -2143,6 +2161,9 @@
(define find-edit #f) (define find-edit #f)
(define replace-edit #f) (define replace-edit #f)
(define/public (get-find-edit) find-edit)
(define/public (get-replace-edit) replace-edit)
(inherit begin-container-sequence end-container-sequence) (inherit begin-container-sequence end-container-sequence)
(define/private (build-search-gui-in-frame) (define/private (build-search-gui-in-frame)
@ -2155,14 +2176,17 @@
(define _0 (set! search/replace-panel (new horizontal-panel% (define _0 (set! search/replace-panel (new horizontal-panel%
[parent super-root] [parent super-root]
[stretchable-height #f]))) [stretchable-height #f])))
(define search-panel (new horizontal-panel% (define search-panel
[parent search/replace-panel] (new horizontal-panel%
[stretchable-height #f])) [parent search/replace-panel]
(define replace-panel (new horizontal-panel% [stretchable-height #f]))
[parent search/replace-panel] (define replace-panel
[stretchable-height #f])) (new horizontal-panel%
[parent search/replace-panel]
[stretchable-height #f]))
(define _1 (set! find-canvas (new searchable-canvas% (define _1 (set! find-canvas (new searchable-canvas%
[style '(hide-hscroll hide-vscroll)] [style '(hide-hscroll hide-vscroll)]
[vertical-inset 2]
[parent search-panel] [parent search-panel]
[editor find-edit] [editor find-edit]
[line-count 1] [line-count 1]
@ -2170,16 +2194,19 @@
[stretchable-width #t]))) [stretchable-width #t])))
(define _3 (set! replace-canvas (new searchable-canvas% (define _3 (set! replace-canvas (new searchable-canvas%
[style '(hide-hscroll hide-vscroll)] [style '(hide-hscroll hide-vscroll)]
[vertical-inset 2]
[parent replace-panel] [parent replace-panel]
[editor replace-edit] [editor replace-edit]
[line-count 1] [line-count 1]
[stretchable-height #f] [stretchable-height #f]
[stretchable-width #t]))) [stretchable-width #t])))
(define search-button (make-object button% (define search-button (new button%
(string-constant find) [label (string-constant find)]
search-panel [vert-margin 0]
(λ (x y) (search 'forward)))) [parent search-panel]
[callback (λ (x y) (search 'forward))]
[font small-control-font]))
(define hits-panel (new vertical-panel% (define hits-panel (new vertical-panel%
[parent search-panel] [parent search-panel]
@ -2189,37 +2216,47 @@
(define num-msg (new message% (define num-msg (new message%
[label "0"] [label "0"]
[vert-margin 0]
[auto-resize #t] [auto-resize #t]
[font small-control-font] [font tiny-control-font]
[parent hits-panel]))
(define mth-msg (new message%
[label "Matches"]
[font small-control-font]
[parent hits-panel])) [parent hits-panel]))
(define matches-msg (new message%
[label "Matches"]
[vert-margin 0]
[font tiny-control-font]
[parent hits-panel]))
(define _6 (set! update-matches (define _6 (set! update-matches
(λ (m) (λ (m)
(send mth-msg set-label (if (= m 1) "Match" "Matches")) (let ([number
(send num-msg set-label (list->string
(list->string (reverse
(reverse (let loop ([chars (reverse (string->list (format "~a" m)))])
(let loop ([chars (reverse (string->list (format "~a" m)))]) (cond
(cond [(<= (length chars) 3)
[(<= (length chars) 3) chars]
chars] [else (list* (list-ref chars 0)
[else (list* (list-ref chars 0) (list-ref chars 1)
(list-ref chars 1) (list-ref chars 2)
(list-ref chars 2) #\,
#\, (loop (cdddr chars)))]))))])
(loop (cdddr chars)))])))))))) (send num-msg set-label number)
(send matches-msg set-label (if (= m 1) "Match" "Matches"))))))
(define replace-all-button (make-object button% (define replace&search-button
(string-constant replace-all-menu-item) (new button%
replace-panel [label (string-constant replace&find)]
(λ x (replace-all)))) [vert-margin 0]
[parent replace-panel]
[font small-control-font]
[callback (λ (x y) (replace&search 'forward))]))
(define hide-button (make-object button% (string-constant hide) (define hide-button (new button%
search/replace-panel [label (string-constant hide)]
(λ args (hide-search)))) [vert-margin 0]
[parent search/replace-panel]
[font small-control-font]
[callback (λ (x y) (hide-search))]))
(void)) (void))
(end-container-sequence))) (end-container-sequence)))

4
collects/framework/private/keymap.ss
View File

@ -967,7 +967,9 @@
(λ () (λ ()
(let loop ([obj frame]) (let loop ([obj frame])
(cond (cond
[(and found-one? (is-a? obj editor-canvas%)) [(and found-one?
(is-a? obj editor-canvas%)
(is-a? (send obj get-editor) editor:keymap<%>))
(send obj focus) (send obj focus)
(k (void))] (k (void))]
[(and (is-a? obj window<%>) (send obj has-focus?)) [(and (is-a? obj window<%>) (send obj has-focus?))

48
collects/framework/private/standard-menus-items.ss
View File

@ -359,28 +359,37 @@
'(string-constant find-menu-item) '(string-constant find-menu-item)
edit-menu:edit-target-on-demand edit-menu:edit-target-on-demand
#f) #f)
(make-an-item 'edit-menu 'find-backwards
'(string-constant find-backwards-info) (make-an-item 'edit-menu 'find-again
'(λ (item control) (void)) '(string-constant find-again-info)
#\f
'(cons 'shift (get-default-shortcut-prefix))
'(string-constant find-backwards-menu-item)
edit-menu:edit-target-on-demand
#f)
(make-an-item 'edit-menu 'replace-and-find
'(string-constant replace-and-find-info)
'(λ (item control) (void)) '(λ (item control) (void))
#\g #\g
'(get-default-shortcut-prefix) '(get-default-shortcut-prefix)
'(string-constant replace-and-find-menu-item) '(string-constant find-again-menu-item)
edit-menu:edit-target-on-demand edit-menu:edit-target-on-demand
#f) #f)
(make-an-item 'edit-menu 'replace-and-find-backwards (make-an-item 'edit-menu 'find-again-backwards
'(string-constant replace-and-find-backwards-info) '(string-constant find-again-backwards-info)
'(λ (item control) (void)) '(λ (item control) (void))
#\g #\g
'(cons 'shift (get-default-shortcut-prefix)) '(cons 'shift (get-default-shortcut-prefix))
'(string-constant replace-and-find-backwards-menu-item) '(string-constant find-again-backwards-menu-item)
edit-menu:edit-target-on-demand
#f)
(make-an-item 'edit-menu 'replace-and-find-again
'(string-constant replace-and-find-again-info)
'(λ (item control) (void))
#\r
'(get-default-shortcut-prefix)
'(string-constant replace-and-find-again-menu-item)
edit-menu:edit-target-on-demand
#f)
(make-an-item 'edit-menu 'replace-and-find-again-backwards
'(string-constant replace-and-find-again-backwards-info)
'(λ (item control) (void))
#\r
'(cons 'shift (get-default-shortcut-prefix))
'(string-constant replace-and-find-again-backwards-menu-item)
edit-menu:edit-target-on-demand edit-menu:edit-target-on-demand
#f) #f)
(make-an-item 'edit-menu 'replace-all (make-an-item 'edit-menu 'replace-all
@ -391,17 +400,6 @@
'(string-constant replace-all-menu-item) '(string-constant replace-all-menu-item)
edit-menu:edit-target-on-demand edit-menu:edit-target-on-demand
#f) #f)
(make-an-item 'edit-menu 'toggle-find-focus
'(string-constant toggle-find-focus-info)
'(λ (item control) (void))
#\f
'(cons (case (system-type)
[(macosx) 'option]
[else 'alt])
(get-default-shortcut-prefix))
'(string-constant toggle-find-focus)
'(λ (item) (void))
#f)
(make-a-checkable-item 'edit-menu 'find-case-sensitive (make-a-checkable-item 'edit-menu 'find-case-sensitive
'(string-constant find-case-sensitive-info) '(string-constant find-case-sensitive-info)

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

@ -279,15 +279,12 @@ WARNING: printf is rebound in the body of the unit to always
;; we don't need to consider the first or the last line, ;; we don't need to consider the first or the last line,
;; since they are already covered ;; since they are already covered
;; by `start-x' and `end-x' ;; by `start-x' and `end-x'
(let loop ([l start-x] (let loop ([l (min start-x end-x)]
[r end-x] [r (max start-x end-x)]
[line (+ (position-line start start-eol?) 1)]) [line (position-line start start-eol?)])
(cond (cond
[(>= line end-line) [(> line end-line)
;; techincally, the > should not be needed, but we
;; would rather have bad drawing than an infinite loop
;; in the case that there is a bug ...
(cons (cons
(make-rectangle l (make-rectangle l
top-start-y top-start-y
@ -301,8 +298,8 @@ WARNING: printf is rebound in the body of the unit to always
[line-end (line-end-position line)]) [line-end (line-end-position line)])
(position-location line-start b1 #f #t) (position-location line-start b1 #f #t)
(position-location line-end b2 #f #t) (position-location line-end b2 #f #t)
(loop (min (unbox b1) l) (loop (min (unbox b1) (unbox b2) l)
(max (unbox b2) r) (max (unbox b1) (unbox b2) r)
(+ line 1)))])))] (+ line 1)))])))]
[else [else
(list* (list*
@ -627,18 +624,26 @@ WARNING: printf is rebound in the body of the unit to always
(define updating-search? #f) (define updating-search? #f)
(define timer #f)
(define/private (content-changed) (define/private (content-changed)
(when searching-str (when searching-str
(run-after-edit-sequence (unless timer
(λ () (set! timer
(set! updating-search? #t) (new timer%
(redo-search) [notify-callback
(let ([tlw (get-top-level-window)]) (λ ()
(when (and tlw (run-after-edit-sequence
(is-a? tlw frame:searchable<%>)) (λ ()
(send tlw search-results-changed))) (set! updating-search? #t)
(set! updating-search? #f)) (redo-search)
'framework:search-results-changed))) (let ([tlw (get-top-level-window)])
(when (and tlw
(is-a? tlw frame:searchable<%>))
(send tlw search-results-changed)))
(set! updating-search? #f))
'framework:search-results-changed))]
[just-once? #t])))
(send timer start 500 #t)))
(inherit get-top-level-window) (inherit get-top-level-window)
(define/override (on-focus on?) (define/override (on-focus on?)

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

@ -953,51 +953,60 @@ framework)) @(require (for-label scheme/gui)) @(require
@scheme[editor<%>] @scheme[editor<%>]
in this frame. in this frame.
@defmethod*[#:mode override (((edit-menu:find-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{ @defmethod*[#:mode override (((edit-menu:find-callback) boolean?))]{
Toggles the focus between the find window and the window being searched.
Calls @method[frame:searchable unhide-search] and then When moving to the window with the search string, selects the entire
@method[frame:searchable<%> search]. range in the buffer.
} }
@defmethod*[#:mode override (((edit-menu:create-find?) boolean?))]{ @defmethod*[#:mode override (((edit-menu:create-find?) boolean?))]{
returns @scheme[#t]. returns @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:find-backwards-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
@defmethod*[#:mode override (((edit-menu:find-again-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
Calls @method[frame:searchable unhide-search] and then Calls @method[frame:searchable unhide-search] and then
@method[frame:searchable<%> search]. @method[frame:searchable<%> search].
} }
@defmethod*[#:mode override (((edit-menu:create-find-backwards?) boolean?))]{ @defmethod*[#:mode override (((edit-menu:create-find-again?) boolean?))]{
returns @scheme[#t].
}
@defmethod*[#:mode override (((edit-menu:find-again-backwards-callback (item (is-a?/c menu-item%)) (evt (is-a?/c control-event%))) void?))]{
Calls @method[frame:searchable unhide-search] and then
@method[frame:searchable<%> search].
}
@defmethod*[#:mode override (((edit-menu:create-find-again-backwards?) boolean?))]{
returns @scheme[#t]. returns @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:replace-and-find-callback) boolean?))]{ @defmethod*[#:mode override (((edit-menu:replace-and-find-again-callback) boolean?))]{
Calls @method[frame:searchable unhide-search] and then Calls @method[frame:searchable unhide-search] and then
calls @method[frame:searchable<%> replace&search]. calls @method[frame:searchable<%> replace&search].
} }
@defmethod*[#:mode override (((edit-menu:replace-and-find-on-demand (item menu-item%)) void))]{ @defmethod*[#:mode override (((edit-menu:replace-and-find-again-on-demand (item menu-item%)) void))]{
Disables @scheme[item] when Disables @scheme[item] when
@method[frame:searchable<%> can-replace?] @method[frame:searchable<%> can-replace?]
returns @scheme[#f] and enables it when that method returns returns @scheme[#f] and enables it when that method returns
@scheme[#t]. @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:create-replace-and-find?) boolean?))]{ @defmethod*[#:mode override (((edit-menu:create-replace-and-find-again?) boolean?))]{
returns @scheme[#t]. returns @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:replace-and-find-backwards-callback) boolean?))]{ @defmethod*[#:mode override (((edit-menu:replace-and-find-again-backwards-callback) boolean?))]{
Calls @method[frame:searchable unhide-search] and then Calls @method[frame:searchable unhide-search] and then
calls @method[frame:searchable<%> replace&search]. calls @method[frame:searchable<%> replace&search].
} }
@defmethod*[#:mode override (((edit-menu:replace-and-find-backwards-on-demand (item menu-item%)) void))]{ @defmethod*[#:mode override (((edit-menu:replace-and-find-again-backwards-on-demand (item menu-item%)) void))]{
Disables @scheme[item] when Disables @scheme[item] when
@method[frame:searchable<%> can-replace?] @method[frame:searchable<%> can-replace?]
returns @scheme[#f] and enables it when that method returns returns @scheme[#f] and enables it when that method returns
@scheme[#t]. @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:create-replace-and-find-backwards?) boolean?))]{ @defmethod*[#:mode override (((edit-menu:create-replace-and-find-again-backwards?) boolean?))]{
returns @scheme[#t]. returns @scheme[#t].
} }
@ -1031,17 +1040,6 @@ framework)) @(require (for-label scheme/gui)) @(require
returns @scheme[#t]. returns @scheme[#t].
} }
@defmethod*[#:mode override (((edit-menu:toggle-find-focus-callback) boolean?))]{
toggles the focus between the find window and the window being searched.
}
@defmethod*[#:mode override (((edit-menu:create-toggle-find-focus?) boolean?))]{
returns @scheme[#t].
}
@defmethod*[#:mode override (((make-root-area-container) (is-a?/c area-container<%>)))]{ @defmethod*[#:mode override (((make-root-area-container) (is-a?/c area-container<%>)))]{
Builds a panel for the searching information. Builds a panel for the searching information.