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))))))) +