Merge trunk

9 files changed, 160 insertions, 123 deletions

diff --git a/generic/tkBind.c b/generic/tkBind.c
index 8ffcc1d..25d919f 100644
--- a/generic/tkBind.c
+++ b/generic/tkBind.c
@@ -738,7 +738,6 @@ static int		NameToWindow(Tcl_Interp *interp, Tk_Window main,
 			    Tcl_Obj *objPtr, Tk_Window *tkwinPtr);
 static unsigned		ParseEventDescription(Tcl_Interp *interp, const char **eventStringPtr,
 			    TkPattern *patPtr, EventMask *eventMaskPtr);
-static void		DoWarp(ClientData clientData);
 static PSList *		GetLookupForEvent(LookupTables* lookupPtr, const Event *eventPtr,
 			    Tcl_Obj *object, int onlyConsiderDetailedEvents);
 static void		ClearLookupTable(LookupTables *lookupTables, ClientData object);
@@ -4402,17 +4401,6 @@ HandleEventGenerate(
 	}
 
 	/*
-	 * Now we have constructed the event, inject it into the event handling
-	 * code.
-	 */
-
-	if (synch) {
-	    Tk_HandleEvent(&event.general);
-	} else {
-	    Tk_QueueWindowEvent(&event.general, pos);
-	}
-
-	/*
 	 * We only allow warping if the window is mapped.
 	 */
 
@@ -4421,11 +4409,6 @@ HandleEventGenerate(
 
 	    Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, event.general.xmotion.window);
 
