...

original commit: ee96d2a8135f51b6b7dc3f1a51aa7a881b55f58b

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

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)

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)