summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tkInt.h2
-rw-r--r--generic/tkListbox.c11
-rw-r--r--generic/tkText.c31
-rw-r--r--generic/tkTextDisp.c17
-rw-r--r--generic/tkUtil.c9
-rw-r--r--library/button.tcl30
-rw-r--r--macosx/tkMacOSXDialog.c8
-rw-r--r--tests/button.test34
-rw-r--r--tests/listbox.test1
-rw-r--r--tests/text.test40
-rw-r--r--win/tkWinDialog.c8
11 files changed, 109 insertions, 82 deletions
diff --git a/generic/tkInt.h b/generic/tkInt.h
index b644c5b..029f0f1 100644
--- a/generic/tkInt.h
+++ b/generic/tkInt.h
@@ -1208,7 +1208,7 @@ MODULE_SCOPE void TkpCreateBusy(Tk_FakeWin *winPtr, Tk_Window tkRef,
MODULE_SCOPE int TkBackgroundEvalObjv(Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv, int flags);
MODULE_SCOPE void TkSendVirtualEvent(Tk_Window tgtWin,
- const char *eventName);
+ const char *eventName, Tcl_Obj *detail);
MODULE_SCOPE Tcl_Command TkMakeEnsemble(Tcl_Interp *interp,
const char *nsname, const char *name,
ClientData clientData, const TkEnsemble *map);
diff --git a/generic/tkListbox.c b/generic/tkListbox.c
index c7effdd..b059727 100644
--- a/generic/tkListbox.c
+++ b/generic/tkListbox.c
@@ -3223,16 +3223,7 @@ static void
GenerateListboxSelectEvent(
Listbox *listPtr) /* Information about widget. */
{
- union {XEvent general; XVirtualEvent virtual;} event;
-
- memset(&event, 0, sizeof(event));
- event.general.xany.type = VirtualEvent;
- event.general.xany.serial = NextRequest(Tk_Display(listPtr->tkwin));
- event.general.xany.send_event = False;
- event.general.xany.window = Tk_WindowId(listPtr->tkwin);
- event.general.xany.display = Tk_Display(listPtr->tkwin);
- event.virtual.name = Tk_GetUid("ListboxSelect");
- Tk_HandleEvent(&event.general);
+ TkSendVirtualEvent(listPtr->tkwin, "ListboxSelect", NULL);
}
/*
diff --git a/generic/tkText.c b/generic/tkText.c
index 506075d..3e8d625 100644
--- a/generic/tkText.c
+++ b/generic/tkText.c
@@ -3554,16 +3554,7 @@ TkTextSelectionEvent(
* event generate $textWidget <<Selection>>
*/
- union {XEvent general; XVirtualEvent virtual;} event;
-
- memset(&event, 0, sizeof(event));
- event.general.xany.type = VirtualEvent;
- event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
- event.general.xany.send_event = False;
- event.general.xany.window = Tk_WindowId(textPtr->tkwin);
- event.general.xany.display = Tk_Display(textPtr->tkwin);
- event.virtual.name = Tk_GetUid("Selection");
- Tk_HandleEvent(&event.general);
+ TkSendVirtualEvent(textPtr->tkwin, "Selection", NULL);
}
/*
@@ -5215,7 +5206,10 @@ TextEditCmd(
*/
if ((!oldModified) != (!setModified)) {
- GenerateModifiedEvent(textPtr);
+ for (textPtr = textPtr->sharedTextPtr->peers; textPtr != NULL;
+ textPtr = textPtr->next) {
+ GenerateModifiedEvent(textPtr);
+ }
}
break;
case EDIT_REDO:
@@ -5361,21 +5355,8 @@ static void
GenerateModifiedEvent(
TkText *textPtr) /* Information about text widget. */
{
- union {
- XEvent general;
- XVirtualEvent virtual;
- } event;
-
Tk_MakeWindowExist(textPtr->tkwin);
-
- memset(&event, 0, sizeof(event));
- event.general.xany.type = VirtualEvent;
- event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
- event.general.xany.send_event = False;
- event.general.xany.window = Tk_WindowId(textPtr->tkwin);
- event.general.xany.display = Tk_Display(textPtr->tkwin);
- event.virtual.name = Tk_GetUid("Modified");
- Tk_HandleEvent(&event.general);
+ TkSendVirtualEvent(textPtr->tkwin, "Modified", NULL);
}
/*
diff --git a/generic/tkTextDisp.c b/generic/tkTextDisp.c
index 0849307..81bce94 100644
--- a/generic/tkTextDisp.c
+++ b/generic/tkTextDisp.c
@@ -3104,7 +3104,7 @@ AsyncUpdateLineMetrics(
* Send the <<WidgetViewSync>> event related to the text widget
* line metrics asynchronous update.
* This is equivalent to:
- * event generate $textWidget <<WidgetViewSync>> -detail $s
+ * event generate $textWidget <<WidgetViewSync>> -data $s
* where $s is the sync status: true (when the widget view is in
* sync with its internal data) or false (when it is not).
*
@@ -3120,19 +3120,10 @@ AsyncUpdateLineMetrics(
static void
GenerateWidgetViewSyncEvent(
TkText *textPtr, /* Information about text widget. */
- Bool InSync) /* True if in sync, false otherwise */
+ Bool InSync) /* true if in sync, false otherwise */
{
- union {XEvent general; XVirtualEvent virtual;} event;
-
- memset(&event, 0, sizeof(event));
- event.general.xany.type = VirtualEvent;
- event.general.xany.serial = NextRequest(Tk_Display(textPtr->tkwin));
- event.general.xany.send_event = False;
- event.general.xany.window = Tk_WindowId(textPtr->tkwin);
- event.general.xany.display = Tk_Display(textPtr->tkwin);
- event.virtual.name = Tk_GetUid("WidgetViewSync");
- event.virtual.user_data = Tcl_NewBooleanObj(InSync);
- Tk_HandleEvent(&event.general);
+ TkSendVirtualEvent(textPtr->tkwin, "WidgetViewSync",
+ Tcl_NewBooleanObj(InSync));
}
/*
diff --git a/generic/tkUtil.c b/generic/tkUtil.c
index 7ff9ecb..6563165 100644
--- a/generic/tkUtil.c
+++ b/generic/tkUtil.c
@@ -1162,7 +1162,8 @@ TkMakeEnsemble(
* TkSendVirtualEvent --
*
* Send a virtual event notification to the specified target window.
- * Equivalent to "event generate $target <<$eventName>>"
+ * Equivalent to:
+ * "event generate $target <<$eventName>> -data $detail"
*
* Note that we use Tk_QueueWindowEvent, not Tk_HandleEvent, so this
* routine does not reenter the interpreter.
@@ -1173,7 +1174,8 @@ TkMakeEnsemble(
void
TkSendVirtualEvent(
Tk_Window target,
- const char *eventName)
+ const char *eventName,
+ Tcl_Obj *detail)
{
union {XEvent general; XVirtualEvent virtual;} event;
@@ -1184,6 +1186,9 @@ TkSendVirtualEvent(
event.general.xany.window = Tk_WindowId(target);
event.general.xany.display = Tk_Display(target);
event.virtual.name = Tk_GetUid(eventName);
+ if (detail != NULL) {
+ event.virtual.user_data = detail;
+ }
Tk_QueueWindowEvent(&event.general, TCL_QUEUE_TAIL);
}
diff --git a/library/button.tcl b/library/button.tcl
index 469a9a8..80d8bf9 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -589,20 +589,6 @@ proc ::tk::ButtonUp w {
# Shared routines
##################
-# ::tk::ButtonInvokeEnd --
-# The procedure below is called after a button is invoked through
-# the keyboard. It simulate a release of the button via the mouse.
-#
-# Arguments:
-# w - The name of the widget.
-
-proc ::tk::ButtonInvokeEnd {w oldState oldRelief} {
- if {[winfo exists $w]} {
- $w configure -state $oldState -relief $oldRelief
- uplevel #0 [list $w invoke]
- }
-}
-
# ::tk::ButtonInvoke --
# The procedure below is called when a button is invoked through
# the keyboard. It simulate a press of the button via the mouse.
@@ -619,6 +605,22 @@ proc ::tk::ButtonInvoke w {
}
}
+# ::tk::ButtonInvokeEnd --
+# The procedure below is called after a button is invoked through
+# the keyboard. It simulate a release of the button via the mouse.
+#
+# Arguments:
+# w - The name of the widget.
+# oldState - Old state to be set back.
+# oldRelief - Old relief to be set back.
+
+proc ::tk::ButtonInvokeEnd {w oldState oldRelief} {
+ if {[winfo exists $w]} {
+ $w configure -state $oldState -relief $oldRelief
+ uplevel #0 [list $w invoke]
+ }
+}
+
# ::tk::ButtonAutoInvoke --
#
# Invoke an auto-repeating button, and set it up to continue to repeat.
diff --git a/macosx/tkMacOSXDialog.c b/macosx/tkMacOSXDialog.c
index f6edb6d..80a7a11 100644
--- a/macosx/tkMacOSXDialog.c
+++ b/macosx/tkMacOSXDialog.c
@@ -1320,7 +1320,7 @@ FontchooserEvent(
switch (kind) {
case FontchooserClosed:
if (fcdPtr->parent != None) {
- TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+ TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
fontchooserInterp = NULL;
}
break;
@@ -1343,7 +1343,7 @@ FontchooserEvent(
ckfree(tmpv);
}
}
- TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged");
+ TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged", NULL);
}
break;
}
@@ -1553,7 +1553,7 @@ FontchooserConfigureCmd(
[fm setSelectedAttributes:fontPanelFontAttributes
isMultiple:NO];
if ([fp isVisible]) {
- TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged");
+ TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserFontChanged", NULL);
}
break;
case FontchooserCmd:
@@ -1616,7 +1616,7 @@ FontchooserShowCmd(
}
if (![fp isVisible]) {
[fm orderFrontFontPanel:NSApp];
- TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility");
+ TkSendVirtualEvent(fcdPtr->parent, "TkFontchooserVisibility", NULL);
}
fontchooserInterp = interp;
diff --git a/tests/button.test b/tests/button.test
index 984fd43..708fc30 100644
--- a/tests/button.test
+++ b/tests/button.test
@@ -3750,7 +3750,7 @@ test button-12.1 {button widget vs hidden commands} -body {
destroy .b
} -result {1}
-test button-13.1 {size behaviouor: label} -setup {
+test button-13.1 {size behavior: label} -setup {
label .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
label .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
label .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
@@ -3769,7 +3769,7 @@ test button-13.1 {size behaviouor: label} -setup {
} -cleanup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.2 {size behaviouor: label} -setup {
+test button-13.2 {size behavior: label} -setup {
label .a -borderwidth 2 -highlightthickness 2 -font {Arial 20}
label .b -borderwidth 2 -highlightthickness 2 -font {Arial 20}
label .c -borderwidth 2 -highlightthickness 2 -font {Arial 20}
@@ -3789,7 +3789,7 @@ test button-13.2 {size behaviouor: label} -setup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.3 {size behaviouor: button} -setup {
+test button-13.3 {size behavior: button} -setup {
button .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
button .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
@@ -3808,7 +3808,7 @@ test button-13.3 {size behaviouor: button} -setup {
} -cleanup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.4 {size behaviouor: button} -setup {
+test button-13.4 {size behavior: button} -setup {
button .a -borderwidth 2 -highlightthickness 2 -font {Arial 20}
button .b -borderwidth 2 -highlightthickness 2 -font {Arial 20}
button .c -borderwidth 2 -highlightthickness 2 -font {Arial 20}
@@ -3828,7 +3828,7 @@ test button-13.4 {size behaviouor: button} -setup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.5 {size behaviouor: radiobutton} -setup {
+test button-13.5 {size behavior: radiobutton} -setup {
radiobutton .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
radiobutton .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
radiobutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
@@ -3848,7 +3848,7 @@ test button-13.5 {size behaviouor: radiobutton} -setup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.6 {size behaviouor: radiobutton} -setup {
+test button-13.6 {size behavior: radiobutton} -setup {
radiobutton .a -borderwidth 2 -highlightthickness 2 -font {Arial 20}
radiobutton .b -borderwidth 2 -highlightthickness 2 -font {Arial 20}
radiobutton .c -borderwidth 2 -highlightthickness 2 -font {Arial 20}
@@ -3868,7 +3868,7 @@ test button-13.6 {size behaviouor: radiobutton} -setup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.7 {size behaviouor: checkbutton} -setup {
+test button-13.7 {size behavior: checkbutton} -setup {
checkbutton .a -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
checkbutton .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold}
@@ -3888,7 +3888,7 @@ test button-13.7 {size behaviouor: checkbutton} -setup {
destroy .a .b .c
} -result {1 1 1}
-test button-13.8 {size behaviouor: checkbutton} -setup {
+test button-13.8 {size behavior: checkbutton} -setup {
checkbutton .a -borderwidth 2 -highlightthickness 2 -font {Arial 20}
checkbutton .b -borderwidth 2 -highlightthickness 2 -font {Arial 20}
checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Arial 20}
@@ -3908,6 +3908,24 @@ test button-13.8 {size behaviouor: checkbutton} -setup {
destroy .a .b .c
} -result {1 1 1}
+test button-14.1 {bug fix: [011706ec42] tk::ButtonInvoke unsafe wrt widget destruction} -body {
+ proc destroy_button {} {
+ if {[winfo exists .top.b]} {
+ destroy .top.b
+ }
+ }
+ toplevel .top
+ button .top.b -text Foo -command destroy_button
+ bind .top.b <space> destroy_button
+ pack .top.b
+ focus -force .top.b
+ update
+ event generate .top.b <space>
+ update ; # shall not trigger error invalid command name ".top.b"
+} -cleanup {
+ destroy .top.b .top
+} -result {}
+
imageFinish
cleanupTests
return
diff --git a/tests/listbox.test b/tests/listbox.test
index 76a4349..407420c 100644
--- a/tests/listbox.test
+++ b/tests/listbox.test
@@ -3170,6 +3170,7 @@ test listbox-31.2 {<<ListboxSelect>> event on lost selection} -setup {
focus -force .l
event generate .l <1> -x 5 -y 5 ; # <<ListboxSelect>> fires
selection clear ; # <<ListboxSelect>> fires again
+ update
set res
} -cleanup {
destroy .l
diff --git a/tests/text.test b/tests/text.test
index a778b79..f217bcf 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -3053,6 +3053,25 @@ test text-11a.41 {"sync" "pendingsync" and <<WidgetViewSync>>} -setup {
destroy .top.yt .top
} -result {Sync:0 Pending:1 Sync:1 Pending:0}
+test text-11a.51 {<<WidgetViewSync>> calls TkSendVirtualEvent(),
+ NOT Tk_HandleEvent().
+ Bug [b362182e45704dd7bbd6aed91e48122035ea3d16]} -setup {
+ destroy .top.t .top
+} -body {
+ set res {}
+ toplevel .top
+ pack [text .top.t]
+ for {set i 1} {$i < 10000} {incr i} {
+ .top.t insert end "Hello world!\n"
+ }
+ bind .top.t <<WidgetViewSync>> {destroy .top.t}
+ .top.t tag add mytag 1.5 8000.8 ; # shall not crash
+ update
+ set res "Still doing fine!"
+} -cleanup {
+ destroy .top.t .top
+} -result {Still doing fine!}
+
test text-12.1 {TextWidgetCmd procedure, "index" option} -setup {
text .t
} -body {
@@ -6280,7 +6299,7 @@ test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup {
# Shouldn't require [update idle] to trigger event [Bug 1809538]
lappend ::retval [.t edit modified]
.t edit modified 1
- update idletasks
+ update
lappend ::retval [.t edit modified]
.t edit modified 1 ; # binding should only fire once [Bug 1799782]
update idletasks
@@ -6295,6 +6314,7 @@ test text-27.12 {<<Modified>> virtual event} -body {
bind .t <<Modified>> "set ::retval modified"
update idletasks
.t insert end "nothing special\n"
+ update
return $::retval
} -cleanup {
destroy .t
@@ -6305,6 +6325,7 @@ test text-27.13 {<<Modified>> virtual event - insert before Modified} -body {
bind .t <<Modified>> { set ::retval [.t get 1.0 end-1c] }
update idletasks
.t insert end "nothing special"
+ update
return $::retval
} -cleanup {
destroy .t
@@ -6317,10 +6338,26 @@ test text-27.14 {<<Modified>> virtual event - delete before Modified} -body {
.t insert end "nothing special"
.t edit modified 0
.t delete 1.0 1.2
+ update
set ::retval
} -cleanup {
destroy .t
} -result {thing special}
+test text-27.14a {<<Modified>> virtual event - propagation to peers} -body {
+# Bug [fd3a4dc111], <<Modified>> event is not always sent to peers
+ set ::retval 0
+ text .t -undo 1
+ .t peer create .tt
+ pack .t .tt
+ bind .t <<Modified>> {incr ::retval}
+ bind .tt <<Modified>> {incr ::retval}
+ .t insert end "This increments ::retval once for each peer, i.e. twice."
+ .t edit modified 0 ; # shall increment twice as well, not just once
+ update
+ set ::retval
+} -cleanup {
+ destroy .t .tt
+} -result {4}
test text-27.15 {<<Selection>> virtual event} -body {
set ::retval no_selection
pack [text .t -undo 1]
@@ -6328,6 +6365,7 @@ test text-27.15 {<<Selection>> virtual event} -body {
update idletasks
.t insert end "nothing special\n"
.t tag add sel 1.0 1.1
+ update
set ::retval
} -cleanup {
destroy .t
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index d7f63fb..d58bd52 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -3145,13 +3145,13 @@ HookProc(
if (IsWindow(hwndCtrl)) {
EnableWindow(hwndCtrl, FALSE);
}
- TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility", NULL);
return 1; /* we handled the message */
}
if (WM_DESTROY == msg) {
phd->hwnd = NULL;
- TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility");
+ TkSendVirtualEvent(phd->parent, "TkFontchooserVisibility", NULL);
return 0;
}
@@ -3169,7 +3169,7 @@ HookProc(
ApplyLogfont(phd->interp, phd->cmdObj, hdc, &lf);
}
if (phd && phd->parent) {
- TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged");
+ TkSendVirtualEvent(phd->parent, "TkFontchooserFontChanged", NULL);
}
return 1;
}
@@ -3481,7 +3481,7 @@ FontchooserShowCmd(
ApplyLogfont(hdPtr->interp, hdPtr->cmdObj, hdc, &lf);
}
if (hdPtr->parent) {
- TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged");
+ TkSendVirtualEvent(hdPtr->parent, "TkFontchooserFontChanged", NULL);
}
}
Tcl_SetServiceMode(oldMode);
generated by cgit v0.12 at 2024-11-08 13:10:46 (GMT)