From bbdc22f6c746b3b2e7e15dd0a21507726706242c Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 22 Apr 1999 19:47:37 +0000 Subject: [PATCH] ... original commit: ee96d2a8135f51b6b7dc3f1a51aa7a881b55f58b --- collects/framework/editor.ss | 12 ++++---- collects/framework/frame.ss | 22 ++------------ collects/tests/framework/keys.ss | 51 ++++++++++++++++++++++++++++++++ 3 files changed, 60 insertions(+), 25 deletions(-) create mode 100644 collects/tests/framework/keys.ss diff --git a/collects/framework/editor.ss b/collects/framework/editor.ss index 0d8f8eb4..52c977d4 100644 --- a/collects/framework/editor.ss +++ b/collects/framework/editor.ss @@ -156,11 +156,13 @@ (lambda (x) (set! is-locked? x) (super-lock x))] - [on-new-box - (lambda (type) - (cond - [(eq? type 'text) (make-object editor-snip% (make-object text:basic%))] - [else (make-object editor-snip% (make-object pasteboard:basic%))]))]) + ;[on-new-box + ; (lambda (type) + ; (cond + ; [(eq? type 'text) (make-object editor-snip% (make-object text:basic%))] + ; [else (make-object editor-snip% (make-object pasteboard:basic%))]))] + ;; need a snipclass to handle copying/pasting. This isn't enough. + ) (override diff --git a/collects/framework/frame.ss b/collects/framework/frame.ss index 523303f8..552e2e06 100644 --- a/collects/framework/frame.ss +++ b/collects/framework/frame.ss @@ -361,14 +361,6 @@ (eq? x 'backward)) (error 'set-searching-direction "expected ~e or ~e, got ~e" 'forward 'backward x)) (set! searching-direction x)) - (define get-active-embedded-edit - (lambda (edit) - (let loop ([edit edit]) - (let ([snip (send edit get-focus-snip)]) - (if (or (not snip) - (not (is-a? snip original:editor-snip%))) - edit - (loop (send snip get-editor))))))) (define old-search-highlight void) (define clear-search-highlight @@ -433,7 +425,6 @@ [edit-above (send (send snip get-admin) get-editor)] [pos (send edit-above get-snip-position snip)] [pop-out-pos (if (eq? direction 'forward) (add1 pos) pos)]) - (printf "popping out to ~a~n" pop-out-pos) (find-string-embedded edit-above str @@ -444,14 +435,10 @@ case-sensitive? pop-out?)) (values edit #f))))]) - (printf "flat: ~a start: ~a end: ~a~n" flat start end) (let loop ([current-snip (send edit find-snip start (if (eq? direction 'forward) 'after-or-none 'before-or-none))]) - (printf "searching snips: ~s ~s editor-snip? ~a~n" current-snip - (and current-snip (send current-snip get-text 0 (send current-snip get-count))) - (and current-snip (is-a? current-snip original:editor-snip%))) (let ([next-loop (lambda () (if (eq? direction 'forward) @@ -467,18 +454,15 @@ (< flat end)) (and (< start flat) (<= flat end)))))) - (printf "terminating this level~n") (if (and (not flat) pop-out?) (pop-out) (values edit flat))] [(is-a? current-snip original:editor-snip%) - (printf "found embedded editor~n") (let-values ([(embedded embedded-pos) (let ([media (send current-snip get-editor)]) (if (and media (is-a? media original:text%)) (begin - (printf "searching in embedded editor~n") (find-string-embedded media str @@ -489,7 +473,6 @@ 'eof get-start case-sensitive?)) (values #f #f)))]) - (printf "embedded: ~a embedded-pos ~a~n" embedded embedded-pos) (if (not embedded-pos) (next-loop) (values embedded embedded-pos)))] @@ -508,8 +491,7 @@ (set! searching-frame frame))] [get-searching-edit (lambda () - (get-active-embedded-edit - (send searching-frame get-text-to-search)))] + (send searching-frame get-text-to-search))] [search (opt-lambda ([reset-search-anchor? #t] [beep? #t] [wrap? #t]) (when searching-frame @@ -552,7 +534,7 @@ (if wrap? (let-values ([(found-edit pos) (find-string-embedded - searching-edit + top-searching-edit string searching-direction (if (eq? 'forward searching-direction) diff --git a/collects/tests/framework/keys.ss b/collects/tests/framework/keys.ss new file mode 100644 index 00000000..f0b59fad --- /dev/null +++ b/collects/tests/framework/keys.ss @@ -0,0 +1,51 @@ +(begin-elaboration-time (current-load-relative-directory + "Cupertino:robby:plt:collects:tests:framework") + (printf "3 curr-dir ~a curr-load-dir ~a~n" + (current-directory) + (current-load-relative-directory))) + +(include "key-specs.ss") + +(define (test-key key-spec) + (let* ([keys ((case (system-type) + [(macos) key-spec-macos] + [(unix) key-spec-unix] + [(windows) key-spec-windows]) + key-spec)] + [before (key-spec-before key-spec)] + [after (key-spec-after key-spec)] + [process-key + (lambda (key) + (let ([text-expect (buff-spec-string after)] + [start-expect (buff-spec-start after)] + [end-expect (buff-spec-end after)]) + (test key + (lambda (x) (equal? x (vector text-expect start-expect end-expect))) + `(let* ([text (send (get-top-level-focus-window) get-editor)]) + (send text erase) + (send text insert ,(buff-spec-string before)) + (send text set-position ,(buff-spec-start before) ,(buff-spec-end before)) + (test:keystroke ',(car key) ',(cdr key)) + (vector (send text get-text) + (send text get-start-position) + (send text get-end-position))))))]) + (for-each process-key keys))) + +(send-sexp-to-mred `(send (make-object frame:basic% "dummy to trick frame group") show #t)) +(wait-for-frame "dummy to trick frame group") + +(define (test-specs frame-name frame-class specs) + (send-sexp-to-mred `(send (make-object ,frame-class ,frame-name) show #t)) + (wait-for-frame frame-name) + (for-each test-key specs) + (send-sexp-to-mred `(test:close-frame (get-top-level-focus-window)))) + +(test-specs "global keybingings test" 'frame:text% global-specs) +(test-specs "scheme mode keybindings test" + '(class frame:editor% (name) + (override + [get-editor% + (lambda () + (scheme:text-mixin text:basic%))]) + (sequence (super-init name))) + scheme-specs)