diff --git a/clim/accept.lisp b/clim/accept.lisp
index dedd01a9fca6dc1a00a15734483f528a01d7f166..253a71273c5fa317f2f2e6f5d38d81a4c816807d 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.21 92/12/03 10:25:56 cer Exp $
+;; $fiHeader: accept.lisp,v 1.22 92/12/16 16:45:56 cer Exp $
 
 (in-package :clim-internals)
 
@@ -95,12 +95,12 @@
 (defmethod stream-accept ((stream input-protocol-mixin) type &rest accept-args
 			  &key view &allow-other-keys)
   (declare (dynamic-extent accept-args))
-  (let ((query-identifier
-	  (apply #'prompt-for-accept
-		 (encapsulated-stream stream) type view accept-args)))
-    (apply #'accept-1 (encapsulated-stream stream) type
-		      :query-identifier query-identifier
-		      accept-args)))
+  (let* ((stream (encapsulated-stream stream))
+	 (query-identifier (apply #'prompt-for-accept
+				  stream type view accept-args)))
+    (apply #'accept-1 stream type
+	   :query-identifier query-identifier
+	   accept-args)))
 
 (defmethod prompt-for-accept ((stream input-protocol-mixin) type (view view)
 			      &rest accept-args
diff --git a/clim/clim-defs.lisp b/clim/clim-defs.lisp
index 7bafef6db9625f16e2c5d8185d4f91004f2c114f..826c92d071735d5fc951cc8825520378c4a35165 100644
--- a/clim/clim-defs.lisp
+++ b/clim/clim-defs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: clim-defs.lisp,v 1.21 92/12/07 12:14:08 cer Exp $
+;; $fiHeader: clim-defs.lisp,v 1.22 92/12/16 16:46:05 cer Exp $
 
 (in-package :clim-internals)
 
@@ -233,12 +233,14 @@
 	 (expand-presentation-type-abbreviation ,type) ,override
 	 #'body-continuation #'context-continuation))))
 
-(defmacro with-input-focus ((stream) &body body)
+(defmacro with-input-focus ((stream &optional (doit t)) &body body)
   (let ((old-input-focus '#:old-input-focus))
     `(let ((,old-input-focus nil))
        (unwind-protect
-	   (progn (setq ,old-input-focus (stream-set-input-focus ,stream))
-		  ,@body)
+	   (progn
+	     (when ,doit
+	       (setq ,old-input-focus (stream-set-input-focus ,stream)))
+	     ,@body)
 	 (when ,old-input-focus
 	   (stream-restore-input-focus ,stream ,old-input-focus))))))
 
diff --git a/clim/cursor.lisp b/clim/cursor.lisp
index 3d9ac1130d4cf7aa5e0a5517664facf91a5cb3d2..0a37c542e1372e262e926312b12dc022a7b8a73b 100644
--- a/clim/cursor.lisp
+++ b/clim/cursor.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: cursor.lisp,v 1.22 93/01/21 14:57:42 cer Exp $
+;; $fiHeader: cursor.lisp,v 1.23 93/03/04 18:59:47 colin Exp $
 
 (in-package :clim-internals)
 
@@ -42,6 +42,8 @@
 
 (defmethod bounding-rectangle* ((cursor standard-text-cursor))
   (with-slots (x y width) cursor
+    ;; this is surely wrong (ie what about height) - but frankly who
+    ;; cares?? --CIM  
     (values x y (+ x width) (+ y width))))
 
 (defconstant cursor_active (byte 1 0))
@@ -67,31 +69,30 @@
   (cursor-set-position cursor x y))
 
 (defmethod cursor-set-position ((cursor standard-text-cursor) nx ny &optional fastp)
-  (with-slots (x y flags stream) cursor
+  (with-slots (x y stream) cursor
     (unless (and (= x (coordinate nx))
 		 (= y (coordinate ny)))
-      (if (or fastp (not (cursor-state cursor)))
-	  (setf x (coordinate nx)
-		y (coordinate ny))
-	  (let ((active (cursor-active cursor))) 
-	    ;; Turn it off and then turn it on to make it move
-	    (unwind-protect
-		(progn
-		  (when active
-		    (setf (cursor-active cursor) nil))
-		  (setf x (coordinate nx)
-			y (coordinate ny)))
-	      (when active
-		(setf (cursor-active cursor) active))))))))
-
+      (let ((state (cursor-state cursor))
+	    (active (cursor-active cursor)))
+	(if (or fastp 
+		(not (and state active)))
+	    (setf x (coordinate nx)
+		  y (coordinate ny))
+	  ;; Turn it off and then turn it on to make it move
+	  (unwind-protect
+	      (progn
+		(setf (cursor-active cursor) nil)
+		(setf x (coordinate nx)
+		      y (coordinate ny)))
+	    (setf (cursor-active cursor) t)))))))
+  
 (defmethod (setf cursor-state) (new-state (cursor standard-text-cursor))
   (with-slots (flags) cursor
     (multiple-value-bind (active state focus)
 	(decode-cursor-flags flags)
       (declare (ignore active focus))
       (setf (ldb cursor_state flags) (if new-state 1 0))
-      (unless (eq state new-state)
-	(note-cursor-change cursor 'cursor-state state new-state)))))
+      (note-cursor-change cursor 'cursor-state state new-state))))
 
 (defmethod cursor-state ((cursor standard-text-cursor))
   (ldb-test cursor_state (slot-value cursor 'flags)))
@@ -102,8 +103,7 @@
 	(decode-cursor-flags flags)
       (declare (ignore state focus))
       (setf (ldb cursor_active flags) (if new-active 1 0))
-      (unless (eq active new-active)
-	(note-cursor-change cursor 'cursor-active active new-active)))))
+      (note-cursor-change cursor 'cursor-active active new-active))))
 
 (defmethod cursor-active ((cursor standard-text-cursor))
   (ldb-test cursor_active (slot-value cursor 'flags)))
@@ -114,14 +114,16 @@
 	(decode-cursor-flags flags)
       (declare (ignore active state))
       (setf (ldb cursor_focus flags) (if new-focus 1 0))
-      (unless (eq focus new-focus)
-	(note-cursor-change cursor 'cursor-focus focus new-focus)))))
+      (note-cursor-change cursor 'cursor-focus focus new-focus))))
 
 (defmethod cursor-focus ((cursor standard-text-cursor))
   (ldb-test cursor_focus (slot-value cursor 'flags)))
 
 (defmethod cursor-visibility ((cursor standard-text-cursor))
-  (cursor-active cursor))
+  (and (cursor-active cursor)
+       (if (cursor-state cursor)
+	   :on
+	 :off)))
  
 (defmethod (setf cursor-visibility) (visibility (cursor standard-text-cursor))
   (setf (cursor-state cursor) 
@@ -152,6 +154,23 @@
 	 (unless abort-p
 	   (setf (cursor-state cursor) old-state))))))
 
+(defmacro with-cursor-active ((stream active) &body body)
+  (default-input-stream stream)
+  `(let* ((cursor (and (extended-input-stream-p ,stream)
+		       (stream-text-cursor ,stream)))
+	  (old-active (and cursor (cursor-active cursor)))
+	  (abort-p t))
+     (unwind-protect
+	 (progn (when cursor
+		  (cond ((eq old-active ,active))
+			(t
+			 (setf (cursor-active cursor) ,active)
+			 (setf abort-p nil))))
+		,@body)
+       (when cursor
+	 (unless abort-p
+	   (setf (cursor-active cursor) old-active))))))
+
 (defmethod cursor-width-and-height-pending-protocol ((cursor t))
   (values 8 12))
 
@@ -172,61 +191,61 @@
 ;;; state transitions.  For example, the cursor might be getting the focus, and
 ;;; thus change from a hollow rectangle to a filled one (or in Genera, it might
 ;;; start blinking).
-(defmethod port-note-cursor-change :after ((port basic-port) 
-					   cursor stream (type (eql 'cursor-focus)) old new)
-  (declare (ignore old cursor))
-  ;;--- This should really only do this when PORT-INPUT-FOCUS-SELECTION
-  ;;--- is :SHEET-UNDER-POINTER, since this causes the "wrong" thing to
-  ;;--- happen from the perspective of Genera users.  But where do we
-  ;;--- implement the :CLICK-TO-SELECT behavior?
-  (setf (port-keyboard-input-focus port) (and new stream)))
 
 (defmethod port-note-cursor-change ((port basic-port) 
 				    cursor stream (type (eql 'cursor-state)) old new)
-  (declare (ignore old))
-  (let ((active (cursor-active cursor)))
+  (let ((active (cursor-active cursor))
+	(focus (cursor-focus cursor)))
     (when active
       (multiple-value-bind (x y) (bounding-rectangle* cursor)
-	(if new
-	    (port-draw-cursor port cursor stream x y t)
-	    (port-draw-cursor port cursor stream x y nil))))))
+	(port-draw-cursor port cursor stream x y old new focus)))))
 
 (defmethod port-note-cursor-change ((port basic-port) 
 				    cursor stream (type (eql 'cursor-active)) old new)
-  (declare (ignore old))
-  (let ((state (cursor-state cursor)))
+  (let ((state (cursor-state cursor))
+	(focus (cursor-focus cursor)))
     (when state
       (multiple-value-bind (x y) (bounding-rectangle* cursor)
-	(if new
-	    (port-draw-cursor port cursor stream x y t)
-	    (port-draw-cursor port cursor stream x y nil))))))
+	(port-draw-cursor port cursor stream x y old new focus)))))
 
 (defmethod port-note-cursor-change ((port basic-port) 
 				    cursor stream (type (eql 'cursor-focus)) old new)
   (let ((active (cursor-active cursor))
 	(state (cursor-state cursor)))
-    (declare (ignore focus))
-    (when (and active state)
+    (when (and active 
+	       state
+	       (not (eq old new)))
       (multiple-value-bind (x y) (bounding-rectangle* cursor)
 	;; erase it with old-focus
-	(port-draw-cursor port cursor stream x y nil old)
+	(port-draw-cursor port cursor stream x y t nil old)
 	;; draw it with new-focus
-	(port-draw-cursor port cursor stream x y t new)))))
+	(port-draw-cursor port cursor stream x y nil t new)))))
 
 ;; PORT-DRAW-CURSOR is invoked to draw or erase the cursor.
 (defmethod port-draw-cursor
-	   ((port basic-port) (cursor standard-text-cursor) stream x y on-p
-	    &optional (focus nil focus-p))
-  #---ignore (declare (ignore on-p))
+    ((port basic-port) (cursor standard-text-cursor) stream x1 y1 old new focus)
   ;;--- protocol violations:  output recording protocol (with-output-recording-options)
   ;;---                       graphics protocol (draw-rectangle*)
   ;;---                       output protocol (stream-line-height)
   (let ((height (stream-line-height stream))
 	(width (slot-value cursor 'width)))
-    (unless focus-p (setq focus (cursor-focus cursor)))
-    (with-output-recording-options (stream :record nil)
-      (draw-rectangle* stream x y (+ x width) (+ y height)
-		       :filled focus
-		       :ink #+++ignore (if on-p +foreground-ink+ +background-ink+)
-			    #---ignore +flipping-ink+))
-    (force-output stream)))
+    (unless (eq old new)
+      (with-output-recording-options (stream :record nil)
+	(with-drawing-options (stream :ink +flipping-ink+)
+	  (let ((x2 (+ x1 width))
+		(y2 (+ y1 height)))
+	    (if focus
+		(draw-rectangle* stream x1 y1 (1+ x2) (1+ y2)
+				 :filled t)
+	      (progn
+		(draw-line* stream x1 y1 x2 y1)
+		(draw-line* stream x1 y2 x2 y2)
+		(draw-line* stream x1 (1+ y1) x1 (1- y2))
+		(draw-line* stream x2 (1+ y1) x2 (1- y2))))))
+	(force-output stream)))))
+
+
+
+
+
+
diff --git a/clim/db-stream.lisp b/clim/db-stream.lisp
index 09904157dcefd8443f350a1bff35af8fac920b2e..638a841c4273af96961f465a8dbc1688034da7b2 100644
--- a/clim/db-stream.lisp
+++ b/clim/db-stream.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: db-stream.lisp,v 1.50 1993/05/05 01:38:20 cer Exp $
+;; $fiHeader: db-stream.lisp,v 1.51 93/05/13 16:23:01 cer Exp $
 
 (in-package :clim-internals)
 
@@ -714,8 +714,8 @@
 	 (port (port stream)))
     (setf (medium-foreground stream) foreground
 	  (medium-background stream) background
-	  (medium-default-text-style stream) (or default-text-style (port-default-text-style port))
-	  (medium-text-style stream) (or text-style (port-default-text-style port))
+	  (medium-default-text-style stream) (or default-text-style *default-text-style*)
+	  (medium-text-style stream) (or text-style *default-text-style*)
 	  (stream-vertical-spacing stream) vertical-spacing
 	  (stream-end-of-line-action stream) end-of-line-action
 	  (stream-end-of-page-action stream) end-of-page-action
diff --git a/clim/gadget-output.lisp b/clim/gadget-output.lisp
index 0807d0608da4488cdabb3459f0c8699184435827..b69d40feff12970ef66f1b1f824e1dcdceb5852b 100644
--- a/clim/gadget-output.lisp
+++ b/clim/gadget-output.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: gadget-output.lisp,v 1.48 1993/05/05 01:38:27 cer Exp $
+;; $fiHeader: gadget-output.lisp,v 1.49 93/05/13 16:23:07 cer Exp $
 
 (in-package :clim-internals)
 
@@ -312,9 +312,7 @@
 		   (when (typep sheet 'toggle-button)
 		     (when (setf (gadget-value sheet)
 				 (and default-supplied-p
-				      (funcall test 
-					       (funcall value-key (gadget-id sheet))
-					       (funcall value-key default))))
+				      (funcall test (gadget-id sheet) default)))
 		       (setf (radio-box-current-selection radio-box) sheet))))
 	       radio-box)))
       (with-output-as-gadget (stream :cache-value type :update-gadget #'update-gadget)
@@ -328,24 +326,20 @@
 			  (let* ((value (funcall value-key element))
 				 (button
 				  (apply #'make-pane 'toggle-button 
-				    :label 
-				      (let ((name (funcall name-key element)))
-					(if (eq printer #'write-token)
-					    name
-					    (pixmap-from-menu-item stream name printer nil)))
-				    :indicator-type
-				      (getf toggle-options :indicator-type :one-of)
-				    :value
-				      (and default-supplied-p
-					   (funcall test 
-						    value
-						    (funcall value-key default)))
-				    :id value
-				    toggle-options)))
+					 :label 
+					 (let ((name (funcall name-key element)))
+					   (if (eq printer #'write-token)
+					       name
+					     (pixmap-from-menu-item stream name printer nil)))
+					 :indicator-type
+					 (getf toggle-options :indicator-type :one-of)
+					 :value
+					 (and default-supplied-p
+					      (funcall test value default))
+					 :id value
+					 toggle-options)))
 			    (when (and default-supplied-p
-				       (funcall test 
-						value
-						(funcall value-key default)))
+				       (funcall test value default))
 			      (setq current-selection button))
 			    button))
 		      sequence))
@@ -404,9 +398,7 @@
 		     (let ((value 
 			     (and default-supplied-p
 				  (member (gadget-id sheet) default
-					  :test test 
-					  ;;--- Should the value-key be used?
-					  :key value-key) 
+					  :test test)
 				  t)))
 		       (when value (push sheet current-selection))
 		       (setf (gadget-value sheet) value))))
@@ -424,9 +416,7 @@
 			(let* ((value (funcall value-key element))
 			       (actual-value (and default-supplied-p
 						  (member value default
-							  :test test 
-							  ;;--- Should the value-key be used?
-							  :key value-key)
+							  :test test)
 						  t))
 			       (button
 				 (apply #'make-pane 'toggle-button
diff --git a/clim/input-protocol.lisp b/clim/input-protocol.lisp
index 0997202df3af0e37c949c8c1cf8337628223194f..748bee74a151373c6da6aaacc716b51f5d226674 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.40 1993/05/05 01:38:37 cer Exp $
+;; $fiHeader: input-protocol.lisp,v 1.41 93/05/13 16:23:13 cer Exp $
 
 (in-package :clim-internals)
 
@@ -66,7 +66,7 @@
      (pointer-motion-pending :initform nil)
      (text-cursor :accessor stream-text-cursor
 		  :initarg :text-cursor)
-     (read-gesture-cursor-state :initarg :read-gesture-cursor-state 
+     (read-gesture-cursor-state :initarg :read-gesture-cursor-state
 				:accessor stream-read-gesture-cursor-state))
   (:default-initargs
       :text-cursor (make-instance 'standard-text-cursor)
@@ -102,15 +102,12 @@
       ;; Assumes that the cursors are all off for the stream
       (cursor-set-position cursor x y t))))
 
-
 (defmethod initialize-menu :before (port (menu input-protocol-mixin) &key label)
   (declare (ignore port label))
   (let ((cursor (stream-text-cursor menu)))
     (when cursor
       (setf (cursor-active cursor) nil))))
 
-(defvar *cursor-repaint-rectangle* (make-bounding-rectangle 0 0 0 0))
-
 (defmethod repaint-sheet :after ((stream input-protocol-mixin) (region nowhere))
   ;; Repainting nowhere, don't repaint the cursor
   )
@@ -120,15 +117,18 @@
 	(viewport (pane-viewport stream)))
     (when (and cursor viewport)
       (when (and (cursor-active cursor)
-		 (cursor-state cursor)
-		 (cursor-focus cursor))
+		 (cursor-state cursor))
 	(multiple-value-bind (x y) (cursor-position cursor)
 	  (multiple-value-bind (width height)
 	      (cursor-width-and-height-pending-protocol cursor)
 	    (with-bounding-rectangle* (left top right bottom) region
 	      (when (ltrb-overlaps-ltrb-p left top right bottom
-					  x y (+ x width) (+ y height))
-		(note-cursor-change cursor 'cursor-active t t)))))))))
+					  x y (+ x width) (+ y
+							     height))
+		(with-sheet-medium (medium stream)
+		  (with-medium-clipping-region (medium region)
+		    (declare (ignore medium))
+		    (note-cursor-change cursor 'cursor-active nil t)))))))))))
 
 (defmethod pointer-motion-pending ((stream input-protocol-mixin)
 				   &optional
@@ -191,16 +191,6 @@
   (let ((pointer (stream-primary-pointer stream)))
     (setf (pointer-motion-pending stream pointer) t)))
 
-(defmethod queue-event :after ((stream input-protocol-mixin) (event pointer-enter-event))
-  (let ((text-cursor (stream-text-cursor stream)))
-    (when text-cursor 
-      (setf (cursor-focus text-cursor) t))))
-
-(defmethod queue-event :before ((stream input-protocol-mixin) (event pointer-exit-event))
-  (let ((text-cursor (stream-text-cursor stream)))
-    (when text-cursor
-      (setf (cursor-focus text-cursor) nil))))
-
 (defmethod queue-event ((stream input-protocol-mixin) (event pointer-exit-event))
   (queue-put (stream-input-buffer stream) (copy-event event)))
 
@@ -242,39 +232,41 @@
   (declare (ignore pointer-button-press-handler))
   (let ((read-gesture-cursor-state (stream-read-gesture-cursor-state stream)))
     (with-cursor-state (stream read-gesture-cursor-state)
-      (loop
-	(multiple-value-bind (input-happened flag)
-	    (stream-input-wait
-	     stream
-	     :timeout timeout :input-wait-test input-wait-test)
-	  (case flag
-	    (:timeout
-	     (return-from stream-read-gesture (values nil :timeout)))
-	    (:input-wait-test
-	     ;; only call the input-wait-handler if we didn't get a first-rate
-	     ;; gesture back from stream-input-wait.
-	     (when input-wait-handler
-	       (funcall input-wait-handler stream)))
-	    (otherwise 
-	     (when input-happened
-	       (let ((gesture (queue-get (stream-input-buffer stream))))
-		 (when gesture
-		   ;;--- What we *should* do is to reinstate a separate input
-		   ;;--- buffer for the stream, then this should loop doing
-		   ;;--- HANDLE-EVENT until something gets inserted into the
-		   ;;--- stream's input buffer.  Then this should read and
-		   ;;--- process the gesture in the input buffer.
-		   (let* ((sheet (and (typep gesture 'device-event)
-				      (event-sheet gesture)))
-			  (new-gesture 
-			   (receive-gesture
-			    (if (or (null sheet) (eq sheet stream))
-				(encapsulated-stream stream)
-			      sheet)
-			    gesture)))
-		     (when new-gesture
-		       (when peek-p (queue-unget (stream-input-buffer stream) gesture))
-		       (return-from stream-read-gesture new-gesture)))))))))))))
+      (with-input-focus (stream read-gesture-cursor-state)
+	(loop
+	  (multiple-value-bind (input-happened flag)
+	      (stream-input-wait
+	       stream
+	       :timeout timeout :input-wait-test input-wait-test)
+	    (case flag
+	      (:timeout
+	       (return-from stream-read-gesture (values nil :timeout)))
+	      (:input-wait-test
+	       ;; only call the input-wait-handler if we didn't get a first-rate
+	       ;; gesture back from stream-input-wait.
+	       (when input-wait-handler
+		 (funcall input-wait-handler stream)))
+	      (otherwise 
+	       (when input-happened
+		 (let ((gesture (queue-get (stream-input-buffer stream))))
+		   (when gesture
+		     ;;--- What we *should* do is to reinstate a separate input
+		     ;;--- buffer for the stream, then this should loop doing
+		     ;;--- HANDLE-EVENT until something gets inserted into the
+		     ;;--- stream's input buffer.  Then this should read and
+		     ;;--- process the gesture in the input buffer.
+		     (let* ((sheet (and (typep gesture 'device-event)
+					(event-sheet gesture)))
+			    (new-gesture 
+			     (receive-gesture
+			      (if (or (null sheet) (eq sheet stream))
+				  (encapsulated-stream stream)
+				sheet)
+			      gesture)))
+		       (when new-gesture
+			 (when peek-p
+			   (queue-unget (stream-input-buffer stream) gesture))
+			 (return-from stream-read-gesture new-gesture))))))))))))))
 
 ;; Presentation translators have probably already run...
 (defmethod receive-gesture
@@ -672,3 +664,15 @@
 
 (defmethod stream-restore-input-focus ((stream input-protocol-mixin) old-focus)
   (setf (port-keyboard-input-focus (port stream)) old-focus))
+
+(defmethod note-sheet-gain-focus ((sheet input-protocol-mixin))
+  (let ((text-cursor (stream-text-cursor sheet)))
+    (when text-cursor
+      (setf (cursor-focus text-cursor) t))))
+
+(defmethod note-sheet-lose-focus ((sheet input-protocol-mixin))
+  (let ((text-cursor (stream-text-cursor sheet)))
+    (when text-cursor
+      (setf (cursor-focus text-cursor) nil))))
+
+
diff --git a/clim/interactive-protocol.lisp b/clim/interactive-protocol.lisp
index cc5f33befad5a0b3e6690ff77463eacf90b84de1..de0ae8c9c72e54c0afa732b78b015c8474929236 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.25 1993/05/05 01:38:40 cer Exp $
+;; $fiHeader: interactive-protocol.lisp,v 1.26 93/05/13 16:23:19 cer Exp $
 
 (in-package :clim-internals)
 
@@ -469,10 +469,11 @@
 		   ;; If there's anything in the input buffer, disallow accelerators
 		   (and *input-buffer-empty* *accelerator-gestures*)))
 	    (stream-read-gesture stream
-	      :timeout timeout :peek-p peek-p
-	      :input-wait-test input-wait-test
-	      :input-wait-handler input-wait-handler
-	      :pointer-button-press-handler pointer-button-press-handler))
+				 :timeout timeout :peek-p peek-p
+				 :input-wait-test input-wait-test
+				 :input-wait-handler input-wait-handler
+				 :pointer-button-press-handler
+				 pointer-button-press-handler))
 	(cond ((eq type ':timeout)
 	       (return-from stream-read-gesture
 		 (values thing type)))
diff --git a/silica/classes.lisp b/silica/classes.lisp
index 784aa5bbff51ac75e86e370d5c025a755b6f773f..b355322828ebc68664f48e9283a26ce0188e0f63 100644
--- a/silica/classes.lisp
+++ b/silica/classes.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: classes.lisp,v 1.31 93/03/04 19:01:04 colin Exp $
+;; $fiHeader: classes.lisp,v 1.32 93/03/25 15:40:19 colin Exp $
 
 (in-package :silica)
 
@@ -27,7 +27,7 @@
      (mirror->sheet-table :initform (make-hash-table) 
 			  :reader port-mirror->sheet-table)
      (focus :initform nil :accessor port-keyboard-input-focus)
-     (focus-selection :initform :sheet-under-pointer :initarg :focus-selection
+     (focus-selection :initform :click-to-select :initarg :focus-selection
 		      :accessor port-input-focus-selection
 		      :type (member :sheet-under-pointer :click-to-select))
      (trace-thing :initform (make-array 10 :fill-pointer 0 :adjustable t)
@@ -170,7 +170,6 @@
 (define-event-class pointer-exit-event (pointer-boundary-event) ())
 (define-event-class pointer-enter-event (pointer-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)
@@ -195,6 +194,12 @@
 
 (define-event-class timer-event (event) ())
 
+(define-event-class focus-event (event)
+  ((sheet :reader event-sheet :initarg :sheet)))
+
+(define-event-class focus-in-event (focus-event) ())
+(define-event-class focus-out-event (focus-event) ())
+
 
 ;;; Values used in event objects
 
diff --git a/silica/event.lisp b/silica/event.lisp
index 30487a8a4ac0af7eb9231c15bcb8852de020e08e..a5dcd42e1b2211d0dc2d9a5787c6a903c1c9cde8 100644
--- a/silica/event.lisp
+++ b/silica/event.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: event.lisp,v 1.34 93/03/31 10:39:34 cer Exp $
+;; $fiHeader: event.lisp,v 1.35 93/05/05 01:39:44 cer Exp $
 
 (in-package :silica)
 
@@ -23,8 +23,23 @@
   #+++ignore (warn "Ignoring event ~S on sheet ~S" sheet event)
   nil)
 
+(defgeneric port-input-focus-selection (port))
 (defgeneric port-keyboard-input-focus (port))
 
+(defgeneric note-sheet-gain-focus (sheet))
+(defgeneric note-sheet-lose-focus (sheet))
+
+(defmethod note-sheet-gain-focus ((sheet basic-sheet)) nil)
+(defmethod note-sheet-lose-focus ((sheet basic-sheet)) nil)
+
+(defmethod (setf port-keyboard-input-focus) :before (focus (port basic-port))
+  (let ((old-focus (port-keyboard-input-focus port)))
+    (when (and old-focus
+	       (not (eq focus old-focus)))
+      (note-sheet-lose-focus old-focus))
+    (when focus
+      (note-sheet-gain-focus focus))))
+
 (defclass sheet-with-event-queue-mixin ()
     ((event-queue :initform nil :initarg :event-queue
 		  :accessor sheet-event-queue)))
@@ -207,6 +222,8 @@
 	     (push sheet sheets))))
     (macrolet ((generate-enter-event (sheet kind)
 		 `(let ((sheet ,sheet))
+		    (when (eq (port-input-focus-selection port) :sheet-under-pointer)
+		      (setf (port-keyboard-input-focus port) sheet))
 		    (dispatch-event
 		      sheet
 		      (allocate-event 'pointer-enter-event
@@ -218,6 +235,10 @@
 			:pointer pointer))))
 	       (generate-exit-event (sheet kind)
 		 `(let ((sheet ,sheet))
+		    (when (and (eq (port-input-focus-selection port)
+				   :sheet-under-pointer)
+			       (eq (port-keyboard-input-focus port) sheet))
+		      (setf (port-keyboard-input-focus port) nil))
 		    (dispatch-event
 		      sheet
 		      (allocate-event 'pointer-exit-event
@@ -346,6 +367,8 @@
 	 (pointer (pointer-event-pointer event)))
     (macrolet ((generate-enter-event (sheet kind)
 		 `(let ((sheet ,sheet))
+		    (when (eq (port-input-focus-selection port) :sheet-under-pointer)
+		      (setf (port-keyboard-input-focus port) sheet))
 		    (dispatch-event
 		      sheet
 		      (allocate-event 'pointer-enter-event
@@ -357,6 +380,10 @@
 			:pointer pointer))))
 	       (generate-exit-event (sheet kind)
 		 `(let ((sheet ,sheet))
+		    (when (and (eq (port-input-focus-selection port)
+				   :sheet-under-pointer)
+			       (eq (port-keyboard-input-focus port) sheet))
+		      (setf (port-keyboard-input-focus port) nil))
 		    (dispatch-event
 		      sheet
 		      (allocate-event 'pointer-exit-event
@@ -469,7 +496,7 @@
 (defmethod distribute-event :before ((port basic-port) (event pointer-button-press-event))
   (let ((pointer (pointer-event-pointer event)))
     (setf (pointer-button-state pointer) 
-	  (logior (pointer-button-state pointer) (pointer-event-button event)))))
+      (logior (pointer-button-state pointer) (pointer-event-button event)))))
 
 (defmethod distribute-event :before ((port basic-port) (event pointer-button-release-event))
   (let ((pointer (pointer-event-pointer event)))
@@ -490,11 +517,17 @@
   (dispatch-event (event-sheet event) event))
 
 (defmethod distribute-event-1 ((port basic-port) (event keyboard-event))
-  (let ((focus (or (port-keyboard-input-focus port)
-		   (event-sheet event))))
-    ;;--- Is this correct???
-    (setf (slot-value event 'sheet) focus)
-    (dispatch-event focus event)))
+  (let ((sheet (port-keyboard-input-focus port)))
+    ;;---is it ok to setf an event's sheet??
+    (when sheet
+      (setf (slot-value event 'sheet) sheet)
+      (dispatch-event sheet event))))
+
+(defmethod distribute-event-1 ((port basic-port) (event focus-in-event))
+  (setf (port-keyboard-input-focus port) (event-sheet event)))
+
+(defmethod distribute-event-1 ((port basic-port) (event focus-out-event))
+  (setf (port-keyboard-input-focus port) nil))
 
 (defmethod distribute-event-1 ((port basic-port) (event window-event))
   (dispatch-event 
@@ -519,8 +552,14 @@
 		      (aref v (1- (fill-pointer v)))))))
     (dispatch-pointer-event-to-sheet port event sheet)))
 
-(defun dispatch-pointer-event-to-sheet (port event sheet)
-  (declare (ignore port))
+(defmethod dispatch-pointer-event-to-sheet :before 
+	   ((port basic-port) (event pointer-button-press-event) sheet)
+  (let ((button (pointer-event-button event)))
+    (when (and (eq (port-input-focus-selection port) :click-to-select)
+	       (eq button +pointer-left-button+))
+      (setf (port-keyboard-input-focus port) sheet))))
+  
+(defmethod dispatch-pointer-event-to-sheet ((port basic-port) (event event) sheet)
   (let ((event-type (class-name (class-of event)))
 	(x (pointer-event-native-x event))
 	(y (pointer-event-native-y event))
diff --git a/silica/pixmaps.lisp b/silica/pixmaps.lisp
index ab193987ebab2f8f9af71bb6aab28140e80a9652..469feefde08097dd2097eda3fdfec3bfe0552377 100644
--- a/silica/pixmaps.lisp
+++ b/silica/pixmaps.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: SILICA; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: pixmaps.lisp,v 1.15 93/02/08 15:57:36 cer Exp $
+;; $fiHeader: pixmaps.lisp,v 1.16 93/03/25 15:40:37 colin Exp $
 
 (in-package :silica)
 
@@ -10,11 +10,14 @@
 
 ;;; Pixmaps
 
-(defclass pixmap () ())
+(defclass pixmap () 
+  ((port :reader pixmap-port :initarg :port)))
 
 (defgeneric pixmap-width (pixmap))
 (defgeneric pixmap-height (pixmap))
 
+(defmethod port ((pixmap pixmap))
+  (pixmap-port pixmap))
 
 ;;; Pixmap mediums
 
@@ -40,12 +43,18 @@
     (medium-copy-area medium from-x from-y width height
 		      medium to-x to-y)))
 
-(defun copy-from-pixmap (pixmap pixmap-x pixmap-y width height
-			 medium medium-x medium-y)
+(defmethod copy-from-pixmap (pixmap pixmap-x pixmap-y width height
+			     (medium basic-medium) medium-x medium-y)
   (medium-copy-area pixmap pixmap-x pixmap-y width height
 		    medium medium-x medium-y))
 
-(defun copy-to-pixmap (medium medium-x medium-y width height
+(defmethod copy-from-pixmap (pixmap pixmap-x pixmap-y width height
+			     (sheet basic-sheet) medium-x medium-y)
+  (with-sheet-medium (medium sheet)
+    (medium-copy-area pixmap pixmap-x pixmap-y width height
+		      medium medium-x medium-y)))
+
+(defmethod copy-to-pixmap ((medium basic-medium) medium-x medium-y width height
 		       &optional pixmap (pixmap-x 0) (pixmap-y 0))
   (unless pixmap
     (setf pixmap (allocate-pixmap medium width height)))
@@ -53,6 +62,15 @@
 		    pixmap pixmap-x pixmap-y)
   pixmap)
 
+(defmethod copy-to-pixmap ((sheet basic-sheet) medium-x medium-y width height
+		       &optional pixmap (pixmap-x 0) (pixmap-y 0))
+  (with-sheet-medium (medium sheet)
+    (unless pixmap
+      (setf pixmap (allocate-pixmap medium width height)))
+    (medium-copy-area medium medium-x medium-y width height
+		      pixmap pixmap-x pixmap-y)
+    pixmap))
+
 
 ;;; Pixmap sheets
 
diff --git a/silica/text-style.lisp b/silica/text-style.lisp
index 41e18eb41440eda5fddbe4afbc588cf797e4e731..b5d4fc5039b9eb01720034f094f0df0003da30e1 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.17 92/12/07 12:15:24 cer Exp $
+;; $fiHeader: text-style.lisp,v 1.18 92/12/16 16:49:52 cer Exp $
 
 (in-package :silica)
 
@@ -664,15 +664,15 @@
 	  (let ((font-size (text-style-size (car tuple))))
 	    (if exact-size-required
 		(when (= size font-size)
-		  (return (cdr tuple)))
-		(when (<= size font-size)
-		  ;; Know which one to pick.
-		  (cond ((null last-tuple)
-			 (return (cadr tuple)))
-			((< (abs (- size font-size)) (abs (- size last-size)))
-			 (return (cadr tuple)))
-			(t
-			 (return (cadr last-tuple))))))
+		  (return (cadr tuple)))
+	      (when (<= size font-size)
+		;; Know which one to pick.
+		(cond ((null last-tuple)
+		       (return (cadr tuple)))
+		      ((< (abs (- size font-size)) (abs (- size last-size)))
+		       (return (cadr tuple)))
+		      (t
+		       (return (cadr last-tuple))))))
 	    (setq last-tuple tuple)
 	    (setq last-size font-size)))))))
 
diff --git a/test/test-suite.lisp b/test/test-suite.lisp
index 1c2a23ce5871fcbbe06214dcd8844ab1da3993a9..d6c15b39e5cee296dc77b30d86211c1970ee9966 100644
--- a/test/test-suite.lisp
+++ b/test/test-suite.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-USER; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: test-suite.lisp,v 1.62 93/04/23 09:18:17 cer Exp $
+;; $fiHeader: test-suite.lisp,v 1.63 93/05/13 16:24:24 cer Exp $
 
 (in-package :clim-user)
 
@@ -761,13 +761,16 @@ people, shall not perish from the earth.
 		      (draw-text* ps "hello" 10 50)))))
       (dotimes (i 5)
 	(sleep 0.25)
-	(copy-from-pixmap pixmap 0 0 100 100 medium (* i 100) (* i 100))))
+	(copy-from-pixmap pixmap 0 0 100 100 stream (* i 100) (* i 100)))
+      (deallocate-pixmap pixmap))
     (dotimes (j 5)
       (let ((pixmap (copy-to-pixmap medium (* j 100) (* j 100) 100 100)))
 	(dotimes (i 5)
 	  (unless (= i j)
 	    (sleep 0.25)
-	    (copy-from-pixmap pixmap 0 0 100 100 medium (* j 100) (* i 100))))))))
+	    (copy-from-pixmap pixmap 0 0 100 100 medium (* j 100) (* i 100))))
+	(deallocate-pixmap pixmap)))))
+
 
 #+allegro
 (define-test (read-image-test graphics) (stream)
@@ -2034,6 +2037,16 @@ Luke Luck licks the lakes Luke's duck likes."))
 		      :default x))
       (terpri stream))))
 
