Tk Source Code

Check-in [34f66244]
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:All event tests now pass on Windows
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-22349fc78a-v2
Files: files | file ages | folders
SHA3-256: 34f66244eae410afff70455c8bad71da377ec857023c6064a95048514aea42d9
User & Date: culler 2024-05-22 02:44:54
Original Comment: All tests now pass on Windows
Original User & Date: marcc 2024-05-22 02:44:54
Context
2024-05-22
03:16
Remove debugging code. Issues remain with macOS for other tests in event.test. check-in: 9e30de65 user: culler tags: bug-22349fc78a-v2
02:44
All event tests now pass on Windows check-in: 34f66244 user: culler tags: bug-22349fc78a-v2
2024-05-21
22:42
Only 9.13, 9.14. and 9.19 fail on windows. Debug output included. check-in: 32b38d0b user: culler tags: bug-22349fc78a-v2
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/event.test.

869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
# 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)
}








<

















<







869
870
871
872
873
874
875

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892

893
894
895
896
897
898
899
# 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.


    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

    }
}
proc waitForWindowEvent.signal {counter} {
# Helper proc that records the triggering of a window event.
    incr ::_windowEvent($counter)
}

979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000


1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033


1034
1035
1036
1037
1038
1039
1040
    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







<






|
|

<

<


>
>

<



<




<













<


<
<
<



>
>







977
978
979
980
981
982
983

984
985
986
987
988
989
990
991
992

993

994
995
996
997
998

999
1000
1001

1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020



1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
    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 {

    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|" ; puts stderr "=leave=" }
    bind all <Enter> {append result "<Enter> %d %W|" ; puts stderr "-enter=" }
    set result |

} -body {

    destroy .two
    waitForWindowEvent .one <Enter>
    # destroying .one here instead of in cleanup makes the test pass
    destroy .one
    set result

} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}

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

test event-9.14 {pointer window is a toplevel, tk internal destination} -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 {

    destroy .two
    waitForWindowEvent .one.f1.f2 <Enter>



    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    set result
} -cleanup {
    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

Changes to win/tkWinWm.c.

2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601

2602
2603
2604
2605
2606
2607
2608
{
    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);
}







<
<




<




|
|
|
>







2581
2582
2583
2584
2585
2586
2587


2588
2589
2590
2591

2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
{
    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);


    if (windows != NULL) {
	for (w = windows; *w ; w++) {
	    RECT windowRect;
	    HWND hwnd = Tk_GetHWND(Tk_WindowId((Tk_Window) *w));

	    if (GetWindowRect(hwnd, &windowRect) == 0) {
		continue;
	    }
	    if (winPtr != *w && PtInRect(&windowRect, mouse)) {
		Tk_Window target = Tk_CoordsToWindow(mouse.x, mouse.y,
		    (Tk_Window) *w);
		Tk_UpdatePointer((Tk_Window) target,
		      mouse.x, mouse.y, state);
		break;
	    }
	}
	ckfree(windows);
    }
    fflush(stderr);
}
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
{
    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.
	 */







<
<







6704
6705
6706
6707
6708
6709
6710


6711
6712
6713
6714
6715
6716
6717
{
    Tcl_HashEntry *hPtr;
    TkWindow *childWinPtr;

    TkWmStackorderToplevelPair *pair =
	    (TkWmStackorderToplevelPair *) lParam;



    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.
	 */