Index: frames.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/frames.lisp,v
retrieving revision 1.123
diff -u -r1.123 frames.lisp
--- frames.lisp	4 Jan 2007 09:13:25 -0000	1.123
+++ frames.lisp	25 Jan 2007 16:58:00 -0000
@@ -129,8 +129,7 @@
    (manager :initform nil
 	    :reader frame-manager
             :accessor %frame-manager)
-   (keyboard-input-focus :initform nil
-                         :accessor keyboard-input-focus)
+   (keyboard-input-focus :initform nil :accessor frame-keyboard-input-focus)
    (properties :accessor %frame-properties
 	       :initarg :properties
 	       :initform nil)
@@ -998,6 +997,14 @@
 					  x y
 					  :frame frame :event event))
 
+(defmethod frame-input-context-button-press-handler :before
+    ((frame standard-application-frame) (stream interactor-pane) button-press-event)
+  (let ((previous (stream-set-input-focus stream)))
+    (when (and previous (typep previous 'gadget))
+      (let ((client (gadget-client previous))
+            (id (gadget-id previous)))
+      (disarmed-callback previous client id)))))
+
 (defmethod frame-input-context-button-press-handler
     ((frame standard-application-frame)
      (stream output-recording-stream)
@@ -1322,13 +1329,9 @@
   `(let ((,frame *application-frame*))
      ,@body))
 
-
 (defmethod note-input-focus-changed (pane state)
   (declare (ignore pane state)))
 
-(defmethod (setf keyboard-input-focus) :after (focus frame)
-  (%set-port-keyboard-focus (port frame) focus))
-
 (defmethod (setf client-setting) (value frame setting)
   (setf (getf (client-settings frame) setting) value))
 
Index: panes.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/panes.lisp,v
retrieving revision 1.178
diff -u -r1.178 panes.lisp
--- panes.lisp	23 Jan 2007 07:51:10 -0000	1.178
+++ panes.lisp	25 Jan 2007 16:58:00 -0000
@@ -2587,10 +2587,16 @@
 	  (copy-area pane  srcx srcy (- x2 x1) (- y2 y1) destx desty))))))
 
 (defmethod stream-set-input-focus ((stream clim-stream-pane))
-  (with-slots (port) stream
+  (let ((frame (pane-frame stream)))
     (prog1
-	(port-keyboard-input-focus port)
-      (setf (port-keyboard-input-focus port) stream))))
+	(frame-keyboard-input-focus frame)
+      (setf (frame-keyboard-input-focus frame) stream))))
+
+(defmethod stream-set-input-focus ((stream null))
+  (let ((frame *application-frame*))
+    (prog1
+        (frame-keyboard-input-focus frame)
+      (setf (frame-keyboard-input-focus frame) nil))))
 
 ;;; output any buffered stuff before input
 
@@ -2638,6 +2644,14 @@
 #+ignore  (let ((cursor (stream-text-cursor pane)))
     (setf (cursor-visibility cursor) t)))
 
+(defmethod handle-event :before 
+    ((pane interactor-pane) (event pointer-button-press-event))
+  (let ((previous (stream-set-input-focus pane)))
+    (when (and previous (typep previous 'gadget))
+      (let ((client (gadget-client previous))
+            (id (gadget-id previous)))
+      (disarmed-callback previous client id)))))
+
 ;;; APPLICATION PANES
 
 (defclass application-pane (clim-stream-pane)
Index: ports.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/ports.lisp,v
retrieving revision 1.54
diff -u -r1.54 ports.lisp
--- ports.lisp	24 Dec 2006 14:27:43 -0000	1.54
+++ ports.lisp	25 Jan 2007 16:58:00 -0000
@@ -49,9 +49,6 @@
    (mirror->sheet :initform (make-hash-table :test #'eq))
    (pixmap->mirror :initform (make-hash-table :test #'eq))
    (mirror->pixmap :initform (make-hash-table :test #'eq))
-   #+ignore (keyboard-input-focus :initform nil ;; nuked this, see below
-			 :initarg :keyboard-input-focus
-			 :accessor port-keyboard-input-focus)
    (event-process
     :initform nil
     :initarg  :event-process
@@ -69,49 +66,6 @@
 		  :documentation "The sheet the pointer is over, if any")
    ))
 
-;; Keyboard focus is now managed per-frame rather than per-port,
-;; which makes a lot of sense (less sense in the presense of
-;; multiple top-level windows, but no one does that yet). The CLIM
-;; spec suggests this in a "Minor Issue". So, redirect
-;; PORT-KEYBOARD-INPUT-FOCUS to the current application frame
-;; for compatibility.
-
-;; Note: This would prevent you from using the function the
-;; function to query who currently has the focus. I don't
-;; know if this is an intended use or not.
-
-;; The big picture:
-;;   PORT-KEYBOARD-INPUT-FOCUS is defined by CLIM 2.0
-;;   Our default method on this delegates to KEYBOARD-INPUT-FOCUS
-;;    on the current application frame.
-;;   %SET-PORT-KEYBOARD-FOCUS is the function which
-;;    should be implemented in a McCLIM backend and
-;;    does the work of changing the focus.
-;;   A method on (SETF KEYBOARD-INPUT-FOCUS) brings them together,
-;;    calling %SET-PORT-KEYBOARD-FOCUS.
-
-(defgeneric port-keyboard-input-focus (port))
-(defgeneric (setf port-keyboard-input-focus) (focus port))
-
-(defmethod port-keyboard-input-focus (port)
-  (declare (ignore port))
-  (when *application-frame*
-    (keyboard-input-focus *application-frame*)))
-
-(defmethod (setf port-keyboard-input-focus) (focus port)
-  (when focus
-    (if (pane-frame focus)
-        (setf (keyboard-input-focus (pane-frame focus)) focus)
-        (%set-port-keyboard-focus port focus))))
-
-;; This is not in the CLIM spec, but since (setf port-keyboard-input-focus)
-;; now calls (setf keyboard-input-focus), we need something concrete the
-;; backend can implement to set the focus.    
-(defmethod %set-port-keyboard-focus (port focus &key timestamp)
-  (declare (ignore focus timestamp))  
-  (warn "%SET-PORT-KEYBOARD-FOCUS is not implemented on ~W" port))
-  
-
 (defun find-port (&key (server-path *default-server-path*))
   (if (null server-path)
       (setq server-path (find-default-server-path)))
@@ -195,8 +149,7 @@
 (defmethod distribute-event ((port basic-port) event)
   (cond
    ((typep event 'keyboard-event)
-    (dispatch-event (or #+ignore(port-keyboard-input-focus port) (event-sheet event))
-		    event))
+    (dispatch-event (event-sheet event) event))
    ((typep event 'window-event)
 ;   (dispatch-event (window-event-mirrored-sheet event) event)
     (dispatch-event (event-sheet event) event))
Index: stream-input.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/stream-input.lisp,v
retrieving revision 1.50
diff -u -r1.50 stream-input.lisp
--- stream-input.lisp	10 Dec 2006 23:26:39 -0000	1.50
+++ stream-input.lisp	25 Jan 2007 16:58:01 -0000
@@ -141,12 +141,8 @@
     (setq stream '*standard-input*))
   (let ((old-stream (gensym "OLD-STREAM")))
     `(let ((,old-stream (stream-set-input-focus ,stream)))
-       (unwind-protect (locally
-			 ,@body)
-	 (if ,old-stream
-	     (stream-set-input-focus ,old-stream)
-	     (setf (port-keyboard-input-focus (port ,stream)) nil))))))
-
+       (unwind-protect (locally ,@body)
+         (stream-set-input-focus ,old-stream)))))
 
 (defun read-gesture (&key
 		     (stream *standard-input*)
@@ -265,9 +261,11 @@
 	   ;; the problem. -- moore
 	   (cond ((null gesture)
 		  (go wait-for-char))
-		 ((and pointer-button-press-handler
-		       (typep gesture 'pointer-button-press-event))
-		  (funcall pointer-button-press-handler stream gesture))
+		 ((typep gesture 'pointer-button-press-event)
+                  (print "Hello" *trace-output*)
+                  (if pointer-button-press-handler
+                      (funcall pointer-button-press-handler stream gesture)
+                      (handle-event stream gesture)))
 		 ((loop for gesture-name in *abort-gestures*
 			thereis (event-matches-gesture-name-p gesture
 							      gesture-name))
Index: text-editor-gadget.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp,v
retrieving revision 1.7
diff -u -r1.7 text-editor-gadget.lisp
--- text-editor-gadget.lisp	20 Dec 2006 22:58:20 -0000	1.7
+++ text-editor-gadget.lisp	25 Jan 2007 16:58:01 -0000
@@ -126,10 +126,9 @@
     (make-text-style :fixed :roman :normal))
 
 (defclass goatee-text-field-pane (text-field
-			   standard-extended-output-stream
-			   standard-output-recording-stream
-			   enter/exit-arms/disarms-mixin
-			   basic-pane)
+                                  standard-extended-output-stream
+                                  standard-output-recording-stream
+                                  basic-pane)
   ((area :accessor area :initform nil
 	 :documentation "The Goatee area used for text editing.")
    (previous-focus :accessor previous-focus :initform nil
@@ -169,15 +168,15 @@
 								     'value))))
     (stream-add-output-record pane (area pane))))
 
-;;; Unilaterally declare a "focus follows mouse" policy.  I don't like this
-;;; much; the whole issue of keyboard focus needs a lot more thought,
-;;; especially when multiple application frames per port become possible.
+(defmethod handle-event :before 
+    ((gadget goatee-text-field-pane) (event pointer-button-press-event))
+  (let ((previous (stream-set-input-focus gadget)))
+    (when (and previous (typep previous 'gadget))
+      (disarmed-callback previous (gadget-client previous) (gadget-id previous)))
+    (armed-callback gadget (gadget-client gadget) (gadget-id gadget))))
 
 (defmethod armed-callback :after ((gadget goatee-text-field-pane) client id)
   (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (previous-focus gadget) (port-keyboard-input-focus port))
-    (setf (port-keyboard-input-focus port) gadget))
   (handle-repaint gadget +everywhere+)	;FIXME: trigger initialization
   (let ((cursor (cursor (area gadget))))
     (letf (((cursor-state cursor) nil))
@@ -185,16 +184,13 @@
 
 (defmethod disarmed-callback :after ((gadget goatee-text-field-pane) client id)
   (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (port-keyboard-input-focus port) (previous-focus gadget))
-    (setf (previous-focus gadget) nil))
   (handle-repaint gadget +everywhere+)	;FIXME: trigger initialization
   (let ((cursor (cursor (area gadget))))
     (letf (((cursor-state cursor) nil))
       (setf (cursor-appearance cursor) :hollow))))
 
-
-(defmethod handle-event ((gadget goatee-text-field-pane) (event key-press-event))
+(defmethod handle-event 
+    ((gadget goatee-text-field-pane) (event key-press-event))
   (let ((gesture (convert-to-gesture event))
 	(*activation-gestures* (activation-gestures gadget)))
     (when (activation-gesture-p gesture)
Index: Backends/CLX/port.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp,v
retrieving revision 1.126
diff -u -r1.126 port.lisp
--- Backends/CLX/port.lisp	24 Dec 2006 14:27:44 -0000	1.126
+++ Backends/CLX/port.lisp	25 Jan 2007 16:58:01 -0000
@@ -349,7 +349,8 @@
 					      :enter-window :leave-window
 					      :structure-notify
 					      :pointer-motion
-					      :button-motion)))
+					      :button-motion
+                                              )))
   (when (null (port-lookup-mirror port sheet))
     (update-mirror-geometry sheet)
     (let* ((desired-color (typecase sheet
@@ -663,10 +664,13 @@
 		      type width height x y root-x root-y
 		      data override-redirect-p send-event-p hint-p
                       target property requestor selection
+                      request first-keycode count
                       &allow-other-keys)
   (declare (special *clx-port*))
-  (let ((sheet (and window
-		    (port-lookup-sheet *clx-port* window))))
+  (when (eq event-key :mapping-notify)
+    (format *trace-output* "~&MappingNotify: ~S ~D ~D~%"
+            request first-keycode count))
+  (let ((sheet (and window (port-lookup-sheet *clx-port* window))))
     (when sheet
       (case event-key
 	((:key-press :key-release)
@@ -681,7 +685,9 @@
 	     :x x :y y
 	     :graft-x root-x
 	     :graft-y root-y
-             :sheet sheet :modifier-state modifier-state :timestamp time)))
+             :sheet (or (climi::frame-keyboard-input-focus (pane-frame sheet))
+                        sheet)
+             :modifier-state modifier-state :timestamp time)))
 	((:button-press :button-release)
 	 (let ((modifier-state (clim-xcommon:x-event-state-modifiers *clx-port*
 								     state)))
@@ -843,17 +849,26 @@
 (defmethod port-wm-protocols-message (sheet time (message (eql :wm_delete_window)) data)
   (declare (ignore data))
   (make-instance 'window-manager-delete-event
-                 :sheet sheet
-                 :timestamp time))
+                 :sheet sheet :timestamp time))
 
+;;; FIXME: we don't need this any more, as we manage keyboard focus
+;;; ourselves with a per-frame slot.  I think that means that we can
+;;; disengage ourselves from the ICCCM WM_TAKE_FOCUS protocol,
+;;; becoming "Passive" rather than "Locally Active" in the language of
+;;; that document.  The problem with "Locally Active" mode, where we
+;;; set focus to a subwindow, is that there is no means in CLIM to
+;;; propagate the timestamps of events we care about to the functions
+;;; that actually set focus, and so it's desperately easy to mess up
+;;; your X server state.
 (defmethod port-wm-protocols-message (sheet time (message (eql :wm_take_focus)) data)
   (when time
     (format *trace-output* "~&;; In :WM_TAKE_FOCUS, TIME is not NIL: ~S" time))
   (let* ((frame (pane-frame sheet))
-         (focus (climi::keyboard-input-focus frame))
+         (focus (climi::frame-keyboard-input-focus frame))
 	 ;; FIXME: Do I really have to use ELT here?  The CLX manual
 	 ;; says (sequence integer), so I suppose I do.
 	 (timestamp (elt data 1)))
+    #+nil
     (when (and focus (sheet-mirror focus))
       (xlib:set-input-focus (clx-port-display *clx-port*)
                             (sheet-mirror focus) :parent timestamp)
@@ -1158,10 +1173,15 @@
 
 ;;; Set the keyboard input focus for the port.
 
-(defmethod %set-port-keyboard-focus ((port clx-port) focus &key timestamp)
+(defmethod (setf port-keyboard-input-focus) 
+    (focus (port clx-port))
   (let ((mirror (sheet-mirror focus)))
     (when mirror
-      (xlib:set-input-focus (clx-port-display port) mirror :parent timestamp))))
+      (xlib:set-input-focus (clx-port-display port) mirror :parent nil)))
+  focus)
+
+(defmethod port-keyboard-input-focus ((port clx-port))
+  (port-lookup-sheet port (xlib:input-focus (clx-port-display port))))
 
 (defmethod port-force-output ((port clx-port))
   (xlib:display-force-output (clx-port-display port)))
Index: Drei/drei-clim.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp,v
retrieving revision 1.16
diff -u -r1.16 drei-clim.lisp
--- Drei/drei-clim.lisp	17 Jan 2007 11:43:51 -0000	1.16
+++ Drei/drei-clim.lisp	25 Jan 2007 16:58:01 -0000
@@ -206,8 +206,6 @@
 ;;; updating is done after a command has been executed, and only then
 ;;; (or by commands at their own discretion).
 (defclass drei-gadget-pane (drei-pane value-gadget action-gadget
-                                      #+(or mcclim building-mcclim) ; No idea how it works in classic CLIM.
-                                      climi::enter/exit-arms/disarms-mixin
                                       asynchronous-command-processor)
   ((%currently-processing :initform nil
                           :accessor currently-processing-p)
@@ -251,21 +249,13 @@
                             (gadget-id gadget)
                             new-value)))
 
-;; It's really silly that we have to manage keyboard input focus
-;; ourself.
 (defmethod armed-callback :after ((gadget drei-gadget-pane) client id)
   (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (previous-focus gadget) (port-keyboard-input-focus port))
-    (setf (port-keyboard-input-focus port) gadget))
   (setf (active gadget) t)
   (display-drei gadget))
 
 (defmethod disarmed-callback :after ((gadget drei-gadget-pane) client id)
   (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (port-keyboard-input-focus port) (previous-focus gadget))
-    (setf (previous-focus gadget) nil))
   (setf (active gadget) nil)
   (display-drei gadget))
 
@@ -320,6 +310,13 @@
             (let ((*standard-input* (or *minibuffer* *standard-input*)))
               (handle-gesture gadget gesture))))))))
 
+(defmethod handle-event :before 
+    ((gadget drei-gadget-pane) (event pointer-button-press-event))
+  (let ((previous (stream-set-input-focus gadget)))
+    (when (and previous (typep previous 'gadget))
+      (disarmed-callback previous (gadget-client previous) (gadget-id previous)))
+    (armed-callback gadget (gadget-client gadget) (gadget-id gadget))))
+
 (defmethod invoke-accepting-from-user ((drei drei-gadget-pane) (continuation function))
   ;; When an `accept' is called during the execution of a command for
   ;; the Drei gadget, we must deactivate the gadget in order to not
Index: ESA/esa.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/ESA/esa.lisp,v
retrieving revision 1.4
diff -u -r1.4 esa.lisp
--- ESA/esa.lisp	10 Dec 2006 00:08:30 -0000	1.4
+++ ESA/esa.lisp	25 Jan 2007 16:58:01 -0000
@@ -119,10 +119,11 @@
   ;; error: there's no feedback, unlike emacs' quite nice "[no
   ;; match]".
   (loop
-     (handler-case 
-         (return (call-next-method))
-       (parse-error ()
-         nil))))
+   (handler-case
+       (with-input-focus (pane)
+         (return (call-next-method)))
+     (parse-error ()
+       nil))))
 
 (defmethod stream-accept ((pane minibuffer-pane) type &rest args
                           &key (view (stream-default-view pane))
Index: Looks/pixie.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Looks/pixie.lisp,v
retrieving revision 1.18
diff -u -r1.18 pixie.lisp
--- Looks/pixie.lisp	23 Dec 2006 11:52:27 -0000	1.18
+++ Looks/pixie.lisp	25 Jan 2007 16:58:01 -0000
@@ -1089,18 +1089,6 @@
         (display-gadget-background pane (gadget-current-color pane) 0 0 (- x2 x1) (- y2 y1))
         (goatee::redisplay-all (area pane))))))
 
-(defmethod armed-callback :after ((gadget pixie-text-field-pane) client id)
-  (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (previous-focus gadget) (port-keyboard-input-focus port))
-    (setf (port-keyboard-input-focus port) gadget)))
-
-(defmethod disarmed-callback :after ((gadget pixie-text-field-pane) client id)
-  (declare (ignore client id))
-  (let ((port (port gadget)))
-    (setf (port-keyboard-input-focus port) (previous-focus gadget))
-    (setf (previous-focus gadget) nil)))
-
 (defmethod handle-event ((gadget pixie-text-field-pane) (event key-press-event))
   (let ((gesture (convert-to-gesture event))
 	(*activation-gestures* *standard-activation-gestures*))
