📄 itcl_parse.c
字号:
* Handles the following syntax: * * method <name> ?<arglist>? ?<body>? * * ------------------------------------------------------------------------ */intItcl_ClassMethodCmd(clientData, interp, objc, objv) ClientData clientData; /* info for all known objects */ Tcl_Interp *interp; /* current interpreter */ int objc; /* number of arguments */ Tcl_Obj *CONST objv[]; /* argument objects */{ ItclObjectInfo *info = (ItclObjectInfo*)clientData; ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack); char *name, *arglist, *body; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "name ?args? ?body?"); return TCL_ERROR; } name = Tcl_GetStringFromObj(objv[1], (int*)NULL); arglist = NULL; body = NULL; if (objc >= 3) { arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL); } if (objc >= 4) { body = Tcl_GetStringFromObj(objv[3], (int*)NULL); } if (Itcl_CreateMethod(interp, cdefnPtr, name, arglist, body) != TCL_OK) { return TCL_ERROR; } return TCL_OK;} /* * ------------------------------------------------------------------------ * Itcl_ClassProcCmd() * * Invoked by Tcl during the parsing of a class definition whenever * the "proc" command is invoked to define a common class proc. * A "proc" is like a "method", but only has access to "common" * class variables. Handles the following syntax: * * proc <name> ?<arglist>? ?<body>? * * ------------------------------------------------------------------------ */intItcl_ClassProcCmd(clientData, interp, objc, objv) ClientData clientData; /* info for all known objects */ Tcl_Interp *interp; /* current interpreter */ int objc; /* number of arguments */ Tcl_Obj *CONST objv[]; /* argument objects */{ ItclObjectInfo *info = (ItclObjectInfo*)clientData; ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack); char *name, *arglist, *body; if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "name ?args? ?body?"); return TCL_ERROR; } name = Tcl_GetStringFromObj(objv[1], (int*)NULL); arglist = NULL; body = NULL; if (objc >= 3) { arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL); } if (objc >= 4) { body = Tcl_GetStringFromObj(objv[3], (int*)NULL); } if (Itcl_CreateProc(interp, cdefnPtr, name, arglist, body) != TCL_OK) { return TCL_ERROR; } return TCL_OK;} /* * ------------------------------------------------------------------------ * Itcl_ClassVariableCmd() * * Invoked by Tcl during the parsing of a class definition whenever * the "variable" command is invoked to define an instance variable. * Handles the following syntax: * * variable <varname> ?<init>? ?<config>? * * ------------------------------------------------------------------------ */intItcl_ClassVariableCmd(clientData, interp, objc, objv) ClientData clientData; /* info for all known objects */ Tcl_Interp *interp; /* current interpreter */ int objc; /* number of arguments */ Tcl_Obj *CONST objv[]; /* argument objects */{ ItclObjectInfo *info = (ItclObjectInfo*)clientData; ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack); int pLevel; ItclVarDefn *vdefn; char *name, *init, *config; pLevel = Itcl_Protection(interp, 0); if (pLevel == ITCL_PUBLIC) { if (objc < 2 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "name ?init? ?config?"); return TCL_ERROR; } } else if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "name ?init?"); return TCL_ERROR; } /* * Make sure that the variable name does not contain anything * goofy like a "::" scope qualifier. */ name = Tcl_GetStringFromObj(objv[1], (int*)NULL); if (strstr(name, "::")) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad variable name \"", name, "\"", (char*)NULL); return TCL_ERROR; } init = NULL; config = NULL; if (objc >= 3) { init = Tcl_GetStringFromObj(objv[2], (int*)NULL); } if (objc >= 4) { config = Tcl_GetStringFromObj(objv[3], (int*)NULL); } if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, config, &vdefn) != TCL_OK) { return TCL_ERROR; } return TCL_OK;} /* * ------------------------------------------------------------------------ * Itcl_ClassCommonCmd() * * Invoked by Tcl during the parsing of a class definition whenever * the "common" command is invoked to define a variable that is * common to all objects in the class. Handles the following syntax: * * common <varname> ?<init>? * * ------------------------------------------------------------------------ */intItcl_ClassCommonCmd(clientData, interp, objc, objv) ClientData clientData; /* info for all known objects */ Tcl_Interp *interp; /* current interpreter */ int objc; /* number of arguments */ Tcl_Obj *CONST objv[]; /* argument objects */{ ItclObjectInfo *info = (ItclObjectInfo*)clientData; ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack); int newEntry; char *name, *init; ItclVarDefn *vdefn; Tcl_HashEntry *entry; Namespace *nsPtr; Var *varPtr; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?"); return TCL_ERROR; } /* * Make sure that the variable name does not contain anything * goofy like a "::" scope qualifier. */ name = Tcl_GetStringFromObj(objv[1], (int*)NULL); if (strstr(name, "::")) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad variable name \"", name, "\"", (char*)NULL); return TCL_ERROR; } init = NULL; if (objc >= 3) { init = Tcl_GetStringFromObj(objv[2], (int*)NULL); } if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL, &vdefn) != TCL_OK) { return TCL_ERROR; } vdefn->member->flags |= ITCL_COMMON; /* * Create the variable in the namespace associated with the * class. Do this the hard way, to avoid the variable resolver * procedures. These procedures won't work until we rebuild * the virtual tables below. */ nsPtr = (Namespace*)cdefnPtr->namesp; entry = Tcl_CreateHashEntry(&nsPtr->varTable, vdefn->member->name, &newEntry); varPtr = _TclNewVar(); varPtr->hPtr = entry; varPtr->nsPtr = nsPtr; varPtr->flags |= VAR_NAMESPACE_VAR; varPtr->refCount++; /* one use by namespace */ varPtr->refCount++; /* another use by class */ Tcl_SetHashValue(entry, varPtr); /* * TRICKY NOTE: Make sure to rebuild the virtual tables for this * class so that this variable is ready to access. The variable * resolver for the parser namespace needs this info to find the * variable if the developer tries to set it within the class * definition. * * If an initialization value was specified, then initialize * the variable now. */ Itcl_BuildVirtualTables(cdefnPtr); if (init) { init = Tcl_SetVar(interp, vdefn->member->name, init, TCL_NAMESPACE_ONLY); if (!init) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "cannot initialize common variable \"", vdefn->member->name, "\"", (char*)NULL); return TCL_ERROR; } } return TCL_OK;} /* * ------------------------------------------------------------------------ * Itcl_ParseVarResolver() * * Used by the "parser" namespace to resolve variable accesses to * common variables. The runtime resolver procedure is consulted * whenever a variable is accessed within the namespace. It can * deny access to certain variables, or perform special lookups itself. * * This procedure allows access only to "common" class variables that * have been declared within the class or inherited from another class. * A "set" command can be used to initialized common data members within * the body of the class definition itself: * * itcl::class Foo { * common colors * set colors(red) #ff0000 * set colors(green) #00ff00 * set colors(blue) #0000ff * ... * } * * itcl::class Bar { * inherit Foo * set colors(gray) #a0a0a0 * set colors(white) #ffffff * * common numbers * set numbers(0) zero * set numbers(1) one * } * * ------------------------------------------------------------------------ *//* ARGSUSED */intItcl_ParseVarResolver(interp, name, contextNs, flags, rPtr) Tcl_Interp *interp; /* current interpreter */ char* name; /* name of the variable being accessed */ Tcl_Namespace *contextNs; /* namespace context */ int flags; /* TCL_GLOBAL_ONLY => global variable * TCL_NAMESPACE_ONLY => namespace variable */ Tcl_Var* rPtr; /* returns: Tcl_Var for desired variable */{ ItclObjectInfo *info = (ItclObjectInfo*)contextNs->clientData; ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack); Tcl_HashEntry *entry; ItclVarLookup *vlookup; /* * See if the requested variable is a recognized "common" member. * If it is, make sure that access is allowed. */ entry = Tcl_FindHashEntry(&cdefnPtr->resolveVars, name); if (entry) { vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry); if ((vlookup->vdefn->member->flags & ITCL_COMMON) != 0) { if (!vlookup->accessible) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't access \"", name, "\": ", Itcl_ProtectionStr(vlookup->vdefn->member->protection), " variable", (char*)NULL); return TCL_ERROR; } *rPtr = vlookup->var.common; return TCL_OK; } } /* * If the variable is not recognized, return TCL_CONTINUE and * let lookup continue via the normal name resolution rules. * This is important for variables like "errorInfo" * that might get set while the parser namespace is active. */ return TCL_CONTINUE;} /* * ------------------------------------------------------------------------ * ItclFreeParserCommandData() * * This callback will free() up memory dynamically allocated * and passed as the ClientData argument to Tcl_CreateObjCommand. * This callback is required because one can not simply pass * a pointer to the free() or ckfree() to Tcl_CreateObjCommand. * ------------------------------------------------------------------------ */static voidItclFreeParserCommandData(cdata) char* cdata; /* client data to be destroyed */{ ckfree(cdata);}⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -