diff --git a/Makefile b/Makefile
index 1b6bdb124cb10f32d3fdce2306c3c910b50b30a5..e6ad41f68eb8b47dc6933955c9143d3d9bb1744c 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-# $fiHeader: Makefile,v 1.14 92/03/02 18:38:46 cer Exp Locker: cer $
+# $fiHeader: Makefile,v 1.15 92/03/09 17:42:01 cer Exp Locker: cer $
 # 
 #  Makefile for CLIM 2.0
 #
@@ -92,6 +92,7 @@ CLIM-STANDALONE-OBJS = clim/gestures.fasl \
                         clim/input-protocol.fasl \
                         clim/output-protocol.fasl \
                         clim/recording-protocol.fasl \
+			clim/recording-defs.fasl \
 			clim/text-recording.fasl \
 			clim/graphics-recording.fasl \
                         clim/interactive-protocol.fasl \
diff --git a/clim/accept-values.lisp b/clim/accept-values.lisp
index ed978c51d558829f855b0b2e55dcdd84ebc9b74e..da99a5c10c191cb535800ca6db104886cb4c959d 100644
--- a/clim/accept-values.lisp
+++ b/clim/accept-values.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept-values.lisp,v 1.9 92/03/04 16:21:04 cer Exp Locker: cer $
+;; $fiHeader: accept-values.lisp,v 1.9 92/03/04 16:21:04 cer Exp $
 
 (in-package :clim-internals)
 
@@ -361,7 +361,7 @@
 					     :stream command-stream
 					     :command-parser 'menu-command-parser
 					     :use-keystrokes t)))))
-		     (if (and command (not (characterp command)))
+		     (if (and command (not (keyboard-event-p command)))
 			 (execute-frame-command frame command)
 			 (beep stream)))
 		   (when (or resynchronize-every-pass (slot-value avv-record 'resynchronize))
@@ -558,7 +558,7 @@
     (map-queries avv-record)))
 
 #+Genera
-(define-accept-values-command (com-next-avv-choice :keystroke #\c-N)
+(define-accept-values-command (com-next-avv-choice :keystroke (:n :control))
     ()
   (with-slots (stream selected-item) *application-frame*
     (let ((avv-record (slot-value stream 'avv-record)))
@@ -581,7 +581,7 @@
 			 (setq found-item t)))))))))))
 
 #+Genera
