Itk - the [incr Tk] extension

    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.

    if (objc != 4) {
        objPtr = Tcl_NewStringObj("usual", -1);
        Tcl_IncrRefCount(objPtr);
    } else {
        objPtr = objv[3];
    }

//    result = Itcl_PushCallFrame(interp, &frame, parserNs,
 //           /* isProcCallFrame */ 0);

    Tcl_Import(interp, NULL, "::itk::option-parser::*", 1);

    if (result == TCL_OK) {
        result = Tcl_EvalObj(interp, objPtr);
  //      Itcl_PopCallFrame(interp);
	Tcl_ForgetImport(interp, NULL, "::itk::option-parser::*");
    }

    if (objc != 4) {
        Tcl_DecrRefCount(objPtr);
    }
    if (result != TCL_OK) {
        goto compFail;

        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);

        (c == 's' && strcmp(archOpt->switchName,"-screen") == 0) ||
        (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);

    if (result == TCL_OK) {
	/*
	 * Casting away CONST of ival only to satisfy Tcl 8.3 and
	 * earlier headers.
	 */
fprintf(stdout, "ARCH INIT OPTION '%s'\n", archOpt->switchName);
fflush(stdout);
char *res =        Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
            (char *)((ival) ? ival : ""), 0);
fprintf(stdout, "STORED: '%s'\n", res); fflush(stdout);
fprintf(stdout, "CONTEXT: '%s'\n", Tcl_GetCurrentNamespace(interp)->fullName);
    Itcl_PopCallFrame(interp);
    }
#endif

    if (ival) {
        archOpt->init = (char*)ckalloc((unsigned)(strlen(ival)+1));
        strcpy(archOpt->init, ival);
    }
}


    if (!parserNs) {
        Itk_DelMergeInfo((char*)mergeInfo);
        Tcl_AddErrorInfo(interp, "\n    (while initializing itk)");
        return TCL_ERROR;
    }
    Itcl_PreserveData((ClientData)mergeInfo);
    Itcl_EventuallyFree((ClientData)mergeInfo, Itk_DelMergeInfo);
    Tcl_Export(interp, parserNs, "[a-z]*", 1);

    Tcl_CreateObjCommand(interp, "::itk::option-parser::keep",
        Itk_ArchOptKeepCmd,
        (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);

    Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore",
        Itk_ArchOptIgnoreCmd,

            (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);

        eval configure $option $args
    }

    method component {{name ""} args} {
        ::itcl::builtin::Archetype component $name {*}$args
    }

#    protected method itk_component {option args} {
#        ::itcl::builtin::Archetype itk_component $option {*}$args
#    }
    protected method itk_component {option args} @Archetype-itk_component


#    protected method itk_option {option args} {
#        ::itcl::builtin::Archetype itk_option $option {*}$args
#    }
    protected method itk_option {option args} @Archetype-itk_option


#    protected method itk_initialize {args} {
#        ::itcl::builtin::Archetype itk_initialize {*}$args

#    }
    protected method itk_initialize {args} @Archetype-itk_initialize

    protected variable itk_option
    protected variable itk_component
    protected variable itk_interior ""

    # ------------------------------------------------------------------
    #  Options common to all widgets

    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}