Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv16608
Modified Files: NEWS decls.lisp frames.lisp package.lisp panes.lisp ports.lisp stream-input.lisp text-editor-gadget.lisp Log Message: New click-to-focus policy for text-editor gadgets and panes, implemented for the CLX, Null and gtkairo backends (but gtk_window_get_focus() hand-inserted into gtkairo/ffi.lisp).
PORT-KEYBOARD-INPUT-FOCUS is now a trampoline to PORT-FRAME-KEYBOARD-INPUT-FOCUS, a per-port function to set the keyboard focus for a particular frame. Not implemented for Beagle or OpenGL backends.
Now Drei / Goatee gadgets don't have to do their own keyboard focus handling on arm/disarm any more. Various kludges sprinkled all over the place to make this so.
--- /project/mcclim/cvsroot/mcclim/NEWS 2007/01/18 15:01:11 1.20 +++ /project/mcclim/cvsroot/mcclim/NEWS 2007/02/07 12:44:16 1.21 @@ -2,6 +2,9 @@ ** Installation: the systems clim-listener, scigraph, clim-examples, and clouseau can now be loaded without loading the system mcclim first. +** improvement: the CLX backend should no longer cause focus stealing + when an application has text-editor panes. This change comes with + a rudimentary click-to-focus-keyboard widget policy.
* Changes in mcclim-0.9.4 relative to 0.9.3: ** cleanup: removed the obsolete system.lisp file. --- /project/mcclim/cvsroot/mcclim/decls.lisp 2006/12/14 19:43:51 1.45 +++ /project/mcclim/cvsroot/mcclim/decls.lisp 2007/02/07 12:44:16 1.46 @@ -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)) --- /project/mcclim/cvsroot/mcclim/frames.lisp 2007/02/05 02:55:29 1.124 +++ /project/mcclim/cvsroot/mcclim/frames.lisp 2007/02/07 12:44:16 1.125 @@ -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))
--- /project/mcclim/cvsroot/mcclim/package.lisp 2007/02/05 03:16:55 1.61 +++ /project/mcclim/cvsroot/mcclim/package.lisp 2007/02/07 12:44:17 1.62 @@ -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 --- /project/mcclim/cvsroot/mcclim/panes.lisp 2007/02/05 03:02:59 1.179 +++ /project/mcclim/cvsroot/mcclim/panes.lisp 2007/02/07 12:44:17 1.180 @@ -27,7 +27,7 @@ ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA.
-;;; $Id: panes.lisp,v 1.179 2007/02/05 03:02:59 ahefner Exp $ +;;; $Id: panes.lisp,v 1.180 2007/02/07 12:44:17 crhodes Exp $
(in-package :clim-internals)
@@ -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) --- /project/mcclim/cvsroot/mcclim/ports.lisp 2006/12/24 14:27:43 1.54 +++ /project/mcclim/cvsroot/mcclim/ports.lisp 2007/02/07 12:44:17 1.55 @@ -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)) --- /project/mcclim/cvsroot/mcclim/stream-input.lisp 2006/12/10 23:26:39 1.50 +++ /project/mcclim/cvsroot/mcclim/stream-input.lisp 2007/02/07 12:44:17 1.51 @@ -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)) --- /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2006/12/20 22:58:20 1.7 +++ /project/mcclim/cvsroot/mcclim/text-editor-gadget.lisp 2007/02/07 12:44:17 1.8 @@ -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)