Tk Source Code

	     * refcount before firing it into the low-level event subsystem; the
	     * refcount will be decremented once the event has been processed.
	     */
	    event.virtual.user_data = userDataObj;
	    Tcl_IncrRefCount(userDataObj);
	}












	/*
	 * We only allow warping if the window is mapped.
	 */

	if (warp && Tk_IsMapped(tkwin)) {
	    TkDisplay *dispPtr = TkGetDisplay(event.general.xmotion.display);

	    Tk_Window warpWindow = Tk_IdToWindow(dispPtr->display, event.general.xmotion.window);






	    if (warpWindow != dispPtr->warpWindow) {
		if (warpWindow) {
		    Tcl_Preserve(warpWindow);
		}
		if (dispPtr->warpWindow) {
		    Tcl_Release(dispPtr->warpWindow);
		}
		dispPtr->warpWindow = warpWindow;
	    }
	    dispPtr->warpMainwin = mainWin;
	    dispPtr->warpX = event.general.xmotion.x;
	    dispPtr->warpY = event.general.xmotion.y;

	    if (!(dispPtr->flags & TK_DISPLAY_IN_WARP)) {
		Tcl_DoWhenIdle(DoWarp, dispPtr);
		dispPtr->flags |= TK_DISPLAY_IN_WARP;
	    }
	}

	/*
	 * 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);
	}
    }

    Tcl_ResetResult(interp);
    return TCL_OK;
}
/*

}

void
TkpWarpPointer(
    TkDisplay *dispPtr)
{
    CGPoint pt;



    if (dispPtr->warpWindow) {
	int x, y;




	Tk_GetRootCoords(dispPtr->warpWindow, &x, &y);
	pt.x = x + dispPtr->warpX;
	pt.y = y + dispPtr->warpY;


    } else {

	pt.x = dispPtr->warpX;
	pt.y = dispPtr->warpY;

    }









    CGWarpMouseCursorPosition(pt);










}

/*
 *----------------------------------------------------------------------
 *
 * TkpSetCapture --
 *

    bind xyz <Enter> {}
    bind {a b} <Enter> {}
    bind .t <Enter> {}
}

# move the mouse pointer away of the testing area
# otherwise some spurious events may pollute the tests
# also, this will procure a known grab state at startup
# for tests mixing grabs and pointer warps
proc pointerAway {} {
    toplevel .top
    wm geometry .top 50x50-50-50
    update
    # On KDE/Plasma _with_the_Aurorae_theme_ (at least), setting up the toplevel
    # will not be finished right 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
    event generate .top <Button-1> -warp 1
    update
    destroy .top
}
pointerAway

test bind-1.1 {bind command} -body {
    bind
} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"}
test bind-1.2 {bind command} -body {
    bind a b c d
} -returnCodes error -result {wrong # args: should be "bind window ?pattern? ?command?"}

    # Old implementation failed, and returned "first", but this was wrong,
    # because both bindings are homogeneous equal, so the most recently defined
    # must be preferred.
} -result {last}

test bind-34.1 {-warp works relatively to a window} -setup {
    toplevel .top
    wm geometry .top +100+100
    update
} -body {
    # In order to avoid platform-dependent coordinate results due to
    # decorations and borders, this test warps the pointer twice 
    # relatively to a window that moved in the meantime, and checks
    # how much the pointer moved
    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 .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 .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
    foreach pos1 $pointerPos1 pos2 $pointerPos2 {
        if {$pos1 != [expr {$pos2 - 400}]} {
            set res [list $pointerPos1 $pointerPos2]
        }

        } else {
            lappend res $dim
        }
    }
    set res
} -cleanup {
} -result {ok ok ok ok}

test bind-35.1 {pointer warp with grab on master, bug [e3888d5820]} -setup {
    pointerAway
    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  ; # this will queue events
    after 50
    update
    event generate .top.l <Motion> -warp 1 -x 10 -y 10
    update idletasks ; after 50
    foreach {x1 y1} [winfo pointerxy .top.l] {}
    event generate {} <Motion> -warp 1 -x 50 -y 50
    update idletasks ; after 50
    grab release .top  ; # this will queue events
    after 50
    update
    event generate .top.l <Motion> -warp 1 -x 10 -y 10
    update idletasks ; after 50
    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

# vi:set ts=4 sw=4 et:
# Local Variables:
# mode: tcl
# End: