[mcclim-devel] Drei and input focus

Christophe Rhodes csr21 at cantab.net
Tue Feb 6 09:17:33 EST 2007


Christophe Rhodes <csr21 at cantab.net> writes:

> unsupportable API... on that subject, what implications does this have
> for other backends?

I attach a patch which reworks my previous stuff, and implements the
same behaviour (as far as I can tell) for the gtkairo backend as well
as the CLX backend.

* PORT-KEYBOARD-INPUT-FOCUS, (SETF PORT-KEYBOARD-INPUT-FOCUS):
  trampoline to PORT-FRAME-KEYBOARD-INPUT-FOCUS and (SETF ...).  The
  interpretation of this operator is to set the keyboard focus on a
  per-frame basis, and not to interact with any window manager to grab
  the focus from potentially unrelated applications.

* PORT-FRAME-KEYBOARD-INPUT-FOCUS / (SETF ...): per-backend methods,
  specialized on the port, for querying and setting the frame's focus
  sheet.  Implemented in CLX (and Null) backend using
  FRAME-PROPERTIES; in gtkairo backend using gtk_window_get_focus()
  and gtk_widget_grab_focus().

* various editor gadgets: no longer do keyboard handling in
  [dis]armed-callback; handle-event methods for assigning focus.
  frame-pointer-button-press-handler method likewise for
  INTERACTOR-PANEs.

Any comments?

-------------- next part --------------
Index: decls.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/decls.lisp,v
retrieving revision 1.45
diff -u -r1.45 decls.lisp
--- decls.lisp	14 Dec 2006 19:43:51 -0000	1.45
+++ decls.lisp	6 Feb 2007 14:12:00 -0000
@@ -221,6 +221,9 @@
 ;;;; 8.1
 (defgeneric process-next-event (port &key wait-function timeout))
 
+(defgeneric port-keyboard-input-focus (port))
+(defgeneric (setf port-keyboard-input-focus) (focus port))
+
 ;;; 8.2 Standard Device Events
 
 (defgeneric event-timestamp (event))
Index: frames.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/frames.lisp,v
retrieving revision 1.124
diff -u -r1.124 frames.lisp
--- frames.lisp	5 Feb 2007 02:55:29 -0000	1.124
+++ frames.lisp	6 Feb 2007 14:12:00 -0000
@@ -129,8 +129,6 @@
    (manager :initform nil
 	    :reader frame-manager
             :accessor %frame-manager)
-   (keyboard-input-focus :initform nil
-                         :accessor keyboard-input-focus)
    (properties :accessor %frame-properties
 	       :initarg :properties
 	       :initform nil)
@@ -1329,13 +1327,9 @@
   `(let ((,frame *application-frame*))
      , at 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: package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/package.lisp,v
retrieving revision 1.61
diff -u -r1.61 package.lisp
--- package.lisp	5 Feb 2007 03:16:55 -0000	1.61
+++ package.lisp	6 Feb 2007 14:12:00 -0000
@@ -1967,6 +1967,7 @@
    #:port-disable-sheet
    #:port-enable-sheet
    #:port-force-output
+   #:port-frame-keyboard-input-focus
    #:port-grab-pointer
    #:port-mirror-height
    #:port-mirror-width
@@ -1977,7 +1978,6 @@
    #:port-set-sheet-transformation
    #:port-ungrab-pointer
    #:queue-callback
-   #:%set-port-keyboard-focus
    #:set-sheet-pointer-cursor
    #:synthesize-pointer-motion-event
    #:text-style-character-width
Index: panes.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/panes.lisp,v
retrieving revision 1.179
diff -u -r1.179 panes.lisp
--- panes.lisp	5 Feb 2007 03:02:59 -0000	1.179
+++ panes.lisp	6 Feb 2007 14:12:00 -0000
@@ -2599,10 +2599,16 @@
 
 (defmethod stream-set-input-focus ((stream clim-stream-pane))
   (with-slots (port) stream
-    (prog1
-	(port-keyboard-input-focus port)
+    (prog1 (port-keyboard-input-focus port)
       (setf (port-keyboard-input-focus port) stream))))
 
+#+nil
+(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
 
 (defmethod stream-read-gesture :before ((stream clim-stream-pane)
@@ -2649,6 +2655,20 @@
 #+ignore  (let ((cursor (stream-text-cursor pane)))
     (setf (cursor-visibility cursor) t)))
 
+;;; KLUDGE: this is a hack to get keyboard focus (click-to-focus)
+;;; roughly working for interactor panes.  It's a hack somewhat
+;;; analogous to the mouse-wheel / select-and-paste handling in
+;;; DISPATCH-EVENT, just in a slightly different place.
+(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)))))
+
 ;;; 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	6 Feb 2007 14:12: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
@@ -66,51 +63,23 @@
    (text-style-mappings :initform (make-hash-table :test #'eq)
                         :reader port-text-style-mappings)
    (pointer-sheet :initform nil :accessor port-pointer-sheet
-		  :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))
+		  :documentation "The sheet the pointer is over, if any")))
 
 (defmethod port-keyboard-input-focus (port)
-  (declare (ignore port))
-  (when *application-frame*
-    (keyboard-input-focus *application-frame*)))
-
+  (when (null *application-frame*)
+    (error "~S called with null ~S" 
+           'port-keyboard-input-focus '*application-frame*))
+  (port-frame-keyboard-input-focus port *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))
-  
+  (when (null *application-frame*)
+    (error "~S called with null ~S" 
+           '(setf port-keyboard-input-focus) '*application-frame*))
+  (unless (eq *application-frame* (pane-frame focus))
+    (error "frame mismatch in ~S" '(setf port-keyboard-input-focus)))
+  (setf (port-frame-keyboard-input-focus port *application-frame*) focus))
+
+(defgeneric port-frame-keyboard-input-focus (port frame))
+(defgeneric (setf port-frame-keyboard-input-focus) (focus port frame))
 
 (defun find-port (&key (server-path *default-server-path*))
   (if (null server-path)
@@ -195,8 +164,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	6 Feb 2007 14:12:00 -0000
@@ -141,12 +141,9 @@
     (setq stream '*standard-input*))
   (let ((old-stream (gensym "OLD-STREAM")))
     `(let ((,old-stream (stream-set-input-focus ,stream)))
-       (unwind-protect (locally
-			 , at body)
-	 (if ,old-stream
-	     (stream-set-input-focus ,old-stream)
-	     (setf (port-keyboard-input-focus (port ,stream)) nil))))))
-
+       (unwind-protect (locally , at body)
+         (when ,old-stream
+           (stream-set-input-focus ,old-stream))))))
 
 (defun read-gesture (&key
 		     (stream *standard-input*)
@@ -265,9 +262,9 @@
 	   ;; 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))
