From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Jan 1992 17:54:28 +0000 (+0000)
Subject: Totally new implementation of comtabs.  Now DEFINE-KEY and
X-Git-Tag: 20090517-FFI~10011
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a5be80078f8cdcde1d9d1bc5309f350938831290;p=mit-scheme.git

Totally new implementation of comtabs.  Now DEFINE-KEY and
DEFINE-PREFIX-KEY handle lower-case letters specially: if the
corresponding upper-case letter is undefined, it is converted into an
alias for the lower-case letter.  Additional changes:
DEFINE-DEFAULT-KEY eliminated (it was unused); comtabs support aliases
much like Emacs does; internal structure of comtab varies depending on
the contents of the comtab.
---

diff --git a/v7/src/edwin/comtab.scm b/v7/src/edwin/comtab.scm
index e6a993b36..e0611bbb7 100644
--- a/v7/src/edwin/comtab.scm
+++ b/v7/src/edwin/comtab.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comtab.scm,v 1.60 1991/08/06 15:39:30 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comtab.scm,v 1.61 1992/01/09 17:53:26 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -47,173 +47,364 @@
 (declare (usual-integrations))
 
 (define-structure (comtab (constructor make-comtab ()))
-  (dispatch-alists (cons '() '()) read-only true)
-  (button-alist '()))
-
-(define (set-comtab-entry! alists key command)
-  (let ((entry (assq key (cdr alists))))
-    (if entry
-	(set-cdr! entry command)
-	(set-cdr! alists (cons (cons key command) (cdr alists))))))
-
-(define (make-prefix-key! alists key alists*)
-  (let ((entry (assq key (car alists))))
-    (if entry
-	(set-cdr! entry alists*)
-	(set-car! alists
-		  (cons (cons key alists*)
-			(car alists))))))
-
-(define (comtab-lookup-prefix comtabs key if-undefined if-defined)
-  (let ((alists (comtab-dispatch-alists (car comtabs))))
-    (cond ((key? key)
-	   (if-defined alists (remap-alias-key key)))
-	  ((pair? key)
-	   (let ((keys (map remap-alias-key key)))
-	     (let loop ((alists alists) (keys keys))
-	       (let ((key (car keys))
-		     (keys (cdr keys)))
-		 (cond ((null? keys)
-			(if-defined alists key))
-		       ((assq key (car alists))
-			=> (lambda (entry) (loop (cdr entry) keys)))
-		       ((assq key (cdr alists))
-			(error "Illegal prefix key:" key))
-		       ((not if-undefined)
-			(set-comtab-entry! alists
-					   key
-					   (ref-command-object prefix-key))
-			(let ((alists* (cons '() '())))
-			  (make-prefix-key! alists key alists*)
-			  (loop alists* keys)))
-		       (else
-			(if-undefined)))))))
-	  (else
-	   (error "Illegal comtab key" key)))))
+  (vector 0)
+  (alist '()))
 
-(define (comtab-entry comtabs key)
-  (let ((continue
-	 (if (button? key)
-	     (lambda ()
-	       (and (not (null? (cdr comtabs)))
-		    (comtab? (cadr comtabs))
-		    (comtab-entry (cdr comtabs) key)))
-	     (lambda ()
-	       (cond ((null? (cdr comtabs))
-		      (ref-command-object undefined))
-		     ((comtab? (cadr comtabs))
-		      (comtab-entry (cdr comtabs) key))
+(define (comtab-get comtab key)
+  (let ((vector (comtab-vector comtab)))
+    (if (and (vector? vector)
+	     (char? key)
+	     (< (char->integer key) (vector-length vector)))
+	(vector-ref vector (char->integer key))
+	(let ((entry (assq key (comtab-alist comtab))))
+	  (and entry
+	       (cdr entry))))))
+
+(define (comtab-put! comtab key datum)
+  (cond ((not datum)
+	 (comtab-remove! comtab key))
+	((and (char? key) (< (char->integer key) 256))
+	 (let ((vector (comtab-vector comtab)))
+	   (if (vector? vector)
+	       (vector-set! vector (char->integer key) datum)
+	       (let ((alist (comtab-alist comtab)))
+		 (let ((entry (assq key alist)))
+		   (if entry
+		       (set-cdr! entry datum)
+		       (let ((vector (+ vector 1))
+			     (alist (cons (cons key datum) alist)))
+			 (if (< vector 64)
+			     (without-interrupts
+			      (lambda ()
+				(set-comtab-vector! comtab vector)
+				(set-comtab-alist! comtab alist)))
+			     (let ((vector (make-vector 256 false)))
+			       (let ((alist
+				      (list-transform-negative alist
+					(lambda (entry)
+					  (let ((key (car entry)))
+					    (and (char? key)
+						 (< (char->integer key) 256)
+						 (begin
+						   (vector-set!
+						    vector
+						    (char->integer key)
+						    (cdr entry))
+						   true)))))))
+				 (without-interrupts
+				  (lambda ()
+				    (set-comtab-vector! comtab vector)
+				    (set-comtab-alist! comtab alist))))))))))))
+	 ;; Defining a lower-case character defines the corresponding
+	 ;; upper-case character to be an alias if not already defined.
+	 (if (char-lower-case? key)
+	     (let ((key* (char-upcase key)))
+	       (if (not (comtab-get comtab key*))
+		   (comtab-put! comtab key* (cons comtab key))))))
+	(else
+	 (let ((alist (comtab-alist comtab)))
+	   (let ((entry (assq key alist)))
+	     (if entry
+		 (set-cdr! entry datum)
+		 (set-comtab-alist! comtab
+				    (cons (cons key datum) alist))))))))
+
+(define (comtab-remove! comtab key)
+  (if (and (char? key) (< (char->integer key) 256))
+      (let ((vector (comtab-vector comtab)))
+	(if (vector? vector)
+	    (vector-set! vector (char->integer key) false)
+	    (let ((alist (comtab-alist comtab)))
+	      (let ((entry (assq key alist)))
+		(if entry
+		    (let ((vector (- vector 1))
+			  (alist (delq entry alist)))
+		      (without-interrupts
+		       (lambda ()
+			 (set-comtab-vector! comtab vector)
+			 (set-comtab-alist! comtab alist)))))))))
+      (set-comtab-alist! comtab (del-assq key (comtab-alist comtab)))))
+
+(define (valid-comtabs? object)
+  (or (mode? object)
+      (symbol? object)
+      (comtab? object)
+      (list-of-comtabs? object)))
+
+(define (guarantee-comtabs object procedure)
+  (cond ((mode? object)
+	 (mode-comtabs object))
+	((symbol? object)
+	 (mode-comtabs (->mode object)))
+	((comtab? object)
+	 (list object))
+	((list-of-comtabs? object)
+	 object)
+	(else
+	 (error:wrong-type-argument object "list of comtabs" procedure))))
+
+(define (mode-name? object)
+  (and (symbol? object)
+       (string-table-get editor-modes (symbol->string object))))
+
+(define (list-of-comtabs? object)
+  (and (not (null? object))
+       (list? object)
+       (for-all? object comtab?)))
+
+(define (valid-key? object)
+  (or (key? object)
+      (prefixed-key? object)
+      (button? object)))
+
+(define (prefixed-key? object)
+  (let loop ((object object))
+    (and (pair? object)
+	 (key? (car object))
+	 (or (null? (cdr object))
+	     (loop (cdr object))))))
+
+(define (valid-datum? object)
+  (or (not object)
+      (command? object)
+      (comtab? object)
+      (command&comtab? object)
+      (comtab-alias? object)))
+
+(define (command&comtab? object)
+  (and (pair? object)
+       (command? (car object))
+       (comtab? (cdr object))))
+
+(define (comtab-alias? object)
+  (and (pair? object)
+       (valid-comtabs? (car object))
+       (valid-key? (cdr object))))
+
+(define (comtab-alias/dereference datum)
+  (lookup-key (car datum) (cdr datum)))
+
+(define (lookup-key comtabs key)
+  (let ((comtabs (guarantee-comtabs comtabs 'LOOKUP-KEY)))
+    (let ((simple-lookup
+	   (lambda (key)
+	     (let loop ((comtabs* comtabs))
+	       (cond ((comtab-get (car comtabs*) key)
+		      => handle-datum)
+		     ((not (null? (cdr comtabs*)))
+		      (loop (cdr comtabs*)))
 		     (else
-		      (cadr comtabs)))))))
-    (let ((try
-	   (lambda (key alist)
-	     (let ((entry (assq key alist)))
-	       (if entry
-		   (cdr entry)
-		   (continue))))))
-      (cond ((or (key? key) (pair? key))
-	     (comtab-lookup-prefix comtabs key continue
-	       (lambda (alists key)
-		 (try key (cdr alists)))))
+		      false))))))
+      (cond ((key? key)
+	     (simple-lookup (remap-alias-key key)))
 	    ((button? key)
-	     (try key (comtab-button-alist (car comtabs))))
+	     (simple-lookup key))
+	    ((prefixed-key? key)
+	     (let ((prefix (except-last-pair key))
+		   (key (remap-alias-key (car (last-pair key)))))
+	       (if (null? prefix)
+		   (simple-lookup key)
+		   (let loop ((comtabs* comtabs))
+		     (let ((comtab
+			    (lookup-prefix (car comtabs*) prefix false)))
+		       (cond ((and comtab (comtab-get comtab key))
+			      => handle-datum)
+			     ((not (null? (cdr comtabs*)))
+			      (loop (cdr comtabs*)))
+			     (else
+			      false)))))))
 	    (else
-	     (error "Illegal comtab key" key))))))
-
-(define (prefix-key-list? comtabs keys)
-  (let loop
-      ((key->alist (car (comtab-dispatch-alists (car comtabs))))
-       (keys (if (list? keys) keys (list keys))))
-    (or (null? keys)
-	(let ((entry (assq (remap-alias-key (car keys)) key->alist)))
-	  (if entry
-	      (loop (cadr entry) (cdr keys))
-	      (and (not (null? (cdr comtabs)))
-		   (comtab? (cadr comtabs))
-		   (prefix-key-list? (cdr comtabs) keys)))))))
-
-(define (define-key mode key command)
-  (let ((comtabs (mode-comtabs (->mode mode)))
-	(command (->command command)))
-    (if (button? key)
-	(let ((alist (comtab-button-alist (car comtabs))))
-	  (let ((entry (assq key alist)))
-	    (if entry
-		(set-cdr! entry command)
-		(set-comtab-button-alist! (car comtabs)
-					  (cons (cons key command) alist)))))
-	(let ((normal-key
-	       (lambda (key)
-		 (comtab-lookup-prefix comtabs key false
-		   (lambda (alists key)
-		     (set-comtab-entry! alists key command))))))
-	  (cond ((or (key? key) (pair? key))
-		 (normal-key key))
-		((char-set? key)
-		 (for-each normal-key (char-set-members key)))
-		(else
-		 (error "Illegal comtab key" key))))))
-  key)
+	     (error:wrong-type-argument key "comtab key" 'LOOKUP-KEY))))))
 
-(define (define-prefix-key mode key command)
-  (let ((comtabs (mode-comtabs (->mode mode)))
-	(command (->command command)))
-    (if (not (or (key? key) (pair? key)))
-	(error "Illegal comtab key" key))
-    (comtab-lookup-prefix comtabs key false
-      (lambda (alists key)
-	(set-comtab-entry! alists key command)
-	(make-prefix-key! alists key (cons '() '())))))
-  key)
+(define (handle-datum datum)
+  (cond ((or (command? datum)
+	     (comtab? datum)
+	     (command&comtab? datum))
+	 datum)
+	((comtab-alias? datum)
+	 (comtab-alias/dereference datum))
+	(else
+	 (error "Illegal comtab datum:" datum))))
 
-(define (define-default-key mode command)
-  (let ((comtabs (mode-comtabs (->mode mode)))
-	(command (->command command)))
-    (if (not (or (null? (cdr comtabs)) (command? (cadr comtabs))))
-	(error "Can't define default key for this mode" mode))
-    (set-cdr! comtabs (list command)))
-  'DEFAULT-KEY)
+(define (lookup-prefix comtab prefix intern?)
+  (let loop ((comtab comtab) (prefix* prefix))
+    (if (null? prefix*)
+	comtab
+	(let ((key (remap-alias-key (car prefix*)))
+	      (prefix* (cdr prefix*)))
+	  (let datum-loop ((datum (comtab-get comtab key)))
+	    (cond ((not datum)
+		   (and intern?
+			(let ((datum (make-comtab)))
+			  ;; Note that this will clobber a comtab-alias
+			  ;; that points to an undefined entry.
+			  (comtab-put! comtab key datum)
+			  (loop datum prefix*))))
+		  ((comtab? datum)
+		   (loop datum prefix*))
+		  ((command&comtab? datum)
+		   (loop (cdr datum) prefix*))
+		  ((comtab-alias? datum)
+		   (datum-loop (comtab-alias/dereference datum)))
+		  ((command? datum)
+		   (error "Key sequence too long:"
+			  prefix
+			  (- (length prefix) (length prefix*))))
+		  (else
+		   (error "Illegal comtab datum:" datum))))))))
 
-(define (comtab-key-bindings comtabs command)
-  (define (search-comtabs comtabs)
-    (let ((bindings
-	   (search-comtab '() (comtab-dispatch-alists (car comtabs)))))
-      (if (and (not (null? (cdr comtabs)))
-	       (comtab? (cadr comtabs)))
-	  (append! bindings (search-comtabs (cdr comtabs)))
-	  bindings)))
-
-  (define (search-comtab prefix dispatch-alists)
-    (define (search-prefix-map alist)
-      (if (null? alist)
-	  (map (lambda (key) (append prefix (list key)))
-	       (search-command-map (cdr dispatch-alists)))
-	  (append! (search-comtab (append prefix (list (caar alist)))
-				  (cdar alist))
-		   (search-prefix-map (cdr alist)))))
-
-    (define (search-command-map alist)
-      (cond ((null? alist)
-	     '())
-	    ((eq? command (cdar alist))
-	     (cons (caar alist) (search-command-map (cdr alist))))
-	    (else
-	     (search-command-map (cdr alist)))))
+(define (comtab-entry comtabs key)
+  (let ((object (lookup-key comtabs key)))
+    (cond ((not object)
+	   (and (not (button? key))
+		(ref-command-object undefined)))
+	  ((command? object)
+	   object)
+	  ((command&comtab? object)
+	   (car object))
+	  ((comtab? object)
+	   (ref-command-object prefix-key))
+	  (else
+	   (error "Illegal result from lookup-key:" object)))))
+
+(define (prefix-key-list? comtabs key)
+  (let ((object (lookup-key comtabs key)))
+    (or (comtab? object)
+	(command&comtab? object))))
 
-    (search-prefix-map (car dispatch-alists)))
+(define (define-key mode key datum)
+  (%define-key (car (guarantee-comtabs mode 'DEFINE-KEY))
+	       key
+	       (if (valid-datum? datum) datum (->command datum))
+	       'DEFINE-KEY))
 
-  ;; Filter out shadowed bindings.
-  (list-transform-positive (search-comtabs comtabs)
-    (lambda (xkey)
-      (eq? command (comtab-entry comtabs xkey)))))
+(define (define-prefix-key mode key #!optional command)
+  (%define-key (car (guarantee-comtabs mode 'DEFINE-PREFIX-KEY))
+	       (begin
+		 (if (button? key)
+		     (error:wrong-type-argument key
+						"comtab prefix key"
+						'DEFINE-PREFIX-KEY))
+		 key)
+	       (let ((command
+		      (if (default-object? command)
+			  (ref-command-object prefix-key)
+			  (->command command)))
+		     (comtab (make-comtab)))
+		 (if (eq? command (ref-command-object prefix-key))
+		     comtab
+		     (cons command comtab)))
+	       'DEFINE-PREFIX-KEY))
 
+(define (%define-key comtab key datum procedure)
+  (cond ((or (key? key) (button? key))
+	 (comtab-put! comtab (remap-alias-key key) datum))
+	((char-set? key)
+	 (for-each (lambda (key)
+		     (comtab-put! comtab (remap-alias-key key) datum))
+		   (char-set-members key)))
+	((prefixed-key? key)
+	 (let ((prefix (except-last-pair key)))
+	   (comtab-put! (if (null? prefix)
+			    comtab
+			    (lookup-prefix comtab prefix true))
+			(remap-alias-key (car (last-pair key)))
+			datum)))
+	(else
+	 (error:wrong-type-argument key "comtab key" procedure)))
+  key)
+
+(define (comtab-alist* comtab)
+  (let ((vector (comtab-vector comtab))
+	(alist (comtab-alist comtab)))
+    (if (vector? vector)
+	(let ((end (vector-length vector)))
+	  (let loop ((index 0))
+	    (if (< index end)
+		(let ((datum (vector-ref vector index)))
+		  (if datum
+		      (cons (cons (integer->char index) datum)
+			    (loop (+ index 1)))
+		      (loop (+ index 1))))
+		alist)))
+	alist)))
+
 (define (comtab->alist comtab)
-  (let loop ((prefix '()) (da (comtab-dispatch-alists comtab)))
-    (append! (map (lambda (element)
-		    (cons (append prefix (list (car element)))
-			  (cdr element)))
-		  (cdr da))
-	     (append-map (lambda (element)
-			   (loop (append prefix (list (car element)))
-				 (cdr element)))
-			 (car da)))))
\ No newline at end of file
+  (let loop ((prefix '()) (comtab comtab))
+    (append-map!
+     (lambda (entry)
+       (if (and (button? (car entry))
+		(not (null? prefix)))
+	   '()
+	   (let ((prefix (append prefix (list (car entry)))))
+	     (let ((key (if (null? (cdr prefix)) (car prefix) prefix)))
+	       (let datum-loop ((datum (cdr entry)))
+		 (cond ((not datum)
+			'())
+		       ((command? datum)
+			(list (cons key datum)))
+		       ((comtab? datum)
+			(loop prefix datum))
+		       ((command&comtab? datum)
+			(cons (cons key (car datum))
+			      (loop prefix (cdr datum))))
+		       ((comtab-alias? datum)
+			(datum-loop (comtab-alias/dereference datum)))
+		       (else
+			(error "Illegal comtab datum:" datum))))))))
+     (comtab-alist* comtab))))
+
+(define (comtab-key-bindings comtabs command)
+  (let ((comtabs (guarantee-comtabs comtabs 'COMTAB-KEY-BINDINGS))
+	(command (->command command)))
+    ;; In addition to having a binding of COMMAND, every key in the
+    ;; result satisfies VALID-KEY?.  This eliminates bindings that are
+    ;; shadowed by other bindings.
+    (let ((valid-key?
+	   (lambda (key)
+	     (let ((datum (lookup-key comtabs key)))
+	       (cond ((command? datum)
+		      (eq? command datum))
+		     ((comtab? datum)
+		      (eq? command (ref-command-object prefix-key)))
+		     ((command&comtab? datum)
+		      (eq? command (car datum)))
+		     (else
+		      false))))))
+      (let loop ((comtabs comtabs))
+	(if (null? comtabs)
+	    '()
+	    (%comtab-bindings (car comtabs)
+			      (loop (cdr comtabs))
+			      command
+			      valid-key?))))))
+
+(define (%comtab-bindings comtab keys command valid-key?)
+  (let comtab-loop ((comtab comtab) (keys keys) (prefix '()))
+    (let alist-loop ((entries (comtab-alist* comtab)))
+      (if (null? entries)
+	  keys
+	  (let ((key (append prefix (list (caar entries)))))
+	    (let datum-loop
+		((datum (cdar entries))
+		 (keys (alist-loop (cdr entries))))
+	      (cond ((not datum)
+		     keys)
+		    ((command? datum)
+		     (if (and (eq? datum command)
+			      (valid-key? key))
+			 (cons key keys)
+			 keys))
+		    ((comtab? datum)
+		     (let ((keys (comtab-loop datum keys key)))
+		       (if (and (eq? command (ref-command-object prefix-key))
+				(valid-key? key))
+			   (cons key keys)
+			   keys)))
+		    ((command&comtab? datum)
+		     (datum-loop (car datum)
+				 (datum-loop (cdr datum) keys)))
+		    ((comtab-alias? datum)
+		     (datum-loop (comtab-alias/dereference datum) keys))
+		    (else
+		     (error "Illegal comtab datum:" datum)))))))))
\ No newline at end of file
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 362eb115d..1fdf99cce 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.70 1992/01/08 06:26:30 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.71 1992/01/09 17:54:28 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -178,7 +178,6 @@ MIT in each case. |#
 	  comtab-entry
 	  comtab-key-bindings
 	  comtab?
-	  define-default-key
 	  define-key
 	  define-prefix-key
 	  make-comtab
diff --git a/v7/src/edwin/keymap.scm b/v7/src/edwin/keymap.scm
index a422ff8d3..c5b8b0a7f 100644
--- a/v7/src/edwin/keymap.scm
+++ b/v7/src/edwin/keymap.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/keymap.scm,v 1.10 1991/08/06 15:39:26 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/keymap.scm,v 1.11 1992/01/09 17:54:12 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -168,7 +168,10 @@ Previous contents of that buffer are killed first."
   (map (lambda (element)
 	 (cons (xkey->name (car element))
 	       (command-name-string (cdr element))))
-       (sort elements (lambda (a b) (xkey<? (car a) (car b))))))
+       (sort (list-transform-negative elements
+	       (lambda (element)
+		 (button? (car element))))
+	     (lambda (a b) (xkey<? (car a) (car b))))))
 
 (define (sort-by-prefix elements)
   (let ((prefix-alist '()))
@@ -189,15 +192,18 @@ Previous contents of that buffer are killed first."
 			   (lambda (index)
 			     (make-entry (string-head string index) element)))
 			  (index (string-find-previous-char string #\space)))
-		      (cond (index
-			     (has-prefix (1+ index)))
-			    ((string-prefix? "M-C-" string)
-			     (has-prefix 4))
-			    ((or (string-prefix? "M-" string)
-				 (string-prefix? "C-" string))
-			     (has-prefix 2))
-			    (else
-			     (make-entry "" element))))))
+		      (if index
+			  (has-prefix (1+ index))
+			  (let ((end (string-length string)))
+			    (let loop ((index 0))
+			      (let ((index+1 (+ index 1)))
+				(if (and (< index+1 end)
+					 (char=? #\-
+						 (string-ref string index+1))
+					 (memv (string-ref string index)
+					       '(#\C #\M #\H #\S #\T)))
+				    (loop (+ index+1 1))
+				    (has-prefix index)))))))))
 		elements))
     (map (lambda (entry)
 	   (group-elements (reverse! (cdr entry))))
diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index 06f4a0658..c8e777873 100644
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.136 1991/11/26 08:03:27 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.137 1992/01/09 17:53:59 cph Exp $
 ;;;
-;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1985, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -70,7 +70,6 @@ This is an alist, the cars of which are pathname types,
 and the cdrs of which are major modes."
   (os/file-type-to-major-mode))
 
-(define-default-key 'fundamental 'undefined)
 (define-key 'fundamental char-set:graphic 'self-insert-command)
 (define-key 'fundamental char-set:numeric 'auto-digit-argument)
 (define-key 'fundamental #\- 'auto-negative-argument)
@@ -110,7 +109,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental #\c-@ 'set-mark-command)
 (define-key 'fundamental #\c-a 'beginning-of-line)
 (define-key 'fundamental #\c-b 'backward-char)
-(define-prefix-key 'fundamental #\c-c 'prefix-key)
+(define-prefix-key 'fundamental #\c-c)
 (define-key 'fundamental #\c-d 'delete-char)
 (define-key 'fundamental #\c-e 'end-of-line)
 (define-key 'fundamental #\c-f 'forward-char)
@@ -131,7 +130,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental #\c-u 'universal-argument)
 (define-key 'fundamental #\c-v 'scroll-up)
 (define-key 'fundamental #\c-w 'kill-region)
-(define-prefix-key 'fundamental #\c-x 'prefix-key)
+(define-prefix-key 'fundamental #\c-x)
 (define-key 'fundamental #\c-y 'yank)
 (define-key 'fundamental #\c-z 'control-meta-prefix)
 (define-key 'fundamental #\c-\[ 'meta-prefix)
@@ -273,7 +272,7 @@ Like Fundamental mode, but no self-inserting characters.")
 (define-key 'fundamental '(#\c-x #\0) 'delete-window)
 (define-key 'fundamental '(#\c-x #\1) 'delete-other-windows)
 (define-key 'fundamental '(#\c-x #\2) 'split-window-vertically)
-(define-prefix-key 'fundamental '(#\c-x #\4) 'prefix-key)
+(define-prefix-key 'fundamental '(#\c-x #\4))
 (define-key 'fundamental '(#\c-x #\4 #\c-f) 'find-file-other-window)
 (define-key 'fundamental '(#\c-x #\4 #\.) 'find-tag-other-window)
 (define-key 'fundamental '(#\c-x #\4 #\b) 'switch-to-buffer-other-window)