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

...

Browse Source 
original commit: 90f71db9cc1823232674b22eafcc8713eb48fd93
This commit is contained in:
Robby Findler 2001-09-21 17:15:25 +00:00
parent 422acdfbb5
commit b45855ad5f
3 changed files with 79 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -843,7 +843,13 @@
(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)] [to-be-searched-canvas (send to-be-searched-text get-canvas)]
[dialog (make-object dialog% (string-constant find-and-replace) frame)] [allow-replace? (not (send to-be-searched-text is-locked?))]
[dialog (make-object dialog%
(if allow-replace?
(string-constant find-and-replace)
(string-constant find))
frame)]
[copy-text [copy-text
(lambda (from to) (lambda (from to)
@ -905,12 +911,13 @@
(lambda x (lambda x
(update-texts) (update-texts)
(send frame replace)))] (send frame replace)))]
[replace-button (make-object button% (string-constant replace&find-again) [replace-and-find-button (make-object button% (string-constant replace&find-again)
button-panel button-panel
(lambda x (lambda x
(update-texts) (update-texts)
(send frame replace&search)))] (send frame replace&search)))]
[replace-button (make-object button% (string-constant replace-to-end) button-panel [replace-to-end-button
(make-object button% (string-constant replace-to-end) button-panel
(lambda x (lambda x
(update-texts) (update-texts)
(send frame replace-all)))] (send frame replace-all)))]
@ -918,6 +925,21 @@
(lambda x (lambda x
(send to-be-searched-canvas force-display-focus #f) (send to-be-searched-canvas force-display-focus #f)
(send dialog show #f)))]) (send dialog show #f)))])
(unless allow-replace?
(send button-panel change-children
(lambda (l)
(remq
replace-button
(remq
replace-and-find-button
(remq
replace-to-end-button
l)))))
(send dialog change-children
(lambda (l)
(remq replace-panel l))))
(copy-text find-edit f-text) (copy-text find-edit f-text)
(copy-text replace-edit r-text) (copy-text replace-edit r-text)
(send find-canvas min-width 400) (send find-canvas min-width 400)
@ -1106,9 +1128,10 @@
top-searching-edit))] top-searching-edit))]
[not-found [not-found
(lambda (found-edit) (lambda (found-edit skip-beep?)
(send found-edit set-position search-anchor) (send found-edit set-position search-anchor)
(when beep? (when (and beep?
(not skip-beep?))
(bell)) (bell))
#f)] #f)]
[found [found
@ -1123,7 +1146,7 @@
#f #t 'local)) #f #t 'local))
#t))]) #t))])
(if (string=? string "") (if (string=? string "")
(not-found top-searching-edit) (not-found top-searching-edit #t)
(begin (begin
(when reset-search-anchor? (when reset-search-anchor?
(reset-search-anchor searching-edit)) (reset-search-anchor searching-edit))
@ -1146,9 +1169,9 @@
0 0
(send searching-edit last-position)))]) (send searching-edit last-position)))])
(if (not pos) (if (not pos)
(not-found found-edit) (not-found found-edit #f)
(found found-edit pos))) (found found-edit pos)))
(not-found found-edit))] (not-found found-edit #f))]
[else [else
(found found-edit first-pos)])))))))]) (found found-edit first-pos)])))))))])
(private-field (private-field
@ -1271,9 +1294,27 @@
(when (and hidden? (when (and hidden?
(not (preferences:get 'framework:search-using-dialog?))) (not (preferences:get 'framework:search-using-dialog?)))
(set! hidden? #f) (set! hidden? #f)
(show/hide-replace (send (get-text-to-search) is-locked?))
(send search-panel focus) (send search-panel focus)
(send super-root add-child search-panel) (send super-root add-child search-panel)
(reset-search-anchor (get-text-to-search))))] (reset-search-anchor (get-text-to-search))))]
(define (show/hide-replace hide?)
(cond
[hide?
(send replace-canvas-panel change-children
(lambda (l) null))
(send replace-button-panel change-children (lambda (l) null))
(send middle-middle-panel change-children (lambda (l) null))]
[else
(send replace-canvas-panel change-children
(lambda (l) (list replace-canvas)))
(send replace-button-panel change-children
(lambda (l) (list replace-button)))
(send middle-middle-panel change-children
(lambda (l) (list replace&search-button
replace-all-button)))]))
[define remove-callback [define remove-callback
(preferences:add-callback (preferences:add-callback
'framework:search-using-dialog? 'framework:search-using-dialog?
@ -1394,7 +1435,11 @@
[define left-panel (make-object vertical-panel% search-panel)] [define left-panel (make-object vertical-panel% search-panel)]
[define find-canvas (make-object searchable-canvas% left-panel)] [define find-canvas (make-object searchable-canvas% left-panel)]
[define replace-canvas (make-object searchable-canvas% left-panel)] [define replace-canvas-panel (instantiate vertical-panel% ()
(parent left-panel)
(stretchable-width #t)
(stretchable-height #f))]
[define replace-canvas (make-object searchable-canvas% replace-canvas-panel)]
[define middle-left-panel (make-object vertical-pane% search-panel)] [define middle-left-panel (make-object vertical-pane% search-panel)]
[define middle-middle-panel (make-object vertical-pane% search-panel)] [define middle-middle-panel (make-object vertical-pane% search-panel)]
@ -1405,12 +1450,21 @@
middle-left-panel middle-left-panel
(lambda args (search-again)))] (lambda args (search-again)))]
[define replace-button-panel
(instantiate vertical-panel% ()
(parent middle-left-panel)
(stretchable-width #f)
(stretchable-height #f))]
[define replace-button (make-object button% (string-constant replace)
replace-button-panel
(lambda x (replace)))]
[define replace&search-button (make-object button% [define replace&search-button (make-object button%
(string-constant replace&find-again) (string-constant replace&find-again)
middle-middle-panel middle-middle-panel
(lambda x (replace&search)))] (lambda x (replace&search)))]
[define replace-button (make-object button% (string-constant replace)
middle-left-panel (lambda x (replace)))]
[define replace-all-button (make-object button% [define replace-all-button (make-object button%
(string-constant replace-to-end) (string-constant replace-to-end)
middle-middle-panel middle-middle-panel
@ -1443,10 +1497,11 @@
(for-each (lambda (x) (send x set-alignment 'center 'center)) (for-each (lambda (x) (send x set-alignment 'center 'center))
(list middle-left-panel middle-middle-panel)) (list middle-left-panel middle-middle-panel))
(for-each (lambda (x) (send x stretchable-height #f)) (for-each (lambda (x) (send x stretchable-height #f))
(list search-panel left-panel middle-left-panel middle-middle-panel middle-right-panel)) (list search-panel middle-left-panel middle-middle-panel middle-right-panel))
(for-each (lambda (x) (send x stretchable-width #f)) (for-each (lambda (x) (send x stretchable-width #f))
(list middle-left-panel middle-middle-panel middle-right-panel)) (list middle-left-panel middle-middle-panel middle-right-panel))
(send find-canvas set-editor find-edit) (send find-canvas set-editor find-edit)
(send find-canvas stretchable-height #t)
(send replace-canvas set-editor replace-edit) (send replace-canvas set-editor replace-edit)
(hide-search #t))) (hide-search #t)))

1
collects/framework/private/group.ss
View File

@ -230,6 +230,7 @@
(if (test-frame frame) (if (test-frame frame)
frame frame
(loop (cdr frames))))]))))] (loop (cdr frames))))]))))]
(super-instantiate ()))) (super-instantiate ())))
(define (internal-get-the-frame-group) (define (internal-get-the-frame-group)

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

@ -339,8 +339,8 @@
'(string-constant find-again-info) '(string-constant find-again-info)
#f #f
#\g #\g
'(string-constant find-menu-item-before) '(string-constant find-again-menu-item-before)
'(string-constant find-menu-item-after) '(string-constant find-again-menu-item-after)
edit-menu:edit-target-on-demand) edit-menu:edit-target-on-demand)
(make-an-item 'edit-menu 'replace-and-find-again (make-an-item 'edit-menu 'replace-and-find-again
'(string-constant replace-and-find-again-info) '(string-constant replace-and-find-again-info)