From 2799d07b553d0f692f083a9b42b8145cb47e2b93 Mon Sep 17 00:00:00 2001 From: jenglish Date: Thu, 13 Nov 2008 01:13:54 +0000 Subject: ttkWidget.c: Reworked widget construction and destruction sequence; fixes [#2207435] and several other problems discovered during investigation of same. ttkButton.c(CheckbuttonInitialize): Account for initializeProc being called earlier in the construction sequence now. --- ChangeLog | 10 +++ generic/ttk/ttkButton.c | 48 ++++++------ generic/ttk/ttkWidget.c | 190 ++++++++++++++++++++++++++---------------------- tests/ttk/ttk.test | 56 +++++++++----- 4 files changed, 177 insertions(+), 127 deletions(-) diff --git a/ChangeLog b/ChangeLog index 9fdbcac..85d0405 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2008-11-12 Joe English + + * generic/ttk/ttkWidget.c: Reworked widget construction + and destruction sequence; fixes [Bug 2207435] and several + other problems discovered during investigation of same. + * generic/ttk/ttkButton.c(CheckbuttonInitialize): + Account for initializeProc being called earlier in the + construction sequence now. + * tests/ttk/ttk.test: Updated test suite. + 2008-11-12 Pat Thoyts * library/text.tcl: bug #1777362 - handle windows with funky names diff --git a/generic/ttk/ttkButton.c b/generic/ttk/ttkButton.c index ce4fd67..1b199be 100644 --- a/generic/ttk/ttkButton.c +++ b/generic/ttk/ttkButton.c @@ -1,4 +1,4 @@ -/* $Id: ttkButton.c,v 1.10 2008/11/09 23:53:09 jenglish Exp $ +/* $Id: ttkButton.c,v 1.11 2008/11/13 01:13:54 jenglish Exp $ * Copyright (c) 2003, Joe English * * label, button, checkbutton, radiobutton, and menubutton widgets. @@ -57,24 +57,24 @@ typedef struct static Tk_OptionSpec BaseOptionSpecs[] = { {TK_OPTION_STRING, "-text", "text", "Text", "", - Tk_Offset(Base,base.textObj), -1, + Tk_Offset(Base,base.textObj), -1, 0,0,GEOMETRY_CHANGED }, {TK_OPTION_STRING, "-textvariable", "textVariable", "Variable", "", - Tk_Offset(Base,base.textVariableObj), -1, + Tk_Offset(Base,base.textVariableObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_INT, "-underline", "underline", "Underline", - "-1", Tk_Offset(Base,base.underlineObj), -1, + "-1", Tk_Offset(Base,base.underlineObj), -1, 0,0,0 }, /* SB: OPTION_INT, see <> */ {TK_OPTION_STRING, "-width", "width", "Width", - NULL, Tk_Offset(Base,base.widthObj), -1, + NULL, Tk_Offset(Base,base.widthObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, /* * Image options */ {TK_OPTION_STRING, "-image", "image", "Image", NULL/*default*/, - Tk_Offset(Base,base.imageObj), -1, + Tk_Offset(Base,base.imageObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, /* @@ -132,7 +132,7 @@ BaseCleanup(void *recordPtr) Base *basePtr = recordPtr; if (basePtr->base.textVariableTrace) Ttk_UntraceVariable(basePtr->base.textVariableTrace); - if (basePtr->base.imageSpec) + if (basePtr->base.imageSpec) TtkFreeImageSpec(basePtr->base.imageSpec); } @@ -219,23 +219,23 @@ typedef struct static Tk_OptionSpec LabelOptionSpecs[] = { - {TK_OPTION_BORDER, "-background", "frameColor", "FrameColor", + {TK_OPTION_BORDER, "-background", "frameColor", "FrameColor", NULL, Tk_Offset(Label,label.backgroundObj), -1, TK_OPTION_NULL_OK,0,0 }, - {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor", + {TK_OPTION_COLOR, "-foreground", "textColor", "TextColor", NULL, Tk_Offset(Label,label.foregroundObj), -1, TK_OPTION_NULL_OK,0,0 }, {TK_OPTION_FONT, "-font", "font", "Font", NULL, Tk_Offset(Label,label.fontObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, - {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", + {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", NULL, Tk_Offset(Label,label.borderWidthObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_RELIEF, "-relief", "relief", "Relief", NULL, Tk_Offset(Label,label.reliefObj), -1, TK_OPTION_NULL_OK,0,GEOMETRY_CHANGED }, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", - NULL, Tk_Offset(Label,label.anchorObj), -1, + NULL, Tk_Offset(Label,label.anchorObj), -1, TK_OPTION_NULL_OK, 0, GEOMETRY_CHANGED}, {TK_OPTION_JUSTIFY, "-justify", "justify", "Justify", NULL, Tk_Offset(Label, label.justifyObj), -1, @@ -417,13 +417,17 @@ static Tk_OptionSpec CheckbuttonOptionSpecs[] = WIDGET_TAKES_FOCUS, {TK_OPTION_STRING, "-variable", "variable", "Variable", - "", Tk_Offset(Checkbutton, checkbutton.variableObj), -1, 0,0,0}, + "", Tk_Offset(Checkbutton, checkbutton.variableObj), -1, + TK_OPTION_DONT_SET_DEFAULT,0,0}, {TK_OPTION_STRING, "-onvalue", "onValue", "OnValue", - "1", Tk_Offset(Checkbutton, checkbutton.onValueObj), -1, 0,0,0}, + "1", Tk_Offset(Checkbutton, checkbutton.onValueObj), -1, + 0,0,0}, {TK_OPTION_STRING, "-offvalue", "offValue", "OffValue", - "0", Tk_Offset(Checkbutton, checkbutton.offValueObj), -1, 0,0,0}, + "0", Tk_Offset(Checkbutton, checkbutton.offValueObj), -1, + 0,0,0}, {TK_OPTION_STRING, "-command", "command", "Command", - "", Tk_Offset(Checkbutton, checkbutton.commandObj), -1, 0,0,0}, + "", Tk_Offset(Checkbutton, checkbutton.commandObj), -1, + 0,0,0}, WIDGET_INHERIT_OPTIONS(BaseOptionSpecs) }; @@ -452,17 +456,17 @@ static void CheckbuttonVariableChanged(void *clientData, const char *value) } } -static void CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr) +static void +CheckbuttonInitialize(Tcl_Interp *interp, void *recordPtr) { Checkbutton *checkPtr = recordPtr; - Tcl_Obj *objPtr; + Tcl_Obj *variableObj; /* default -variable is the widget name: */ - objPtr = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1); - Tcl_IncrRefCount(objPtr); - Tcl_DecrRefCount(checkPtr->checkbutton.variableObj); - checkPtr->checkbutton.variableObj = objPtr; + variableObj = Tcl_NewStringObj(Tk_PathName(checkPtr->core.tkwin), -1); + Tcl_IncrRefCount(variableObj); + checkPtr->checkbutton.variableObj = variableObj; BaseInitialize(interp, recordPtr); } @@ -630,7 +634,7 @@ static Tk_OptionSpec RadiobuttonOptionSpecs[] = /* * Variable trace procedure for radiobuttons. */ -static void +static void RadiobuttonVariableChanged(void *clientData, const char *value) { Radiobutton *radioPtr = clientData; diff --git a/generic/ttk/ttkWidget.c b/generic/ttk/ttkWidget.c index 66ab44c..c2cb2b6 100644 --- a/generic/ttk/ttkWidget.c +++ b/generic/ttk/ttkWidget.c @@ -1,4 +1,4 @@ -/* $Id: ttkWidget.c,v 1.17 2008/11/11 23:39:30 jenglish Exp $ +/* $Id: ttkWidget.c,v 1.18 2008/11/13 01:13:54 jenglish Exp $ * Copyright (c) 2003, Joe English * * Core widget utilities. @@ -170,30 +170,48 @@ int TtkWidgetEnsembleCommand( return commands[index].command(interp, objc, objv, clientData); } -/* - * WidgetInstanceObjCmd -- +/* WidgetInstanceObjCmd -- * Widget instance command implementation. */ static int WidgetInstanceObjCmd( - ClientData clientData, /* Widget record pointer */ - Tcl_Interp *interp, /* Current interpreter. */ - int objc, /* Number of arguments. */ - Tcl_Obj *const objv[]) /* Argument objects. */ + ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { WidgetCore *corePtr = clientData; const WidgetCommandSpec *commands = corePtr->widgetSpec->commands; - int status = TCL_OK; + int status; Tcl_Preserve(clientData); status = TtkWidgetEnsembleCommand(commands,1, interp,objc,objv,clientData); + if (WidgetDestroyed(corePtr)) { + status = TCL_ERROR; + Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + } Tcl_Release(clientData); return status; } -/* - * Command deletion callback for widget instance commands. +/*------------------------------------------------------------------------ + * +++ Widget destruction. + * + * A widget can be destroyed when the application explicitly + * destroys the window or one of its ancestors via [destroy] + * or Tk_DestroyWindow(); when the application deletes the widget + * instance command; when there is an error in the widget constructor; + * or when another application calls XDestroyWindow on the window ID. + * + * The window receives a event in all cases, + * so we do the bulk of the cleanup there. See [#2207435] for + * further notes (esp. re: Tk_FreeConfigOptions). + * + * Widget code that reenters the interp should only do so + * when the widtget is Tcl_Preserve()d, and should check + * the WIDGET_DESTROYED flag bit upon return. + */ + +/* WidgetInstanceObjCmdDeleted -- + * Widget instance command deletion callback. */ static void WidgetInstanceObjCmdDeleted(ClientData clientData) @@ -204,20 +222,46 @@ WidgetInstanceObjCmdDeleted(ClientData clientData) Tk_DestroyWindow(corePtr->tkwin); } -/* - * WidgetCleanup -- - * Final cleanup for widget. - * - * @@@ TODO: check all code paths leading to widget destruction, - * @@@ describe here. - * @@@ Call widget-specific cleanup routine at an appropriate point. +/* FreeWidget -- + * Final cleanup for widget; called via Tcl_EventuallyFree(). */ static void -WidgetCleanup(char *memPtr) +FreeWidget(char *memPtr) { ckfree(memPtr); } +/* DestroyWidget -- + * Main widget destructor; called from event handler. + */ +static void +DestroyWidget(WidgetCore *corePtr) +{ + corePtr->flags |= WIDGET_DESTROYED; + + corePtr->widgetSpec->cleanupProc(corePtr); + + Tk_FreeConfigOptions( + (ClientData)corePtr, corePtr->optionTable, corePtr->tkwin); + + if (corePtr->layout) { + Ttk_FreeLayout(corePtr->layout); + } + + if (corePtr->flags & REDISPLAY_PENDING) { + Tcl_CancelIdleCall(DrawWidget, corePtr); + } + + corePtr->tkwin = NULL; + if (corePtr->widgetCmd) { + Tcl_Command cmd = corePtr->widgetCmd; + corePtr->widgetCmd = 0; + /* NB: this can reenter the interpreter via a command traces */ + Tcl_DeleteCommandFromToken(corePtr->interp, cmd); + } + Tcl_EventuallyFree(corePtr, FreeWidget); +} + /* * CoreEventProc -- * Event handler for basic events. @@ -258,34 +302,10 @@ static void CoreEventProc(ClientData clientData, XEvent *eventPtr) } break; case DestroyNotify : - corePtr->flags |= WIDGET_DESTROYED; - - Tk_DeleteEventHandler(corePtr->tkwin, - CoreEventMask,CoreEventProc,clientData); - - if (corePtr->flags & REDISPLAY_PENDING) { - Tcl_CancelIdleCall(DrawWidget, clientData); - } - - corePtr->widgetSpec->cleanupProc(corePtr); - - Tk_FreeConfigOptions( - clientData, corePtr->optionTable, corePtr->tkwin); - corePtr->tkwin = NULL; - - if (corePtr->layout) { - Ttk_FreeLayout(corePtr->layout); - } - - /* NB: this can reenter the interpreter via a command traces */ - if (corePtr->widgetCmd) { - Tcl_Command cmd = corePtr->widgetCmd; - corePtr->widgetCmd = 0; - Tcl_DeleteCommandFromToken(corePtr->interp, cmd); - } - Tcl_EventuallyFree(clientData, WidgetCleanup); + Tk_DeleteEventHandler( + corePtr->tkwin, CoreEventMask,CoreEventProc,clientData); + DestroyWidget(corePtr); break; - case FocusIn: case FocusOut: /* Don't process "virtual crossing" events */ @@ -348,24 +368,20 @@ int TtkWidgetConstructorObjCmd( { WidgetSpec *widgetSpec = clientData; const char *className = widgetSpec->className; - WidgetCore *corePtr; - void *recordPtr; + Tk_OptionTable optionTable = + Tk_CreateOptionTable(interp, widgetSpec->optionSpecs); Tk_Window tkwin; - Tk_OptionTable optionTable; + void *recordPtr; + WidgetCore *corePtr; + Tk_SavedOptions savedOptions; int i; - if (objc < 2 || objc % 1 == 1) { + if (objc < 2 || objc % 2 == 1) { Tcl_WrongNumArgs(interp, 1, objv, "pathName ?-option value ...?"); return TCL_ERROR; } - tkwin = Tk_CreateWindowFromPath( - interp, Tk_MainWindow(interp), Tcl_GetString(objv[1]), NULL); - if (tkwin == NULL) - return TCL_ERROR; - - /* - * Check if a -class resource has been specified: + /* Check if a -class option has been specified. * We have to do this before the InitOptions() call, * since InitOptions() is affected by the widget class. */ @@ -376,15 +392,10 @@ int TtkWidgetConstructorObjCmd( } } - Tk_SetClass(tkwin, className); - - /* - * Set the BackgroundPixmap to ParentRelative here, so - * subclasses don't need to worry about setting the background. - */ - Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative); - - optionTable = Tk_CreateOptionTable(interp, widgetSpec->optionSpecs); + tkwin = Tk_CreateWindowFromPath( + interp, Tk_MainWindow(interp), Tcl_GetString(objv[1]), NULL); + if (tkwin == NULL) + return TCL_ERROR; /* * Allocate and initialize the widget record. @@ -399,52 +410,57 @@ int TtkWidgetConstructorObjCmd( corePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tkwin), WidgetInstanceObjCmd, recordPtr, WidgetInstanceObjCmdDeleted); corePtr->optionTable = optionTable; + corePtr->layout = NULL; + corePtr->flags = 0; + corePtr->state = 0; + Tk_SetClass(tkwin, className); Tk_SetClassProcs(tkwin, &widgetClassProcs, recordPtr); - - if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK) - goto error_nocleanup; + Tk_SetWindowBackgroundPixmap(tkwin, ParentRelative); widgetSpec->initializeProc(interp, recordPtr); - if (Tk_SetOptions(interp, recordPtr, optionTable, objc - 2, - objv + 2, tkwin, NULL/*savePtr*/, NULL/*maskPtr*/) != TCL_OK) + Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr); + + /* + * Initial configuration. + */ + + Tcl_Preserve(corePtr); + if (Tk_InitOptions(interp, recordPtr, optionTable, tkwin) != TCL_OK) { goto error; + } + if (Tk_SetOptions(interp, recordPtr, optionTable, + objc - 2, objv + 2, tkwin, &savedOptions, NULL) != TCL_OK) { + Tk_RestoreSavedOptions(&savedOptions); + goto error; + } else { + Tk_FreeSavedOptions(&savedOptions); + } if (widgetSpec->configureProc(interp, recordPtr, ~0) != TCL_OK) goto error; - if (widgetSpec->postConfigureProc(interp, recordPtr, ~0) != TCL_OK) goto error; if (WidgetDestroyed(corePtr)) goto error; - if (UpdateLayout(interp, corePtr) != TCL_OK) - goto error; + Tcl_Release(corePtr); SizeChanged(corePtr); - Tk_CreateEventHandler(tkwin, CoreEventMask, CoreEventProc, recordPtr); - Tk_MakeWindowExist(tkwin); Tcl_SetObjResult(interp, Tcl_NewStringObj(Tk_PathName(tkwin), -1)); - return TCL_OK; error: - widgetSpec->cleanupProc(recordPtr); -error_nocleanup: - if (corePtr->layout) { - Ttk_FreeLayout(corePtr->layout); - corePtr->layout = 0; + if (WidgetDestroyed(corePtr)) { + Tcl_SetResult(interp, "Widget has been destroyed", TCL_STATIC); + } else { + Tk_DestroyWindow(tkwin); } - Tk_UndefineCursor(tkwin); /* @@@ TEMP: workaround for #2207435 */ - Tk_FreeConfigOptions(recordPtr, optionTable, tkwin); - Tk_DestroyWindow(tkwin); - corePtr->tkwin = 0; - Tcl_DeleteCommandFromToken(interp, corePtr->widgetCmd); - ckfree(recordPtr); + Tcl_Release(corePtr); return TCL_ERROR; } diff --git a/tests/ttk/ttk.test b/tests/ttk/ttk.test index 4092c40..e050e2a 100644 --- a/tests/ttk/ttk.test +++ b/tests/ttk/ttk.test @@ -23,24 +23,24 @@ test ttk-6.1 "Self-destructing checkbutton" -body { trace variable sd w [list selfdestruct .sd] update .sd invoke -} -returnCodes 1 +} -returnCodes 1 -result "Widget has been destroyed" test ttk-6.2 "Checkbutton self-destructed" -body { winfo exists .sd } -result 0 # test ttk-6.3 not applicable [see #2175411] -test ttk-6.4 "Defeat evil intentions" -body { +test ttk-6.4 "Destroy widget in configure" -setup { + set OUCH ouch trace variable OUCH r { kill.b } proc kill.b {args} { destroy .b } +} -cleanup { + unset OUCH +} -body { pack [ttk::checkbutton .b] - .b configure -variable OUCH - # At this point, .b should be gone. - .b invoke - list [set OUCH] [winfo exists .b] - # Mostly we just care that we haven't crashed the interpreter. - # -} -returnCodes error -match glob -result "*" + set rc [catch { .b configure -variable OUCH } msg] + list $rc $msg [winfo exists .b] [info commands .b] +} -result [list 1 "Widget has been destroyed" 0 {}] test ttk-6.5 "Clean up -textvariable traces" -body { foreach class {ttk::button ttk::checkbutton ttk::radiobutton} { @@ -61,7 +61,6 @@ test ttk-6.6 "Bad color spec in styles" -body { set ::bgerror } -result {unknown color name "badColor"} -# This should move to be a standard test per widget test file test ttk-6.7 "Basic destruction test" -body { foreach widget { button checkbutton radiobutton sizegrip separator notebook @@ -80,9 +79,6 @@ test ttk-6.8 "Button command removes itself" -body { set ::A } -result {it worked} -# -# - test ttk-6.9 "Bad font spec in styles" -setup { ttk::style theme create badfont -settings { ttk::style configure . -font {Helvetica 12 Bogus} @@ -98,6 +94,30 @@ test ttk-6.9 "Bad font spec in styles" -setup { set ::bgerror } -result {unknown font style "Bogus"} +test ttk-construction-failure-1 "Excercise construction failure path" -setup { + option add *TLabel.cursor badCursor 1 +} -cleanup { + option add *TLabel.cursor {} 1 +} -body { + catch {ttk::label .l} errmsg + list $errmsg [info commands .l] [winfo exists .l] +} -result [list {bad cursor spec "badCursor"} {} 0] + +test ttk-construction-failure-2 "Destroy widget in constructor" -setup { + set OUCH ouch + trace variable OUCH r { kill.b } + proc kill.b {args} { destroy .b } +} -cleanup { + unset OUCH +} -body { + list \ + [catch { ttk::checkbutton .b -variable OUCH } msg] \ + $msg \ + [winfo exists .b] \ + [info commands .b] \ + ; +} -result [list 1 "Widget has been destroyed" 0 {}] + # # Basic tests. # @@ -111,7 +131,6 @@ test ttk-1.2 "Check style" -body { .t cget -style } -result {} - test ttk-1.4 "Restore default style" -body { .t cget -style } -result "" @@ -167,7 +186,6 @@ test ttk-2.7 "instate scripts, true" -body { set x } -result 1 - # misc. error detection test ttk-3.0 "Bad option" -body { ttk::button .bad -badoption foo @@ -186,6 +204,10 @@ test ttk-3.2 "Propagate errors from variable traces" -body { unset ::A ; destroy .cb } -returnCodes error -result {can't set "A": failure} +test ttk-3.3 "Constructor failure with cursor" -body { + ttk::button .b -cursor bottom_right_corner -style BadStyle +} -returnCodes 1 -result "Layout BadStyle not found" + test ttk-3.4 "SF#2009213" -body { ttk::style configure TScale -sliderrelief {} pack [ttk::scale .s] @@ -439,7 +461,7 @@ test ttk-9.6 "Unset -textvariable" -body { test ttk-9.7 "Unset textvariable, comparison" -body { # -# NB: the ttk label behaves differently from the standard label here; +# NB: ttk::label behaves differently from the standard label here; # NB: this is on purpose: I believe the standard behaviour is the Wrong Thing # unset -nocomplain V1 V2 @@ -549,7 +571,6 @@ test ttk-12.4 "-borderwidth frame option" -body { update } - test ttk-13.1 "Custom styles -- bad -style option" -body { ttk::button .tb1 -style badstyle } -returnCodes 1 -result "*badstyle not found*" -match glob @@ -590,7 +611,6 @@ test ttk-14.3 "-textvariable in nonexistant namespace" -body { } -returnCodes 1 -result {can't trace *: parent namespace doesn't exist} \ -match glob -cleanup { destroy .tw } - test ttk-15.1 "style element create: insufficient args" -body { ttk::style element create } -returnCodes 1 -result "wrong # args: should be \"ttk::style element create name type ?-option value ...?\"" -- cgit v0.12