+                 ((and pointer-button-press-handler
+                       (typep gesture 'pointer-button-press-event))
+                  (funcall pointer-button-press-handler 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	6 Feb 2007 14:12:00 -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,17 @@
 								     '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.
+;;; This implements click-to-focus-keyboard-and-pass-click-through
+;;; behaviour.
+(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 +186,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/package.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/package.lisp,v
retrieving revision 1.19
diff -u -r1.19 package.lisp
--- Backends/CLX/package.lisp	9 Feb 2004 22:30:55 -0000	1.19
+++ Backends/CLX/package.lisp	6 Feb 2007 14:12:00 -0000
@@ -53,7 +53,6 @@
                 #:width                 ;dito
                 #:coordinate=
                 #:get-transformation
-                #:keyboard-input-focus
                 ;;
                 #:invoke-with-special-choices
                 #:medium-miter-limit
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	6 Feb 2007 14:12:00 -0000
@@ -432,7 +432,7 @@
       (setf (xlib:wm-hints window) (xlib:make-wm-hints :input :on))
       (setf (xlib:wm-name window) (frame-pretty-name frame))
       (setf (xlib:wm-icon-name window) (frame-pretty-name frame))
-      (setf (xlib:wm-protocols window) `(:wm_delete_window :wm_take_focus)))))
+      (setf (xlib:wm-protocols window) `(:wm_delete_window)))))
 
 (defmethod realize-mirror ((port clx-port) (sheet unmanaged-top-level-sheet-pane))
   (realize-mirror-aux port sheet
@@ -663,10 +663,10 @@
 		      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))))
+  (let ((sheet (and window (port-lookup-sheet *clx-port* window))))
     (when sheet
       (case event-key
 	((:key-press :key-release)
@@ -681,7 +681,8 @@
 	     :x x :y y
 	     :graft-x root-x
 	     :graft-y root-y
-             :sheet sheet :modifier-state modifier-state :timestamp time)))
+             :sheet (or (frame-properties (pane-frame sheet) 'focus) sheet)
+             :modifier-state modifier-state :timestamp time)))
 	((:button-press :button-release)
 	 (let ((modifier-state (clim-xcommon:x-event-state-modifiers *clx-port*
 								     state)))
@@ -842,22 +843,7 @@
 
 (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))
-
-(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))
-	 ;; FIXME: Do I really have to use ELT here?  The CLX manual
-	 ;; says (sequence integer), so I suppose I do.
-	 (timestamp (elt data 1)))
-    (when (and focus (sheet-mirror focus))
-      (xlib:set-input-focus (clx-port-display *clx-port*)
-                            (sheet-mirror focus) :parent timestamp)
-      nil)))
+  (make-instance 'window-manager-delete-event :sheet sheet :timestamp time))
 
 (defmethod port-wm-protocols-message (sheet time (message t) data)
   (warn "Unprocessed WM Protocols message: ~:_message = ~S;~:_ data = ~S;~_ sheet = ~S."
@@ -1155,13 +1141,10 @@
 	       ;; reasonable timestamp.
 	       :timestamp 0))))))))
   
-
-;;; Set the keyboard input focus for the port.
-
-(defmethod %set-port-keyboard-focus ((port clx-port) focus &key timestamp)
-  (let ((mirror (sheet-mirror focus)))
-    (when mirror
-      (xlib:set-input-focus (clx-port-display port) mirror :parent timestamp))))
+(defmethod port-frame-keyboard-input-focus ((port clx-port) frame)
+  (frame-properties frame 'focus))
+(defmethod (setf port-frame-keyboard-input-focus) (focus (port clx-port) frame)
+  (setf (frame-properties frame 'focus) focus))
 
 (defmethod port-force-output ((port clx-port))
   (xlib:display-force-output (clx-port-display port)))
Index: Backends/Null/port.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/Null/port.lisp,v
retrieving revision 1.2
diff -u -r1.2 port.lisp
--- Backends/Null/port.lisp	29 Oct 2006 00:21:35 -0000	1.2
+++ Backends/Null/port.lisp	6 Feb 2007 14:12:00 -0000
@@ -155,9 +155,16 @@
 (defmethod synthesize-pointer-motion-event ((pointer null-pointer))
   ())
 
-;;; Set the keyboard input focus for the port.
+(defmethod port-frame-keyboard-input-focus ((port null-port) frame)
+  (frame-properties frame 'focus))
+(defmethod (setf port-frame-keyboard-input-focus) 
+    (focus (port null-port) frame)
+  (setf (frame-properties frame 'focus) focus))
 
-(defmethod %set-port-keyboard-focus (focus (port null-port) &key timestamp)
+(defmethod (setf port-keyboard-input-focus) (focus (port null-port))
+  focus)
+
+(defmethod port-keyboard-input-focus ((port null-port))
   ())
 
 (defmethod port-force-output ((port null-port))
Index: Backends/gtkairo/ffi.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/ffi.lisp,v
retrieving revision 1.16
diff -u -r1.16 ffi.lisp
--- Backends/gtkairo/ffi.lisp	4 Feb 2007 12:55:44 -0000	1.16
+++ Backends/gtkairo/ffi.lisp	6 Feb 2007 14:12:00 -0000
@@ -1625,6 +1625,10 @@
   (requisition :pointer)                ;GtkRequisition *
   )
 
+(defcfun "gtk_window_get_focus"
+    :pointer
+  (window :pointer))
+
 (defcfun "gtk_window_move"
     :void
   (window :pointer)                     ;GtkWindow *
Index: Backends/gtkairo/port.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp,v
retrieving revision 1.16
diff -u -r1.16 port.lisp
--- Backends/gtkairo/port.lisp	4 Feb 2007 12:55:44 -0000	1.16
+++ Backends/gtkairo/port.lisp	6 Feb 2007 14:12:00 -0000
@@ -742,10 +742,22 @@
 		  ;; reasonable timestamp.
 		  :timestamp 0)))))))))
 
-(defmethod %set-port-keyboard-focus ((port gtkairo-port) focus &key timestamp)
-  (declare (ignore timestamp))
+(defmethod port-frame-keyboard-input-focus ((port gtkairo-port) frame)
   (with-gtk ()
-    (gtk_widget_grab_focus (mirror-widget (sheet-mirror focus)))))
+    (let* ((sheet (frame-top-level-sheet frame))
+           (mirror (climi::port-lookup-mirror port sheet))
+           (widget (gtk_window_get_focus (mirror-window mirror))))
+      (if (cffi:null-pointer-p widget)
+          nil
+          (widget->sheet widget port)))))
+
+(defmethod (setf port-frame-keyboard-input-focus) 
+    (focus (port gtkairo-port) frame)
+  (with-gtk ()
+    ;; could use gtk_window_set_focus here for symmetry, but we don't
+    ;; have to.
+    (gtk_widget_grab_focus (mirror-widget (sheet-mirror focus))))
+  focus)
 
 (defmethod port-force-output ((port gtkairo-port))
   (with-gtk ()
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	6 Feb 2007 14:12:00 -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	6 Feb 2007 14:12:00 -0000
@@ -119,10 +119,10 @@
   ;; 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.19
diff -u -r1.19 pixie.lisp
--- Looks/pixie.lisp	5 Feb 2007 03:31:59 -0000	1.19
+++ Looks/pixie.lisp	6 Feb 2007 14:12:00 -0000
@@ -1098,18 +1098,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*))
-------------- next part --------------

Cheers,

Christophe


More information about the mcclim-devel mailing list