Tk Source Code

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

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

          if [ $nmatches -lt 4 ]
          then
            echo "::error::Failure during Test"
            exit 1
          fi
        timeout-minutes: 30
  clang:
    runs-on: macos-11
    runs-on: macos-12
    strategy:
      matrix:
        symbols:
          - 'no'
          - 'mem'
        options:
          - '--enable-aqua'

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

/*
 * Forward declarations for functions defined later in this file:
 */

static int		ImageObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestProcessEventsObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestbitmapObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);
static int		TestborderObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj * const objv[]);

     * Create additional commands for testing Tk.
     */

    if (Tcl_PkgProvideEx(interp, "Tktest", TK_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "testprocessevents", TestProcessEventsObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "square", SquareObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbitmap", TestbitmapObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testborder", TestborderObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);
    Tcl_CreateObjCommand(interp, "testcolor", TestcolorObjCmd,
	    (ClientData) Tk_MainWindow(interp), NULL);

	    TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);

    Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
    ckfree(timPtr->imageName);
    ckfree(timPtr->varName);
    ckfree(timPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestProcessEventsObjCmd --
 *
 *      This function implements the "testprocessevents" command which processes
 *      all queued events of a type specified by one of the arguments to the
 *      command.  Currently the supported arguments are leave, enter, motion,
 *      and expose.  Others could be added if needed.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Events are processed
 *
 *----------------------------------------------------------------------
 */

static Tk_RestrictAction
CrossingRestrictProc(
    ClientData arg,
    XEvent *eventPtr)
{
    int *eventTypes = (int *) arg;
    for (int *t = eventTypes; *t != 0; t++) {
	if (eventPtr->type == *t) {
	    return TK_PROCESS_EVENT;
	}
    }
    return TK_DEFER_EVENT;	
}

static int TestProcessEventsObjCmd(
    TCL_UNUSED(ClientData),	/* Main window for application. */
    Tcl_Interp* interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj* const objv[])	/* Argument objects. */
{
    ClientData oldArg;
    Tk_RestrictProc *oldProc;
    int index;
    static const char *const eventTypeNames[] = {
	"leave", "enter", "motion", "expose", NULL};
    static const int eventTypes[] = {
	LeaveNotify, EnterNotify, MotionNotify, Expose};
#define NUM_TYPES (sizeof(eventTypes)/sizeof(int))
    int whichEvents[1 + NUM_TYPES];
    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "eventtype ?eventtype ...?");
        return TCL_ERROR;
    }
    if (objc > NUM_TYPES + 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "too many event types");
        return TCL_ERROR;
    }
#undef NUM_TYPES
    for (int n = 1; n < objc; n++) {
	if (Tcl_GetIndexFromObj(interp, objv[n], eventTypeNames, "eventtype", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	whichEvents[n - 1] = eventTypes[index];
    }
    whichEvents[objc - 1] = 0;
    oldProc = Tk_RestrictEvents(CrossingRestrictProc, (void *) whichEvents,
				&oldArg);
    while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT)) {};
    Tk_RestrictEvents(oldProc, oldArg, &oldArg);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestmakeexistObjCmd --
 *
 *	This function implements the "testmakeexist" command. It calls

static void		DeleteWindowsExitProc(ClientData clientData);
static TkDisplay *	GetScreen(Tcl_Interp *interp, const char *screenName,
			    int *screenPtr);
static int		Initialize(Tcl_Interp *interp);
static int		NameWindow(Tcl_Interp *interp, TkWindow *winPtr,
			    TkWindow *parentPtr, const char *name);
static void		UnlinkWindow(TkWindow *winPtr);

/*
 * This static variable only makes sense for macOS and Windows, which never
 * have more than one display.  It is set by TkCloseDisplay, and when set
 * prevents sending Enter and Leave events when all of the windows in the
 * display are being destroyed.  Tk does not send those events on X11; that
 * job is handled by the X server.
 */

static int displayBeingClosed = 0;


