Itk - the [incr Tk] extension

    ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv);
    int newEntry;
    int result;
    CONST char *cmd;
    CONST char *token;
    CONST char *resultStr;
    Tcl_CallFrame frame;
    char *name;
    Tcl_Namespace *parserNs;
    ItclClass *contextClass;
    ItclClass *ownerClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_Command accessCmd;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;


    Tcl_CallFrame *uplevelFramePtr;
    Tcl_CallFrame *oldFramePtr = NULL;
    ItclObjectInfo *infoPtr;
    ItclCallContext *callContextPtr;


    /*
     *  Get the Archetype info associated with this widget.
     */
    contextClass = NULL;
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
        !contextObj) {

    Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr);
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    uplevelFramePtr = Itcl_GetUplevelCallFrame(interp, 1);
    oldFramePtr = Itcl_ActivateCallFrame(interp, uplevelFramePtr);
#endif
    result = Tcl_EvalObjEx(interp, objv[2], 0);
    if (result != TCL_OK) {
fprintf(stdout, "FAIL '%s'!\n", Tcl_GetString(objv[2])); fflush(stdout);
        goto compFail;
    }

    /*
     *  Take the result from the widget creation commands as the
     *  path name for the new component.  Make a local copy of
     *  this, since the interpreter will get used in the mean time.

    Tcl_SetResult(interp, name, TCL_VOLATILE);
    return TCL_OK;

    /*
     *  If any errors were encountered, clean up and return.
     */
compFail:

    if (oldFramePtr) {
	(void) Itcl_ActivateCallFrame(interp, oldFramePtr);
    }

    if (archComp) {
        Itk_DelArchComponent(archComp);
    }
    if (entry) {
        Tcl_DeleteHashEntry(entry);
    }
    if (path) {

        cmdlinePtr = Itk_CreateConfigCmdline(interp,
            mergeInfo->archComp->accessCmd, token);

        optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
            Itk_PropagateOption, Itk_DeleteConfigCmdline,
            (ClientData)mergeInfo->archComp);

fprintf(stdout, "KEEP 4 '%s' '%s'\n", token,
Tcl_GetCurrentNamespace(interp)->fullName); fflush(stdout);

        result = Itk_AddOptionPart(interp, mergeInfo->archInfo,
            opt->switchName, opt->resName, opt->resClass,
            opt->init, opt->value, optPart, &archOpt);

fprintf(stdout, "KEEP 5 '%s'\n", token); fflush(stdout);
        if (result == TCL_OK) {
            opt->integrated = archOpt;
            opt->optPart    = optPart;
        } else {
            Itk_DelOptionPart(optPart);
fprintf(stdout, "KEEP ERROR '%s'\n", token); fflush(stdout);
            result = TCL_ERROR;
            break;
        }
    }
    return result;
}

        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "unknown option \"", name, "\"",
            (char*)NULL);
        return TCL_ERROR;
    }
    archOpt = (ArchOption*)Tcl_GetHashValue(entry);

fprintf(stdout, "ARCH SET OPTION '%s'\n", archOpt->switchName);
fflush(stdout);
    if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
	    (const char *)value, 0)) {
        Itk_ArchOptAccessError(interp, info, archOpt);
        return TCL_ERROR;
    }
    return TCL_OK;
}

    } else {
        lastval = NULL;
    }

    /*
     *  Update the "itk_option" array with the new setting.
     */
