Tk Source Code

name: Linux
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    - "bug-22349fc78a"
    tags:
    - "core-**"
permissions:
  contents: read
defaults:
  run:
    shell: bash

name: macOS
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    - "bug-22349fc78a"
    tags:
    - "core-**"
permissions:
  contents: read
env:
  ERROR_ON_FAILURES: 1
jobs:

name: Windows
on:
  push:
    branches:
    - "main"
    - "core-8-branch"
    - "core-8-6-branch"
    - "bug-22349fc78a"
    tags:
    - "core-**"
permissions:
  contents: read
env:
  ERROR_ON_FAILURES: 1
jobs:

    unsigned lastState;		/* Last known state flags. */
    XPoint lastPos;		/* Last reported mouse position. */
    TkWindow *lastWinPtr;	/* Last reported mouse window. */
    TkWindow *restrictWinPtr;	/* Window to which all mouse events will be
				 * reported. */
    TkWindow *cursorWinPtr;	/* Window that is currently controlling the
				 * global cursor. */
    int pwIsDead;		/* 1 if destroyed, 0 if not */
    TkWindow deadWin;		/* Replacement for a destroyed pointer
    				 * window, used as the source window for
    				 * generating crossing events. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of procedures used in this file.
 */

{
    int crossed = 0;		/* 1 if mouse crossed a window boundary */
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    TkWindow *restrictWinPtr = tsdPtr->restrictWinPtr;
    TkWindow *lastWinPtr = tsdPtr->lastWinPtr;

    if (tsdPtr->pwIsDead) {
	XEvent event;
	TkWindow *deadWinPtr = &tsdPtr->deadWin;
	TkWindow *targetPtr = deadWinPtr->parentPtr;

	if (targetPtr && (targetPtr->window != None)) {

	    /*
	     * Only generate Enter events. We can't deliver Leave events
	     * since the windows to receive them don't exist anymore.
	     */

	    InitializeEvent(&event, targetPtr, EnterNotify, x, y, state,
		    NotifyInferior);
	    TkInOutEvents(&event, deadWinPtr, winPtr, 0,
		    EnterNotify, TCL_QUEUE_TAIL);
	}
    if (winPtr != tsdPtr->lastWinPtr) {
	tsdPtr->lastWinPtr = winPtr;
	tsdPtr->pwIsDead = 0;
	crossed = 1;
    } else if (winPtr != lastWinPtr) {
	if (restrictWinPtr) {
	    int newPos, oldPos;

	    newPos = TkPositionInTree(winPtr, restrictWinPtr);
	    oldPos = TkPositionInTree(lastWinPtr, restrictWinPtr);

	    /*

		targetPtr = lastWinPtr;
	    }

	    if (targetPtr && (targetPtr->window != None)) {
		XEvent event;

		/*
		 * Generate appropriate Enter/Leave events.
		 * Generate Enter/Leave events for the old and new pointer
		 * window and their intermediates.
		 */

		InitializeEvent(&event, targetPtr, LeaveNotify, x, y, state,
			NotifyNormal);
			NotifyAncestor);

		TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
			EnterNotify, TCL_QUEUE_TAIL);
		crossed = 1;
	    }
	}
	tsdPtr->lastWinPtr = winPtr;

	    targetWinPtr = tsdPtr->restrictWinPtr;
	} else if (tsdPtr->grabWinPtr && !winPtr) {
	    targetWinPtr = tsdPtr->grabWinPtr;
	}

	if (targetWinPtr != NULL) {
	    InitializeEvent(&event, targetWinPtr, MotionNotify, x, y,
		    tsdPtr->lastState, NotifyNormal);
		    tsdPtr->lastState, NotifyAncestor);
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	}
	tsdPtr->lastPos = pos;
    }
}