/*
 *----------------------------------------------------------------------
 *
 * TkCloseDisplay --
 *
 *	Closing the display can lead to order of deletion problems. We defer

 *----------------------------------------------------------------------
 */

static void
TkCloseDisplay(
    TkDisplay *dispPtr)
{
    displayBeingClosed = 1;
    TkClipCleanup(dispPtr);

    TkpCancelWarp(dispPtr);

    if (dispPtr->name != NULL) {
	ckfree(dispPtr->name);
    }

 * Side effects:
 *	The window is deleted, along with all of its children. Relevant
 *	callback functions are invoked.
 *
 *--------------------------------------------------------------
 */

#if defined(MAC_OSX_TK) || defined(_WIN32)
static void SendEnterLeaveForDestroy(
    Tk_Window tkwin)
{
    int x, y;
    unsigned int state;
    Tk_Window pointerWin;
    TkWindow *containerPtr;

    if (displayBeingClosed) {
	return;
    }
    XQueryPointer(Tk_Display(tkwin), None, NULL, NULL, &x, &y,
		  NULL, NULL, &state);
    pointerWin = Tk_CoordsToWindow(x, y, tkwin);
    if (pointerWin == tkwin) {
	if (!Tk_IsTopLevel(tkwin)) {
	    containerPtr = TkGetContainer((TkWindow *)pointerWin);
	    Tk_UpdatePointer((Tk_Window) containerPtr, x, y, state);
	}
    }
    
    if (pointerWin && (tkwin == Tk_Parent(pointerWin))) {
	Tk_UpdatePointer(Tk_Parent(tkwin), x, y, state);
    }
}
#else
static void SendEnterLeaveForDestroy(
    TCL_UNUSED(Tk_Window))
{
}
#endif

void
Tk_DestroyWindow(
    Tk_Window tkwin)		/* Window to destroy. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    XEvent event;
    TkHalfdeadWindow *halfdeadPtr, *prev_halfdeadPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->flags & TK_ALREADY_DEAD) {
	/*
	 * A destroy event binding caused the window to be destroyed again.
	 * Ignore the request.
	 */

	return;
    }
    if ((winPtr->flags & TK_DONT_DESTROY_WINDOW) == 0) {
	SendEnterLeaveForDestroy(tkwin);
    }
    
    winPtr->flags |= TK_ALREADY_DEAD;

    /*
     * Unless we are cleaning up a half dead window from
     * DeleteWindowsExitProc, add this window to the half dead list.
     */

	Tcl_Panic("window not found on half dead list");
    }

    /*
     * Cleanup the data structures associated with this window.
     */

    if (winPtr->flags & TK_WIN_MANAGED) {
    if (winPtr->wmInfoPtr && (winPtr->flags & TK_WIN_MANAGED)) {
	TkWmDeadWindow(winPtr);
    } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
	TkWmRemoveFromColormapWindows(winPtr);
    }
    if (winPtr->window != None) {
#if defined(MAC_OSX_TK) || defined(_WIN32)
	XDestroyWindow(winPtr->display, winPtr->window);

				 * then tkwin goes above or below all windows
				 * in the same parent. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkWindow *otherPtr = (TkWindow *) other;

    /*
     * Special case: if winPtr is a top-level window then just find the
     * Special case: if winPtr is a toplevel window then just find the
     * top-level ancestor of otherPtr and restack winPtr above otherPtr
     * without changing any of Tk's childLists.
     */

    if (winPtr->flags & TK_WIN_MANAGED) {
	while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_HIERARCHY)) {
	    otherPtr = otherPtr->parentPtr;

    void *clientdata)
{
    Bool doCleanup = doCleanupFromExit;
    if (doCleanupFromExit) {
	doCleanupFromExit = NO; /* prevent possible recursive call. */
	closePanels();
    }

    /*
     * At this point it is too late to be looking up the Tk window associated
     * to any NSWindows, but it can happen.  This makes sure the answer is None
     * if such a query is attempted. 
     */
    
    for (TKWindow *w in [NSApp orderedWindows]) {
	if ([w respondsToSelector: @selector (tkWindow)]) {
	    [w setTkWindow: None];
	}
    }

    /*
     * Tcl_Exit does not call Tcl_Finalize if there is an exit proc installed.
     */

    Tcl_Finalize();
    if (doCleanup == YES) {

	     * we make sure that the button state appears the way that Tk
	     * expects.
	     */

	    state |= TkGetButtonMask(Button1);
	}
	if (eventType == NSMouseEntered) {
	    Tk_Window new_win = Tk_CoordsToWindow(global.x, global.y,
	    Tk_UpdatePointer((Tk_Window) [NSApp tkPointerWindow],
				 global.x, global.y, state);
		 (Tk_Window) [NSApp tkPointerWindow]);
	    Tk_UpdatePointer(new_win, global.x, global.y, state);
	} else if (eventType == NSMouseExited) {
	    if ([NSApp tkDragTarget]) {
	    	Tk_UpdatePointer((Tk_Window) [NSApp tkDragTarget],
	    			 global.x, global.y, state);
	    } else {
	    Tk_UpdatePointer(NULL, global.x, global.y, state);
	    }

    MacDrawable *macWin = (MacDrawable *)window;

    /*
     * Remove any dangling pointers that may exist if the window we are
     * deleting is being tracked by the grab code.
     */

    TkPointerDeadWindow(macWin->winPtr);
    TkMacOSXSelDeadWindow(macWin->winPtr);
    TkMacOSXSelDeadWindow(macWin->winPtr);
    TkPointerDeadWindow(macWin->winPtr);
    macWin->toplevel->referenceCount--;

    if (!Tk_IsTopLevel(macWin->winPtr)) {
	TkMacOSXInvalidateWindow(macWin, TK_PARENT_WINDOW);
	if (macWin->winPtr->parentPtr != NULL) {
	    TkMacOSXInvalClipRgns((Tk_Window)macWin->winPtr->parentPtr);
	}

- (void) windowMapped: (NSNotification *) notification
{
    NSWindow *w = [notification object];
    TkWindow *winPtr = TkMacOSXGetTkWindow(w);

    if (winPtr) {
	while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}
   	while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}
    }
}

- (void) windowLiveResize: (NSNotification *) notification
{
    NSString *name = [notification name];
    if ([name isEqualToString:NSWindowWillStartLiveResizeNotification]) {

- (void) windowUnmapped: (NSNotification *) notification
{
    TKLog(@"-[%@(%p) %s] %@", [self class], self, sel_getName(_cmd), notification);
    NSWindow *w = [notification object];
    TkWindow *winPtr = TkMacOSXGetTkWindow(w);

#if 0
    if (winPtr) {
	//Tk_UnmapWindow((Tk_Window)winPtr);
        Tk_UnmapWindow((Tk_Window)winPtr);
    }
#endif
}

#endif /* TK_MAC_DEBUG_NOTIFICATIONS */

- (void) _setupWindowNotifications
{
    NSNotificationCenter *nc = [NSNotificationCenter defaultCenter];

    NSPoint p = NSMakePoint(x, TkMacOSXZeroScreenHeight() - y);
    NSArray *windows = [NSApp orderedWindows];
    TkWindow *winPtr = NULL;

    for (NSWindow *w in windows) {
	winPtr = TkMacOSXGetTkWindow(w);
	if (winPtr) {
	    WmInfo *wmPtr = winPtr->wmInfoPtr;
	    NSRect windowFrame = [w frame];
	    NSRect contentFrame = [w frame];

	    contentFrame.size.height = [[w contentView] frame].size.height;
	    /*
	     * For consistency with other platforms, points in the
	     * title bar are not considered to be contained in the
	     * window.
	     */

	    if ((wmPtr->hints.initial_state == NormalState ||
		    wmPtr->hints.initial_state == ZoomState)) {
		if (NSMouseInRect(p, contentFrame, NO)) {
		    return winPtr;
		} else if (NSMouseInRect(p, windowFrame, NO)) {
		    return NULL;
	    if (NSMouseInRect(p, contentFrame, NO)) {
		return winPtr;
	    } else if (NSMouseInRect(p, windowFrame, NO)) {
		/*
		 * The pointer is in the title bar of the highest NSWindow
		 * containing it, and therefore is should not be considered
		 * to be contained in any Tk window.
		 */
		return NULL;
		}
	    }
	}
    }
    return NULL;
}

/*

/*
 *----------------------------------------------------------------------
 *
 * TkWmDeadWindow --
 *
 *	This procedure is invoked when a top-level window is about to be
 *	deleted. It cleans up the wm-related data structures for the window.
 *      If the dead window contains the pointer, TkUpdatePointer is called
 *      to tell Tk which window will be the new pointer window. 
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The WmInfo structure for winPtr gets freed up.
 *	The WmInfo structure for winPtr gets freed.  Tk's cached pointer
 *      window may change.
 *
 *----------------------------------------------------------------------
 */

void
TkWmDeadWindow(
    TkWindow *winPtr)		/* Top-level window that's being deleted. */
{
    TkWindow *winPtr2;
    WmInfo *wmPtr = winPtr->wmInfoPtr, *wmPtr2;
    TKWindow *deadNSWindow;

    if (wmPtr == NULL) {
    TKWindow *deadNSWindow = (TKWindow *)TkMacOSXGetNSWindowForDrawable(
	Tk_WindowId(winPtr));
    if (deadNSWindow == NULL) {
	return;
    }

    /*
     *If the dead window is a transient, remove it from the container's list.
     */

    RemoveTransient(winPtr);
    Tk_ManageGeometry((Tk_Window)winPtr, NULL, NULL);
    Tk_DeleteEventHandler((Tk_Window)winPtr, StructureNotifyMask,

    while (wmPtr->transientPtr != NULL) {
	Transient *transientPtr = wmPtr->transientPtr;

	wmPtr->transientPtr = transientPtr->nextPtr;
	ckfree(transientPtr);
    }

    deadNSWindow = (TKWindow *)wmPtr->window;

    /*
     * Remove references to the Tk window from the mouse event processing
     * state which is recorded in the NSApplication object.
     * state which is recorded in the NSApplication object and notify Tk
     * of the new pointer window.
     */

    if (winPtr == [NSApp tkPointerWindow]) {
	NSWindow *w;
    NSPoint mouse = [NSEvent mouseLocation];
    NSWindow *w;
	NSPoint mouse = [NSEvent mouseLocation];
	[NSApp setTkPointerWindow:nil];
	for (w in [NSApp orderedWindows]) {
	    if (w == deadNSWindow) {
		continue;
	    }
	    if (NSPointInRect(mouse, [w frame])) {
    [NSApp setTkPointerWindow:nil];
    winPtr2 = NULL;
    
    for (w in [NSApp orderedWindows]) {
	if (w == deadNSWindow || w == NULL) {
	    continue;
	}
	winPtr2 = TkMacOSXGetTkWindow(w);
	if (winPtr2 == NULL) {
	    continue;
	}
	if (NSPointInRect(mouse, [w frame])) {
		TkWindow *winPtr2 = TkMacOSXGetTkWindow(w);
		int x = mouse.x, y = TkMacOSXZeroScreenHeight() - mouse.y;
		[NSApp setTkPointerWindow:winPtr2];
	    [NSApp setTkPointerWindow: winPtr2];
		Tk_UpdatePointer((Tk_Window) winPtr2, x, y,
				 [NSApp tkButtonState]);
		break;
	    }
	    break;
	}
    }
    if (winPtr2) {
	/*
	 * We now know which toplevel will contain the pointer when the window
	 * is destroyed.  We need to know which Tk window within the
	 * toplevel will contain the pointer.
	 */
	NSPoint local = [w tkConvertPointFromScreen: mouse];
	int top_x = floor(local.x),
	    top_y = floor(w.frame.size.height - local.y);
	int root_x = floor(mouse.x),
	    root_y = floor(TkMacOSXZeroScreenHeight() - mouse.y);
	int win_x, win_y;
	Tk_Window target = Tk_TopCoordsToWindow((Tk_Window) winPtr2, top_x, top_y, &win_x, &win_y);
	/*
	 * A non-toplevel window can have a NULL parent while it is in the process of
	 * being destroyed.  We should not call Tk_UpdatePointer in that case.
	 */
	if (Tk_Parent(target) != NULL || Tk_IsTopLevel(target)) {
	    Tk_UpdatePointer(target, root_x, root_y, [NSApp tkButtonState]);
	}
    }

    /*
     * Unregister the NSWindow and remove all references to it from the Tk
     * data structures.  If the NSWindow is a child, disassociate it from
     * the parent.  Then close and release the NSWindow.

	/*
	 * Fix bug 5692042764:
	 * set tkEventTarget to NULL when there is no window to send Tk events to.
	 */
	TkWindow *newTkEventTarget = NULL;
	winPtr2 = NULL;

	for (NSWindow *w in [NSApp orderedWindows]) {
	    TkWindow *winPtr2 = TkMacOSXGetTkWindow(w);
	    winPtr2 = TkMacOSXGetTkWindow(w);
	    BOOL isOnScreen;

	    if (!winPtr2 || !winPtr2->wmInfoPtr) {
		continue;
	    }
	    wmPtr2 = winPtr2->wmInfoPtr;
	    isOnScreen = (wmPtr2->hints.initial_state != IconicState &&

    	Tk_UnmapWindow(frameWin);

	macWin->toplevel->referenceCount--;
	macWin->toplevel = winPtr->parentPtr->privatePtr->toplevel;
	macWin->toplevel->referenceCount++;
	macWin->flags &= ~TK_HOST_EXISTS;

	TkWmDeadWindow(winPtr);
	RemapWindows(winPtr, (MacDrawable *)winPtr->parentPtr->window);

        /*
         * Make sure wm no longer manages this window
         */
        Tk_ManageGeometry(frameWin, NULL, NULL);

	winPtr->flags |=
		(TK_TOP_HIERARCHY|TK_TOP_LEVEL|TK_HAS_WRAPPER|TK_WIN_MANAGED);
	TkMapTopFrame(frameWin);
	TkWmMapWindow(winPtr);
    } else if (Tk_IsTopLevel(frameWin)) {
	/* Already managed by wm - ignore it */
    }
    Tk_ManageGeometry((Tk_Window)winPtr, &wmMgrType, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * WmMaxsizeCmd --

    $e get 1.0 1.end
} -cleanup {
    deleteWindows
} -result {MEL}
test event-2.6(keypress) {type into text widget, triple click,
    hit Delete key, and then type some more} -setup {
	deleteWindows
	update idletasks
} -body {
    set t [toplevel .t]
    set e [text $t.e]
    pack $e
    tkwait visibility $e
    _keypress_string $e JUMP

                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>]
} -body {
    wm geometry . 200x200+300+300
    wm deiconify .
    _pause 200
    toplevel .top2 -width 200 -height 200
    wm geometry .top2 +[expr {[winfo rootx .]+50}]+[expr {[winfo rooty .]+50}]
    wm deiconify .top2
    raise .top2
    _pause 400
    event generate .top2 <Motion> -warp 1 -x 50 -y 50
    _pause 100

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

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
    update idletasks
}

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+400; # 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 {($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; # needed for Windows
    update idletasks; # finish display of window
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1.f2
    if {[tk windowingsystem] ne "x11"} {
        testprocessevents enter leave
    } else {
	update
    }
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyInferior .one.f1|}

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
    event generate .one <Motion> -warp 1 -x 250 -y 250
    _pause 200; # needed for Windows
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.g
    if {[tk windowingsystem] ne "x11"} {
        testprocessevents enter leave
    } else {
	update
    }
    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
    toplevel .two
    wm geometry .two 300x300+150+150
    wm withdraw .two
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    update idletasks; # finish displaying windows
    set result |
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .two
    waitForWindowEvent .one <Enter>
    if {[tk windowingsystem] ne "x11"} {
        testprocessevents enter leave
    } else {
    bind . <Enter> {lappend res %W}
    set res [list ]
    destroy .top2
    _pause 200
    set res
	update
    }
    set result
} -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 {
    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>
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .two
    waitForWindowEvent .one.f1.f2 <Enter>
    testprocessevents enter leave
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    unset result
} -result {|<Enter> NotifyNonlinearVirtual .one|<Enter> NotifyNonlinearVirtual .one.f1|<Enter> NotifyNonlinear .one.f1.f2|}
    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 .
        update

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)
#    destroy .one
    toplevel .two
    wm geometry .two 300x300+150+150
    wm deiconify .two
    waitForWindowEvent .two <Enter>
    update idletasks; # finish displaying .two
    event generate .two <Motion> -warp 1 -x 275 -y 275
    controlPointerWarpTiming
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .two
    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
    update idletasks; # finish displaying window
    _pause 200; # needed for Windows
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1
    if {[tk windowingsystem] ne "x11"} {
        testprocessevents enter leave
    } else {
	update
        set iconified true
    }
    set result
} -body {
    toplevel .top1
    wm geometry .top1 200x200+300+300
    wm deiconify .top1
    _pause 200
} -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
    update idletasks; # finish displaying window
    _pause 200; # needed for Windows
    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
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .one.f1.f2
    update; # make sure window is gone
    destroy .one.f1
    update; # make sure window is gone
    if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave}
    set result
    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
} -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>
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .two
    waitForWindowEvent .one <Enter>
    if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave}
    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)
#    destroy .one
    toplevel .two
    pack propagate .two 0
    wm geometry .two 300x300+100+100
    create_and_pack_frames .two
    wm deiconify .two
    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>
    update idletasks; # finish displaying windows
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .three
    waitForWindowEvent .two.f1.f2 <Enter>
    update idletasks; #finish destroying .two
    if {[tk windowingsystem] ne "x11"} {testprocessevents enter leave}
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    destroy .one
    destroy .two
    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)
    destroy .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>
    set result "|"
} -body {
    bind all <Leave> {append result "<Leave> %d %W|"}
    bind all <Enter> {append result "<Enter> %d %W|"}
    destroy .two
    update idletasks; #finish destroying .two
    set result
} -cleanup {
    bind all <Leave> {}
    bind all <Enter> {}
    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

    set text Hello!
    destroy .t.c
    set c [canvas .t.c]
    set textid [$c create text 20 20 -font MyFont -text $text -anchor nw]
    set twidth [font measure MyFont $text]
    set theight [font metrics MyFont -linespace]
    set circid [$c create polygon \
		    15                    15 \
		    [expr {15 + $twidth}] 15 \
		    [expr {15 + $twidth}] [expr {15 + $theight}] \
		    15                    [expr {15 + $theight}] \
		    -width 1 -joinstyle round -smooth true -fill {} -outline blue]
        15                    15 \
        [expr {15 + $twidth}] 15 \
        [expr {15 + $twidth}] [expr {15 + $theight}] \
        15                    [expr {15 + $theight}] \
            -width 1 -joinstyle round -smooth true -fill {} -outline blue]
    pack $c -fill both -expand 1 -side top
    update

    # Lamda test functions
    # Lambda test functions
    set circle_text {{w user_data text circ} {
	if {[winfo class $w] ne "Canvas"} {
	    puts "Wrong widget type: $w"
	    return
	}
	if {$user_data ne "FontChanged"} {
	    return

    }}
    set enclosed {{can id} {$can find enclosed {*}[$can bbox $id]}}

    set results {}
    apply $circle_text $c FontChanged $textid $circid
    update
    bind $c <<TkWorldChanged>> [list apply $circle_text %W %d $textid $circid]
    update idletasks

    # Begin test:
    set results {}
    lappend results [apply $enclosed $c $circid]
    font configure MyFont -size 26
    update  ; # services the "TheWorldHasChanged" event, queues "TkWorldChanged" events
    update  ; # services the queued "TkWorldChanged" events

    } $geom
    incr i
}