fprintf(stdout, "ARCH CONFIG OPTION '%s'\n", archOpt->switchName);
fflush(stdout);
    if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName, value, 0)) {
        Itk_ArchOptAccessError(interp, info, archOpt);
        result = TCL_ERROR;
        goto configDone;
    }

    /*

     *  If the option configuration failed, then set the option
     *  back to its previous settings.  Scan back through all of
     *  the option parts and sync them up with the old value.
     */
    if (result == TCL_ERROR) {
        istate = Itcl_SaveInterpState(interp, result);

fprintf(stdout, "ARCH CONFIG OPTION 2 '%s'\n", archOpt->switchName);
fflush(stdout);
        Tcl_SetVar2(interp, "itk_option", archOpt->switchName, lastval, 0);

        part = Itcl_FirstListElem(&archOpt->parts);
        while (part) {
            optPart = (ArchOptionPart*)Itcl_GetListValue(part);
            (*optPart->configProc)(interp, info->itclObj,
                optPart->clientData, lastval);

    ArchInfo *info,                /* info for Archetype mega-widget */
    ArchOption *archOpt,           /* option to initialize */
    CONST char *defVal,            /* last-resort default value */
    char *currVal)                 /* current option value */
{
    CONST char *init = NULL;


    Tcl_CallFrame frame;
    int result;

    CONST char *ival;
    char c;

    /*
     *  If the option is already initialized, then abort.
     */
    if (archOpt->init) {

        (c == 'v' && strcmp(archOpt->switchName,"-visual") == 0)) {
        ival = currVal;
    } else {
        ival = init;
    }

#if 1
{
//    Tcl_CallFrame *up = Itcl_GetUplevelCallFrame(interp, 1);
//    Tcl_CallFrame *save = Itcl_ActivateCallFrame(interp, up);

fprintf(stdout, "ARCH INIT OPTION '%s'\n", archOpt->switchName);
fflush(stdout);
    Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
            (char *)((ival) ? ival : ""), 0);

//    Itcl_ActivateCallFrame(interp, save);
}
#else
    /*
     *  Set the initial value in the itk_option array.
     *  Since this might be called from the itk::option-parser
     *  namespace, reinstall the object context.
     */
    result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);

    CONST char *defVal,              /* last-resort default value */
    char *currVal,                   /* current value (or NULL) */
    ArchOptionPart *optPart,         /* part to be added in */
    ArchOption **raOpt)              /* returns: option containing new part */
{
    CONST char *init = NULL;


    Tcl_CallFrame frame;

    int result;
    ArchOption *archOpt;

    *raOpt = NULL;
    archOpt = NULL;

    /*

     *  simply update this part to the current value.  Otherwise,
     *  leave the configuration to Itk_ArchInitCmd().
     */
    Itcl_AppendList(&archOpt->parts, (ClientData)optPart);

    if ((archOpt->flags & ITK_ARCHOPT_INIT) != 0) {

        result = Itcl_PushCallFrame(interp, &frame, info->itclObj->iclsPtr->nsPtr, /*isProcCallFrame*/0);

        if (result == TCL_OK) {
            init = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
            Itcl_PopCallFrame(interp);
        }

        if (!init) {
            Itk_ArchOptAccessError(interp, info, archOpt);
            return TCL_ERROR;
        }

    Itcl_ListElem *part;
    ArchOption *archOpt;
    ArchOptionPart *optPart;
    ItclHierIter hier;
    ItclVariable *ivPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *entry;

    ItclObjectInfo *infoPtr;
    ItclCallContext *callContextPtr;
    Tcl_HashEntry *hPtr;


    ItclShowArgs(2, "Itk_ArchInitCmd", objc, objv);
    contextClass = NULL;
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
        !contextObj) {

        token = Tcl_GetString(objv[0]);
        Tcl_ResetResult(interp);
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "improper usage: should be \"object ",
            token, " ?-option value -option value...?\"",
            (char*)NULL);
        return TCL_ERROR;
    }


    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);

    if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
        return TCL_ERROR;
    }

    /*
     *  See what class is being initialized by getting the namespace
     *  for the calling context.

            (char *)callContextPtr->nsPtr);
    if (hPtr != NULL) {
        contextClass = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
#endif


fprintf(stdout, "INIT context class = '%s'\n",
Tcl_GetString(contextClass->fullNamePtr)); fflush(stdout);
    /*
     *  Integrate all public variables for the current class
     *  context into the composite option list.
     */
    Itcl_InitHierIter(&hier, contextClass);
    while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
        entry = Tcl_FirstHashEntry(&iclsPtr->variables, &place);

     *  Invoke the parts of uninitialized options to propagate
     *  changes and update the widget.
     */
    if (contextObj->iclsPtr == contextClass) {
        for (i=0; i < info->order.len; i++) {
            archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);

fprintf(stdout, "GETTING VAR...\n"); fflush(stdout);
            if ((archOpt->flags & ITK_ARCHOPT_INIT) == 0) {
                val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);

                if (!val) {
fprintf(stdout, "INIT context class = '%s' object='%s'\n",
Tcl_GetString(contextClass->fullNamePtr),
Tcl_GetString(contextObj->namePtr)
); fflush(stdout);
                    Itk_ArchOptAccessError(interp, info, archOpt);
                    return TCL_ERROR;
                }

                part = Itcl_FirstListElem(&archOpt->parts);
                while (part) {
                    optPart = (ArchOptionPart*)Itcl_GetListValue(part);

    constructor {args} {
        #
        #  Create a window with the same name as this object
        #
        set itk_hull [namespace tail $this]
        set itk_interior $itk_hull

puts "WHICH:[namespace which itk_component]"
        itk_component add hull {
            frame $itk_hull -class [namespace tail [info class]]
        } {
puts "WHICH:[namespace which keep]"
            keep -background -cursor
        }
        bind itk-delete-$itk_hull <Destroy> [list itcl::delete object $this]

        set tags [bindtags $itk_hull]
        bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]

test option-1.2 {"keep" can be called more than once} {
    .testOptWidget0 do {
        itk_component add k0 {
            TestOptComp $itk_interior.k0 -status "create"
        } {
            keep -background -foreground -cursor
#            keep -background -foreground -cursor
#            keep -status
#            keep -status
        }
        pack $itk_component(k0)
    }
    .testOptWidget0 configure -status "foo"
    .testOptWidget0 component k0 do {set status}
} {create foo}