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)