set i 1
foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" {
    test unixWm-3.$i {moving window while iconified} unix {
        update
	wm iconify .t
	update idletasks
	wm geom .t $geom
	update idletasks
	wm deiconify .t
	update idletasks
	scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y

test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix {
    list [catch {wm deiconify .t 12} msg] $msg
} {1 {wrong # args: should be "wm deiconify window"}}
test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} unix {
    destroy .icon
    toplevel .icon -width 50 -height 50 -bg red
    # calling update here prevents a crash in 16.3 on macOS
    update
    wm iconwindow .t .icon
    set result [list [catch {wm deiconify .icon} msg] $msg]
    destroy .icon
    set result
} {1 {can't deiconify .icon: it is an icon for .t}}
test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {unix failsOnUbuntu failsOnXQuarz} {
    wm iconify .t

    set result [list [catch {wm withdraw .t2} msg]  $msg]
    destroy .t2
    set result
} {1 {can't withdraw .t2: it is an icon for .t}}
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix {
    set result {}
    wm withdraw .t
    #added to avoid a crash on macOS
    update idletasks
    lappend result [wm state .t] [winfo ismapped .t]
    wm deiconify .t
    #added to avoid a crash on macOS
    update idletasks
    lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}

test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} unix {
    list [catch {wm unknown .t} msg] $msg
} {1 {bad option "unknown": must be aspect, attributes, client, colormapwindows, command, deiconify, focusmodel, forget, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconphoto, iconposition, iconwindow, manage, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, stackorder, state, title, transient, or withdraw}}

destroy .t .icon

test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {unix nonPortable} {
    destroy .t
    toplevel .t
    wm geometry .t 30x10+0+0
    listbox .t.l -height 20 -width 20 -setgrid 1
    pack .t.l -fill both -expand 1
    update
    wm geometry .t
} {30x10+0+0}
test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} unix {
    update
    destroy .t
    update
    toplevel .t
    wm geometry .t 200x100+100+$Y0
    listbox .t.l -height 20 -width 20
    pack .t.l -fill both -expand 1
    update
    .t.l configure -setgrid 1
    update

    testmenubar window .t .t.m
    update
    list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
	    [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
} {52 7 12 62}

deleteWindows
# Make sure that the root window is out of the way!
wm geom . +700+700
wm withdraw .
if {[tk windowingsystem] eq "aqua"} {
    # Modern mac windows have no border.
    set result_50_1 {{} {} .t .t .t2 {} .t2 .t .t}
} else {
    # Windows are assumed to have a border (invisible in Gnome 3).
    set result_50_1 {{} {} .t {} .t2 {} .t2 {} .t}

} -cleanup {
    deleteWindows
} -result {child 0 parent 0}

test winfo-13.4 {[winfo containing] with embedded windows} -setup {
    deleteWindows
} -body {
    wm geometry . +100+100
    frame .con -container 1
    pack .con -expand yes -fill both
    update
    toplevel .emb -use [winfo id .con] -bd 0 -highlightthickness 0
    button .emb.b
    pack .emb.b -expand yes -fill both
    update

    button .b
    pack .b -expand yes -fill both

    wm iconwindow .t2 .icon
    wm iconwindow .t .icon
} -returnCodes error -cleanup {
    destroy .t2 .icon
} -result {.icon is already an icon for .t2}

test wm-iconwindow-2.1 {setting and reading values} -setup {
    # without this macOS crashes for unknown reasons
    wm iconwindow .t {}
    destroy .icon
    set result {}
} -body {
    lappend result [wm iconwindow .t]
    toplevel .icon -width 50 -height 50 -bg green
    wm iconwindow .t .icon
    lappend result [wm iconwindow .t]

    } msg4]

    if {$err0 || $err1 || $err2 || $err3 || $err4} {
	    error [list $msg0 $msg1 $msg2 $msg3 $msg4]
    }
    catch {unset foo}
    destroy .foo
    update
}

# ----------------------------------------------------------------------

test xmfbox-1.1 {tk::MotifFDialog_Create, -parent switch} -constraints {
    unix
} -setup {

    unix
} -setup {
    catch {unset foo}
    deleteWindows
} -body {
    toplevel .bar
    wm geometry .bar +0+0
    update
    set x [tk::MotifFDialog_Create foo open {-parent .bar}]
} -cleanup {
    destroy $x
    destroy .bar
}  -result {.bar.foo}


test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} -constraints {
    unix
} -body {
    cleanup
    file mkdir ./~nosuchuser1
    set x [tk::MotifFDialog_Create foo open {}]
    update
    $::tk::dialog::file::foo(fEnt) delete 0 end
    $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
    set kk [tk::MotifFDialog_InterpFilter $x]
} -result "$testPWD/~nosuchuser1 *"

test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} -constraints {
    unix
} -body {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tk::MotifFDialog_Create foo open {}]
    update
    $::tk::dialog::file::foo(fEnt) delete 0 end
    $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
    set kk [tk::MotifFDialog_InterpFilter $x]
} -result "$testPWD ./~nosuchuser1"

