Tcl Source Code

Artifact 048b995856af36e21fe409e93622b48a4cc1af21:

Attachment "wantedinterfacesfromtcl.c" to ticket [1865230fff] added by wiede 2008-01-07 01:47:43.

---

int
Itcl_InitRewriteEnsemble(
    Tcl_Interp *interp,
    int numRemoved,
    int numInserted,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
        iPtr->ensembleRewrite.sourceObjs = objv;
        iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
        iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
        int numIns = iPtr->ensembleRewrite.numInsertedObjs;
        if (numIns < numRemoved) {
            iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
            iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
        } else {
            iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
        }
    }
    return isRootEnsemble;
}

void
Itcl_ResetRewriteEnsemble(
    Tcl_Interp *interp,
    int isRootEnsemble)
{
    Interp *iPtr = (Interp *) interp;

    if (isRootEnsemble) {
        iPtr->ensembleRewrite.sourceObjs = NULL;
        iPtr->ensembleRewrite.numRemovedObjs = 0;
        iPtr->ensembleRewrite.numInsertedObjs = 0;
    }
}

Tcl_Var
Itcl_NewNamespaceVar(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,
    const char *varName)
{
    Var *varPtr = NULL;
    int new;

    if ((nsPtr == NULL) || (varName == NULL)) {
        return NULL;
    }

    varPtr = TclVarHashCreateVar(&((Namespace *)nsPtr)->varTable,
            varName, &new);
    TclSetVarNamespaceVar(varPtr);
    VarHashRefCount(varPtr)++;
    return (Tcl_Var)varPtr;
}

Tcl_Namespace *
Itcl_GetUplevelNamespace(
    Tcl_Interp *interp,
    int level)
{
    if (level < 0) {
        return NULL;
    }
    CallFrame *framePtr = ((Interp *)interp)->framePtr;
    while ((framePtr != NULL) && (level-- > 0)) {
        framePtr = framePtr->callerVarPtr;
    }
    if (framePtr == NULL) {
        return NULL;
    }
    return (Tcl_Namespace *)framePtr->nsPtr;
}

ClientData
Itcl_GetCallFrameClientData(
    Tcl_Interp *interp)
{
    CallFrame *framePtr = ((Interp *)interp)->framePtr;
    if (framePtr == NULL) {
        return NULL;
    }
    return framePtr->clientData;
}

int
Itcl_SetCallFrameNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr)
{
    CallFrame *framePtr = ((Interp *)interp)->framePtr;
    if (framePtr == NULL) {
        return TCL_ERROR;
    }
    ((Interp *)interp)->framePtr->nsPtr = (Namespace *)nsPtr;
    return TCL_OK;
}

int
Itcl_GetCallFrameObjc(
    Tcl_Interp *interp)
{
    CallFrame *framePtr = ((Interp *)interp)->framePtr;
    if (framePtr == NULL) {
        return 0;
    }
    return ((Interp *)interp)->framePtr->objc;
}

Tcl_Obj * const *
Itcl_GetCallFrameObjv(
    Tcl_Interp *interp)
{
    CallFrame *framePtr = ((Interp *)interp)->framePtr;
    if (framePtr == NULL) {
        return NULL;
    }
    return ((Interp *)interp)->framePtr->objv;
}

int
Itcl_IsCallFrameArgument(
    Tcl_Interp *interp,
    const char *name)
{
    CallFrame *varFramePtr = ((Interp *)interp)->framePtr;
    if (varFramePtr == NULL) {
        return 0;
    }
    if (!varFramePtr->isProcCallFrame) {
        return 0;
    }
    Proc *procPtr = varFramePtr->procPtr;
    /*
     *  Search through compiled locals first...
     */
    if (procPtr) {
        CompiledLocal *localPtr = procPtr->firstLocalPtr;
        int nameLen = strlen(name);

        for (;localPtr != NULL; localPtr = localPtr->nextPtr) {
            if (TclIsVarArgument(localPtr)) {
                register char *localName = localPtr->name;
                if ((name[0] == localName[0])
                        && (nameLen == localPtr->nameLength)
                        && (strcmp(name, localName) == 0)) {
                    return 1;
                }
            }
        }            
    }
    return 0;
}

int
Itcl_ProcessReturn(
    Tcl_Interp *interp,
    int code,
    int level,
    Tcl_Obj *returnOpts)
{
    Interp *iPtr = (Interp *) interp;
    if (level != 0) {
        iPtr->returnLevel = level;
        iPtr->returnCode = code;
        return TCL_RETURN;
    }
    return TCL_ERROR;
}

int
ItclGetInterpErrorLine(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    return iPtr->errorLine;
}