-(define-accept-values-command (com-previous-avv-choice :keystroke #\c-P)
+(define-accept-values-command (com-previous-avv-choice :keystroke (:p :control))
     ()
   (with-slots (stream selected-item) *application-frame*
     (let ((avv-record (slot-value stream 'avv-record)))
@@ -593,7 +593,7 @@
 	     )))))
 
 #+Genera
-(add-keystroke-to-command-table 'accept-values #\c-E :function
+(add-keystroke-to-command-table 'accept-values '(:e :control) :function
   #'(lambda (gesture numeric-argument)
       (declare (ignore gesture numeric-argument))
       (with-slots (selected-item) *application-frame*
@@ -622,15 +622,11 @@
       (setf value nil
 	    changed-p t))))
 
-(define-accept-values-command (com-exit-avv :keystroke #+Genera #\End
-						       ;; what the key labelled END gives
-						       #+CCL-2 #\^D
-						       #-(or Genera CCL-2) nil)
+(define-accept-values-command (com-exit-avv :keystroke :end)
     ()
   (invoke-restart 'frame-exit))
 
-(define-accept-values-command (com-abort-avv :keystroke #+Genera #\Abort
-							#-Genera nil)
+(define-accept-values-command (com-abort-avv :keystroke :abort)
     ()
   (abort))
 
@@ -1078,7 +1074,7 @@
 
 (defmethod value-changed-callback ((gadget radio-box)
 				   (client accept-values-stream) id new-value)
-  (do-avv-command new-value client id))
+  (do-avv-command (gadget-id new-value) client id))
 
 (defun do-avv-command (new-value client id)
   (throw-highlighted-presentation
diff --git a/clim/accept.lisp b/clim/accept.lisp
index e6c8c7fb2e5bba3b55412de2e2c785c507e18b7e..3045941a6a7f8edd8f281d54c380e58ea7978fdd 100644
--- a/clim/accept.lisp
+++ b/clim/accept.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: accept.lisp,v 1.3 92/02/24 13:06:53 cer Exp $
+;; $fiHeader: accept.lisp,v 1.4 92/03/04 16:21:07 cer Exp $
 
 (in-package :clim-internals)
 
@@ -246,9 +246,9 @@
     ;; The input has been parsed, moused, or defaulted.
     ;; If we are still inside a WITH-INPUT-EDITING at an outer level, leave the
     ;; delimiter in the stream.  But if this was the top level of input, eat
-    ;; the activation character instead of leaving it in the stream.
-    ;; Don't eat the activation character on streams that can't ever support
-    ;; input editing, such as string streams.
+    ;; the activation gesture instead of leaving it in the stream. Don't eat
+    ;; the activation gesture on streams that can't ever support input editing,
+    ;; such as string streams.
     ;;--- This is really lousy.  We need a coherent theory here.
     (when activated
       (when (and (not (input-editing-stream-p stream))
diff --git a/clim/command-processor.lisp b/clim/command-processor.lisp
index 02c900f68ffff36141449effc9264edb10376891..fce22fadf8c584dcc81f98edc8d7514529e9f911 100644
--- a/clim/command-processor.lisp
+++ b/clim/command-processor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command-processor.lisp,v 1.3 92/02/24 13:07:05 cer Exp $
+;; $fiHeader: command-processor.lisp,v 1.4 92/03/04 16:21:13 cer Exp $
 
 (in-package :clim-internals)
 
@@ -15,7 +15,8 @@
 ;;; What separates command args.
 (defparameter *command-argument-delimiters* '(#\Space))
 
-(defparameter *command-previewers* '(#+Genera #\m-Complete))
+(define-gesture-name :preview-command :keyboard (:complete :meta))
+(defparameter *command-previewers* '(:preview-command))
 
 ;; This is around only to provide a input context "wall" during parsing
 (define-presentation-type command-arguments ())
@@ -46,7 +47,8 @@
 	     (multiple-value-bind (command final-delimiter)
 		 (invoke-command-name-parser-and-collect-1 
 		   command-name arg-parser delimiter-parser stream)
-	       (if (member final-delimiter *command-previewers*)
+	       (if (member final-delimiter *command-previewers*
+			   :test #'keyboard-event-matches-gesture-name-p)
 		   (with-input-editor-typeout (stream)
 		     (accept-values-command-parser
 		       command-name command-table 
@@ -97,9 +99,9 @@
     (when (and activation-p (activation-gesture-p delimiter))
       (unread-gesture delimiter :stream stream)
       (when echo-space
-	;; If we're not finished yet, leave the activation character for later,
-	;; insert a space in front of it, and read past the space.  Something like
-	;; the echo of a default will come after the space.
+	;; If we're not finished yet, leave the activation gesture for later,
+	;; insert a space in front of it, and read past the space.  Something
+	;; like the echo of a default will come after the space.
 	;; Must REPLACE-INPUT after UNREAD-GESTURE so the delimiter is unread
 	;; into the input editor's buffer, not the underlying stream's buffer.
 	(when (input-editing-stream-p stream)
@@ -183,12 +185,12 @@
 		      (when (activation-gesture-p char)
 			(return char))
 		      (unless (whitespace-char-p char)
-			(simple-parse-error "Extraneous character seen")))))
+			(simple-parse-error "Extraneous character seen at end of line")))))
 		 ((eq args-to-go :keywords)
 		  ;; Reached before reading the first keyword argument
 		  ;; If this is a command with no positional arguments, the preceding call
-		  ;; should have had args-to-go = (&key ...), but actually had :args
-		  ;; Compensate for that by checking for an activation character now
+		  ;; should have had args-to-go = (&key ...), but actually had :ARGS.
+		  ;; Compensate for that by checking for an activation gesture now
 		  (let ((char (read-gesture :stream stream :timeout 0)))
 		    (when char
 		      (unread-gesture char :stream stream)
@@ -388,11 +390,12 @@
 					 (read-gesture :stream stream :timeout timeout))))
 				 (when (eq numeric-arg :timeout)
 				   (return-from menu-command-parser nil))
-				 (when (characterp keystroke)
-				   (let ((command (lookup-keystroke-command-item
-						    keystroke command-table
-						    :test #'char-equal
-						    :numeric-argument numeric-arg)))
+				 (when (keyboard-event-p keystroke)
+				   (let ((command 
+					   (lookup-keystroke-command-item
+					     keystroke command-table
+					     :test #'keyboard-event-matches-gesture-name-p
+					     :numeric-argument numeric-arg)))
 				     (when (presentation-typep command command-type)
 				       (return-from menu-command-parser
 					 (values command command-type)))))
@@ -665,7 +668,7 @@
 			  (command-unparser *command-unparser*)
 			  (partial-command-parser *partial-command-parser*)
 			  (use-keystrokes nil)
-			  (keystroke-test #'eql))
+			  (keystroke-test #'keyboard-event-matches-gesture-name-p))
   (if use-keystrokes
       (with-command-table-keystrokes (keystrokes command-table)
 	(read-command-using-keystrokes command-table keystrokes
@@ -687,7 +690,7 @@
 					   (command-parser *command-parser*)
 					   (command-unparser *command-unparser*)
 					   (partial-command-parser *partial-command-parser*)
-					   (keystroke-test #'eql))
+					   (keystroke-test #'keyboard-event-matches-gesture-name-p))
   (let ((*command-parser* command-parser)
 	(*command-unparser* command-unparser)
 	(*partial-command-parser* partial-command-parser))
@@ -703,7 +706,7 @@
 	    (let ((*accelerator-gestures* keystrokes))
 	      (accept `(command :command-table ,command-table)
 		      :stream stream :prompt nil))))
-      (if (characterp command)
+      (if (keyboard-event-p command)
 	  (let ((command (lookup-keystroke-command-item command command-table
 							:test keystroke-test
 							:numeric-argument numeric-arg)))
diff --git a/clim/command.lisp b/clim/command.lisp
index b466361d7d8993e81d7a12c695931d6fdb7832b2..2e41a62112e521aa7847b6e2895399321a92b28c 100644
--- a/clim/command.lisp
+++ b/clim/command.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: command.lisp,v 1.4 92/03/04 16:21:15 cer Exp Locker: cer $
+;; $fiHeader: command.lisp,v 1.5 92/03/06 09:08:41 cer Exp $
 
 (in-package :clim-internals)
 
@@ -47,7 +47,7 @@
 ;; COMMANDS is a table of all the commands in this command table, which maps from the
 ;; command name to the command-line name.
 ;; COMMAND-LINE-NAMES is a sorted set that maps from command-line names to command names.
-;; MENU is a mapping from menu names and accelerator characters to menu items, stored
+;; MENU is a mapping from menu names and accelerator gestures to menu items, stored
 ;; in the form (MENU-NAME KEYSTROKE COMMAND-MENU-ITEM), where the menu item is of the
 ;; form (TYPE VALUE . OPTIONS).  MENU-TICK is incremented when MENU changes.
 ;; TRANSLATORS is the set of presentation translators for this command table.
@@ -195,13 +195,15 @@
     (nstring-capitalize (nsubstitute #\Space #\- name))))
 
 (defun add-command-to-command-table (command-name command-table
-				     &key name menu keystroke (test #'eql) (errorp t))
+				     &key name menu keystroke (test #'gesture-eql) (errorp t))
   (check-type command-name symbol)
   (setq command-table (find-command-table command-table))
   (when (eq name t)
     (setq name (command-name-from-symbol command-name)))
   (check-type name (or string null))
-  (check-type keystroke (or character null))	;---gesture spec
+  (when keystroke
+    (assert (keyboard-gesture-spec-p keystroke) (keystroke)
+	    "~S is not a keyboard gesture spec" keystroke))
   (when (command-present-in-command-table-p command-name command-table)
     (when errorp
       (cerror "Remove the command and proceed"
@@ -396,7 +398,9 @@
 					    text-style (errorp t))
   (check-type string (or string null))
   (check-type type (member :command :function :menu :divider))
-  (check-type keystroke (or character null))	;---gesture spec
+  (when keystroke
+    (assert (keyboard-gesture-spec-p keystroke) (keystroke)
+	    "~S is not a keyboard gesture spec" keystroke))
   (check-type documentation (or string null))
   (setq command-table (find-command-table command-table))
   (let ((old-item (and string (find-menu-item string command-table :errorp nil))))
@@ -669,30 +673,31 @@
 
 ;;; Keystroke accelerators
 
-(defun add-keystroke-to-command-table (command-table character type value
-				       &key documentation (test #'eql) (errorp t))
-  (check-type character character)		;---gesture spec
+(defun add-keystroke-to-command-table (command-table keystroke type value
+				       &key documentation (test #'gesture-eql) (errorp t))
+  (assert (keyboard-gesture-spec-p keystroke) (keystroke)
+	  "~S is not a keyboard gesture spec" keystroke)
   (check-type type (member :command :function :menu))
   (check-type documentation (or string null))
   (setq command-table (find-command-table command-table))
-  (let ((old-item (find-keystroke-item character command-table
+  (let ((old-item (find-keystroke-item keystroke command-table
 				       :test test :errorp nil)))
     (when old-item
       (when errorp
 	(cerror "Remove the keystroke item and proceed"
 		'command-already-present
 		:format-string "Keystroke item ~S already present in ~S"
-		:format-args (list character command-table)))
-	(remove-keystroke-from-command-table command-table character :test test)))
+		:format-args (list keystroke command-table)))
+	(remove-keystroke-from-command-table command-table keystroke :test test)))
   (add-menu-item-to-command-table command-table nil type value
 				  :documentation documentation
-				  :keystroke character :errorp nil))
+				  :keystroke keystroke :errorp nil))
 
-(defun remove-keystroke-from-command-table (command-table character
-					    &key (test #'eql) (errorp t))
+(defun remove-keystroke-from-command-table (command-table keystroke
+					    &key (test #'gesture-eql) (errorp t))
   (setq command-table (find-command-table command-table))
   (with-slots (menu keystrokes) command-table
-    (let ((index (position character menu :key #'second :test test)))
+    (let ((index (position keystroke menu :key #'second :test test)))
       (cond (index
 	     (let ((element (aref menu index)))
 	       ;; Don't remove the whole item if there's a menu-name,
@@ -708,7 +713,7 @@
 	     (when errorp
 	       (error 'command-not-present
 		      :format-string "Keystroke item ~S not present in ~S"
-		      :format-args (list character command-table))))))))
+		      :format-args (list keystroke command-table))))))))
 
 (defun map-over-command-table-keystrokes (function command-table)
   (declare (dynamic-extent function))
@@ -717,14 +722,14 @@
 		 (apply function entry)))
        (slot-value (find-command-table command-table) 'menu)))
 
-(defun find-keystroke-item (character command-table &key (test #'eql) (errorp t))
+(defun find-keystroke-item (keystroke command-table &key (test #'gesture-eql) (errorp t))
   (declare (values menu-item command-table))
   (let* ((command-table (find-command-table command-table))
 	 (entry (block find-entry
-		  ;; Do it the hard way so that CHAR-EQUAL doesn't see NILs
+		  ;; Do it the hard way so that GESTURE-EQL doesn't see NILs
 		  (map nil #'(lambda (entry)
 			       (when (and (second entry)
-					  (funcall test character (second entry)))
+					  (funcall test keystroke (second entry)))
 				 (return-from find-entry entry)))
 		       (slot-value command-table 'menu)))))
     (when entry
@@ -733,15 +738,15 @@
   (when errorp
     (error 'command-not-present
 	   :format-string "Keystroke ~S has no menu item present in ~S"
-	   :format-args (list character command-table))))
+	   :format-args (list keystroke command-table))))
 
-(defun lookup-keystroke-item (character command-table &key (test #'eql))
+(defun lookup-keystroke-item (keystroke command-table &key (test #'gesture-eql))
   (declare (values menu-item command-table))
   (labels ((map-menu (command-table)
 	     (map nil #'(lambda (entry)
 			  (let ((item (third entry)))
 			    (when (and (second entry)
-				       (funcall test character (second entry)))
+				       (funcall test keystroke (second entry)))
 			      (return-from lookup-keystroke-item
 				(values item command-table)))
 			    (when (and (eq (command-menu-item-type item) ':menu)
@@ -757,10 +762,10 @@
     (map-menu (find-command-table command-table))))
 
 ;; Return a command associated with a keystroke iff it is enabled.
-;; Otherwise, return the keystroke character.
-(defun lookup-keystroke-command-item (character command-table
-				      &key (test #'eql) (numeric-argument 1))
-  (let ((item (lookup-keystroke-item character command-table :test test)))
+;; Otherwise, return the keystroke keystroke.
+(defun lookup-keystroke-command-item (keystroke command-table
+				      &key (test #'gesture-eql) (numeric-argument 1))
+  (let ((item (lookup-keystroke-item keystroke command-table :test test)))
     (when item
       (let* ((type (command-menu-item-type item))
 	     (command 
@@ -770,7 +775,7 @@
 	(when (command-enabled (command-name command) *application-frame*)
 	  (return-from lookup-keystroke-command-item
 	    (substitute-numeric-argument-marker command numeric-argument))))))
-  character)
+  keystroke)
 
 (defmacro with-command-table-keystrokes ((keystrokes-var command-table) &body body)
   (let ((comtab '#:command-table))
diff --git a/clim/completer.lisp b/clim/completer.lisp
index 444bc9e6345c0512a7d7dad10b84f93b9d5282eb..b7adc5226c1cd6ec308fe3dcfe0edb86304989bf 100644
--- a/clim/completer.lisp
+++ b/clim/completer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: completer.lisp,v 1.3 92/02/24 13:07:09 cer Exp $
+;; $fiHeader: completer.lisp,v 1.4 92/03/04 16:21:17 cer Exp $
 
 (in-package :clim-internals)
 
@@ -41,8 +41,8 @@
 		      (and (eq action :help) help-displays-possibilities)))))
       (declare (dynamic-extent #'completion-help))
       (with-accept-help ((:subhelp #'completion-help))
-       ;; Keep the input editor from handling help and possibilities characters.
-       ;; They will get treated as activation characters, thus ensuring that 
+       ;; Keep the input editor from handling help and possibilities gestures.
+       ;; They will get treated as activation gestures, thus ensuring that 
        ;; STUFF-SO-FAR will be accurate when we display the possibilities.
        (let ((*ie-help-enabled* nil)
 	     (location (input-position stream))
@@ -63,14 +63,18 @@
 	    (extend-vector stuff-so-far token)
 	    (cond ((null ch)
 		   (error "Null ch?"))
-		  ((characterp ch)
-		   (cond ((member ch *help-gestures*)
+		  ((keyboard-event-p ch)
+		   (cond ((member ch *help-gestures* 
+				  :test #'keyboard-event-matches-gesture-name-p)
 			  (setq completion-mode ':help))
-			 ((member ch *possibilities-gestures*)
+			 ((member ch *possibilities-gestures* 
+				  :test #'keyboard-event-matches-gesture-name-p)
 			  (setq completion-mode ':possibilities))
-			 ((member ch *completion-gestures*)
+			 ((member ch *completion-gestures*
+				  :test #'keyboard-event-matches-gesture-name-p)
 			  (setq completion-mode ':complete-maximal))
-			 ((member ch partial-completers :test #'char-equal)
+			 ((member ch partial-completers 
+				  :test #'keyboard-event-matches-gesture-name-p)
 			  (setq completion-mode ':complete-limited
 				unread t extend t return 'if-completed))
 			 ;; What about "overloaded" partial completers??
diff --git a/clim/defresource.lisp b/clim/defresource.lisp
index 47e43adbcd80fb171d2b4f12eab5a0937196c289..7a5a0ba4e3336273505cb33442e7d286db009acb 100644
--- a/clim/defresource.lisp
+++ b/clim/defresource.lisp
@@ -1,12 +1,12 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: defresource.lisp,v 1.4 92/02/24 13:07:22 cer Exp $
+;; $fiHeader: defresource.lisp,v 1.5 92/03/04 16:21:26 cer Exp $
 
 (in-package :clim-internals)
 
 "Copyright (c) 1988, 1989, 1990 International Lisp Associates.  All rights reserved."
 
-(defstruct (resource-descriptor (:conc-name RD-)
+(defstruct (resource-descriptor (:conc-name rd-)
 				#+Allegro (:print-function print-resource)
 				(:constructor make-resource-descriptor (name)))
   name
@@ -20,9 +20,9 @@
 #+Allegro
 (defun print-resource (o s d)
   (declare (ignore d))
-  (format s "#<~S ~S>" (type-of o) (RD-name o)))
+  (format s "#<~S ~S>" (type-of o) (rd-name o)))
 
-(defstruct (object-storage (:conc-name OS-))
+(defstruct (object-storage (:conc-name os-))
   object
   use-cons
   parameters)
@@ -39,15 +39,15 @@
        ,@body)))
 
 (defun describe-resource (resource)
-  (with-resource-rd (resource RD)
-    (format t "~&Resource ~S:" (RD-name RD))
-    (when (RD-constructor RD)
-      (format t "~%Constructor: ~S" (RD-constructor RD)))
-    (when (RD-initializer RD)
-      (format t "~%Initializer: ~S" (RD-initializer RD)))
-    (when (RD-matcher RD)
-      (format t "~%Matcher: ~S" (RD-matcher RD)))
-    (let ((objects (RD-objects RD)))
+  (with-resource-rd (resource rd)
+    (format t "~&Resource ~S:" (rd-name rd))
+    (when (rd-constructor rd)
+      (format t "~%Constructor: ~S" (rd-constructor rd)))
+    (when (rd-initializer rd)
+      (format t "~%Initializer: ~S" (rd-initializer rd)))
+    (when (rd-matcher rd)
+      (format t "~%Matcher: ~S" (rd-matcher rd)))
+    (let ((objects (rd-objects rd)))
       (when (> (fill-pointer objects) 0)
 	(format t "~%~D Object~:P:" (fill-pointer objects)))
       (doseq (object-storage objects)
@@ -56,8 +56,8 @@
 		(os-use-cons object-storage))))))
 
 (defun clear-resource (resource)
-  (with-resource-rd (resource RD)
-    (setf (fill-pointer (RD-objects RD)) 0))
+  (with-resource-rd (resource rd)
+    (setf (fill-pointer (rd-objects rd)) 0))
   nil)
 
 (defun lookup-resource-descriptor (name)
@@ -89,14 +89,16 @@
 		     ((symbolp function) `#',function)
 		     (t (let ((function-name
 				(make-symbol (concatenate 'string
-							  (string name) "-" (string type)))))
+					       (string name) "-" (string type)))))
 			  (output `(defun ,function-name (,@extra-parameters ,@parameters)
 				     ,@extra-parameters ,@(cleanup-lambda-list parameters)
 				     ,function))
 			  `#',function-name)))))
-      (setf constructor (output-function constructor 'constructor (make-symbol "RD"))
+      (setf constructor (output-function constructor 'constructor 
+					 (make-symbol (symbol-name 'rd)))
 	    initializer (output-function initializer 'initializer name)
-	    matcher (or (output-function matcher 'matcher name (make-symbol "OBJECT-STORAGE"))
+	    matcher (or (output-function matcher 'matcher name
+					 (make-symbol (symbol-name 'object-storage)))
 			(output-function 'default-resource-matcher 'matcher))
 	    deinitializer (letf-globally ((parameters nil))
 			    (output-function deinitializer 'deinitializer name)))
@@ -110,33 +112,33 @@
 
 (defun defresource-load-time (name constructor initializer deinitializer matcher
 			      initial-copies)
-  #+Ignore
+  #+++ignore
   (when (lookup-resource-descriptor name)
     (cerror "Continue to overwrite old definition of resource ~S"
 	    "Attempt to redefine resource ~S" name))
-  (let ((RD (or (lookup-resource-descriptor name) (make-resource-descriptor name))))
-    (with-lock-held ((RD-lock RD) "Resource lock")
-      (unless (RD-objects RD)
-	(setf (RD-objects RD) (make-array (* 2 (or initial-copies 10))
+  (let ((rd (or (lookup-resource-descriptor name) (make-resource-descriptor name))))
+    (with-lock-held ((rd-lock rd) "Resource lock")
+      (unless (rd-objects rd)
+	(setf (rd-objects rd) (make-array (* 2 (or initial-copies 10))
 					  :fill-pointer 0))
 	(when initial-copies
 	  (dotimes (i initial-copies)
 	    #-(or Allegro Minima) (declare (ignore i))
-	    (vector-push (cons nil (funcall constructor RD)) (RD-objects RD)))))
-      (setf (RD-constructor RD) constructor)
-      (setf (RD-initializer RD) initializer)
-      (setf (RD-deinitializer RD) deinitializer)
-      (setf (RD-matcher RD) matcher)
-      (setf (lookup-resource-descriptor name) RD))))
-
-(defun allocate-resource (name &rest parameters &aux RD object-storage)
+	    (vector-push (cons nil (funcall constructor rd)) (rd-objects rd)))))
+      (setf (rd-constructor rd) constructor)
+      (setf (rd-initializer rd) initializer)
+      (setf (rd-deinitializer rd) deinitializer)
+      (setf (rd-matcher rd) matcher)
+      (setf (lookup-resource-descriptor name) rd))))
+
+(defun allocate-resource (name &rest parameters &aux rd object-storage)
   (declare (dynamic-extent parameters))
   (block allocate
-    (setf RD (lookup-resource-descriptor name))
-    (unless RD (error "Can't allocate nonexistent resource ~S" name))
-    (with-lock-held ((RD-lock RD) "Resource lock")
-      (let* ((array (RD-objects RD))
-	     (matcher (RD-matcher RD))
+    (setf rd (lookup-resource-descriptor name))
+    (unless rd (error "Can't allocate nonexistent resource ~S" name))
+    (with-lock-held ((rd-lock rd) "Resource lock")
+      (let* ((array (rd-objects rd))
+	     (matcher (rd-matcher rd))
 	     (fill-pointer (fill-pointer array)))
 	#+Genera (declare (sys:array-register array))
 	#+Minima (declare (type vector array))
@@ -147,50 +149,50 @@
 			 (equal (os-parameters object-storage) parameters)
 			 (apply matcher (os-object object-storage) object-storage parameters)))
 	    (if (os-use-cons object-storage)
-		(setf (car (os-use-cons object-storage)) RD
+		(setf (car (os-use-cons object-storage)) rd
 		      (cdr (os-use-cons object-storage)) i)
-		(setf (os-use-cons object-storage) (cons RD i)))
+		(setf (os-use-cons object-storage) (cons rd i)))
 	    (return-from allocate)))
-	(let* ((new-object (apply (RD-constructor RD) RD parameters))
+	(let* ((new-object (apply (rd-constructor rd) rd parameters))
 	       (array-size (array-dimension array 0)))
 	  (setf object-storage (make-object-storage
 				 :object new-object
-				 :use-cons (cons RD fill-pointer)
+				 :use-cons (cons rd fill-pointer)
 				 :parameters (copy-list parameters)))
 	  (when (<= array-size fill-pointer)
 	    (let ((new-array (make-array (* 2 array-size)
 					 :fill-pointer fill-pointer)))
 	      (replace new-array array)
-	      (setf array (setf (RD-objects RD) new-array))))
+	      (setf array (setf (rd-objects rd) new-array))))
 	  (vector-push object-storage array)))))
-  (when (RD-initializer RD) (apply (RD-initializer RD) (os-object object-storage) parameters))
+  (when (rd-initializer rd) (apply (rd-initializer rd) (os-object object-storage) parameters))
   (values (os-object object-storage) object-storage))
 
 (defun deallocate-resource (name object &optional allocation-key
-			    &aux RD object-array object-index object-storage)
+			    &aux rd object-array object-index object-storage)
     (if allocation-key
-	(setf RD (car (os-use-cons allocation-key)) object-array (RD-objects RD)
+	(setf rd (car (os-use-cons allocation-key)) object-array (rd-objects rd)
 	      object-index (cdr (os-use-cons allocation-key)))
-	(setf RD (or (lookup-resource-descriptor name)
+	(setf rd (or (lookup-resource-descriptor name)
 		     (error "Can't deallocate nonexistent resource ~S" name))
-	      object-array (RD-objects RD)
+	      object-array (rd-objects rd)
 	      object-index (position object object-array
 				     :key #'os-object)))
     (unless object-index
-      (error "Can't deallocate object ~S: not present in resource ~S" object (RD-name RD)))
-    (with-lock-held ((RD-lock RD) "Resource lock")
+      (error "Can't deallocate object ~S: not present in resource ~S" object (rd-name rd)))
+    (with-lock-held ((rd-lock rd) "Resource lock")
       (setf object-storage (aref object-array object-index))
       (unless (cdr (os-use-cons object-storage))
 	(error "Can't deallocate object ~S: already deallocated from resource ~S"
-	       object (RD-name RD)))
+	       object (rd-name rd)))
       (unless (eq object (os-object object-storage))
-	(error "Can't deallocate object ~S: not present in resource ~S" object (RD-name RD)))
-      (when (RD-deinitializer RD)
-	(funcall (RD-deinitializer RD) (os-object object-storage)))
+	(error "Can't deallocate object ~S: not present in resource ~S" object (rd-name rd)))
+      (when (rd-deinitializer rd)
+	(funcall (rd-deinitializer rd) (os-object object-storage)))
       (setf (cdr (os-use-cons object-storage)) nil)))
 
 (defmacro using-resource ((variable resource &rest parameters) &body body)
-  (let ((allocation-key (make-symbol "ALLOCATION-KEY")))
+  (let ((allocation-key (make-symbol (symbol-name 'allocation-key))))
     `(let ((,variable nil)
 	   (,allocation-key nil))
        (unwind-protect
diff --git a/clim/dragging-output.lisp b/clim/dragging-output.lisp
index e612a57b82f3880496231a062b9e29dcba8abf1c..1b7cca16cea492d973b2ac2d5d9f840bb64d7112 100644
--- a/clim/dragging-output.lisp
+++ b/clim/dragging-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: dragging-output.lisp,v 1.4 92/02/24 13:07:25 cer Exp $
+;; $fiHeader: dragging-output.lisp,v 1.5 92/03/04 16:21:30 cer Exp $
 
 (in-package :clim-internals)
 
@@ -21,7 +21,7 @@
 (defun drag-output-record (stream output-record
 			   &key (repaint t) (erase #'erase-output-record) feedback
 				(finish-on-release nil))
-  (declare (values final-x final-y))
+  (declare (values final-x final-y delta-x delta-y))
   (let (last-x last-y
 	(delta-x 0)
 	(delta-y 0)
diff --git a/clim/frames.lisp b/clim/frames.lisp
index db1b9aca809d71b4e0da5df818a94a5e1e3a11d6..399c2424097cc92034514cbe37af83cdd23df00d 100644
--- a/clim/frames.lisp
+++ b/clim/frames.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: frames.lisp,v 1.8 92/02/24 13:07:30 cer Exp $
+;; ;; $fiHeader: frames.lisp,v 1.9 92/03/04 16:21:35 cer Exp $
 
 (in-package :clim-internals)
 
@@ -580,32 +580,48 @@
 					       force-p)))
 		   (frame-top-level-sheet frame)))
 
-;;--- This needs to be more beefy, like in CLIM 1.0
-;;--- And what about CLIM 0.9's PANE-NEEDS-REDISPLAY, etc?
+;;--- What about CLIM 0.9's PANE-NEEDS-REDISPLAY, etc?
+;;--- What about CLIM 1.0's :DISPLAY-AFTER-COMMANDS :NO-CLEAR?
 (defun redisplay-frame-pane (frame pane &key force-p)
   (when (symbolp pane)
     (setq pane (get-frame-pane frame pane)))
   (when (pane-display-function pane)
-    (let* ((ird (slot-value pane 'incremental-redisplay-p))
-	   (history (and ird (stream-output-history pane)))
-	   (record (and history
-			(> (output-record-count history) 0)
-			(output-record-element history 0))))
+    (let* ((ir (slot-value pane 'incremental-redisplay-p))
+	   (redisplay-p (if (listp ir) (first ir) ir))
+	   (check-overlapping (or (atom ir)	;default is T
+				  (getf (rest ir) :check-overlapping t))))
       (with-simple-restart (nil "Skip redisplaying pane ~S" pane)
 	(loop
 	  (with-simple-restart (nil "Retry displaying pane ~S" pane)
 	    (return
-	      (cond ((and ird (or force-p (null record)))
-		     (when force-p
-		       (window-clear pane))
-		     (updating-output (pane)
-		       (invoke-pane-redisplay-function frame pane)))
-		    (ird
-		     (redisplay record pane))
-		    (t
-		     (invoke-pane-redisplay-function frame pane))))))))))
+	      (let ((redisplay-record
+		      (and redisplay-p
+			   (let ((history (stream-output-history pane)))
+			     (when history
+			       #+compulsive-redisplay
+			       (when (> (output-record-count history) 1)
+				 (cerror "Clear the output history and proceed"
+					 "There is more than one element in this redisplay pane")
+				 (window-clear pane))
+			       (unless (zerop (output-record-count history))
+				 (output-record-element history 0)))))))
+		(cond ((and redisplay-p
+			    (or force-p (null redisplay-record)))
+		       (when force-p
+			 (window-clear pane))
+		       (invoke-pane-redisplay-function frame pane))
+		      (redisplay-p
+		       (redisplay redisplay-record pane 
+				  :check-overlapping check-overlapping))
+		      (t
+		       (invoke-pane-display-function frame pane)))))))))))
 
 (defun invoke-pane-redisplay-function (frame pane &rest args)
+  (declare (dynamic-extent args))
+  (updating-output (pane)
+    (apply #'invoke-pane-display-function frame pane args)))
+
+(defun invoke-pane-display-function (frame pane &rest args)
   (declare (dynamic-extent args))
   (let* ((df (pane-display-function pane))
 	 (display-args (if (listp df) (rest df) nil))
@@ -741,6 +757,11 @@
 (defmethod frame-maintain-presentation-histories ((frame standard-application-frame))
   (not (null (find-frame-pane-of-type frame 'interactor-pane))))
 
+;;--- What should this really do?
+#+Allegro
+(defun notify-user (&rest ignore) 
+  (format excl::*initial-terminal-io* "Notify ~a~%" ignore))
+
 
 ;;; Pointer documentation
 
@@ -904,8 +925,3 @@
 
 #+Genera
 (defmethod mouse-documentation-window ((window window-stream)) nil)
-
-;;--- What should this do?
-
-(defun notify-user (&rest ignore) 
-  (format excl::*initial-terminal-io* "Notify ~a~%" ignore))
diff --git a/clim/genera-activities.lisp b/clim/genera-activities.lisp
deleted file mode 100644
index e69de29bb2d1d6434b8b29ae775ad8c2e48c5391..0000000000000000000000000000000000000000
diff --git a/clim/gestures.lisp b/clim/gestures.lisp
index b6a161a5e4c42ee270efd988923ad03b73572938..055672b7448f73c323a8c59138e63951baf7e99b 100644
--- a/clim/gestures.lisp
+++ b/clim/gestures.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gestures.lisp,v 1.3 92/02/24 13:07:39 cer Exp $
+;; $fiHeader: gestures.lisp,v 1.4 92/03/04 16:21:43 cer Exp $
 
 (in-package :clim-internals)
 
@@ -15,9 +15,6 @@
 ;;;    as per CLtL.
 ;;; 2) The set of possible "mouse buttons" is :LEFT, :MIDDLE, and :RIGHT.
 
-(defconstant *pointer-buttons* '#(:left :middle :right))
-(defconstant *modifier-keys*   '#(:shift :control :meta :super :hyper))
-
 (defun-inline button-index (name)
   #+Genera (declare lt:(side-effects simple reducible))
   (position name *pointer-buttons*))
@@ -33,6 +30,8 @@
 ;; Modifier states can be compared with =
 (defun make-modifier-state (&rest modifiers)
   (declare (dynamic-extent modifiers))
+  (assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
+	  "~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
   (let ((state 0))
     (dolist (name modifiers)
       (let ((bit (modifier-key-index name)))
@@ -63,6 +62,11 @@
 		      ,(ash 1 (length *modifier-keys*)))
 		    :initial-element nil))
 
+;; A table indexed by the modifier state.
+;; Each bucket in the table contains an alist of a keysym and 1 or more gesture names.
+(defvar *keysym-and-modifier-key->gesture*
+	(make-array (ash 1 (length *modifier-keys*)) :initial-element nil))
+
 ;; BUTTON is a button number (0, 1, or 2), and MODIFIER-STATE is a mask
 (defun-inline button-and-modifier-state-gesture-names (button modifier-state)
   (declare (fixnum button modifier-state))
@@ -90,7 +94,18 @@
   (declare (values button modifier-state))
   (do-button-and-modifier-state (button modifier-state bucket)
     (when (member gesture-name bucket)
-      (return-from gesture-name-button-and-modifiers (values button modifier-state))))
+      (return-from gesture-name-button-and-modifiers
+	(values button modifier-state))))
+  nil)
+
+(defun gesture-name-keysym-and-modifiers (gesture-name)
+  (declare (values keysym modifier-state))
+  (dotimes (index (ash 1 (length *modifier-keys*)))
+    (let ((bucket (aref *keysym-and-modifier-key->gesture* index)))
+      (dolist (entry bucket)
+	(when (member gesture-name (cdr entry))
+	  (return-from gesture-name-keysym-and-modifiers
+	    (values (car entry) index))))))
   nil)
 
 #||
@@ -149,9 +164,49 @@
       (- (integer-length button) #.(integer-length +pointer-left-button+))
       modifier-state gesture-name)))
 
+;;--- Shouldn't #\A match (:A :SHIFT), and so forth?
 (defun keyboard-event-matches-gesture-name-p (event gesture-name)
-  ;;--- Fill this in
-  )
+  (when (and (characterp event)
+	     (characterp gesture-name)
+	     (eql event gesture-name))
+    (return-from keyboard-event-matches-gesture-name-p t))
+  (multiple-value-bind (keysym modifier-state character)
+      (etypecase event
+	(character
+	  (values nil 0 event))
+	(key-press-event
+	  (values (keyboard-event-key-name event)
+		  (event-modifier-state event)
+		  (keyboard-event-character event))))
+    (declare (fixnum modifier-state))
+    (let ((bucket (aref *keysym-and-modifier-key->gesture* modifier-state)))
+      ;;--- Presently allows both keysyms and characters.  Is that right?
+      (or (member gesture-name (cdr (assoc keysym bucket)))
+	  (member gesture-name (cdr (assoc character bucket)))))))
+
+(defun-inline keyboard-event-p (x)
+  (or (characterp x)
+      (typep x 'key-press-event)))
+
+(defun keyboard-gesture-spec-p (x)
+  (let ((keysym (if (consp x) (first x) x))
+	(modifiers (and (consp x) (rest x))))
+    (and (or (characterp keysym)
+	     (symbolp keysym))
+	 (every #'(lambda (x) (find x *modifier-keys*)) modifiers))))
+
+;;--- Shouldn't #\A match (:A :SHIFT), and so forth?
+(defun gesture-eql (gesture1 gesture2)
+  (let ((g1-keysym (if (consp gesture1) (first gesture1) gesture1))
+	(g1-modifiers (and (consp gesture1) (rest gesture1)))
+	(g2-keysym (if (consp gesture2) (first gesture2) gesture2))
+	(g2-modifiers (and (consp gesture2) (rest gesture2))))
+    (and (or (eql g1-keysym g2-keysym)
+	     (and (characterp g1-keysym)
+		  (characterp g2-keysym)
+		  (char-equal g1-keysym g2-keysym)))
+	 (every #'(lambda (x) (member x g2-modifiers)) g1-modifiers)
+	 (every #'(lambda (x) (member x g1-modifiers)) g2-modifiers))))
 
 
 (defun add-gesture-name (name type gesture-spec &key (unique t))
@@ -161,18 +216,23 @@
   (ecase type
     (:keyboard
       (destructuring-bind (key-name &rest modifiers) gesture-spec
-	(check-type key-name (or character
-				 (member :newline :linefeed :tab :backspace :page :rubout)))
-	(assert (every #'(lambda (x) (member x '(:shift :control :meta :super :hyper)))
-		       modifiers) (modifiers)
+	(check-type key-name (or symbol character))
+	(assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
 		"~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
-	;;--- Fill this in
-	))
+	(let* ((index (apply #'make-modifier-state modifiers))
+	       (bucket (aref *keysym-and-modifier-key->gesture* index))
+	       (entry (assoc key-name bucket)))
+	  (cond (entry
+		 (setf (aref *keysym-and-modifier-key->gesture* index)
+		       (nsubstitute (append entry (list name)) entry bucket)))
+		(t
+		 (setq entry (list key-name name))
+		 (push entry (aref *keysym-and-modifier-key->gesture* index))))
+	  bucket)))
     (:pointer-button
       (destructuring-bind (button &rest modifiers) gesture-spec
 	(check-type button (member :left :middle :right))
-	(assert (every #'(lambda (x) (member x '(:shift :control :meta :super :hyper)))
-		       modifiers) (modifiers)
+	(assert (every #'(lambda (x) (find x *modifier-keys*)) modifiers) (modifiers)
 		"~S is not a subset of ~S" modifiers '(:shift :control :meta :super :hyper))
 	(pushnew name (button-and-modifier-state-gesture-names
 			(button-index button)
@@ -182,7 +242,14 @@
   (do-button-and-modifier-state (button modifier-state bucket)
     (when (member name bucket)
       (setf (aref *button-and-modifier-key->gesture* button modifier-state)
-	    (delete name bucket)))))
+	    (delete name bucket))))
+  (dotimes (index (ash 1 (length *modifier-keys*)))
+    (let ((bucket (aref *keysym-and-modifier-key->gesture* index)))
+      (do* ((entryl bucket (cdr entryl))
+	    (entry (first entryl) (first entryl)))
+	   ((null entryl))
+	(when (member name (cdr entry))
+	  (setf (first entryl) (delete name entry)))))))
 
 #+CLIM-1-compatibility
 (define-compatibility-function (add-pointer-gesture-name add-gesture-name)
diff --git a/clim/input-editor-commands.lisp b/clim/input-editor-commands.lisp
index 570f5ccf5f76ca25c98a16c44544e90fee8be1d2..591d5b5ddc93ae6d21b13983639d6339b1e33e37 100644
--- a/clim/input-editor-commands.lisp
+++ b/clim/input-editor-commands.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-editor-commands.lisp,v 1.3 92/02/24 13:07:52 cer Exp $
+;; $fiHeader: input-editor-commands.lisp,v 1.4 92/03/04 16:21:53 cer Exp $
 
 (in-package :clim-internals)
 
@@ -11,29 +11,41 @@
 ;;; an input editor.  This may prove to be a foolish decision down the pike.
 
 (eval-when (compile load eval)
-(defvar *ie-command-arglist* '(stream input-buffer character numeric-argument))
+(defvar *ie-command-arglist* '(stream input-buffer gesture numeric-argument))
 )
 
-;; CHARS is either a single character, or a list of characters.  FUNCTION is
-;; the function that implements an input editor command.  This associates
-;; the character(s) with the command.
-(defun add-input-editor-command (characters function)
-  (flet ((add-aarray-entry (char thing aarray)
-	   (let ((old (find char aarray :key #'first)))
+;; GESTURES is either a gesture name, or a list of gesture names.  FUNCTION
+;; is the function that implements an input editor command.  This associates
+;; the gesture(s) with the command.
+(defun add-input-editor-command (gestures function)
+  (flet ((add-aarray-entry (gesture thing aarray)
+	   (let ((old (find gesture aarray :key #'first)))
 	     (if old
 		 (setf (second old) thing)
-	         (vector-push-extend (list char thing) aarray)))))
-    (declare (dynamic-extent #'add-aarray-entry))
-    (cond ((characterp characters)
-	   (assert (not (ordinary-char-p characters)))
-	   (add-aarray-entry characters function *input-editor-command-aarray*))
+	         (vector-push-extend (list gesture thing) aarray))))
+	 ;; Does the gesture correspond to some character with any bucky
+	 ;; bits on, or some other non-standard non-printing character?
+	 (bucky-char-p (gesture)
+	   (multiple-value-bind (keysym modifier-state)
+	       (gesture-name-keysym-and-modifiers gesture)
+	     (if (zerop modifier-state)
+		 ;;--- What should this really be?
+		 (member keysym '(:rubout :clear-input :scroll))
+		 (logtest modifier-state
+			  #.(logior +control-key+ +meta-key+ +super-key+ +hyper-key+))))))
+    (declare (dynamic-extent #'add-aarray-entry #'bucky-char-p))
+    (cond ((atom gestures)
+	   (assert (bucky-char-p gestures) (gestures)
+		   "~S does not correspond to a bucky character" gestures)
+	   (add-aarray-entry gestures function *input-editor-command-aarray*))
 	  (t
-	   (assert (> (length characters) 1))
-	   (assert (not (ordinary-char-p (first characters))))
-	   ;; We've got a command that wil be bound to a sequence of characters,
+	   (assert (> (length gestures) 1))
+	   (assert (bucky-char-p (first gestures)) (gestures)
+		   "~S does not correspond to a bucky character" gestures)
+	   ;; We've got a command that wil be bound to a sequence of gestures,
 	   ;; so set up the prefix tables.
 	   (let ((aarray *input-editor-command-aarray*))
-	     (dorest (rest characters)
+	     (dorest (rest gestures)
 	       (let* ((prefix (first rest))
 		      (rest (rest rest)))
 		 (if (null rest)
@@ -44,81 +56,56 @@
 			 (add-aarray-entry prefix subaarray aarray))
 		       (setq aarray subaarray))))))))))
 
-(defmacro assign-input-editor-key-bindings (&body functions-and-keystrokes)
-  (let ((forms nil))
-    (loop
-      (when (null functions-and-keystrokes) (return))
-      (let* ((function (pop functions-and-keystrokes))
-	     (keystrokes (pop functions-and-keystrokes)))
-	(when keystrokes
-	  (push `(add-input-editor-command ',keystrokes ',function)
-		forms))))
-    `(progn ,@(nreverse forms))))
-
-;; These need to be defined before being used, otherwise they would
-;; live in CLOE-IMPLMENTATION
-#+Cloe-Runtime
-(eval-when (compile load)
-	   
-;; Define the new key chars for Cloe CLIM.  Regular Cloe defines 0-127, we define
-;; 128-139 as the F-keys (F1 thru F12), 140 for c-sh-A, and 141 as c-sh-V
-(sys::define-character-name "F1" 128)
-(sys::define-character-name "F2" 129)
-(sys::define-character-name "F3" 130)
-(sys::define-character-name "F4" 131)
-(sys::define-character-name "F5" 132)
-(sys::define-character-name "F6" 133)
-(sys::define-character-name "F7" 134)
-(sys::define-character-name "F8" 135)
-(sys::define-character-name "F9" 136)
-;; Note windows traps F10 as alt-space. Why?
-(sys::define-character-name "F10" 137)
-(sys::define-character-name "F11" 138)
-(sys::define-character-name "F12" 139)
-(sys::define-character-name "Arglist" 140)
-(sys::define-character-name "ShowValue" 141)
-
-)	;eval-when
 
 ;; When T, the input editor should handle help and completion.  Otherwise,
 ;; something like COMPLETE-INPUT will do it for us.
 (defvar *ie-help-enabled* t)
 
+(define-gesture-name :complete :keyboard (:tab))
+(define-gesture-name :complete :keyboard (:complete))
+(define-gesture-name :help     :keyboard (:help))
+(define-gesture-name :possibilities :keyboard (:? :shift :control))
+
 ;; These need to be on a per-implementation basis, naturally
-;;--- If you change these, change *MAGIC-COMPLETION-CHARACTERS* too
-(defvar *completion-gestures* #+Genera '(#\Complete #\Tab)
-			      #-Genera '(#\Tab))
-(defvar *help-gestures* '(#+Genera #\Help
-			  #+Cloe-Runtime #\F1
-			  #+CCL-2 #\^E))
-(defvar *possibilities-gestures* `(#+Genera  #\c-?
-				   #+Lucid   #\control-\?
-				   #+Allegro #\c-?
-				   #+CCL-2   ,(extended-char #\? :control :shift)))
-
-(defun lookup-input-editor-command (character aarray)
+;;--- If you change these, change *MAGIC-COMPLETION-GESTURES* too
+(defvar *completion-gestures* '(:complete))
+(defvar *help-gestures* '(:help))
+(defvar *possibilities-gestures* '(:possibilities))
+
+(defun lookup-input-editor-command (gesture aarray)
   ;; Need to handle the help and possibilities commands specially so
   ;; that they work correctly inside of COMPLETE-INPUT
-  (cond ((and *ie-help-enabled* (member character *help-gestures*))
+  (cond ((and *ie-help-enabled* 
+	      (member gesture *help-gestures*
+		      :test #'keyboard-event-matches-gesture-name-p))
 	 'com-ie-help)
-	((and *ie-help-enabled* (member character *possibilities-gestures*))
+	((and *ie-help-enabled*
+	      (member gesture *possibilities-gestures*
+		      :test #'keyboard-event-matches-gesture-name-p))
 	 'com-ie-possibilities)
-	((and *ie-help-enabled* (member character *completion-gestures*))
+	((and *ie-help-enabled*
+	      (member gesture *completion-gestures*
+		      :test #'keyboard-event-matches-gesture-name-p))
 	 'com-ie-complete)
 	(t
-	 (let ((code (char-code character))
-	       (bits (char-bits character)))
+	 (let* ((keysym (keyboard-event-key-name gesture))
+		(modifier-state (event-modifier-state gesture))
+		(bucky-p
+		  (logtest modifier-state
+			   #.(logior +control-key+ +meta-key+ +super-key+ +hyper-key+))))
 	   (cond ((and (eq aarray *input-editor-command-aarray*)
-		       (not (zerop bits))
-		       (<= (char-code #\0) code (char-code #\9)))
+		       bucky-p
+		       (member keysym '(:0 :1 :2 :3 :4 :5 :6 :7 :8 :9)))
 		  ;; A numeric argument...
-		  (- code (char-code #\0)))
+		  (position keysym '(:0 :1 :2 :3 :4 :5 :6 :7 :8 :9)))
 		 ((and (eq aarray *input-editor-command-aarray*)
-		       (not (zerop bits))
-		       (= code (char-code #\-)))
+		       bucky-p
+		       (eq keysym ':-))		;a smiley face indeed!
 		  -1)
 		 (t
-		  (second (find character aarray :key #'first))))))))
+		  (second (find gesture aarray 
+				:key #'first 
+				:test #'keyboard-event-matches-gesture-name-p))))))))
 
 (defmacro define-input-editor-command ((name &key (rescan T) (type 'motion) history)
 				       arglist &body body)
@@ -140,45 +127,53 @@
 (scl:defprop define-input-editor-command zwei:defselect-function-spec-finder
 	     zwei:definition-function-spec-finder)
 
-(defmethod stream-process-gesture ((istream input-editing-stream-mixin) gesture type)
+(defmethod stream-process-gesture ((istream input-editing-stream-mixin)
+				   gesture type)
+  (values gesture type))
+
+;; No input editing commands are standard characters...
+(defmethod stream-process-gesture ((istream input-editing-stream-mixin)
+				   (gesture character) type)
+  (with-slots (last-command-type command-state) istream
+    (setq last-command-type 'character
+	  command-state *input-editor-command-aarray*))
+  (values gesture type))
+
+(defmethod stream-process-gesture ((istream input-editing-stream-mixin) 
+				   (gesture key-press-event) type)
   (with-slots (numeric-argument last-command-type command-state) istream
-    (cond ((characterp gesture)
-	   ;; The COMMAND-STATE slot holds the current IE command aarray,
-	   ;; and gets updated when we see a prefix characters (e.g., ESC)
-	   (let ((command (unless (activation-gesture-p gesture)
-			    (lookup-input-editor-command gesture command-state))))
-	     (cond ((numberp command)
-		    (cond ((null numeric-argument)
-			   (setq numeric-argument command))
-			  ((= command -1)
-			   (setq numeric-argument (- numeric-argument)))
-			  (t
-			   (setq numeric-argument (+ (* numeric-argument 10) command))))
-		    ;; Numeric arguments don't affect LAST-COMMAND-TYPE
-		    (return-from stream-process-gesture nil))
-		   ((arrayp command)
-		    ;; A prefix character, update the state and return
-		    (setq command-state command)
-		    (return-from stream-process-gesture nil))
-		   (command
-		    (let ((argument (or numeric-argument 1)))
-		      (setq numeric-argument nil
-			    command-state *input-editor-command-aarray*)
-		      (funcall command
-			       istream (slot-value istream 'input-buffer) gesture argument))
-		    (return-from stream-process-gesture nil))
-		   ((not (eq command-state *input-editor-command-aarray*))
-		    (beep istream)
-		    (setq numeric-argument nil
-			  command-state *input-editor-command-aarray*)
-		    (return-from stream-process-gesture nil))
+    ;; The COMMAND-STATE slot holds the current IE command aarray, and
+    ;; gets updated when we see a prefix (such as ESC or c-X)
+    (let ((command (unless (activation-gesture-p gesture)
+		     (lookup-input-editor-command gesture command-state))))
+      (cond ((numberp command)
+	     (cond ((null numeric-argument)
+		    (setq numeric-argument command))
+		   ((= command -1)
+		    (setq numeric-argument (- numeric-argument)))
 		   (t
-		    (setq last-command-type 'character
-			  command-state *input-editor-command-aarray*)))))
-	  (t
-	   (setq numeric-argument nil
-		 last-command-type 'gesture
-		 command-state *input-editor-command-aarray*))))
+		    (setq numeric-argument (+ (* numeric-argument 10) command))))
+	     ;; Numeric arguments don't affect LAST-COMMAND-TYPE
+	     (return-from stream-process-gesture nil))
+	    ((arrayp command)
+	     ;; A prefix, update the state and return
+	     (setq command-state command)
+	     (return-from stream-process-gesture nil))
+	    (command
+	     (let ((argument (or numeric-argument 1)))
+	       (setq numeric-argument nil
+		     command-state *input-editor-command-aarray*)
+	       (funcall command
+			istream (slot-value istream 'input-buffer) gesture argument))
+	     (return-from stream-process-gesture nil))
+	    ((not (eq command-state *input-editor-command-aarray*))
+	     (beep istream)
+	     (setq numeric-argument nil
+		   command-state *input-editor-command-aarray*)
+	     (return-from stream-process-gesture nil))
+	    (t
+	     (setq last-command-type 'character
+		   command-state *input-editor-command-aarray*)))))
   (values gesture type))
 
 
@@ -658,206 +653,83 @@
         (beep))))
 
 
-;;; Per-platform key bindings
-
-#+Genera
-(assign-input-editor-key-bindings
-  com-ie-ctrl-g		       #\c-G
-  com-ie-universal-argument    #\c-U
-  com-ie-forward-character     #\c-F
-  com-ie-forward-word	       #\m-F
-  com-ie-backward-character    #\c-B
-  com-ie-backward-word	       #\m-B
-  com-ie-beginning-of-buffer   #\m-<
-  com-ie-end-of-buffer	       #\m->
-  com-ie-beginning-of-line     #\c-A
-  com-ie-end-of-line	       #\c-E
-  com-ie-next-line	       #\c-N
-  com-ie-previous-line	       #\c-P
-  com-ie-rubout		       #\Rubout
-  com-ie-delete-character      #\c-D
-  com-ie-rubout-word	       #\m-Rubout
-  com-ie-delete-word	       #\m-D
-  com-ie-clear-input	       #\Clear-Input
-  com-ie-kill-line	       #\c-K
-  com-ie-make-room	       #\c-O
-  com-ie-transpose-characters  #\c-T
-  com-ie-show-arglist	       #\c-sh-A
-  com-ie-show-value	       #\c-sh-V
-  com-ie-kill-ring-yank	       #\c-Y
-  com-ie-history-yank	       #\c-m-Y
-  com-ie-yank-next	       #\m-Y
-  com-ie-scroll-forward	       #\Scroll
-  com-ie-scroll-backward       #\meta-Scroll
-  com-ie-scroll-forward	       #\c-V
-  com-ie-scroll-backward       #\meta-V)
-
-#+Cloe-Runtime
-(assign-input-editor-key-bindings
-  com-ie-ctrl-g		       #\BEL
-  com-ie-universal-argument    nil    
-  com-ie-beginning-of-buffer   #\m-<
-  com-ie-end-of-buffer	       #\m->
-  com-ie-forward-character     #\ACK
-  com-ie-forward-word	       #\m-F
-  com-ie-backward-character    #\STX
-  com-ie-backward-word	       #\m-B
-  com-ie-beginning-of-line     #\SOH
-  com-ie-end-of-line	       #\ENQ
-  com-ie-next-line	       #\SO
-  com-ie-previous-line	       #\DLE
-  com-ie-rubout		       #\Rubout
-  com-ie-delete-character      #\Eot
-  com-ie-rubout-word	       #\m-Rubout
-  com-ie-delete-word	       #\m-D
-  com-ie-clear-input	       #\Del
-  com-ie-kill-line	       #\Vt
-  com-ie-make-room	       nil
-  com-ie-transpose-characters  #\DC4
-  com-ie-show-arglist	       #\Arglist
-  com-ie-show-value	       #\ShowValue
-  com-ie-kill-ring-yank	       #\EM
-  com-ie-history-yank	       #\F3
-  com-ie-yank-next	       #\m-Y
-  com-ie-scroll-forward        #\Syn
-  com-ie-scroll-backward       #\m-V)
-
-#+Minima-Runtime
-(assign-input-editor-key-bindings
-  com-ie-rubout		       #\Rubout)
-
-#+Lucid
-(assign-input-editor-key-bindings
-  com-ie-ctrl-g		       #\Control-\g
-  com-ie-universal-argument    #\Control-\u
-  com-ie-forward-character     #\Control-\f
-  com-ie-forward-word	       #\Meta-\f
-  com-ie-backward-character    #\Control-\b
-  com-ie-backward-word	       #\Meta-\b
-  com-ie-beginning-of-buffer   #\Meta-<
-  com-ie-end-of-buffer	       #\Meta->
-  com-ie-beginning-of-line     #\Control-\a
-  com-ie-end-of-line	       #\Control-\e
-  com-ie-next-line	       #\Control-\n
-  com-ie-previous-line	       #\Control-\p
-  com-ie-rubout		       #\Rubout
-  com-ie-delete-character      #\Control-\d
-  com-ie-rubout-word	       #\Meta-Rubout
-  com-ie-delete-word	       #\Meta-\d
-  com-ie-clear-input	       #\Control-Meta-Rubout
-  com-ie-kill-line	       #\Control-\k
-  com-ie-make-room	       #\Control-\o
-  com-ie-transpose-characters  #\Control-\t
-  com-ie-show-arglist	       #\Control-\A
-  com-ie-show-value	       #\Control-\V
-  com-ie-kill-ring-yank	       #\Control-\y
-  com-ie-history-yank	       #\Control-Meta-\y
-  com-ie-yank-next	       #\Meta-\y
-  com-ie-scroll-forward	       #\Control-\v
-  com-ie-scroll-backward       #\Meta-\v)
-
-#+(and Allegro (not Silica))
-;; Like above but lowercase characters
-(assign-input-editor-key-bindings
-  com-ie-ctrl-g		       #\c-\g
-  com-ie-universal-argument    nil
-  com-ie-forward-character     #\c-\f
-  com-ie-forward-word	       #\meta-\f
-  com-ie-backward-character    #\c-\b
-  com-ie-backward-word	       #\meta-\b
-  com-ie-beginning-of-buffer   #\meta-\<
-  com-ie-end-of-buffer	       #\meta-\>
-  com-ie-beginning-of-line     #\c-\a
-  com-ie-end-of-line	       #\c-\e
-  com-ie-next-line	       #\c-\n
-  com-ie-previous-line	       #\c-\p
-  com-ie-rubout		       #\rubout
-  com-ie-delete-character      #\c-\d
-  com-ie-rubout-word	       #\meta-rubout
-  com-ie-delete-word	       #\meta-d
-  com-ie-clear-input	       #\c-\u
-  com-ie-kill-line	       #\c-\k
-  com-ie-make-room	       #\c-\o
-  com-ie-transpose-characters  #\c-\t
-  com-ie-show-arglist	       (#\c-\x #\c-\a)
-  com-ie-show-value	       (#\c-\x #\c-\v)
-  com-ie-kill-ring-yank	       #\c-\y
-  com-ie-history-yank	       #\control-meta-\y
-  com-ie-yank-next	       #\meta-\y
-  com-ie-scroll-forward	       #\c-\v
-  com-ie-scroll-backward       #\meta-\v)
-
-;;--- Until the keyboard event processor works...
-#+(and Allegro Silica)
-(assign-input-editor-key-bindings
-  com-ie-ctrl-g		       #\^g
-  com-ie-universal-argument    nil
-  com-ie-forward-character     #\^f
-  com-ie-forward-word	       #\meta-\f
-  com-ie-backward-character    #\^b
-  com-ie-backward-word	       #\meta-\b
-  com-ie-beginning-of-buffer   #\meta-\<
-  com-ie-end-of-buffer	       #\meta-\>
-  com-ie-beginning-of-line     #\^a
-  com-ie-end-of-line	       #\^e
-  com-ie-next-line	       #\^n
-  com-ie-previous-line	       #\^p
-  com-ie-rubout		       #\rubout
-  com-ie-rubout                #\backspace
-  com-ie-rubout                #\c-\h
-  com-ie-delete-character      #\^d
-  com-ie-rubout-word	       #\meta-rubout
-  com-ie-delete-word	       #\meta-d
-  com-ie-clear-input	       #\^u
-  com-ie-kill-line	       #\^k
-  com-ie-make-room	       #\^o
-  com-ie-transpose-characters  #\^t
-  com-ie-show-arglist	       (#\^x #\^a)
-  com-ie-show-value	       (#\^x #\^v)
-  com-ie-kill-ring-yank	       #\^y
-  com-ie-history-yank	       #\control-meta-\y
-  com-ie-yank-next	       #\meta-\y
-  com-ie-scroll-forward	       #\^v
-  com-ie-scroll-backward       #\meta-\v)
-
-#+CCL-2
-(defmacro assign-input-editor-key-bindings-ccl (&body functions-and-keystrokes)
+;;; Key bindings
+
+(defmacro define-input-editor-gestures (&body gestures)
+  `(progn
+     ,@(mapcar #'(lambda (gesture) 
+		   (let ((name (first gesture))
+			 (gesture-spec (rest gesture)))
+		     `(add-gesture-name ,name :keyboard ',gesture-spec :unique nil)))
+	       gestures)))
+
+(define-input-editor-gestures
+  (:ie-abort                :g  :control)
+  (:ie-universal-argument   :u  :control)
+  (:ie-forward-character    :f  :control)
+  (:ie-forward-word	    :f  :meta)
+  (:ie-backward-character   :b  :control)
+  (:ie-backward-word	    :b  :meta)
+  (:ie-beginning-of-buffer  :\< :meta)
+  (:ie-end-of-buffer	    :\> :meta)
+  (:ie-beginning-of-line    :a  :control)
+  (:ie-end-of-line	    :e  :control)
+  (:ie-next-line	    :n  :control)
+  (:ie-previous-line	    :p  :control)
+  (:ie-delete-character	    :d  :control)
+  (:ie-delete-word	    :d  :meta)
+  (:ie-rubout-character     :rubout)
+  (:ie-rubout-word	    :rubout :meta)
+  (:ie-kill-line	    :k  :control)
+  (:ie-clear-input	    :clear-input)
+  (:ie-make-room	    :o  :control)
+  (:ie-transpose-characters :t  :control)
+  (:ie-show-arglist	    :a  :control :shift)
+  (:ie-show-value	    :v  :control :shift)
+  (:ie-kill-ring-yank	    :y  :control)
+  (:ie-history-yank	    :y  :control :meta)
+  (:ie-yank-next	    :y  :meta)
+  (:ie-scroll-forward	    :v  :control)
+  (:ie-scroll-backward	    :v  :meta)
+  (:ie-scroll-forward	    :scroll)
+  (:ie-scroll-backward	    :scroll :meta))
+
+(defmacro assign-input-editor-key-bindings (&body functions-and-gestures)
   (let ((forms nil))
     (loop
-      (when (null functions-and-keystrokes) (return))
-      (let* ((function (pop functions-and-keystrokes))
-             (keystroke (pop functions-and-keystrokes)))
-        (when keystroke
-          (push `(add-input-editor-command ,keystroke ',function)
-                forms))))
+      (when (null functions-and-gestures) (return))
+      (let* ((function (pop functions-and-gestures))
+	     (gesture (pop functions-and-gestures)))
+	(when gesture
+	  (push `(add-input-editor-command ',gesture ',function)
+		forms))))
     `(progn ,@(nreverse forms))))
 
-#+CCL-2
-(assign-input-editor-key-bindings-ccl
-  com-ie-ctrl-g		       (extended-char #\g :control)
-  com-ie-universal-argument    (extended-char #\u :control)
-  com-ie-forward-character     (extended-char #\f :control)
-  com-ie-forward-word	       (extended-char #\f :meta)
-  com-ie-backward-character    (extended-char #\b :control)
-  com-ie-backward-word	       (extended-char #\b :meta)
-  com-ie-beginning-of-buffer   (extended-char #\< :meta)
-  com-ie-end-of-buffer	       (extended-char #\> :meta)
-  com-ie-beginning-of-line     (extended-char #\a :control)
-  com-ie-end-of-line	       (extended-char #\e :control)
-  com-ie-next-line	       (extended-char #\n :control)
-  com-ie-previous-line	       (extended-char #\p :control)
-  com-ie-rubout		       #\Rubout
-  com-ie-delete-character      (extended-char #\d :control)
-  com-ie-rubout-word	       (extended-char #\Rubout :meta)
-  com-ie-delete-word	       (extended-char #\d :meta)
-  com-ie-clear-input	       (extended-char #\Rubout :control :meta)
-  com-ie-kill-line	       (extended-char #\k :control)
-  com-ie-make-room	       (extended-char #\o :control)
-  com-ie-transpose-characters  (extended-char #\t :control)
-  com-ie-show-arglist	       (extended-char #\A :control :shift)
-  com-ie-show-value	       (extended-char #\V :control :shift)
-  com-ie-kill-ring-yank	       (extended-char #\y :control)
-  com-ie-history-yank	       (extended-char #\y :control :meta)
-  com-ie-yank-next	       (extended-char #\y :meta)
-  com-ie-scroll-forward	       (extended-char #\v :control)
-  com-ie-scroll-backward       (extended-char #\v :meta))
+(assign-input-editor-key-bindings
+  com-ie-ctrl-g		       :ie-abort
+  com-ie-universal-argument    :ie-universal-argument
+  com-ie-forward-character     :ie-forward-character
+  com-ie-forward-word	       :ie-forward-word
+  com-ie-backward-character    :ie-backward-character
+  com-ie-backward-word	       :ie-backward-word
+  com-ie-beginning-of-buffer   :ie-beginning-of-buffer
+  com-ie-end-of-buffer	       :ie-end-of-buffer
+  com-ie-beginning-of-line     :ie-beginning-of-line
+  com-ie-end-of-line	       :ie-end-of-line
+  com-ie-next-line	       :ie-next-line
+  com-ie-previous-line	       :ie-previous-line
+  com-ie-delete-character      :ie-delete-character
+  com-ie-delete-word	       :ie-delete-word
+  com-ie-rubout		       :ie-rubout-character
+  com-ie-rubout-word	       :ie-rubout-word
+  com-ie-clear-input	       :ie-clear-input
+  com-ie-kill-line	       :ie-kill-line
+  com-ie-make-room	       :ie-make-room
+  com-ie-transpose-characters  :ie-transpose-characters
+  com-ie-show-arglist	       :ie-show-arglist
+  com-ie-show-value	       :ie-show-value
+  com-ie-kill-ring-yank	       :ie-kill-ring-yank
+  com-ie-history-yank	       :ie-history-yank
+  com-ie-yank-next	       :ie-yank-next
+  com-ie-scroll-forward	       :ie-scroll-forward
+  com-ie-scroll-backward       :ie-scroll-backward)
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 264fda2b003d83c878657da1b68fe8b02ca89b3a..f6b1164cb7c8bdae96154fdbb930770cf42356b7 100644
--- a/clim/input-protocol.lisp
+++ b/clim/input-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: input-protocol.lisp,v 1.7 92/02/28 09:17:49 cer Exp $
+;; $fiHeader: input-protocol.lisp,v 1.8 92/03/04 16:21:55 cer Exp $
 
 (in-package :clim-internals)
 
@@ -57,7 +57,9 @@
 ;;; Our implementation of the extended-input protocol.
 (defclass input-protocol-mixin
 	 (basic-extended-input-protocol)
-    ((pointer-motion-pending :initform nil)
+    (#+++ignore (input-buffer :accessor stream-input-buffer
+			      :initarg :input-buffer)
+     (pointer-motion-pending :initform nil)
      (text-cursor :accessor stream-text-cursor
 		  :initarg :text-cursor))
   (:default-initargs
@@ -156,18 +158,18 @@
 (defmethod queue-event ((stream input-protocol-mixin) (event key-press-event))
   (let ((char (keyboard-event-character event))
 	(keysym (keyboard-event-key-name event)))
-    ;; this probably wants to be STRING-CHAR-P, but that will still require some thought.
-    (cond ((and char (characterp char))
+    ;;--- This probably wants to be STRING-CHAR-P...
+    (cond ((and char (standard-char-p char))
 	   (queue-put (stream-input-buffer stream) char))
-	  ((and keysym (not (typep keysym 'modifier-keysym))
-	   (queue-put (stream-input-buffer stream) (copy-event event))))
+	  ((and keysym (not (typep keysym 'modifier-keysym)))
+	   (queue-put (stream-input-buffer stream) (copy-event event)))
 	  (keysym
 	   ;; must be a shift keysym
 	   ;; must update the pointer shifts.
 	   (let ((pointer (stream-primary-pointer stream)))
 	     (when pointer
 	       (setf (pointer-button-state pointer) 
-		 (event-modifier-state event))))))))
+		     (event-modifier-state event))))))))
 
 (defmethod queue-event ((stream input-protocol-mixin) (event key-release-event))
   ;;--- key state table?  Not unless all sheets are helping maintain it.
@@ -179,9 +181,10 @@
 	  (setf (pointer-button-state pointer) (event-modifier-state event))))))
   nil)
 
-;;; --- need to modularize stream implementation into fundamental and extended layers
-;;; so that we can tell when to queue up non-characters into the stream.
-;;; These don't need to set pointer-motion-pending because they synchronize through the io buffer.
+;;;--- need to modularize stream implementation into fundamental and extended
+;;;--- layers so that we can tell when to queue up non-characters into the
+;;;--- stream.  These don't need to set pointer-motion-pending because they
+;;;--- synchronize through the io buffer.
 (defmethod queue-event ((stream input-protocol-mixin) (event pointer-button-press-event))
   (queue-put (stream-input-buffer stream) (copy-event event)))
 
@@ -428,26 +431,31 @@
   ;; don't translate it
   gesture)
 
-(defmethod receive-gesture :around
+(defmethod receive-gesture
 	   ((stream input-protocol-mixin) (gesture character))
-  (cond ((member gesture *accelerator-gestures*)
+  (process-abort-or-accelerator-gesture stream gesture)
+  gesture)
+
+(defmethod receive-gesture
+	   ((stream input-protocol-mixin) (gesture key-press-event))
+  (process-abort-or-accelerator-gesture stream gesture)
+  gesture)
+
+(defun process-abort-or-accelerator-gesture (stream gesture)
+  (cond ((member gesture *accelerator-gestures*
+		 :test #'keyboard-event-matches-gesture-name-p)
 	 (signal 'accelerator-gesture
 		 :event gesture
 		 :numeric-argument (or *accelerator-numeric-argument* 1)))
-	((member gesture *abort-gestures*)
+	((member gesture *abort-gestures*
+		 :test #'keyboard-event-matches-gesture-name-p)
 	 (let ((cursor (slot-value stream 'text-cursor)))
 	   (when (and cursor
 		      (cursor-active cursor))
 	     (write-string "[Abort]" stream)
 	     (force-output stream)))
-	 (error 'abort-gesture :event gesture))
-	(t (call-next-method))))
+	 (error 'abort-gesture :event gesture))))
 
-(defmethod receive-gesture :around
-	   ((stream input-protocol-mixin) (gesture key-press-event))
-  ;;--- What about Abort gestures that aren't characters?
-  (call-next-method))
- 
 ;;; This function is just a convenience for the programmer, defaulting the
 ;;; keyword :STREAM argument to *standard-input*.  The application can call
 ;;; stream-read-gesture directly.
diff --git a/clim/interactive-defs.lisp b/clim/interactive-defs.lisp
index 26781ab36c5a99d362a914ec1374ddaf748545ed..4f3d1dfafc3e4df2a7fb27a797c9220b5967accc 100644
--- a/clim/interactive-defs.lisp
+++ b/clim/interactive-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-defs.lisp,v 1.4 92/02/24 13:07:56 cer Exp $
+;; $fiHeader: interactive-defs.lisp,v 1.5 92/03/04 16:21:57 cer Exp $
 
 (in-package :clim-internals)
 
@@ -14,27 +14,33 @@
 (defvar *pointer-button-press-handler* nil)
 
 
-(defparameter *abort-gestures* '(#+Genera #\Abort
-				 #+Cloe-Runtime #\Escape
-				 #+Lucid #\control-\z
-				 #+Allegro #\c-\z
-				 ;;--- Until the keyboard event processor works...
-				 #+(and Allegro Silica) #\^z))
+(define-gesture-name :abort :keyboard 
+  #+Genera (:abort)
+  #+Cloe-Runtime (:escape)
+  #-(or Genera Cloe-Runtime) (:z :control))
+
+(defparameter *abort-gestures* '(:abort))
 
 (defvar *accelerator-gestures* nil)
 (defvar *accelerator-numeric-argument* nil)
 
+(define-gesture-name :newline :keyboard (:newline))
+(define-gesture-name :return  :keyboard (:return))
+(define-gesture-name :end     :keyboard (:end))
+
+;;--- Kludge until gesture matching working properly.
+;;--- That is, the standard characters should match their own keysyms,
+;;--- such as :A and #\A, :NEWLINE and #\Newline, and so on.
+(define-gesture-name :newline :keyboard (#\Newline))
+
 ;; Activation gestures terminate the entire input line.  They are usually
-;; non-printing characters such as Return or End.
+;; non-printing characters such as #\Newline or #\End.
 (defvar *activation-gestures* nil)
 
-;; Until we have a real per-implementation key table, we don't
-;; know whether the implementation puts #\Newline or #\Return on the
-;; key marked "Return".
-(defvar *standard-activation-gestures* '(#+Genera #\End #\Newline #\Return))
+(defvar *standard-activation-gestures* '(:newline :return :end))
 
 (defmacro with-activation-gestures ((additional-gestures &key override) &body body)
-  (when (characterp additional-gestures)
+  (when (characterp additional-gestures)	;yes, we mean CHARACTERP
     (setq additional-gestures `'(,additional-gestures)))
   `(with-stack-list* (*activation-gestures*
 		       ,additional-gestures
@@ -47,7 +53,8 @@
 (defun activation-gesture-p (gesture)
   (dolist (set *activation-gestures*)
     (when (if (listp set)
-	      (member gesture set)
+	      (member gesture set 
+		      :test #'keyboard-event-matches-gesture-name-p)
 	      (funcall set gesture))
       (return-from activation-gesture-p t))))
 
@@ -66,11 +73,11 @@
 
 
 ;; Delimiter gestures terminate a field in an input line.  They are usually
-;; printing characters such as Space or Tab
+;; printing characters such as #\Space or #\Tab
 (defvar *delimiter-gestures* nil)
 
 (defmacro with-delimiter-gestures ((additional-gestures &key override) &body body)
-  (when (characterp additional-gestures)
+  (when (characterp additional-gestures)	;yes, we mean CHARACTERP
     (setq additional-gestures `'(,additional-gestures)))
   `(with-stack-list* (*delimiter-gestures*
 		       ,additional-gestures
@@ -83,7 +90,8 @@
 (defun delimiter-gesture-p (gesture)
   (dolist (set *delimiter-gestures*)
     (when (if (listp set)
-	      (member gesture set)
+	      (member gesture set 
+		      :test #'keyboard-event-matches-gesture-name-p)
 	      (funcall set gesture))
       (return-from delimiter-gesture-p t))))
 
@@ -105,7 +113,7 @@
 
 (defparameter *quotation-character* #\")
 
-;; READ-TOKEN reads characters until it encounters an activation character,
+;; READ-TOKEN reads characters until it encounters an activation gesture,
 ;; a delimiter character, or something else (like a mouse click).
 (defun read-token (stream &key input-wait-handler pointer-button-press-handler 
 			       click-only timeout)
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index 12be25053d97d43b5b832a603bbb9c3ec5949da9..ba8c58ca08a1c00baa5b94d5d53229dc5c65466d 100644
--- a/clim/interactive-protocol.lisp
+++ b/clim/interactive-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: interactive-protocol.lisp,v 1.4 92/02/24 13:07:57 cer Exp $
+;; $fiHeader: interactive-protocol.lisp,v 1.5 92/03/04 16:21:59 cer Exp $
 
 (in-package :clim-internals)
 
@@ -32,7 +32,7 @@
 (defclass input-editing-stream-mixin
 	  (standard-encapsulating-stream input-editing-stream)
       ;; The fill-pointer of INPUT-BUFFER is the "high water" mark,
-      ;; that is, it points past the last character in the buffer.
+      ;; that is, it points past the last thing in the buffer.
      ((input-buffer :initform (make-array 100 :fill-pointer 0 :adjustable t)
 		    :accessor input-editor-buffer)
       ;; SCAN-POINTER (or INPUT-POSITION) is the point at which
@@ -47,8 +47,8 @@
       ;; input that was already typed in response to some editing command.
       (rescanning-p :accessor rescanning-p :initform nil)
       (rescan-queued :initform nil)
-      ;; A buffer for an activation character to process.  Conceptually,
-      ;; the activation character lives at the end of the input buffer.
+      ;; A buffer for an activation gesture to process.  Conceptually,
+      ;; the activation gesture lives at the end of the input buffer.
       (activation-gesture :initform nil)
       ;; State for prefixed commands, holds a command aarray
       (command-state :initform nil)
@@ -61,7 +61,7 @@
       (last-command-type :initform nil)))
 
 ;; The structure of *INPUT-EDITOR-COMMAND-AARRAY* is an alist that associates
-;; a character with either an input editor command, in the case of a "prefix",
+;; a gesture with either an input editor command, in the case of a "prefix",
 ;; another alist.  It is purposely not adjustable for performance reasons.
 ;; If you overflow, make another bigger one.
 ;; Perhaps the input-editor command table [or alist] should be a conceptual
@@ -110,8 +110,8 @@
 				  (start-index-var end-index-var noise-string-var)
 				  &key normal noise-string)
   #+Genera (declare (zwei:indentation 2 1))
-  (let ((end-var (make-symbol "END"))
-	(next-var (make-symbol "NEXT")))
+  (let ((end-var '#:end)
+	(next-var '#:next))
     `(let ((,start-index-var ,start)
 	   (,end-var (or ,end (length ,input-buffer)))
 	   (,end-index-var 0)
@@ -376,8 +376,8 @@
 
 (defmethod stream-unread-gesture ((istream input-editing-stream-mixin) gesture)
   (with-slots (input-buffer scan-pointer activation-gesture stream) istream
-    (when (characterp gesture)
-      ;; If it's an activation character, store it in the input editor's
+    (when (characterp gesture)		;no general keyboard events here...
+      ;; If it's an activation gesture, store it in the input editor's
       ;; slot rather than sending it back to the underlying stream.
       (when (activation-gesture-p gesture)
 	(when activation-gesture
@@ -506,10 +506,10 @@
 			  (return-from stream-read-gesture
 			    (values new-thing new-type)))
 			 ((activation-gesture-p new-thing)
-			  ;; If we got an activation character, we must first finish
+			  ;; If we got an activation gesture, we must first finish
 			  ;; scanning the input line, moving the insertion-pointer
 			  ;; to the end and finishing rescanning.  Only then can we
-			  ;; return the activation character.
+			  ;; return the activation gesture.
 			  (cond ((= insertion-pointer (fill-pointer input-buffer))
 				 (return-from stream-read-gesture
 				   (values new-thing new-type)))
@@ -904,11 +904,11 @@
 	    (let ((sys:rubout-handler :read))
 	      (funcall continuation stream)))
 	  ;; On the way out, swallow the unread delimiter, since the Genera input
-	  ;; editor discards activation characters on the way out
+	  ;; editor discards activation gestures on the way out.
 	  ;; This breaks some cases of read-preserving-whitespace, which could be
-	  ;; fixed by only discarding activation characters, but there's no way
-	  ;; to tell here if a character was an activation character, so trying to
-	  ;; fix read-preserving-whitespace would only break more important things
+	  ;; fixed by only discarding activation gestures, but there's no way to
+	  ;; tell here if a character was an activation gesture, so trying to fix
+	  ;; read-preserving-whitespace would only break more important things
 	  (stream-read-char-no-hang stream))))))
 
 #+Genera
diff --git a/clim/menus.lisp b/clim/menus.lisp
index 2a040e294a31eeaea08a55c95f02cb5e80e4d163..d9c388d5548b7623bafe1b26f17d2c8bbd30e70d 100644
--- a/clim/menus.lisp
+++ b/clim/menus.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: menus.lisp,v 1.13 92/03/04 16:22:00 cer Exp Locker: cer $
+;; $fiHeader: menus.lisp,v 1.14 92/03/06 09:08:44 cer Exp $
 
 (in-package :clim-internals)
 
@@ -269,6 +269,19 @@
 	  (write-string string stream))
 	(write-string string stream))))
 
+(defclass static-menu ()
+    ((name :initarg :name)
+     (menu-contents :initarg :menu-contents)
+     (default-presentation :initarg :default-presentation)
+     (root-window :initarg :root-window)
+     ;; In case we need to "compile" the menu on the fly
+     (items :initarg :items)
+     (default-item :initarg :default-item)
+     (default-style :initarg :default-style)
+     (printer :initarg :printer)
+     (presentation-type :initarg :presentation-type)
+     (drawer-args :initarg :drawer-args)))
+
 (defgeneric menu-choose (items &rest keys
 			 &key associated-window default-item default-style
 			      label printer presentation-type
@@ -545,19 +558,6 @@
 
 ;;; Static menus
 
-(defclass static-menu ()
-    ((name :initarg :name)
-     (menu-contents :initarg :menu-contents)
-     (default-presentation :initarg :default-presentation)
-     (root-window :initarg :root-window)
-     ;; In case we need to "compile" the menu on the fly
-     (items :initarg :items)
-     (default-item :initarg :default-item)
-     (default-style :initarg :default-style)
-     (printer :initarg :printer)
-     (presentation-type :initarg :presentation-type)
-     (drawer-args :initarg :drawer-args)))
-
 (defmethod print-object ((static-menu static-menu) stream)
   (print-unreadable-object (static-menu stream :type t :identity t)
     (write (slot-value static-menu 'name) :stream stream :escape nil)))
diff --git a/clim/presentations.lisp b/clim/presentations.lisp
index 57d95760ae25c296e5605a5b48689db0b3c71859..6581a13778d7ee68a959ec857af6d2b9a5f10041 100644
--- a/clim/presentations.lisp
+++ b/clim/presentations.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: presentations.lisp,v 1.5 92/02/24 13:08:18 cer Exp $
+;; $fiHeader: presentations.lisp,v 1.6 92/03/04 16:22:07 cer Exp $
 
 (in-package :clim-internals)
 
@@ -339,12 +339,15 @@
 	     ;; a translator from it to the input context.
 	     (dolist (context input-context)
 	       (let ((context-type (input-context-type context)))
-		 (when (presentation-matches-context-type presentation context-type
-							  frame stream x y
-							  :event event
-							  :modifier-state modifier-state)
-		   (return-from find-innermost-applicable-presentation
-		     presentation))))))
+		 (multiple-value-bind (translator any-match-p)
+		     (presentation-matches-context-type presentation context-type
+							frame stream x y
+							:event event
+							:modifier-state modifier-state)
+		   (declare (ignore translator))
+		   (when any-match-p
+		     (return-from find-innermost-applicable-presentation
+		       presentation)))))))
     (declare (dynamic-extent #'mapper #'test))
     (mapper (stream-output-history stream) nil 0 0)))
 
diff --git a/clim/ptypes1.lisp b/clim/ptypes1.lisp
index 40db5b58945e0b25e521e917aa2ef4431d690a83..d71f8a87ac0351e7929e11c3134caf970ae1e8d0 100644
--- a/clim/ptypes1.lisp
+++ b/clim/ptypes1.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: ptypes1.lisp,v 1.6 92/02/28 09:17:51 cer Exp $
+;; $fiHeader: ptypes1.lisp,v 1.7 92/03/04 16:22:09 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1167,13 +1167,13 @@
 		    (unless (or (constantp parameters-massager) (symbolp parameters-massager)
 				(member (second (assoc to-class class-bindings-used))
 					'(0 1 nil)))
-		      (let ((temp (make-symbol (format nil "~A-PARAMETERS" supertype))))
+		      (let ((temp (make-symbol (format nil "~A-~A" supertype 'parameters))))
 			(push (list temp parameters-massager) bindings)
 			(setq parameters-massager temp)))
 		    (unless (or (constantp options-massager) (symbolp options-massager)
 				(member (third (assoc to-class class-bindings-used))
 					'(0 1 nil)))
-		      (let ((temp (make-symbol (format nil "~A-OPTIONS" supertype))))
+		      (let ((temp (make-symbol (format nil "~A-~A" supertype 'options))))
 			(push (list temp options-massager) bindings)
 			(setq options-massager temp))))
 		  (push (list to-class parameters-massager options-massager) alist)))))))
diff --git a/clim/recording-protocol.lisp b/clim/recording-protocol.lisp
index f640c552b1b2aa6b9bdf5f7174feb629f3666c04..79b8eb552934980d5424f8b2c4abdb37ae15cdbf 100644
--- a/clim/recording-protocol.lisp
+++ b/clim/recording-protocol.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: recording-protocol.lisp,v 1.3 92/03/04 16:22:13 cer Exp Locker: cer $
+;; $fiHeader: recording-protocol.lisp,v 1.3 92/03/04 16:22:13 cer Exp $
 
 (in-package :clim-internals)
 
@@ -8,20 +8,7 @@
  Portions copyright (c) 1991, 1992 Franz, Inc.  All rights reserved.
  Portions copyright (c) 1989, 1990 International Lisp Associates."
 
-;; The protocol class for an object that obeys the output record protocol,
-;; that is, can hold output record elements
-(define-protocol-class output-record (bounding-rectangle))
 
-;; The protocol class for output records that are leaves.
-(define-protocol-class displayed-output-record (bounding-rectangle))
-
-;; The protocol class for textual displayed output records.
-(define-protocol-class text-displayed-output-record (displayed-output-record))
-
-;; The protocol class for graphical displayed output records.
-(define-protocol-class graphics-displayed-output-record (displayed-output-record))
-
-
 ;;; A mix-in for classes that can be stored by other output records
 ;;; OUTPUT-RECORD-ELEMENT-MIXIN has slots for
 ;;;     (bounding rectangle, parent, start-position, end-position, contents-ok)
@@ -1074,14 +1061,14 @@
 	     (vp (pane-viewport stream)))
 	(when vp
 	  (update-scrollbars vp))
+	#-ignore
 	(update-region stream 
 		       nminx
 		       nminy
 		       nmaxy
 		       nmaxx)
 	#+ignore
-	(update-region stream (- nmaxx nminx) (- nmaxy nminy))
-	))))
+	(update-region stream (- nmaxx nminx) (- nmaxy nminy))))))
 
 ;;; Defclass of OUTPUT-RECORDING-MIXIN, etc. is in STREAM-CLASS-DEFS
 (defmethod initialize-instance :after ((stream output-recording-mixin) &rest args)
@@ -1105,19 +1092,14 @@
   (with-slots (output-record current-output-record-stack) stream
     (let ((the-output-record (or current-output-record-stack output-record)))
       (add-output-record record the-output-record)
-      ;;--- I suspect that this is totally unncessary since
-      ;;--- adding the record will update the history which will
-      ;;-- do this
-      #+Silica-ignore
+      ;;--- I think we let the history worry about this
+      #+ignore-Silica
       (let ((width (bounding-rectangle-width stream))
 	    (height (bounding-rectangle-height stream)))
 	(declare (type coordinate width height))
 	(with-bounding-rectangle* (rl rt rr rb) the-output-record
 				  (when (or (< rl 0) (< width rr)
 					    (< rt 0) (< height rb))
-				    #+ignore
-				    (update-region stream rl rt rr rb)
-				    #+ignore
 				    (update-region stream (- rr rl) (- rb rt))))))))
 
 (defmethod stream-replay ((stream output-recording-mixin) &optional region)
@@ -1173,36 +1155,6 @@
     (add-character-output-to-text-record record character text-style
 					 width height baseline)))
 
-(defmethod get-text-output-record ((stream output-recording-mixin) style)
-  (let ((default-style (medium-default-text-style stream)))
-    (let ((record (stream-text-output-record stream)))
-      (when record
-	;; If we're changing styles mid-stream, need to convert this
-	;; text record to the more expensive form
-	(when (and (not (eq style default-style))
-		   (not (typep record 'styled-text-output-record)))
-	  (setq record (stylize-text-output-record record default-style stream)))
-	(return-from get-text-output-record record)))
-    (let* ((string (make-array 16 :element-type 'extended-char	;--- 16?
-				  :fill-pointer 0 :adjustable t))
-	   (record (if (not (eq style default-style))
-		       (make-styled-text-output-record (medium-ink stream) string)
-		       (make-standard-text-output-record (medium-ink stream) string))))
-      (setf (stream-text-output-record stream) record)
-      (multiple-value-bind (abs-x abs-y)
-	  (point-position*
-	    (stream-output-history-position stream))
-	(declare (type coordinate abs-x abs-y))
-	(multiple-value-bind (cx cy) (stream-cursor-position* stream)
-	  (declare (type coordinate cx cy))
-	  (output-record-set-start-cursor-position*
-	    record (- cx abs-x) (- cy abs-y))))
-      ;; Moved to STREAM-CLOSE-TEXT-OUTPUT-RECORD, since we don't need this thing
-      ;; in the history until then.  This should save an extra recompute-extent call
-      ;; (one in here, one when the string is added).
-      ;; (stream-add-output-record stream record)
-      record)))
-
 (defmethod stream-close-text-output-record ((stream output-recording-mixin)
 					    &optional wrapped)
   ;; It's faster to access the slot directly instead of going through 
@@ -1242,52 +1194,6 @@
     (unless (eq y old-y)
       (stream-close-text-output-record stream))))
 
-;; Copy just the text from the window to the stream.  If REGION is supplied,
-;; only the text overlapping that region is copied.
-;; This loses information about text styles, presentations, and graphics, and
-;; doesn't deal perfectly with tab characters and changing baselines.
-(defun copy-textual-output-history (window stream &optional region)
-  (let* ((char-width (stream-character-width window #\space))
-	 (line-height (stream-line-height window))
-	 (history (stream-output-history window))
-	 (array (make-array (ceiling (bounding-rectangle-height history) line-height)
-			    :fill-pointer 0 :adjustable t :initial-element nil)))
-    (labels ((collect (record x-offset y-offset)
-	       (multiple-value-bind (start-x start-y)
-		   (output-record-start-cursor-position* record)
-		 (translate-positions x-offset y-offset start-x start-y)
-		 (when (typep record 'standard-text-output-record)
-		   (vector-push-extend (list* start-y start-x (slot-value record 'string))
-				       array))
-		 (map-over-output-records-overlapping-region
-		   #'collect record region 
-		   (- x-offset) (- y-offset) start-x start-y))))
-      (declare (dynamic-extent #'collect))
-      (collect history 0 0))
-    (sort array #'(lambda (r1 r2)
-		    (or (< (first r1) (first r2))
-			(and (= (first r1) (first r2))
-			     (< (second r1) (second r2))))))
-    (let ((current-x 0)
-	  (current-y (first (aref array 0))))
-      (dotimes (i (fill-pointer array))
-	(let* ((item (aref array i))
-	       (y (pop item))
-	       (x (pop item)))
-	  (unless (= y current-y)
-	    (dotimes (j (round (- y current-y) line-height))
-	      #-(or Allegro Minima) (declare (ignore j))
-	      (terpri stream)
-	      (setq current-x 0))
-	    (setq current-y y))
-	  (unless (= x current-x)
-	    (dotimes (j (round (- x current-x) char-width))
-	      #-(or Allegro Minima) (declare (ignore j))
-	      (write-char #\space stream))
-	    (setq current-x x))
-	  (write-string item stream)
-	  (incf current-x (stream-string-width window item)))))))
-
 ;;; This method should cover a multitude of sins.
 #+Silica
 (defmethod repaint-sheet :after ((stream output-recording-mixin) region)
@@ -1304,7 +1210,6 @@
       :ink +background-ink+)
     (stream-replay stream region)))
 
-
 
 ;;; For Silica
 ;;;--- Consider these old methods on a case-by-case basis to see if the
diff --git a/clim/standard-types.lisp b/clim/standard-types.lisp
index bbc2eda49492c90c278cae31d10b7b6bf16fbbdf..034cb738aebcc0e010ea8b4184fe8b5dd74fabd7 100644
--- a/clim/standard-types.lisp
+++ b/clim/standard-types.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: standard-types.lisp,v 1.3 92/02/24 13:08:26 cer Exp $
+;; $fiHeader: standard-types.lisp,v 1.4 92/03/04 16:22:15 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1431,7 +1431,8 @@
 		  (let ((char (read-char stream)))
 		    (vector-push-extend char input-buffer)))
 		 (t
-		  (when (activation-gesture-p char)	;wasn't really an activation char
+		  (when (activation-gesture-p char)
+		    ;; I guess it wasn't really an activation gesture...
 		    (unless (rescanning-p stream)
 		      (replace-input stream (string char))))
 		  (vector-push-extend char input-buffer)
diff --git a/clim/temp-strings.lisp b/clim/temp-strings.lisp
index 382db4fd6ba6daee252ad6007d7eda2dee96466f..afe5dc0ec8ce336ecd704b369c76f0ba13f623e5 100644
--- a/clim/temp-strings.lisp
+++ b/clim/temp-strings.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: temp-strings.lisp,v 1.3 92/01/31 14:58:53 cer Exp $
+;; $fiHeader: temp-strings.lisp,v 1.4 92/02/24 13:08:38 cer Exp $
 
 (in-package :clim-internals)
 
@@ -15,7 +15,7 @@
 (defresource temporary-string
 	     (&key (length 100) (adjustable t))
   :constructor (make-array length
-			   :element-type 'extended-char
+			   :element-type 'character
 			   :fill-pointer 0
 			   :adjustable adjustable)
   :matcher (and (eq adjustable (adjustable-array-p temporary-string))
@@ -39,7 +39,7 @@
 (defmacro evacuate-temporary-string (string-var)
   `(if (temporary-string-p ,string-var)
        (make-array (length ,string-var)
-		   :element-type 'extended-char
+		   :element-type 'character
 		   :fill-pointer (length ,string-var)
 		   :initial-contents ,string-var)
        ,string-var))
@@ -51,8 +51,9 @@
 (progn
 
 (defmacro with-temporary-string ((var &key (length 100) (adjustable t)) &body body)
-  `(sys:with-stack-array (,var ,length :element-type 'extended-char :adjustable ,adjustable
-			  :fill-pointer 0)
+  `(sys:with-stack-array (,var ,length :element-type 'character
+				       :adjustable ,adjustable
+				       :fill-pointer 0)
      ,@body))
 
 (defun temporary-string-p (string)
diff --git a/clim/text-formatting.lisp b/clim/text-formatting.lisp
index 2d2ed00007d1ce6a15946a62d2eb3fba78e26875..e61e6144a695db91c060f613c55cffd01da4f9f0 100644
--- a/clim/text-formatting.lisp
+++ b/clim/text-formatting.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-formatting.lisp,v 1.4 92/02/24 13:08:40 cer Exp $
+;; $fiHeader: text-formatting.lisp,v 1.5 92/03/04 16:22:21 cer Exp $
 
 (in-package :clim-internals)
 
@@ -133,7 +133,7 @@
 
 (defresource filling-stream (stream fill-width break-characters prefix prefix-width)
   :constructor (make-instance 'filling-stream
-			      :buffer (make-array 100 :element-type 'extended-char
+			      :buffer (make-array 100 :element-type 'character
 						      :fill-pointer 0
 						      :adjustable t))
   :matcher 't
diff --git a/clim/text-recording.lisp b/clim/text-recording.lisp
index 7c700a166d074089da5cea5a34844c78d7b9e6ce..67b12a0d68c93f0aff754c876e4da9a8b8f6c5e0 100644
--- a/clim/text-recording.lisp
+++ b/clim/text-recording.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-recording.lisp,v 1.1 92/02/24 13:18:29 cer Exp $
+;; $fiHeader: text-recording.lisp,v 1.2 92/03/04 16:22:22 cer Exp $
 
 (in-package :clim-internals)
 
@@ -394,6 +394,62 @@
 	      (output-record-set-old-start-cursor-position*
 		text old-start-x old-start-y))))))))
 
+(defmethod get-text-output-record ((stream output-recording-mixin) style)
+  (let ((default-style (medium-default-text-style stream)))
+    (let ((record (stream-text-output-record stream)))
+      (when record
+	;; If we're changing styles mid-stream, need to convert this
+	;; text record to the more expensive form
+	(when (and (not (eq style default-style))
+		   (not (typep record 'styled-text-output-record)))
+	  (setq record (stylize-text-output-record record default-style stream)))
+	(return-from get-text-output-record record)))
+    (let* ((string (make-array 16 :element-type 'character	;--- 16?
+				  :fill-pointer 0 :adjustable t))
+	   (record (if (not (eq style default-style))
+		       (make-styled-text-output-record (medium-ink stream) string)
+		       (make-standard-text-output-record (medium-ink stream) string))))
+      (setf (stream-text-output-record stream) record)
+      (multiple-value-bind (abs-x abs-y)
+	  (point-position*
+	    (stream-output-history-position stream))
+	(declare (type coordinate abs-x abs-y))
+	(multiple-value-bind (cx cy) (stream-cursor-position* stream)
+	  (declare (type coordinate cx cy))
+	  (output-record-set-start-cursor-position*
+	    record (- cx abs-x) (- cy abs-y))))
+      ;; Moved to STREAM-CLOSE-TEXT-OUTPUT-RECORD, since we don't need this thing
+      ;; in the history until then.  This should save an extra recompute-extent call
+      ;; (one in here, one when the string is added).
+      ;; (stream-add-output-record stream record)
+      record)))
+
+;; The cost of stylizing an existing record is actually fairly low, and we
+;; don't do it very often, because of the optimization in GET-TEXT-OUTPUT-RECORD
+;; that creates a stylized record as early as possible.
+(defmethod stylize-text-output-record ((record standard-text-output-record) style stream)
+  (with-slots (ink string wrapped-p left top right bottom
+	       start-x start-y end-x end-y) record
+    (let* (#+Silica (port (port stream))
+	   (new-record (make-styled-text-output-record-1
+			 ink string wrapped-p
+			 style (- (text-style-height style #-Silica stream #+Silica port)
+				  (text-style-descent style #-Silica stream #+Silica port)))))
+      (with-slots ((new-left left) (new-top top) (new-right right) (new-bottom bottom)
+		   (new-sx start-x) (new-sy start-y) (new-ex end-x) (new-ey end-y)
+		   (new-wrapped-p wrapped-p)) new-record
+	(setq new-left left
+	      new-top top
+	      new-right right
+	      new-bottom bottom
+	      new-sx start-x
+	      new-sy start-y
+	      new-ex end-x
+	      new-ey end-y))
+      (setf (stream-text-output-record stream) new-record)
+      new-record)))
+
+
 (defun find-text-baseline (record stream)
   ;; This finds the lowest baseline of the text in RECORD, which will be slower than, say,
   ;; the first baseline but more likely to look good with misaligned things.
@@ -421,27 +477,48 @@
       (find-or-recurse record 0))
     baseline)) 
 
-;; The cost of stylizing an existing record is actually fairly low, and we
-;; don't do it very often, because of the optimization in GET-TEXT-OUTPUT-RECORD
-;; that creates a stylized record as early as possible.
-(defmethod stylize-text-output-record ((record standard-text-output-record) style stream)
-  (with-slots (ink string wrapped-p left top right bottom
-	       start-x start-y end-x end-y) record
-    (let* (#+Silica (port (port stream))
-	   (new-record (make-styled-text-output-record-1
-			 ink string wrapped-p
-			 style (- (text-style-height style #-Silica stream #+Silica port)
-				  (text-style-descent style #-Silica stream #+Silica port)))))
-      (with-slots ((new-left left) (new-top top) (new-right right) (new-bottom bottom)
-		   (new-sx start-x) (new-sy start-y) (new-ex end-x) (new-ey end-y)
-		   (new-wrapped-p wrapped-p)) new-record
-	(setq new-left left
-	      new-top top
-	      new-right right
-	      new-bottom bottom
-	      new-sx start-x
-	      new-sy start-y
-	      new-ex end-x
-	      new-ey end-y))
-      (setf (stream-text-output-record stream) new-record)
-      new-record)))
+;; Copy just the text from the window to the stream.  If REGION is supplied,
+;; only the text overlapping that region is copied.
+;; This loses information about text styles, presentations, and graphics, and
+;; doesn't deal perfectly with tab characters and changing baselines.
+(defun copy-textual-output-history (window stream &optional region)
+  (let* ((char-width (stream-character-width window #\space))
+	 (line-height (stream-line-height window))
+	 (history (stream-output-history window))
+	 (array (make-array (ceiling (bounding-rectangle-height history) line-height)
+			    :fill-pointer 0 :adjustable t :initial-element nil)))
+    (labels ((collect (record x-offset y-offset)
+	       (multiple-value-bind (start-x start-y)
+		   (output-record-start-cursor-position* record)
+		 (translate-positions x-offset y-offset start-x start-y)
+		 (when (typep record 'standard-text-output-record)
+		   (vector-push-extend (list* start-y start-x (slot-value record 'string))
+				       array))
+		 (map-over-output-records-overlapping-region
+		   #'collect record region 
+		   (- x-offset) (- y-offset) start-x start-y))))
+      (declare (dynamic-extent #'collect))
+      (collect history 0 0))
+    (sort array #'(lambda (r1 r2)
+		    (or (< (first r1) (first r2))
+			(and (= (first r1) (first r2))
+			     (< (second r1) (second r2))))))
+    (let ((current-x 0)
+	  (current-y (first (aref array 0))))
+      (dotimes (i (fill-pointer array))
+	(let* ((item (aref array i))
+	       (y (pop item))
+	       (x (pop item)))
+	  (unless (= y current-y)
+	    (dotimes (j (round (- y current-y) line-height))
+	      #-(or Allegro Minima) (declare (ignore j))
+	      (terpri stream)
+	      (setq current-x 0))
+	    (setq current-y y))
+	  (unless (= x current-x)
+	    (dotimes (j (round (- x current-x) char-width))
+	      #-(or Allegro Minima) (declare (ignore j))
+	      (write-char #\space stream))
+	    (setq current-x x))
+	  (write-string item stream)
+	  (incf current-x (stream-string-width window item)))))))
diff --git a/clim/tracking-pointer.lisp b/clim/tracking-pointer.lisp
index 9006f4e4f7120b448633255d7ed7231c76aab40e..dbe3054656268ef5e2c96833a138416ff80773e2 100644
--- a/clim/tracking-pointer.lisp
+++ b/clim/tracking-pointer.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: tracking-pointer.lisp,v 1.4 92/02/24 13:08:43 cer Exp $
+;; $fiHeader: tracking-pointer.lisp,v 1.5 92/03/04 16:22:24 cer Exp $
 
 (in-package :clim-internals)
 
@@ -266,7 +266,7 @@
 		    (block process-gesture
 		      (cond ((null gesture)
 			     (return-from input-wait))
-			    ((characterp gesture)
+			    ((keyboard-event-p gesture)
 			     (when keyboard-function
 			       (funcall keyboard-function gesture)
 			       (return-from process-gesture)))
diff --git a/clim/translators.lisp b/clim/translators.lisp
index 41d8ec863490db21eb637b12d5d1636bf09fa19d..6d5be7b830a590ceb6df5b025a67f7f449352348 100644
--- a/clim/translators.lisp
+++ b/clim/translators.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: translators.lisp,v 1.3 92/02/24 13:08:45 cer Exp $
+;; $fiHeader: translators.lisp,v 1.4 92/03/04 16:22:27 cer Exp $
 
 (in-package :clim-internals)
 
@@ -445,12 +445,15 @@
 
 ;; Returns the higherst priority translator that matches the presentation
 ;; in this context, or NIL if there is no matching translator.
+;; Returns a second value of T if there was any translator that matched
+;; on everything except for the gesture, and the menu translator matched
+;; (that is, a second value of T means that the menu translator will apply)
 (defun presentation-matches-context-type (presentation context-type
 					  frame window x y
 					  &key event (modifier-state 0)
 					       #+CLIM-1-compatibility
 					       (shift-mask 0 shift-mask-p))
-  (declare (values translator))
+  (declare (values translator any-match-p))
   #+CLIM-1-compatibility
   (when shift-mask-p
     (setq modifier-state shift-mask))
@@ -467,22 +470,30 @@
 						frame event window x y)))
 	  (when (and by-gesture by-tester)
 	    ;; Matched by both gesture and by the tester, we're done
-	    (return-from presentation-matches-context-type translator))
+	    (return-from presentation-matches-context-type
+	      (values translator t)))
 	  (when by-tester
-	    ;; We matched by the tester, it's OK to try the menu translator.
-	    (setq one-matched t))))
+	    ;; We matched by the tester, it's OK to try the menu translator
+	    ;; unless the translator is not supposed to be in a menu.
+	    (setq one-matched (or one-matched 
+				  (presentation-translator-menu translator))))))
       ;; If EVENT is non-NIL, then we are running on behalf of the user having
       ;; pressed a pointer button, which means that some translator must have
       ;; matched during the test phase, which means that the PRESENTATION-MENU
       ;; translator might be applicable, even though no others were found.
-      (when (and event one-matched
-		 *presentation-menu-translator*
-		 (test-presentation-translator *presentation-menu-translator*
-					       presentation context-type
-					       frame window x y
-					       :event event))
-	(return-from presentation-matches-context-type *presentation-menu-translator*))))
-  nil)
+      (let ((menu-applicable
+	      (and one-matched
+		   *presentation-menu-translator*
+		   (test-presentation-translator *presentation-menu-translator*
+						 presentation context-type
+						 frame window x y
+						 :modifier-state modifier-state
+						 :event event))))
+	   (if (and event menu-applicable)
+	       (values *presentation-menu-translator* t)
+	       (values nil (and one-matched
+				(presentation-translator-matches-event
+				  *presentation-menu-translator* event modifier-state))))))))
 
 ;; When FASTP is T, that means "as soon as you find a matching translator, return
 ;; that translator".  Otherwise, return a list of all applicable translators.
diff --git a/clim/window-stream.lisp b/clim/window-stream.lisp
index 68a6bef94ca4e5ecfb44b5f5f151a30a871e6670..80d8e687fe5f41476662dc2dac7c159230339cdb 100644
--- a/clim/window-stream.lisp
+++ b/clim/window-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: window-stream.lisp,v 1.3 92/01/31 14:59:02 cer Exp $
+;; $fiHeader: window-stream.lisp,v 1.4 92/02/24 13:08:55 cer Exp $
 
 (in-package :clim-internals)
 
@@ -140,7 +140,7 @@
 	  port-type *port-types*)
   (let ((port-type (second (assoc port-type *port-types*))))
     (let ((port (apply #'find-port :port-type port-type creation-args)))
-      (values (find-graft :port port :origin :nw) port))))
+      (values (find-graft :port port :orientation :nw) port))))
 
 #+Silica
 (defun open-window-stream (&rest args &key parent left top right bottom width height
diff --git a/clx/clx-medium.lisp b/clx/clx-medium.lisp
index a7a9e0226d8210f785642e13ca287eab3d1428df..be9743a1913809a583d915389530ff00201fae7f 100644
--- a/clx/clx-medium.lisp
+++ b/clx/clx-medium.lisp
@@ -3,7 +3,7 @@
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved."
-;;; $fiHeader: clx-medium.lisp,v 1.2 92/02/24 13:23:46 cer Exp $
+;;; $fiHeader: clx-medium.lisp,v 1.3 92/03/04 16:20:52 cer Exp $
 
 
 (defclass clx-medium (medium)
@@ -294,8 +294,15 @@
 		(error "Pattern designs other than colors are not supported yet.")))
 	    (let* ((design-pixels (make-array (length designs)))
 		   (depth (xlib:screen-root-depth screen))
-		   (image-data (make-array (list height width)
-					   :element-type `(unsigned-byte ,depth))))
+		   (image-data 
+		     (make-array (list height width)
+				 :element-type
+				   (cond ((= depth 1) 'xlib::pixarray-1-element-type)
+					 ((<= depth 4) 'xlib::pixarray-4-element-type)
+					 ((<= depth 8) 'xlib::pixarray-8-element-type)
+					 ((<= depth 16) 'xlib::pixarray-16-element-type)
+					 ((<= depth 24) 'xlib::pixarray-24-element-type)
+					 (t 'xlib::pixarray-32-element-type)))))
 	      (declare #+Genera (sys:array-register design-pixels)
 		       (simple-vector design-pixels))
 	      ;; Cache the decoded designs from the pattern
@@ -321,7 +328,6 @@
 		(setf (xlib:gcontext-tile gc)
 		      (let ((image
 			      (xlib:create-image :depth depth
-						 :bits-per-pixel depth
 						 :data image-data
 						 :width width :height height))
 			    (pixmap
@@ -423,9 +429,6 @@
     (convert-to-device-coordinates transform x y)
     (let ((thickness (line-style-thickness line-style))
 	  (gc (clx-decode-ink ink medium)))
-      (ecase (line-style-unit line-style)
-	((:normal :point)
-	 (setf thickness (* thickness points-to-pixels))))
       (if (< thickness 2)
 	  (xlib:draw-point drawable gc x y)
 	  (let ((thickness (round thickness)))
@@ -440,8 +443,8 @@
       x1 y1 x2 y2)
     (xlib:draw-line drawable
 		    (clx-adjust-ink (clx-decode-ink ink medium) medium line-style
-				    (min start-x end-x) (min start-y end-y))
-		    start-x start-y end-x end-y)))
+				    (min x1 x2) (min y1 y2))
+		    x1 y1 x2 y2)))
 
 (defmethod port-draw-rectangle* ((port clx-port) sheet medium
 				 left top right bottom filled)
@@ -454,7 +457,7 @@
     (xlib:draw-rectangle drawable 
 			 (clx-adjust-ink (clx-decode-ink ink medium) medium line-style
 					 left top)
-			 left top (- right left) (- bottom top) (null line-style))))
+			 left top (- right left) (- bottom top) filled)))
 
 (defmethod port-draw-polygon* ((port clx-port) sheet medium points closed filled)
   (let ((transform (sheet-device-transformation sheet))
@@ -465,7 +468,7 @@
 	  (miny most-positive-fixnum)
 	  (points (copy-list points)))
       (declare (fixnum minx miny))
-      (do* ((points points (cddr points))a)
+      (do* ((points points (cddr points)))
 	   ((null points))
 	(let ((x (first points))
 	      (y (second points)))
@@ -479,7 +482,7 @@
       (xlib:draw-lines drawable 
 		       (clx-adjust-ink (clx-decode-ink ink medium) medium line-style
 				       minx miny)
-		       points :fill-p (null line-style)))))
+		       points :fill-p filled))))
 
 (defmethod port-draw-ellipse* ((port clx-port) sheet medium
 			       center-x center-y
@@ -534,7 +537,7 @@
 		       (- center-x x-radius) (- center-y y-radius)
 		       (* x-radius 2) (* y-radius 2)
 		       ;; CLX measures the second angle relative to the first
-		       start-angle angle-size (null line-style))))))
+		       start-angle angle-size filled)))))
 
 (defmethod port-draw-string* ((port clx-port) sheet medium
 			      string x y start end align-x align-y)
@@ -547,7 +550,7 @@
       (setq end (length string)))
     (let* ((font (if text-style
 		     (text-style-mapping port text-style)
-		     (clx-get-default-font medium)))
+		     (clx-get-default-font port medium)))
 	   (ascent (xlib:font-ascent font))
 	   (descent (xlib:font-descent font))
 	   (height (+ ascent descent))
@@ -568,7 +571,7 @@
     (convert-to-device-coordinates transform x y)
     (let* ((font (if text-style
 		     (text-style-mapping port text-style)
-		     (clx-get-default-font medium)))
+		     (clx-get-default-font port medium)))
 	   (ascent (xlib:font-ascent font))
 	   (descent (xlib:font-descent font))
 	   (height (+ ascent descent))
@@ -659,7 +662,8 @@
       (with-sheet-medium (medium from-sheet)
 	(let ((width (- from-right from-left))
 	      (height (- from-bottom from-top))
-	      (drawable (slot-value medium 'drawable)))
+	      (drawable (slot-value medium 'drawable))
+	      (copy-gc (slot-value medium 'copy-gcontext)))
 	  (xlib:copy-area drawable copy-gc
 			  from-left from-top width height drawable
 			  to-left to-top))))))
diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp
index 58443b9581db00ae1ad9194c00cb15bb32c643e8..e72dfe23122585129e6d1455d4d765911f6d1667 100644
--- a/clx/clx-port.lisp
+++ b/clx/clx-port.lisp
@@ -3,7 +3,7 @@
 (in-package :clx-clim)
 
 "Copyright (c) 1992 Symbolics, Inc.  All rights reserved.
-;;; $fiHeader: clx-port.lisp,v 1.2 92/02/24 13:23:53 cer Exp $
+;;; $fiHeader: clx-port.lisp,v 1.3 92/03/04 16:20:55 cer Exp $
  Portions copyright (c) 1991, 1992 International Lisp Associates."
 
 
@@ -171,10 +171,10 @@
 
 ;;; Text styles for CLX windows
 
-(defvar *clx-font-families* 
-	'((:fix "*-courier-*")
-	  (:sans-serif "*-helvetica-*")
-	  (:serif "*-charter-*" "*-new century schoolbook-*" "*-times-*")))
+(defvar *clx-font-families*
+	'((:fix "-*-courier-*")
+	  (:sans-serif "-*-helvetica-*")
+	  (:serif "-*-charter-*" "-*-new century schoolbook-*" "-*-times-*")))
 
 (defvar *clx-fallback-font* "8x13"
   "When non NIL and nothing better exists use this as the fallback font")
diff --git a/demo/listener.lisp b/demo/listener.lisp
index b5335316c582f79dd66b1f6cb3cd271bd72e9838..3a83bf5d297ea5128b5cf8f222575d67d73dde1b 100644
--- a/demo/listener.lisp
+++ b/demo/listener.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-DEMO; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: listener.lisp,v 1.5 92/03/04 16:23:00 cer Exp Locker: cer $
+;; $fiHeader: listener.lisp,v 1.6 92/03/06 09:08:54 cer Exp $
 
 (in-package :clim-demo)
 
@@ -90,11 +90,12 @@
 				     &key keystrokes listener-depth (prompt "=> "))
   (catch-abort-gestures ("Return to ~A command level ~D"
 			 (frame-pretty-name frame) listener-depth)
-    ;; Eat any abort characters that might be hanging around.
+    ;; Eat any abort gestures that might be hanging around.
     ;; We need to do this because COMMAND-OR-FORM is wierd.
-    (let* ((abort-chars *abort-gestures*)
+    (let* ((abort-gestures *abort-gestures*)
 	   (*abort-gestures* nil))
-      (when (member (stream-read-gesture *standard-input* :timeout 0 :peek-p t) abort-chars)
+      ;;--- What test does this need?
+      (when (member (stream-read-gesture *standard-input* :timeout 0 :peek-p t) abort-gestures)
 	(stream-read-gesture *standard-input* :timeout 0)))
     (fresh-line *standard-input*)
     (multiple-value-bind (command-or-form type numeric-arg)
@@ -118,7 +119,7 @@
       (when (eq type :keystroke)
 	(let ((command (lookup-keystroke-command-item command-or-form command-table 
 						      :numeric-argument numeric-arg)))
-	  (unless (characterp command)
+	  (unless (clim-internals::keyboard-gesture-p command)
 	    (when (partial-command-p command)
 	      (setq command (funcall *partial-command-parser*
 				     command command-table *standard-input* nil
@@ -291,7 +292,8 @@
   (window-clear (frame-standard-output *application-frame*)))
 
 #+Genera
-(add-keystroke-to-command-table 'lisp-listener #\c-m-L :command 'com-clear-output-history)
+(add-keystroke-to-command-table 
+  'lisp-listener '(:l :control :meta) :command 'com-clear-output-history)
 
 #-Minima (progn
 
@@ -519,8 +521,7 @@
 	 (ll (cdr entry)))
     (when (or (null ll) reinit)
       (setq ll (make-application-frame 'lisp-listener
-				       :parent root
-				       :width 500 :height 500))
+				       :width 600 :height 500))
       (if entry
 	  (setf (cdr entry) ll)
 	  (push (cons root ll) *listeners*)))
diff --git a/misc/compile-xm.lisp b/misc/compile-xm.lisp
index 915419bdb48b81c07b0d91c99beedb1dfe43d316..1eba2ebd5f5f4077d03d54b87ef98b1d699c1e80 100644
--- a/misc/compile-xm.lisp
+++ b/misc/compile-xm.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: compile-xm.lisp,v 1.4 92/03/04 16:23:11 cer Exp Locker: cer $
+;; $fiHeader: compile-xm.lisp,v 1.5 92/03/09 17:42:03 cer Exp Locker: cer $
 
 (in-package :user)
 
diff --git a/pre-silica/cloe-implementation.lisp b/pre-silica/cloe-implementation.lisp
index bad5cea51e158ba245d40bbd6b5469a75c8d7c84..e6967b469bf3199fdc83b053c247a3d5035f1068 100644
--- a/pre-silica/cloe-implementation.lisp
+++ b/pre-silica/cloe-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cloe-implementation.lisp,v 1.1 92/01/31 14:27:40 cer Exp $
+;; $fiHeader: cloe-implementation.lisp,v 1.2 92/02/24 13:07:01 cer Exp $
 
 (in-package :clim-internals)
 
@@ -45,6 +45,31 @@
   text-color
   background-color)
 
+;;;
+
+(eval-when (compile load eval)
+	   
+;; Define the new key chars for Cloe CLIM.  Regular Cloe defines 0-127, we define
+;; 128-139 as the F-keys (F1 thru F12), 140 for c-sh-A, and 141 as c-sh-V
+(sys::define-character-name "F1" 128)
+(sys::define-character-name "F2" 129)
+(sys::define-character-name "F3" 130)
+(sys::define-character-name "F4" 131)
+(sys::define-character-name "F5" 132)
+(sys::define-character-name "F6" 133)
+(sys::define-character-name "F7" 134)
+(sys::define-character-name "F8" 135)
+(sys::define-character-name "F9" 136)
+;; Note windows traps F10 as alt-space. Why?
+(sys::define-character-name "F10" 137)
+(sys::define-character-name "F11" 138)
+(sys::define-character-name "F12" 139)
+(sys::define-character-name "Arglist" 140)
+(sys::define-character-name "ShowValue" 141)
+
+)	;eval-when
+
+
 ;;;
 
 (defun initialize-dc ()
diff --git a/pre-silica/clx-implementation.lisp b/pre-silica/clx-implementation.lisp
index e6f3e48806e5289a07bf79843b99f7065f1f0899..658bbb756e6eb009db78efdb8827839b563514b8 100644
--- a/pre-silica/clx-implementation.lisp
+++ b/pre-silica/clx-implementation.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clx-implementation.lisp,v 1.2 92/02/24 13:07:02 cer Exp $
+;; $fiHeader: clx-implementation.lisp,v 1.3 92/03/04 16:21:10 cer Exp $
 
 (in-package :clim-internals)
 
@@ -15,9 +15,10 @@
 
 (defvar *window-manager-border-size* 2)
 
-(defvar *clx-font-families* '((:fix "*-courier-*")
-			      (:sans-serif "*-helvetica-*")
-			      (:serif "*-charter-*" "*-new century schoolbook-*" "*-times-*")))
+(defvar *clx-font-families*
+	'((:fix "-*-courier-*")
+	  (:sans-serif "-*-helvetica-*")
+	  (:serif "-*-charter-*" "-*-new century schoolbook-*" "-*-times-*")))
 
 (defvar *clx-white-color* (xlib:make-color :red 1 :blue 1 :green 1))
 (defvar *clx-black-color* (xlib:make-color :red 0 :blue 0 :green 0))
@@ -506,8 +507,8 @@
 		 ;; the event is about any other windows (e.g. intermediaries inserted
 		 ;; by the window manger), then it's talking about something beyond
 		 ;; our sphere of influence and we ignore it.
-		 (cond ((eq parent (clx-stream-window (window-parent ws)))
-			(with-slots (left top right bottom) ws
+		 (with-slots (left top right bottom) ws
+		   (cond ((eq parent (clx-stream-window (window-parent ws)))
 			  (let ((border-width
 				  ;;--- This is technically more correct, but it doesn't
 				  ;;--- account for the title bar, and generally messes
@@ -518,9 +519,19 @@
 			      (window-note-size-or-position-change
 				ws (- x border-width) (- y border-width)
 				(+ x (- right left) border-width)
-				(+ y (- bottom top) border-width)))))
-			(setf (slot-value ws 'reparented-p) nil))
-		       (t (setf (slot-value ws 'reparented-p) t)))
+				(+ y (- bottom top) border-width))))
+			  (setf (slot-value ws 'reparented-p) nil))
+			 (t			  
+			  (multiple-value-setq (x y)
+			    (xlib:translate-coordinates
+			      window 0 0 (clx-stream-window (window-parent ws))))
+			  (let ((border-width 0))
+			    (window-note-size-or-position-change
+			      ws
+			      (- x border-width) (- y border-width)
+			      (+ x (- right left) border-width)
+			      (+ y (- bottom top) border-width)))
+			  (setf (slot-value ws 'reparented-p) t))))
 		 t)
 		((:configure-notify) (window width height x y send-event-p border-width)
 		 (setq ws (getf (xlib:window-plist window) 'stream))	;test form
@@ -1520,8 +1531,15 @@
 		(error "Pattern designs other than colors are not supported yet.")))
 	    (let* ((design-pixels (make-array (length designs)))
 		   (depth (xlib:screen-root-depth screen))
-		   (image-data (make-array (list height width)
-					   :element-type `(unsigned-byte ,depth))))
+		   (image-data 
+		     (make-array (list height width)
+				 :element-type
+				   (cond ((= depth 1) 'xlib::pixarray-1-element-type)
+					 ((<= depth 4) 'xlib::pixarray-4-element-type)
+					 ((<= depth 8) 'xlib::pixarray-8-element-type)
+					 ((<= depth 16) 'xlib::pixarray-16-element-type)
+					 ((<= depth 24) 'xlib::pixarray-24-element-type)
+					 (t 'xlib::pixarray-32-element-type)))))
 	      (declare #+Genera (sys:array-register design-pixels)
 		       (simple-vector design-pixels))
 	      ;; Cache the decoded designs from the pattern
@@ -1547,7 +1565,6 @@
 		(setf (xlib:gcontext-tile gc)
 		      (let ((image
 			      (xlib:create-image :depth depth
-						 :bits-per-pixel depth
 						 :data image-data
 						 :width width :height height))
 			    (pixmap
diff --git a/pre-silica/default-application.lisp b/pre-silica/default-application.lisp
index 525ca3c92b71d213b1b056fdd4172a8b57517e0c..1d230f346b20bb557b438729dba0cf2f16eeb453 100644
--- a/pre-silica/default-application.lisp
+++ b/pre-silica/default-application.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: default-application.lisp,v 1.2 92/02/24 13:07:17 cer Exp $
+;; $fiHeader: default-application.lisp,v 1.3 92/03/04 16:21:23 cer Exp $
 
 (in-package :clim-internals)
 
@@ -36,7 +36,8 @@
     (throw-highlighted-presentation 
       (or (and (output-recording-stream-p window)
 	       (frame-find-innermost-applicable-presentation
-		 frame input-context window x y))
+		 frame input-context window x y
+		 :event button-press-event))
 	  *null-presentation*)
       input-context
       button-press-event)))
@@ -45,8 +46,11 @@
 ;;; satisfying the input context specified by TYPE.  Everything that looks for a
 ;;; presentation goes through this so that applications can specialize it.
 (defmethod frame-find-innermost-applicable-presentation
-	   ((frame standard-application-frame) input-context stream x y)
-  (find-innermost-applicable-presentation input-context stream x y))
+	   ((frame standard-application-frame) input-context stream x y &key event)
+  (find-innermost-applicable-presentation
+    input-context stream x y
+    :frame frame
+    :modifier-state (window-modifier-state stream) :event event))
 
 ;;; The contract of this is to replay the contents of STREAM within the region.
 (defmethod frame-replay ((frame standard-application-frame) stream &optional region)
@@ -106,7 +110,9 @@
        (frame presentation input-context window x y stream)
   (let ((modifier-state (window-modifier-state window)))
     (declare (fixnum modifier-state))
-    (multiple-value-bind (left left-context middle middle-context right right-context)
+    (multiple-value-bind (left   left-presentation   left-context
+			  middle middle-presentation middle-context
+			  right  right-presentation  right-context)
 	(find-applicable-translators-for-documentation presentation input-context
 						       frame window x y modifier-state)
       (let* ((*print-length* 3)
@@ -115,7 +121,8 @@
 	     (*print-array* nil)
 	     (*print-readably* nil)
 	     (*print-pretty* nil))
-	(flet ((document-translator (translator context-type button-name separator)
+	(flet ((document-translator (translator presentation context-type
+				     button-name separator)
 		 ;; Assumes 5 modifier keys and the reverse ordering of *MODIFIER-KEYS*
 		 (let ((bit #o20)
 		       (shift-name '("h-" "s-" "m-" "c-" "sh-")))
@@ -143,17 +150,18 @@
 				      (setq middle nil)
 				      "L,M: ")
 				     (t "L: "))))
-	      (document-translator left left-context button-name
-				   (if (or middle right) "; " "."))))
+	      (document-translator left left-presentation left-context
+				   button-name (if (or middle right) "; " "."))))
 	  (when middle
 	    (let ((button-name (cond ((eq middle right)
 				      (setq right nil)
 				      "M,R: ")
 				     (t "M: "))))
-	      (document-translator middle middle-context button-name
-				   (if right "; " "."))))
+	      (document-translator middle middle-presentation middle-context
+				   button-name (if right "; " "."))))
 	  (when right
-	    (document-translator right right-context "R: " "."))
+	    (document-translator right right-presentation right-context
+				 "R: " "."))
 	  ;; Return non-NIL if any pointer documentation was produced
 	  (or left middle right))))))
 
@@ -161,12 +169,14 @@
 (defun find-applicable-translators-for-documentation
        (presentation input-context frame window x y modifier-state)
   ;; Assume a maximum of three pointer buttons
-  (let ((left nil)   (left-context nil)
-	(middle nil) (middle-context nil)
-	(right nil)  (right-context nil))
-    (macrolet ((match (translator context-type button)
-		 (let ((button-translator (intern (symbol-name button)))
-		       (button-context (fintern "~A-~A" (symbol-name button) 'context)))
+  (let ((left nil)   (left-presentation nil)   (left-context nil)
+	(middle nil) (middle-presentation nil) (middle-context nil)
+	(right nil)  (right-presentation nil)  (right-context nil))
+    (macrolet ((match (translator presentation context-type button)
+		 (let* ((symbol (symbol-name button))
+			(button-translator (intern symbol))
+			(button-presentation (fintern "~A-~A" symbol 'presentation))
+			(button-context (fintern "~A-~A" symbol 'context)))
 		   `(when (and (or (null ,button-translator)
 				   (> (presentation-translator-priority ,translator)
 				      (presentation-translator-priority ,button-translator)))
@@ -174,6 +184,7 @@
 				 (button-index ,button) modifier-state
 				 (presentation-translator-gesture-name ,translator)))
 		      (setq ,button-translator ,translator
+			    ,button-presentation ,presentation
 			    ,button-context ,context-type)))))
       (do ((presentation presentation
 			 (parent-presentation-with-shared-box presentation window)))
@@ -189,21 +200,21 @@
 							presentation context-type
 							frame window x y
 							:modifier-state modifier-state)
-		      (match translator context-type :left)
-		      (match translator context-type :middle)
-		      (match translator context-type :right)))))
+		      (match translator presentation context-type :left)
+		      (match translator presentation context-type :middle)
+		      (match translator presentation context-type :right)))))
 	      (when (and (or left middle right)
 			 *presentation-menu-translator*
 			 (test-presentation-translator *presentation-menu-translator*
 						       presentation context-type
 						       frame window x y
 						       :modifier-state modifier-state))
-		(match *presentation-menu-translator* context-type :left)
-		(match *presentation-menu-translator* context-type :middle)
-		(match *presentation-menu-translator* context-type :right)))))))
-    (values left   left-context
-	    middle middle-context
-	    right  right-context)))
+		(match *presentation-menu-translator* presentation context-type :left)
+		(match *presentation-menu-translator* presentation context-type :middle)
+		(match *presentation-menu-translator* presentation context-type :right)))))))
+    (values left   left-presentation   left-context
+	    middle middle-presentation middle-context
+	    right  right-presentation  right-context)))
 
 #+Genera
 (defmethod mouse-documentation-window ((window window-stream)) nil)
diff --git a/pre-silica/define-application.lisp b/pre-silica/define-application.lisp
index f01499015c992dc34665aeb5661fb373f03dcb8e..37d37cd75510a76574c99c878657cdb64ec3f39e 100644
--- a/pre-silica/define-application.lisp
+++ b/pre-silica/define-application.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: define-application.lisp,v 1.2 92/02/24 13:07:19 cer Exp $
+;; $fiHeader: define-application.lisp,v 1.3 92/03/04 16:21:24 cer Exp $
 
 (in-package :clim-internals)
 
@@ -1181,9 +1181,12 @@
 (defun redisplay-frame-pane-1 (frame pane description &optional force-p)
   (let* ((options (pane-descriptor-options description))
 	 (display-function (getf options :display-function))
-	 (incremental-redisplay (getf options :incremental-redisplay))
+	 (ir (getf options :incremental-redisplay))
+	 (redisplay-p (if (listp ir) (first ir) ir))
+	 (check-overlapping (or (atom ir)	;default is T
+				(getf (rest ir) :check-overlapping t)))
 	 (redisplay-record
-	   (and incremental-redisplay
+	   (and redisplay-p
 		(let ((history (stream-output-history pane)))
 		  (when history
 		    #+compulsive-redisplay
@@ -1211,13 +1214,14 @@
 		 (return
 		   (cond (display-function
 			  ;; If there's a display function, call it to generate new contents.
-			  (cond (incremental-redisplay
+			  (cond (redisplay-p
 				 (cond ((or (null redisplay-record) force-p)
 					(when force-p
 					  (window-clear pane))
 					(call-redisplay-function
 					  display-function frame pane))
-				       (t (redisplay redisplay-record pane))))
+				       (t (redisplay redisplay-record pane
+						     :check-overlapping check-overlapping))))
 				((or force-p
 				     (getf options :display-after-commands t))
 				 (unless (and (not force-p)
diff --git a/silica/classes.lisp b/silica/classes.lisp
index fe7c4981f89c035cbf9eab28f57710e65cf04c68..c6dd7ef3b317f9822df21d70b617b938e61e19cf 100644
--- a/silica/classes.lisp
+++ b/silica/classes.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: classes.lisp,v 1.5 92/02/26 10:23:16 cer Exp $
+;; $fiHeader: classes.lisp,v 1.6 92/03/04 16:19:23 cer Exp $
 
 (in-package :silica)
 
@@ -120,12 +120,14 @@
 
 (define-event-class keyboard-event (device-event)
   ((key-name :reader keyboard-event-key-name :initarg :key-name)
+   ;; This is NIL for keyboard events that don't correspond to
+   ;; characters in the standard CL character set
    (character :reader keyboard-event-character :initarg :character)))
 
-
 (define-event-class key-press-event (keyboard-event) ())
 (define-event-class key-release-event (keyboard-event) ())
 
+
 (define-event-class pointer-event (device-event)
   ((x :reader pointer-event-x :initarg :x)
    (y :reader pointer-event-y :initarg :y)
@@ -153,6 +155,7 @@
 (define-event-class pointer-exit-event (pointer-motion-or-boundary-event) ())
 (define-event-class pointer-enter-event (pointer-motion-or-boundary-event) ())
 
+
 (define-event-class window-event (event)
   ((region :reader window-event-region :initarg :region)
    (native-region :reader window-event-native-region :initarg :native-region)
@@ -163,10 +166,41 @@
 (define-event-class window-configuration-event (window-event) ())
 (define-event-class window-repaint-event (window-event) ())
 
+
 (define-event-class window-manager-event (event) 
   ((sheet :reader event-sheet :initarg :sheet)))
 (define-event-class window-manager-delete-event (window-manager-event) ())
 
+
 (define-event-class timer-event (event) ())
 
 
+;;; Values used in event objects
+
+(defconstant +pointer-left-button+   (ash 1 8))
+(defconstant +pointer-middle-button+ (ash 1 9))
+(defconstant +pointer-right-button+  (ash 1 10))
+
+;; The order of this must match the values above
+(defconstant *pointer-buttons* '#(:left :middle :right))
+
+(deftype button-name () '(member :left :middle :right))
+
+(defconstant +shift-key+   (ash 1 0))
+(defconstant +control-key+ (ash 1 1))
+(defconstant +meta-key+    (ash 1 2))
+(defconstant +super-key+   (ash 1 3))
+(defconstant +hyper-key+   (ash 1 4))
+
+;; The order of this must match the values above
+(defconstant *modifier-keys* '#(:shift :control :meta :super :hyper))
+
+(deftype shift-keysym   () '(member :left-shift :right-shift))
+(deftype control-keysym () '(member :left-control :right-control))
+(deftype meta-keysym    () '(member :left-meta :right-meta))
+(deftype super-keysym   () '(member :left-super :right-super))
+(deftype hyper-keysym   () '(member :left-hyper :right-hyper))
+(deftype lock-keysym    () '(member :caps-lock :shift-lock :mode-lock))
+
+(deftype modifier-keysym ()
+  '(or shift-keysym control-keysym meta-keysym super-keysym hyper-keysym lock-keysym))
diff --git a/silica/db-border.lisp b/silica/db-border.lisp
index 036ff188bfaf34b2d2859c274c53b7d8a63cc61e..e864a2fad69507ede3a91717656f023d1137bccb 100644
--- a/silica/db-border.lisp
+++ b/silica/db-border.lisp
@@ -5,17 +5,12 @@
 
 (in-package :silica)
 
-;;; $fiHeader: db-border.lisp,v 1.2 92/02/24 13:16:24 cer Exp Locker: cer $
+;; $fiHeader: db-border.lisp,v 1.3 92/03/04 16:19:25 cer Exp $
 
 ;;; Border Panes
 (defclass border-pane (layout-pane)
     ((thickness :initform 1 :initarg :thickness)))
 
-(defmacro bordering (options &body contents)
-  `(realize-pane 'border-pane
-		 :contents ,@contents
-		 ,@options))
-
 (defmethod initialize-instance :after ((pane border-pane) &key contents)
   (sheet-adopt-child pane contents))
 
@@ -35,6 +30,11 @@
 			    (- width (* 2 thickness))
 			    (- height (* 2 thickness)))))
   
+(defmacro bordering (options &body contents)
+  `(realize-pane 'border-pane
+		 :contents ,@contents
+		 ,@options))
+
 
 (defclass outlined-pane (border-pane)
   ((background :initform +black+ :accessor pane-background)))
diff --git a/silica/db-button.lisp b/silica/db-button.lisp
index 956696a0d6d845e63baf4ea03624cbb548430ad9..2ce2f856513366434ba91ffa9ece3026c12f13b1 100644
--- a/silica/db-button.lisp
+++ b/silica/db-button.lisp
@@ -3,8 +3,6 @@
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;;; $fiHeader$
-
 (in-package :silica)
 
 
diff --git a/silica/db-slider.lisp b/silica/db-slider.lisp
index 881229472a2a7304e8616687e07d65b1fd562712..e9417a18ab467c66c8f874b44d9d7519c312095f 100644
--- a/silica/db-slider.lisp
+++ b/silica/db-slider.lisp
@@ -3,8 +3,6 @@
 "Copyright (c) 1990, 1991 International Lisp Associates.
  Portions copyright (c) 1991, 1992 by Symbolics, Inc.  All rights reserved."
 
-;;; $fiHeader$
-
 (in-package :silica)
 
 
diff --git a/silica/event.lisp b/silica/event.lisp
index 0018929330d1d64b5e758d3c7bab98241cc8deab..9a4acf62bc51337fcfeeec251545c86a09517f3f 100644
--- a/silica/event.lisp
+++ b/silica/event.lisp
@@ -19,129 +19,11 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: event.lisp,v 1.6 92/02/26 10:23:17 cer Exp $
+;; $fiHeader: event.lisp,v 1.7 92/03/04 16:19:36 cer Exp $
 
 (in-package :silica)
 
 
-;;; Event stuff
-
-;;--- How important are these actual values?
-;;--- Just flush them?
-(deftype button-name ()
-  '(member :left :middle :right))
-					; Button and Modifier State Masks
-(deftype shift-keysym ()
-  '(member :left-shift :right-shift))
-
-(deftype control-keysym ()
-  '(member :left-control :right-control))
-
-(deftype meta-keysym ()
-  '(member :left-meta :right-meta))
-
-(deftype super-keysym ()
-  '(member :left-super :right-super))
-
-(deftype hyper-keysym ()
-  '(member :left-hyper :right-hyper))
-
-(deftype lock-keysym ()
-  '(member :caps-lock :shift-lock :mode-lock))
-
-
-(deftype modifier-keysym ()
-  '(or shift-keysym control-keysym meta-keysym super-keysym
-    hyper-keysym lock-keysym))
-
-(defun-inline state->modifier-state (state)
-  ;; Get just the modifier-state part of state
-  (logand state #xFF))
-
-(defconstant +pointer-left-button+   (ash 1 8))
-(defconstant +pointer-middle-button+ (ash 1 9))
-(defconstant +pointer-right-button+  (ash 1 10))
-
-(defconstant +shift-key+   (ash 1 0))
-(defconstant +control-key+ (ash 1 2))
-(defconstant +meta-key+    (ash 1 3))
-(defconstant +super-key+   (ash 1 4))
-(defconstant +hyper-key+   (ash 1 5))
-
-(defmacro keyboard-modifier-state-match-p (button modifier-state &body clauses)
-  (let ((b (gensym))
-	(m (gensym)))
-    `(let ((,b ,button)
-	   (,m ,modifier-state))
-       (declare (ignore-if-unused ,b ,m))
-       ,(compile-kbms-clauses
-	  b m `(and ,@clauses)))))
-
-(defun compile-kbms-clauses (button modifier clause)
-  (if (atom clause)
-      (ecase clause
-	(:left `(= ,button +pointer-left-button+))
-	(:right `(= ,button +pointer-right-button+))
-	(:middle `(= ,button +pointer-middle-button+))
-	(:shift `(logtest ,modifier +shift-key+))
-	(:control `(logtest ,modifier +control-key+))
-	(:meta `(logtest ,modifier +meta-key+))
-	(:super `(logtest ,modifier +super-key+))
-	(:hyper `(logtest ,modifier +hyper-key+)))
-      (ecase (car clause)
-	(and `(and ,@(mapcar #'(lambda (c)
-				 (compile-kbms-clauses button modifier c))
-			     (cdr clause))))
-	(or `(or ,@(mapcar #'(lambda (c)
-			       (compile-kbms-clauses button modifier c))
-			   (cdr clause))))
-	(not `(not ,(compile-kbms-clauses button modifier (second clause)))))))
-
-
-(defun parse-gesture-spec (gesture-spec)
-  (if (or (atom gesture-spec) 
-	  (and (cdr gesture-spec)
-	       (atom (cdr gesture-spec))))
-      gesture-spec
-      (let ((button (find-if-not #'shift-code gesture-spec)))
-	(unless button
-	  (cerror "Assume :LEFT and go on."
-		  "Gesture spec missing a keysym: ~S" gesture-spec)
-	  (setq button ':left))
-	(cons button (apply #'make-modifier-state (delete button gesture-spec))))))
-
-(defvar symbolic->mask `(:left    ,+pointer-left-button+
-			 :right   ,+pointer-right-button+
-			 :middle  ,+pointer-middle-button+
-			 :hyper   ,+hyper-key+
-			 :super   ,+super-key+
-			 :meta    ,+meta-key+
-			 :control ,+control-key+
-			 :shift   ,+shift-key+))
-
-(defun button-name->mask (button)
-  (or (getf symbolic->mask button)
-      (error "Cannot find button name: ~S" button)))
-
-(defvar *shifts* `(:hyper ,+hyper-key+
-		   :super ,+super-key+
-		   :meta  ,+meta-key+
-		   :control ,+control-key+
-		   :shift ,+shift-key+))
-
-(defun modifier->mask (m)
-  (or (getf *shifts* m)
-      (error "cannot find modifier: ~S" m)))
-
-(defun modifiers->mask (modifiers)
-  (let ((n 0))
-    (dolist (m modifiers n)
-      (setq n (logior n (modifier->mask m))))))
-
-
-
-;;; 
-
 (defgeneric process-next-event (port &key wait-function timeout))
 
 (defgeneric distribute-event (port event))
diff --git a/silica/gadgets.lisp b/silica/gadgets.lisp
index f8ca5a4ed03167a15cab5ed09feb96bafb3e69d4..c1d62cd3d8ae2fa5d8c60a24eb6db0f7dfc87b21 100644
--- a/silica/gadgets.lisp
+++ b/silica/gadgets.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadgets.lisp,v 1.9 92/03/04 16:19:41 cer Exp Locker: cer $
+;; $fiHeader: gadgets.lisp,v 1.10 92/03/06 14:17:30 cer Exp Locker: cer $
 
 "Copyright (c) 1991, 1992 by Franz, Inc.  All rights reserved.
  Portions copyright (c) 1992 by Symbolics, Inc.  All rights reserved."
@@ -100,7 +100,7 @@
 (defclass labelled-gadget ()
     ((label :initarg :label
 	    :accessor gadget-label)
-     (alignment :initarg :halign ;;--- compat hack
+     (alignment :initarg :halign		;--- compatibility hack
 		:initarg :alignment
 		:accessor gadget-alignment))
   (:default-initargs :label nil))
@@ -148,10 +148,6 @@
 ;;; Push-button
 (defclass push-button 
 	  (action-gadget labelled-gadget) 
-	  ())
-
-(defclass label-pane 
-	  (labelled-gadget) 
     ())
 
 
@@ -169,6 +165,11 @@
 		     :reader gadget-indicator-type)))
 
 
+(defclass label-pane
+	  (labelled-gadget)
+    ())
+
+
 ;;; Caption
 ;;; option menu
 ;;; label
diff --git a/silica/macros.lisp b/silica/macros.lisp
index 808cf80ec19ca041773fd1e9e8e05f9bc17a15c9..d9f3505cd98a55d823e153e2523075e3d88b6ef4 100644
--- a/silica/macros.lisp
+++ b/silica/macros.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: macros.lisp,v 1.4 92/02/24 13:04:46 cer Exp $
+;; $fiHeader: macros.lisp,v 1.5 92/03/04 16:19:46 cer Exp $
 
 (in-package :silica)
 
@@ -61,5 +61,6 @@
 
 (defmacro realize-pane (&whole form pane-class &rest pane-options)
   (declare (ignore pane-class pane-options))
-  (error "Realize-pane not inside a with-look-and-feel-realization")
+  (error "~S not inside a call to ~S"
+	 'realize-pane 'with-look-and-feel-realization)
   form)
diff --git a/silica/mirror.lisp b/silica/mirror.lisp
index f4d832f76733a60b7d1f8f7b4b8f6fffda55684b..bb71f0a1d3ba015a6776f4c8f6c04999ff3f7e55 100644
--- a/silica/mirror.lisp
+++ b/silica/mirror.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: mirror.lisp,v 1.10 92/03/06 09:08:28 cer Exp Locker: cer $
+;; $fiHeader: mirror.lisp,v 1.11 92/03/06 14:17:31 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -264,7 +264,7 @@
 		     (- bottom top))))
 	(when (or (/= sc-x 1.0)
 		  (/= sc-y 1.0)
-		  (not (zerop  tr-x))
+		  (not (zerop tr-x))
 		  (not (zerop tr-y)))
 	  (let (#+Allegro (*error-output* excl::*initial-terminal-io*))
 	    (warn "Mirror scaling ~S,~S,~S,~S" 
diff --git a/silica/port.lisp b/silica/port.lisp
index 3b85d14bf6bcb20302691aa745e6dbef8c4885e2..671674a5dbbd882c773b7c449de76f52d2248fcf 100644
--- a/silica/port.lisp
+++ b/silica/port.lisp
@@ -19,7 +19,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: port.lisp,v 1.6 92/03/04 16:19:51 cer Exp Locker: cer $
+;; $fiHeader: port.lisp,v 1.7 92/03/09 17:41:14 cer Exp Locker: cer $
 
 (in-package :silica)
 
@@ -114,14 +114,15 @@
 			(server-path *default-server-path*)
 			(orientation :default)
 			(units :device))
-  (unless port (setq port (find-port :server-paths server-path)))
+  (unless port
+    (setq port (find-port :server-path server-path)))
   (map-over-grafts #'(lambda (graft)
 		       (when (graft-matches-spec graft orientation units)
 			 (return-from find-graft graft)))
 		   port)
   (make-instance (port-graft-class port)
 		 :port port
-		 :orientation  orientation 
+		 :orientation orientation 
 		 :units units))
 
 (defun graft-matches-spec (graft orientation units)
diff --git a/silica/text-style.lisp b/silica/text-style.lisp
index 98853d62cfdfb0f8d21b10247b67ce560c5dd9d5..466decd412400f0dc838a9ca02d7df9922e9af9d 100644
--- a/silica/text-style.lisp
+++ b/silica/text-style.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: text-style.lisp,v 1.4 92/02/24 13:05:00 cer Exp $
+;; $fiHeader: text-style.lisp,v 1.5 92/03/04 16:19:56 cer Exp $
 
 (in-package :silica)
 
@@ -76,7 +76,8 @@
 
 (defun initialize-text-style-tables ()
   (setf *null-text-style* (make-text-style-1 nil nil nil 0)
-	*undefined-text-style* (make-text-style-1 (make-symbol "UNDEFINED") nil nil 1)
+	*undefined-text-style* 
+	  (make-text-style-1 (make-symbol (symbol-name 'undefined)) nil nil 1)
 	*next-text-style-index* 2
 	*text-style-index-table*
 	  (make-array maximum-text-style-index 
@@ -553,28 +554,7 @@
     (dolist (spec specs)
       (load-specs nil nil nil spec))))
 
-;(defclass display-device ()
-;    ((name :initarg :name :reader display-device-name)
-;     (undefined-text-style :initform *undefined-text-style* 
-;			   :accessor device-undefined-text-style)
-;     ;; When this is true, the text style -> device font mapping is done
-;     ;; loosely.  That is, the actual screen size of the font need not be
-;     ;; exactly what the user has asked for.  Instead the closest fit is
-;     ;; chosen.  This is necessary in X11 because different screen sizes &
-;     ;; resolutions result in fonts having *actual displayed sizes* that
-;     ;; are not exactly what the fonts were designed for.  Loose text style
-;     ;; mapping is done by having the mapping table ignore size when hashing.
-;     ;; Thus each bucket is a list of fonts with the same family and face,
-;     ;; but different sizes.  They are kept sorted small to large.
-;     (allow-loose-text-style-size-mapping 
-;       :initform nil :initarg :allow-loose-text-style-size-mapping)
-;     ;; When ALLOW-LOOSE-TEXT-STYLE-SIZE-MAPPING is true, this should be
-;     ;; an EQUAL hash table!
-;     (mapping-table 
-;       :initform (make-hash-table) :initarg :mapping-table)))
-;
-;(defvar *display-devices* nil)
-;
+;;--- I think we need to preserve some of this, no?
 ;(defmethod initialize-instance :after
 ;	   ((device display-device) &key font-for-undefined-style)
 ;  (push-unique device *display-devices* :key #'display-device-name)
@@ -587,10 +567,6 @@
 ;    (add-text-style-mapping
 ;      device *standard-character-set* *undefined-text-style*
 ;      font-for-undefined-style)))
-;
-;(defmethod print-object ((device display-device) stream)
-;  (print-unreadable-object (device stream :type t :identity t)
-;    (format stream "~A" (slot-value device 'name))))
 
 (defmethod (setf text-style-mapping)
 	   (mapping (device port) style 
diff --git a/sys/sysdcl.lisp b/sys/sysdcl.lisp
index 80970c3014e37bbac636b15c1022edd8752f89ab..1649d2058605b6e6dbedf28a9a040d81ce0bbe30 100644
--- a/sys/sysdcl.lisp
+++ b/sys/sysdcl.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: sysdcl.lisp,v 1.6 92/03/04 16:22:34 cer Exp Locker: cer $
+;; $fiHeader: sysdcl.lisp,v 1.6 92/03/04 16:22:34 cer Exp $
 
 (in-package #-ANSI-90 "USER" #+ANSI-90 :cl-user)
 
@@ -8,7 +8,9 @@
 
 (eval-when (compile load eval)
 
-;; Tell the world that we're here
+;;; Tell the world that we're here
+  ;;------------- This needs to be in the CLIM.fasl also.
+  
 (pushnew :clim *features*)
 (pushnew :clim-2 *features*)
 (pushnew :clim-2.0 *features*)
@@ -242,8 +244,10 @@
   ("window-protocol" :features (not Silica))
 
   ;; Output recording
-  ("recording-protocol"
+  ("recording-defs"
    :load-before-compile ("clim-defs"))
+  ("recording-protocol"
+   :load-before-compile ("recording-defs"))
   ("text-recording"
    :load-before-compile ("recording-protocol"))
   ("graphics-recording"
@@ -406,13 +410,12 @@
 #+(and Silica Allegro)
 (defsys:defsystem xlib-clim
     (:default-pathname (frob-pathname "xlib")
-     :default-binary-pathname (frob-pathname "xlib")
-     :needed-systems (clim-standalone)
-     :load-before-compile (clim-standalone))
+	:default-binary-pathname (frob-pathname "xlib")
+	:needed-systems (clim-standalone)
+	:load-before-compile (clim-standalone))
   ("pkg")
-  #+ignore
-  ("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp"
-				    "xlib/last.lisp")))
+  #+++ignore ("ffi" :eval-after (mapc #'load '("xlib/xlib.lisp" "xlib/x11-keysyms.lisp"
+					       "xlib/last.lisp")))
   ("ffi")
   ("xlib-defs" #|:load-before-compile ("ffi") |#) ; Takes forever to compile...
   ("xlib-funs" :load-before-compile ("ffi"))
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 1c9d662149f5c4489678e3a31a3de01c41854405..d79bc778937f122b757eecf1b61eb9286ca427eb 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Suppplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.14 92/03/06 09:08:32 cer Exp Locker: cer $
+;; $fiHeader: xm-gadgets.lisp,v 1.14 92/03/06 09:08:32 cer Exp $
 
 (in-package :xm-silica)
 
@@ -105,7 +105,8 @@
 						     (sheet motif-label-pane))
   (with-accessors ((label gadget-label)) sheet
     (values 'tk::xm-label
-	    (and  label (list :label-string label)))))
+	    (and label (list :label-string label)))))
+
 
 ;;; Push button
 
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index db7b5752bb7c1fbf582e9719845eb3c485ff7281..c5089f3743cf1ef4b08ebb346607e1f7d224771d 100644
--- a/tk-silica/xt-silica.lisp
+++ b/tk-silica/xt-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-silica.lisp,v 1.11 92/03/06 14:17:37 cer Exp Locker: cer $
+;; $fiHeader: xt-silica.lisp,v 1.12 92/03/09 17:41:30 cer Exp Locker: cer $
 
 (in-package :xm-silica)
 
@@ -53,6 +53,7 @@
 	 (,ignore &key ((:display ,display)
 			(or (sys::getenv "DISPLAY")
 			    "localhost:0")))
+	 ,path
 	 (declare (ignore ,ignore))
        ,@body)))
        
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 5a0746a56c6981aa0cb96a88d3fdc9c6cc369053..b525054c32e3d3f5698a3fa344820f127358f9cd 100644
--- a/tk/resources.lisp
+++ b/tk/resources.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: resources.lisp,v 1.9 92/03/06 09:08:25 cer Exp Locker: cer $
+;; $fiHeader: resources.lisp,v 1.10 92/03/09 17:40:58 cer Exp Locker: cer $
 
 (in-package :tk)
 
@@ -203,8 +203,7 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'boolean)) value)
   (if value 1 0))
 
-(defmethod convert-resource-out ((parent  t) (type (eql 'string))
-				 value)
+(defmethod convert-resource-out ((parent  t) (type (eql 'string)) value)
   (string-to-char* value))
 
 (define-enumerated-resource dialog-style (:modeless
@@ -226,8 +225,7 @@
 				value)
   (not (zerop (ash value -24))))
 
-(defmethod convert-resource-in ((parent t) (type (eql 'cardinal))
-				value)
+(defmethod convert-resource-in ((parent t) (type (eql 'cardinal)) value)
   value)
 
 ;; We have to do this because we pass a pointer to :unsigned-long but
@@ -254,12 +252,10 @@
 (defmethod convert-resource-in ((parent t) (type (eql 'pixel)) value)
   value)
 
-(defmethod convert-resource-out ((parent t) (type (eql
-						   'horizontal-position))  value)
+(defmethod convert-resource-out ((parent t) (type (eql 'horizontal-position))  value)
   value)
 
-(defmethod convert-resource-out ((parent t) (type (eql
-						   'vertical-position))  value)
+(defmethod convert-resource-out ((parent t) (type (eql 'vertical-position))  value)
   value)
 
 (define-enumerated-resource resize-policy (:none :grow :any))
@@ -274,14 +270,12 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'shell-vert-dim)) x) x)
 (defmethod convert-resource-out ((parent t) (type (eql 'shell-vert-pos)) x) x)
 (defmethod convert-resource-out ((parent t) (type (eql 'shell-horiz-dim)) x) x)
-(defmethod convert-resource-out ((parent t) (type (eql
-						   'shell-horiz-pos)) x) x)
+(defmethod convert-resource-out ((parent t) (type (eql 'shell-horiz-pos)) x) x)
 
 (defmethod convert-resource-in ((parent t) (type (eql 'shell-vert-dim)) x) x)
 (defmethod convert-resource-in ((parent t) (type (eql 'shell-vert-pos)) x) x)
 (defmethod convert-resource-in ((parent t) (type (eql 'shell-horiz-dim)) x) x)
-(defmethod convert-resource-in ((parent t) (type (eql
-						  'shell-horiz-pos)) x) x)
+(defmethod convert-resource-in ((parent t) (type (eql 'shell-horiz-pos)) x) x)
 
 
 (define-enumerated-resource delete-response (:destroy :unmap :do-nothing))
@@ -338,8 +332,7 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'position)) value)
   value)
 
-(defmethod convert-resource-in ((parent t) (type (eql 'position))
-				value)
+(defmethod convert-resource-in ((parent t) (type (eql 'position)) value)
   (convert-16bit-resource-in value))
 
 (defun convert-16bit-resource-in (value)
@@ -352,8 +345,7 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'dimension)) value)
   value)
 
-(defmethod convert-resource-in ((parent t) (type (eql 'dimension))
-				value)
+(defmethod convert-resource-in ((parent t) (type (eql 'dimension)) value)
   (ash value -16))
 
 ;; from OpenLook.h
diff --git a/utils/clim-streams.lisp b/utils/clim-streams.lisp
index e5b3b213534c89829f3304fa85f57155e39fa5a0..3d5f0144f76466b95b59fe56daed42effd31e21a 100644
--- a/utils/clim-streams.lisp
+++ b/utils/clim-streams.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-streams.lisp,v 1.1 92/01/31 14:25:28 cer Exp $
+;; $fiHeader: clim-streams.lisp,v 1.2 92/02/24 13:05:20 cer Exp $
 
 (in-package :clim-utils)
 
@@ -19,6 +19,6 @@
 	  (encapsulating-stream)
     ((stream :initarg :stream
 	     :reader encapsulating-stream-stream))
-  #+Allegro (:default-initargs :element-type 'extended-char))
+  #+Allegro (:default-initargs :element-type 'character))
 
 
diff --git a/utils/coral-char-bits.lisp b/utils/coral-char-bits.lisp
index f53ca9f1b97135254c8c6f3704aad510f0cb6721..5ae97352ebc4ed2f5ae8f7a68f7eca4089f6c611 100644
--- a/utils/coral-char-bits.lisp
+++ b/utils/coral-char-bits.lisp
@@ -1,7 +1,7 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
 
-;; $fiHeader: coral-char-bits.lisp,v 1.2 92/01/31 15:16:24 cer Exp $
+;; $fiHeader: coral-char-bits.lisp,v 1.3 92/02/24 13:05:27 cer Exp $
 
 (in-package :clim-utils)
 
@@ -29,7 +29,7 @@
   (declare (fixnum ch1 ch2))
   ;; Really gross!
   (ccl::require-type ch1 'character)
-  (ccl::require-type ch2'character)
+  (ccl::require-type ch2 'character)
   (= ch1 ch2))
 
 (defmacro shadow-char-p-function (name)
@@ -43,5 +43,3 @@
 (shadow-char-p-function graphic-char-p)
 (shadow-char-p-function standard-char-p)
 (shadow-char-p-function alpha-char-p)
-
-;; --- do we need to shadow ALPHANUMERICP ?
diff --git a/utils/defpackage.lisp b/utils/defpackage.lisp
index 3ef1a5baa9f89ff2302cf9728a6ffa7c5199e9a5..6109d31b5c7cfe5cd5c47e1485d6d46afed226eb 100644
--- a/utils/defpackage.lisp
+++ b/utils/defpackage.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: (CLIM-LISP :USE LISP :COLON-MODE :EXTERNAL); Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: defpackage.lisp,v 1.3 92/02/24 13:05:29 cer Exp $
+;; $fiHeader: defpackage.lisp,v 1.4 92/03/04 16:20:11 cer Exp $
 
 "Copyright (c) 1989, 1990, 1991 by International Lisp Associates.  All Rights Reserved."
 
@@ -43,7 +43,7 @@
 	  (nicknames (get-option :nicknames))
 	  #+Genera (prefix-name (car (get-option :prefix-name)))
 	  (size (get-option :size))
-	  (package-var (make-symbol "PACKAGE")))
+	  (package-var '#:package))
       (let ((bad-option
 	      (find-if-not #'(lambda (opt)
 			       (lisp:member opt '(:use :nicknames :size #+Genera :prefix-name
diff --git a/utils/excl-verification.lisp b/utils/excl-verification.lisp
index 92bd144aa1dc897eefcf8104c6476d52b8ad00fd..236816a42a1271fca7ca5c57a16a40c35563a815 100644
--- a/utils/excl-verification.lisp
+++ b/utils/excl-verification.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: excl-verification.lisp,v 1.2 92/01/31 14:52:38 cer Exp $
+;; $fiHeader: excl-verification.lisp,v 1.4 92/02/24 13:05:36 cer Exp $
 
 (in-package :sys)
 
diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp
index 3c27103fce434fec41ed1ecfe76471382cb8df44..64a27b9227feeda3e67358c819fbef04d6ef6d42 100644
--- a/utils/lisp-utilities.lisp
+++ b/utils/lisp-utilities.lisp
@@ -1,6 +1,6 @@
  ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: lisp-utilities.lisp,v 1.4 92/02/24 13:05:40 cer Exp $
+;; $fiHeader: lisp-utilities.lisp,v 1.5 92/03/04 16:20:15 cer Exp $
 
 (in-package :clim-utils)
 
@@ -89,11 +89,6 @@
 	      forms)))))
 
 
-;;--- Yes, this is a kludge.  I promise we'll fix it.
-(deftype extended-char ()
-  #+(or Minima CCL-2) 'character
-  #-(or Minima CCL-2) 'string-char)
-
 ;;; Characters that are ordinary text rather than potential input editor commands.
 ;;; Note that GRAPHIC-CHAR-P is true of #\Space
 (defun ordinary-char-p (char)
@@ -208,10 +203,13 @@
 		(apply #'lisp:format () format-string format-args))))))
 
 (defvar *gensymbol* 0)
+
+(eval-when (compile load eval)
 (defun gensymbol (&rest parts)
   (declare (dynamic-extent parts))
   (when (null parts) (setf parts '(gensymbol)))
   (make-symbol (lisp:format nil "~{~A-~}~D" parts (incf *gensymbol*))))
+)	;eval-when
 
 ;;; For macro writers; you can have your GENSYMBOLs start at 1.  Use
 ;;; this in the macro, not in its expansion...
@@ -648,7 +646,7 @@
      ,@body))
 
 (defmacro writing-clauses (&body body)
-  (let ((clauses-var (make-symbol "CLAUSES")))
+  (let ((clauses-var (gensymbol 'clauses)))
     `(let ((,clauses-var nil))
        (macrolet ((clause (clause)
 		    `(push ,clause ,',clauses-var)))
@@ -821,8 +819,10 @@
 ;;; objects which have the right properties flavors mixed in.
 (defmacro define-class-mixture-and-resource (name (&key initializer initial-copies)
 					     &body specs)
-  (let ((matcher-function-name (make-symbol (lisp:format nil "~A-MATCHER" name)))
-	(constructor-function-name (make-symbol (lisp:format nil "~A-CONSTRUCTOR" name))))
+  (let ((matcher-function-name 
+	  (make-symbol (lisp:format nil "~A-~A" name 'matcher)))
+	(constructor-function-name
+	  (make-symbol (lisp:format nil "~A-~A" name 'constructor))))
     `(define-group ,name define-class-mixture-and-resource
        (define-class-mixture ,name ,@specs)
        (defun ,matcher-function-name (object os &rest args)
@@ -956,7 +956,8 @@
   (unless (eq property :property)
     (warn "Using ~S to define a function named ~S, which is not a property"
 	  'defun-property (list property symbol indicator)))
-  (let ((function-name (make-symbol (lisp:format nil "~A-~A-PROPERTY" symbol indicator))))
+  (let ((function-name 
+	  (make-symbol (lisp:format nil "~A-~A-~A" symbol indicator 'property))))
     `(progn (defun ,function-name ,lambda-list ,@body)
 	    (eval-when (load eval) (setf (get ',symbol ',indicator) #',function-name)))))
 
@@ -965,10 +966,10 @@
 				   substring-form
 				   &body char-clauses)
   (let ((special-characters ())
-	(next-var (make-symbol "NEXT"))
-	(string-var (if (symbolp string) string (make-symbol "STRING")))
-	(end-var (make-symbol "END"))
-	(char-var (or char-var (make-symbol "THE-CHAR"))))
+	(next-var (gensymbol 'next))
+	(string-var (if (symbolp string) string (gensymbol 'string)))
+	(end-var (gensymbol 'end))
+	(char-var (or char-var (gensymbol 'the-char))))
     (dolist (char-clause char-clauses)
       (let ((chars (first char-clause)))
 	(if (atom chars)
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 35a2bf3466eed042cc9e90b16ec90cd4caa321df..1872248945b2a85d220d7910e76ae04a18840783 100644
--- a/utils/packages.lisp
+++ b/utils/packages.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: packages.lisp,v 1.5 92/03/04 16:20:19 cer Exp Locker: cer $
+;; $fiHeader: packages.lisp,v 1.4 92/02/24 13:05:46 cer Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -2318,7 +2318,6 @@
     viewp
     with-input-context
     with-output-as-presentation
-    with-output-as-gadget
     with-presentation-type-decoded
     with-presentation-type-options
     with-presentation-type-parameters
@@ -2579,9 +2578,7 @@
     gadget-label
     gadget-orientation
     gadget-value
-    label-pane
     menu-bar
-    notify-user
     note-gadget-activated
     note-gadget-deactivated
     push-button
@@ -2986,7 +2983,6 @@
     doseq
     dovector
     evacuate-list
-    extended-char
     find-class-that-works
     fintern
     flatten-arglist
@@ -3189,7 +3185,9 @@
   (:export
     *all-drawing-options*
     *default-text-style*
+    *modifier-keys*
     *null-text-style*
+    *pointer-buttons*
     *standard-character-set* 
     *undefined-text-style* 
     +highlighting-line-style+
diff --git a/utils/reader.lisp b/utils/reader.lisp
index fb2e0915554f922924e968c870c8e47aecb71a3e..64fead9d2c6d93e1d5866172085d71e11ef6cddf 100644
--- a/utils/reader.lisp
+++ b/utils/reader.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: reader.lisp,v 1.4 92/01/31 15:07:27 cer Exp $
+;; $fiHeader: reader.lisp,v 1.5 92/02/24 13:05:53 cer Exp $
 
 (in-package :clim-utils)
 
@@ -11,7 +11,7 @@
 
 ;;; Tool to temporarily add a macro character.
 (defmacro with-macro-character ((char function) &body body)
-  (let ((existing (make-symbol "EXISTING")))
+  (let ((existing (make-symbol (symbol-name 'existing))))
     `(let ((,existing (get-macro-character ,char)))
        (unwind-protect
 	   (progn
diff --git a/utils/region-arithmetic.lisp b/utils/region-arithmetic.lisp
index 98a8088d7bc9fb66f004fd8552635bb081609285..d3330eaf88fcf00db572ec47794e7df6155f3672 100644
--- a/utils/region-arithmetic.lisp
+++ b/utils/region-arithmetic.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: region-arithmetic.lisp,v 1.3 92/02/24 13:05:55 cer Exp $
+;; $fiHeader: region-arithmetic.lisp,v 1.4 92/03/04 16:20:22 cer Exp $
 
 (in-package :clim-utils)
 
@@ -123,8 +123,8 @@
 ;;; General region difference
 
 (defclass standard-region-difference (region-set area)
-    ((region1 :type region :initarg region1)
-     (region2 :type region :initarg region2)
+    ((region1 :type region :initarg :region1)
+     (region2 :type region :initarg :region2)
      (regions :type list)))
 
 (define-constructor make-region-difference standard-region-difference