test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} -constraints {
    unix
} -body {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tk::MotifFDialog_Create foo open {}]
    update
    $::tk::dialog::file::foo(fEnt) delete 0 end
    $::tk::dialog::file::foo(fEnt) insert 0 [pwd]/~nosuchuser1
    tk::MotifFDialog_InterpFilter $x
    tk::MotifFDialog_Update $x
    $::tk::dialog::file::foo(fList) get end
} -result {~nosuchuser1}

test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} -constraints {
    unix
} -body {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tk::MotifFDialog_Create foo open {}]
    update
    set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
    expr {$i >= 0}
} -result 1

test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} -constraints {
    unix
} -body {
    cleanup
    close [open ./~nosuchuser1 {CREAT TRUNC WRONLY}]
    set x [tk::MotifFDialog_Create foo open {}]
    update
    set i [lsearch [$::tk::dialog::file::foo(fList) get 0 end] ~nosuchuser1]
    $::tk::dialog::file::foo(fList) selection clear 0 end
    $::tk::dialog::file::foo(fList) selection set $i
    tk::MotifFDialog_BrowseFList $x
    $::tk::dialog::file::foo(sEnt) get
} -result "$testPWD/~nosuchuser1"

 *	None.
 *
 * Side effects:
 *	The WmInfo structure for winPtr gets freed up.
 *
 *--------------------------------------------------------------
 */

static void CheckForPointer(TkWindow *winPtr)
{
    POINT mouse;
    int x, y;
    unsigned int state = TkWinGetModifierState();
    TkWindow **windows = TkWmStackorderToplevel(winPtr->mainPtr->winPtr);
    TkWindow **w;
    TkGetPointerCoords(NULL, &x, &y);
    mouse.x = x;
    mouse.y = 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(x, y, (Tk_Window) *w);
		Tk_UpdatePointer((Tk_Window) target, x, y, state);
		break;
	    }
	}
	ckfree(windows);
    }
}

void
TkWmDeadWindow(
    TkWindow *winPtr)		/* Top-level window that's being deleted. */
{
    WmInfo *wmPtr = winPtr->wmInfoPtr;
    WmInfo *wmPtr2;

	 * after destroying the decorative frame, because the decorative frame
	 * is using this icon.
	 */

	DecrIconRefCount(wmPtr->iconPtr);
    }

    /*
     * Check if the dead window is a toplevel containing the pointer.  If so,
     * find the window which will inherit the pointer and call
     * TkUpdatePointer.
     */

    CheckForPointer(winPtr);
    ckfree(wmPtr);
    winPtr->wmInfoPtr = NULL;
}

/*
 *--------------------------------------------------------------
 *

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