Itk - the [incr Tk] extension

 *
 * ========================================================================
 *  AUTHOR:  Michael J. McLennan
 *           Bell Labs Innovations for Lucent Technologies
 *           [email protected]
 *           http://www.tcltk.com/itcl
 *
 *     RCS:  $Id: itkArchBase.c,v 1.1.2.7 2008/10/19 16:56:34 wiede Exp $
 * ========================================================================
 *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
 * ------------------------------------------------------------------------
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
#include <assert.h>
................................................................................
    ItclClass *contextClass;
    ItclClass *ownerClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_Command accessCmd;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;





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

    /*
     *  Execute the <createCmds> to create the component widget.
     *  Do this one level up, in the scope of the calling routine.
     */
    Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr);
    Tcl_Namespace *saveNsPtr = Tcl_GetCurrentNamespace(interp);
    ItclObjectInfo *infoPtr;
    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);
    int idx;
    idx = 2;
    if (Itcl_GetStackSize(&infoPtr->contextStack) == 1) {
	    idx = 1;
    }
    ItclCallContext *callContextPtr;
    callContextPtr = Itcl_GetStackValue(&infoPtr->contextStack,
            Itcl_GetStackSize(&infoPtr->contextStack)-idx);
    Itcl_SetCallFrameNamespace(interp, callContextPtr->nsPtr);


    result = Tcl_EvalObjEx(interp, objv[2], 0);
    Itcl_SetCallFrameNamespace(interp, saveNsPtr);
    if (result != TCL_OK) {
        goto compFail;
    }

    /*
     *  Take the result from the widget creation commands as the
     *  path name for the new component.  Make a local copy of
................................................................................
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
           "cannot find component access command \"",
            path, "\" for component \"", name, "\"",
            (char*)NULL);
        goto compFail;
    }


    winNamePtr = Tcl_NewStringObj((char*)NULL, 0);
    Tcl_GetCommandFullName(interp, accessCmd, winNamePtr);
    Tcl_IncrRefCount(winNamePtr);


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

 *
 * ========================================================================
 *  AUTHOR:  Michael J. McLennan
 *           Bell Labs Innovations for Lucent Technologies
 *           [email protected]
 *           http://www.tcltk.com/itcl
 *
 *     RCS:  $Id: itkArchBase.c,v 1.1.2.8 2009/10/23 16:37:35 wiede Exp $
 * ========================================================================
 *           Copyright (c) 1993-1998  Lucent Technologies, Inc.
 * ------------------------------------------------------------------------
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
#include <assert.h>
................................................................................
    ItclClass *contextClass;
    ItclClass *ownerClass;
    ItclObject *contextObj;
    ArchInfo *info;
    Tcl_Command accessCmd;
    Tcl_Obj *objPtr;
    Tcl_DString buffer;
    Tcl_CallFrame *uplevelFramePtr;
    Tcl_CallFrame *oldFramePtr;
    ItclObjectInfo *infoPtr;
    ItclCallContext *callContextPtr;

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

    /*
     *  Execute the <createCmds> to create the component widget.
     *  Do this one level up, in the scope of the calling routine.
     */
    Itcl_SetCallFrameResolver(interp, contextClass->resolvePtr);


    infoPtr = Tcl_GetAssocData(interp, ITCL_INTERP_DATA, NULL);









    uplevelFramePtr = Itcl_GetUplevelCallFrame(interp, 1);
    oldFramePtr = Itcl_ActivateCallFrame(interp, uplevelFramePtr);
    result = Tcl_EvalObjEx(interp, objv[2], 0);

    if (result != TCL_OK) {
        goto compFail;
    }

    /*
     *  Take the result from the widget creation commands as the
     *  path name for the new component.  Make a local copy of
................................................................................
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
           "cannot find component access command \"",
            path, "\" for component \"", name, "\"",
            (char*)NULL);
        goto compFail;
    }

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


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