diff options
Diffstat (limited to 'itcl/itk/generic/itk_archetype.c')
| -rw-r--r-- | itcl/itk/generic/itk_archetype.c | 71 |
1 files changed, 54 insertions, 17 deletions
diff --git a/itcl/itk/generic/itk_archetype.c b/itcl/itk/generic/itk_archetype.c index 06a031f745b..f8075863145 100644 --- a/itcl/itk/generic/itk_archetype.c +++ b/itcl/itk/generic/itk_archetype.c @@ -791,10 +791,10 @@ Itk_ArchCompAddCmd(dummy, interp, objc, objv) oldFramePtr = _Tcl_ActivateCallFrame(interp, uplevelFramePtr); /* CYGNUS LOCAL - Fix for Tcl8.1 */ -#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 - if (Tcl_EvalObj(interp, objv[2]) != TCL_OK) { -#else +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 if (Tcl_EvalObj(interp, objv[2], 0) != TCL_OK) { +#else + if (Tcl_EvalObj(interp, objv[2]) != TCL_OK) { #endif /* END CYGNUS LOCAL */ goto compFail; @@ -986,10 +986,10 @@ Itk_ArchCompAddCmd(dummy, interp, objc, objv) if (result == TCL_OK) { /* CYGNUS LOCAL - Fix for Tcl8.1 */ -#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 - result = Tcl_EvalObj(interp, objPtr); -#else +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 result = Tcl_EvalObj(interp, objPtr, 0); +#else + result = Tcl_EvalObj(interp, objPtr); #endif /* END CYGNUS LOCAL */ Tcl_PopCallFrame(interp); @@ -1112,6 +1112,8 @@ Itk_ArchCompDeleteCmd(dummy, interp, objc, objv) ArchComponent *archComp; ArchOption *archOpt; ArchOptionPart *optPart; + Itcl_List delOptList; + Tcl_DString buffer; /* * Get the Archetype info associated with this widget. @@ -1143,8 +1145,31 @@ Itk_ArchCompDeleteCmd(dummy, interp, objc, objv) return TCL_ERROR; } archComp = (ArchComponent*)Tcl_GetHashValue(entry); + + /* + * Clean up the binding tag that causes the widget to + * call this method automatically when destroyed. + * Ignore errors if anything goes wrong. + */ + Tcl_DStringInit(&buffer); + Tcl_DStringAppend(&buffer, "itk::remove_destroy_hook ", -1); + Tcl_DStringAppend(&buffer, Tk_PathName(archComp->tkwin), -1); + (void) Tcl_Eval(interp, Tcl_DStringValue(&buffer)); + Tcl_ResetResult(interp); + Tcl_DStringFree(&buffer); + + Tcl_UnsetVar2(interp, "itk_component", token, 0); Tcl_DeleteHashEntry(entry); + /* + * Clean up the options that belong to the component. Do this + * by scanning through all available options and looking for + * those that belong to the component. If we remove them as + * we go, we'll mess up Tcl_NextHashEntry. So instead, we + * build up a list of options to remove, and then remove the + * options below. + */ + Itcl_InitList(&delOptList); entry = Tcl_FirstHashEntry(&info->options, &place); while (entry) { archOpt = (ArchOption*)Tcl_GetHashValue(entry); @@ -1152,16 +1177,28 @@ Itk_ArchCompDeleteCmd(dummy, interp, objc, objv) while (elem) { optPart = (ArchOptionPart*)Itcl_GetListValue(elem); if (optPart->from == (ClientData)archComp) { - Itk_DelOptionPart(optPart); - elem = Itcl_DeleteListElem(elem); - } - else { - elem = Itcl_NextListElem(elem); + Itcl_AppendList(&delOptList, (ClientData)entry); } + elem = Itcl_NextListElem(elem); } entry = Tcl_NextHashEntry(&place); } + /* + * Now that we've figured out which options to delete, + * go through the list and remove them. + */ + elem = Itcl_FirstListElem(&delOptList); + while (elem) { + entry = (Tcl_HashEntry*)Itcl_GetListValue(elem); + token = Tcl_GetHashKey(&info->options, entry); + + Itk_RemoveArchOptionPart(info, token, (ClientData)archComp); + + elem = Itcl_NextListElem(elem); + } + Itcl_DeleteList(&delOptList); + Itk_DelArchComponent(archComp); } return TCL_OK; @@ -1544,10 +1581,10 @@ Itk_ArchOptUsualCmd(clientData, interp, objc, objv) if (entry) { codePtr = (Tcl_Obj*)Tcl_GetHashValue(entry); /* CYGNUS LOCAL - Fix for Tcl8.1 */ -#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 - return Tcl_EvalObj(interp, codePtr); -#else +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 return Tcl_EvalObj(interp, codePtr, 0); +#else + return Tcl_EvalObj(interp, codePtr); #endif /* END CYGNUS LOCAL */ } @@ -4043,10 +4080,10 @@ Itk_CreateGenericOpt(interp, switchName, accessCmd) Tcl_AppendToObj(codePtr, name, -1); /* CYGNUS LOCAL - Fix for Tcl8.1 */ -#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 - if (Tcl_EvalObj(interp, codePtr) != TCL_OK) { +#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 1 + if (Tcl_EvalObj(interp, codePtr, 0) != TCL_OK) { #else - if (Tcl_EvalObj(interp, codePtr, 0) != TCL_OK) { + if (Tcl_EvalObj(interp, codePtr) != TCL_OK) { #endif /* END CYGNUS LOCAL */ goto optionDone; |