/*

TkPointerDeadWindow(
    TkWindow *winPtr)
{
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr == tsdPtr->lastWinPtr) {
	TkWindow *deadWinPtr = &tsdPtr->deadWin;
	tsdPtr->pwIsDead = 1;

	/*
	 * Save the pointer window information that GenerateEnterLeave()
	 * needs for generating crossing events.
	 */

	deadWinPtr->parentPtr = winPtr->parentPtr;
	deadWinPtr->flags = winPtr->flags;

	tsdPtr->lastWinPtr = TkGetContainer(winPtr);
	tsdPtr->lastWinPtr = winPtr->parentPtr;
    }
    if (winPtr == tsdPtr->grabWinPtr) {
	tsdPtr->grabWinPtr = NULL;
    }
    if (winPtr == tsdPtr->restrictWinPtr) {
	tsdPtr->restrictWinPtr = NULL;
    }

                on which this test is run does NOT have a diaeresis \
                physical key - in this case, test is actually void."
    }
} -cleanup {
    deleteWindows
} -result {OK}

proc waitForWindowEvent {w event {timeout 1000}} {
# This proc is intended to overcome latency of windowing system
# notifications when toplevel windows are involved. These latencies vary
# considerably with the window manager in use, with the system load,
# 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.
test event-9.1 {enter . window by destroying a toplevel - bug b1d115fa60} -setup {
    set EnterBind [bind . <Enter>]

    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 "waiting 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)
}

proc create_and_pack_frames {{w {}}} {
    frame $w.f1 -bg blue -width 200 -height 200
    pack propagate $w.f1 0
    frame $w.f1.f2 -bg yellow -width 100 -height 100
    pack $w.f1.f2 $w.f1 -side bottom -anchor se
}

proc setup_win_mousepointer {w} {
# Position the window and the mouse pointer as an initial state for some tests.
# The so-called "pointer window" is the $w window that will now contain the mouse pointer.
    wm geometry . +700+700; # root window out of our way - must not cover windows from event-9.1*
    toplevel $w
    pack propagate $w 0
    wm geometry $w 300x300+100+100
    tkwait visibility $w
    update; # service remaining screen drawing events (e.g. <Expose>)
    set pointerWin [winfo containing [winfo pointerx $w] [winfo pointery $w]]
    event generate $w <Motion> -warp 1 -x 250 -y 250
    if {[tk windowingsystem] eq "aqua"} {
        # Generate a NSMouseMoved NSevent with no mouse pointer position change.
        # This is to let event-9.1? tests pass on macOS aqua and is only a workaround
        # since macOS aqua should send the adequate NSevent by itself.
        movemouse [expr {[winfo rootx $w] + 250}] [expr {[winfo rooty $w] + 250}]
    }
    if {($pointerWin ne $w) && ([tk windowingsystem] ne "aqua")} {
        waitForWindowEvent $w <Enter>
    } else {
        controlPointerWarpTiming
    }
}

test event-9.11 {pointer window container = parent} -setup {
    setup_win_mousepointer .one
    wm withdraw .one
    create_and_pack_frames .one
    wm deiconify .one
    tkwait visibility .one.f1.f2
    _pause 200
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    wm geometry . 200x200+300+300
    wm deiconify .
    _pause 200
    toplevel .top2 -width 200 -height 200
    destroy .one.f1.f2
    if {[tk windowingsystem] eq "aqua"} {
        # Generate a NSMouseMoved NSevent with no mouse pointer position change.
        # This is to let event-9.1? tests pass on macOS aqua and is only a workaround
        # since macOS aqua should send the adequate NSevent by itself.
        movemouse [expr {[winfo rootx .one] + 250}] [expr {[winfo rooty .one] + 250}]
    }
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyInferior .one.f1|}

    wm geometry .top2 +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}]
    wm deiconify .top2
    raise .top2
    _pause 400
