[mcclim-cvs] CVS update: mcclim/Backends/beagle/input/events.lisp

[Duncan Rose]

Update of /project/mcclim/cvsroot/mcclim/Backends/beagle/input
In directory common-lisp.net:/tmp/cvs-serv26518/beagle/input

Modified Files:
	events.lisp 
Log Message:
Implement 'pseudo' pointer grabbing. Get rid of redefinition of pointer
tracking loop from frame-manager.lisp (can use usual definition now
PORT-GRAB-POINTER etc. are implemented).

Date: Fri Jun  3 23:33:09 2005
Author: drose

Index: mcclim/Backends/beagle/input/events.lisp
diff -u mcclim/Backends/beagle/input/events.lisp:1.6 mcclim/Backends/beagle/input/events.lisp:1.7
--- mcclim/Backends/beagle/input/events.lisp:1.6	Sun May 29 11:55:39 2005
+++ mcclim/Backends/beagle/input/events.lisp	Fri Jun  3 23:33:09 2005
@@ -28,7 +28,7 @@
 
 #||
 
-$Id: events.lisp,v 1.6 2005/05/29 09:55:39 drose Exp $
+$Id: events.lisp,v 1.7 2005/06/03 21:33:09 drose Exp $
 
 Events in Cocoa
 ---------------
@@ -72,6 +72,13 @@
 is handled.")
 
 
+(defparameter *grabber-sheets-list* nil
+  "Contains a push-down list containing all sheets that have 'grabbed' the
+pointer; the head of the list is the most recent 'grabber' to whom events
+should be dispatched. If the list is empty, the 'usual' dispatch mechanism
+is used.")
+
+
 (defvar *keysym-hash-table*
   (make-hash-table :test #'eql))
 
@@ -809,16 +816,31 @@
 
 
 (defmethod port-grab-pointer ((port beagle-port) pointer sheet)
-  (declare (ignore port pointer sheet))
-  (warn "events:port-grab-pointer:Pointer grabbing not implemented in Cocoa backend")
-  nil)
+  (declare (ignore port pointer)
+	   (special *grabber-sheets-list*))
+  (push sheet *grabber-sheets-list*)
+  sheet)
 
 
 (defmethod port-ungrab-pointer ((port beagle-port) pointer sheet)
-  (declare (ignore port pointer sheet))
-  (warn "events:port-ungrab-pointer:Pointer grabbing not implemented in Cocoa backend")
-  nil)
-
+  (declare (ignore port pointer sheet)
+	   (special *grabber-sheets-list*))
+  ;; We *should* remove the last instance of the sheet provided to
+  ;; be pushed onto *grabber-sheets-list* I think, but instead just
+  ;; pop.
+  (when *grabber-sheets-list*
+    (pop *grabber-sheets-list*)))
+
+
+;;; Hrm. Do we use the 'distribute-event :around' method like CLX,
+;;; or make use of *grabber-sheets-list* directly in the event
+;;; generation code? For now, follow CLX' lead.
+(defmethod distribute-event :around ((port beagle-port) event)
+  (declare (ignore port)
+	   (special *grabber-sheets-list*))
+  (if *grabber-sheets-list*
+      (queue-event (first *grabber-sheets-list*) event)
+    (call-next-method)))
 
 (defun characters-to-key-name (ns-string-characters-in)
 ;;;  (format *terminal-io* "Processing ~S~%" ns-string-characters-in)