...

original commit: e9db8c3da1d993f0393215d7cd8aa784abf34f94

collects/framework/editor.ss

@@ -162,7 +162,7 @@
 	(apply super-init args)
 	(auto-wrap (default-auto-wrap?)))))
   
-  (define -keymap<%> (interface (basic<%>)))
+  (define -keymap<%> (interface (basic<%>) get-keymaps))
   (define keymap-mixin
     (mixin (basic<%>) (-keymap<%>) args
       (public
@@ -179,18 +179,20 @@
 	  (add-text-keymap-functions keymap)
 	  (add-pasteboard-keymap-functions keymap)
 	  (for-each (lambda (k)
+		      (keymap:set-keymap-error-handler k)
+		      (keymap:set-keymap-implied-shifts k)
 		      (send keymap chain-to-keymap k #f))
 		    (get-keymaps))))))
 
-  (define file<%> (interface (basic<%>)))
+  (define file<%> (interface (-keymap<%>)))
-  (define file-mixin ;; wx - should come from -keymap<%>
+  (define file-mixin
-    (mixin (basic<%>) (file<%>) args
+    (mixin (-keymap<%>) (file<%>) args
-      (inherit get-keymap  
+      (inherit get-filename lock get-style-list 
-	       get-filename lock get-style-list 
 	       is-modified? change-style set-modified 
 	       get-top-level-window)
       (rename [super-after-save-file after-save-file]
-	      [super-after-load-file after-load-file])
+	      [super-after-load-file after-load-file]
+	      [super-get-keymaps get-keymaps])
       
       (override [editing-this-file? (lambda () #t)])
       (private
@@ -215,11 +217,12 @@
 	 (lambda (sucessful?)
 	   (when sucessful?
 	     (check-lock))
-	   (super-after-load-file sucessful?))])
+	   (super-after-load-file sucessful?))]
+	[get-keymaps
+	 (lambda ()
+	   (cons (keymap:get-file) (super-get-keymaps)))])
       (sequence
-	(apply super-init args)
+	(apply super-init args))))
-	(let ([keymap (get-keymap)])
-	  (send keymap chain-to-keymap (keymap:get-file) #f)))))
   
   (define backup-autosave<%>
     (interface (basic<%>)

collects/framework/frameworks.ss

@@ -88,11 +88,13 @@
 
 (define-signature framework:editor^
   (basic<%>
+   keymap<%>
    info<%>
    file<%>
    backup-autosave<%>
    
    basic-mixin
+   keymap-mixin
    info-mixin
    file-mixin
    backup-autosave-mixin))

collects/framework/keymap.ss

@@ -9,10 +9,6 @@
   
   (rename [-get-file get-file])
 
-  ; This is a list of keys that are typed with the SHIFT key, but
-  ;  are not normally thought of as shifted. It will have to be
-  ;  changed for different keyboards.
-  
   (define keyerr
     (lambda (str)
       (display str (current-error-port))

collects/framework/main.ss

@@ -35,11 +35,8 @@
 	      '(cond 
 		 begin begin0 delay
 		 unit compound-unit compound-unit/sig
-		 public private
+		 public private override
-		 inherit inherit-from
+		 inherit sequence))
-		 rename rename-from
-		 share share-from
-		 sequence))
     (for-each (lambda (x) (hash-table-put! hash-table x 'lambda))
 	      '(lambda let let* letrec recur
 		 let/cc let/ec letcc catch

collects/framework/pasteboard.ss

@@ -2,7 +2,7 @@
   (import mred-interfaces^
 	  [editor : framework:editor^])
 
-  (define basic% (editor:basic-mixin pasteboard%))
+  (define basic% (editor:keymap-mixin (editor:basic-mixin pasteboard%)))
   (define file% (editor:file-mixin basic%))
   (define backup-autosave% (editor:backup-autosave-mixin file%))
   (define info% (editor:info-mixin backup-autosave%)))

collects/framework/scheme.ss

@@ -184,20 +184,23 @@
 	 (lambda (pos)
 	   (let loop ([pos pos])
 	     (let ([paren-pos 
-		    (apply max (map (lambda (pair)
+		    (let loop ([pairs (scheme-paren:get-paren-pairs)]
-				      (find-string
+			       [curr-max #f])
-				       (car pair)
+		      (cond
-				       'backward
+		       [(null? pairs) curr-max]
-				       pos
+		       [else (let* ([pair (car pairs)]
-				       'eof
+				    [fnd (find-string (car pair) 'backward pos 'eof #f)])
-				       #f))
+			       (if (and fnd curr-max)
-				    (scheme-paren:get-paren-pairs)))])
+				   (loop (cdr pairs)
+					 (max fnd curr-max))
+				   (loop (cdr pairs)
+					 (or fnd curr-max))))]))])
 	       (cond
-		 [(= -1 paren-pos) #f]
+		 [(not paren-pos) #f]
 		 [else
 		  (let ([semi-pos (find-string ";" 'backward paren-pos)])
 		    (cond
-		      [(or (= -1 semi-pos)
+		      [(or (not semi-pos)
 			   (< semi-pos (paragraph-start-position
 					(position-paragraph paren-pos))))
 		       paren-pos]
@@ -282,9 +285,8 @@
 	
 	[balance-quotes
 	 (lambda (key)
-	   (let* ([code (send key get-key-code)] ;; must be a character because of the mapping setup
+	   (let* ([char (send key get-key-code)]) ;; must be a character because of the mapping setup
-		                                 ;; this function is only bound to ascii-returning keys
+		                                  ;; this function is only bound to ascii-returning keys
-		  [char (integer->char code)])
 	     (insert char)
 	     (let* ([start-pos (get-start-position)]
 		    [limit (get-limit start-pos)]
@@ -376,15 +378,16 @@
 		  [visual-offset
 		   (lambda (pos)
 		     (let loop ([p (sub1 pos)])
-		       (let ([c (get-character p)])
+		       (if (= p -1)
-			 (cond
+			   0
-			   [(= p -1) 0]
+			   (let ([c (get-character p)])
-			   [(char=? c #\null) 0]
+			     (cond
-			   [(char=? c #\tab)
+			      [(char=? c #\null) 0]
-			    (let ([o (loop (sub1 p))])
+			      [(char=? c #\tab)
-			      (+ o (- 8 (modulo o 8))))]
+			       (let ([o (loop (sub1 p))])
-			   [(char=? c #\newline) 0]
+				 (+ o (- 8 (modulo o 8))))]
-			   [else (add1 (loop (sub1 p)))]))))]
+			      [(char=? c #\newline) 0]
+			      [else (add1 (loop (sub1 p)))])))))]
 		  [do-indent
 		   (lambda (amt)
 		     (let* ([pos-start end]
@@ -446,7 +449,7 @@
 			#f))
 		  => (lambda (x) (set-position x))]
 		 [(= para 0) (do-indent 0)]
-		 [(or (not contains) (= contains -1))
+		 [(not contains)
 		  (do-indent 0)]
 		 [(not last) ;; search backwards for the opening parenthesis, and use it to align this line
 		  (let ([enclosing (find-enclosing-paren pos)])
@@ -487,7 +490,7 @@
 		      (loop (add1 para))))
 		  (when (and (>= (position-paragraph start-pos) end-para)
 			     (<= (paren:skip-whitespace 
-				  this (get-start-position) -1)
+				  this (get-start-position) 'backward)
 				 (paragraph-start-position first-para)))
 		    (set-position 
 		     (let loop ([new-pos (get-start-position)])
@@ -544,7 +547,7 @@
 			  (paren:skip-whitespace 
 			   this 
 			   (paragraph-start-position curr-para)
-			   1)])
+			   'forward)])
 		     (delete first-on-para
 			   (+ first-on-para
 			      (let char-loop ([n 0])
@@ -666,7 +669,7 @@
 	     #t))]
 	[remove-parens-forward
 	 (lambda (start-pos)
-	   (let* ([pos (paren:skip-whitespace this start-pos 1)]
+	   (let* ([pos (paren:skip-whitespace this start-pos 'forward)]
 		  [first-char (get-character pos)]
 		  [paren? (or (char=? first-char #\( )
 			      (char=? first-char #\[ ))]
@@ -741,11 +744,11 @@
 	(set-tabs null tab-size #f)
 	(set-style-list style-list)
 	(set-styles-fixed #t)
-	(let ([keymap (or (get-keymap)
+	(let ([k (or (get-keymap)
-			  (let ([k (make-object keymap%)])
+		     (let ([k (make-object keymap%)])
-			    (set-keymap k)
+		       (set-keymap k)
-			    k))])
+		       k))])
-	  (send keymap chain-to-keymap keymap #t)))))
+	  (send k chain-to-keymap keymap #t)))))
 
   (define -text% (text-mixin text:info%))
 

collects/framework/text.ss

@@ -13,7 +13,7 @@
   ;; unless matthew makes it primitive
 
   (define basic<%>
-    (interface (editor:basic<%> text<%>)
+    (interface (editor:keymap<%> text<%>)
       highlight-range      
       get-styles-fixed
       set-styles-fixed
@@ -21,10 +21,10 @@
       initial-autowrap-bitmap))
 
   (define basic-mixin
-    (mixin (editor:basic<%> text<%>) (basic<%>) args
+    (mixin (editor:keymap<%> text<%>) (basic<%>) args
       (inherit get-canvases get-admin split-snip get-snip-position
 	       delete find-snip invalidate-bitmap-cache
-	       set-autowrap-bitmap get-keymap
+	       set-autowrap-bitmap
 	       set-file-format get-file-format
 	       get-style-list is-modified? change-style set-modified
 	       position-location get-extent)
@@ -296,22 +296,24 @@
 
       (public
 	[initial-autowrap-bitmap (lambda () #f)])
+
+      (rename [super-get-keymaps get-keymaps])
+      (override
+       [get-keymaps
+	(lambda ()
+	  (cons (keymap:get-global) (super-get-keymaps)))])
+
       (sequence
 	(apply super-init args)
-	(set-autowrap-bitmap (initial-autowrap-bitmap))
+	(set-autowrap-bitmap (initial-autowrap-bitmap)))))
-	(let ([keymap (get-keymap)])
-	  (keymap:set-keymap-error-handler keymap)
-	  (keymap:set-keymap-implied-shifts keymap)
-	  (send keymap chain-to-keymap (keymap:get-global) #f)))))
   
   (define searching<%>
     (interface ()
       find-string-embedded))
   (define searching-mixin
-    (mixin (editor:basic<%> text<%>) (searching<%>) args
+    (mixin (basic<%>) (searching<%>) args
       (inherit get-end-position get-start-position last-position 
-	       find-string get-snip-position get-admin find-snip
+	       find-string get-snip-position get-admin find-snip)
-	       get-keymap)
       (public
 	[find-string-embedded
 	 (opt-lambda (str [direction 1] [start -1]
@@ -390,12 +392,15 @@
 			    (next-loop)
 			    (values embedded embedded-pos)))]
 		     [else (next-loop)]))))))])
+
+      (rename [super-get-keymaps get-keymaps])
+      (override
+       [get-keymaps
+	(lambda ()
+	  (cons (keymap:get-search) (super-get-keymaps)))])
+
       (sequence
-	(apply super-init args)
+	(apply super-init args))))
-	(let ([keymap (get-keymap)])
-	  (keymap:set-keymap-error-handler keymap)
-	  (keymap:set-keymap-implied-shifts keymap)
-	  (send keymap chain-to-keymap (keymap:get-search) #f)))))
   
   (define return<%> (interface (text<%>)))
 
@@ -516,7 +521,7 @@
 		   #f))))])
       (sequence (apply super-init args))))
 
-  (define basic% (basic-mixin (editor:basic-mixin text%)))
+  (define basic% (basic-mixin (editor:keymap-mixin (editor:basic-mixin text%))))
   (define return% (return-mixin basic%))
   (define file% (editor:file-mixin basic%))
   (define clever-file-format% (clever-file-format-mixin file%))