[mcclim-cvs] CVS update: mcclim/Experimental/menu-choose.lisp

[Timothy Moore]

Update of /project/mcclim/cvsroot/mcclim/Experimental
In directory common-lisp.net:/tmp/cvs-serv15555/Experimental

Modified Files:
	menu-choose.lisp 
Log Message:

Eat the pointer-release events from a menu choose action. Otherwise,
they will still be around when if a command, invoked by the menu,
starts looking at the event queue.

Completely bypass the standard presentation translator mechanism when
determining whether to call the presentation clauses in
TRACKING-POINTER. Presentation translators and actions can't do
anything here.

Date: Tue Jan 11 14:14:21 2005
Author: tmoore

Index: mcclim/Experimental/menu-choose.lisp
diff -u mcclim/Experimental/menu-choose.lisp:1.13 mcclim/Experimental/menu-choose.lisp:1.14
--- mcclim/Experimental/menu-choose.lisp:1.13	Sun Oct 31 02:46:31 2004
+++ mcclim/Experimental/menu-choose.lisp	Tue Jan 11 14:14:21 2005
@@ -266,15 +266,27 @@
                                  :width x2
                                  :height y2
                                  :resize-frame t)))
-  (let ((*pointer-documentation-output* pointer-documentation))
-    (tracking-pointer (menu :context-type presentation-type :multiple-window t :highlight t) 
-      (:pointer-button-press (&key event x y) ; Pointer clicked outside menu? Close the menu.
-        (unless (and (sheet-ancestor-p (event-sheet event) menu)
-                     (region-contains-position-p (sheet-region menu) x y))
-          (return-from menu-choose-from-drawer (values nil))))
-      (:presentation-button-press (&key event presentation x y)
+  ;; Eat pointer release event so it isn't fed spuriously to another
+  ;; command entering its own tracking-pointer loop. 
+  (let ((*pointer-documentation-output* pointer-documentation)
+	(exit-menu nil))
+    (tracking-pointer (menu :context-type presentation-type
+			    :multiple-window t :highlight t)
+      (:presentation (&key presentation)
+	(format *trace-output* "type:~S presentation:~S~%"
+		presentation-type
+		presentation)
+       (setq exit-menu t))
+      (:pointer-button-release (&key event x y) ; Pointer clicked outside menu?
+					; Close the menu.
+	(when exit-menu
+	  (unless (and (sheet-ancestor-p (event-sheet event) menu)
+		       (region-contains-position-p (sheet-region menu) x y))
+	    (return-from menu-choose-from-drawer (values nil)))))
+      (:presentation-button-release (&key event presentation x y)
         (if (and (sheet-ancestor-p (event-sheet event) menu)
                  (region-contains-position-p (sheet-region menu) x y))
             (return-from menu-choose-from-drawer
               (values (presentation-object presentation) event))
             (return-from menu-choose-from-drawer (values nil)))))))
+