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*)) ,@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 - ,@body) - (if ,old-stream - (stream-set-input-focus ,old-stream) - (setf (port-keyboard-input-focus (port ,stream)) nil)))))) - + (unwind-protect (locally ,@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*))