more adjustments to searching and related things
svn: r10939 original commit: b088ac9c7451ebc5677205a7eb5225d2645a908f
This commit is contained in:
Robby Findler
parent
867379a910
commit
4c89307ee6
|
|
@ -1829,12 +1829,14 @@
|
|||
[else
|
||||
(found found-edit first-pos)]))))))))
|
||||
|
||||
(define callback-queued? #f)
|
||||
(define/private (update-searching-str)
|
||||
(let ([tlw (get-top-level-window)])
|
||||
(when tlw
|
||||
(let ([txt (send tlw get-text-to-search)])
|
||||
(when txt
|
||||
(update-searching-str/cs txt (get-case-sensitive-search?)))))))
|
||||
|
||||
|
||||
(define/public (text-to-search-changed old new)
|
||||
(when old
|
||||
|
|
@ -1895,6 +1897,17 @@
|
|||
(set-styles-fixed #t)))
|
||||
|
||||
(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 add-function "find"
|
||||
(λ (text evt)
|
||||
|
|
@ -1928,7 +1941,10 @@
|
|||
(super on-paint))
|
||||
(super-new)))
|
||||
|
||||
(define-local-member-name update-matches)
|
||||
(define-local-member-name
|
||||
update-matches
|
||||
get-find-edit
|
||||
get-replace-edit)
|
||||
|
||||
(define searchable-mixin
|
||||
(mixin (standard-menus<%>) (searchable<%>)
|
||||
|
|
@ -1937,20 +1953,35 @@
|
|||
(define case-sensitive-search? (preferences:get 'framework: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:find-backwards-callback menu evt) (search 'backward) #t)
|
||||
(define/override (edit-menu:create-find-backwards?) #t)
|
||||
(define/override (edit-menu:find-again-callback menu evt) (search 'forward) #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:replace-and-find-on-demand item) (send item enable (can-replace?)))
|
||||
(define/override (edit-menu:create-replace-and-find?) #t)
|
||||
(define/override (edit-menu:find-again-backwards-callback menu evt) (search 'backward) #t)
|
||||
(define/override (edit-menu:create-find-again-backwards?) #t)
|
||||
|
||||
(define/override (edit-menu:replace-and-find-backwards-callback menu evt) (replace&search 'backward) #t)
|
||||
(define/override (edit-menu:replace-and-find-backwards-on-demand item)
|
||||
(define/override (edit-menu:replace-and-find-again-callback menu evt) (replace&search 'forward) #t)
|
||||
(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?)))
|
||||
(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)
|
||||
(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: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
|
||||
(λ (% parent)
|
||||
(let* ([s-root (super make-root-area-container
|
||||
|
|
@ -2026,11 +2044,11 @@
|
|||
(when hidden?
|
||||
(set! hidden? #f)
|
||||
(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)
|
||||
(unless (memq search/replace-panel (send super-root get-children))
|
||||
(send super-root add-child search/replace-panel))
|
||||
(when focus?
|
||||
(send find-edit set-position 0 (send find-edit last-position))
|
||||
(send (send find-edit get-canvas) focus))))
|
||||
|
||||
(define/public (can-replace?)
|
||||
|
|
@ -2143,6 +2161,9 @@
|
|||
(define find-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)
|
||||
|
||||
(define/private (build-search-gui-in-frame)
|
||||
|
|
@ -2155,14 +2176,17 @@
|
|||
(define _0 (set! search/replace-panel (new horizontal-panel%
|
||||
[parent super-root]
|
||||
[stretchable-height #f])))
|
||||
(define search-panel (new horizontal-panel%
|
||||
[parent search/replace-panel]
|
||||
[stretchable-height #f]))
|
||||
(define replace-panel (new horizontal-panel%
|
||||
[parent search/replace-panel]
|
||||
[stretchable-height #f]))
|
||||
(define search-panel
|
||||
(new horizontal-panel%
|
||||
[parent search/replace-panel]
|
||||
[stretchable-height #f]))
|
||||
(define replace-panel
|
||||
(new horizontal-panel%
|
||||
[parent search/replace-panel]
|
||||
[stretchable-height #f]))
|
||||
(define _1 (set! find-canvas (new searchable-canvas%
|
||||
[style '(hide-hscroll hide-vscroll)]
|
||||
[vertical-inset 2]
|
||||
[parent search-panel]
|
||||
[editor find-edit]
|
||||
[line-count 1]
|
||||
|
|
@ -2170,16 +2194,19 @@
|
|||
[stretchable-width #t])))
|
||||
(define _3 (set! replace-canvas (new searchable-canvas%
|
||||
[style '(hide-hscroll hide-vscroll)]
|
||||
[vertical-inset 2]
|
||||
[parent replace-panel]
|
||||
[editor replace-edit]
|
||||
[line-count 1]
|
||||
[stretchable-height #f]
|
||||
[stretchable-width #t])))
|
||||
|
||||
(define search-button (make-object button%
|
||||
(string-constant find)
|
||||
search-panel
|
||||
(λ (x y) (search 'forward))))
|
||||
(define search-button (new button%
|
||||
[label (string-constant find)]
|
||||
[vert-margin 0]
|
||||
[parent search-panel]
|
||||
[callback (λ (x y) (search 'forward))]
|
||||
[font small-control-font]))
|
||||
|
||||
(define hits-panel (new vertical-panel%
|
||||
[parent search-panel]
|
||||
|
|
@ -2189,37 +2216,47 @@
|
|||
|
||||
(define num-msg (new message%
|
||||
[label "0"]
|
||||
[vert-margin 0]
|
||||
[auto-resize #t]
|
||||
[font small-control-font]
|
||||
[parent hits-panel]))
|
||||
(define mth-msg (new message%
|
||||
[label "Matches"]
|
||||
[font small-control-font]
|
||||
[font tiny-control-font]
|
||||
[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
|
||||
(λ (m)
|
||||
(send mth-msg set-label (if (= m 1) "Match" "Matches"))
|
||||
(send num-msg set-label
|
||||
(list->string
|
||||
(reverse
|
||||
(let loop ([chars (reverse (string->list (format "~a" m)))])
|
||||
(cond
|
||||
[(<= (length chars) 3)
|
||||
chars]
|
||||
[else (list* (list-ref chars 0)
|
||||
(list-ref chars 1)
|
||||
(list-ref chars 2)
|
||||
#\,
|
||||
(loop (cdddr chars)))]))))))))
|
||||
(let ([number
|
||||
(list->string
|
||||
(reverse
|
||||
(let loop ([chars (reverse (string->list (format "~a" m)))])
|
||||
(cond
|
||||
[(<= (length chars) 3)
|
||||
chars]
|
||||
[else (list* (list-ref chars 0)
|
||||
(list-ref chars 1)
|
||||
(list-ref chars 2)
|
||||
#\,
|
||||
(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%
|
||||
(string-constant replace-all-menu-item)
|
||||
replace-panel
|
||||
(λ x (replace-all))))
|
||||
(define replace&search-button
|
||||
(new button%
|
||||
[label (string-constant replace&find)]
|
||||
[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)
|
||||
search/replace-panel
|
||||
(λ args (hide-search))))
|
||||
(define hide-button (new button%
|
||||
[label (string-constant hide)]
|
||||
[vert-margin 0]
|
||||
[parent search/replace-panel]
|
||||
[font small-control-font]
|
||||
[callback (λ (x y) (hide-search))]))
|
||||
|
||||
(void))
|
||||
(end-container-sequence)))
|
||||
|
|
|
|||
|
|
@ -967,7 +967,9 @@
|
|||
(λ ()
|
||||
(let loop ([obj frame])
|
||||
(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)
|
||||
(k (void))]
|
||||
[(and (is-a? obj window<%>) (send obj has-focus?))
|
||||
|
|
|
|||
|
|
@ -359,28 +359,37 @@
|
|||
'(string-constant find-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'find-backwards
|
||||
'(string-constant find-backwards-info)
|
||||
'(λ (item control) (void))
|
||||
#\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)
|
||||
|
||||
(make-an-item 'edit-menu 'find-again
|
||||
'(string-constant find-again-info)
|
||||
'(λ (item control) (void))
|
||||
#\g
|
||||
'(get-default-shortcut-prefix)
|
||||
'(string-constant replace-and-find-menu-item)
|
||||
'(string-constant find-again-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'replace-and-find-backwards
|
||||
'(string-constant replace-and-find-backwards-info)
|
||||
(make-an-item 'edit-menu 'find-again-backwards
|
||||
'(string-constant find-again-backwards-info)
|
||||
'(λ (item control) (void))
|
||||
#\g
|
||||
'(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
|
||||
#f)
|
||||
(make-an-item 'edit-menu 'replace-all
|
||||
|
|
@ -391,17 +400,6 @@
|
|||
'(string-constant replace-all-menu-item)
|
||||
edit-menu:edit-target-on-demand
|
||||
#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
|
||||
'(string-constant find-case-sensitive-info)
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
;; since they are already covered
|
||||
;; by `start-x' and `end-x'
|
||||
(let loop ([l start-x]
|
||||
[r end-x]
|
||||
[line (+ (position-line start start-eol?) 1)])
|
||||
(let loop ([l (min start-x end-x)]
|
||||
[r (max start-x end-x)]
|
||||
[line (position-line start start-eol?)])
|
||||
|
||||
(cond
|
||||
[(>= 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 ...
|
||||
[(> line end-line)
|
||||
(cons
|
||||
(make-rectangle l
|
||||
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)])
|
||||
(position-location line-start b1 #f #t)
|
||||
(position-location line-end b2 #f #t)
|
||||
(loop (min (unbox b1) l)
|
||||
(max (unbox b2) r)
|
||||
(loop (min (unbox b1) (unbox b2) l)
|
||||
(max (unbox b1) (unbox b2) r)
|
||||
(+ line 1)))])))]
|
||||
[else
|
||||
(list*
|
||||
|
|
@ -627,18 +624,26 @@ WARNING: printf is rebound in the body of the unit to always
|
|||
|
||||
(define updating-search? #f)
|
||||
|
||||
(define timer #f)
|
||||
(define/private (content-changed)
|
||||
(when searching-str
|
||||
(run-after-edit-sequence
|
||||
(λ ()
|
||||
(set! updating-search? #t)
|
||||
(redo-search)
|
||||
(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)))
|
||||
(unless timer
|
||||
(set! timer
|
||||
(new timer%
|
||||
[notify-callback
|
||||
(λ ()
|
||||
(run-after-edit-sequence
|
||||
(λ ()
|
||||
(set! updating-search? #t)
|
||||
(redo-search)
|
||||
(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)
|
||||
(define/override (on-focus on?)
|
||||
|
|
|
|||
|
|
@ -953,51 +953,60 @@ framework)) @(require (for-label scheme/gui)) @(require
|
|||
@scheme[editor<%>]
|
||||
in this frame.
|
||||
|
||||
@defmethod*[#:mode override (((edit-menu:find-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:find-callback) boolean?))]{
|
||||
Toggles the focus between the find window and the window being searched.
|
||||
When moving to the window with the search string, selects the entire
|
||||
range in the buffer.
|
||||
}
|
||||
@defmethod*[#:mode override (((edit-menu:create-find?) boolean?))]{
|
||||
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
|
||||
@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].
|
||||
}
|
||||
|
||||
@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<%> 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
|
||||
@method[frame:searchable<%> can-replace?]
|
||||
returns @scheme[#f] and enables it when that method returns
|
||||
@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].
|
||||
}
|
||||
|
||||
@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<%> 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
|
||||
@method[frame:searchable<%> can-replace?]
|
||||
returns @scheme[#f] and enables it when that method returns
|
||||
@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].
|
||||
}
|
||||
|
|
@ -1031,17 +1040,6 @@ framework)) @(require (for-label scheme/gui)) @(require
|
|||
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<%>)))]{
|
||||
|
||||
Builds a panel for the searching information.
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user