summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tkWindow.c53
-rw-r--r--macosx/tkMacOSXInit.c12
-rw-r--r--macosx/tkMacOSXMouseEvent.c5
-rw-r--r--macosx/tkMacOSXSubwindows.c2
-rw-r--r--macosx/tkMacOSXTest.c2
-rw-r--r--macosx/tkMacOSXWindowEvent.c6
-rw-r--r--macosx/tkMacOSXWm.c104
-rw-r--r--tests/event.test478
-rw-r--r--tests/font.test13
-rw-r--r--tests/pack.test14
-rw-r--r--tests/ttk/ttk.test5
-rw-r--r--tests/unixWm.test11
-rw-r--r--tests/winfo.test2
-rw-r--r--tests/wm.test2
-rw-r--r--tests/xmfbox.test7
-rw-r--r--win/tkWinWm.c36
16 files changed, 601 insertions, 151 deletions
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 68f3406..64f6ce0 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -215,6 +215,17 @@ 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;
+
/*
*----------------------------------------------------------------------
@@ -239,6 +250,7 @@ static void
TkCloseDisplay(
TkDisplay *dispPtr)
{
+ displayBeingClosed = 1;
TkClipCleanup(dispPtr);
if (dispPtr->name != NULL) {
@@ -1334,6 +1346,39 @@ Tk_CreateWindowFromPath(
*--------------------------------------------------------------
*/
+#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. */
@@ -1353,6 +1398,10 @@ Tk_DestroyWindow(
return;
}
+ if ((winPtr->flags & TK_DONT_DESTROY_WINDOW) == 0) {
+ SendEnterLeaveForDestroy(tkwin);
+ }
+
winPtr->flags |= TK_ALREADY_DEAD;
/*
@@ -1523,7 +1572,7 @@ Tk_DestroyWindow(
* 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);
@@ -2612,7 +2661,7 @@ Tk_RestackWindow(
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.
*/
diff --git a/macosx/tkMacOSXInit.c b/macosx/tkMacOSXInit.c
index 185d923..b1f6855 100644
--- a/macosx/tkMacOSXInit.c
+++ b/macosx/tkMacOSXInit.c
@@ -423,6 +423,18 @@ TCL_NORETURN void TkpExitProc(
}
/*
+ * 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.
*/
diff --git a/macosx/tkMacOSXMouseEvent.c b/macosx/tkMacOSXMouseEvent.c
index 83d2cd2..9eca985 100644
--- a/macosx/tkMacOSXMouseEvent.c
+++ b/macosx/tkMacOSXMouseEvent.c
@@ -504,8 +504,9 @@ enum {
state |= Tk_GetButtonMask(Button1);
}
if (eventType == NSMouseEntered) {
- Tk_UpdatePointer((Tk_Window) [NSApp tkPointerWindow],
- global.x, global.y, state);
+ Tk_Window new_win = Tk_CoordsToWindow(global.x, global.y,
+ (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],
diff --git a/macosx/tkMacOSXSubwindows.c b/macosx/tkMacOSXSubwindows.c
index 0c4e4e4..2ba8568 100644
--- a/macosx/tkMacOSXSubwindows.c
+++ b/macosx/tkMacOSXSubwindows.c
@@ -65,8 +65,8 @@ XDestroyWindow(
* deleting is being tracked by the grab code.
*/
- TkPointerDeadWindow(macWin->winPtr);
TkMacOSXSelDeadWindow(macWin->winPtr);
+ TkPointerDeadWindow(macWin->winPtr);
macWin->toplevel->referenceCount--;
if (!Tk_IsTopLevel(macWin->winPtr)) {
diff --git a/macosx/tkMacOSXTest.c b/macosx/tkMacOSXTest.c
index f6a1f0c..19feb8d 100644
--- a/macosx/tkMacOSXTest.c
+++ b/macosx/tkMacOSXTest.c
@@ -140,6 +140,8 @@ MenuBarHeightObjCmd(
* Returns true if and only if the NSView of the drawable is the
* current focusView, which on 10.14 and newer systems can only be the
* case when within [NSView drawRect].
+ * NOTE: This is no longer needed when we use updateLayer instead
+ * of drawRect. Now it always returns True.
*
* Side effects:
* None
diff --git a/macosx/tkMacOSXWindowEvent.c b/macosx/tkMacOSXWindowEvent.c
index bd5e2e6..bd5ea2d 100644
--- a/macosx/tkMacOSXWindowEvent.c
+++ b/macosx/tkMacOSXWindowEvent.c
@@ -256,7 +256,7 @@ extern NSString *NSWindowDidOrderOffScreenNotification;
TkWindow *winPtr = TkMacOSXGetTkWindow(w);
if (winPtr) {
- while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {}
}
}
@@ -284,9 +284,11 @@ extern NSString *NSWindowDidOrderOffScreenNotification;
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 */
diff --git a/macosx/tkMacOSXWm.c b/macosx/tkMacOSXWm.c
index 4d5ea7e..c01d506 100644
--- a/macosx/tkMacOSXWm.c
+++ b/macosx/tkMacOSXWm.c
@@ -826,7 +826,6 @@ FrontWindowAtPoint(
for (NSWindow *w in windows) {
winPtr = TkMacOSXGetTkWindow(w);
if (winPtr) {
- WmInfo *wmPtr = winPtr->wmInfoPtr;
NSRect windowFrame = [w frame];
NSRect contentFrame = [w frame];
@@ -837,13 +836,15 @@ FrontWindowAtPoint(
* 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;
}
}
}
@@ -1102,12 +1103,15 @@ TkWmUnmapWindow(
*
* 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.
*
*----------------------------------------------------------------------
*/
@@ -1116,13 +1120,14 @@ void
TkWmDeadWindow(
TkWindow *winPtr) /* Top-level window that's being deleted. */
{
+ TkWindow *winPtr2;
+ NSWindow *w;
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.
*/
@@ -1174,11 +1179,10 @@ TkWmDeadWindow(
for (Transient *transientPtr = wmPtr->transientPtr;
transientPtr != NULL; transientPtr = transientPtr->nextPtr) {
- TkWindow *winPtr2 = transientPtr->winPtr;
- TkWindow *containerPtr = (TkWindow *)TkMacOSXGetContainer(winPtr2);
-
+ TkWindow *containerPtr = (TkWindow *)TkMacOSXGetContainer(
+ transientPtr->winPtr);
if (containerPtr == winPtr) {
- wmPtr2 = winPtr2->wmInfoPtr;
+ wmPtr2 = transientPtr->winPtr->wmInfoPtr;
wmPtr2->container = NULL;
}
}
@@ -1190,29 +1194,48 @@ TkWmDeadWindow(
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];
- [NSApp setTkPointerWindow:nil];
- for (w in [NSApp orderedWindows]) {
- if (w == deadNSWindow) {
- continue;
- }
- if (NSPointInRect(mouse, [w frame])) {
- TkWindow *winPtr2 = TkMacOSXGetTkWindow(w);
- int x = mouse.x, y = TkMacOSXZeroScreenHeight() - mouse.y;
- [NSApp setTkPointerWindow:winPtr2];
- Tk_UpdatePointer((Tk_Window) winPtr2, x, y,
- [NSApp tkButtonState]);
- break;
- }
+ NSPoint mouse = [NSEvent mouseLocation];
+ [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])) {
+ [NSApp setTkPointerWindow: winPtr2];
+ 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]);
}
}
@@ -1264,9 +1287,10 @@ TkWmDeadWindow(
* 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);
+ for (w in [NSApp orderedWindows]) {
+ winPtr2 = TkMacOSXGetTkWindow(w);
BOOL isOnScreen;
if (!winPtr2 || !winPtr2->wmInfoPtr) {
@@ -2543,7 +2567,6 @@ WmForgetCmd(
macWin->toplevel->referenceCount++;
macWin->flags &= ~TK_HOST_EXISTS;
- TkWmDeadWindow(winPtr);
RemapWindows(winPtr, (MacDrawable *)winPtr->parentPtr->window);
/*
@@ -3490,6 +3513,7 @@ WmManageCmd(
} else if (Tk_IsTopLevel(frameWin)) {
/* Already managed by wm - ignore it */
}
+ Tk_ManageGeometry((Tk_Window)winPtr, &wmMgrType, NULL);
return TCL_OK;
}
@@ -6029,7 +6053,7 @@ Tk_Window
TkMacOSXGetContainer(
TkWindow *winPtr)
{
- if (winPtr->wmInfoPtr != NULL) {
+ if (Tk_PathName(winPtr)) {
return (Tk_Window)winPtr->wmInfoPtr->container;
}
return NULL;
diff --git a/tests/event.test b/tests/event.test
index c56d4d8..8058069 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,9 +1,9 @@
# This file is a Tcl script to test the code in tkEvent.c. It is
# organized in the standard fashion for Tcl tests.
#
-# Copyright © 1994 The Regents of the University of California.
-# Copyright © 1994-1995 Sun Microsystems, Inc.
-# Copyright © 1998-1999 Scriptics Corporation.
+# Copyright (c) 1994 The Regents of the University of California.
+# Copyright (c) 1994-1995 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
package require tcltest 2.2
@@ -20,10 +20,57 @@ namespace import -force tcltest::test
proc _init_keypress_lookup {} {
global keypress_lookup
+ scan A %c start
+ scan Z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ scan a %c start
+ scan z %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ scan 0 %c start
+ scan 9 %c finish
+
+ for {set i $start} {$i <= $finish} {incr i} {
+ set l [format %c $i]
+ set keypress_lookup($l) $l
+ }
+
+ # Most punctuation
+ array set keypress_lookup {
+ ! exclam
+ % percent
+ & ampersand
+ ( parenleft
+ ) parenright
+ * asterisk
+ + plus
+ , comma
+ - minus
+ . period
+ / slash
+ : colon
+ < less
+ = equal
+ > greater
+ ? question
+ @ at
+ ^ asciicircum
+ _ underscore
+ | bar
+ ~ asciitilde
+ ' apostrophe
+ }
# Characters with meaning to Tcl...
array set keypress_lookup [list \
- - minus \
- > greater \
\" quotedbl \
\# numbersign \
\$ dollar \
@@ -34,7 +81,6 @@ proc _init_keypress_lookup {} {
\{ braceleft \
\} braceright \
" " space \
- \xA0 nobreakspace \
"\n" Return \
"\t" Tab]
}
@@ -42,8 +88,8 @@ proc _init_keypress_lookup {} {
# Lookup an event in the keypress table.
# For example:
# Q -> Q
-# ; -> semicolon
-# > -> greater
+# . -> period
+# / -> slash
# Delete -> Delete
# Escape -> Escape
@@ -65,7 +111,7 @@ proc _keypress_lookup {char} {
}
}
-# Lookup and generate a pair of Key and KeyRelease events
+# Lookup and generate a pair of KeyPress and KeyRelease events
proc _keypress {win key} {
set keysym [_keypress_lookup $key]
@@ -78,7 +124,7 @@ proc _keypress {win key} {
if {[focus] != $win} {
focus -force $win
}
- event generate $win <Key-$keysym>
+ event generate $win <KeyPress-$keysym>
_pause 50
if {[focus] != $win} {
focus -force $win
@@ -148,10 +194,10 @@ test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} -setup
update
bind .b <Destroy> {
lappend x destroy
- event generate .b <Button-1>
+ event generate .b <1>
event generate .b <ButtonRelease-1>
}
- bind .b <Button-1> {
+ bind .b <1> {
lappend x button
}
@@ -223,7 +269,7 @@ test event-2.3(keypress) {type into entry widget, triple click, hit Delete key,
event generate $e <Enter>
for {set i 0} {$i < 3} {incr i} {
_pause 100
- event generate $e <Button-1>
+ event generate $e <ButtonPress-1>
_pause 100
event generate $e <ButtonRelease-1>
}
@@ -265,6 +311,7 @@ test event-2.5(keypress) {type into text widget and then delete some text} -setu
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]
@@ -277,7 +324,7 @@ test event-2.6(keypress) {type into text widget, triple click,
event generate $e <Enter>
for {set i 0} {$i < 3} {incr i} {
_pause 100
- event generate $e <Button-1>
+ event generate $e <ButtonPress-1>
_pause 100
event generate $e <ButtonRelease-1>
}
@@ -309,7 +356,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Click down to set the insert cursor position
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
# Save the position of the insert cursor
lappend result [$e index insert]
@@ -335,7 +382,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Now click and click and drag to the left, over "Tcl/Tk selection"
- event generate $e <Button-1> -x $current_x -y $current_y
+ event generate $e <ButtonPress-1> -x $current_x -y $current_y
while {[$e compare $current >= [list $anchor - 4 char]]} {
foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
@@ -376,7 +423,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Click down to set the insert cursor position
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
# Save the position of the insert cursor
lappend result [$e index insert]
@@ -402,7 +449,7 @@ test event-3.1(click-drag) {click and drag in a text widget, this tests
# Now click and click and drag to the left, over "Tcl/Tk selection"
- event generate $e <Button-1> -x $current_x -y $current_y
+ event generate $e <ButtonPress-1> -x $current_x -y $current_y
while {$current >= ($anchor - 4)} {
foreach {current_x current_y} [_text_ind_to_x_y $e $current] break
@@ -441,11 +488,11 @@ test event-4.1(double-click-drag) {click down, click up, click down again,
# Click down, release, then click down again
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
# Save the highlighted text
@@ -512,11 +559,11 @@ test event-4.2(double-click-drag) {click down, click up, click down again,
# Click down, release, then click down again
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
set result [list]
@@ -584,17 +631,17 @@ test event-5.1(triple-click-drag) {Triple click and drag across lines in a
event generate $e <Enter>
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
event generate $e <ButtonRelease-1> -x $anchor_x -y $anchor_y
_pause 50
- event generate $e <Button-1> -x $anchor_x -y $anchor_y
+ event generate $e <ButtonPress-1> -x $anchor_x -y $anchor_y
_pause 50
set result [list]
@@ -634,7 +681,7 @@ test event-6.1(button-state) {button press in a window that is then
} -body {
set t [toplevel .t]
- event generate $t <Button-1>
+ event generate $t <ButtonPress-1>
destroy $t
set t [toplevel .t]
set motion nomotion
@@ -673,11 +720,11 @@ test event-7.1(double-click) {A double click on a lone character
# Double click near left hand egde of the letter A
event generate $e <Enter>
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
@@ -688,18 +735,18 @@ test event-7.1(double-click) {A double click on a lone character
# Clear selection by clicking at 0,0
- event generate $e <Button-1> -x 0 -y 0
+ event generate $e <ButtonPress-1> -x 0 -y 0
_pause 50
event generate $e <ButtonRelease-1> -x 0 -y 0
_pause 50
# Double click near right hand edge of the letter A
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
@@ -740,11 +787,11 @@ test event-7.2(double-click) {A double click on a lone character
# Double click near left hand egde of the letter A
event generate $e <Enter>
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
- event generate $e <Button-1> -x $left_x -y $left_y
+ event generate $e <ButtonPress-1> -x $left_x -y $left_y
_pause 50
event generate $e <ButtonRelease-1> -x $left_x -y $left_y
_pause 50
@@ -755,18 +802,18 @@ test event-7.2(double-click) {A double click on a lone character
# Clear selection by clicking at 0,0
- event generate $e <Button-1> -x 0 -y 0
+ event generate $e <ButtonPress-1> -x 0 -y 0
_pause 50
event generate $e <ButtonRelease-1> -x 0 -y 0
_pause 50
# Double click near right hand edge of the letter A
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
- event generate $e <Button-1> -x $right_x -y $right_y
+ event generate $e <ButtonPress-1> -x $right_x -y $right_y
_pause 50
event generate $e <ButtonRelease-1> -x $right_x -y $right_y
_pause 50
@@ -790,7 +837,7 @@ test event-8 {event generate with keysyms corresponding to
set e [entry $t.e]
pack $e
tkwait visibility $e
- bind $e <Key> {lappend res keycode: %k keysym: %K}
+ bind $e <KeyPress> {lappend res keycode: %k keysym: %K}
focus -force $e
update
event generate $e <diaeresis>
@@ -815,66 +862,313 @@ test event-8 {event generate with keysyms corresponding to
deleteWindows
} -result {OK}
-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}]
- update idletasks
- wm deiconify .top2
- update idletasks
- raise .top2
- _pause 400
- event generate .top2 <Motion> -warp 1 -x 50 -y 50
- _pause 100
- bind . <Enter> {lappend res %W}
- set res [list ]
- destroy .top2
+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.
+
+ 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
- _pause 200
- set res
-} -cleanup {
- 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
- set iconified true
+}
+
+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 {
- toplevel .top1
- wm geometry .top1 200x200+300+300
- wm deiconify .top1
- _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
- update idletasks
- raise .top2
- _pause 400
- 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|"}
+ destroy .one.f1.f2
+ update
+ set result
} -cleanup {
- deleteWindows ; # destroy all children of ".", this already includes .top1
- if {$iconified} {
- wm deiconify .
- update
- }
-} -result {.top1}
+ 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
+ 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>
+ 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>
+ 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|}
+
+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
+ update
+ 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
+ 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.f2
+ update; # make sure window is gone
+ destroy .one.f1
+ update; # make sure window is gone
+ 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>
+ set result "|"
+} -body {
+ bind all <Leave> {append result "<Leave> %d %W|"}
+ bind all <Enter> {append result "<Enter> %d %W|"}
+ destroy .two
+ waitForWindowEvent .one <Enter>
+ set result
+} -cleanup {
+ bind all <Leave> {}
+ bind all <Enter> {}
+ destroy .one
+ unset result
+} -result {|<Enter> NotifyNonlinear .one|}
+
+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
+ 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
+# macOS sometimes has trouble deleting the test window,
+# causing a failure in focus.test.
+_pause 200;
+deleteWindows
update
unset -nocomplain keypress_lookup
rename _init_keypress_lookup {}
@@ -883,6 +1177,8 @@ rename _keypress {}
rename _pause {}
rename _text_ind_to_x_y {}
rename _get_selection {}
+rename create_and_pack_frames {}
+rename setup_win_mousepointer {}
cleanupTests
return
diff --git a/tests/font.test b/tests/font.test
index ca38269..4c1f0de 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -2434,15 +2434,15 @@ test font-47.2 {Bug 3049518 - Canvas} -body {
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"
@@ -2468,6 +2468,7 @@ test font-47.2 {Bug 3049518 - Canvas} -body {
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 {}
diff --git a/tests/pack.test b/tests/pack.test
index 0731125..201bf9f 100644
--- a/tests/pack.test
+++ b/tests/pack.test
@@ -1553,6 +1553,11 @@ test pack-17.2 {PackLostContentProc procedure} -setup {
# into account while the window is unmapped.
# pack-18.1.2 checks that, on Windows, width/height changes are taken into
# account on window remapping.
+#
+# While these tests pass on macOS, one can see by watching the tests
+# that the window .pack is sometimes black, even though the frame is
+# colored. So, evidently, even though the size changes are honored,
+# the window is sometimes not completely configured.
test pack-18.1.1 {unmap content when container unmapped} -constraints {
macOrUnix failsOnUbuntu failsOnXQuarz
} -setup {
@@ -1562,7 +1567,8 @@ test pack-18.1.1 {unmap content when container unmapped} -constraints {
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -width 100 -height 50 -relief raised -bd 2
+ frame .pack.a -width 100 -height 50 -relief raised -bd 2 -bg green
+ after 100
pack .pack.a
update
set result [winfo ismapped .pack.a]
@@ -1585,7 +1591,7 @@ test pack-18.1.2 {unmap content when container unmapped} -constraints {
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -width 100 -height 50 -relief raised -bd 2
+ frame .pack.a -width 100 -height 50 -relief raised -bd 2 -bg green
pack .pack.a
update
set result [winfo ismapped .pack.a]
@@ -1606,8 +1612,8 @@ test pack-18.2 {unmap content when container unmapped} -constraints {failsOnUbun
# as the screen (screen switch causes scale and other tests to fail).
wm geometry .pack +100+100
} -body {
- frame .pack.a -relief raised -bd 2
- frame .pack.b -width 70 -height 30 -relief sunken -bd 2
+ frame .pack.a -relief raised -bd 2 -bg green
+ frame .pack.b -width 70 -height 30 -relief sunken -bd 2 -bg red
pack .pack.a
pack .pack.b -in .pack.a
update
diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test
index 74cd80a..d099c40 100644
--- a/tests/ttk/ttk.test
+++ b/tests/ttk/ttk.test
@@ -136,6 +136,8 @@ test ttk-selfdestruct-ok-1 "Intentional self-destruction" -body {
# Basic tests.
#
test ttk-1.1 "Create multiline button showing justified text" -body {
+ wm geometry . +100+100
+ event generate . <Motion> -warp 1 -x 600 -y 600
pack [ttk::button .t -text "Hello\nWorld!!" -justify center] -expand true -fill both
update
}
@@ -152,6 +154,8 @@ test ttk-1.4 "Original style preserved" -body {
.t cget -style
} -result ""
+# Tests using this will fail if the top-level window contains the cursor
+
proc checkstate {w} {
foreach statespec {
{!active !disabled}
@@ -166,7 +170,6 @@ proc checkstate {w} {
set result
}
-# NB: this will fail if the top-level window pops up underneath the cursor
test ttk-2.0 "Check state" -body {
checkstate .t
} -result [list 1 0 0 0 0 0]
diff --git a/tests/unixWm.test b/tests/unixWm.test
index 2ad40e2..0a86082 100644
--- a/tests/unixWm.test
+++ b/tests/unixWm.test
@@ -105,6 +105,7 @@ foreach geom "+20+80 +80+$Y0 +0+$Y0 -0-0 +0-0 -0+$Y0 -10-5 -10+$Y5 +10-5" {
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
@@ -641,6 +642,8 @@ test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} unix {
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
@@ -1352,8 +1355,12 @@ test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} unix {
test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} unix {
set result {}
wm withdraw .t
+ #added to avoid a crash on macOS
+ update
lappend result [wm state .t] [winfo ismapped .t]
wm deiconify .t
+ #added to avoid a crash on macOS
+ update
lappend result [wm state .t] [winfo ismapped .t]
} {withdrawn 0 normal 1}
@@ -1373,7 +1380,9 @@ test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on gr
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
@@ -1798,6 +1807,8 @@ test unixWm-49.2 {Tk_GetRootCoords procedure, menubars} {unix testmenubar} {
} {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.
diff --git a/tests/winfo.test b/tests/winfo.test
index d4cc1ff..908647b 100644
--- a/tests/winfo.test
+++ b/tests/winfo.test
@@ -441,8 +441,10 @@ test winfo-13.3 {destroying container window} -setup {
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
diff --git a/tests/wm.test b/tests/wm.test
index d913006..650292d 100644
--- a/tests/wm.test
+++ b/tests/wm.test
@@ -1084,6 +1084,8 @@ test wm-iconwindow-1.5 {usage} -setup {
} -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 {
diff --git a/tests/xmfbox.test b/tests/xmfbox.test
index 89eda3c..0d3b4d3 100644
--- a/tests/xmfbox.test
+++ b/tests/xmfbox.test
@@ -54,6 +54,7 @@ proc cleanup {} {
}
catch {unset foo}
destroy .foo
+ update
}
# ----------------------------------------------------------------------
@@ -76,6 +77,7 @@ test xmfbox-1.2 {tk::MotifFDialog_Create, -parent switch} -constraints {
} -body {
toplevel .bar
wm geometry .bar +0+0
+ update
set x [tk::MotifFDialog_Create foo open {-parent .bar}]
} -cleanup {
destroy $x
@@ -89,6 +91,7 @@ test xmfbox-2.1 {tk::MotifFDialog_InterpFilter, ~ in dir names} -constraints {
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
file normalize [file join {*}[tk::MotifFDialog_InterpFilter $x]]
@@ -100,6 +103,7 @@ test xmfbox-2.2 {tk::MotifFDialog_InterpFilter, ~ in file names} -constraints {
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
file normalize [file join {*}[tk::MotifFDialog_InterpFilter $x]]
@@ -111,6 +115,7 @@ test xmfbox-2.3 {tk::MotifFDialog_Update, ~ in file names} -constraints {
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
@@ -124,6 +129,7 @@ test xmfbox-2.4 {tk::MotifFDialog_LoadFile, ~ in file names} -constraints {
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
@@ -134,6 +140,7 @@ test xmfbox-2.5 {tk::MotifFDialog_BrowseFList, ~ in file names} -constraints {
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
diff --git a/win/tkWinWm.c b/win/tkWinWm.c
index f6d3216..4ad0056 100644
--- a/win/tkWinWm.c
+++ b/win/tkWinWm.c
@@ -2466,6 +2466,33 @@ TkpWmGetState(
*--------------------------------------------------------------
*/
+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. */
@@ -2604,6 +2631,13 @@ TkWmDeadWindow(
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;
}
@@ -6595,8 +6629,6 @@ TkWmStackorderToplevelEnumProc(
TkWmStackorderToplevelPair *pair =
(TkWmStackorderToplevelPair *) lParam;
- /*fprintf(stderr, "Looking up HWND %d\n", hwnd);*/
-
hPtr = Tcl_FindHashEntry(pair->table, hwnd);
if (hPtr != NULL) {
childWinPtr = (TkWindow *)Tcl_GetHashValue(hPtr);
generated by cgit v0.12 at 2024-09-19 22:24:14 (GMT)