diff options
| -rw-r--r-- | generic/tkInt.h | 4 | ||||
| -rw-r--r-- | generic/tkWindow.c | 29 | ||||
| -rw-r--r-- | tests/window.test | 33 |
3 files changed, 54 insertions, 12 deletions
diff --git a/generic/tkInt.h b/generic/tkInt.h index ee453ea..214dd71 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -701,6 +701,10 @@ typedef struct TkMainInfo { struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by * this process. */ Tcl_HashTable busyTable; /* Information used by [tk busy] command. */ + Tcl_CmdInfo *tclUpdateCmdPtr; + /* Saved Tcl [update] command, used to restore + * Tcl's version of [update] after Tk is shut + * down */ } TkMainInfo; /* diff --git a/generic/tkWindow.c b/generic/tkWindow.c index ac36440..403b97d 100644 --- a/generic/tkWindow.c +++ b/generic/tkWindow.c @@ -93,6 +93,7 @@ static const XSetWindowAttributes defAtts= { #define PASSMAINWINDOW 2 #define WINMACONLY 4 #define USEINITPROC 8 +#define SAVEUPDATECMD 16 /* better only be one of these! */ typedef int (TkInitProc)(Tcl_Interp *interp, ClientData clientData); typedef struct { @@ -126,7 +127,7 @@ static const TkCmd commands[] = { {"selection", Tk_SelectionObjCmd, PASSMAINWINDOW}, {"tk", (Tcl_ObjCmdProc *)(void *)TkInitTkCmd, USEINITPROC|PASSMAINWINDOW|ISSAFE}, {"tkwait", Tk_TkwaitObjCmd, PASSMAINWINDOW|ISSAFE}, - {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE}, + {"update", Tk_UpdateObjCmd, PASSMAINWINDOW|ISSAFE|SAVEUPDATECMD}, {"winfo", Tk_WinfoObjCmd, PASSMAINWINDOW|ISSAFE}, {"wm", Tk_WmObjCmd, PASSMAINWINDOW}, @@ -199,8 +200,6 @@ static const TkCmd commands[] = { {NULL, NULL, 0} }; -static Tcl_CmdInfo *saveTclUpdateCmd = NULL; -static Tcl_ObjCmdProc *updateObjProc = NULL; /* * Forward declarations to functions defined later in this file: */ @@ -878,6 +877,7 @@ TkCreateMainWindow( Tcl_InitHashTable(&mainPtr->imageTable, TCL_STRING_KEYS); mainPtr->strictMotif = 0; mainPtr->alwaysShowSelection = 0; + mainPtr->tclUpdateCmdPtr = NULL; if (Tcl_LinkVar(interp, "tk_strictMotif", (char *) &mainPtr->strictMotif, TCL_LINK_BOOLEAN) != TCL_OK) { Tcl_ResetResult(interp); @@ -938,12 +938,12 @@ TkCreateMainWindow( } else { clientData = NULL; } - if (Tcl_GetCommandInfo(interp, cmdPtr->name, &cmdInfo)) { - if (cmdInfo.isNativeObjectProc && saveTclUpdateCmd == NULL) { - saveTclUpdateCmd = ckalloc(sizeof (Tcl_CmdInfo)); - *saveTclUpdateCmd = cmdInfo; - updateObjProc = cmdInfo.objProc; - } + if ((cmdPtr->flags & SAVEUPDATECMD) && + Tcl_GetCommandInfo(interp, cmdPtr->name, &cmdInfo) && + cmdInfo.isNativeObjectProc && + mainPtr->tclUpdateCmdPtr == NULL) { + mainPtr->tclUpdateCmdPtr = ckalloc(sizeof (Tcl_CmdInfo)); + *mainPtr->tclUpdateCmdPtr = cmdInfo; } if (cmdPtr->flags & USEINITPROC) { ((TkInitProc *)(void *)cmdPtr->objProc)(interp, clientData); @@ -1509,10 +1509,12 @@ Tk_DestroyWindow( if ((winPtr->mainPtr->interp != NULL) && !Tcl_InterpDeleted(winPtr->mainPtr->interp)) { for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) { - if (saveTclUpdateCmd && updateObjProc && - cmdPtr->objProc == Tk_UpdateObjCmd) { + if ((cmdPtr->flags & SAVEUPDATECMD) && + winPtr->mainPtr->tclUpdateCmdPtr != NULL) { + /* Restore Tcl's version of [update] */ Tcl_CreateObjCommand(winPtr->mainPtr->interp, - cmdPtr->name, updateObjProc, + cmdPtr->name, + winPtr->mainPtr->tclUpdateCmdPtr->objProc, NULL, NULL); } else { Tcl_CreateObjCommand(winPtr->mainPtr->interp, @@ -1543,6 +1545,9 @@ Tk_DestroyWindow( if (winPtr->flags & TK_EMBEDDED) { XSync(winPtr->display, False); } + if (winPtr->mainPtr->tclUpdateCmdPtr) { + ckfree(winPtr->mainPtr->tclUpdateCmdPtr); + } ckfree(winPtr->mainPtr); /* diff --git a/tests/window.test b/tests/window.test index dec2cc4..8a56d5a 100644 --- a/tests/window.test +++ b/tests/window.test @@ -263,6 +263,38 @@ test window-2.11 {Tk_DestroyWindow, don't reanimate a half-dead window} -constra list $error $msg } -result {0 YES} +test window-2.12 {Test for ticket [9b6065d1fd] - restore Tcl [update] command} -constraints { + unixOrWin +} -body { + set code [loadTkCommand] + append code { + after 1000 {set forever 1} + after 100 {destroy .} + after 200 {catch bell msg; puts "ringing the bell -> $msg"} + after 250 {update idletasks} + after 300 {update} + puts "waiting" + vwait forever + puts "done waiting" + catch {bell} msg + puts "bell -> $msg" + catch update msg + puts "update -> $msg" + } + set script [makeFile $code script] + if {[catch {exec [interpreter] $script -geometry 10x10+0+0} msg]} { + set error 1 + } else { + set error 0 + } + removeFile script + list $error $msg +} -result {0 {waiting +ringing the bell -> can't invoke "bell" command: application has been destroyed +done waiting +bell -> can't invoke "bell" command: application has been destroyed +update -> }} + test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -constraints { unix testmenubar @@ -342,6 +374,7 @@ test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} -con } -result {} + # cleanup cleanupTests return |