Tk Source Code

# with configured scheduling priorities for processes, etc ...
# Waiting for the corresponding window events evades the trouble that is
# associated with the alternative: waiting or halting the Tk process for a
# fixed amount of time (using "after ms"). With the latter strategy it's
# always a gamble how much waiting time is enough on an end user's system.
# It also leads to long fixed waiting times in order to be on the safe side.

    puts stderr "Waiting for $event on $w"
    variable _windowEvent

    # Use counter as a unique ID to prevent subsequent waits
    # from interfering with each other.
    set counter [incr _windowEvent(counter)]
    set _windowEvent($counter) 1
    set savedBinding [bind $w $event]
    bind $w $event [list +waitForWindowEvent.signal $counter]
    set afterID [after $timeout [list set _windowEvent($counter) -1]]
    vwait _windowEvent($counter)
    set late [expr {$_windowEvent($counter) == -1}]
    bind $w $event $savedBinding
    unset _windowEvent($counter)
    if {$late} {
	puts stderr "wait for $event event on $w timed out (> $timeout ms)"
    } else {
        after cancel $afterID
	puts stderr "Event received"
    }
}
proc waitForWindowEvent.signal {counter} {
# Helper proc that records the triggering of a window event.
    incr ::_windowEvent($counter)
}

    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}

test event-9.13 {pointer window is a toplevel, toplevel destination} -setup {
    puts stderr "9.13 setup started"
    setup_win_mousepointer .one
    toplevel .two
    wm geometry .two 300x300+150+150
    wm withdraw .two
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result |
    puts stderr "9.13 setup done"
} -body {
    puts stderr "9.13 body started - destroying .two"
    destroy .two
    waitForWindowEvent .one <Enter>


    set result
    puts stderr "9.13 body finished"
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinear .one|}

test event-9.14 {pointer window is a toplevel, tk internal destination} -setup {
    puts stderr "9.14 setup"
    setup_win_mousepointer .one
    wm withdraw .one
    create_and_pack_frames .one
    toplevel .two
    wm geometry .two 300x300+150+150
    wm withdraw .two
    wm deiconify .one
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    puts stderr "9.14 body"
    destroy .two
    waitForWindowEvent .one.f1.f2 <Enter>
    set result
    puts stderr "9.14 body finished"
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one


    unset result
} -result {|<Enter> NotifyNonlinearVirtual .one|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}

test event-9.15 {pointer window is a toplevel, destination is screen root} -setup {
    setup_win_mousepointer .one; # ensure the mouse pointer is where we want it to be (the .one toplevel is not itself used in this test)
    toplevel .two
    wm geometry .two 300x300+150+150

{
    Display *display = Tk_Display(winPtr);
    POINT mouse;
    unsigned int state = TkWinGetModifierState();
    TkWindow **windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
    TkWindow **w;
    TkGetPointerCoords(NULL, &mouse.x, &mouse.y);
    fprintf(stderr, "CheckForPointer: %s with mouse @(%d, %d)\n",
	    Tk_PathName(winPtr), mouse.x, mouse.y);
    if (windows != NULL) {
	for (w = windows; *w ; w++) {
	    RECT windowRect;
	    HWND hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) *w));
	    fprintf(stderr, "    Checking %s\n", Tk_PathName(*w));
	    if (GetWindowRect(hwnd, &windowRect) == 0) {
		continue;
	    }
	    if (winPtr != *w && PtInRect(&windowRect, mouse)) {
	    	fprintf(stderr, "Pointer is in %s. Calling Tk_UpdatePointer\n",
	    		Tk_PathName(*w));
		Tk_UpdatePointer((Tk_Window) *w, mouse.x, mouse.y, state);

		break;
	    }
	}
	ckfree(windows);
    }
    fflush(stderr);
}

{
    Tcl_HashEntry *hPtr;
    TkWindow *childWinPtr;

    TkWmStackorderToplevelPair *pair =
	    (TkWmStackorderToplevelPair *) lParam;

    /*fprintf(stderr, "Looking up HWND %d\n", hwnd);*/

    hPtr = Tcl_FindHashEntry(pair->table, (char *) hwnd);
    if (hPtr != NULL) {
	childWinPtr = (TkWindow *)Tcl_GetHashValue(hPtr);

	/*
	 * Double check that same HWND does not get passed twice.
	 */