[mcclim-devel] Drei and input focus
Christophe Rhodes
csr21 at cantab.net
Thu Jan 25 12:10:55 EST 2007
"Andy Hefner" <ahefner at gmail.com> writes:
> On 1/19/07, Christophe Rhodes <csr21 at cantab.net> wrote:
>> Well, I say the "Right Thing": _clearly_ the right thing is to abandon
>> this horrific focus-follows-mouse-around-widgets disaster and
>> implement a sane keyboard focus policy. Then much of the complexity
>> can go away. Hooray. (What did Classic CLIM do?)
>
> I'm not familiar with the horrors of the Goatee input focus kludge,
> but it seems straightforward to implement click-to-focus. I've
> attached a trivial test which demonstrates that this does indeed work
> (click to focus between two mock text-editor gadgets, although it is
> initially focus-follows-mouse until the focus is first assigned by
> clicking, as that simply seems to be what X does by default).
I've attached a patch which implements click-to-focus fairly
pervasively, without using the X focus mechanism. The basic idea is
to separate out port-keyboard-input-focus, which mediates the X focus
for top-level windows, and frame-keyboard-input-focus, which is a
per-frame setting. This patch deviates from CLIM II in that
stream-set-input-focus does not call port-keyboard-input-focus, but
merely sets the per-frame slot; the CLX event handler is adjusted to
place the proper sheet in keyboard events.
The implementation of click-to-focus is kludgy. It's fine for
drei-gadgets, and for text-gadgets generally; it's not so hot for
general streams. I've taken the line that interactor-panes should be
focusable with a click; somewhat to my surprise, you can't just write
a method on handle-event to get this, but have to work with
frame-input-context-button-press-handler. A potential gotcha is that
I have not implented click-to-focus for application-panes; this may
cause surprises, but it seemed to me the only way not to break the
address book demo ;-)
One new spec compliance is that initially keyboard focus really does
go to *query-io*. This might cause some surprising behaviour.
Somewhat to my surprise, gsharp seems to work -- maybe because its
toplevel loop is different -- but ESAs with default-frame-top-level
deliver keyboard events to the minibuffer by default, which isn't
ideal. On the other hand, the focus behaviour of text gadgets is, to
me, much nicer -- and there's no more focus stealing going on.
I have to send this in a bit of a hurry; there's more I could say
about this, but I'll be happy to hear comments.
-------------- next part --------------
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*))
, 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: 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
- , at body)
- (if ,old-stream
- (stream-set-input-focus ,old-stream)
- (setf (port-keyboard-input-focus (port ,stream)) nil))))))
-
+ (unwind-protect (locally , at 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*))
-------------- next part --------------
Cheers,
Christophe
More information about the mcclim-devel
mailing list