+(define-test (window-stream menus-and-dialogs) (stream)
+  "Simple test of open-window-stream"
+  (declare (ignore stream))
+  (let ((w (open-window-stream)))
+    (window-expose w)
+    (sleep 0.1)				; so why do I need this?
+    (write-string "A window stream" w)
+    (sleep 2)
+    (destroy-frame (pane-frame w))))
+
 (define-test (slider-dialog menus-and-dialogs) (stream)
   "Various sliders"
   (let ((d 0.5)
diff --git a/tk-silica/ol-frames.lisp b/tk-silica/ol-frames.lisp
index 0cff1dc5d84e3ae5405e92a7843483feadb0a63f..cea90d8d396be37fb11d6bb67c5d1c738a906d22 100644
--- a/tk-silica/ol-frames.lisp
+++ b/tk-silica/ol-frames.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-frames.lisp,v 1.22 93/03/31 10:40:10 cer Exp $
+;; $fiHeader: ol-frames.lisp,v 1.23 93/04/08 13:18:52 colin Exp $
 
 
 (in-package :xm-silica)
@@ -63,7 +63,7 @@
 	    row-wise
 	    n-columns
 	    n-rows)
-  (declare (ignore gesture))
+  (declare (ignore gesture row-wise n-columns n-rows))
   (let* (value-returned 
 	 return-value
 	 (simplep (and (null printer)
diff --git a/tk-silica/ol-gadgets.lisp b/tk-silica/ol-gadgets.lisp
index d31bb52c97da379a55dd24a3d204d068fcb7258a..6a413ac616413db7b7c7cde1cfa4d670c3f7b926 100644
--- a/tk-silica/ol-gadgets.lisp
+++ b/tk-silica/ol-gadgets.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-gadgets.lisp,v 1.48 1993/05/05 01:40:28 cer Exp $
+;; $fiHeader: ol-gadgets.lisp,v 1.49 93/05/13 16:24:53 cer Exp $
 
 
 (in-package :xm-silica)
@@ -587,9 +587,6 @@
       (tk::add-event-handler edit-widget
 			     '(:focus-change)
 			     1
-			     ;; this should eventually be
-			     ;; sheet-mirror-event-handler once all
-			     ;; the focus stuff works
 			     'openlook-text-field-event-handler
 			     sheet))))
 
@@ -1795,10 +1792,11 @@
 		      :accelerator-text accel-text))))
 
 (defmethod discard-accelerator-event-p ((port openlook-port) (event t))
-  ;;-- There are a whole bunch of other keysyms that need to be ignored.
-  ;;-- Perhaps in OLIT there is a way of getting the actual keysym.
-  ;;-- Perhaps we need a way of representing them in the clim world
-  (call-next-method))
+  (or (call-next-method)
+      ;;-- There are a whole bunch of other keysyms that need to be ignored.
+      ;;-- Perhaps in OLIT there is a way of getting the actual keysym.
+      ;;-- Perhaps we need a way of representing them in the clim world
+      (member (keyboard-event-key-name event) '(:tab))))
 
 (defmethod frame-manager-notify-user ((framem openlook-frame-manager)
 				      message-string 
diff --git a/tk-silica/ol-silica.lisp b/tk-silica/ol-silica.lisp
index 4ac109fc0fd82d5b9a5f1ff845db80325f31c850..8f0c1902709356cf1cabb5995f67e1fb9a4ae512 100644
--- a/tk-silica/ol-silica.lisp
+++ b/tk-silica/ol-silica.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-silica.lisp,v 1.18 93/04/27 14:36:07 cer Exp $
+;; $fiHeader: ol-silica.lisp,v 1.19 93/05/13 16:24:56 cer Exp $
 
 (in-package :xm-silica)
 
@@ -35,17 +35,9 @@
 
 (setq *default-server-path* '(:openlook))
 
-(defmethod make-cursor-widget-for-port ((port openlook-port) parent)
-  (make-instance 'tk::draw-area
-		 :parent parent
-		 :background (tk::get-values parent :foreground)
-		 :width 2
-		 :height 11
-		 :managed t))
-
-(defmethod port-note-cursor-change :after ((port openlook-port)
-					   cursor stream type old new)
-  (declare (ignore old type cursor))
+(defmethod port-note-cursor-change :after
+    ((port openlook-port) cursor stream (type (eql 'cursor-focus)) old new)
+  (declare (ignore cursor old))
   (when new 
     (let ((mirror (sheet-mirror stream)))
       (when mirror 
@@ -94,7 +86,6 @@
 		 (append
 		  (let ((x (find-shell-of-calling-frame sheet)))
 		    (and x `(:transient-for ,x)))
-		  '(:keyboard-focus-policy :pointer)
 		  (and (typep (pane-frame sheet)
 			   'clim-internals::menu-frame)
 		    '(:override-redirect t)))))
@@ -112,3 +103,6 @@
   ;; Only do this if its the top most widget being destroyed or we are
   ;; screwing around with the tree in someway
   (xt::unmanage-child (sheet-direct-mirror sheet)))
+
+(defun ol-get-focus-widget (widget)
+  (tk::intern-widget (tk::ol_get_current_focus_widget widget)))
diff --git a/tk-silica/xm-gadgets.lisp b/tk-silica/xm-gadgets.lisp
index 306d01c81b19fd4ab966e9bf4df4ffadb3a1df21..93442e5ec654ae49a1ccefe3043f04502428f4f1 100644
--- a/tk-silica/xm-gadgets.lisp
+++ b/tk-silica/xm-gadgets.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-gadgets.lisp,v 1.73 1993/05/05 01:40:32 cer Exp $
+;; $fiHeader: xm-gadgets.lisp,v 1.74 93/05/13 16:25:00 cer Exp $
 
 (in-package :xm-silica)
 
@@ -196,10 +196,10 @@
                     :expose-callback 
                     'sheet-mirror-exposed-callback
                     sheet)
-  (tk::add-callback widget 
-                    :input-callback 
-                    'sheet-mirror-input-callback
-                    sheet)
+  (tk::add-callback widget
+		    :input-callback 
+		    'sheet-mirror-input-callback
+		    sheet)
   (tk::add-event-handler widget
                          '(:enter-window 
                            :leave-window
@@ -216,6 +216,7 @@
                          'sheet-mirror-event-handler
                          sheet))
 
+
 ;;-- This is identical to the method for label
 
 (defmethod compose-space ((sheet motif-push-button) &key width height)
@@ -483,6 +484,7 @@
 (defmethod find-widget-class-and-initargs-for-sheet ((port motif-port)
                                                      (parent t)
                                                      (sheet top-level-sheet))
+
   (cond 
    ;;--- hack alert
    ;; Seems that we need to use a bulletin board so that everything
@@ -1723,7 +1725,7 @@
       ;;-- ignored too but there does not appear to be an easy way
       ;;-- of going from the osf name to the keysym that we need to ignore
       ;;--  osfMenuBar
-      (member (keyboard-event-key-name event) '(:f10))))
+      (member (keyboard-event-key-name event) '(:f10 :tab))))
 
 
 (defmethod set-button-accelerator-from-keystroke ((menubar motif-menu-bar) button keystroke)
@@ -1743,3 +1745,5 @@
       (tk::set-values button 
                       :accelerator accel
                       :accelerator-text accel-text))))
+
+
diff --git a/tk-silica/xm-silica.lisp b/tk-silica/xm-silica.lisp
index 34d0201b80de2d8925be9285c9175ef90a14a389..1a693b20e796e327721bdae3679c048138402683 100644
--- a/tk-silica/xm-silica.lisp
+++ b/tk-silica/xm-silica.lisp
@@ -18,7 +18,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-silica.lisp,v 1.34 93/04/07 09:07:25 cer Exp $
+;; $fiHeader: xm-silica.lisp,v 1.35 93/04/16 09:46:02 cer Exp $
 
 (in-package :xm-silica)
 
@@ -57,36 +57,29 @@
 
 (defclass motif-geometry-manager (xt-geometry-manager) ())
 
+
+(defmethod change-widget-geometry ((parent tk::xm-dialog-shell) child
+				   &rest args
+				   &key x y width height)
+  (declare (ignore x y args))
+  (tk::set-values child :width width :height height :x x :y y))
+
 (defmethod find-shell-class-and-initargs ((port motif-port) sheet)
-  (if (popup-frame-p sheet)
-      (values 'tk::xm-dialog-shell
-	      (append
-	       (let ((x (find-shell-of-calling-frame sheet)))
-		 (and x `(:transient-for ,x)))
-	       '(:keyboard-focus-policy :pointer)
-	       (and (typep (pane-frame sheet)
-			   'clim-internals::menu-frame)
-		    '(:override-redirect t))))
-    (call-next-method)))
-
-(defmethod make-cursor-widget-for-port ((port motif-port) parent)
-  (make-instance 'tk::xm-my-drawing-area
-		 :parent parent
-		 :background (tk::get-values parent :foreground)
-		 :width 2
-		 :height 11
-		 :managed t))
-
-#+ignore 
-(ff:defforeign 'xmprocesstraversal
-    :entry-point (ff:convert-to-lang "_XmProcessTraversal"))
-
-#+ignore 
-(defmethod port-note-cursor-change :after ((port motif-port)
-					   cursor stream type old new)
-  (declare (ignore old type cursor))
-  (when new
-    (xmprocesstraversal (sheet-mirror stream) 0)))
+  (multiple-value-bind (class initargs)
+      (if (popup-frame-p sheet)
+	  (values 'tk::xm-dialog-shell
+		  (append
+		   (let ((x (find-shell-of-calling-frame sheet)))
+		     (and x `(:transient-for ,x)))
+		   (and (typep (pane-frame sheet)
+			       'clim-internals::menu-frame)
+			'(:override-redirect t))))
+	(call-next-method))
+    (values class `(:keyboard-focus-policy 
+		    ,(ecase (port-input-focus-selection port)
+		       (:click-to-select :explicit)
+		       (:sheet-under-pointer :pointer))
+		    ,@initargs))))
 
 (defmethod enable-xt-widget ((parent tk::xm-dialog-shell) (mirror t))
   ;; this is a nasty hack just to make sure that the child is managed.
@@ -96,7 +89,6 @@
   (popup (widget-parent mirror)))
 
 
-
 (ff:defun-c-callable my-drawing-area-query-geometry-stub ((widget :unsigned-long)
 							  (intended :unsigned-long)
 							  (desired :unsigned-long))
@@ -137,3 +129,54 @@
     (return-from my-drawing-area-query-geometry tk::xt-geometry-almost)))
 
 
+;;; hacks for explicit focus
+
+(defmethod note-sheet-tree-grafted :after ((port motif-port)
+					   (sheet clim-stream-sheet))
+  ;; this is a hack which enables this child widget to take input
+  ;; events in the presence of explicit focus.
+  (let ((cursor (stream-text-cursor sheet))
+	(widget (sheet-mirror sheet)))
+    (when cursor
+      (let ((input-widget (make-instance 'tk::xm-my-drawing-area
+					 :parent widget
+					 :background (tk::get-values widget
+								     :background)
+					 :width 1
+					 :height 1
+					 :managed (cursor-active cursor))))
+	(with-slots (clim-internals::plist) cursor
+	  (setf (getf clim-internals::plist :input-widget) input-widget)
+	  (tk::add-callback input-widget
+			    :input-callback 
+			    'sheet-mirror-input-callback
+			    sheet)
+	  (tk::add-event-handler input-widget
+				 '(:focus-change)
+				 1
+				 'sheet-mirror-event-handler
+				 sheet))))))
+
+(defmethod port-note-cursor-change :after 
+	   ((port motif-port) cursor stream (type (eql 'cursor-active)) old new)
+  (declare (ignore stream old))
+  (let* ((plist (slot-value cursor 'clim-internals::plist))
+	 (input-widget (getf plist :input-widget)))
+    (when input-widget
+      (if new
+	  (tk::manage-child input-widget)
+	(tk::unmanage-child input-widget)))))
+
+(defmethod port-note-cursor-change :after
+	   ((port motif-port) cursor stream (type (eql 'cursor-focus)) old new)
+  (declare (ignore stream old))
+  (when new
+    (let* ((plist (slot-value cursor 'clim-internals::plist))
+	   (input-widget (getf plist :input-widget)))
+      (when input-widget
+	(tk::xm_process_traversal input-widget 0)))))
+
+(defun xm-get-focus-widget (widget)
+  (tk::intern-widget (tk::xm_get_focus_widget widget)))
+
+
diff --git a/tk-silica/xt-graphics.lisp b/tk-silica/xt-graphics.lisp
index a382b38d1ae069c84cab2aeb2f5abae188600bee..b7bf730966840c02666bf7d015eed4e53d118ea5 100644
--- a/tk-silica/xt-graphics.lisp
+++ b/tk-silica/xt-graphics.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-graphics.lisp,v 1.71 93/04/12 21:22:25 colin Exp $
+;; $fiHeader: xt-graphics.lisp,v 1.72 93/05/13 16:25:03 cer Exp $
 
 (in-package :tk-silica)
 
@@ -99,22 +99,22 @@
    (white-pixel :initarg :white-pixel)
    (black-pixel :initarg :black-pixel)))
 
-(defun make-xt-palette (port colormap)
+
+(defmethod make-palette ((port xt-port) &key colormap)
   (let* ((display (port-display port))
 	 (screen (tk::display-screen-number display)))
     (make-instance 'xt-palette
-		   :port port
-		   :colormap colormap
-		   :dynamic-p (and 
-			       (member (port-visual-class port)
-				       '(:gray-scale :pseudo-color :direct-color))
-			       t)
-		   :color-p (port-color-p port)
-		   :white-pixel (x11:xwhitepixel display screen)
-		   :black-pixel (x11:xblackpixel display screen))))
-
-(defmethod make-palette ((port xt-port) &key)
-  (make-xt-palette port (tk::create-colormap (port-display port))))
+      :port port
+      :colormap (or colormap
+		    (tk::create-colormap (port-display port)))
+      :dynamic-p (and 
+		  (member (port-visual-class port)
+			  '(:gray-scale :pseudo-color :direct-color))
+		  t)
+      :color-p (port-color-p port)
+      :white-pixel (x11:xwhitepixel display screen)
+      :black-pixel (x11:xblackpixel display screen))))
+
 
 (defmethod medium-palette ((medium xt-medium))
   (let ((frame (pane-frame (medium-sheet medium))))
diff --git a/tk-silica/xt-pixmaps.lisp b/tk-silica/xt-pixmaps.lisp
index 014558b76a76767c798c6f4fecfe4d1f4cabb794..4a3fc9ea55a394eac653d7bc27b09d182d11a6ae 100644
--- a/tk-silica/xt-pixmaps.lisp
+++ b/tk-silica/xt-pixmaps.lisp
@@ -20,31 +20,35 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-pixmaps.lisp,v 1.14 93/02/08 15:58:17 cer Exp $
+;; $fiHeader: xt-pixmaps.lisp,v 1.15 93/02/10 10:04:31 cer Exp $
 
 
 (in-package :xm-silica)
 
+(defclass xt-pixmap (tk::pixmap pixmap)
+  ())
+
 (defmethod port-allocate-pixmap ((port xt-port) medium width height)
   (declare (ignore medium))
   (fix-coordinates width height)
   (let ((root (tk::display-root-window (port-display port))))
-    (make-instance 'tk::pixmap
+    (make-instance 'xt-pixmap
       :drawable root
       :width width
       :height height
-      :depth (tk::drawable-depth root))))
+      :depth (tk::drawable-depth root)
+      :port port)))
 
-(defmethod port-deallocate-pixmap ((port xt-port) (pixmap tk::pixmap))
+(defmethod port-deallocate-pixmap ((port xt-port) (pixmap xt-pixmap))
   (x11:xfreepixmap (port-display port) pixmap))
 
-(defmethod pixmap-width ((pixmap tk::pixmap))
+(defmethod pixmap-width ((pixmap xt-pixmap))
   (tk::pixmap-width pixmap))
 
-(defmethod pixmap-height ((pixmap tk::pixmap))
+(defmethod pixmap-height ((pixmap xt-pixmap))
   (tk::pixmap-height pixmap))
 
-(defmethod pixmap-depth ((pixmap tk::pixmap))
+(defmethod pixmap-depth ((pixmap xt-pixmap))
   (tk::pixmap-depth pixmap))
 
 
@@ -116,7 +120,7 @@
 
 
 (defmethod medium-copy-area 
-	   ((pixmap tk::pixmap) from-x from-y width height
+	   ((pixmap xt-pixmap) from-x from-y width height
 	    (to-medium xt-medium) to-x to-y)
   (let ((transform (sheet-native-transformation (medium-sheet to-medium))))
     (convert-to-device-coordinates transform to-x to-y)
@@ -129,7 +133,7 @@
 
 (defmethod medium-copy-area 
 	   ((from-medium xt-medium) from-x from-y width height
-				    (pixmap tk::pixmap) to-x to-y)
+				    (pixmap xt-pixmap) to-x to-y)
   ;;; What about the graphics exposure event problem
   (let ((transform (sheet-native-transformation (medium-sheet from-medium))))
     (convert-to-device-coordinates transform from-x from-y)
@@ -140,30 +144,4 @@
 	window copy-gc from-x from-y width height 
 	pixmap to-x to-y))))
 
-;;; I dont understand the need for these methods
-;;; Also what is the xt-pixmap class below.
 
-#+ignore
-(defmethod medium-copy-area 
-	   ((from-medium xt-medium) from-x from-y width height
-	    (pixmap tk::pixmap) to-x to-y)
-  (let ((transform (sheet-native-transformation (medium-sheet from-medium))))
-    (convert-to-device-coordinates transform from-x from-y)
-    (convert-to-device-distances transform width height)
-    (let ((window (medium-drawable from-medium))
-	  (copy-gc (make-instance 'tk::gcontext :drawable window)))
-      (tk::copy-area 
-	window copy-gc from-x from-y width height 
-	pixmap to-x to-y))))
-
-#+ignore
-(defmethod medium-copy-area 
-	   ((pixmap tk::pixmap) from-x from-y width height
-	    (to-medium xt-medium) to-x to-y)
-  (let ((transform (sheet-native-transformation (medium-sheet to-medium))))
-    (convert-to-device-coordinates transform to-x to-y)
-    (let ((window (medium-drawable to-medium))
-	  (copy-gc (make-instance 'tk::gcontext :drawable window)))
-      (tk::copy-area 
-	pixmap copy-gc from-x from-y width height
-	window to-x to-y))))
diff --git a/tk-silica/xt-silica.lisp b/tk-silica/xt-silica.lisp
index fa31e138c523657d03aac3cb6babb852f6087912..f2e87b0a82466bd59245383069dbb09a34b6804f 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.81 1993/05/05 01:40:38 cer Exp $
+;; $fiHeader: xt-silica.lisp,v 1.82 93/05/13 16:25:07 cer Exp $
 
 (in-package :xm-silica)
 
@@ -126,7 +126,8 @@
 		  (port-depth port) (x11:xdefaultdepth display (tk::display-screen-number display))
 		  (port-visual-class port) (tk::screen-root-visual-class (tk::default-screen display))
 		  (slot-value port 'silica::default-palette) 
-		  (make-xt-palette port (tk::default-colormap (port-display port))))
+		  (make-palette port :colormap 
+				(tk::default-colormap (port-display port))))
 	    (let* ((screen (x11:xdefaultscreenofdisplay display))
 		   (bs-p (not (zerop (x11::screen-backing-store screen))))
 		   (su-p (not (zerop (x11::screen-save-unders screen))))
@@ -432,7 +433,11 @@
 			     :native-x native-x
 			     :native-y native-y
 			     :modifier-state 
-			     (state->modifiers state)))))))
+			     (state->modifiers state))))
+	  (:focus-in
+	   (allocate-event 'focus-in-event :sheet sheet))
+	  (:focus-out
+	   (allocate-event 'focus-out-event :sheet sheet)))))
     (when clim-event
       (distribute-event port clim-event))))
 
@@ -608,6 +613,10 @@
 	    (getf initargs :height) (fix-coordinate (- bottom top)))))
   initargs)
 
+(defmethod initialize-shell ((port xt-port) sheet widget)
+  (declare (ignore sheet widget))
+  nil)
+
 ;; If we are creating a top level sheet then we have to create a shell for it
 (defmethod find-widget-parent ((port xt-port) sheet)
   (let ((ma (sheet-mirrored-ancestor sheet)))
@@ -617,9 +626,13 @@
 	  (let ((frame (pane-frame sheet)))
 	    (when frame
 	      (setf (getf initargs :name) (string (frame-name frame))
-		    (getf initargs :title) (frame-pretty-name frame))))
-	  (apply #'make-instance class :parent (find-shell-parent port sheet) initargs))
-        (sheet-mirror-for-parenting ma))))
+		    (getf initargs :title) (frame-pretty-name
+					    frame)))
+	    (let ((shell (apply #'make-instance class 
+				:parent (find-shell-parent port sheet) initargs)))
+	      (initialize-shell port sheet shell)
+	      shell)))
+      (sheet-mirror-for-parenting ma))))
 
 (defmethod sheet-mirror-for-parenting ((sheet basic-sheet))
   ;; There might be a situation where a sheet is mirrored by a whil
@@ -646,21 +659,19 @@
 
 (defmethod find-shell-class-and-initargs ((port xt-port) (sheet t))
   (values 'top-level-shell 
-	  ;; Need this so that an interactive pane can have children
-	  ;; but still accept the focus
-	  `(:keyboard-focus-policy :pointer)))
+	  '(:input t)))
 
 (defmethod find-shell-class-and-initargs :around ((port xt-port) (sheet pane))
   (let* ((palette (frame-manager-palette (frame-manager (pane-frame sheet)))))
-    (multiple-value-bind
-	(class initargs)
+    (multiple-value-bind (class initargs)
 	(call-next-method)
       (values class
-	      `(:allow-shell-resize ,(and (pane-frame sheet)
-					  (clim-internals::frame-resizable (pane-frame sheet)))
-				    ,@initargs 
-				    ,@(and (not (eq (port-default-palette port) palette))
-					   `(:colormap ,(palette-colormap palette))))))))
+	      `(:allow-shell-resize 
+		,(and (pane-frame sheet)
+		      (clim-internals::frame-resizable (pane-frame sheet)))
+		,@(and (not (eq (port-default-palette port) palette))
+		       `(:colormap ,(palette-colormap palette)))
+		,@initargs)))))
 
 
 (defmethod enable-mirror ((port xt-port) (sheet t))
diff --git a/tk/ol-funs.lisp b/tk/ol-funs.lisp
index bd91c0641fb2a9fe08081dfa7d9026647042ebaf..0dde2d712053948cfb738c4da41bcc1892601a7e 100644
--- a/tk/ol-funs.lisp
+++ b/tk/ol-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: ol-funs.lisp,v 1.8 92/12/14 15:03:59 cer Exp $
+;; $fiHeader: ol-funs.lisp,v 1.9 93/03/31 10:40:00 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -70,6 +70,20 @@
     :arg-checking nil
     :return-type :void)
 
+(defforeign 'ol_call_accept_focus
+    :entry-point (ff:convert-to-lang "OlCallAcceptFocus")
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
+(defforeign 'ol_can_accept_focus
+    :entry-point (ff:convert-to-lang "OlCanAcceptFocus")
+    :call-direct t
+    :arguments '(foreign-address integer)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
 (defforeign 'ol_set_input_focus
     :entry-point (ff:convert-to-lang "OlSetInputFocus")
     :call-direct t
@@ -77,6 +91,20 @@
     :arg-checking nil
     :return-type :void)
 
+(defforeign 'ol_move_focus
+    :entry-point (ff:convert-to-lang "OlMoveFocus")
+    :call-direct t
+    :arguments '(foreign-address fixnum integer)
+    :arg-checking nil
+    :return-type :void)
+
+(defforeign 'ol_get_current_focus_widget
+    :entry-point (ff:convert-to-lang "OlGetCurrentFocusWidget")
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
+
 (defforeign 'ol_menu_post
     :entry-point (ff:convert-to-lang "OlMenuPost")
     :call-direct t
diff --git a/tk/resources.lisp b/tk/resources.lisp
index 80354b8fe7828378daab2d8152f6f42db19cd4d1..b2cc0b67cfbd6b279e06aaff5bc27f274cdf4e8c 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.44 93/04/16 09:45:49 cer Exp $
+;; $fiHeader: resources.lisp,v 1.45 93/05/13 16:24:38 cer Exp $
 
 (in-package :tk)
 
@@ -562,6 +562,12 @@
 (defmethod convert-resource-out ((parent t) (type (eql 'boolean)) value)
   (if value 1 0))
 
+;; so why does ol descide to call this resource type boolean rather
+;; than bool? Who knows? -cim
+
+(defmethod convert-resource-out ((parent t) (type (eql 'bool)) value)
+  (if value 1 0))
+
 (defmethod convert-resource-out ((parent  t) (type (eql 'string)) value)
   (string-to-char* value))
 
diff --git a/tk/xlib.lisp b/tk/xlib.lisp
index 3d3bf912b97b05619c902e57b011f6fee3ba03aa..2a942d2a8aabcf37505c17c432a00fa54f07473b 100644
--- a/tk/xlib.lisp
+++ b/tk/xlib.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xlib.lisp,v 1.44 1993/05/05 01:40:19 cer Exp $
+;; $fiHeader: xlib.lisp,v 1.45 93/05/13 16:24:40 cer Exp $
 
 (in-package :tk)
 
@@ -491,6 +491,17 @@
    'screen
    :display display))
 
+(defun get-input-focus (display)
+  (with-ref-par
+      ((focus 0)
+       (revert-to 0))
+    (x11:xgetinputfocus display focus revert-to)
+    (values (aref focus 0) (aref revert-to 0))))
+
+(defun set-input-focus (display focus &optional (revert-to 0) (time 0))
+  (x11:xsetinputfocus display focus revert-to time))
+
+
 (defun query-pointer (window)
   (with-ref-par 
       ((root 0)
diff --git a/tk/xm-funs.lisp b/tk/xm-funs.lisp
index 90d44ac41fd1ede070c9a20604c5f8e3972b5929..4f284bf138ed132df9064642a7c2a4c9aaadf936 100644
--- a/tk/xm-funs.lisp
+++ b/tk/xm-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xm-funs.lisp,v 1.8 93/04/27 14:36:00 cer Exp $
+;; $fiHeader: xm-funs.lisp,v 1.9 93/05/05 01:40:21 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -156,8 +156,19 @@
     :arg-checking nil
     :return-type :void)
 
+(defforeign 'xm_get_focus_widget
+    :entry-point (ff:convert-to-lang "XmGetFocusWidget")
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
-
+(defforeign 'xm_is_traversable
+    :entry-point (ff:convert-to-lang "XmIsTraversable")
+    :call-direct t
+    :arguments '(foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (defforeign 'xm_font_list_append_entry
     :entry-point (ff:convert-to-lang "XmFontListAppendEntry")
@@ -175,8 +186,6 @@
     :arg-checking nil
     :return-type :unsigned-integer)
 
-
-
 (defforeign 'xm_font_list_entry_get_font
     :entry-point (ff:convert-to-lang "XmFontListEntryGetFont")
     :call-direct t
diff --git a/tk/xt-funs.lisp b/tk/xt-funs.lisp
index 7f45c20ab6c2ba9dbf7521614001c4603e7a0902..c755e0a79c9fc61c17d5ff88bc1309d6cd65e0db 100644
--- a/tk/xt-funs.lisp
+++ b/tk/xt-funs.lisp
@@ -20,7 +20,7 @@
 ;; 52.227-19 or DOD FAR Supplement 252.227-7013 (c) (1) (ii), as
 ;; applicable.
 ;;
-;; $fiHeader: xt-funs.lisp,v 1.16 93/01/11 15:46:02 colin Exp $
+;; $fiHeader: xt-funs.lisp,v 1.17 93/05/13 16:24:42 cer Exp $
 
 ;;
 ;; This file contains compile time only code -- put in clim-debug.fasl.
@@ -369,6 +369,12 @@
     :arg-checking nil
     :return-type :unsigned-integer)
 
+(defforeign 'xt_set_keyboard_focus
+    :entry-point (ff:convert-to-lang "XtSetKeyboardFocus")
+    :call-direct t
+    :arguments '(foreign-address foreign-address)
+    :arg-checking nil
+    :return-type :unsigned-integer)
 
 (ff:defforeign 'init_clim_gc_cursor_stuff
     :call-direct t
diff --git a/utils/designs.lisp b/utils/designs.lisp
index f366ad5ecf0a8a705c631cff8b7b456fd67afd33..cd808a44e3d4b5bd130ed7b8dc0c23454585bc2a 100644
--- a/utils/designs.lisp
+++ b/utils/designs.lisp
@@ -1,6 +1,6 @@
 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-UTILS; Base: 10; Lowercase: Yes -*-
 
-;; $fiHeader: designs.lisp,v 1.13 92/11/19 14:25:41 cer Exp $
+;; $fiHeader: designs.lisp,v 1.14 92/12/03 10:30:37 cer Exp $
 
 (in-package :clim-utils)
 
@@ -320,7 +320,7 @@
 	       (palette-full-palette condition)))))
 )	;eval-when
 
-(defmethod add-color-to-palette ((palette basic-palette) &rest colors)
+(defmethod add-colors-to-palette ((palette basic-palette) &rest colors)
   (declare (dynamic-extent colors))
   (let ((colors-done nil))
     (dolist (color colors)
@@ -333,7 +333,7 @@
 	   (deallocate-color color palette))
 	 (error condition))))))
 
-(defmethod remove-color-from-palette ((palette basic-palette) &rest colors)
+(defmethod remove-colors-from-palette ((palette basic-palette) &rest colors)
   (declare (dynamic-extent colors))
   (dolist (color colors)
     (deallocate-color color palette)))
diff --git a/utils/packages.lisp b/utils/packages.lisp
index 2cf1764fc24503b9e56cdbb43592c8e3b41cdce6..9b943c578511e782344e4544901d9acdfda13ebc 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.52 93/04/02 18:41:13 cer Exp $
+;; $fiHeader: packages.lisp,v 1.53 93/04/27 14:36:16 cer Exp $
 
 (in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user)
 
@@ -1760,6 +1760,9 @@
     fetch-clipping-region
     find-graft
     find-port
+    focus-event
+    focus-in-event
+    focus-out-event
     graft
     graft-height
     graft-orientation
@@ -1819,6 +1822,8 @@
     note-sheet-disowned
     note-sheet-enabled
     note-sheet-grafted
+    note-sheet-gain-focus
+    note-sheet-lose-focus
     note-sheet-region-changed
     note-sheet-transformation-changed
     permanent-medium-sheet-output-mixin
@@ -2071,7 +2076,7 @@
     pattern-width
     
     ;; Palettes
-    add-color-to-palette
+    add-colors-to-palette
     frame-manager-palette
     frame-palette
     make-palette
@@ -2081,7 +2086,7 @@
     palette-full
     palettep
     port-default-palette
-    remove-color-from-palette
+    remove-colors-from-palette
 
     ;; Extended output
     beep