From ad4fae60dc4c96e0bab745f16d3188efb3e2c801 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 16 May 2007 22:14:06 +0000
Subject: [PATCH] fix card-games bug related to button clicks when a card click
 (that could be a drag) triggers an animation that throws away the button
 release (so that the drag internally stays active until the next event)

svn: r6227
---
 collects/games/cards/classes.ss | 33 +++++++++++++++++++--------------
 1 file changed, 19 insertions(+), 14 deletions(-)

diff --git a/collects/games/cards/classes.ss b/collects/games/cards/classes.ss
index 7500eefcee..53bdade798 100644
--- a/collects/games/cards/classes.ss
+++ b/collects/games/cards/classes.ss
@@ -237,20 +237,21 @@
       (augment
 	[after-interactive-move
 	 (lambda (e)
-	   (set! dragging? #f)
-	   (inner (void) after-interactive-move e)
-	   (for-each-selected (lambda (snip) (send snip back-to-original-location this)))
-	   (let ([cards (get-reverse-selected-list)])
-	     (only-front-selected) ; in case overlap changed
-	     (for-each
-	      (lambda (region)
-		(when (region-hilite? region)
-		  (mred:queue-callback
-		   ; Call it outside the current edit sequence
-		   (lambda ()
-		     ((region-callback region) cards)
-		     (unhilite-region region)))))
-	      regions)))])
+           (when dragging?
+             (set! dragging? #f)
+             (inner (void) after-interactive-move e)
+             (for-each-selected (lambda (snip) (send snip back-to-original-location this)))
+             (let ([cards (get-reverse-selected-list)])
+               (only-front-selected) ; in case overlap changed
+               (for-each
+                (lambda (region)
+                  (when (region-hilite? region)
+                    (mred:queue-callback
+                                        ; Call it outside the current edit sequence
+                     (lambda ()
+                       ((region-callback region) cards)
+                       (unhilite-region region)))))
+                regions))))])
       (override
 	[on-default-event
 	 (lambda (e)
@@ -317,6 +318,10 @@
 		       (set! bg-click? #f)))
 		 (unless bg-click?
 		   (super on-default-event e))
+                 (when (and bg-click? dragging?)
+                   ;; We didn't call super on-default-event, so we need
+                   ;;  to explicitly end the drag:
+                   (after-interactive-move e))
 		 (when bg-click?
 		   ; Check for clicking on a button region:
 		   (for-each