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*))