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

..

Browse Source 
original commit: a5f57c6907ebaa68449195980a382247cf28540a
This commit is contained in:
Robby Findler 2003-09-03 19:35:15 +00:00
parent 113aab5fc4
commit b2cab72ff6
1 changed files with 106 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3,7 +3,6 @@
(require (lib "string-constant.ss" "string-constants")
(lib "unitsig.ss")
(lib "class.ss")
(lib "class100.ss")
(lib "include.ss")
"sig.ss"
"../gui-utils.ss"
@ -1565,18 +1564,17 @@
(loop (send snip next)))))]
[text-keymap/editor%
(class100 text:keymap% args
(class text:keymap%
(rename [super-get-keymaps get-keymaps])
(override
[get-keymaps
(lambda ()
(define/override (get-keymaps)
(if (preferences:get 'framework:menu-bindings)
(append (list (keymap:get-editor))
(super-get-keymaps))
(append (super-get-keymaps)
(list (keymap:get-editor)))))])
(sequence
(apply super-init args)))]
(list (keymap:get-editor)))))
(inherit set-styles-fixed)
(super-new)
(set-styles-fixed #t))]
[find-panel (make-object horizontal-panel% dialog)]
@ -1812,18 +1810,15 @@
(set! searching-frame frame))
(define find-text%
(class100 text:keymap% args
(class text:keymap%
(inherit get-text)
(rename [super-after-insert after-insert]
[super-after-delete after-delete]
[super-on-focus on-focus])
(private
[get-searching-edit
(lambda ()
(define/private (get-searching-edit)
(and searching-frame
(send searching-frame get-text-to-search)))])
(public
[search
(send searching-frame get-text-to-search)))
(define/public search
(opt-lambda ([reset-search-anchor? #t] [beep? #t] [wrap? #t])
(when searching-frame
(let* ([string (get-text)]
@ -1880,58 +1875,51 @@
(found found-edit pos)))
(not-found found-edit #f))]
[else
(found found-edit first-pos)])))))))])
(private-field
(found found-edit first-pos)]))))))))
(field
[dont-search #f])
(public
[stop-searching
(lambda ()
(set! dont-search #t))]
[start-searching
(lambda ()
(set! dont-search #f))])
(define/public (stop-searching)
(set! dont-search #t))
(define/public (start-searching)
(set! dont-search #f))
(override
[on-focus
(lambda (on?)
(define/override (on-focus on?)
(when on?
(let ([edit (get-searching-edit)])
(when edit
(reset-search-anchor (get-searching-edit)))))
(super-on-focus on?))]
[after-insert
(lambda (x y)
(super-on-focus on?))
(define/override (after-insert x y)
(super-after-insert x y)
(unless dont-search
(search #f)))]
[after-delete
(lambda (x y)
(search #f)))
(define/override (after-delete x y)
(super-after-delete x y)
(unless dont-search
(search #f)))])
(sequence (apply super-init args))))
(search #f)))
(super-new)
(inherit set-styles-fixed)
(set-styles-fixed #t)))
; this is here for when editors are printed, during debugging
(define replace-text%
(class text:keymap%
(super-instantiate ())))
(inherit set-styles-fixed)
(super-instantiate ())
(set-styles-fixed #t)))
(define find-edit #f)
(define replace-edit #f)
(define searchable-canvas%
(class100 editor-canvas% (parent)
(class editor-canvas%
(inherit get-top-level-window set-line-count)
(rename [super-on-focus on-focus])
(override
[on-focus
(lambda (x)
(define/override (on-focus x)
(when x
(set-searching-frame (get-top-level-window)))
(super-on-focus x))])
(sequence
(super-init parent #f '(hide-hscroll hide-vscroll))
(set-line-count 2))))
(super-on-focus x))
(super-new (style '(hide-hscroll hide-vscroll)))
(set-line-count 2)))
(define (init-find/replace-edits)
(unless find-edit
@ -2283,7 +2271,7 @@
(super-instantiate ())))
; to see printouts in memory debugging better.
(define memory-text% (class100 text% args (sequence (apply super-init args))))
(define memory-text% (class text% (super-new)))
(define memory-text (make-object memory-text%))
(send memory-text hide-caret #t)
(define show-memory-text?