int
ItclCallCCommand(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const *objv)
{
Tcl_CmdProc *argProc;
Tcl_ObjCmdProc *objProc;
ClientData cData;
int result;
ItclShowArgs(2, "ItclCallCCommand", objc, objv);
if (!Itcl_FindC(interp, Tcl_GetString(objv[1])+1, &argProc,
&objProc, &cData)) {
Tcl_AppendResult(interp, "no such registered C command 1: \"",
Tcl_GetString(objv[1]), "\"", NULL);
return TCL_ERROR;
}
if ((argProc == NULL) && (objProc == NULL)) {
Tcl_AppendResult(interp, "no such registered C command 2: \"",
Tcl_GetString(objv[1]), "\"", NULL);
return TCL_ERROR;
}
result = TCL_ERROR;
if (argProc != NULL) {
const char **argv;
int i;
argv = (const char**)ckalloc((unsigned)((objc-1)*sizeof(char*)));
for (i=2;i<objc;i++) {
argv[i-2] = Tcl_GetString(objv[i]);
}
result = (*argProc)(cData, interp, objc-2, argv);
ckfree((char*)argv);
}
if (objProc != NULL) {
#ifdef FIXED_ITCL_CALL_CONTEXT
Tcl_Namespace *callerNsPtr;
ItclObjectInfo *infoPtr;
callerNsPtr = Itcl_GetUplevelNamespace(interp, 1);
ItclShowArgs(2, "CARGS", Itcl_GetCallFrameObjc(interp),
Itcl_GetCallFrameObjv(interp));
infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
ITCL_INTERP_DATA, NULL);
/* FIXME have to use ItclCallContext here !!! */
/* Itcl_PushStack(callerNsPtr, &infoPtr->namespaceStack); */
#endif
result = (*objProc)(cData, interp, Itcl_GetCallFrameObjc(interp)-1,
Itcl_GetCallFrameObjv(interp)+1);
#ifdef FIXED_ITCL_CALL_CONTEXT
/* Itcl_PopStack(&infoPtr->namespaceStack); */
#endif
}
return result;
}
/*
* ------------------------------------------------------------------------
* Itcl_ClassVarResolver()
*
* Used by the class namespaces to handle name resolution for runtime
* variable accesses. This procedure looks for references to both
* common variables and instance variables at runtime. It is used as
* a second line of defense, to handle references that could not be
* resolved as compiled locals.
*
* If a variable is found, this procedure returns TCL_OK along with
* the appropriate Tcl variable in the rPtr argument. If a particular
* variable is private, this procedure returns TCL_ERROR and access
* to the variable is denied. If a variable is not recognized, this
* procedure returns TCL_CONTINUE, and lookup continues via the normal
* Tcl name resolution rules.
* ------------------------------------------------------------------------
*/
int
Itcl_ClassVarResolver2(
Tcl_Interp *interp, /* current interpreter */
const char* name, /* name of the variable being accessed */
Tcl_Namespace *nsPtr, /* namespace performing the resolution */
int flags, /* TCL_LEAVE_ERR_MSG => leave error messages
* in interp if anything goes wrong */
Tcl_Var *rPtr) /* returns: resolved variable */
{
ItclObjectInfo *infoPtr;
ItclClass *iclsPtr;
ItclObject *contextIoPtr;
Tcl_HashEntry *hPtr;
ItclVarLookup *vlookup;
Tcl_Var varPtr;
ItclResolvingInfo *iriPtr;
ObjectVarTableInfo *ovtiPtr;
ObjectVarInfo *oviPtr;
Tcl_Namespace *upNsPtr;
upNsPtr = Itcl_GetUplevelNamespace(interp, 1);
/*
* If this is a global variable, handle it in the usual
* Tcl manner.
*/
if (flags & TCL_GLOBAL_ONLY) {
return TCL_CONTINUE;
}
infoPtr = (ItclObjectInfo *)Tcl_GetAssocData(interp,
ITCL_INTERP_DATA, NULL);
hPtr = Tcl_FindHashEntry(&infoPtr->namespaceClasses, (char *)nsPtr);
if (hPtr == NULL) {
return TCL_CONTINUE;
}
iclsPtr = Tcl_GetHashValue(hPtr);
/*
* See if this is a formal parameter in the current proc scope.
* If so, that variable has precedence. Look it up and return
* it here. This duplicates some of the functionality of
* TclLookupVar, but we return it here (instead of returning
* TCL_CONTINUE) to avoid looking it up again later.
*/
ItclCallContext *callContextPtr;
callContextPtr = Itcl_PeekStack(&infoPtr->contextStack);
if ((strstr(name,"::") == NULL) &&
Itcl_IsCallFrameArgument(interp, name)) {
return TCL_CONTINUE;
}
iriPtr = Tcl_GetAssocData(interp, ITCL_RESOLVE_DATA, NULL);
hPtr = Tcl_FindHashEntry(&iriPtr->resolveVars , nsPtr->fullName);
if (hPtr != NULL) {
Tcl_HashTable *tablePtr;
tablePtr = Tcl_GetHashValue(hPtr);
hPtr = Tcl_FindHashEntry(tablePtr , name);
if (hPtr != NULL) {
int ret;
ItclClassVarInfo *icviPtr = Tcl_GetHashValue(hPtr);
ret = (* iriPtr->varProtFcn)(interp,
Tcl_GetCurrentNamespace(interp), name,
(ClientData)icviPtr);
if (ret != TCL_OK) {
return ret;
}
/*
* If this is an instance variable, then we have to
* find the object context,
*/
if ((callContextPtr != NULL) && (callContextPtr->ioPtr != NULL)) {
contextIoPtr = callContextPtr->ioPtr;
hPtr = Tcl_FindHashEntry(&iriPtr->objectVarsTables,
(char *)contextIoPtr);
if (hPtr != NULL) {
ovtiPtr = Tcl_GetHashValue(hPtr);
hPtr = Tcl_FindHashEntry(&ovtiPtr->varInfos,
(char *)icviPtr);
if (hPtr != NULL) {
oviPtr = Tcl_GetHashValue(hPtr);
varPtr = oviPtr->varPtr;
*rPtr = varPtr;
return TCL_OK;
}
}
}
}
}
/*
* See if the variable is a known data member and accessible.
*/
hPtr = Tcl_FindHashEntry(&iclsPtr->resolveVars, name);
if (hPtr == NULL) {
return TCL_CONTINUE;
}
vlookup = (ItclVarLookup*)Tcl_GetHashValue(hPtr);
if (!vlookup->accessible) {
return TCL_CONTINUE;
}
/*
* If this is a common data member, then its variable
* is easy to find. Return it directly.
*/
if ((vlookup->ivPtr->flags & ITCL_COMMON) != 0) {
hPtr = Tcl_FindHashEntry(&vlookup->ivPtr->iclsPtr->classCommons,
(char *)vlookup->ivPtr);
if (hPtr != NULL) {
*rPtr = Tcl_GetHashValue(hPtr);
return TCL_OK;
}
}
return TCL_CONTINUE;
}
