[mcclim-cvs] CVS update: mcclim/Backends/beagle/windowing/frame-manager.lisp

[Duncan Rose]

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

Modified Files:
	frame-manager.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/windowing/frame-manager.lisp
diff -u mcclim/Backends/beagle/windowing/frame-manager.lisp:1.3 mcclim/Backends/beagle/windowing/frame-manager.lisp:1.4
--- mcclim/Backends/beagle/windowing/frame-manager.lisp:1.3	Fri Jun  3 00:17:30 2005
+++ mcclim/Backends/beagle/windowing/frame-manager.lisp	Fri Jun  3 23:33:09 2005
@@ -178,122 +178,3 @@
       (send window :make-key-and-order-front nil))))
 
 
-;;; Override 'pointer-tracking.lisp' method of the same name since we *don't* do pointer tracking;
-;;; should fix this properly in the future at which time we should be able to remove this.
-
-;;; Remove it now, this isn't the way pointer-tracking is implemented any more - this breaks menus
-;;; in Beagle, unfortunately, now.
-
-;;;(in-package :clim-internals)
-;;;
-;;;(defun invoke-tracking-pointer
-;;;    (sheet
-;;;     pointer-motion-handler presentation-handler
-;;;     pointer-button-press-handler presentation-button-press-handler
-;;;     pointer-button-release-handler presentation-button-release-handler
-;;;     keyboard-handler
-;;;     &key pointer multiple-window transformp (context-type t)
-;;;     (highlight nil highlight-p))
-;;;  ;; (setq pointer (port-pointer (port sheet))) ; FIXME
-;;;  (let ((port (port sheet))        
-;;;        (presentations-p (or presentation-handler
-;;;                             presentation-button-press-handler
-;;;                             presentation-button-release-handler)))
-;;;    (unless highlight-p (setq highlight presentations-p))
-;;;    (with-sheet-medium (medium sheet)
-;;;      (flet ((do-tracking ()
-;;;               (with-input-context (context-type :override t)
-;;;                 ()
-;;;                 (loop
-;;;                  (let ((event (event-read sheet)))
-;;;                    (when (and (eq sheet (event-sheet event))
-;;;                               (typep event 'pointer-motion-event))
-;;;                      (queue-event sheet event)
-;;;                      (highlight-applicable-presentation
-;;;                       (pane-frame sheet) sheet *input-context*))
-;;;                    (cond ((and (typep event 'pointer-event)
-;;;                                #+nil
-;;;                                (eq (pointer-event-pointer event)
-;;;                                    pointer))                     
-;;;                           (let* ((x (pointer-event-x event))
-;;;                                  (y (pointer-event-y event))
-;;;                                  (window (event-sheet event))
-;;;                                  (presentation
-;;;                                   (and presentations-p
-;;;                                        (find-innermost-applicable-presentation
-;;;                                         *input-context*
-;;;                                         sheet ; XXX
-;;;                                         x y
-;;;                                         :modifier-state (event-modifier-state event)))))
-;;;                             (when (and highlight presentation)
-;;;                               (frame-highlight-at-position
-;;;                                (pane-frame sheet) window x y))
-;;;                             ;; FIXME Convert X,Y to SHEET coordinates; user
-;;;                             ;; coordinates
-;;;                             (typecase event
-;;;                               (pointer-motion-event
-;;;                                (if (and presentation presentation-handler)
-;;;                                    (funcall presentation-handler
-;;;                                             :presentation presentation
-;;;                                             :window window :x x :y y)
-;;;                                    (maybe-funcall
-;;;                                     pointer-motion-handler
-;;;                                     :window window :x x :y y)))
-;;;                               (pointer-button-press-event
-;;;                                (if (and presentation
-;;;                                         presentation-button-press-handler)
-;;;                                    (funcall
-;;;                                     presentation-button-press-handler
-;;;                                     :presentation presentation
-;;;                                     :event event :x x :y y)
-;;;                                    (maybe-funcall
-;;;                                     pointer-button-press-handler
-;;;                                     :event event :x x :y y)))
-;;;                               (pointer-button-release-event
-;;;                                (if (and presentation
-;;;                                         presentation-button-release-handler)
-;;;                                    (funcall
-;;;                                     presentation-button-release-handler
-;;;                                     :presentation presentation
-;;;                                     :event event :x x :y y)
-;;;                                    (maybe-funcall
-;;;                                     pointer-button-release-handler
-;;;                                     :event event :x x :y y))))))
-;;;                          ((typep event
-;;;                                  '(or keyboard-event character symbol))
-;;;                           (maybe-funcall keyboard-handler
-;;;                                          :gesture event #|XXX|#))
-;;;                          (t (handle-event #|XXX|# (event-sheet event)
-;;;                                                   event))))))))
-;;;        (do-tracking)))))
-
-;;; Now we change tracking-pointer-loop instead. I think we *REALLY* should get
-;;; rid of pointer grabbing!
-
-(in-package :clim-internals)
-
-(defmethod tracking-pointer-loop
-    ((state tracking-pointer-state) frame sheet &rest args
-     &key pointer multiple-window transformp context-type highlight)
-  (declare (ignore args pointer context-type highlight frame multiple-window))
-  (with-sheet-medium (medium sheet)
-    (flet ((do-tracking ()
-	     (loop
-		for event = (event-read sheet)
-		do (if (typep event 'pointer-event)
-		       (multiple-value-bind (sheet-x sheet-y)
-			   (pointer-event-position* event)
-			 (multiple-value-bind (x y)
-			     (if transformp
-				 (transform-position
-				  (medium-transformation medium)
-				  sheet-x
-				  sheet-y)
-				 (values sheet-x sheet-y))
-			   (tracking-pointer-loop-step state event x y)))
-		       (tracking-pointer-loop-step state event 0 0)))))
-      (do-tracking))))
-;;;      (if multiple-window
-;;;	  (with-pointer-grabbed ((port medium) sheet)
-;;;	    (do-tracking))
-;;;	  (do-tracking)))))