-	    if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
-		Tcl_DoWhenIdle(DoWarp, dispPtr);
-		dispPtr->flags |= TK_DISPLAY_IN_WARP;
-	    }
-
 	    if (warpWindow != dispPtr->warpWindow) {
 		if (warpWindow) {
 		    Tcl_Preserve(warpWindow);
@@ -4438,6 +4421,31 @@ HandleEventGenerate(
 	    dispPtr->warpMainwin = mainWin;
 	    dispPtr->warpX = event.general.xmotion.x;
 	    dispPtr->warpY = event.general.xmotion.y;
+
+            /*
+             * Warping with respect to a window will be done when Tk_handleEvent
+             * below will run the event handlers and in particular TkPointerEvent.
+             * This allows to make grabs and warping work together robustly, that
+             * is without depending on a precise sequence of events.
+             * Warping with respect to the whole screen (i.e. dispPtr->warpWindow
+             * is NULL) is run directly here.
+             */
+
+            if (!dispPtr->warpWindow) {
+                TkpWarpPointer(dispPtr);
+                XForceScreenSaver(dispPtr->display, ScreenSaverReset);
+            }
+	}
+
+	/*
+	 * Now we have constructed the event, inject it into the event handling
+	 * code.
+	 */
+
+	if (synch) {
+	    Tk_HandleEvent(&event.general);
+	} else {
+	    Tk_QueueWindowEvent(&event.general, pos);
 	}
     }
 
@@ -4510,46 +4518,47 @@ NameToWindow(
 /*
  *-------------------------------------------------------------------------
  *
- * DoWarp --
+ * TkDoWarpWrtWin --
  *
- *	Perform Warping of X pointer. Executed as an idle handler only.
+ *	Perform warping of mouse pointer with respect to a window.
  *
  * Results:
  *	None
  *
  * Side effects:
- *	X Pointer will move to a new location.
+ *	Mouse pointer moves to a new location.
  *
  *-------------------------------------------------------------------------
  */
 
-static void
-DoWarp(
-    ClientData clientData)
+void
+TkDoWarpWrtWin(
+    TkDisplay *dispPtr)
 {
-    TkDisplay *dispPtr = (TkDisplay *)clientData;
-
-    assert(clientData);
+    assert(dispPtr);
 
     /*
-     * DoWarp was scheduled only if the window was mapped. It needs to be
-     * still mapped at the time the present idle callback is executed. Also
-     * one needs to guard against window destruction in the meantime.
-     * Finally, the case warpWindow == NULL is special in that it means
-     * the whole screen.
+     * A NULL warpWindow means warping with respect to the whole screen.
+     * We want to warp here only if we're warping with respect to a window.
      */
 
-    if (!dispPtr->warpWindow ||
-            (Tk_IsMapped(dispPtr->warpWindow) && Tk_WindowId(dispPtr->warpWindow) != None)) {
-        TkpWarpPointer(dispPtr);
-        XForceScreenSaver(dispPtr->display, ScreenSaverReset);
-    }
-
     if (dispPtr->warpWindow) {
-	Tcl_Release(dispPtr->warpWindow);
-	dispPtr->warpWindow = NULL;
+
+        /*
+         * Warping with respect to a window can only be done if the window is
+         * mapped. This was checked in HandleEvent. The window needs to be
+         * still mapped at the time the present code is executed. Also
+         * one needs to guard against window destruction in the meantime,
+         * which could have happened as a side effect of an event handler.
+         */
+
+        if (Tk_IsMapped(dispPtr->warpWindow) && Tk_WindowId(dispPtr->warpWindow) != None) {
+            TkpWarpPointer(dispPtr);
+            XForceScreenSaver(dispPtr->display, ScreenSaverReset);
+        }
+        Tcl_Release(dispPtr->warpWindow);
+        dispPtr->warpWindow = NULL;
     }
-    dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
 }
 
 /*
@@ -5320,35 +5329,6 @@ TkpGetBindingXEvent(
 /*
  *----------------------------------------------------------------------
  *
- * TkpCancelWarp --
- *
- *	This function cancels an outstanding pointer warp and
- *	is called during tear down of the display.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TkpCancelWarp(
-    TkDisplay *dispPtr)
-{
-    assert(dispPtr);
-
-    if (dispPtr->flags & TK_DISPLAY_IN_WARP) {
-	Tcl_CancelIdleCall(DoWarp, dispPtr);
-	dispPtr->flags &= ~TK_DISPLAY_IN_WARP;
-    }
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TkpDumpPS --
  *
  *	Dump given pattern sequence to stdout.
diff --git a/generic/tkEntry.c b/generic/tkEntry.c
index 5bbad3e..2c5db3e 100644
--- a/generic/tkEntry.c
+++ b/generic/tkEntry.c
@@ -3385,17 +3385,21 @@ EntryValidateChange(
 
     if (entryPtr->validateCmd == NULL ||
 	entryPtr->validate == VALIDATE_NONE) {
+        if (entryPtr->flags & VALIDATING) {
+            entryPtr->flags |= VALIDATE_ABORT;
+        }
 	return (varValidate ? TCL_ERROR : TCL_OK);
     }
 
     /*
-     * If we're already validating, then we're hitting a loop condition Return
-     * and set validate to 0 to disallow further validations and prevent
-     * current validation from finishing
+     * If we're already validating, then we're hitting a loop condition. Set
+     * validate to none to disallow further validations, arrange for flags
+     * to prevent current validation from finishing, and return.
      */
 
     if (entryPtr->flags & VALIDATING) {
 	entryPtr->validate = VALIDATE_NONE;
+        entryPtr->flags |= VALIDATE_ABORT;
 	return (varValidate ? TCL_ERROR : TCL_OK);
     }
 
diff --git a/generic/tkGrab.c b/generic/tkGrab.c
index 012d434..3e4d9db 100644
--- a/generic/tkGrab.c
+++ b/generic/tkGrab.c
@@ -666,6 +666,9 @@ ReleaseButtonGrab(
  *	This function is called for each pointer-related event, before the
  *	event has been processed. It does various things to make grabs work
  *	correctly.
+ *	Also, this function takes care of warping the mouse pointer with
+ *	respect to a given window, both when there is a grab in effect and
+ *	when there is none.
  *
  * Results:
  *	If the return value is 1 it means the event should be processed (event
@@ -677,6 +680,7 @@ ReleaseButtonGrab(
  *	Grab state information may be updated. New events may also be pushed
  *	back onto the event queue to replace or augment the one passed in
  *	here.
+ *	The mouse pointer may be moved.
  *
  *----------------------------------------------------------------------
  */
@@ -773,10 +777,24 @@ TkPointerEvent(
 	return 1;
     }
 
+    if ((eventPtr->type == MotionNotify) && !appGrabbed) {
+
+        /*
+         * Warp the mouse pointer with respect to window dispPtr->warpWindow
+         * if such a window was set in HandleEventGenerate.
+         */
+
+        TkDoWarpWrtWin(dispPtr);
+    }
+
     if (!appGrabbed) {
 	return 1;
     }
 
+    /*
+     * From this point on, there is a grab in effect.
+     */
+
     if (eventPtr->type == MotionNotify) {
 	/*
 	 * When grabs are active, X reports motion events relative to the
@@ -799,6 +817,13 @@ TkPointerEvent(
 	    Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
 	    return 0;
 	}
+
+        /*
+         * Warp the mouse pointer with respect to window dispPtr->warpWindow
+         * if such a window was set in HandleEventGenerate.
+         */
+
+        TkDoWarpWrtWin(dispPtr);
 	return 1;
     }
 
diff --git a/generic/tkInt.h b/generic/tkInt.h
index f37e2d3..5465a0e 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -576,14 +576,11 @@ typedef struct TkDisplay {
  *	Whether to use input methods for this display
  *  TK_DISPLAY_WM_TRACING:		(default off)
  *	Whether we should do wm tracing on this display.
- *  TK_DISPLAY_IN_WARP:			(default off)
- *	Indicates that we are in a pointer warp
  */
 
 #define TK_DISPLAY_COLLAPSE_MOTION_EVENTS	(1 << 0)
 #define TK_DISPLAY_USE_IM			(1 << 1)
 #define TK_DISPLAY_WM_TRACING			(1 << 3)
-#define TK_DISPLAY_IN_WARP			(1 << 4)
 
 /*
  * One of the following structures exists for each error handler created by a
@@ -1361,8 +1358,8 @@ MODULE_SCOPE int	TkInitFontchooser(Tcl_Interp *interp,
 			    ClientData clientData);
 MODULE_SCOPE void	TkInitEmbeddedConfigurationInformation(
 			    Tcl_Interp *interp);
+MODULE_SCOPE void	TkDoWarpWrtWin(TkDisplay *dispPtr);
 MODULE_SCOPE void	TkpWarpPointer(TkDisplay *dispPtr);
-MODULE_SCOPE void	TkpCancelWarp(TkDisplay *dispPtr);
 MODULE_SCOPE int	TkListCreateFrame(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_Obj *listObj,
 			    int toplevel, Tcl_Obj *nameObj);
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 26ae472..9d6c1f4 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -239,8 +239,6 @@ TkCloseDisplay(
 {
     TkClipCleanup(dispPtr);
 
-    TkpCancelWarp(dispPtr);
-
     if (dispPtr->name != NULL) {
 	ckfree(dispPtr->name);
     }
diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c
index c8754e8..28a788b 100644
--- a/macosx/tkMacOSXMouseEvent.c
+++ b/macosx/tkMacOSXMouseEvent.c
@@ -645,46 +645,18 @@ TkpWarpPointer(
     TkDisplay *dispPtr)
 {
     CGPoint pt;
-    NSPoint loc;
-    int wNum;
 
     if (dispPtr->warpWindow) {
 	int x, y;
-	TkWindow *winPtr = (TkWindow *) dispPtr->warpWindow;
-	TkWindow *topPtr = winPtr->privatePtr->toplevel->winPtr;
-	NSWindow *w = TkMacOSXDrawableWindow(winPtr->window);
-	wNum = [w windowNumber];
 	Tk_GetRootCoords(dispPtr->warpWindow, &x, &y);
 	pt.x = x + dispPtr->warpX;
 	pt.y = y + dispPtr->warpY;
-	loc.x = dispPtr->warpX;
-	loc.y = Tk_Height(topPtr) - dispPtr->warpY;
     } else {
-	wNum = 0;
-	pt.x = loc.x = dispPtr->warpX;
+	pt.x = dispPtr->warpX;
 	pt.y = dispPtr->warpY;
-	loc.y = TkMacOSXZeroScreenHeight() - pt.y;
     }
 
-    /*
-     * Generate an NSEvent of type NSMouseMoved.
-     *
-     * It is not clear why this is necessary.  For example, calling
-     *     event generate $w <Motion> -warp 1 -x $X -y $Y
-     * will cause two <Motion> events to be added to the Tcl queue.
-     */
-
     CGWarpMouseCursorPosition(pt);
-    NSEvent *warpEvent = [NSEvent mouseEventWithType:NSMouseMoved
-	location:loc
-	modifierFlags:0
-	timestamp:GetCurrentEventTime()
-	windowNumber:wNum
-	context:nil
-	eventNumber:0
-	clickCount:1
-	pressure:0.0];
-    [NSApp postEvent:warpEvent atStart:NO];
 }
 
 /*
diff --git a/tests/bind.test b/tests/bind.test
index 4439634..718c609 100644
--- a/tests/bind.test
+++ b/tests/bind.test
@@ -6229,6 +6229,8 @@ test bind-31.7 {virtual event user_data field - unshared, asynch} -setup {
 } -result {{} {} {TestUserData >b<}}
 
 test bind-32.1 {-warp, window was destroyed before the idle callback DoWarp} -setup {
+    # note: this test is now essentially useless
+    #       since DoWarp no longer exist, not even as an idle callback
     frame .t.f
     pack .t.f
     focus -force .t.f
@@ -6815,15 +6817,11 @@ test bind-34.1 {-warp works relatively to a window} -setup {
     wm geometry .top +200+200
     update
     event generate .top <Motion> -x 20 -y 20 -warp 1
-    update idletasks ; # DoWarp is an idle callback
-    after 50         ; # Win specific - wait for SendInput to be executed
-    set pointerPos1 [winfo pointerxy .t]
+    set pointerPos1 [winfo pointerxy .top]
     wm geometry .top +600+600
     update
     event generate .top <Motion> -x 20 -y 20 -warp 1
-    update idletasks ; # DoWarp is an idle callback
-    after 50         ; # Win specific - wait for SendInput to be executed
-    set pointerPos2 [winfo pointerxy .t]
+    set pointerPos2 [winfo pointerxy .top]
     # from the first warped position to the second one, the mouse
     # pointer should have moved the same amount as the window moved
     set res 1
@@ -6840,12 +6838,8 @@ test bind-34.2 {-warp works relatively to the screen} -setup {
 } -body {
     # Contrary to bind-34.1, we're directly checking screen coordinates
     event generate {} <Motion> -x 20 -y 20 -warp 1
-    update idletasks ; # DoWarp is an idle callback
-    after 50         ; # Win specific - wait for SendInput to be executed
     set res [winfo pointerxy .]
     event generate {} <Motion> -x 200 -y 200 -warp 1
-    update idletasks ; # DoWarp is an idle callback
-    after 50         ; # Win specific - wait for SendInput to be executed
     lappend res {*}[winfo pointerxy .]
 } -cleanup {
 } -result {20 20 200 200}
@@ -6863,8 +6857,6 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup {
     set res {}
 } -body {
     event generate {} <Motion> -x 0 -y 0 -warp 1
-    update idletasks ; # DoWarp is an idle callback
-    after 50         ; # Win specific - wait for SendInput to be executed
     foreach dim [winfo pointerxy .] {
         if {$dim <= $halo} {
             lappend res ok
@@ -6873,9 +6865,7 @@ test bind-34.3 {-warp works with null or negative coordinates} -setup {
         }
     }
     event generate {} <Motion> -x 100 -y 100 -warp 1
-    update idletasks ; after 50
     event generate {} <Motion> -x -1 -y -1 -warp 1
-    update idletasks ; after 50
     foreach dim [winfo pointerxy .] {
         if {$dim <= $halo} {
             lappend res ok
@@ -7018,6 +7008,37 @@ test bind-35.3 {Events agree for modifier keys} -constraints {aqua} -setup {
 } -cleanup {
 } -result pass
 
+test bind-36.1 {pointer warp with grab on master, bug [e3888d5820]} -setup {
+    event generate {} <Motion> -warp 1 -x 50 -y 50
+    toplevel .top
+    grab release .top
+    wm geometry .top 200x200+300+300
+    label .top.l -height 5 -width 20 -highlightthickness 2 \
+            -highlightbackground black -bg yellow -text "My label"
+    pack .top.l -side bottom
+    update
+    # On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel
+    # and the label will not be finished after the above 'update'. The WM still
+    # needs some time before the window is fully ready. For me 50 ms is enough,
+    # but let's wait more (it depends on computer performance).
+    after 100 ; update
+} -body {
+    grab .top
+    event generate .top.l <Motion> -warp 1 -x 10 -y 10
+    foreach {x1 y1} [winfo pointerxy .top.l] {}
+    event generate {} <Motion> -warp 1 -x 50 -y 50
+    grab release .top
+    event generate .top.l <Motion> -warp 1 -x 10 -y 10
+    foreach {x2 y2} [winfo pointerxy .top.l] {}
+    # success if the coords are the same with or without the grab, and if they
+    # are at (10,10) inside the label widget as requested by the warping
+    expr {$x1==$x2 && $y1==$y2 && $x1==[winfo rootx .top.l]+10 \
+                               && $y1==[winfo rooty .top.l]+10}
+} -cleanup {
+    destroy .top
+    unset x1 y1 x2 y2
+} -result {1}
+
 # cleanup
 cleanupTests
 return
diff --git a/tests/entry.test b/tests/entry.test
index e139ae3..b70a92e 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -3385,7 +3385,7 @@ test entry-19.19 {entry widget validation} -setup {
     list [.e cget -validate] [.e get] $::vVals
 } -cleanup {
     destroy .e
-} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+} -result {none nextdata {.e -1 -1 nextdata nextdata {} all forced}}
 
 ## This leaves validate alone because we trigger validation through the
 ## textvar (a write trace), and the write during validation triggers
@@ -3411,6 +3411,26 @@ test entry-19.20 {entry widget validation} -setup {
 } -cleanup {
     destroy .e
 } -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+## This leaves validate alone because we trigger validation through the
+## textvar (a write trace), and the write during validation triggers
+## nothing (by definition of avoiding loops on var traces).  This is
+## one of those "dangerous" conditions where the user will have a
+## different value in the entry widget shown as is in the textvar.
+test entry-19.21 {entry widget validation - bug 40e4bf6198} -setup {
+    unset -nocomplain ::e ::vVals
+} -body {
+    entry .e -validate key \
+        -validatecommand [list doval2 %W %d %i %P %s %S %v %V] \
+        -textvariable ::e
+    pack .e
+    set ::e origdata
+    .e insert 0 A
+    list [.e cget -validate] [.e get] $::e $::vVals
+} -cleanup {
+    destroy .e
+} -result {none origdata mydata {.e 1 0 Aorigdata origdata A key key}}
+
 ##
 ## End validation tests
 ##
diff --git a/tests/spinbox.test b/tests/spinbox.test
index f5c6540..371d0a6 100644
--- a/tests/spinbox.test
+++ b/tests/spinbox.test
@@ -3624,7 +3624,7 @@ test spinbox-19.19 {spinbox widget validation} -setup {
     list [.e cget -validate] [.e get] $::vVals
 } -cleanup {
     destroy .e
-} -result {none mydata {.e -1 -1 nextdata nextdata {} all forced}}
+} -result {none nextdata {.e -1 -1 nextdata nextdata {} all forced}}
 
 ## This leaves validate alone because we trigger validation through the
 ## textvar (a write trace), and the write during validation triggers
@@ -3650,6 +3650,26 @@ test spinbox-19.20 {spinbox widget validation} -setup {
 } -cleanup {
     destroy .e
 } -result {all testdata mydata {.e -1 -1 testdata mydata {} all forced}}
+
+## This leaves validate alone because we trigger validation through the
+## textvar (a write trace), and the write during validation triggers
+## nothing (by definition of avoiding loops on var traces).  This is
+## one of those "dangerous" conditions where the user will have a
+## different value in the entry widget shown as is in the textvar.
+test spinbox-19.21 {spinbox widget validation - bug 40e4bf6198} -setup {
+    unset -nocomplain ::e ::vVals
+} -body {
+    spinbox .e -validate key \
+        -validatecommand [list doval2 %W %d %i %P %s %S %v %V] \
+        -textvariable ::e
+    pack .e
+    set ::e origdata
+    .e insert 0 A
+    list [.e cget -validate] [.e get] $::e $::vVals
+} -cleanup {
+    destroy .e
+} -result {none origdata mydata {.e 1 0 Aorigdata origdata A key key}}
+
 ##
 ## End validation tests
 ##