test event-9.12 {pointer window container != parent} -setup {
    setup_win_mousepointer .one
    wm withdraw .one
    create_and_pack_frames .one
    pack propagate .one.f1.f2 0
    pack [frame .one.g -bg orange -width 80 -height 80] -anchor se -side bottom -in .one.f1.f2
    wm deiconify .one
    tkwait visibility .one.g
    _pause 200
    event generate .top2 <Motion> -warp 1 -x 50 -y 50
    _pause 100
    bind . <Enter> {lappend res %W}
    set res [list ]
    destroy .top2
    _pause 200
    set res
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.g
    _pause 200; # service crossing events
    set result
} -cleanup {
    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
    wm withdraw .one
    toplevel .two
    wm geometry .two 300x300+150+150
    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 <Enter>
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinear .one|}
    deleteWindows
    bind . <Enter> $EnterBind
} -result {.}
test event-9.2 {enter toplevel window by destroying a toplevel - bug b1d115fa60} -setup {
    set iconified false
    if {[winfo ismapped .]} {
        wm iconify .

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 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>
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
        update
        set iconified true
    }
    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
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    event generate .two <Motion> -warp 1 -x 275 -y 275
    controlPointerWarpTiming
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    toplevel .top1
    wm geometry .top1 200x200+300+300
    wm deiconify .top1
    destroy .two
    _pause 200; # ensure servicing of all scheduled events (only <Expose> events expected)
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|}

test event-9.16 {Successive destructions (pointer window + parent), single generation of crossing events} -setup {
    # Tests correctness of overwriting the dead window struct in
    # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave().
    setup_win_mousepointer .one
    wm withdraw .one
    create_and_pack_frames .one
    wm deiconify .one
    tkwait visibility .one.f1.f2
    _pause 200
    toplevel .top2 -width 200 -height 200
    wm geometry .top2 +[expr {[winfo rootx .top1]+50}]+[expr {[winfo rooty .top1]+50}]
    _pause 200
    wm deiconify .top2
    raise .top2
    _pause 400
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.f1
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyInferior .one|}

test event-9.17 {Successive destructions (pointer window + parent), separate crossing events} -setup {
    # Tests correctness of overwriting the dead window struct in
    # TkPointerDeadWindow() and subsequent reading in GenerateEnterLeave().
    setup_win_mousepointer .one
    wm withdraw .one
    create_and_pack_frames .one
    wm deiconify .one
    tkwait visibility .one.f1.f2
    _pause 200
    event generate .top2 <Motion> -warp 1 -x 50 -y 50
    _pause 100
    bind .top1 <Enter> {lappend res %W}
    set res [list ]
    destroy .top2
    _pause 200
    set res
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .one.f1.f2
    _pause 200; # service crossing events
    destroy .one.f1
    _pause 200; # service crossing events
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyInferior .one.f1|<Enter> NotifyInferior .one|}

test event-9.18 {Successive destructions (pointer window + ancestors including its toplevel), destination is non-root toplevel} -setup {
    setup_win_mousepointer .one
    toplevel .two
    pack propagate .two 0
    wm geometry .two 300x300+100+100
    create_and_pack_frames .two
    wm deiconify .two
    waitForWindowEvent .two.f1.f2 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .two
    waitForWindowEvent .one <Enter>
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinear .one|}
    deleteWindows ; # destroy all children of ".", this already includes .top1
    if {$iconified} {
        wm deiconify .
        update
    }
} -result {.top1}

test event-9.19 {Successive destructions (pointer window + ancestors including its toplevel), destination is internal window, bypass root win} -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
    pack propagate .two 0
    wm geometry .two 300x300+100+100
    create_and_pack_frames .two
    wm deiconify .two
    waitForWindowEvent .two.f1.f2 <Enter>
    toplevel .three
    pack propagate .three 0
    wm geometry .three 300x300+110+110
    create_and_pack_frames .three
    wm deiconify .three
    waitForWindowEvent .three.f1.f2 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .three
    waitForWindowEvent .two.f1.f2 <Enter>
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .two
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .two|<Enter> NotifyNonlinearVirtual .two.f1|<Enter> NotifyNonlinear .two.f1.f2|}

test event-9.20 {Successive destructions (pointer window + ancestors including its 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)
    wm withdraw .one
    toplevel .two
    pack propagate .two 0
    wm geometry .two 300x300+100+100
    create_and_pack_frames .two
    wm deiconify .two
    waitForWindowEvent .two.f1.f2 <Enter>
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    set result "|"
} -body {
    destroy .two
    _pause 200; # service events (only screen drawing events expected)
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|}

# cleanup
update
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
rename _keypress_lookup {}
rename _keypress {}
rename _pause {}
rename _text_ind_to_x_y {}
rename _get_selection {}
rename create_and_pack_frames {}
rename setup_win_mousepointer {}

cleanupTests
return