• Home
  • History
  • Annotate
  • Raw
  • Download
  • only in /macosx-10.9.5/tcl-102/tcl_ext/xotcl/xotcl/generic/

Lines Matching +defs:cl +defs:start

93 static int GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd, Tcl_Interp *interp, ClientData clientData, int push);
95 static int IsMetaClass(Tcl_Interp *interp, XOTclClass *cl);
96 static int hasMixin(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl);
97 static int isSubType(XOTclClass *subcl, XOTclClass *cl);
667 /*return RUNTIME_STATE(interp)->cs.top->cl;*/
668 return CallStackGetFrame(interp)->cl;
1219 XOTclClass **cl, int retry) {
1232 /*fprintf(stderr, "GetXOTclClassFromObj %s cmd = %p cl=%p retry=%d\n",
1236 if (cl) *cl = cls;
1247 if (cl) *cl = cls;
1270 result = GetXOTclClassFromObj(interp, objPtr, cl, 0);
1275 /*fprintf(stderr, "GetXOTclClassFromObj %s returns %d cls = %p *cl = %p\n",
1276 objName, result, cls, cl?*cl:NULL);*/
1295 element->cl = sl->cl;
1304 XOTclAddClass(XOTclClasses **cList, XOTclClass *cl, ClientData cd) {
1306 element->cl = cl;
1323 static XOTclClasses *Super(XOTclClass *cl) { return cl->super; }
1324 static XOTclClasses *Sub(XOTclClass *cl) { return cl->sub; }
1328 TopoSort(XOTclClass *cl, XOTclClass *base, XOTclClasses* (*next)(XOTclClass*)) {
1329 /*XOTclClasses *sl = (*next)(cl);*/
1330 XOTclClasses *sl = next == Super ? cl->super : cl->sub;
1339 cl->color = GRAY;
1341 XOTclClass *sc = sl->cl;
1342 if (sc->color == GRAY) { cl->color = WHITE; return 0; }
1344 cl->color = WHITE;
1345 if (cl == base) {
1347 for (pc = cl->order; pc; pc = pc->next) { pc->cl->color = WHITE; }
1352 cl->color = BLACK;
1354 pl->cl = cl;
1357 if (cl == base) {
1359 for (pc = cl->order; pc; pc = pc->next) { pc->cl->color = WHITE; }
1365 TopoOrder(XOTclClass *cl, XOTclClasses* (*next)(XOTclClass*)) {
1366 if (TopoSort(cl, cl, next))
1367 return cl->order;
1368 XOTclFreeClasses(cl->order);
1369 return cl->order = NULL;
1373 ComputeOrder(XOTclClass *cl, XOTclClasses *order, XOTclClasses* (*direction)(XOTclClass*)) {
1376 return cl->order = TopoOrder(cl, direction);
1380 XOTclComputePrecedence(XOTclClass *cl) {
1381 return ComputeOrder(cl, cl->order, Super);
1385 XOTclComputeDependents(XOTclClass *cl) {
1386 return ComputeOrder(cl, cl->order, Sub);
1391 FlushPrecedencesOnSubclasses(XOTclClass *cl) {
1393 XOTclFreeClasses(cl->order);
1394 cl->order = NULL;
1395 pc = ComputeOrder(cl, cl->order, Sub);
1404 XOTclFreeClasses(pc->cl->order);
1405 pc->cl->order = NULL;
1407 XOTclFreeClasses(cl->order);
1408 cl->order = NULL;
1412 AddInstance(XOTclObject *obj, XOTclClass *cl) {
1413 obj->cl = cl;
1414 if (cl) {
1416 (void) Tcl_CreateHashEntry(&cl->instances, (char *)obj, &nw);
1421 RemoveInstance(XOTclObject *obj, XOTclClass *cl) {
1422 if (cl) {
1423 Tcl_HashEntry *hPtr = XOTcl_FindHashEntry(&cl->instances, (char *)obj);
1437 AS(XOTclClass *cl, XOTclClass *s, XOTclClasses **sl) {
1439 while (l && l->cl != s) l = l->next;
1442 sc->cl = s;
1449 AddSuper(XOTclClass *cl, XOTclClass *super) {
1450 if (cl && super) {
1454 AS(cl, super, &cl->super);
1455 AS(super, cl, &super->sub);
1460 RemoveSuper1(XOTclClass *cl, XOTclClass *s, XOTclClasses **sl) {
1463 if (l->cl == s) {
1468 while (l->next && l->next->cl != s) l = l->next;
1479 RemoveSuper(XOTclClass *cl, XOTclClass *super) {
1483 int sp = RemoveSuper1(cl, super, &cl->super);
1484 int sb = RemoveSuper1(super, cl, &super->sub);
1520 if ((entryPtr = XOTcl_FindHashEntry(Tcl_Namespace_cmdTable(pl->cl->nsPtr), methodName))) {
1522 return pl->cl;
1527 if ((*cmd = FindMethod(methodName, pl->cl->nsPtr))) {
1528 return pl->cl;
1537 SearchCMethod(XOTclClass *cl, char *nm, Tcl_Command *cmd) {
1538 assert(cl);
1539 return SearchPLMethod(ComputeOrder(cl, cl->order, Super), nm, cmd);
1616 XOTclRequireClassOpt(XOTclClass *cl) {
1617 assert(cl);
1618 if (!cl->opt) {
1619 cl->opt = NEW(XOTclClassOpt);
1620 memset(cl->opt, 0, sizeof(XOTclClassOpt));
1621 if (cl->object.flags & XOTCL_IS_CLASS) {
1622 cl->opt->id = cl->object.id; /* probably a temporary solution */
1625 return cl->opt;
2170 XOTclClass *cl = (XOTclClass*) cli;
2172 ALLOC_NAME_NS(cptr, cl->nsPtr->fullName, nm);
2436 CallStackPush(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl,
2450 csc->cl = cl;
3042 clPtr = ComputeOrder(obj->cl, obj->cl->order, Super);
3044 XOTclAssertionStore *aStore = (clPtr->cl->opt) ? clPtr->cl->opt->assertions : 0;
3055 AssertionCheck(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl,
3061 if (cl)
3062 aStore = cl->opt ? cl->opt->assertions : 0;
3132 /*fprintf(stderr, " %s, ", ObjStr(pl->cl->object.cmdName));*/
3133 if (pl->cl != RUNTIME_STATE(interp)->theObject) {
3134 XOTclClassOpt *opt = pl->cl->opt;
3142 ObjStr(cls->cl->object.cmdName));*/
3143 if (pl->cl == cls->cl) {
3149 XOTclAddClass(checkList, pl->cl, NULL);
3151 ObjStr(pl->cl->object.cmdName));*/
3158 mixinClasses, ObjStr(pl->cl->object.cmdName), clPtr);*/
3159 clPtr = XOTclAddClass(clPtr, pl->cl, m->clientData);
3199 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) {
3200 XOTclClassOpt *opt = pl->cl->opt;
3213 ObjStr(mixinClasses->cl->object.cmdName));*/
3216 if (checker->cl == mixinClasses->cl) break;
3222 /* check obj->cl hierachy */
3223 for (checker = ComputeOrder(obj->cl, obj->cl->order, Super); checker; checker = checker->next) {
3224 if (checker->cl == mixinClasses->cl)
3234 ObjStr(mixinClasses->cl->object.cmdName));*/
3235 new = CmdListAdd(&obj->mixinOrder, mixinClasses->cl->object.id, NULL,
3241 if (guardChecker->cl == mixinClasses->cl) {
3332 XOTclObject *obj = (XOTclObject *)cls->cl;
3371 rc = listInstances(interp, sc->cl, pattern, closure, matchObject);
3401 getAllInstances(interp, destTable, sc->cl);
3431 addToResultSetWithGuards(Tcl_Interp *interp, Tcl_HashTable *destTable, XOTclClass *cl, ClientData clientData, int *new,
3433 Tcl_CreateHashEntry(destTable, (char *)cl, new);
3436 if (!pattern || Tcl_StringMatch(ObjStr(cl->object.cmdName), pattern)) {
3439 Tcl_ListObjAppendElement(interp, l, cl->object.cmdName);
3446 if (matchObject && matchObject == (XOTclObject *)cl) {
3472 rc = getAllObjectMixinsOf(interp, destTable, sc->cl, isMixin, appendResult, pattern, matchObject);
3479 XOTclClass *cl;
3485 cl = XOTclGetClassFromCmdPtr(m->cmdPtr);
3486 assert(cl);
3488 ObjStr(cl->object.cmdName),ObjStr(startCl->object.cmdName));*/
3489 rc = getAllObjectMixinsOf(interp, destTable, cl, isMixin, appendResult, pattern, matchObject);
3491 ObjStr(cl->object.cmdName),ObjStr(startCl->object.cmdName));*/
3528 XOTclClass *cl;
3547 rc = getAllClassMixinsOf(interp, destTable, sc->cl, isMixin, appendResult, pattern, matchObject);
3563 cl = XOTclGetClassFromCmdPtr(m->cmdPtr);
3564 assert(cl);
3566 rc = addToResultSet(interp, destTable, &cl->object, &new, appendResult, pattern, matchObject);
3569 rc = getAllClassMixinsOf(interp, destTable, cl, 1, appendResult, pattern, matchObject);
3587 XOTclClass *cl;
3601 cl = XOTclGetClassFromCmdPtr(m->cmdPtr);
3602 assert(cl);
3604 /* fprintf(stderr,"Instmixin found: %s\n", ObjStr(cl->object.cmdName)); */
3607 /* fprintf(stderr,"addToResultSetWithGuards: %s\n", ObjStr(cl->object.cmdName)); */
3608 rc = addToResultSetWithGuards(interp, destTable, cl, m->clientData, &new, 1, pattern, matchObject);
3610 /* fprintf(stderr,"addToResultSet: %s\n", ObjStr(cl->object.cmdName)); */
3611 rc = addToResultSet(interp, destTable, &cl->object, &new, 1, pattern, matchObject);
3616 /* fprintf(stderr,"Instmixin getAllClassMixins for: %s (%s)\n",ObjStr(cl->object.cmdName),ObjStr(startCl->object.cmdName)); */
3617 rc = getAllClassMixins(interp, destTable, cl, withGuards, pattern, matchObject);
3628 /* fprintf(stderr,"Superclass getAllClassMixins for %s (%s)\n",ObjStr(sc->cl->object.cmdName),ObjStr(startCl->object.cmdName)); */
3629 rc = getAllClassMixins(interp, destTable, sc->cl, withGuards, pattern, matchObject);
3646 ObjStr(cl->object.cmdName), ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */
3657 XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr);
3658 XOTclClassOpt *clopt = cl ? cl->opt : NULL;
3674 XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr);
3675 XOTclClassOpt *clopt = cl ? cl->opt : NULL;
3680 ObjStr(cl->object.cmdName), ObjStr(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)->cmdName)); */
3683 if (cl->object.mixinOrder) MixinResetOrder(&cl->object);
3698 ObjStr(cl->object.cmdName), ObjStr(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)->cmdName)); */
3712 MixinResetOrderForInstances(Tcl_Interp *interp, XOTclClass *cl) {
3716 hPtr = Tcl_FirstHashEntry(&cl->instances, &hSrch);
3719 ObjStr(clPtr->cl->object.cmdName));*/
3726 XOTclObject *obj = (XOTclObject *)Tcl_GetHashKey(&cl->instances, hPtr);
3738 ResetOrderOfClassesUsedAsMixins(XOTclClass *cl) {
3740 ObjStr(cl->object.cmdName), cl->opt);*/
3742 if (cl->opt) {
3744 for (ml = cl->opt->isObjectMixinOf; ml; ml = ml->next) {
3759 MixinInvalidateObjOrders(Tcl_Interp *interp, XOTclClass *cl) {
3760 XOTclClasses *saved = cl->order, *clPtr;
3765 cl->order = NULL;
3770 for (clPtr = ComputeOrder(cl, cl->order, Sub); clPtr; clPtr = clPtr->next) {
3772 Tcl_HashEntry *hPtr = &clPtr->cl->instances ?
3773 Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : NULL;
3776 ResetOrderOfClassesUsedAsMixins(clPtr->cl);
3778 /* fprintf(stderr,"invalidating instances of class %s\n", ObjStr(clPtr->cl->object.cmdName));
3782 XOTclObject *obj = (XOTclObject *)Tcl_GetHashKey(&clPtr->cl->instances, hPtr);
3788 XOTclFreeClasses(cl->order);
3789 cl->order = saved;
3797 getAllClassMixinsOf(interp, commandTable, cl, 1, 0, NULL, NULL);
3857 XOTclClass **cl, Tcl_Command *currentCmdPtr) {
3901 *cl = cls;
3951 MixinSearchMethodByName(Tcl_Interp *interp, XOTclCmdList *mixinList, char *name, XOTclClass **cl) {
3958 if (cl) *cl = mcl;
3981 XOTclClass *startingCl, XOTclClass **cl) {
3989 * object's class as start point for the class-specific search then ...
3991 startingCl = startingObj->cl;
3997 if ((cmd = MixinSearchMethodByName(interp, opt->mixins, name, cl))) {
4009 if ((cmd = MixinSearchMethodByName(interp, opt->instmixins, name, cl))) {
4021 *cl = (XOTclClass*)startingObj;
4030 *cl = SearchCMethod(startingCl, name, &cmd);
4031 if (!*cl) {
4035 *cl = SearchCMethod(startingCl->object.cl, name, &cmd);
4135 GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd,
4154 CallStackPush(interp, obj, cl, cmd, 0, 0, XOTCL_CSC_TYPE_GUARD);
4218 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); !guardAdded && pl; pl = pl->next) {
4219 XOTclClassOpt *opt = pl->cl->opt;
4283 XOTclClass *cl;
4292 if (!(cmd = FilterSearch(interp, ObjStr(name), startingObj, startingCl, &cl))) {
4303 /*fprintf(stderr, " +++ adding filter %s cl %p\n", ObjStr(name), cl);*/
4305 new = CmdListAdd(filterList, cmd, cl, /*noDuplicates*/ 1);
4337 XOTclClass *cl = NULL;
4342 cmd = FilterSearch(interp, simpleName, startingObj, startingCl, &cl);
4348 CmdListReplaceCmd(cmdList, cmd, cl);
4367 FilterInvalidateObjOrders(Tcl_Interp *interp, XOTclClass *cl) {
4368 XOTclClasses *saved = cl->order, *clPtr, *savePtr;
4370 cl->order = NULL;
4371 savePtr = clPtr = ComputeOrder(cl, cl->order, Sub);
4372 cl->order = saved;
4376 Tcl_HashEntry *hPtr = &clPtr->cl->instances ?
4377 Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : 0;
4380 if (clPtr->cl->opt) {
4381 FilterSearchAgain(interp, &clPtr->cl->opt->instfilters, 0, clPtr->cl);
4384 XOTclObject *obj = (XOTclObject*) Tcl_GetHashKey(&clPtr->cl->instances, hPtr);
4398 * from cl on down the hierarchy we remove all filters
4401 * class cl
4404 FilterRemoveDependentFilterCmds(XOTclClass *cl, XOTclClass *removeClass) {
4405 XOTclClasses *saved = cl->order, *clPtr;
4406 cl->order = NULL;
4408 /*fprintf(stderr, "FilterRemoveDependentFilterCmds cl %p %s, removeClass %p %s\n",
4409 cl, ObjStr(cl->object.cmdName),
4412 for (clPtr = ComputeOrder(cl, cl->order, Sub); clPtr; clPtr = clPtr->next) {
4414 Tcl_HashEntry *hPtr = &clPtr->cl->instances ?
4415 Tcl_FirstHashEntry(&clPtr->cl->instances, &hSrch) : NULL;
4416 XOTclClassOpt *opt = clPtr->cl->opt;
4421 XOTclObject *obj = (XOTclObject*) Tcl_GetHashKey(&clPtr->cl->instances, hPtr);
4428 XOTclFreeClasses(cl->order);
4429 cl->order = saved;
4433 * build up a qualifier of the form <obj/cl> proc/instproc <procName>
4434 * if cl is not NULL, we build an instproc identifier for cl, else a proc
4439 XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd) {
4445 if (cl) {
4446 Tcl_ListObjAppendElement(interp, list, cl->object.cmdName);
4555 fcl = fObj->cl;
4562 /* don't search on the start class again */
4566 Tcl_Command pi = FindMethod(simpleName, pl->cl->nsPtr);
4568 CmdListAdd(filterList, pi, pl->cl, /*noDuplicates*/ 0);
4570 fprintf(stderr, " %s::%s, ", ObjStr(pl->cl->object.cmdName), simpleName);
4617 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl=pl->next) {
4618 XOTclClassOpt *opt = pl->cl->opt;
4749 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) {
4750 XOTclClassOpt *opt = pl->cl->opt;
4753 Tcl_ListObjAppendElement(interp, list, pl->cl->object.cmdName);
4770 Tcl_Command *currentCmd, XOTclClass **cl) {
4796 *cl = NULL;
4798 *cl = cmdList->clorobj;
4812 SuperclassAdd(Tcl_Interp *interp, XOTclClass *cl, int oc, Tcl_Obj **ov, Tcl_Obj *arg) {
4818 filterCheck = ComputeOrder(cl, cl->order, Super);
4823 * do not check the class "cl" itself (first entry in
4829 FilterRemoveDependentFilterCmds(cl, filterCheck->cl);
4834 MixinInvalidateObjOrders(interp, cl);
4835 FilterInvalidateObjOrders(interp, cl);
4856 if (dl->cl == scl[i]) break;
4868 while (cl->super) {
4873 XOTclClass *sc = cl->super->cl;
4876 osl->cl = sc;
4878 (void)RemoveSuper(cl, cl->super->cl);
4881 AddSuper(cl, scl[i]);
4884 FlushPrecedencesOnSubclasses(cl);
4886 if (!ComputeOrder(cl, cl->order, Super)) {
4893 while (cl->super) (void)RemoveSuper(cl, cl->super->cl);
4894 for (l = osl; l; l = l->next) AddSuper(cl, l->cl);
4902 if (cl->super == NULL)
4903 AddSuper(cl, RUNTIME_STATE(interp)->theObject);
5108 XOTclClass *cl = obj->cl, *mixin;
5120 assert(cl);
5132 for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->next) {
5133 result = SearchDefaultValuesOnClass(interp, obj, cmdCl, pl->cl);
5144 XOTclClass *cl = XOTclObjectToClass(cd);
5147 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
5149 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "searchDefaults obj");
5157 return SearchDefaultValues(interp, defaultObj, defaultObj->cl);
5163 XOTclClassOpt *opt = obj->cl->opt;
5292 Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, char *methodName,
5358 if (obj && obj->teardown && cl && !(obj->flags & XOTCL_DESTROY_CALLED)) {
5360 fprintf(stderr, "CL= %s ", ObjStr(cl->object.cmdName));
5394 int rc = GuardCall(obj, cl, (Tcl_Command) cmdList->cmdPtr, interp,
5405 rc = XOTclNextMethod(obj, interp, cl, methodName,
5427 (result = AssertionCheck(interp, obj, cl, methodName, CHECK_PRE)) == TCL_ERROR) {
5493 (result = AssertionCheck(interp, obj, cl, methodName, CHECK_POST) == TCL_ERROR)) {
5501 XOTclProfileEvaluateData(interp, startSec, startUsec, obj, cl, methodName);
5511 Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl,
5536 if ((CallStackPush(interp, obj, cl, cmd, objc, objv, frameType)) != TCL_OK) {
5546 rc = callProcCheck(cp, interp, objc, objv, cmd, obj, cl,
5567 XOTclClass *cl = NULL;
5609 /* Only start new filter chain, if
5623 cmd = FilterSearchProc(interp, obj, &obj->filterStack->currentCmdPtr,&cl);
5645 cmd = MixinSearchProc(interp, obj, methodName, &cl,
5672 if (obj->cl->order == NULL) obj->cl->order = TopoOrder(obj->cl, Super);
5673 cl = SearchPLMethod(obj->cl->order, methodName, &cmd);
5675 /* cl = SearchCMethod(obj->cl, methodName, &cmd); */
5680 if ((result = DoCallProcCheck(cd, interp, objc-1, objv+1, cmd, obj, cl,
5682 result = XOTclErrInProc(interp, cmdName, cl ? cl->object.cmdName : NULL, methodName);
5941 int start, end, length, i, j, nw = 0;
5960 return XOTclVarErrMsg(interp, "non-positional args does not start with '-': ",
5973 start = j+1;
5974 while(start<length && isspace((int)arg[start])) start++;
5975 for (l=start; l<length;l++) {
5979 Tcl_NewStringObj(arg+start, end-start));
5981 start = l;
5982 while (start<length && isspace((int)arg[start])) start++;
5988 Tcl_NewStringObj(arg+start, end-start));
6476 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) {
6477 Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(pl->cl->nsPtr);
6485 Tcl_SetObjResult(interp, obj->cl->object.cmdName);
6490 ListHeritage(Tcl_Interp *interp, XOTclClass *cl, char *pattern) {
6491 XOTclClasses *pl = ComputeOrder(cl, cl->order, Super);
6495 AppendMatchingElement(interp, pl->cl->object.cmdName, pattern);
6518 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) {
6519 AppendMatchingElement(interp, pl->cl->object.cmdName, pattern);
6780 return SearchCMethod(obj->cl, methodName, &cmd);
6788 XOTclClass **cl, char **method, Tcl_Command *cmd,
6806 *cmd = FilterSearchProc(interp, obj, currentCmd, cl);
6812 /* reset the information to the values of method, cl
6817 *cl = 0;
6818 /*fprintf(stderr,"EndOfChain resetting cl\n");*/
6837 *cmd = MixinSearchProc(interp, obj, *method, cl, currentCmd);
6842 *cl = 0;
6854 * past our last point; otherwise (if cl==0) begin from the start
6868 for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl && *cl; pl = pl->next) {
6869 if (pl->cl == *cl)
6870 *cl = 0;
6876 *cl = SearchPLMethod(pl, *method, cmd);
6877 /*fprintf(stderr, "no cmd, cl = %p %s\n",*cl, ObjStr((*cl)->object.cmdName));*/
6879 *cl = 0;
6896 XOTclClass **cl = &givenCl;
6955 NextSearchMethod(obj, interp, csc, cl, methodName, &cmd,
6963 if ((*cl))
6964 fprintf(stderr, " cl=%s,", (*cl)->nsPtr->fullName);
7012 obj, *cl, *methodName, frameType);
7042 return XOTclNextMethod(csc->self, interp, csc->cl,
7079 return XOTclNextMethod(obj, interp, csc->cl, methodName, objc-1, &objv[1], 0);
7093 XOTclClass *cl = csc->cl;
7103 NextSearchMethod(o, interp, csc, &cl, &methodName, &cmd,
7108 o, cl, cmd));
7156 XOTclClass *cl = GetSelfClass(interp);
7157 Tcl_SetObjResult(interp, cl ? cl->object.cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
7181 fprintf(stderr,"current cmdPtr = %p cl = %p, mo=%p %p\n", csc->cmdPtr, csc->cl,
7209 Tcl_SetObjResult(interp, csc && csc->cl ? csc->cl->object.cmdName :
7473 (void)RemoveInstance(obj, obj->cl);
7531 XOTclClass *cl, Tcl_Namespace *namespacePtr, int softrecreate) {
7538 AddInstance(obj, cl);
7646 PrimitiveOInit(void *mem, Tcl_Interp *interp, char *name, XOTclClass *cl) {
7667 CleanupInitObject(interp, obj, cl, nsPtr, 0);
7678 PrimitiveOCreate(Tcl_Interp *interp, char *name, XOTclClass *cl) {
7703 PrimitiveOInit(obj, interp, name, cl);
7725 CleanupDestroyClass(Tcl_Interp *interp, XOTclClass *cl, int softrecreate, int recreate) {
7729 XOTclClassOpt *clopt = cl->opt;
7739 MixinInvalidateObjOrders(interp, cl);
7740 FilterInvalidateObjOrders(interp, cl);
7749 /*MixinInvalidateObjOrders(interp, cl);*/
7752 /*FilterInvalidateObjOrders(interp, cl);*/
7770 FilterRemoveDependentFilterCmds(cl, cl);
7774 XOTclFreeObjectData(cl);
7778 Tcl_ForgetImport(interp, cl->nsPtr, "*"); /* don't destroy namespace imported objects */
7779 NSCleanupNamespace(interp, cl->nsPtr);
7780 NSDeleteChildren(interp, cl->nsPtr);
7791 We do not have to reclassing in case, cl == ::xotcl::Object
7793 if (cl != theobj) {
7794 XOTclClass *baseClass = IsMetaClass(interp, cl) ? RUNTIME_STATE(interp)->theClass : theobj;
7795 if (baseClass == cl) {
7802 hPtr = &cl->instances ? Tcl_FirstHashEntry(&cl->instances, &hSrch) : 0;
7804 XOTclObject *inst = (XOTclObject*)Tcl_GetHashKey(&cl->instances, hPtr);
7805 if (inst && inst != (XOTclObject*)cl && inst->id) {
7807 (void)RemoveInstance(inst, cl->object.cl);
7813 Tcl_DeleteHashTable(&cl->instances);
7814 MEM_COUNT_FREE("Tcl_InitHashTable",&cl->instances);
7817 if (cl->nonposArgsTable) {
7818 NonposArgsFreeTable(cl->nonposArgsTable);
7819 Tcl_DeleteHashTable(cl->nonposArgsTable);
7820 MEM_COUNT_FREE("Tcl_InitHashTable", cl->nonposArgsTable);
7821 ckfree((char *) cl->nonposArgsTable);
7822 MEM_COUNT_FREE("Tcl_HashTable", cl->nonposArgsTable);
7825 if (cl->parameters) {
7826 DECR_REF_COUNT(cl->parameters);
7834 clopt = cl->opt = 0;
7841 FlushPrecedencesOnSubclasses(cl);
7842 while (cl->super) (void)RemoveSuper(cl, cl->super->cl);
7849 while (cl->sub) {
7850 XOTclClass *subClass = cl->sub->cl;
7851 (void)RemoveSuper(subClass, cl);
7856 if (subClass->super == 0 && cl != theobj)
7867 CleanupInitClass(Tcl_Interp *interp, XOTclClass *cl, Tcl_Namespace *namespacePtr,
7869 XOTclObject *obj = (XOTclObject*)cl;
7886 cl->nsPtr = namespacePtr;
7892 cl->sub = NULL;
7894 cl->super = NULL;
7895 AddSuper(cl, RUNTIME_STATE(interp)->theObject);
7897 cl->color = WHITE;
7898 cl->order = NULL;
7899 cl->parameters = NULL;
7902 Tcl_InitHashTable(&cl->instances, TCL_ONE_WORD_KEYS);
7903 MEM_COUNT_ALLOC("Tcl_InitHashTable",&cl->instances);
7907 cl->opt = NULL;
7910 cl->nonposArgsTable = NULL;
7918 XOTclClass *cl = (XOTclClass*)cd;
7946 CleanupDestroyClass(interp, cl, 0, 0);
7952 saved = cl->nsPtr;
7961 /*fprintf(stderr,"primitive cdestroy calls deletenamespace for obj %p\n", cl);*/
7972 PrimitiveCInit(XOTclClass *cl, Tcl_Interp *interp, char *name) {
7983 ns = NSGetFreshNamespace(interp, (ClientData)cl, name);
7986 CleanupInitClass(interp, cl, ns, 0, 0);
7996 XOTclClass *cl = (XOTclClass*)ckalloc(sizeof(XOTclClass));
7998 XOTclObject *obj = (XOTclObject*)cl;
8000 /*fprintf(stderr, "PrimitiveCCreate Class %p %s\n", cl, name);*/
8002 memset(cl, 0, sizeof(XOTclClass));
8003 MEM_COUNT_ALLOC("XOTclObject/XOTclClass", cl);
8010 fprintf(stderr,"Class alloc %p '%s'\n", cl, name);
8015 ckfree((char *) cl);
8019 (ClientData)cl, tclDeletesClass);
8025 PrimitiveCInit(cl, interp, name+2);
8028 return cl;
8034 changeClass(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl) {
8037 if (cl != obj->cl) {
8038 if (IsMetaClass(interp, cl)) {
8044 if (!IsMetaClass(interp, obj->cl)) {
8054 ObjStr(cl->object.cmdName),
8062 (void)RemoveInstance(obj, obj->cl);
8063 AddInstance(obj, cl);
8143 * configure (with '-') start (we don't send them as args to
8278 return XOTclCallMethodWithArgs((ClientData)obj->cl, interp,
8286 XOTclClass *cl = XOTclObjectToClass(obj);
8307 CleanupInitObject(interp, obj, obj->cl, obj->nsPtr, softrecreate);
8309 if (cl) {
8310 CleanupDestroyClass(interp, cl, softrecreate, 1);
8311 CleanupInitClass(interp, cl, cl->nsPtr, softrecreate, 1);
8350 IsMetaClass(Tcl_Interp *interp, XOTclClass *cl) {
8351 /* check if cl is a meta-class by checking is Class is a superclass of cl*/
8355 if (cl == RUNTIME_STATE(interp)->theClass)
8358 for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->next) {
8359 if (pl->cl == RUNTIME_STATE(interp)->theClass)
8363 for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->next) {
8364 XOTclClassOpt *clopt = pl->cl->opt;
8374 /*fprintf(stderr,"- got %s\n", ObjStr(mc->cl->object.cmdName));*/
8375 if (isSubType(mc->cl, RUNTIME_STATE(interp)->theClass)) {
8410 isSubType(XOTclClass *subcl, XOTclClass *cl) {
8413 assert(cl && subcl);
8415 if (cl != subcl) {
8417 for (t = ComputeOrder(subcl, subcl->order, Super); t && t->cl; t = t->next) {
8418 if (t->cl == cl) {
8432 XOTclClass *cl;
8437 if (obj->cl && GetXOTclClassFromObj(interp, objv[1],&cl, 1) == TCL_OK) {
8438 success = isSubType(obj->cl, cl);
8446 hasMixin(Tcl_Interp *interp, XOTclObject *obj, XOTclClass *cl) {
8455 if (mixin == cl) {
8466 XOTclClass *cl;
8472 if (GetXOTclClassFromObj(interp, objv[1],&cl, 1) == TCL_OK) {
8473 success = hasMixin(interp, obj, cl);
8513 /* all start with a "-", so there must be a ov[1] */
8907 XOTclClass *cl = (XOTclClass*) cli;
8910 result = XOTclCallMethodWithArgs((ClientData)cl, interp,
8918 XOTclClass *cl = (XOTclClass*) cli;
8921 result = XOTclCallMethodWithArgs((ClientData)cl, interp,
8935 XOTclClass *cl = (XOTclClass*) cli;
8936 return callMethod((ClientData)cl, interp, XOTclGlobalObjects[XOTE_DESTROY], 2, 0, 0);
9161 XOTclClass *cl = (XOTclClass*) cli;
9162 NSDeleteCmd(interp, cl->nsPtr, nm);
9166 * obj/cl ClientData setter/getter
9181 XOTclClass *cl = (XOTclClass*) cli;
9182 XOTclRequireClassOpt(cl);
9183 cl->opt->clientData = data;
9187 XOTclClass *cl = (XOTclClass*) cli;
9188 return (cl && cl->opt) ? cl->opt->clientData : 0;
9926 XOTclClass *cl = NULL;
9939 GetXOTclClassFromObj(interp, objv[1], &cl, 1);
9940 if (!cl) {
9978 tcd->obj = allocation == 'c' ? &cl->object : obj;
9988 XOTclAddIMethod(interp, (XOTcl_Class*)cl, methodName, objProc, tcd, dp);
10014 XOTclClass *cl = NULL;
10051 GetXOTclClassFromObj(interp, objv[1], &cl, 1);
10052 if (!cl) return XOTclObjErrType(interp, objv[1], "Class");
10055 clopt = XOTclRequireClassOpt(cl);
10060 GetXOTclClassFromObj(interp, objv[1], &cl, 1);
10061 if (!cl) return XOTclObjErrType(interp, objv[1], "Class");
10064 return SuperclassAdd(interp, cl, oc, ov, objv[3]);
10070 GetXOTclClassFromObj(interp, objv[3], &cl, 1);
10071 if (!cl) return XOTclErrBadVal(interp, "class", "a class", ObjStr(objv[1]));
10072 return changeClass(interp, obj, cl);
10082 cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr);
10083 clopt = cl ? cl->opt : NULL;
10124 ObjStr(ov[i]), ObjStr(cl->object.cmdName)); */
10147 RemoveFromClassMixinsOf(cl->object.id, clopt->instmixins);
10151 MixinInvalidateObjOrders(interp, cl);
10155 FilterInvalidateObjOrders(interp, cl);
10163 ObjStr(cl->object.cmdName), ObjStr(ov[i])); */
10169 ObjStr(cl->object.cmdName), ObjStr(nobj->cmdName)); */
10171 CmdListAdd(&nclopt->isClassMixinOf, cl->object.id, NULL, /*noDuplicates*/ 1);
10173 ObjStr(ov[i]), ObjStr(cl->object.cmdName)); */
10181 FilterInvalidateObjOrders(interp, cl);
10184 if (FilterAdd(interp, &clopt->instfilters, ov[i], 0, cl) != TCL_OK)
10333 if (!cmd && obj->cl)
10334 pcl = SearchCMethod(obj->cl, methodName, &cmd);
10496 XOTclClass *cl = XOTclObjectToClass(cd);
10500 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
10502 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "instdestroy <obj/cl>");
10595 XOTclClass *cl = XOTclObjectToClass(cd);
10600 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
10602 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "alloc <obj/cl> ?args?");
10617 result = doCleanup(interp, newobj, &cl->object, objc, objv);
10638 if (IsMetaClass(interp, cl)) {
10642 newcl = PrimitiveCCreate(interp, objName, cl);
10655 newobj = PrimitiveOCreate(interp, objName, cl);
10677 createMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *obj,
10716 if (newobj && (IsMetaClass(interp, cl) == IsMetaClass(interp, newobj->cl))) {
10752 (void)RemoveInstance(newobj, newobj->cl);
10753 AddInstance(newobj, cl);
10772 XOTclClass *cl = XOTclObjectToClass(cd);
10774 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
10776 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "create <obj> ?args?");
10784 return createMethod(interp, cl, &cl->object, objc, objv);
10790 XOTclClass *cl = XOTclObjectToClass(cd);
10801 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
10804 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "new [-childof obj] ?args?");
10833 Tcl_DStringAppend(dsPtr, iss->start, iss->length);
10881 XOTclClass *cl = XOTclObjectToClass(cd);
10885 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
10887 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "recreate <obj> ?args?");
10896 result = doCleanup(interp, newobj, &cl->object, objc, objv);
10908 XOTclClass *cl = XOTclObjectToClass(cd);
10915 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info <opt> ?args?");
10917 if (cl) {
10918 nsp = cl->nsPtr;
10919 opt = cl->opt;
10936 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info classchildren ?pattern?");
10937 return ListChildren(interp, (XOTclObject*) cl, pattern, 1);
10940 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info classparent");
10941 return ListParent(interp, &cl->object);
10948 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info heritage ?pattern?");
10949 return ListHeritage(interp, cl, pattern);
10964 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
10978 rc = listInstances(interp, cl, pattern, withClosure, matchObject);
10987 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
10989 if (cl->nonposArgsTable) {
10991 NonposArgsGet(cl->nonposArgsTable, pattern);
11003 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11012 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11021 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11024 if (cl->nonposArgsTable) {
11026 NonposArgsGet(cl->nonposArgsTable, pattern);
11041 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11053 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11060 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11064 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11078 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11094 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11113 rc = getAllClassMixins(interp, commandTable, cl, withGuards, pattern, matchObject);
11132 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11150 rc = getAllClassMixinsOf(interp, commandTable, cl, 0, 1, pattern, matchObject);
11166 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11175 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11177 if (cl->nonposArgsTable) {
11179 NonposArgsGet(cl->nonposArgsTable, pattern);
11192 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "info instprocs ?pattern?");
11198 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11208 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11218 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11238 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11261 rc = getAllObjectMixinsOf(interp, commandTable, cl, 0, 1, pattern, matchObject);
11282 Tcl_DStringAppend(dsPtr, className(cl), -1);
11303 if (cl->parameters) {
11304 Tcl_SetObjResult(interp, cl->parameters);
11320 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11335 XOTclClasses *pl = ComputeOrder(cl, cl->order, Super);
11339 XOTclClasses *clSuper = XOTclReverseClasses(cl->super);
11355 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11370 XOTclClasses *saved = cl->order, *subclasses;
11371 cl->order = NULL;
11372 subclasses = ComputeOrder(cl, cl->order, Sub);
11373 cl->order = saved;
11378 rc = AppendMatchingElementsFromClasses(interp, cl->sub, pattern, matchObject);
11391 Tcl_DStringAppend(dsPtr, className(cl), -1);
11411 XOTclClass *cl = XOTclObjectToClass(cd);
11415 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11417 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "parameter ?params?");
11418 if (cl->parameters) {
11419 DECR_REF_COUNT(cl->parameters);
11425 cl->parameters = NULL;
11430 cl->parameters = objv[1];
11431 INCR_REF_COUNT(cl->parameters);
11437 result = callParameterMethodWithArg(&cl->object, interp,
11439 cl->object.cmdName, 3+1, &pv[elts], 0);
11449 XOTclClass *cl = XOTclObjectToClass(cd);
11453 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11455 return XOTclObjErrArgCnt(interp, cl->object.cmdName, "parameterclass cl");
11458 opt = cl->opt;
11466 opt = XOTclRequireClassOpt(cl);
11476 XOTclClass *cl = XOTclObjectToClass(cd);
11478 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11479 if (objc < 2) return XOTclObjErrArgCnt(interp, cl->object.cmdName, "instparametercmd name");
11480 XOTclAddIMethod(interp, (XOTcl_Class*) cl, ObjStr(objv[1]),
11607 XOTclClass *cl = XOTclObjectToClass(cd);
11611 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11616 tcd->obj = &cl->object;
11617 XOTclAddIMethod(interp, (XOTcl_Class*) cl, NSTail(ObjStr(objv[1])),
11624 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11694 XOTclClass *cl = XOTclObjectToClass(cd);
11699 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11701 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11712 if ((cl == RUNTIME_STATE(interp)->theObject && isDestroyString(name)) ||
11713 (cl == RUNTIME_STATE(interp)->theClass && isInstDestroyString(name)) ||
11714 (cl == RUNTIME_STATE(interp)->theClass && isAllocString(name)) ||
11715 (cl == RUNTIME_STATE(interp)->theClass && isCreateString(name)))
11716 return XOTclVarErrMsg(interp, className(cl), " instproc: '", name, "' of ",
11717 className(cl), " can not be overwritten. Derive a ",
11722 opt = cl->opt;
11725 rc = NSDeleteCmd(interp, cl->nsPtr, name);
11727 return XOTclVarErrMsg(interp, className(cl), " cannot delete instproc: '", name,
11728 "' of class ", className(cl), (char *) NULL);
11732 opt = XOTclRequireClassOpt(cl);
11737 result = MakeProc(cl->nsPtr, aStore, &(cl->nonposArgsTable),
11738 interp, objc, (Tcl_Obj **) objv, &cl->object);
11742 FilterInvalidateObjOrders(interp, cl);
11750 XOTclClass *cl = XOTclObjectToClass(cd);
11754 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11755 if (objc != 3) return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11758 opt = cl->opt;
11765 FilterInvalidateObjOrders(interp, cl);
11771 ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName),
11778 XOTclClass *cl = XOTclObjectToClass(cd);
11781 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11782 if (objc != 3) return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11785 if (cl->opt && cl->opt->instmixins) {
11792 h = CmdListFindCmdInList(mixinCmd, cl->opt->instmixins);
11797 MixinInvalidateObjOrders(interp, cl);
11804 ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName),
11810 XOTclClass *cl = XOTclObjectToClass(cd);
11813 if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
11815 return XOTclObjErrArgCnt(interp, cl->object.cmdName,
11817 opt = XOTclRequireClassOpt(cl);
11856 XOTclClass *cl;
11868 cl = XOTclpGetClass(interp, NSCutXOTclClasses(name));
11869 obj = (XOTclObject *)cl;
11870 nonposArgsTable = cl->nonposArgsTable;
11872 cl = NULL;
11988 if (cl) {
11992 if (cl) {
11993 procs = cl->opt ?
11994 AssertionFindProcs(cl->opt->assertions, name) : 0;
12010 XOTclRequireClassOpt(cl);
12612 checkAllInstances(Tcl_Interp *interp, XOTclClass *cl, int lvl) {
12615 if (cl && cl->object.refCount>0) {
12616 /*fprintf(stderr,"checkallinstances %d cl=%p '%s'\n", lvl, cl, ObjStr(cl->object.cmdName));*/
12617 for (hPtr = Tcl_FirstHashEntry(&cl->instances, &search); hPtr;
12619 XOTclObject *inst = (XOTclObject*) Tcl_GetHashKey(&cl->instances, hPtr);
12672 ClassHasSubclasses(XOTclClass *cl) {
12673 return (cl->sub != NULL);
12677 ClassHasInstances(XOTclClass *cl) {
12679 return (Tcl_FirstHashEntry(&cl->instances, &hSrch) != NULL);
12713 XOTclClass *thecls, *theobj, *cl;
12753 ObjStr(object->cl->object.cmdName));*/
12767 cl = XOTclpGetClass(interp, key);
12768 /* fprintf(stderr,"cl key = %s %p\n", key, cl); */
12769 if (cl
12770 && !ObjectHasChildren(interp, (XOTclObject*)cl)
12771 && !ClassHasInstances(cl)
12772 && !ClassHasSubclasses(cl)
12773 && cl != RUNTIME_STATE(interp)->theClass
12774 && cl != RUNTIME_STATE(interp)->theObject
12776 /* fprintf(stderr," ... delete class %s %p\n", key, cl); */
12777 freeUnsetTraceVariable(interp, &cl->object);
12778 Tcl_DeleteCommandFromToken(interp, cl->object.id);
12817 XOTclClass *cl;
12868 cl = XOTclpGetClass(interp, key);
12869 if (cl && !(cl->object.flags & XOTCL_DESTROY_CALLED)) {
12870 callDestroyMethod((ClientData)cl, interp, (XOTclObject *)cl, 0);
12908 * is potentially marked for delete when we start working here.