Itk - the [incr Tk] extension

    ItclClass *contextClass;
    ItclClass *ownerClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_Command accessCmd;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;
#if 0
    Tcl_CallFrame frame;
    Tcl_CallFrame *uplevelFramePtr;
    Tcl_CallFrame *oldFramePtr = NULL;
    ItclObjectInfo *infoPtr;
    ItclCallContext *callContextPtr;
#endif

    ItclShowArgs(1, "Itk_ArchCompAddCmd", objc, objv);
    /*
     *  Get the Archetype info associated with this widget.
     */
    contextClass = NULL;
    if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||

        }
    }

    /*
     *  Execute the <createCmds> to create the component widget.
     *  Do this one level up, in the scope of the calling routine.
     */
#if 0
    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) {
        goto compFail;
    }

    /*
     *  Take the result from the widget creation commands as the

        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
           "cannot find component access command \"",
            path, "\" for component \"", name, "\"",
            (char*)NULL);
        goto compFail;
    }

#if 0
    (void) Itcl_ActivateCallFrame(interp, oldFramePtr);
    oldFramePtr = NULL;
#endif
    winNamePtr = Tcl_NewStringObj((char*)NULL, 0);
    Tcl_GetCommandFullName(interp, accessCmd, winNamePtr);
    Tcl_IncrRefCount(winNamePtr);


    /*
     *  Create the component record.  Set the protection level

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

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

    /*
     *  If any errors were encountered, clean up and return.
     */
compFail:
#if 0
    if (oldFramePtr) {
	(void) Itcl_ActivateCallFrame(interp, oldFramePtr);
    }
#endif
    if (archComp) {
        Itk_DelArchComponent(archComp);
    }
    if (entry) {
        Tcl_DeleteHashEntry(entry);
    }
    if (path) {

    /*
     *  Update the public variable with the new option value.
     *  There should already be a call frame installed for handling
     *  instance variables, but make sure that the namespace context
     *  is the most-specific class, so that the public variable can
     *  be found.
     */
#if 0
    result = Itcl_PushCallFrame(interp, &frame, contextObj->iclsPtr->nsPtr,
            /*isProcCallFrame*/0);
#endif

    if (result == TCL_OK) {
	/*
	 * Casting away CONST of newval only to satisfy Tcl 8.3 and
	 * earlier headers.
	 */
        val = Tcl_SetVar2(interp, Tcl_GetString(ivPtr->fullNamePtr), (char *) NULL,
            (char *) newval, TCL_LEAVE_ERR_MSG);

        if (!val) {
            result = TCL_ERROR;
        }
#if 0
        Itcl_PopCallFrame(interp);
#endif
    }

    if (result != TCL_OK) {
        char msg[256];
        sprintf(msg, "\n    (error in configuration of public variable \"%.100s\")", Tcl_GetString(ivPtr->fullNamePtr));
        Tcl_AddErrorInfo(interp, msg);
        return TCL_ERROR;

    Tcl_Interp *interp,            /* interpreter managing the object */
    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;

#if 0
    Tcl_CallFrame frame;
    int result;
#endif
    CONST char *ival;
    char c;

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

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

#if 1
    Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
            (char *)((ival) ? ival : ""), 0);
#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);
    }
}


    char *resClass,                  /* resource class name in X11 database */
    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;

#if 0
    Tcl_CallFrame frame;
#endif
    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_ParseNamespPath(cmd, &buffer, &head, &tail);
    if (objc < 2) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
            "wrong # args: should be one of...\n",
            "  ", tail, " add ?-protected? ?-private? ?--? name createCmds ?optionCmds?\n",
            "  ", tail, " delete name ?name name...?",
            (char*)NULL);
    Tcl_DStringFree(&buffer);
	Tcl_DStringFree(&buffer);
        return TCL_ERROR;
    }

    token = Tcl_GetString(objv[1]);
    c = *token;
    length = strlen(token);

    /*
     *  Handle:  itk_component add...
     */
    if (c == 'a' && strncmp(token, "add", length) == 0) {
        if (objc < 4) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "wrong # args: should be \"",
                tail,
		" add ?-protected? ?-private? ?--?",
		" name createCmds ?optionCmds?\"",
                (char*)NULL);
    Tcl_DStringFree(&buffer);
	    Tcl_DStringFree(&buffer);
            return TCL_ERROR;
        }
    Tcl_DStringFree(&buffer);
	Tcl_DStringFree(&buffer);
        return Itk_ArchCompAddCmd(dummy, interp, objc-1, objv+1);
    } else {

        /*
         *  Handle:  itk_component delete...
         */
        if (c == 'd' && strncmp(token, "delete", length) == 0) {
            if (objc < 3) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "wrong # args: should be \"",
                    tail,
		    " delete name ?name name...?\"",
                    (char*)NULL);
    Tcl_DStringFree(&buffer);
		    Tcl_DStringFree(&buffer);
                return TCL_ERROR;
            }
    Tcl_DStringFree(&buffer);
	    Tcl_DStringFree(&buffer);
            return Itk_ArchCompDeleteCmd(dummy, interp, objc-1, objv+1);
        }
    }
    Tcl_DStringFree(&buffer);

    /*
     *  Flag any errors.

    Itcl_ListElem *part;
    ArchOption *archOpt;
    ArchOptionPart *optPart;
    ItclHierIter hier;
    ItclVariable *ivPtr;
    Tcl_HashSearch place;
    Tcl_HashEntry *entry;
#if 0
    ItclObjectInfo *infoPtr;
    ItclCallContext *callContextPtr;
    Tcl_HashEntry *hPtr;
#endif

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

#if 0
    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
#endif
    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.
     */
#if 0
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
            Itcl_GetStackSize(&infoPtr->contextStack)-2);
    hPtr = Tcl_FindHashEntry(
            &callContextPtr->ioPtr->iclsPtr->infoPtr->namespaceClasses,
            (char *)callContextPtr->nsPtr);
    if (hPtr != NULL) {
        contextClass = (ItclClass *)Tcl_GetHashValue(hPtr);
    }
#endif


    /*
     *  Integrate all public variables for the current class
     *  context into the composite option list.
     */
    Itcl_InitHierIter(&hier, contextClass);
    while ((iclsPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {

        return TCL_ERROR;
    }

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

callingNs = Tcl_GetCurrentNamespace(interp);
    callingNs = Tcl_GetCurrentNamespace(interp);

#if 0
    infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
            ITCL_INTERP_DATA, NULL);
    if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) {
        callingNs = Tcl_GetGlobalNamespace(interp);
    } else {
	ItclCallContext *callContextPtr;
	callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
	        Itcl_GetStackSize(&infoPtr->contextStack)-2);
#ifdef NOTDEF
        callingNs = (Tcl_Namespace *)Itcl_GetStackValue(
	        &infoPtr->namespaceStack,
		Itcl_GetStackSize(&infoPtr->namespaceStack)-2);
#endif
        callingNs = callContextPtr->nsPtr;
    }
#endif
    /*
     *  With no arguments, return a list of components that can be
     *  accessed from the calling scope.
     */
    if (objc == 2) {
	/* if the name of the component is the empty string ignore that arg */
        if (strlen(Tcl_GetString(objv[1])) == 0) {

	}
    }
    ItclShowArgs(1, "Itk_ArchConfigureCmd2", objc, objv);
    if (objc == 1) {
        Tcl_DStringInit(&buffer);

        for (i=0; i < info->order.len; i++) {
Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
	    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
            archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);

Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
	    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
            val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
Itcl_SetCallFrameNamespace(interp, save);
	    Itcl_SetCallFrameNamespace(interp, save);
            if (!val) {
                Itk_ArchOptAccessError(interp, info, archOpt);
                Tcl_DStringFree(&buffer);
                return TCL_ERROR;
            }

            Tcl_DStringStartSublist(&buffer);

        /*
         *  If there is just one argument, then query the information
         *  for that one argument and return:
         *    {name resName resClass init value}
         */
        if (objc == 2) {
Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
	    Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
            token = Tcl_GetString(objv[1]);
            entry = Tcl_FindHashEntry(&info->options, token);
            if (!entry) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "unknown option \"", token, "\"",
                    (char*)NULL);
                return TCL_ERROR;
            }

            archOpt = (ArchOption*)Tcl_GetHashValue(entry);
Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
	    Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
            val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
Itcl_SetCallFrameNamespace(interp, save);
	    Itcl_SetCallFrameNamespace(interp, save);
            if (!val) {
                Itk_ArchOptAccessError(interp, info, archOpt);
                return TCL_ERROR;
            }

            Tcl_AppendElement(interp, archOpt->switchName);
            Tcl_AppendElement(interp,

    /*
     *  Otherwise, it must be a series of "-option value" assignments.
     *  Look up each option and assign the new value.
     */
    for (objc--,objv++; objc > 0; objc-=2, objv+=2) {
	char *value;
	int code;
Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
	Tcl_Namespace *save = Tcl_GetCurrentNamespace(interp);
        token = Tcl_GetString(objv[0]);
        if (objc < 2) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "value for \"", token, "\" missing",
                (char*)NULL);
            return TCL_ERROR;
        }
        value = Tcl_GetString(objv[1]);

Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
	Itcl_SetCallFrameNamespace(interp, contextObj->iclsPtr->nsPtr);
        code = Itk_ArchConfigOption(interp, info, token, value);
Itcl_SetCallFrameNamespace(interp, save);
	Itcl_SetCallFrameNamespace(interp, save);
        if (code != TCL_OK) {
            return TCL_ERROR;
        }
    }

    Tcl_ResetResult(interp);
    return TCL_OK;