Index: ChangeLog =================================================================== diff -u -rad43de1007d040a9860eac2445a8c7781dcb4d06 -rc1c92aa376ad06be608cfdf852d9e531449bc753 --- ChangeLog (.../ChangeLog) (revision ad43de1007d040a9860eac2445a8c7781dcb4d06) +++ ChangeLog (.../ChangeLog) (revision c1c92aa376ad06be608cfdf852d9e531449bc753) @@ -1,5 +1,9 @@ -2007-10-23: - * New mixinof and instmixinof structures: +2007-10-28: + * some code refactoring + * making new code more robust + +2007-10-23: + * First version of new info methods "mixinof" and "instmixinof" - new class info options: mixinof instmixinof - on class destroy entry is now removed from mixin and instmixin lists Index: Makefile =================================================================== diff -u -r97b26d2a27f5718bd4250a78663f8e1a26f63123 -rc1c92aa376ad06be608cfdf852d9e531449bc753 --- Makefile (.../Makefile) (revision 97b26d2a27f5718bd4250a78663f8e1a26f63123) +++ Makefile (.../Makefile) (revision c1c92aa376ad06be608cfdf852d9e531449bc753) @@ -128,7 +128,7 @@ PACKAGE_NAME = xotcl PACKAGE_VERSION = 1.5.7 CC = gcc -CFLAGS_DEFAULT = -Os +CFLAGS_DEFAULT = -g CFLAGS_WARNING = -Wall -Wno-implicit-int CLEANFILES = *.o *.a *.so *~ core gmon.out EXEEXT = Index: doc/xo-daemon.html =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -rc1c92aa376ad06be608cfdf852d9e531449bc753 --- doc/xo-daemon.html (.../xo-daemon.html) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ doc/xo-daemon.html (.../xo-daemon.html) (revision c1c92aa376ad06be608cfdf852d9e531449bc753) @@ -76,7 +76,7 @@ Date: - [::xotcl::rcs date {$Date: 2007/10/12 19:53:32 $}] + [::xotcl::rcs date {$Date: 2006/02/18 22:17:32 $}] Index: doc/xo-whichPkg.html =================================================================== diff -u -rc72f9f638677608fab1502cd696c8f2d6b2952f9 -rc1c92aa376ad06be608cfdf852d9e531449bc753 --- doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision c72f9f638677608fab1502cd696c8f2d6b2952f9) +++ doc/xo-whichPkg.html (.../xo-whichPkg.html) (revision c1c92aa376ad06be608cfdf852d9e531449bc753) @@ -50,7 +50,7 @@ Date: - [::xotcl::rcs date {$Date: 2007/10/12 19:53:32 $}] + [::xotcl::rcs date {$Date: 2006/02/18 22:17:32 $}] Index: generic/xotcl.c =================================================================== diff -u -rad43de1007d040a9860eac2445a8c7781dcb4d06 -rc1c92aa376ad06be608cfdf852d9e531449bc753 --- generic/xotcl.c (.../xotcl.c) (revision ad43de1007d040a9860eac2445a8c7781dcb4d06) +++ generic/xotcl.c (.../xotcl.c) (revision c1c92aa376ad06be608cfdf852d9e531449bc753) @@ -64,14 +64,14 @@ */ #ifdef USE_TCL_STUBS -# define XOTcl_ExprObjCmd(cd,in,objc,objv) \ +# define XOTcl_ExprObjCmd(cd,in,objc,objv) \ XOTclCallCommand(in, XOTE_EXPR, objc, objv) -# define XOTcl_SubstObjCmd(cd,in,objc,objv) \ +# define XOTcl_SubstObjCmd(cd,in,objc,objv) \ XOTclCallCommand(in, XOTE_SUBST, objc, objv) #else -# define XOTcl_ExprObjCmd(cd,in,objc,objv) \ +# define XOTcl_ExprObjCmd(cd,in,objc,objv) \ Tcl_ExprObjCmd(cd, in, objc, objv) -# define XOTcl_SubstObjCmd(cd,in,objc,objv) \ +# define XOTcl_SubstObjCmd(cd,in,objc,objv) \ Tcl_SubstObjCmd(cd, in, objc, objv) #endif @@ -135,19 +135,19 @@ } aliasCmdClientData; static int ObjDispatch(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *CONST objv[], int flags); XOTCLINLINE static int DoDispatch(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[], int flags); + Tcl_Obj *CONST objv[], int flags); static int XOTclNextMethod(XOTclObject *obj, Tcl_Interp *in, XOTclClass *givenCl, - char *givenMethod, int objc, Tcl_Obj *CONST objv[], - int useCSObjs); + char *givenMethod, int objc, Tcl_Obj *CONST objv[], + int useCSObjs); static int XOTclForwardMethod(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *CONST objv[]); static int XOTclObjscopedMethod(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *CONST objv[]); static int XOTclSetterMethod(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *CONST objv[]); static int callDestroyMethod(ClientData cd, Tcl_Interp *in, XOTclObject *obj, int flags); @@ -166,7 +166,7 @@ #ifdef PRE81 /* for backward compatibility only -*/ + */ static int Tcl_EvalObjv(Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[], int flags) { int i, result; @@ -214,73 +214,73 @@ * Define the types missing for the forward compatible mode */ typedef Var * (Tcl_VarHashCreateVarFunction) _ANSI_ARGS_( - (TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) -); + (TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) + ); typedef void (Tcl_InitVarHashTableFunction) _ANSI_ARGS_( - (TclVarHashTable *tablePtr, Namespace *nsPtr) -); + (TclVarHashTable *tablePtr, Namespace *nsPtr) + ); typedef void (Tcl_CleanupVarFunction) _ANSI_ARGS_ ( - (Var * varPtr, Var *arrayPtr) -); + (Var * varPtr, Var *arrayPtr) + ); typedef Var * (Tcl_DeleteVarFunction) _ANSI_ARGS_ ( - (Interp *iPtr, TclVarHashTable *tablePtr) -); + (Interp *iPtr, TclVarHashTable *tablePtr) + ); typedef Var * (lookupVarFromTableFunction) _ANSI_ARGS_ ( - (TclVarHashTable *varTable, CONST char *simpleName, XOTclObject *obj) -); + (TclVarHashTable *varTable, CONST char *simpleName, XOTclObject *obj) + ); typedef struct TclVarHashTable85 { - Tcl_HashTable table; - struct Namespace *nsPtr; + Tcl_HashTable table; + struct Namespace *nsPtr; } TclVarHashTable85; typedef struct Var85 { - int flags; - union { - Tcl_Obj *objPtr; - TclVarHashTable85 *tablePtr; - struct Var85 *linkPtr; - } value; + int flags; + union { + Tcl_Obj *objPtr; + TclVarHashTable85 *tablePtr; + struct Var85 *linkPtr; + } value; } Var85; typedef struct VarInHash { - Var85 var; - int refCount; - Tcl_HashEntry entry; + Var85 var; + int refCount; + Tcl_HashEntry entry; } VarInHash; typedef struct Tcl_CallFrame85 { - Tcl_Namespace *nsPtr; - int dummy1; - int dummy2; - char *dummy3; - char *dummy4; - char *dummy5; - int dummy6; - char *dummy7; - char *dummy8; - int dummy9; - char *dummy10; - char *dummy11; - char *dummy12; + Tcl_Namespace *nsPtr; + int dummy1; + int dummy2; + char *dummy3; + char *dummy4; + char *dummy5; + int dummy6; + char *dummy7; + char *dummy8; + int dummy9; + char *dummy10; + char *dummy11; + char *dummy12; } Tcl_CallFrame85; typedef struct CallFrame85 { - Namespace *nsPtr; - int isProcCallFrame; - int objc; - Tcl_Obj *CONST *objv; - struct CallFrame *callerPtr; - struct CallFrame *callerVarPtr; - int level; - Proc *procPtr; - TclVarHashTable *varTablePtr; - int numCompiledLocals; - Var85 *compiledLocals; - ClientData clientData; - void *localCachePtr; + Namespace *nsPtr; + int isProcCallFrame; + int objc; + Tcl_Obj *CONST *objv; + struct CallFrame *callerPtr; + struct CallFrame *callerVarPtr; + int level; + Proc *procPtr; + TclVarHashTable *varTablePtr; + int numCompiledLocals; + Var85 *compiledLocals; + ClientData clientData; + void *localCachePtr; } CallFrame85; /* @@ -298,16 +298,16 @@ static int varRefCountOffset; static int varHashTableSize; -# define VarHashRefCount(varPtr) \ - (*((int *) (((char *)(varPtr))+varRefCountOffset))) +# define VarHashRefCount(varPtr) \ + (*((int *) (((char *)(varPtr))+varRefCountOffset))) -# define VarHashGetValue(hPtr) \ - (forwardCompatibleMode ? \ - (Var *) ((char *)hPtr - TclOffset(VarInHash, entry)) : \ - (Var *) Tcl_GetHashValue(hPtr) \ - ) +# define VarHashGetValue(hPtr) \ + (forwardCompatibleMode ? \ + (Var *) ((char *)hPtr - TclOffset(VarInHash, entry)) : \ + (Var *) Tcl_GetHashValue(hPtr) \ + ) -#define VarHashGetKey(varPtr) \ +#define VarHashGetKey(varPtr) \ (((VarInHash *)(varPtr))->entry.key.objPtr) #define VAR_TRACED_READ85 0x10 /* TCL_TRACE_READS */ @@ -316,81 +316,81 @@ #define VAR_TRACED_ARRAY85 0x800 /* TCL_TRACE_ARRAY */ #define VAR_TRACE_ACTIVE85 0x2000 #define VAR_SEARCH_ACTIVE85 0x4000 -#define VAR_ALL_TRACES85 \ - (VAR_TRACED_READ85|VAR_TRACED_WRITE85|VAR_TRACED_ARRAY85|VAR_TRACED_UNSET85) +#define VAR_ALL_TRACES85 \ + (VAR_TRACED_READ85|VAR_TRACED_WRITE85|VAR_TRACED_ARRAY85|VAR_TRACED_UNSET85) #define VAR_ARRAY85 0x1 #define VAR_LINK85 0x2 -#define varFlags(varPtr) \ - (forwardCompatibleMode ? \ - ((Var85 *)varPtr)->flags : \ - (varPtr)->flags \ - ) +#define varFlags(varPtr) \ + (forwardCompatibleMode ? \ + ((Var85 *)varPtr)->flags : \ + (varPtr)->flags \ + ) #undef TclIsVarScalar -#define TclIsVarScalar(varPtr) \ - (forwardCompatibleMode ? \ - !(((Var85 *)varPtr)->flags & (VAR_ARRAY85|VAR_LINK85)) : \ - ((varPtr)->flags & VAR_SCALAR) \ - ) +#define TclIsVarScalar(varPtr) \ + (forwardCompatibleMode ? \ + !(((Var85 *)varPtr)->flags & (VAR_ARRAY85|VAR_LINK85)) : \ + ((varPtr)->flags & VAR_SCALAR) \ + ) #undef TclIsVarArray -#define TclIsVarArray(varPtr) \ - (forwardCompatibleMode ? \ - (((Var85 *)varPtr)->flags & VAR_ARRAY85) : \ - ((varPtr)->flags & VAR_ARRAY) \ - ) -#define TclIsVarNamespaceVar(varPtr) \ - (forwardCompatibleMode ? \ - (((Var85 *)varPtr)->flags & VAR_NAMESPACE_VAR) : \ - ((varPtr)->flags & VAR_NAMESPACE_VAR) \ - ) +#define TclIsVarArray(varPtr) \ + (forwardCompatibleMode ? \ + (((Var85 *)varPtr)->flags & VAR_ARRAY85) : \ + ((varPtr)->flags & VAR_ARRAY) \ + ) +#define TclIsVarNamespaceVar(varPtr) \ + (forwardCompatibleMode ? \ + (((Var85 *)varPtr)->flags & VAR_NAMESPACE_VAR) : \ + ((varPtr)->flags & VAR_NAMESPACE_VAR) \ + ) -#define TclIsVarTraced(varPtr) \ - (forwardCompatibleMode ? \ - (((Var85 *)varPtr)->flags & VAR_ALL_TRACES85) : \ - (varPtr->tracePtr != NULL) \ - ) +#define TclIsVarTraced(varPtr) \ + (forwardCompatibleMode ? \ + (((Var85 *)varPtr)->flags & VAR_ALL_TRACES85) : \ + (varPtr->tracePtr != NULL) \ + ) #undef TclIsVarLink -#define TclIsVarLink(varPtr) \ - (forwardCompatibleMode ? \ - (((Var85 *)varPtr)->flags & VAR_LINK85) : \ - (varPtr->flags & VAR_LINK) \ - ) +#define TclIsVarLink(varPtr) \ + (forwardCompatibleMode ? \ + (((Var85 *)varPtr)->flags & VAR_LINK85) : \ + (varPtr->flags & VAR_LINK) \ + ) #undef TclIsVarUndefined -#define TclIsVarUndefined(varPtr) \ - (forwardCompatibleMode ? \ - (((Var85 *)varPtr)->value.objPtr == NULL) : \ - (varPtr->flags & VAR_UNDEFINED) \ - ) +#define TclIsVarUndefined(varPtr) \ + (forwardCompatibleMode ? \ + (((Var85 *)varPtr)->value.objPtr == NULL) : \ + (varPtr->flags & VAR_UNDEFINED) \ + ) #undef TclSetVarLink -#define TclSetVarLink(varPtr) \ - if (forwardCompatibleMode) \ - ((Var85 *)varPtr)->flags = (((Var85 *)varPtr)->flags & ~VAR_ARRAY85) | VAR_LINK85; \ - else \ - (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK +#define TclSetVarLink(varPtr) \ + if (forwardCompatibleMode) \ + ((Var85 *)varPtr)->flags = (((Var85 *)varPtr)->flags & ~VAR_ARRAY85) | VAR_LINK85; \ + else \ + (varPtr)->flags = ((varPtr)->flags & ~(VAR_SCALAR|VAR_ARRAY)) | VAR_LINK #undef TclClearVarUndefined -#define TclClearVarUndefined(varPtr) \ - if (!forwardCompatibleMode) \ - (varPtr)->flags &= ~VAR_UNDEFINED +#define TclClearVarUndefined(varPtr) \ + if (!forwardCompatibleMode) \ + (varPtr)->flags &= ~VAR_UNDEFINED #undef Tcl_CallFrame_compiledLocals -#define Tcl_CallFrame_compiledLocals(cf) \ - (forwardCompatibleMode ? \ - (Var *)(((CallFrame85 *)cf)->compiledLocals) : \ - (((CallFrame*)cf)->compiledLocals) \ +#define Tcl_CallFrame_compiledLocals(cf) \ + (forwardCompatibleMode ? \ + (Var *)(((CallFrame85 *)cf)->compiledLocals) : \ + (((CallFrame*)cf)->compiledLocals) \ ) -#define getNthVar(varPtr,i) \ - (forwardCompatibleMode ? \ - (Var *)(((Var85 *)varPtr)+(i)) : \ - (((Var *)varPtr)+(i)) \ +#define getNthVar(varPtr,i) \ + (forwardCompatibleMode ? \ + (Var *)(((Var85 *)varPtr)+(i)) : \ + (((Var *)varPtr)+(i)) \ ) #define valueOfVar(type,varPtr,field) \ - (forwardCompatibleMode ? \ - (type *)(((Var85 *)varPtr)->value.field) : \ - (type *)(((Var *)varPtr)->value.field) \ + (forwardCompatibleMode ? \ + (type *)(((Var85 *)varPtr)->value.field) : \ + (type *)(((Var *)varPtr)->value.field) \ ) #endif @@ -400,7 +400,7 @@ #endif -#define TclIsCompiledLocalArgument(compiledLocalPtr) \ +#define TclIsCompiledLocalArgument(compiledLocalPtr) \ ((compiledLocalPtr)->flags & VAR_ARGUMENT) #define TclIsCompiledLocalTemporary(compiledLocalPtr) \ ((compiledLocalPtr)->flags & VAR_TEMPORARY) @@ -482,16 +482,16 @@ static Var * LookupVarFromTable84(TclVarHashTable *varTable, CONST char *simpleName, XOTclObject *obj) { - Var *varPtr = NULL; - Tcl_HashEntry *entryPtr; + Var *varPtr = NULL; + Tcl_HashEntry *entryPtr; - if (varTable) { - entryPtr = Tcl_FindHashEntry(varTable, simpleName); - if (entryPtr) { - varPtr = VarHashGetValue(entryPtr); - } + if (varTable) { + entryPtr = Tcl_FindHashEntry(varTable, simpleName); + if (entryPtr) { + varPtr = VarHashGetValue(entryPtr); } - return varPtr; + } + return varPtr; } #endif @@ -529,14 +529,14 @@ static Var * XOTclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, - int flags, const char *msg, int createPart1, int createPart2, - Var **arrayPtrPtr) { + int flags, const char *msg, int createPart1, int createPart2, + Var **arrayPtrPtr) { - return TclLookupVar(interp, ObjStr(part1Ptr), part2, flags, msg, - createPart1, createPart2, arrayPtrPtr); + return TclLookupVar(interp, ObjStr(part1Ptr), part2, flags, msg, + createPart1, createPart2, arrayPtrPtr); } -#define ObjFindNamespace(interp, objPtr) \ +#define ObjFindNamespace(interp, objPtr) \ Tcl_FindNamespace((interp), ObjStr(objPtr), NULL, 0); #else @@ -545,11 +545,11 @@ * definitions for tcl 8.5 */ -#define VarHashGetValue(hPtr) \ +#define VarHashGetValue(hPtr) \ ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) -#define VarHashGetKey(varPtr) \ +#define VarHashGetKey(varPtr) \ (((VarInHash *)(varPtr))->entry.key.objPtr) -#define VarHashTable(varTable) \ +#define VarHashTable(varTable) \ &(varTable)->table #define XOTclObjLookupVar TclObjLookupVar #define varHashTableSize sizeof(TclVarHashTable) @@ -571,27 +571,27 @@ static XOTCLINLINE Var * VarHashCreateVar85(TclVarHashTable *tablePtr, Tcl_Obj *key, int *newPtr) { - Var *varPtr = NULL; - Tcl_HashEntry *hPtr; - hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, - (char *) key, newPtr); - if (hPtr) { - varPtr = VarHashGetValue(hPtr); - } - return varPtr; + Var *varPtr = NULL; + Tcl_HashEntry *hPtr; + hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr, + (char *) key, newPtr); + if (hPtr) { + varPtr = VarHashGetValue(hPtr); + } + return varPtr; } static XOTCLINLINE Var * LookupVarFromTable85(TclVarHashTable *tablePtr, CONST char *simpleName, XOTclObject *obj) { - Var *varPtr = NULL; - if (tablePtr) { - Tcl_Obj *keyPtr = Tcl_NewStringObj(simpleName, -1); - Tcl_IncrRefCount(keyPtr); - varPtr = VarHashCreateVar85(tablePtr, keyPtr, NULL); - Tcl_DecrRefCount(keyPtr); - } - return varPtr; + Var *varPtr = NULL; + if (tablePtr) { + Tcl_Obj *keyPtr = Tcl_NewStringObj(simpleName, -1); + Tcl_IncrRefCount(keyPtr); + varPtr = VarHashCreateVar85(tablePtr, keyPtr, NULL); + Tcl_DecrRefCount(keyPtr); + } + return varPtr; } #endif @@ -604,7 +604,7 @@ */ static int callMethod(ClientData cd, Tcl_Interp *in, Tcl_Obj *method, - int objc, Tcl_Obj *CONST objv[], int flags) { + int objc, Tcl_Obj *CONST objv[], int flags) { XOTclObject *obj = (XOTclObject*) cd; int result; ALLOC_ON_STACK(Tcl_Obj*,objc, tov); @@ -625,7 +625,7 @@ int XOTclCallMethodWithArgs(ClientData cd, Tcl_Interp *in, Tcl_Obj *method, Tcl_Obj *arg, - int givenobjc, Tcl_Obj *CONST objv[], int flags) { + int givenobjc, Tcl_Obj *CONST objv[], int flags) { XOTclObject *obj = (XOTclObject*) cd; int objc = givenobjc + 2; int result; @@ -719,7 +719,7 @@ fprintf(stderr, "\n"); } static void printExit(Tcl_Interp *in, char *string, - int objc, Tcl_Obj *CONST objv[], int result) { + int objc, Tcl_Obj *CONST objv[], int result) { fprintf(stderr, " (%d) <%s: ", Tcl_Interp_numLevels(in), string); /*printObjv(objc, objv);*/ fprintf(stderr, " result=%d\n", result); @@ -731,32 +731,32 @@ * XOTclObject Reference Accounting */ #if defined(XOTCLOBJ_TRACE) -# define XOTclObjectRefCountIncr(obj) \ - obj->refCount++; \ +# define XOTclObjectRefCountIncr(obj) \ + obj->refCount++; \ fprintf(stderr, "RefCountIncr %p count=%d %s\n", obj, obj->refCount,obj->cmdName?ObjStr(obj->cmdName):"no name"); \ MEM_COUNT_ALLOC("XOTclObject RefCount",obj) -# define XOTclObjectRefCountDecr(obj) \ - obj->refCount--; \ - fprintf(stderr, "RefCountDecr %p count=%d\n", obj, obj->refCount); \ +# define XOTclObjectRefCountDecr(obj) \ + obj->refCount--; \ + fprintf(stderr, "RefCountDecr %p count=%d\n", obj, obj->refCount); \ MEM_COUNT_FREE("XOTclObject RefCount", obj) #else -# define XOTclObjectRefCountIncr(obj) \ - obj->refCount++; \ +# define XOTclObjectRefCountIncr(obj) \ + obj->refCount++; \ MEM_COUNT_ALLOC("XOTclObject RefCount",obj) -# define XOTclObjectRefCountDecr(obj) \ - obj->refCount--; \ +# define XOTclObjectRefCountDecr(obj) \ + obj->refCount--; \ MEM_COUNT_FREE("XOTclObject RefCount",obj) #endif #if defined(XOTCLOBJ_TRACE) void objTrace(char *string, XOTclObject *obj) { if (obj) - fprintf(stderr,"--- %s tcl %p %s (%d %p) xotcl %p (%d) %s \n", string, - obj->cmdName, obj->cmdName->typePtr ? obj->cmdName->typePtr->name : "NULL", - obj->cmdName->refCount, obj->cmdName->internalRep.twoPtrValue.ptr1, - obj, obj->refCount, ObjStr(obj->cmdName)); + fprintf(stderr,"--- %s tcl %p %s (%d %p) xotcl %p (%d) %s \n", string, + obj->cmdName, obj->cmdName->typePtr ? obj->cmdName->typePtr->name : "NULL", + obj->cmdName->refCount, obj->cmdName->internalRep.twoPtrValue.ptr1, + obj, obj->refCount, ObjStr(obj->cmdName)); else - fprintf(stderr,"--- No object: %s\n",string); + fprintf(stderr,"--- No object: %s\n",string); } #else # define objTrace(a,b) @@ -803,11 +803,11 @@ assert(obj->flags & XOTCL_DESTROYED); #if REFCOUNT_TRACE fprintf(stderr,"###CLNO %p flags %x rc %d destr %d dc %d\n", - obj, obj->flags, - (obj->flags & XOTCL_REFCOUNTED) != 0, - (obj->flags & XOTCL_DESTROYED) != 0, - (obj->flags & XOTCL_DESTROY_CALLED) != 0 - ); + obj, obj->flags, + (obj->flags & XOTCL_REFCOUNTED) != 0, + (obj->flags & XOTCL_DESTROYED) != 0, + (obj->flags & XOTCL_DESTROY_CALLED) != 0 + ); #endif MEM_COUNT_FREE("XOTclObject/XOTclClass",obj); @@ -837,7 +837,7 @@ XOTclObject *obj = (XOTclObject*) objPtr->internalRep.otherValuePtr; /* fprintf(stderr,"FIP objPtr %p obj %p obj->cmd %p '%s', bytes='%s'\n", - objPtr,obj, obj->cmdName, ObjStr(obj->cmdName), objPtr->bytes); + objPtr,obj, obj->cmdName, ObjStr(obj->cmdName), objPtr->bytes); */ #if defined(XOTCLOBJ_TRACE) if (obj) @@ -846,28 +846,28 @@ #if !defined(REFCOUNTED) if (obj != NULL) { - XOTclCleanupObject(obj); + XOTclCleanupObject(obj); } #else if (obj != NULL) { #if REFCOUNT_TRACE fprintf(stderr, "FIP in %p\n", obj->teardown); fprintf(stderr, "FIP call is destroy %d\n", RUNTIME_STATE(obj->teardown)->callIsDestroy); fprintf(stderr,"FIP %p flags %x rc %d destr %d dc %d refcount = %d\n", - obj, obj->flags, - (obj->flags & XOTCL_REFCOUNTED) != 0, - (obj->flags & XOTCL_DESTROYED) != 0, - (obj->flags & XOTCL_DESTROY_CALLED) != 0, - obj->refCount - ); + obj, obj->flags, + (obj->flags & XOTCL_REFCOUNTED) != 0, + (obj->flags & XOTCL_DESTROYED) != 0, + (obj->flags & XOTCL_DESTROY_CALLED) != 0, + obj->refCount + ); #endif if (obj->flags & XOTCL_REFCOUNTED && - !(obj->flags & XOTCL_DESTROY_CALLED)) { + !(obj->flags & XOTCL_DESTROY_CALLED)) { Tcl_Interp *in = obj->teardown; INCR_REF_COUNT(obj->cmdName); callDestroyMethod((ClientData)obj, in, obj, 0); /* the call to cleanup is the counterpart of the - INCR_REF_COUNT(obj->cmdName) above */ + INCR_REF_COUNT(obj->cmdName) above */ XOTclCleanupObject(obj); } else { fprintf(stderr, "BEFORE CLEANUPOBJ %x\n", (obj->flags & XOTCL_REFCOUNTED)); @@ -901,7 +901,7 @@ #ifdef XOTCLOBJ_TRACE fprintf(stderr,"SetXOTclObjectFromAny %p '%s' %p\n", - objPtr,string,objPtr->typePtr); + objPtr,string,objPtr->typePtr); if (oldTypePtr) fprintf(stderr," convert %s to XOTclObject\n", oldTypePtr->name); #endif @@ -934,14 +934,14 @@ if ((oldTypePtr != NULL) && (oldTypePtr->freeIntRepProc != NULL)) { #ifdef XOTCLOBJ_TRACE fprintf(stderr," freeing type=%p, type=%s\n", - objPtr->typePtr, objPtr->typePtr ? objPtr->typePtr->name : ""); + objPtr->typePtr, objPtr->typePtr ? objPtr->typePtr->name : ""); #endif oldTypePtr->freeIntRepProc(objPtr); } XOTclObjectRefCountIncr(obj); #if defined(XOTCLOBJ_TRACE) fprintf(stderr, "SetXOTclObjectFromAny tcl %p (%d) xotcl %p (%d)\n", - objPtr, objPtr->refCount, obj, obj->refCount); + objPtr, objPtr->refCount, obj, obj->refCount); #endif objPtr->internalRep.otherValuePtr = (XOTclObject*) obj; objPtr->typePtr = &XOTclObjectType; @@ -958,9 +958,9 @@ #ifdef XOTCLOBJ_TRACE fprintf(stderr,"UpdateStringOfXOTclObject %p refCount %d\n", - objPtr,objPtr->refCount); + objPtr,objPtr->refCount); fprintf(stderr," teardown %p id %p destroyCalled %d\n", - obj->teardown, obj->id, (obj->flags & XOTCL_DESTROY_CALLED)); + obj->teardown, obj->id, (obj->flags & XOTCL_DESTROY_CALLED)); #endif /* Here we use GetCommandName, because it doesnt need @@ -971,7 +971,7 @@ DSTRING_INIT(dsp); nsFullName = NSCmdFullName(obj->id); if (!(*nsFullName==':' && *(nsFullName+1)==':' && - *(nsFullName+2)=='\0')) { + *(nsFullName+2)=='\0')) { Tcl_DStringAppend(dsp, nsFullName, -1); } Tcl_DStringAppend(dsp, "::", 2); @@ -993,18 +993,18 @@ } /* fprintf(stderr, "+++UpdateStringOfXOTclObject bytes='%s',length=%d\n", - objPtr->bytes,objPtr->length); + objPtr->bytes,objPtr->length); */ } #ifdef NOTUSED static Tcl_Obj * NewXOTclObjectObj(register XOTclObject *obj) { - register Tcl_Obj *objPtr = 0; - XOTclNewObj(objPtr); - objPtr->bytes = NULL; - objPtr->internalRep.otherValuePtr = obj; - objPtr->typePtr = &XOTclObjectType; + register Tcl_Obj *objPtr = 0; + XOTclNewObj(objPtr); + objPtr->bytes = NULL; + objPtr->internalRep.otherValuePtr = obj; + objPtr->typePtr = &XOTclObjectType; #ifdef XOTCLOBJ_TRACE fprintf(stderr,"NewXOTclObjectObj %p\n",objPtr); #endif @@ -1027,8 +1027,8 @@ objPtr->typePtr = &XOTclObjectType; #ifdef XOTCLOBJ_TRACE - fprintf(stderr,"NewXOTclObjectObjName tcl %p (%d) xotcl %p (%d) %s\n", - objPtr, objPtr->refCount, obj, obj->refCount, objPtr->bytes); + fprintf(stderr,"NewXOTclObjectObjName tcl %p (%d) xotcl %p (%d) %s\n", + objPtr, objPtr->refCount, obj, obj->refCount, objPtr->bytes); #endif XOTclObjectRefCountIncr(obj); @@ -1080,8 +1080,8 @@ if (cmd) { o = XOTclGetObjectFromCmdPtr(cmd); if (o) { - *obj = o; - return TCL_OK; + *obj = o; + return TCL_OK; } } } @@ -1111,27 +1111,27 @@ XOTclObject *o = (XOTclObject*) objPtr->internalRep.otherValuePtr; int refetch = 0; if (o->flags & XOTCL_DESTROYED) { - /* fprintf(stderr,"????? calling free by hand\n"); */ - FreeXOTclObjectInternalRep(objPtr); - refetch = 1; - result = SetXOTclObjectFromAny(in, objPtr); - if (result == TCL_OK) { - o = (XOTclObject*) objPtr->internalRep.otherValuePtr; - assert(o && !(o->flags & XOTCL_DESTROYED)); - } + /* fprintf(stderr,"????? calling free by hand\n"); */ + FreeXOTclObjectInternalRep(objPtr); + refetch = 1; + result = SetXOTclObjectFromAny(in, objPtr); + if (result == TCL_OK) { + o = (XOTclObject*) objPtr->internalRep.otherValuePtr; + assert(o && !(o->flags & XOTCL_DESTROYED)); + } } else { - result = TCL_OK; + result = TCL_OK; } *obj = o; #ifdef XOTCLOBJ_TRACE if (result == TCL_OK) - fprintf(stderr,"XOTclObjConvertObject tcl %p (%d) xotcl %p (%d) r=%d %s\n", - objPtr, objPtr->refCount, o, o->refCount, refetch, objPtr->bytes); + fprintf(stderr,"XOTclObjConvertObject tcl %p (%d) xotcl %p (%d) r=%d %s\n", + objPtr, objPtr->refCount, o, o->refCount, refetch, objPtr->bytes); else - fprintf(stderr,"XOTclObjConvertObject tcl %p (%d) **** rc=%d r=%d %s\n", - objPtr, objPtr->refCount, result, refetch, objPtr->bytes); + fprintf(stderr,"XOTclObjConvertObject tcl %p (%d) **** rc=%d r=%d %s\n", + objPtr, objPtr->refCount, result, refetch, objPtr->bytes); #endif } else { result = TCL_OK; @@ -1143,16 +1143,16 @@ if (cmd) { XOTclObject *o = XOTclGetObjectFromCmdPtr(cmd); /* - fprintf(stderr,"Got Object from '%s' %p\n",objPtr->bytes,o); - fprintf(stderr,"cmd->objProc %p == %p, proc=%p\n", + fprintf(stderr,"Got Object from '%s' %p\n",objPtr->bytes,o); + fprintf(stderr,"cmd->objProc %p == %p, proc=%p\n", Tcl_Command_objProc(cmd), XOTclObjDispatch, Tcl_Command_proc(cmd) ); */ if (o) { - if (obj) *obj = o; - result = TCL_OK; + if (obj) *obj = o; + result = TCL_OK; } else { - goto convert_to_xotcl_object; + goto convert_to_xotcl_object; } } else goto convert_to_xotcl_object; #endif @@ -1211,7 +1211,7 @@ static int GetXOTclClassFromObj(Tcl_Interp *in, register Tcl_Obj *objPtr, - XOTclClass **cl, int retry) { + XOTclClass **cl, int retry) { XOTclObject *obj; XOTclClass *cls = NULL; int result = TCL_OK; @@ -1225,10 +1225,10 @@ Tcl_Command cmd = NSFindCommand(in, objName, callingNameSpace(in)); /*fprintf(stderr, "GetXOTclClassFromObj %s cmd = %p cl=%p retry=%d\n", - objName, cmd, cmd ? XOTclGetClassFromCmdPtr(cmd) : NULL, retry);*/ + objName, cmd, cmd ? XOTclGetClassFromCmdPtr(cmd) : NULL, retry);*/ if (cmd) { - cls = XOTclGetClassFromCmdPtr(cmd); - if (cl) *cl = cls; + cls = XOTclGetClassFromCmdPtr(cmd); + if (cl) *cl = cls; } } } @@ -1238,10 +1238,10 @@ if (result == TCL_OK) { cls = XOTclObjectToClass(obj); if (cls) { - if (cl) *cl = cls; + if (cl) *cl = cls; } else { - /* we have an object, but no class */ - result = TCL_ERROR; + /* we have an object, but no class */ + result = TCL_ERROR; } } } @@ -1403,8 +1403,8 @@ if (cl) { Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&cl->instances, (char *)obj); if (hPtr) { - Tcl_DeleteHashEntry(hPtr); - return 1; + Tcl_DeleteHashEntry(hPtr); + return 1; } } return 0; @@ -1554,12 +1554,12 @@ #if !defined(NDEBUG) {char *cmdName = ObjStr(obj->cmdName); - assert(cmdName != NULL); - /*fprintf(stderr,"findCommand %s -> %p obj->id %p\n",cmdName, - Tcl_FindCommand(in, cmdName, NULL, 0),obj->id);*/ - /*assert(Tcl_FindCommand(in, cmdName, NULL, 0) != NULL);*/ - /*fprintf(stderr,"callDestroyMethod: %p command to be destroyed '%s' does not exist\n", - obj, cmdName);*/ + assert(cmdName != NULL); + /*fprintf(stderr,"findCommand %s -> %p obj->id %p\n",cmdName, + Tcl_FindCommand(in, cmdName, NULL, 0),obj->id);*/ + /*assert(Tcl_FindCommand(in, cmdName, NULL, 0) != NULL);*/ + /*fprintf(stderr,"callDestroyMethod: %p command to be destroyed '%s' does not exist\n", + obj, cmdName);*/ } #endif @@ -1571,7 +1571,7 @@ result = callMethod(cd, in, XOTclGlobalObjects[XOTE_DESTROY], 2, 0, flags); if (result != TCL_OK) { static char cmd[] = - "puts stderr \"[self]: Error in instproc destroy\n\ + "puts stderr \"[self]: Error in instproc destroy\n\ $::errorCode $::errorInfo\""; Tcl_EvalEx(in, cmd, -1, 0); if (++RUNTIME_STATE(in)->errorCount > 20) @@ -1593,11 +1593,11 @@ extern XOTclObjectOpt * XOTclRequireObjectOpt(XOTclObject *obj) { - if (!obj->opt) { - obj->opt = NEW(XOTclObjectOpt); - memset(obj->opt, 0, sizeof(XOTclObjectOpt)); - } - return obj->opt; + if (!obj->opt) { + obj->opt = NEW(XOTclObjectOpt); + memset(obj->opt, 0, sizeof(XOTclObjectOpt)); + } + return obj->opt; } extern XOTclClassOpt* @@ -1643,23 +1643,23 @@ *varHashTable = *objHashTable; /* copy the table */ if (objHashTable->buckets == objHashTable->staticBuckets) { - varHashTable->buckets = varHashTable->staticBuckets; + varHashTable->buckets = varHashTable->staticBuckets; } for (hPtr = Tcl_FirstHashEntry(varHashTable, &search); hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { + hPtr = Tcl_NextHashEntry(&search)) { #if defined(PRE85) - Var *varPtr; + Var *varPtr; # if FORWARD_COMPATIBLE - if (!forwardCompatibleMode) { - varPtr = (Var *) Tcl_GetHashValue(hPtr); - varPtr->nsPtr = (Namespace *)nsPtr; - } -# else + if (!forwardCompatibleMode) { varPtr = (Var *) Tcl_GetHashValue(hPtr); varPtr->nsPtr = (Namespace *)nsPtr; + } +# else + varPtr = (Var *) Tcl_GetHashValue(hPtr); + varPtr->nsPtr = (Namespace *)nsPtr; # endif #endif - hPtr->tablePtr = varHashTable; + hPtr->tablePtr = varHashTable; } ckfree((char *) obj->varTable); @@ -1669,9 +1669,9 @@ } /* typedef int (Tcl_ResolveVarProc) _ANSI_ARGS_(( - * Tcl_Interp* in, CONST char * name, Tcl_Namespace *context, - * int flags, Tcl_Var *rPtr)); - */ + * Tcl_Interp* in, CONST char * name, Tcl_Namespace *context, + * int flags, Tcl_Var *rPtr)); + */ int varResolver(Tcl_Interp *in, CONST char *name, Tcl_Namespace *ns, int flags, Tcl_Var *varPtr) { *varPtr = (Tcl_Var)LookupVarFromTable(Tcl_Namespace_varTable(ns), name,NULL); @@ -1684,8 +1684,8 @@ requireObjNamespace(Tcl_Interp *in, XOTclObject *obj) { if (!obj->nsPtr) makeObjNamespace(in,obj); /* - Tcl_SetNamespaceResolvers(obj->nsPtr, (Tcl_ResolveCmdProc*)NULL, - varResolver, (Tcl_ResolveCompiledVarProc*)NULL); + Tcl_SetNamespaceResolvers(obj->nsPtr, (Tcl_ResolveCmdProc*)NULL, + varResolver, (Tcl_ResolveCompiledVarProc*)NULL); */ } @@ -1744,30 +1744,30 @@ obj = XOTclpGetObject(in, Tcl_DStringValue(&name)); if (obj) { - /* fprintf(stderr, " ... obj= %s\n", ObjStr(obj->cmdName));*/ + /* fprintf(stderr, " ... obj= %s\n", ObjStr(obj->cmdName));*/ - /* in the exit handler physical destroy --> directly call destroy */ - if (RUNTIME_STATE(in)->exitHandlerDestroyRound - == XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY) { - if (XOTclObjectIsClass(obj)) - PrimitiveCDestroy((ClientData) obj); - else - PrimitiveODestroy((ClientData) obj); - } else { - if (obj->teardown != 0 && obj->id && - !(obj->flags & XOTCL_DESTROY_CALLED)) { - if (callDestroyMethod((ClientData)obj, in, obj, 0) != TCL_OK) { - /* destroy method failed, but we have to remove the command - anyway. */ - obj->flags |= XOTCL_DESTROY_CALLED; + /* in the exit handler physical destroy --> directly call destroy */ + if (RUNTIME_STATE(in)->exitHandlerDestroyRound + == XOTCL_EXITHANDLER_ON_PHYSICAL_DESTROY) { + if (XOTclObjectIsClass(obj)) + PrimitiveCDestroy((ClientData) obj); + else + PrimitiveODestroy((ClientData) obj); + } else { + if (obj->teardown != 0 && obj->id && + !(obj->flags & XOTCL_DESTROY_CALLED)) { + if (callDestroyMethod((ClientData)obj, in, obj, 0) != TCL_OK) { + /* destroy method failed, but we have to remove the command + anyway. */ + obj->flags |= XOTCL_DESTROY_CALLED; - if (obj->teardown) { - CallStackDestroyObject(in, obj); - } - /*(void*) Tcl_DeleteCommandFromToken(in, oid);*/ - } - } - } + if (obj->teardown) { + CallStackDestroyObject(in, obj); + } + /*(void*) Tcl_DeleteCommandFromToken(in, oid);*/ + } + } + } } DSTRING_FREE(&name); } @@ -1785,7 +1785,7 @@ XOTcl_PushFrame(in, obj); varPtr = TclLookupVar(in, name, 0, flgs, "obj vwait", - /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); + /*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr); XOTcl_PopFrame(in, obj); return varPtr; } @@ -1805,7 +1805,7 @@ NSDeleteNamespace(in, child); } /* - fprintf(stderr, "NSDeleteNamespace deleting %s\n", ns->fullName); + fprintf(stderr, "NSDeleteNamespace deleting %s\n", ns->fullName); */ MEM_COUNT_FREE("TclNamespace",ns); Tcl_DeleteNamespace(ns); @@ -1850,7 +1850,7 @@ /* objects should not be deleted here to preseve children deletion order*/ if (!XOTclGetObjectFromCmdPtr(cmd)) { /*fprintf(stderr,"NSCleanupNamespace deleting %s %p\n", - Tcl_Command_nsPtr(cmd)->fullName, cmd);*/ + Tcl_Command_nsPtr(cmd)->fullName, cmd);*/ XOTcl_DeleteCommandFromToken(in, cmd); } } @@ -1874,7 +1874,7 @@ Tcl_CallFrame *f = (Tcl_CallFrame *)Tcl_Interp_framePtr(in); /* - fprintf(stderr, " ... correcting ActivationCount for %s was %d ", + fprintf(stderr, " ... correcting ActivationCount for %s was %d ", nsPtr->fullName, nsp->activationCount); */ while (f) { @@ -1886,7 +1886,7 @@ Tcl_Namespace_activationCount(nsPtr) = activationCount; /* - fprintf(stderr, "to %d. \n", nsp->activationCount); + fprintf(stderr, "to %d. \n", nsp->activationCount); */ MEM_COUNT_FREE("TclNamespace",nsPtr); if (Tcl_Namespace_deleteProc(nsPtr) != NULL) { @@ -1902,13 +1902,13 @@ if (ns) { if (ns->deleteProc != NULL || ns->clientData != NULL) { panic("Namespace '%s' exists already with delProc %p and clientData %p; Can only convert a plain Tcl namespace into an XOTcl namespace", - name, ns->deleteProc, ns->clientData); + name, ns->deleteProc, ns->clientData); } ns->clientData = cd; ns->deleteProc = (Tcl_NamespaceDeleteProc*) NSNamespaceDeleteProc; } else { ns = Tcl_CreateNamespace(in, name, cd, - (Tcl_NamespaceDeleteProc*) NSNamespaceDeleteProc); + (Tcl_NamespaceDeleteProc*) NSNamespaceDeleteProc); } MEM_COUNT_ALLOC("TclNamespace",ns); return ns; @@ -1956,34 +1956,34 @@ if (Tcl_FindNamespace(in, parentName, (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY) == 0) { XOTclObject *parentObj = (XOTclObject*) XOTclpGetObject(in, parentName); if (parentObj) { - /* this is for classes */ - requireObjNamespace(in, parentObj); + /* this is for classes */ + requireObjNamespace(in, parentObj); } else { - /* call unknown and try again */ - Tcl_Obj *ov[3]; - int rc; - ov[0] = RUNTIME_STATE(in)->theClass->object.cmdName; - ov[1] = XOTclGlobalObjects[XOTE___UNKNOWN]; - ov[2] = Tcl_NewStringObj(parentName,-1); - INCR_REF_COUNT(ov[2]); - /*fprintf(stderr,"+++ parent... calling __unknown for %s\n", ObjStr(ov[2]));*/ - rc = Tcl_EvalObjv(in, 3, ov, 0); + /* call unknown and try again */ + Tcl_Obj *ov[3]; + int rc; + ov[0] = RUNTIME_STATE(in)->theClass->object.cmdName; + ov[1] = XOTclGlobalObjects[XOTE___UNKNOWN]; + ov[2] = Tcl_NewStringObj(parentName,-1); + INCR_REF_COUNT(ov[2]); + /*fprintf(stderr,"+++ parent... calling __unknown for %s\n", ObjStr(ov[2]));*/ + rc = Tcl_EvalObjv(in, 3, ov, 0); if (rc == TCL_OK) { - XOTclObject *parentObj = (XOTclObject*) XOTclpGetObject(in, parentName); - if (parentObj) { - requireObjNamespace(in, parentObj); - } - result = (Tcl_FindNamespace(in, parentName, - (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY) != 0); - } else { - result = 0; - } - DECR_REF_COUNT(ov[2]); + XOTclObject *parentObj = (XOTclObject*) XOTclpGetObject(in, parentName); + if (parentObj) { + requireObjNamespace(in, parentObj); + } + result = (Tcl_FindNamespace(in, parentName, + (Tcl_Namespace *) NULL, TCL_GLOBAL_ONLY) != 0); + } else { + result = 0; + } + DECR_REF_COUNT(ov[2]); } } else { XOTclObject *parentObj = (XOTclObject*) XOTclpGetObject(in, parentName); if (parentObj) { - requireObjNamespace(in, parentObj); + requireObjNamespace(in, parentObj); } } DSTRING_FREE(dsp); @@ -2030,8 +2030,8 @@ /*if (cmd) { fprintf(stderr,"+++ XOTclGetObject from %s -> objProc=%p, dispatch=%p\n", - name, Tcl_Command_objProc(cmd), XOTclObjDispatch); - }*/ + name, Tcl_Command_objProc(cmd), XOTclObjDispatch); + }*/ if (cmd && Tcl_Command_objProc(cmd) == XOTclObjDispatch) { return (XOTclObject*)Tcl_Command_objClientData(cmd); @@ -2056,7 +2056,7 @@ void XOTclAddPMethod(Tcl_Interp *in, XOTcl_Object *obji, char *nm, Tcl_ObjCmdProc* proc, - ClientData cd, Tcl_CmdDeleteProc* dp) { + ClientData cd, Tcl_CmdDeleteProc* dp) { XOTclObject *obj = (XOTclObject*) obji; Tcl_DString newCmd, *cptr = &newCmd; requireObjNamespace(in, obj); @@ -2067,7 +2067,7 @@ void XOTclAddIMethod(Tcl_Interp *in, XOTcl_Class *cli, char *nm, - Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc* dp) { + Tcl_ObjCmdProc* proc, ClientData cd, Tcl_CmdDeleteProc* dp) { XOTclClass *cl = (XOTclClass*) cli; Tcl_DString newCmd, *cptr = &newCmd; ALLOC_NAME_NS(cptr, cl->nsPtr->fullName, nm); @@ -2107,7 +2107,7 @@ static Tcl_Obj* AutonameIncr(Tcl_Interp *in, Tcl_Obj *name, XOTclObject *obj, - int instanceOpt, int resetOpt) { + int instanceOpt, int resetOpt) { int valueLength, mustCopy = 1, format = 0; char *valueString, *c; Tcl_Obj *valueObject, *result = NULL, *savedResult = NULL; @@ -2145,42 +2145,42 @@ } else { if (valueObject == NULL) { valueObject = Tcl_ObjSetVar2(in, XOTclGlobalObjects[XOTE_AUTONAMES], - name, XOTclGlobalObjects[XOTE_ONE], flgs); + name, XOTclGlobalObjects[XOTE_ONE], flgs); } if (instanceOpt) { char buffer[1], firstChar, *nextChars; nextChars = ObjStr(name); firstChar = *(nextChars ++); if (isupper((int)firstChar)) { - buffer[0] = tolower((int)firstChar); - result = Tcl_NewStringObj(buffer,1); - INCR_REF_COUNT(result); - Tcl_AppendToObj(result, nextChars, -1); - mustCopy = 0; + buffer[0] = tolower((int)firstChar); + result = Tcl_NewStringObj(buffer,1); + INCR_REF_COUNT(result); + Tcl_AppendToObj(result, nextChars, -1); + mustCopy = 0; } } if (mustCopy) { result = Tcl_DuplicateObj(name); INCR_REF_COUNT(result); /* - fprintf(stderr,"*** copy %p %s = %p\n", name,ObjStr(name),result); + fprintf(stderr,"*** copy %p %s = %p\n", name,ObjStr(name),result); */ } /* if we find a % in the autoname -> We use Tcl_FormatObjCmd to let the autoname string be formated, like Tcl "format" command, with the value. E.g.: - autoname a%06d --> a000000, a000001, a000002, ... + autoname a%06d --> a000000, a000001, a000002, ... */ for (c = ObjStr(result); *c != '\0'; c++) { if (*c == '%') { - if (*(c+1) != '%') { - format = 1; - break; - } else { - /* when we find a %% we format and then append autoname, e.g. - autoname a%% --> a%1, a%2, ... */ - c++; - } + if (*(c+1) != '%') { + format = 1; + break; + } else { + /* when we find a %% we format and then append autoname, e.g. + autoname a%% --> a%1, a%2, ... */ + c++; + } } } if (format) { @@ -2191,10 +2191,10 @@ ov[1] = result; ov[2] = valueObject; if (Tcl_EvalObjv(in, 3, ov, 0) != TCL_OK) { - XOTcl_PopFrame(in, obj); - DECR_REF_COUNT(savedResult); - FREE_ON_STACK(ov); - return 0; + XOTcl_PopFrame(in, obj); + DECR_REF_COUNT(savedResult); + FREE_ON_STACK(ov); + return 0; } DECR_REF_COUNT(result); result = Tcl_DuplicateObj(Tcl_GetObjResult(in)); @@ -2228,16 +2228,16 @@ /* skip through toplevel inactive filters, do this offset times */ for (csc=cs->top; csc > cs->content; csc--) { if ((csc->callType & XOTCL_CSC_CALL_IS_NEXT) || - (csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) + (csc->frameType & XOTCL_CSC_TYPE_INACTIVE)) continue; if (offset) offset--; else { if (!deeper) { - return csc; + return csc; } if (csc->currentFramePtr && Tcl_CallFrame_level(csc->currentFramePtr) < topLevel) { - return csc; + return csc; } } } @@ -2295,7 +2295,7 @@ /* XOTclStackDump(in);*/ for (; cf && Tcl_CallFrame_level(cf); cf = Tcl_CallFrame_callerPtr(cf)) { if (Tcl_CallFrame_isProcCallFrame(cf) && cf != top->currentFramePtr) - break; + break; } ctx->varFramePtr = inFramePtr; Tcl_Interp_varFramePtr(in) = (CallFrame *) cf; @@ -2331,14 +2331,14 @@ XOTCLINLINE static int CallStackPush(Tcl_Interp *in, XOTclObject *obj, XOTclClass *cl, - Tcl_Command cmd, int objc, Tcl_Obj *CONST objv[], int frameType) { + Tcl_Command cmd, int objc, Tcl_Obj *CONST objv[], int frameType) { XOTclCallStack *cs; register XOTclCallStackContent *csc; cs = &RUNTIME_STATE(in)->cs; if (cs->top >= &cs->content[MAX_NESTING_DEPTH-1]) { Tcl_SetResult(in, "too many nested calls to Tcl_EvalObj (infinite loop?)", - TCL_STATIC); + TCL_STATIC); return TCL_ERROR; } /*fprintf(stderr, "CallStackPush sets self\n");*/ @@ -2373,7 +2373,7 @@ oid = obj->id; obj->id = 0; if (obj->teardown && oid) { - Tcl_DeleteCommandFromToken(in, oid); + Tcl_DeleteCommandFromToken(in, oid); } } @@ -2391,8 +2391,8 @@ csc->callType |= XOTCL_CSC_CALL_IS_DESTROY; /*fprintf(stderr,"setting destroy on frame %p for obj %p\n",csc,obj);*/ if (csc->destroyedCmd) { - Tcl_Command_refCount(csc->destroyedCmd)++; - MEM_COUNT_ALLOC("command refCount",csc->destroyedCmd); + Tcl_Command_refCount(csc->destroyedCmd)++; + MEM_COUNT_ALLOC("command refCount",csc->destroyedCmd); } countSelfs++; } @@ -2438,8 +2438,8 @@ entries of the object */ while (--h > cs->content) { if (h->self == csc->self) { - destroy = 0; - break; + destroy = 0; + break; } } if (destroy) { @@ -2496,7 +2496,7 @@ XOTclCmdList *h = l, **end = NULL; while (h) { if (h->cmdPtr == c) - return h; + return h; end = &(h->next); h = h->next; } @@ -2547,12 +2547,12 @@ fprintf(stderr,title); while (cmdList) { fprintf(stderr, " CL=%p, cmdPtr=%p %s, clorobj %p, clientData=%p\n", - cmdList, - cmdList->cmdPtr, - in ? Tcl_GetCommandName(in, cmdList->cmdPtr) : "", - cmdList->clorobj, - cmdList->clientData); - cmdList = cmdList->next; + cmdList, + cmdList->cmdPtr, + in ? Tcl_GetCommandName(in, cmdList->cmdPtr) : "", + cmdList->clorobj, + cmdList->clientData); + cmdList = cmdList->next; } } #endif @@ -2598,16 +2598,16 @@ */ static void CmdListRemoveEpoched(XOTclCmdList **cmdList, XOTclFreeCmdListClientData *freeFct) { - XOTclCmdList *f = *cmdList, *del; - while (f) { - if (Tcl_Command_cmdEpoch(f->cmdPtr)) { - del = f; - f = f->next; - del = CmdListRemoveFromList(cmdList, del); - CmdListDeleteCmdListEntry(del, freeFct); - } else - f = f->next; - } + XOTclCmdList *f = *cmdList, *del; + while (f) { + if (Tcl_Command_cmdEpoch(f->cmdPtr)) { + del = f; + f = f->next; + del = CmdListRemoveFromList(cmdList, del); + CmdListDeleteCmdListEntry(del, freeFct); + } else + f = f->next; + } } @@ -2616,10 +2616,10 @@ */ static void CmdListRemoveContextClassFromList(XOTclCmdList **cmdList, XOTclClass *clorobj, - XOTclFreeCmdListClientData* freeFct) { + XOTclFreeCmdListClientData* freeFct) { XOTclCmdList* c, *del = 0; /* - CmdListRemoveEpoched(cmdList, freeFct); + CmdListRemoveEpoched(cmdList, freeFct); */ c = *cmdList; while (c && c->clorobj == clorobj) { @@ -2633,9 +2633,9 @@ del = c; c = *cmdList; while (c->next && c->next != del) - c = c->next; + c = c->next; if (c->next == del) - c->next = del->next; + c->next = del->next; CmdListDeleteCmdListEntry(del, freeFct); } c = c->next; @@ -2698,7 +2698,7 @@ if (oc > 0) { int i; for (i=oc-1; i>=0; i--) { - TclObjListNewElement(&last, ov[i]); + TclObjListNewElement(&last, ov[i]); } } } @@ -2710,7 +2710,7 @@ Tcl_Obj *newAssStr = Tcl_NewStringObj("",0); for (; alist!=NULL; alist = alist->next) { Tcl_AppendStringsToObj(newAssStr, "{", ObjStr(alist->content), - "}", (char *) NULL); + "}", (char *) NULL); if (alist->next != NULL) Tcl_AppendStringsToObj(newAssStr, " ", (char *) NULL); } @@ -2763,7 +2763,7 @@ hPtr = Tcl_FindHashEntry(&aStore->procs, name); if (hPtr) { XOTclProcAssertion* procAss = - (XOTclProcAssertion*) Tcl_GetHashValue(hPtr); + (XOTclProcAssertion*) Tcl_GetHashValue(hPtr); TclObjListFreeList(procAss->pre); TclObjListFreeList(procAss->post); FREE(XOTclProcAssertion, procAss); @@ -2774,7 +2774,7 @@ static void AssertionAddProc(Tcl_Interp *in, char *name, XOTclAssertionStore* aStore, - Tcl_Obj *pre, Tcl_Obj *post) { + Tcl_Obj *pre, Tcl_Obj *post) { int nw = 0; Tcl_HashEntry* hPtr = NULL; XOTclProcAssertion *procs = NEW(XOTclProcAssertion); @@ -2828,19 +2828,19 @@ ov [1] = condition; INCR_REF_COUNT(condition); /* - fprintf(stderr, "----- evaluating condition '%s'\n", ObjStr(condition)); + fprintf(stderr, "----- evaluating condition '%s'\n", ObjStr(condition)); */ result = XOTcl_ExprObjCmd(NULL, in, 2, ov); DECR_REF_COUNT(condition); /* - fprintf(stderr, "----- running condition '%s', result=%d '%s'\n", + fprintf(stderr, "----- running condition '%s', result=%d '%s'\n", ObjStr(condition), result, ObjStr(Tcl_GetObjResult(in))); */ if (result == TCL_OK) { result = Tcl_GetIntFromObj(in,Tcl_GetObjResult(in),&success); /* - fprintf(stderr, " success=%d\n", success); + fprintf(stderr, " success=%d\n", success); */ if (result == TCL_OK && success == 0) result = XOTCL_CHECK_FAILED; @@ -2850,7 +2850,7 @@ static int AssertionCheckList(Tcl_Interp *in, XOTclObject *obj, - XOTclTclObjList* alist, char *methodName) { + XOTclTclObjList* alist, char *methodName) { XOTclTclObjList* checkFailed = NULL; Tcl_Obj *savedObjResult = Tcl_GetObjResult(in); int savedCheckoptions, acResult = TCL_OK; @@ -2880,7 +2880,7 @@ while (c != 0 && *c != '\0') { if (*c == '#') { - comment = 1; break; + comment = 1; break; } c++; } @@ -2900,7 +2900,7 @@ */ acResult = checkConditionInScope(in, alist->content); if (acResult != TCL_OK) - checkFailed = alist; + checkFailed = alist; obj->opt->checkoptions = savedCheckoptions; @@ -2920,14 +2920,14 @@ Tcl_Obj *sr = Tcl_GetObjResult(in); INCR_REF_COUNT(sr); XOTclVarErrMsg(in, "Error in Assertion: {", - ObjStr(checkFailed->content), "} in proc '", - GetSelfProc(in), "'\n\n", ObjStr(sr), (char *) NULL); + ObjStr(checkFailed->content), "} in proc '", + GetSelfProc(in), "'\n\n", ObjStr(sr), (char *) NULL); DECR_REF_COUNT(sr); return TCL_ERROR; } return XOTclVarErrMsg(in, "Assertion failed check: {", - ObjStr(checkFailed->content), "} in proc '", - GetSelfProc(in), "'", (char *) NULL); + ObjStr(checkFailed->content), "} in proc '", + GetSelfProc(in), "'", (char *) NULL); } Tcl_SetObjResult(in, savedObjResult); @@ -2937,12 +2937,12 @@ static int AssertionCheckInvars(Tcl_Interp *in, XOTclObject *obj, char *method, - CheckOptions checkoptions) { + CheckOptions checkoptions) { int result = TCL_OK; if (checkoptions & CHECK_OBJINVAR && obj->opt->assertions) { result = AssertionCheckList(in, obj, obj->opt->assertions->invariants, - method); + method); } if (result != TCL_ERROR && checkoptions & CHECK_CLINVAR) { @@ -2951,7 +2951,7 @@ while (clPtr != 0 && result != TCL_ERROR) { XOTclAssertionStore* aStore = (clPtr->cl->opt) ? clPtr->cl->opt->assertions : 0; if (aStore) { - result = AssertionCheckList(in, obj, aStore->invariants, method); + result = AssertionCheckList(in, obj, aStore->invariants, method); } clPtr = clPtr->next; } @@ -2961,7 +2961,7 @@ static int AssertionCheck(Tcl_Interp *in, XOTclObject *obj, XOTclClass *cl, - char *method, int checkOption) { + char *method, int checkOption) { XOTclProcAssertion* procs; int result = TCL_OK; XOTclAssertionStore* aStore; @@ -2978,11 +2978,11 @@ if (procs) { switch (checkOption) { case CHECK_PRE: - result = AssertionCheckList(in, obj, procs->pre, method); - break; + result = AssertionCheckList(in, obj, procs->pre, method); + break; case CHECK_POST: - result = AssertionCheckList(in, obj, procs->post, method); - break; + result = AssertionCheckList(in, obj, procs->post, method); + break; } } if (result != TCL_ERROR) @@ -3026,8 +3026,8 @@ */ static void MixinComputeOrderFullList(Tcl_Interp *in, XOTclCmdList **mixinList, - XOTclClasses **mixinClasses, - XOTclClasses **checkList, int level) { + XOTclClasses **mixinClasses, + XOTclClasses **checkList, int level) { XOTclCmdList *m; XOTclClasses *pl, **clPtr = mixinClasses; @@ -3038,35 +3038,35 @@ XOTclClass *mCl = XOTclGetClassFromCmdPtr(m->cmdPtr); if (mCl) { for (pl = ComputeOrder(mCl, mCl->order, Super); pl; pl = pl->next) { - /*fprintf(stderr, " %s, ", ObjStr(pl->cl->object.cmdName));*/ - if (!(pl->cl == RUNTIME_STATE(in)->theObject)) { - XOTclClassOpt* opt = pl->cl->opt; - if (opt && opt->instmixins != 0) { - /* compute transitively the instmixin classes of this added - class */ - XOTclClasses *cls; - int i, found=0; - for (i=0, cls = *checkList; cls; i++,cls = cls->next) { - /* fprintf(stderr,"+++ c%d: %s\n",i, - ObjStr(cls->cl->object.cmdName));*/ - if (pl->cl == cls->cl) { - found = 1; - break; - } - } - if (!found) { - XOTclAddClass(checkList, pl->cl, NULL); - /*fprintf(stderr, "+++ transitive %s\n", - ObjStr(pl->cl->object.cmdName));*/ + /*fprintf(stderr, " %s, ", ObjStr(pl->cl->object.cmdName));*/ + if (!(pl->cl == RUNTIME_STATE(in)->theObject)) { + XOTclClassOpt* opt = pl->cl->opt; + if (opt && opt->instmixins != 0) { + /* compute transitively the instmixin classes of this added + class */ + XOTclClasses *cls; + int i, found=0; + for (i=0, cls = *checkList; cls; i++,cls = cls->next) { + /* fprintf(stderr,"+++ c%d: %s\n",i, + ObjStr(cls->cl->object.cmdName));*/ + if (pl->cl == cls->cl) { + found = 1; + break; + } + } + if (!found) { + XOTclAddClass(checkList, pl->cl, NULL); + /*fprintf(stderr, "+++ transitive %s\n", + ObjStr(pl->cl->object.cmdName));*/ - MixinComputeOrderFullList(in, &opt->instmixins, mixinClasses, - checkList, level+1); - } - } - /* fprintf(stderr,"+++ add to mixinClasses %p path: %s clPtr %p\n", - mixinClasses, ObjStr(pl->cl->object.cmdName), clPtr);*/ - clPtr = XOTclAddClass(clPtr, pl->cl, m->clientData); - } + MixinComputeOrderFullList(in, &opt->instmixins, mixinClasses, + checkList, level+1); + } + } + /* fprintf(stderr,"+++ add to mixinClasses %p path: %s clPtr %p\n", + mixinClasses, ObjStr(pl->cl->object.cmdName), clPtr);*/ + clPtr = XOTclAddClass(clPtr, pl->cl, m->clientData); + } } } m = m->next; @@ -3102,15 +3102,15 @@ /* append per-obj mixins */ if (obj->opt) { MixinComputeOrderFullList(in, &obj->opt->mixins, &mixinClasses, - &checkList, 0); + &checkList, 0); } /* append per-class mixins */ for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl; pl = pl->next) { XOTclClassOpt* opt = pl->cl->opt; if (opt && opt->instmixins) { MixinComputeOrderFullList(in, &opt->instmixins, &mixinClasses, - &checkList, 0); + &checkList, 0); } } fullList = mixinClasses; @@ -3131,27 +3131,27 @@ if (checker == 0) { /* check obj->cl hierachy */ for (checker = ComputeOrder(obj->cl, obj->cl->order, Super); checker; checker = checker->next) { - if (checker->cl == mixinClasses->cl) - break; + if (checker->cl == mixinClasses->cl) + break; } /* if checker is set, it was found in the class hierarchy - and it is ignored */ + and it is ignored */ } if (checker == 0) { /* add the class to the mixinOrder list */ XOTclCmdList* new; /* fprintf(stderr,"--- adding to mixinlist %s\n", - ObjStr(mixinClasses->cl->object.cmdName));*/ + ObjStr(mixinClasses->cl->object.cmdName));*/ new = CmdListAdd(&obj->mixinOrder, mixinClasses->cl->object.id,NULL, - /*noDuplicates*/ 0); + /*noDuplicates*/ 0); /* in the client data of the order list, we require the first - matching guard ... scan the full list for it. */ + matching guard ... scan the full list for it. */ for (guardChecker = fullList; guardChecker; guardChecker = guardChecker->next) { - if (guardChecker->cl == mixinClasses->cl) { - new->clientData = guardChecker->clientData; - break; - } + if (guardChecker->cl == mixinClasses->cl) { + new->clientData = guardChecker->clientData; + break; + } } } mixinClasses = nextCl; @@ -3180,7 +3180,7 @@ guard = ovName[2]; /*fprintf(stderr,"mixinadd name = '%s', guard = '%s'\n", ObjStr(name), ObjStr(guard));*/ } /*else return XOTclVarErrMsg(in, "mixin registration '", ObjStr(name), - "' has too many elements.", (char *) NULL);*/ + "' has too many elements.", (char *) NULL);*/ } if (GetXOTclClassFromObj(in, name, &mixin, 1) != TCL_OK) @@ -3200,7 +3200,7 @@ } /* - * get all instances of a class recursively to an initialized + * get all instances of a class recursively into an initialized * String key hashtable */ static void @@ -3216,7 +3216,7 @@ int new; hPtrDest = Tcl_CreateHashEntry(destTable, ObjStr(inst->cmdName), &new); /* - fprintf (stderr, " -- %s (%s)\n", ObjStr(inst->cmdName), ObjStr(startCl->object.cmdName)); + fprintf (stderr, " -- %s (%s)\n", ObjStr(inst->cmdName), ObjStr(startCl->object.cmdName)); */ if (new && XOTclObjectIsClass(inst)) { getAllInstances(destTable, (XOTclClass*) inst); @@ -3225,27 +3225,99 @@ } /* - * recursively get all mixinofs of a class + * recursively get all mixinofs of a class into an initialized * String key hashtable */ static void getAllMixinofs(Tcl_Interp *in, Tcl_HashTable *destTable, XOTclClass *startCl) { - Tcl_HashEntry *hPtr; - XOTclClass *cl; - XOTclClassOpt *clopt; - clopt = XOTclRequireClassOpt(startCl); - register XOTclCmdList *m = clopt->mixinofs; - while (m) { + + if (startCl->opt) { + XOTclClass *cl; + XOTclCmdList *m; int new; - hPtr = Tcl_CreateHashEntry(destTable, Tcl_GetCommandName(in,m->cmdPtr), &new); - /*if (new) fprintf (stderr, " -- %s (%s)\n", Tcl_GetCommandName(in,m->cmdPtr), ObjStr(startCl->object.cmdName));*/ - cl = XOTclGetClassFromCmdPtr(m->cmdPtr); - if (cl) getAllMixinofs(in, destTable, cl); - m = m->next; + + for (m = startCl->opt->mixinofs; m; m = m->next) { + Tcl_CreateHashEntry(destTable, Tcl_GetCommandName(in,m->cmdPtr), &new); + /*if (new) fprintf (stderr, " -- %s (%s)\n", Tcl_GetCommandName(in,m->cmdPtr), ObjStr(startCl->object.cmdName));*/ + cl = XOTclGetClassFromCmdPtr(m->cmdPtr); + if (cl) { + getAllMixinofs(in, destTable, cl); + } + } } } +static void +RemoveFromInstmixinsofs(Tcl_Command cmd, XOTclCmdList *cmdlist) { + for ( ; cmdlist; cmdlist = cmdlist->next) { + XOTclClass *ncl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); + XOTclClassOpt *nclopt = ncl ? ncl->opt : NULL; + if (nclopt) { + XOTclCmdList *del = CmdListFindCmdInList(cmd, nclopt->instmixinofs); + if (del) { + /* fprintf(stderr,"Removing class %s from instmixinofs of class %s\n", + ObjStr(cl->object.cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ + del = CmdListRemoveFromList(&nclopt->instmixinofs,del); + CmdListDeleteCmdListEntry(del, GuardDel); + } + } + } +} + +static void +RemoveFromMixinofs(Tcl_Command cmd, XOTclCmdList *cmdlist) { + for ( ; cmdlist; cmdlist = cmdlist->next) { + XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); + XOTclClassOpt *clopt = cl ? cl->opt : NULL; + if (clopt) { + XOTclCmdList *del = CmdListFindCmdInList(cmd, clopt->mixinofs); + if (del) { + /* fprintf(stderr,"Removing object %s from mixinofs of Class %s\n", + ObjStr(obj->cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ + del = CmdListRemoveFromList(&clopt->mixinofs,del); + CmdListDeleteCmdListEntry(del, GuardDel); + } + } /* else fprintf(stderr,"CleanupDestroyObject %s: NULL pointer in mixins!\n",ObjStr(obj->cmdName)); */ + } +} + +static void +RemoveFromInstmixins(Tcl_Command cmd, XOTclCmdList *cmdlist) { + for ( ; cmdlist; cmdlist = cmdlist->next) { + XOTclClass *cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); + XOTclClassOpt *clopt = cl ? cl->opt : NULL; + if (clopt) { + XOTclCmdList *del = CmdListFindCmdInList(cmd, clopt->instmixins); + if (del) { + /* fprintf(stderr,"Removing class %s from mixins of object %s\n", + ObjStr(cl->object.cmdName),ObjStr(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)->cmdName)); */ + del = CmdListRemoveFromList(&clopt->instmixins, del); + CmdListDeleteCmdListEntry(del, GuardDel); + } + } + } +} + +static void +RemoveFromMixins(Tcl_Command cmd, XOTclCmdList *cmdlist) { + for ( ; cmdlist; cmdlist = cmdlist->next) { + XOTclObject *nobj = XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr); + XOTclObjectOpt *objopt = nobj ? nobj->opt : NULL; + if (objopt) { + XOTclCmdList *del = CmdListFindCmdInList(cmd, objopt->mixins); + if (del) { + /* fprintf(stderr,"Removing class %s from mixins of object %s\n", + ObjStr(cl->object.cmdName),ObjStr(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)->cmdName)); */ + del = CmdListRemoveFromList(&objopt->mixins, del); + CmdListDeleteCmdListEntry(del, GuardDel); + } + } + } +} + + + /* * if the class hierarchy or class mixins have changed -> * invalidate mixin entries in all dependent instances @@ -3274,7 +3346,7 @@ for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { XOTclObject *obj = (XOTclObject*) - Tcl_GetHashKey(&clPtr->cl->instances, hPtr); + Tcl_GetHashKey(&clPtr->cl->instances, hPtr); MixinResetOrder(obj); obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; } @@ -3284,7 +3356,8 @@ cl->order = saved; #if 1 /* invalidate the mixins on all instances that have this mixin (cl) - at the moment */ + at the moment + */ Tcl_InitHashTable(commandTable, TCL_STRING_KEYS); MEM_COUNT_ALLOC("Tcl_InitHashTable",commandTable); /*getAllInstances(commandTable, RUNTIME_STATE(in)->theClass);*/ @@ -3295,16 +3368,16 @@ obj = XOTclpGetObject(in, key); if (obj && !XOTclObjectIsClass(obj) - && !(obj->flags & XOTCL_DESTROY_CALLED) - && (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID)) { + && !(obj->flags & XOTCL_DESTROY_CALLED) + && (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID)) { XOTclCmdList *ml; for (ml = obj->mixinOrder; ml; ml = ml->next) { - XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); - if (mixin == cl) { - MixinResetOrder(obj); - obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; - break; - } + XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); + if (mixin == cl) { + MixinResetOrder(obj); + obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; + break; + } } } hPtr = Tcl_NextHashEntry(&hSrch); @@ -3313,7 +3386,7 @@ Tcl_DeleteHashTable(commandTable); #endif } - static int MixinInfo(Tcl_Interp *in, XOTclCmdList* m, char *pattern, int withGuards); +static int MixinInfo(Tcl_Interp *in, XOTclCmdList* m, char *pattern, int withGuards); /* * the mixin order is either * DEFINED (there are mixins on the instance), @@ -3349,29 +3422,29 @@ currentCmdPtr = obj->mixinStack->currentCmdPtr; /* - { + { XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; XOTclCallStackContent *csc = cs->top; fprintf(stderr, "%p == %p ==> %d \n", csc->cl, currentCmdPtr, csc->cmdPtr == currentCmdPtr); - } + } */ /*** - { Tcl_Obj *sr; + { Tcl_Obj *sr; - MixinInfo(in, obj->mixinOrder, NULL,0); - sr = Tcl_GetObjResult(in); - fprintf(stderr,"INFO->%s order %p next %p\n",ObjStr(sr), obj->mixinOrder, obj->mixinOrder->next); - } + MixinInfo(in, obj->mixinOrder, NULL,0); + sr = Tcl_GetObjResult(in); + fprintf(stderr,"INFO->%s order %p next %p\n",ObjStr(sr), obj->mixinOrder, obj->mixinOrder->next); + } ***/ *cmdList = obj->mixinOrder; /* - fprintf(stderr, "->1 mixin seek current = %p next = %p %s\n", - currentCmdPtr, - (*cmdList)->next, - (*cmdList)->next ? Tcl_GetCommandName(in, (*cmdList)->next->cmdPtr) : ""); + fprintf(stderr, "->1 mixin seek current = %p next = %p %s\n", + currentCmdPtr, + (*cmdList)->next, + (*cmdList)->next ? Tcl_GetCommandName(in, (*cmdList)->next->cmdPtr) : ""); */ #if defined(ACTIVEMIXIN) @@ -3399,54 +3472,54 @@ */ static Tcl_Command MixinSearchProc(Tcl_Interp *in, XOTclObject *obj, char *methodName, - XOTclClass **cl, Tcl_ObjCmdProc **proc, ClientData* cp, - Tcl_Command* currentCmdPtr) { + XOTclClass **cl, Tcl_ObjCmdProc **proc, ClientData* cp, + Tcl_Command* currentCmdPtr) { Tcl_Command cmd = NULL; XOTclCmdList *cmdList; XOTclClass *cls; - + assert(obj); assert(obj->mixinStack); - + MixinSeekCurrent(in, obj, &cmdList); - + /* fprintf(stderr, "MixinSearch searching for '%s' %p\n", methodName,cmdList); */ /*CmdListPrint(in,"MixinSearch CL = \n", cmdList);*/ - + while (cmdList) { if (Tcl_Command_cmdEpoch(cmdList->cmdPtr)) { cmdList = cmdList->next; } else { cls = XOTclGetClassFromCmdPtr(cmdList->cmdPtr); /* - fprintf(stderr,"+++ MixinSearch %s->%s in %p cmdPtr %p clientData %p\n", + fprintf(stderr,"+++ MixinSearch %s->%s in %p cmdPtr %p clientData %p\n", ObjStr(obj->cmdName),methodName, cmdList, cmdList->cmdPtr, cmdList->clientData); */ if (cls) { - int guardOk = TCL_OK; - cmd = FindMethod(methodName, cls->nsPtr); - if (cmd && cmdList->clientData) { - if (!RUNTIME_STATE(in)->cs.guardCount) { - guardOk = GuardCall(obj, cls, (Tcl_Command) cmd, in, cmdList->clientData, 1); - } - } - if (cmd && guardOk == TCL_OK) { - /* - * on success: compute mixin call data - */ - *cl = cls; - *proc = Tcl_Command_objProc(cmd); - *cp = Tcl_Command_objClientData(cmd); - *currentCmdPtr = cmdList->cmdPtr; - break; + int guardOk = TCL_OK; + cmd = FindMethod(methodName, cls->nsPtr); + if (cmd && cmdList->clientData) { + if (!RUNTIME_STATE(in)->cs.guardCount) { + guardOk = GuardCall(obj, cls, (Tcl_Command) cmd, in, cmdList->clientData, 1); + } + } + if (cmd && guardOk == TCL_OK) { + /* + * on success: compute mixin call data + */ + *cl = cls; + *proc = Tcl_Command_objProc(cmd); + *cp = Tcl_Command_objClientData(cmd); + *currentCmdPtr = cmdList->cmdPtr; + break; } else { - cmd = NULL; - cmdList = cmdList->next; - } + cmd = NULL; + cmdList = cmdList->next; + } } } } @@ -3465,17 +3538,17 @@ /* fprintf(stderr," mixin info m=%p, next=%p\n",m,m->next); */ mixinClass = XOTclGetClassFromCmdPtr(m->cmdPtr); if (mixinClass && - (!pattern || - Tcl_StringMatch(ObjStr(mixinClass->object.cmdName), pattern))) { + (!pattern || + Tcl_StringMatch(ObjStr(mixinClass->object.cmdName), pattern))) { if (withGuards && m->clientData) { - Tcl_Obj *l = Tcl_NewListObj(0, NULL); - Tcl_Obj *g = (Tcl_Obj*) m->clientData; - Tcl_ListObjAppendElement(in, l, mixinClass->object.cmdName); - Tcl_ListObjAppendElement(in, l, XOTclGlobalObjects[XOTE_GUARD_OPTION]); - Tcl_ListObjAppendElement(in, l, g); - Tcl_ListObjAppendElement(in, list, l); + Tcl_Obj *l = Tcl_NewListObj(0, NULL); + Tcl_Obj *g = (Tcl_Obj*) m->clientData; + Tcl_ListObjAppendElement(in, l, mixinClass->object.cmdName); + Tcl_ListObjAppendElement(in, l, XOTclGlobalObjects[XOTE_GUARD_OPTION]); + Tcl_ListObjAppendElement(in, l, g); + Tcl_ListObjAppendElement(in, list, l); } else - Tcl_ListObjAppendElement(in, list, mixinClass->object.cmdName); + Tcl_ListObjAppendElement(in, list, mixinClass->object.cmdName); } m = m->next; } @@ -3485,7 +3558,7 @@ /* * info option for mixinofs and instmixinofs - */ + */ static int MixinOfInfo(Tcl_Interp *in, XOTclCmdList* m, char *pattern) { @@ -3495,9 +3568,9 @@ /* fprintf(stderr," mixinof info m=%p, next=%p\n",m,m->next); */ mixinObject = XOTclGetObjectFromCmdPtr(m->cmdPtr); if (mixinObject && - (!pattern || - Tcl_StringMatch(ObjStr(mixinObject->cmdName), pattern))) { - Tcl_ListObjAppendElement(in, list, mixinObject->cmdName); + (!pattern || + Tcl_StringMatch(ObjStr(mixinObject->cmdName), pattern))) { + Tcl_ListObjAppendElement(in, list, mixinObject->cmdName); } m = m->next; } @@ -3537,7 +3610,7 @@ static Tcl_Command FilterSearch(Tcl_Interp *in, char *name, XOTclObject *startingObj, - XOTclClass *startingCl, XOTclClass **cl) { + XOTclClass *startingCl, XOTclClass **cl) { Tcl_Command cmd = NULL; if (startingObj) { @@ -3554,7 +3627,7 @@ */ if (opt && opt->mixins) { if ((cmd = MixinSearchMethodByName(in, opt->mixins, name, cl))) { - return cmd; + return cmd; } } } @@ -3566,7 +3639,7 @@ XOTclClassOpt* opt = startingCl->opt; if (opt && opt->instmixins) { if ((cmd = MixinSearchMethodByName(in, opt->instmixins, name, cl))) { - return cmd; + return cmd; } } } @@ -3633,27 +3706,27 @@ /* fprintf(stderr, " +++ ERROR\n");*/ XOTclVarErrMsg(in, "Guard Error: '", ObjStr(guard), "'\n\n", - ObjStr(sr), (char *) NULL); + ObjStr(sr), (char *) NULL); DECR_REF_COUNT(sr); return TCL_ERROR; } } /* - fprintf(stderr, " +++ FAILED\n"); + fprintf(stderr, " +++ FAILED\n"); */ return XOTCL_CHECK_FAILED; } /* -static void -GuardPrint(Tcl_Interp *in, ClientData clientData) { + static void + GuardPrint(Tcl_Interp *in, ClientData clientData) { Tcl_Obj *guard = (TclObj*) clientData; fprintf(stderr, " +++ \n"); if (guard) { - fprintf(stderr, " * %s \n", ObjStr(guard)); + fprintf(stderr, " * %s \n", ObjStr(guard)); } fprintf(stderr, " +++ \n"); -} + } */ static void @@ -3674,24 +3747,24 @@ INCR_REF_COUNT(guard); CL->clientData = (ClientData) guard; /*fprintf(stderr,"guard added to %p cmdPtr=%p, clientData= %p\n", - CL, CL->cmdPtr, CL->clientData); + CL, CL->cmdPtr, CL->clientData); */ } } } /* -static void -GuardAddList(Tcl_Interp *in, XOTclCmdList* dest, ClientData source) { + static void + GuardAddList(Tcl_Interp *in, XOTclCmdList* dest, ClientData source) { XOTclTclObjList* s = (XOTclTclObjList*) source; while (s) { - GuardAdd(in, dest, (Tcl_Obj*) s->content); - s = s->next; + GuardAdd(in, dest, (Tcl_Obj*) s->content); + s = s->next; } -} */ + } */ static int GuardCall(XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd, - Tcl_Interp *in, ClientData clientData, int push) { + Tcl_Interp *in, ClientData clientData, int push) { int rc = TCL_OK; if (clientData) { @@ -3721,8 +3794,8 @@ static int GuardAddFromDefinitionList(Tcl_Interp *in, XOTclCmdList* dest, - XOTclObject *obj, Tcl_Command interceptorCmd, - XOTclCmdList* interceptorDefList) { + XOTclObject *obj, Tcl_Command interceptorCmd, + XOTclCmdList* interceptorDefList) { XOTclCmdList* h; if (interceptorDefList != 0) { h = CmdListFindCmdInList(interceptorCmd, interceptorDefList); @@ -3742,7 +3815,7 @@ static void GuardAddInheritedGuards(Tcl_Interp *in, XOTclCmdList* dest, - XOTclObject *obj, Tcl_Command filterCmd) { + XOTclObject *obj, Tcl_Command filterCmd) { XOTclClasses* pl; int guardAdded = 0; XOTclObjectOpt *opt; @@ -3756,8 +3829,8 @@ while (ml && ! guardAdded) { mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); if (mixin && mixin->opt) { - guardAdded = GuardAddFromDefinitionList(in, dest, obj, filterCmd, - mixin->opt->instfilters); + guardAdded = GuardAddFromDefinitionList(in, dest, obj, filterCmd, + mixin->opt->instfilters); } ml = ml->next; } @@ -3774,8 +3847,8 @@ for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); !guardAdded && pl; pl = pl->next) { XOTclClassOpt* opt = pl->cl->opt; if (opt) { - guardAdded = GuardAddFromDefinitionList(in, dest, obj, filterCmd, - opt->instfilters); + guardAdded = GuardAddFromDefinitionList(in, dest, obj, filterCmd, + opt->instfilters); } } @@ -3791,10 +3864,10 @@ */ if (!guardAdded) { XOTclCmdList* registeredFilter = - CmdListFindNameInList(in,(char *) Tcl_GetCommandName(in, filterCmd), - obj->filterOrder); + CmdListFindNameInList(in,(char *) Tcl_GetCommandName(in, filterCmd), + obj->filterOrder); if (registeredFilter) { - GuardAdd(in, dest, (Tcl_Obj*) registeredFilter->clientData); + GuardAdd(in, dest, (Tcl_Obj*) registeredFilter->clientData); } } } @@ -3810,28 +3883,28 @@ /* maybe it is a qualified name */ Tcl_Command cmd = NSFindCommand(in, interceptorName, NULL); if (cmd) { - h = CmdListFindCmdInList(cmd, frl); + h = CmdListFindCmdInList(cmd, frl); } } if (h) { Tcl_ResetResult(in); if (h->clientData) { - Tcl_Obj *g = (Tcl_Obj*) h->clientData; - Tcl_SetObjResult(in, g); + Tcl_Obj *g = (Tcl_Obj*) h->clientData; + Tcl_SetObjResult(in, g); } return TCL_OK; } } return XOTclVarErrMsg(in, "info (*)guard: can't find filter/mixin ", - interceptorName, (char *) NULL); + interceptorName, (char *) NULL); } /* * append a filter command to the 'filterList' of an obj/class */ static int FilterAdd(Tcl_Interp *in, XOTclCmdList **filterList, Tcl_Obj *name, - XOTclObject *startingObj, XOTclClass *startingCl) { + XOTclObject *startingObj, XOTclClass *startingCl) { Tcl_Command cmd; int ocName; Tcl_Obj **ovName; Tcl_Obj *guard = NULL; @@ -3848,12 +3921,12 @@ if (!(cmd = FilterSearch(in, ObjStr(name), startingObj, startingCl, &cl))) { if (startingObj) return XOTclVarErrMsg(in, "filter: can't find filterproc on: ", - ObjStr(startingObj->cmdName), " - proc: ", - ObjStr(name), (char *) NULL); + ObjStr(startingObj->cmdName), " - proc: ", + ObjStr(name), (char *) NULL); else return XOTclVarErrMsg(in, "instfilter: can't find filterproc on: ", - ObjStr(startingCl->object.cmdName), " - proc: ", - ObjStr(name), (char *) NULL); + ObjStr(startingCl->object.cmdName), " - proc: ", + ObjStr(name), (char *) NULL); } /*fprintf(stderr, " +++ adding filter %s cl %p\n", ObjStr(name),cl);*/ @@ -3886,7 +3959,7 @@ */ static void FilterSearchAgain(Tcl_Interp *in, XOTclCmdList **filters, - XOTclObject *startingObj, XOTclClass *startingCl) { + XOTclObject *startingObj, XOTclClass *startingCl) { char *simpleName; Tcl_Command cmd; XOTclCmdList *cmdList, *del; @@ -3904,13 +3977,13 @@ CmdListDeleteCmdListEntry(del, GuardDel); } else { if (cmd != cmdList->cmdPtr) - CmdListReplaceCmd(cmdList, cmd, cl); + CmdListReplaceCmd(cmdList, cmd, cl); cmdList = cmdList->next; } } /* some entries might be NULL now, if they are not found anymore -> delete those - CmdListRemoveNulledEntries(filters, GuardDel); + CmdListRemoveNulledEntries(filters, GuardDel); */ } @@ -3944,7 +4017,7 @@ /* recalculate the commands of all object filter registrations */ if (obj->opt) { - FilterSearchAgain(in, &obj->opt->filters, obj, 0); + FilterSearchAgain(in, &obj->opt->filters, obj, 0); } } clPtr = clPtr->next; @@ -3978,7 +4051,7 @@ for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { XOTclObject *obj = (XOTclObject*) Tcl_GetHashKey(&clPtr->cl->instances, hPtr); if (obj->opt) { - CmdListRemoveContextClassFromList(&obj->opt->filters,removeClass, GuardDel); + CmdListRemoveContextClassFromList(&obj->opt->filters,removeClass, GuardDel); } } } @@ -3994,7 +4067,7 @@ */ static Tcl_Obj* getFullProcQualifier(Tcl_Interp *in, CONST84 char *cmdName, - XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd) { + XOTclObject *obj, XOTclClass *cl, Tcl_Command cmd) { Tcl_Obj *list = Tcl_NewListObj(0, NULL); Tcl_Obj *procObj = Tcl_NewStringObj(cmdName, -1); Tcl_ObjCmdProc *objProc = Tcl_Command_objProc(cmd); @@ -4012,7 +4085,7 @@ } else if (objProc == XOTclSetterMethod) { Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_INSTPARAMETERCMD]); } else { - Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_INSTCMD]); + Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_INSTCMD]); } } else { Tcl_ListObjAppendElement(in, list, obj->cmdName); @@ -4037,7 +4110,7 @@ */ static int FilterInfo(Tcl_Interp *in, XOTclCmdList* f, char *pattern, - int withGuards, int fullProcQualifiers) { + int withGuards, int fullProcQualifiers) { CONST84 char *simpleName; Tcl_Obj *list = Tcl_NewListObj(0, NULL); @@ -4052,30 +4125,30 @@ simpleName = Tcl_GetCommandName(in, f->cmdPtr); if (!pattern || Tcl_StringMatch(simpleName, pattern)) { if (withGuards && f->clientData) { - Tcl_Obj *innerList = Tcl_NewListObj(0, NULL); - Tcl_Obj *g = (Tcl_Obj*) f->clientData; - Tcl_ListObjAppendElement(in, innerList, - Tcl_NewStringObj(simpleName, -1)); - Tcl_ListObjAppendElement(in, innerList, XOTclGlobalObjects[XOTE_GUARD_OPTION]); - Tcl_ListObjAppendElement(in, innerList, g); - Tcl_ListObjAppendElement(in, list, innerList); + Tcl_Obj *innerList = Tcl_NewListObj(0, NULL); + Tcl_Obj *g = (Tcl_Obj*) f->clientData; + Tcl_ListObjAppendElement(in, innerList, + Tcl_NewStringObj(simpleName, -1)); + Tcl_ListObjAppendElement(in, innerList, XOTclGlobalObjects[XOTE_GUARD_OPTION]); + Tcl_ListObjAppendElement(in, innerList, g); + Tcl_ListObjAppendElement(in, list, innerList); } else { - if (fullProcQualifiers) { + if (fullProcQualifiers) { XOTclClass *fcl; - XOTclObject *fobj; - if (f->clorobj && !XOTclObjectIsClass(&f->clorobj->object)) { - fobj = (XOTclObject *)f->clorobj; - fcl = NULL; - } else { - fobj = NULL; - fcl = f->clorobj; - } - Tcl_ListObjAppendElement(in, list, - getFullProcQualifier(in, simpleName, - fobj, fcl, f->cmdPtr)); - } else { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(simpleName, -1)); - } + XOTclObject *fobj; + if (f->clorobj && !XOTclObjectIsClass(&f->clorobj->object)) { + fobj = (XOTclObject *)f->clorobj; + fcl = NULL; + } else { + fobj = NULL; + fcl = f->clorobj; + } + Tcl_ListObjAppendElement(in, list, + getFullProcQualifier(in, simpleName, + fobj, fcl, f->cmdPtr)); + } else { + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(simpleName, -1)); + } } } f = f->next; @@ -4090,7 +4163,7 @@ */ static void FilterComputeOrderFullList(Tcl_Interp *in, XOTclCmdList **filters, - XOTclCmdList **filterList) { + XOTclCmdList **filterList) { XOTclCmdList *f ; char *simpleName; XOTclClass *fcl; @@ -4117,18 +4190,18 @@ if (fcl) { pl = ComputeOrder(fcl, fcl->order, Super); if (pl && pl->next) { - /* don't search on the start class again */ - pl = pl->next; - /* now go up the hierarchy */ - for(; pl; pl = pl->next) { - Tcl_Command pi = FindMethod(simpleName, pl->cl->nsPtr); - if (pi) { - CmdListAdd(filterList, pi, pl->cl, /*noDuplicates*/ 0); - /* - fprintf(stderr, " %s::%s, ", ObjStr(pl->cl->object.cmdName), simpleName); - */ - } - } + /* don't search on the start class again */ + pl = pl->next; + /* now go up the hierarchy */ + for(; pl; pl = pl->next) { + Tcl_Command pi = FindMethod(simpleName, pl->cl->nsPtr); + if (pi) { + CmdListAdd(filterList, pi, pl->cl, /*noDuplicates*/ 0); + /* + fprintf(stderr, " %s::%s, ", ObjStr(pl->cl->object.cmdName), simpleName); + */ + } + } } } } @@ -4149,7 +4222,7 @@ if (obj->filterOrder) FilterResetOrder(obj); /* - fprintf(stderr, " List: ", ObjStr(obj->cmdName)); + fprintf(stderr, " List: ", ObjStr(obj->cmdName)); */ /* append instfilters registered for mixins */ @@ -4162,7 +4235,7 @@ while (ml) { mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); if (mixin && mixin->opt && mixin->opt->instfilters) - FilterComputeOrderFullList(in, &mixin->opt->instfilters, &filterList); + FilterComputeOrderFullList(in, &mixin->opt->instfilters, &filterList); ml = ml->next; } } @@ -4180,7 +4253,7 @@ } /* - fprintf(stderr, "\n"); + fprintf(stderr, "\n"); */ /* use no duplicates & no classes of the precedence order on the resulting list */ @@ -4192,13 +4265,13 @@ } if (checker == 0) { newlist = CmdListAdd(&obj->filterOrder, filterList->cmdPtr, filterList->clorobj, - /*noDuplicates*/ 0); + /*noDuplicates*/ 0); GuardAddInheritedGuards(in, newlist, obj, filterList->cmdPtr); /* - fprintf(stderr, " Adding %s::%s,\n", filterList->cmdPtr->nsPtr->fullName, Tcl_GetCommandName(in, filterList->cmdPtr)); + fprintf(stderr, " Adding %s::%s,\n", filterList->cmdPtr->nsPtr->fullName, Tcl_GetCommandName(in, filterList->cmdPtr)); */ /* - GuardPrint(in, newlist->clientData); + GuardPrint(in, newlist->clientData); */ } @@ -4208,7 +4281,7 @@ filterList = next; } /* - fprintf(stderr, "\n"); + fprintf(stderr, "\n"); */ } @@ -4271,7 +4344,7 @@ assert(obj->flags & XOTCL_FILTER_ORDER_VALID); /* ensure that the filter order is not invalid, otherwise compute order - FilterComputeDefined(in, obj); + FilterComputeDefined(in, obj); */ *cmdList = obj->filterOrder; @@ -4297,7 +4370,7 @@ /* only check the callstack entries for this object && only check the callstack entries for the given cmd */ if (obj == csc->self && cmd == csc->cmdPtr && - csc->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { + csc->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { return 1; } csc--; @@ -4324,7 +4397,7 @@ Tcl_ListObjAppendElement(in, list, obj->cmdName); Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_FILTER]); Tcl_ListObjAppendElement(in, list, - Tcl_NewStringObj(Tcl_GetCommandName(in, cmd), -1)); + Tcl_NewStringObj(Tcl_GetCommandName(in, cmd), -1)); return list; } @@ -4333,11 +4406,11 @@ XOTclClassOpt* opt = pl->cl->opt; if (opt && opt->instfilters) { if (CmdListFindCmdInList(cmd, opt->instfilters)) { - Tcl_ListObjAppendElement(in, list, pl->cl->object.cmdName); - Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_INSTFILTER]); - Tcl_ListObjAppendElement(in, list, - Tcl_NewStringObj(Tcl_GetCommandName(in, cmd), -1)); - return list; + Tcl_ListObjAppendElement(in, list, pl->cl->object.cmdName); + Tcl_ListObjAppendElement(in, list, XOTclGlobalObjects[XOTE_INSTFILTER]); + Tcl_ListObjAppendElement(in, list, + Tcl_NewStringObj(Tcl_GetCommandName(in, cmd), -1)); + return list; } } } @@ -4350,7 +4423,7 @@ */ static Tcl_Command FilterSearchProc(Tcl_Interp *in, XOTclObject *obj, Tcl_ObjCmdProc **proc, ClientData* cp, - Tcl_Command* currentCmd, XOTclClass **cl) { + Tcl_Command* currentCmd, XOTclClass **cl) { XOTclCmdList *cmdList; assert(obj); @@ -4366,7 +4439,7 @@ cmdList = cmdList->next; } else if (FilterActiveOnObj(in, obj, cmdList->cmdPtr)) { /* fprintf(stderr, "Filter <%s> -- Active on: %s\n", - Tcl_GetCommandName(in, (Tcl_Command)cmdList->cmdPtr), ObjStr(obj->cmdName)); + Tcl_GetCommandName(in, (Tcl_Command)cmdList->cmdPtr), ObjStr(obj->cmdName)); */ obj->filterStack->currentCmdPtr = cmdList->cmdPtr; FilterSeekCurrent(in, obj, &cmdList); @@ -4375,13 +4448,13 @@ *proc = Tcl_Command_objProc(cmdList->cmdPtr); *cp = Tcl_Command_objClientData(cmdList->cmdPtr); if (cmdList->clorobj && !XOTclObjectIsClass(&cmdList->clorobj->object)) { - *cl = NULL; + *cl = NULL; } else { - *cl = cmdList->clorobj; + *cl = cmdList->clorobj; } *currentCmd = cmdList->cmdPtr; /* fprintf(stderr, "FilterSearchProc - found: %s, %p\n", - Tcl_GetCommandName(in, (Tcl_Command)cmdList->cmdPtr), cmdList->cmdPtr); + Tcl_GetCommandName(in, (Tcl_Command)cmdList->cmdPtr), cmdList->cmdPtr); */ return cmdList->cmdPtr; } @@ -4422,7 +4495,7 @@ if (GetXOTclClassFromObj(in, ov[i], &scl[i], 1) != TCL_OK) { FREE(XOTclClass**, scl); return XOTclErrBadVal(in, "superclass", "a list of classes", - ObjStr(arg)); + ObjStr(arg)); } } @@ -4445,7 +4518,7 @@ if (reversed != 0) { return XOTclErrBadVal(in, "superclass", "classes in dependence order", - ObjStr(arg)); + ObjStr(arg)); } while (cl->super != 0) { @@ -4493,7 +4566,7 @@ static int varExists(Tcl_Interp *in, XOTclObject *obj, char *varName, char *index, - int triggerTrace, int requireDefined) { + int triggerTrace, int requireDefined) { XOTcl_FrameDecls; Var *varPtr, *arrayPtr; int result; @@ -4503,20 +4576,20 @@ if (obj->nsPtr) { Tcl_SetNamespaceResolvers(obj->nsPtr, (Tcl_ResolveCmdProc*)NULL, - varResolver, (Tcl_ResolveCompiledVarProc*)NULL); + varResolver, (Tcl_ResolveCompiledVarProc*)NULL); } XOTcl_PushFrame(in, obj); #if defined(PRE83) varPtr = TclLookupVar(in, varName, index, flags, "access", - /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); #else if (triggerTrace) varPtr = TclVarTraceExists(in, varName); else varPtr = TclLookupVar(in, varName, index, flags, "access", - /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); + /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr); #endif result = ((varPtr != NULL) && (!requireDefined || !TclIsVarUndefined(varPtr))); @@ -4525,8 +4598,8 @@ if (obj->nsPtr) { Tcl_SetNamespaceResolvers(obj->nsPtr, (Tcl_ResolveCmdProc*)NULL, - (Tcl_ResolveVarProc *)NULL, - (Tcl_ResolveCompiledVarProc*)NULL); + (Tcl_ResolveVarProc *)NULL, + (Tcl_ResolveCompiledVarProc*)NULL); } return result; } @@ -4537,9 +4610,9 @@ #if defined(PRE85) # if FORWARD_COMPATIBLE if (forwardCompatibleMode) { - *varNameObj = VarHashGetKey(*val); + *varNameObj = VarHashGetKey(*val); } else { - *varNameObj = Tcl_NewStringObj(Tcl_GetHashKey(hPtr->tablePtr, hPtr),-1); + *varNameObj = Tcl_NewStringObj(Tcl_GetHashKey(hPtr->tablePtr, hPtr),-1); } # else *varNameObj = Tcl_NewStringObj(Tcl_GetHashKey(hPtr->tablePtr, hPtr),-1); @@ -4580,54 +4653,54 @@ INCR_REF_COUNT(varNameObj); if (TclIsVarScalar(val)) { - Tcl_Obj *oldValue = XOTclOGetInstVar2((XOTcl_Object*) obj, - in, varNameObj, NULL, - TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); - /** we check whether the variable is already set. - if so, we do not set it again */ - if (oldValue == NULL) { + Tcl_Obj *oldValue = XOTclOGetInstVar2((XOTcl_Object*) obj, + in, varNameObj, NULL, + TCL_LEAVE_ERR_MSG|TCL_PARSE_PART1); + /** we check whether the variable is already set. + if so, we do not set it again */ + if (oldValue == NULL) { Tcl_Obj *valueObj = valueOfVar(Tcl_Obj,val,objPtr); - char *value = ObjStr(valueObj), *v; - int doSubst = 0; - for (v=value; *v; v++) { - if (*v == '[' && doSubst == 0) - doSubst = 1; - else if ((doSubst == 1 && *v == ']') || *v == '$') { - doSubst = 2; - break; - } - } - if (doSubst == 2) { /* we have to subst */ - Tcl_Obj *ov[2]; - int rc = CallStackPush(in, obj, cmdCl, 0, 1, - &varNameObj, XOTCL_CSC_TYPE_PLAIN); - if (rc != TCL_OK) { - DECR_REF_COUNT(varNameObj); - return rc; - } - ov[1] = valueObj; - Tcl_ResetResult(in); - rc = XOTcl_SubstObjCmd(NULL, in, 2, ov); - CallStackPop(in); - if (rc == TCL_OK) { - valueObj = Tcl_GetObjResult(in); - } else { - DECR_REF_COUNT(varNameObj); - return rc; - } - } - /*fprintf(stderr,"calling %s value='%s'\n", - ObjStr(varNameObj),ObjStr(valueObj));*/ - INCR_REF_COUNT(valueObj); - result = XOTclCallMethodWithArgs((ClientData)obj, in, - varNameObj, valueObj, 1, 0, 0); - DECR_REF_COUNT(valueObj); + char *value = ObjStr(valueObj), *v; + int doSubst = 0; + for (v=value; *v; v++) { + if (*v == '[' && doSubst == 0) + doSubst = 1; + else if ((doSubst == 1 && *v == ']') || *v == '$') { + doSubst = 2; + break; + } + } + if (doSubst == 2) { /* we have to subst */ + Tcl_Obj *ov[2]; + int rc = CallStackPush(in, obj, cmdCl, 0, 1, + &varNameObj, XOTCL_CSC_TYPE_PLAIN); + if (rc != TCL_OK) { + DECR_REF_COUNT(varNameObj); + return rc; + } + ov[1] = valueObj; + Tcl_ResetResult(in); + rc = XOTcl_SubstObjCmd(NULL, in, 2, ov); + CallStackPop(in); + if (rc == TCL_OK) { + valueObj = Tcl_GetObjResult(in); + } else { + DECR_REF_COUNT(varNameObj); + return rc; + } + } + /*fprintf(stderr,"calling %s value='%s'\n", + ObjStr(varNameObj),ObjStr(valueObj));*/ + INCR_REF_COUNT(valueObj); + result = XOTclCallMethodWithArgs((ClientData)obj, in, + varNameObj, valueObj, 1, 0, 0); + DECR_REF_COUNT(valueObj); - if (result != TCL_OK) { - DECR_REF_COUNT(varNameObj); - return result; - } - } + if (result != TCL_OK) { + DECR_REF_COUNT(varNameObj); + return result; + } + } } DECR_REF_COUNT(varNameObj); } @@ -4639,7 +4712,7 @@ Tcl_HashEntry* hPtr = tablePtr ? Tcl_FirstHashEntry(VarHashTable(tablePtr), &hSrch) : 0; /*fprintf(stderr, "+++ we have initcmds for <%s>\n", className(targetClass));*/ - /* iterate over the elements of initcmds */ + /* iterate over the elements of initcmds */ for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { Var *val; Tcl_Obj *varNameObj; @@ -4652,32 +4725,32 @@ ObjStr(varNameObj), varExists(in, obj, ObjStr(varNameObj), NULL, 0, 0));*/ if (TclIsVarScalar(val) && - (!varExists(in, obj, ObjStr(varNameObj), NULL, 0, 0) || - varExists(in, &targetClass->object, "__defaults", ObjStr(varNameObj), 0,0) - )) { - Tcl_Obj *valueObj = valueOfVar(Tcl_Obj,val,objPtr); - char *string = ObjStr(valueObj); - int rc; - XOTcl_FrameDecls; - if (*string) { - XOTcl_PushFrame(in, obj); /* make instvars accessible */ - CallStackPush(in, obj, cmdCl, 0, 1, - &varNameObj, XOTCL_CSC_TYPE_PLAIN); /*allow to call self*/ + (!varExists(in, obj, ObjStr(varNameObj), NULL, 0, 0) || + varExists(in, &targetClass->object, "__defaults", ObjStr(varNameObj), 0,0) + )) { + Tcl_Obj *valueObj = valueOfVar(Tcl_Obj,val,objPtr); + char *string = ObjStr(valueObj); + int rc; + XOTcl_FrameDecls; + if (*string) { + XOTcl_PushFrame(in, obj); /* make instvars accessible */ + CallStackPush(in, obj, cmdCl, 0, 1, + &varNameObj, XOTCL_CSC_TYPE_PLAIN); /*allow to call self*/ - /*fprintf(stderr,"evaluating '%s' obj=%s\n\n",ObjStr(valueObj),ObjStr(obj->cmdName)); - XOTclCallStackDump(in);*/ + /*fprintf(stderr,"evaluating '%s' obj=%s\n\n",ObjStr(valueObj),ObjStr(obj->cmdName)); + XOTclCallStackDump(in);*/ - rc = Tcl_EvalObjEx(in, valueObj, TCL_EVAL_DIRECT); - CallStackPop(in); - XOTcl_PopFrame(in, obj); - if (rc != TCL_OK) { - DECR_REF_COUNT(varNameObj); - return rc; - } - /* fprintf(stderr,"... varexists(%s->%s) = %d\n", - ObjStr(obj->cmdName), - varName, varExists(in, obj, varName, NULL, 0, 0)); */ - } + rc = Tcl_EvalObjEx(in, valueObj, TCL_EVAL_DIRECT); + CallStackPop(in); + XOTcl_PopFrame(in, obj); + if (rc != TCL_OK) { + DECR_REF_COUNT(varNameObj); + return rc; + } + /* fprintf(stderr,"... varexists(%s->%s) = %d\n", + ObjStr(obj->cmdName), + varName, varExists(in, obj, varName, NULL, 0, 0)); */ + } } DECR_REF_COUNT(varNameObj); } @@ -4744,7 +4817,7 @@ static int callParameterMethodWithArg(XOTclObject *obj, Tcl_Interp *in, Tcl_Obj *method, - Tcl_Obj *arg, int objc, Tcl_Obj *CONST objv[], int flags) { + Tcl_Obj *arg, int objc, Tcl_Obj *CONST objv[], int flags) { XOTclClassOpt* opt = obj->cl->opt; Tcl_Obj *pcl = XOTclGlobalObjects[XOTE_PARAM_CL]; XOTclClass *paramCl; @@ -4754,7 +4827,7 @@ if (GetXOTclClassFromObj(in,pcl,¶mCl, 1) == TCL_OK) { result = XOTclCallMethodWithArgs((ClientData)paramCl, in, - method, arg, objc-2, objv, flags); + method, arg, objc-2, objv, flags); } else result = XOTclVarErrMsg(in, "create: can't find parameter class", @@ -4770,7 +4843,7 @@ /* actually call a method (with assertion checking) */ static int callProcCheck(ClientData cp, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[], - Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, + Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, char *methodName, int frameType, int isTclProc) { int result = TCL_OK; XOTclRuntimeState *rst = RUNTIME_STATE(in); @@ -4791,15 +4864,15 @@ methodName, obj, ObjStr(obj->cmdName));*/ /* - fprintf(stderr,"*** callProcCheck: cmd = %p\n",cmd); - fprintf(stderr, + fprintf(stderr,"*** callProcCheck: cmd = %p\n",cmd); + fprintf(stderr, "cp=%p, isTclProc=%d %p %s, dispatch=%d %p, forward=%d %p, scoped %p, ov[0]=%p oc=%d\n", cp, isTclProc, cmd, Tcl_GetCommandName(in, cmd), Tcl_Command_objProc(cmd) == XOTclObjDispatch, XOTclObjDispatch, Tcl_Command_objProc(cmd) == XOTclForwardMethod, XOTclForwardMethod, - XOTclObjscopedMethod, + XOTclObjscopedMethod, objv[0], objc );*/ @@ -4812,8 +4885,8 @@ co = 0; if (obj->opt) co = obj->opt->checkoptions; if ((co & CHECK_INVAR) && - ((result = AssertionCheckInvars(in, obj, methodName, co)) == TCL_ERROR)) { - goto finish; + ((result = AssertionCheckInvars(in, obj, methodName, co)) == TCL_ERROR)) { + goto finish; } #ifdef DISPATCH_TRACE @@ -4838,7 +4911,7 @@ co = 0; if (!rst->callIsDestroy && obj->opt) co = obj->opt->checkoptions; if ((co & CHECK_INVAR) && - ((result = AssertionCheckInvars(in, obj, methodName,co)) == TCL_ERROR)) { + ((result = AssertionCheckInvars(in, obj, methodName,co)) == TCL_ERROR)) { goto finish; } } else { @@ -4856,41 +4929,41 @@ cmdList = obj->filterOrder; while (cmdList && cmdList->cmdPtr != cmd) - cmdList = cmdList->next; + cmdList = cmdList->next; /* * when it is found, check whether it has a filter guard */ if (cmdList) { - int rc = GuardCall(obj, cl, (Tcl_Command) cmdList->cmdPtr, in, - cmdList->clientData, 0); - if (rc != TCL_OK) { - if (rc != TCL_ERROR) { - /* - * call next, use the given objv's, not the callstack objv - * we may not be in a method, thus there may be wrong or - * no callstackobjs - */ - /*fprintf(stderr, "... calling nextmethod\n"); XOTclCallStackDump(in);*/ - - rc = XOTclNextMethod(obj, in, cl, methodName, - objc, objv, /*useCallStackObjs*/ 0); - /*fprintf(stderr, "... after nextmethod\n"); - XOTclCallStackDump(in);*/ - - } + int rc = GuardCall(obj, cl, (Tcl_Command) cmdList->cmdPtr, in, + cmdList->clientData, 0); + if (rc != TCL_OK) { + if (rc != TCL_ERROR) { + /* + * call next, use the given objv's, not the callstack objv + * we may not be in a method, thus there may be wrong or + * no callstackobjs + */ + /*fprintf(stderr, "... calling nextmethod\n"); XOTclCallStackDump(in);*/ + + rc = XOTclNextMethod(obj, in, cl, methodName, + objc, objv, /*useCallStackObjs*/ 0); + /*fprintf(stderr, "... after nextmethod\n"); + XOTclCallStackDump(in);*/ + + } - return rc; - } + return rc; + } } } if (!rst->callIsDestroy && obj->teardown - && !(obj->flags & XOTCL_DESTROY_CALLED)) { + && !(obj->flags & XOTCL_DESTROY_CALLED)) { if (obj->opt && - (obj->opt->checkoptions & CHECK_PRE) && - (result = AssertionCheck(in, obj, cl, methodName, CHECK_PRE)) == TCL_ERROR) { - goto finish; + (obj->opt->checkoptions & CHECK_PRE) && + (result = AssertionCheck(in, obj, cl, methodName, CHECK_PRE)) == TCL_ERROR) { + goto finish; } } @@ -4924,8 +4997,8 @@ } if (obj->opt && !rst->callIsDestroy && obj->teardown && - (obj->opt->checkoptions & CHECK_POST) && - (result = AssertionCheck(in, obj, cl, methodName, CHECK_POST) == TCL_ERROR)) { + (obj->opt->checkoptions & CHECK_POST) && + (result = AssertionCheck(in, obj, cl, methodName, CHECK_POST) == TCL_ERROR)) { goto finish; } } @@ -4943,10 +5016,10 @@ static int DoCallProcCheck(ClientData cp, ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj *CONST objv[], - Tcl_Command cmd, XOTclObject *obj, + int objc, Tcl_Obj *CONST objv[], + Tcl_Command cmd, XOTclObject *obj, XOTclClass *cl, char *methodName, - int frameType, int fromNext) { + int frameType, int fromNext) { int rc, push = 1, isTclProc = 0; if (cp) { @@ -5029,8 +5102,8 @@ if (method == XOTclGlobalObjects[XOTE_CLEANUP] || method == XOTclGlobalObjects[XOTE_DESTROY]) { fprintf(stderr, "%s->%s id=%p destroyCalled=%d\n", - ObjStr(cmdName), methodName, obj, - (obj->flags & XOTCL_DESTROY_CALLED)); + ObjStr(cmdName), methodName, obj, + (obj->flags & XOTCL_DESTROY_CALLED)); } #endif @@ -5045,165 +5118,165 @@ callMethod = methodName; #ifdef AUTOVARS - if (!isNext) { + if (!isNext) { #endif - /* Only start new filter chain, if - (a) filters are defined and - (b) the toplevel csc entry is not an filter on self - */ - if (RUNTIME_STATE(in)->doFilters && - !(flags & XOTCL_CM_NO_FILTERS) && !cs->guardCount && - ((obj->flags & XOTCL_FILTER_ORDER_DEFINED_AND_VALID) == - XOTCL_FILTER_ORDER_DEFINED_AND_VALID)) { - XOTclObject *self = GetSelfObj(in); - if (obj != self || - cs->top->frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { + /* Only start new filter chain, if + (a) filters are defined and + (b) the toplevel csc entry is not an filter on self + */ + if (RUNTIME_STATE(in)->doFilters && + !(flags & XOTCL_CM_NO_FILTERS) && !cs->guardCount && + ((obj->flags & XOTCL_FILTER_ORDER_DEFINED_AND_VALID) == + XOTCL_FILTER_ORDER_DEFINED_AND_VALID)) { + XOTclObject *self = GetSelfObj(in); + if (obj != self || + cs->top->frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { - filterStackPushed = FilterStackPush(in, obj, objv[1]); - cmd = FilterSearchProc(in, obj, &proc, &cp, - &obj->filterStack->currentCmdPtr,&cl); - if (cmd) { /* 'proc' and the other output vars are set as well */ - frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; - callMethod = (char *)Tcl_GetCommandName(in, cmd); - } else { - FilterStackPop(obj); - filterStackPushed = 0; - } - } + filterStackPushed = FilterStackPush(in, obj, objv[1]); + cmd = FilterSearchProc(in, obj, &proc, &cp, + &obj->filterStack->currentCmdPtr,&cl); + if (cmd) { /* 'proc' and the other output vars are set as well */ + frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; + callMethod = (char *)Tcl_GetCommandName(in, cmd); + } else { + FilterStackPop(obj); + filterStackPushed = 0; + } } + } - /* check if a mixin is to be called. - don't use mixins on next method calls, since normally it is not - intercepted (it is used as a primitive command). - don't use mixins on init calls, since init is invoked on mixins - during mixin registration (in XOTclOMixinMethod) - */ + /* check if a mixin is to be called. + don't use mixins on next method calls, since normally it is not + intercepted (it is used as a primitive command). + don't use mixins on init calls, since init is invoked on mixins + during mixin registration (in XOTclOMixinMethod) + */ - if ((obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) == - XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { + if ((obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) == + XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { - mixinStackPushed = MixinStackPush(obj); + mixinStackPushed = MixinStackPush(obj); - if (frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { - cmd = MixinSearchProc(in, obj, methodName, &cl, &proc, &cp, - &obj->mixinStack->currentCmdPtr); - if (cmd) { /* 'proc' and the other output vars are set as well */ - frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; - } else { /* the else branch could be deleted */ - MixinStackPop(obj); - mixinStackPushed = 0; - } - } + if (frameType != XOTCL_CSC_TYPE_ACTIVE_FILTER) { + cmd = MixinSearchProc(in, obj, methodName, &cl, &proc, &cp, + &obj->mixinStack->currentCmdPtr); + if (cmd) { /* 'proc' and the other output vars are set as well */ + frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; + } else { /* the else branch could be deleted */ + MixinStackPop(obj); + mixinStackPushed = 0; + } } -#ifdef AUTOVARS } +#ifdef AUTOVARS + } #endif - /* if no filter/mixin is found => do ordinary method lookup */ - if (proc == 0) { - /* + /* if no filter/mixin is found => do ordinary method lookup */ + if (proc == 0) { + /* fprintf(stderr,"ordinary lookup for obj %p method %s nsPtr %p\n", obj, methodName, obj->nsPtr);*/ - /*if (obj->nsPtr && !(obj->flags & XOTCL_NS_DESTROYED))*/ - if (obj->nsPtr) - cmd = FindMethod(methodName, obj->nsPtr); - /*fprintf(stderr,"findMethod for proc '%s' in %p returned %p\n",methodName, obj->nsPtr, cmd);*/ + /*if (obj->nsPtr && !(obj->flags & XOTCL_NS_DESTROYED))*/ + if (obj->nsPtr) + cmd = FindMethod(methodName, obj->nsPtr); + /*fprintf(stderr,"findMethod for proc '%s' in %p returned %p\n",methodName, obj->nsPtr, cmd);*/ - if (cmd == NULL) - cl = SearchCMethod(obj->cl, methodName, &cmd); + if (cmd == NULL) + cl = SearchCMethod(obj->cl, methodName, &cmd); - if (cmd) { - proc = Tcl_Command_objProc(cmd); - cp = Tcl_Command_objClientData(cmd); - } else { - assert(cp == 0); - } + if (cmd) { + proc = Tcl_Command_objProc(cmd); + cp = Tcl_Command_objClientData(cmd); + } else { + assert(cp == 0); } + } - if (proc) { - result = TCL_OK; - if ((result = DoCallProcCheck(cp, cd, in, objc, objv, cmd, obj, cl, - callMethod, frameType, 0 /* fromNext */)) == TCL_ERROR) { - result = XOTclErrInProc(in, cmdName, cl ? cl->object.cmdName : NULL, callMethod); - } - unknown = RUNTIME_STATE(in)->unknown; - } else { - unknown = 1; + if (proc) { + result = TCL_OK; + if ((result = DoCallProcCheck(cp, cd, in, objc, objv, cmd, obj, cl, + callMethod, frameType, 0 /* fromNext */)) == TCL_ERROR) { + result = XOTclErrInProc(in, cmdName, cl ? cl->object.cmdName : NULL, callMethod); } + unknown = RUNTIME_STATE(in)->unknown; + } else { + unknown = 1; + } - if (result == TCL_OK) { - /*fprintf(stderr,"after doCallProcCheck unknown == %d\n",unknown);*/ - if (unknown) { + if (result == TCL_OK) { + /*fprintf(stderr,"after doCallProcCheck unknown == %d\n",unknown);*/ + if (unknown) { - if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { - return XOTclVarErrMsg(in, ObjStr(objv[0]), - ": unable to dispatch method '", - callMethod, "'", (char *) NULL); - } else if (objv[1] != XOTclGlobalObjects[XOTE_UNKNOWN]) { - /* - * back off and try unknown; - */ - XOTclObject *obj = (XOTclObject*)cd; - ALLOC_ON_STACK(Tcl_Obj*,objc+1, tov); - /* - fprintf(stderr,"calling unknown for %s %s, flgs=%02x,%02x isClass=%d %p %s\n", - ObjStr(obj->cmdName), ObjStr(objv[1]), flags, XOTCL_CM_NO_UNKNOWN, - XOTclObjectIsClass(obj), obj, ObjStr(obj->cmdName)); - */ - tov[0] = obj->cmdName; - tov[1] = XOTclGlobalObjects[XOTE_UNKNOWN]; - if (objc>1) - memcpy(tov+2, objv+1, sizeof(Tcl_Obj *)*(objc-1)); - /* - fprintf(stderr,"?? %s unknown %s\n",ObjStr(obj->cmdName), ObjStr(tov[2])); - */ - result = DoDispatch(cd, in, objc+1, tov, flags | XOTCL_CM_NO_UNKNOWN); - FREE_ON_STACK(tov); + if (XOTclObjectIsClass(obj) && (flags & XOTCL_CM_NO_UNKNOWN)) { + return XOTclVarErrMsg(in, ObjStr(objv[0]), + ": unable to dispatch method '", + callMethod, "'", (char *) NULL); + } else if (objv[1] != XOTclGlobalObjects[XOTE_UNKNOWN]) { + /* + * back off and try unknown; + */ + XOTclObject *obj = (XOTclObject*)cd; + ALLOC_ON_STACK(Tcl_Obj*,objc+1, tov); + /* + fprintf(stderr,"calling unknown for %s %s, flgs=%02x,%02x isClass=%d %p %s\n", + ObjStr(obj->cmdName), ObjStr(objv[1]), flags, XOTCL_CM_NO_UNKNOWN, + XOTclObjectIsClass(obj), obj, ObjStr(obj->cmdName)); + */ + tov[0] = obj->cmdName; + tov[1] = XOTclGlobalObjects[XOTE_UNKNOWN]; + if (objc>1) + memcpy(tov+2, objv+1, sizeof(Tcl_Obj *)*(objc-1)); + /* + fprintf(stderr,"?? %s unknown %s\n",ObjStr(obj->cmdName), ObjStr(tov[2])); + */ + result = DoDispatch(cd, in, objc+1, tov, flags | XOTCL_CM_NO_UNKNOWN); + FREE_ON_STACK(tov); - } else { /* unknown failed */ - return XOTclVarErrMsg(in, ObjStr(objv[0]), - ": unable to dispatch method '", - ObjStr(objv[2]), "'", (char *) NULL); - } - + } else { /* unknown failed */ + return XOTclVarErrMsg(in, ObjStr(objv[0]), + ": unable to dispatch method '", + ObjStr(objv[2]), "'", (char *) NULL); } + } - /* be sure to reset unknown flag */ - if (unknown) - RUNTIME_STATE(in)->unknown = 0; + } + /* be sure to reset unknown flag */ + if (unknown) + RUNTIME_STATE(in)->unknown = 0; #ifdef DISPATCH_TRACE - printExit(in,"DISPATCH", objc,objv, result); - fprintf(stderr,"obj %p mixinStackPushed %d mixinStack %p\n", - obj, mixinStackPushed, obj->mixinStack); + printExit(in,"DISPATCH", objc,objv, result); + fprintf(stderr,"obj %p mixinStackPushed %d mixinStack %p\n", + obj, mixinStackPushed, obj->mixinStack); #endif - /*if (!rst->callIsDestroy ) + /*if (!rst->callIsDestroy ) fprintf(stderr, "obj freed? %p destroy %p self %p %s %d [%d] reference=%d,%d\n",obj, - cs->top->destroyedCmd, cs->top->self, ObjStr(objv[1]), - rst->callIsDestroy, - cs->top->callType & XOTCL_CSC_CALL_IS_DESTROY, - !rst->callIsDestroy, - isdestroy);*/ + cs->top->destroyedCmd, cs->top->self, ObjStr(objv[1]), + rst->callIsDestroy, + cs->top->callType & XOTCL_CSC_CALL_IS_DESTROY, + !rst->callIsDestroy, + isdestroy);*/ - if (!rst->callIsDestroy) { - /*!(obj->flags & XOTCL_DESTROY_CALLED)) {*/ - if (mixinStackPushed && obj->mixinStack) - MixinStackPop(obj); + if (!rst->callIsDestroy) { + /*!(obj->flags & XOTCL_DESTROY_CALLED)) {*/ + if (mixinStackPushed && obj->mixinStack) + MixinStackPop(obj); - if (filterStackPushed && obj->filterStack) - FilterStackPop(obj); - } + if (filterStackPushed && obj->filterStack) + FilterStackPop(obj); + } - DECR_REF_COUNT(cmdName); /* must be after last dereferencing of obj */ - return result; + DECR_REF_COUNT(cmdName); /* must be after last dereferencing of obj */ + return result; } static int ObjDispatch(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[], - int flags) { + int flags) { int result; #ifdef STACK_TRACE @@ -5230,7 +5303,7 @@ #ifdef XOTCL_BYTECODE int XOTclDirectSelfDispatch(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { int result; #ifdef XOTCLOBJ_TRACE XOTclObject *obj; @@ -5244,7 +5317,7 @@ int XOTclObjDispatch(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { return ObjDispatch(cd, in, objc, objv, 0); } @@ -5308,33 +5381,33 @@ for (i=0; i < npalistc; i++) { r1 = Tcl_ListObjGetElements(in, npalistv[i], &npac, &npav); if (r1 == TCL_OK) { - nameStringObj = Tcl_NewStringObj("-", 1); - Tcl_AppendStringsToObj(nameStringObj, ObjStr(npav[0]), - (char *) NULL); - if (npac > 1 && *(ObjStr(npav[1])) != '\0') { - first = 1; - r1 = Tcl_ListObjGetElements(in, npav[1], &checkc, &checkv); - if (r1 == TCL_OK) { - for (j=0; j < checkc; j++) { - if (first) { - Tcl_AppendToObj(nameStringObj,":",1); - first = 0; - } else { - Tcl_AppendToObj(nameStringObj,",",1); - } - Tcl_AppendToObj(nameStringObj, ObjStr(checkv[j]), -1); - } - } - } + nameStringObj = Tcl_NewStringObj("-", 1); + Tcl_AppendStringsToObj(nameStringObj, ObjStr(npav[0]), + (char *) NULL); + if (npac > 1 && *(ObjStr(npav[1])) != '\0') { + first = 1; + r1 = Tcl_ListObjGetElements(in, npav[1], &checkc, &checkv); + if (r1 == TCL_OK) { + for (j=0; j < checkc; j++) { + if (first) { + Tcl_AppendToObj(nameStringObj,":",1); + first = 0; + } else { + Tcl_AppendToObj(nameStringObj,",",1); + } + Tcl_AppendToObj(nameStringObj, ObjStr(checkv[j]), -1); + } + } + } /* fprintf(stderr, "nonposargsformat namestring '%s'\n", ObjStr(nameStringObj));*/ #if 1 - innerlist = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(in, innerlist, nameStringObj); - if (npac > 2) { - Tcl_ListObjAppendElement(in, innerlist, npav[2]); - } + innerlist = Tcl_NewListObj(0, NULL); + Tcl_ListObjAppendElement(in, innerlist, nameStringObj); + if (npac > 2) { + Tcl_ListObjAppendElement(in, innerlist, npav[2]); + } #else { Tcl_DString ds, *dsPtr = &ds; @@ -5348,7 +5421,7 @@ DSTRING_FREE(dsPtr); } #endif - Tcl_ListObjAppendElement(in, list, innerlist); + Tcl_ListObjAppendElement(in, list, innerlist); } } } @@ -5366,25 +5439,25 @@ Tcl_AppendStringsToObj(resultBody, "::xotcl::initProcNS\n", (char *) NULL); if (nonposArgs) { Tcl_AppendStringsToObj(resultBody, - "::xotcl::interpretNonpositionalArgs $args\n", - (char *) NULL); + "::xotcl::interpretNonpositionalArgs $args\n", + (char *) NULL); } Tcl_AppendStringsToObj(resultBody, ObjStr(body), (char *) NULL); return resultBody; } static int parseNonposArgs(Tcl_Interp *in, - char *procName, Tcl_Obj *npArgs, Tcl_Obj *ordinaryArgs, - Tcl_HashTable **nonposArgsTable, - int *haveNonposArgs) { + char *procName, Tcl_Obj *npArgs, Tcl_Obj *ordinaryArgs, + Tcl_HashTable **nonposArgsTable, + int *haveNonposArgs) { int rc, nonposArgsDefc, npac; Tcl_Obj **nonposArgsDefv; rc = Tcl_ListObjGetElements(in, npArgs, &nonposArgsDefc, &nonposArgsDefv); if (rc != TCL_OK) { return XOTclVarErrMsg(in, "cannot break down non-positional args: ", - ObjStr(npArgs), (char *) NULL); + ObjStr(npArgs), (char *) NULL); } if (nonposArgsDefc > 0) { int start, end, length, i, j, nw = 0; @@ -5396,54 +5469,54 @@ for (i=0; i < nonposArgsDefc; i++) { rc = Tcl_ListObjGetElements(in, nonposArgsDefv[i], &npac, &npav); if (rc == TCL_ERROR || npac < 1 || npac > 2) { - DECR_REF_COUNT(nonposArgsObj); - return XOTclVarErrMsg(in, "wrong # of elements in non-positional args ", - "(should be 1 or 2 list elements): ", - ObjStr(npArgs), (char *) NULL); + DECR_REF_COUNT(nonposArgsObj); + return XOTclVarErrMsg(in, "wrong # of elements in non-positional args ", + "(should be 1 or 2 list elements): ", + ObjStr(npArgs), (char *) NULL); } npaObj = Tcl_NewListObj(0, NULL); arg = ObjStr(npav[0]); if (arg[0] != '-') { - DECR_REF_COUNT(npaObj); - DECR_REF_COUNT(nonposArgsObj); - return XOTclVarErrMsg(in, "non-positional args does not start with '-': ", - arg, " in: ", ObjStr(npArgs), (char *) NULL); + DECR_REF_COUNT(npaObj); + DECR_REF_COUNT(nonposArgsObj); + return XOTclVarErrMsg(in, "non-positional args does not start with '-': ", + arg, " in: ", ObjStr(npArgs), (char *) NULL); } length = strlen(arg); for (j=0; j0 && isspace((int)arg[end-1]); end--); - Tcl_ListObjAppendElement(in, list, + Tcl_ListObjAppendElement(in, npaObj, Tcl_NewStringObj(arg+1, j-1)); + start = j+1; + while(start0 && isspace((int)arg[end-1]); end--); + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(arg+start, end-start)); - l++; - start = l; - while(start0 && isspace((int)arg[end-1]); end--); - Tcl_ListObjAppendElement(in, list, + l++; + start = l; + while(start0 && isspace((int)arg[end-1]); end--); + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(arg+start, end-start)); - /* append the whole thing to the list */ - Tcl_ListObjAppendElement(in, npaObj, list); + /* append the whole thing to the list */ + Tcl_ListObjAppendElement(in, npaObj, list); } else { - Tcl_ListObjAppendElement(in, npaObj, Tcl_NewStringObj(arg+1, length)); - Tcl_ListObjAppendElement(in, npaObj, Tcl_NewStringObj("", 0)); + Tcl_ListObjAppendElement(in, npaObj, Tcl_NewStringObj(arg+1, length)); + Tcl_ListObjAppendElement(in, npaObj, Tcl_NewStringObj("", 0)); } if (npac == 2) { - Tcl_ListObjAppendElement(in, npaObj, npav[1]); + Tcl_ListObjAppendElement(in, npaObj, npav[1]); } Tcl_ListObjAppendElement(in, nonposArgsObj, npaObj); *haveNonposArgs = 1; @@ -5453,7 +5526,7 @@ XOTclNonposArgs* nonposArg; if (*nonposArgsTable == 0) { - *nonposArgsTable = NonposArgsCreateTable(); + *nonposArgsTable = NonposArgsCreateTable(); } hPtr = Tcl_CreateHashEntry(*nonposArgsTable, procName, &nw); @@ -5467,7 +5540,7 @@ Tcl_SetHashValue(hPtr, (ClientData)nonposArg); } else { /* for strange reasons, we did not find nonpos-args, although we - have definitions */ + have definitions */ DECR_REF_COUNT(nonposArgsObj); } } @@ -5477,8 +5550,8 @@ static int MakeProc(Tcl_Namespace *ns, XOTclAssertionStore *aStore, - Tcl_HashTable **nonposArgsTable, - Tcl_Interp *in, int objc, Tcl_Obj *objv[], XOTclObject *obj) { + Tcl_HashTable **nonposArgsTable, + Tcl_Interp *in, int objc, Tcl_Obj *objv[], XOTclObject *obj) { int result, incr, haveNonposArgs=0; TclCallFrame frame, *framePtr = &frame; Tcl_Obj *ov[4]; @@ -5494,7 +5567,7 @@ if (objc == 5 || objc == 7) { if ((result = parseNonposArgs(in, procName, objv[2], objv[3], - nonposArgsTable, &haveNonposArgs)) != TCL_OK) + nonposArgsTable, &haveNonposArgs)) != TCL_OK) return result; if (haveNonposArgs) { @@ -5513,7 +5586,7 @@ result = Tcl_ListObjGetElements(in, objv[2], &argsc, &argsv); if (result != TCL_OK) { return XOTclVarErrMsg(in, "cannot break args into list: ", - ObjStr(objv[2]), (char *) NULL); + ObjStr(objv[2]), (char *) NULL); } for (i=0; i ordinary <%s>\n", - ObjStr(nonposArgs),ObjStr(ordinaryArgs));*/ + ObjStr(nonposArgs),ObjStr(ordinaryArgs));*/ result = parseNonposArgs(in, procName, nonposArgs, ordinaryArgs, - nonposArgsTable, &haveNonposArgs); + nonposArgsTable, &haveNonposArgs); DECR_REF_COUNT(ordinaryArgs); DECR_REF_COUNT(nonposArgs); if (result != TCL_OK) - return result; + return result; } #endif if (haveNonposArgs) { @@ -5666,7 +5739,7 @@ for (; hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { key = Tcl_GetHashKey(table, hPtr); if (!pattern || Tcl_StringMatch(key, pattern)) { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(key,-1)); + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj(key,-1)); } } Tcl_SetObjResult(in, list); @@ -5699,7 +5772,7 @@ Var *val = VarHashGetValue(hPtr); Tcl_Obj *key = VarHashGetKey(val); if (!pattern || Tcl_StringMatch(ObjStr(key), pattern)) { - Tcl_ListObjAppendElement(in, list, key); + Tcl_ListObjAppendElement(in, list, key); } } Tcl_SetObjResult(in, list); @@ -5718,9 +5791,9 @@ #if defined(PRE85) # if FORWARD_COMPATIBLE if (forwardCompatibleMode) { - ListVarKeys(in, VarHashTable(varTable), pattern); + ListVarKeys(in, VarHashTable(varTable), pattern); } else { - ListKeys(in, varTable, pattern); + ListKeys(in, varTable, pattern); } # else ListKeys(in, varTable, pattern); @@ -5763,7 +5836,7 @@ for (; hPtr; hPtr = Tcl_NextHashEntry(&hSrch)) { XOTclObject *obj = (XOTclObject*)Tcl_GetHashKey(table, hPtr); if (!pattern || Tcl_StringMatch(ObjStr(obj->cmdName), pattern)) { - Tcl_ListObjAppendElement(in, list, obj->cmdName); + Tcl_ListObjAppendElement(in, list, obj->cmdName); } } Tcl_SetObjResult(in, list); @@ -5773,7 +5846,7 @@ static int ListMethodKeys(Tcl_Interp *in, Tcl_HashTable *table, char *pattern, - int noProcs, int noCmds, int noDups, int onlyForwarder) { + int noProcs, int noCmds, int noDups, int onlyForwarder) { Tcl_HashSearch hSrch; Tcl_HashEntry* hPtr = table ? Tcl_FirstHashEntry(table, &hSrch) : 0; for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { @@ -5792,17 +5865,17 @@ int result = Tcl_ListObjGetElements(in, Tcl_GetObjResult(in), &listc, &listv); size_t keylen = strlen(key); if (result == TCL_OK) { - int found = 0; - for (i=0; iprefix) { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-methodprefix",-1)); - Tcl_ListObjAppendElement(in, list, tcd->prefix); - } - if (tcd->subcommands) { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-default",-1)); - Tcl_ListObjAppendElement(in, list, tcd->subcommands); - } - if (tcd->objscope) { - Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-objscope",-1)); - } - Tcl_ListObjAppendElement(in, list, tcd->cmdName); - if (tcd->args) { - Tcl_Obj **args; - int nrArgs, i; - Tcl_ListObjGetElements(in, tcd->args, &nrArgs, &args); - for (i=0; iprefix) { + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-methodprefix",-1)); + Tcl_ListObjAppendElement(in, list, tcd->prefix); + } + if (tcd->subcommands) { + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-default",-1)); + Tcl_ListObjAppendElement(in, list, tcd->subcommands); + } + if (tcd->objscope) { + Tcl_ListObjAppendElement(in, list, Tcl_NewStringObj("-objscope",-1)); + } + Tcl_ListObjAppendElement(in, list, tcd->cmdName); + if (tcd->args) { + Tcl_Obj **args; + int nrArgs, i; + Tcl_ListObjGetElements(in, tcd->args, &nrArgs, &args); + for (i=0; insPtr) { Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(obj->nsPtr); @@ -5872,19 +5945,19 @@ XOTclCmdList *ml = obj->mixinOrder; XOTclClass *mixin; while (ml) { - int guardOk = TCL_OK; - mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); - if (inContext) { - XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; - if (!cs->guardCount) { - guardOk = GuardCall(obj, 0, 0, in, ml->clientData, 1); - } - } - if (mixin && guardOk == TCL_OK) { - Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(mixin->nsPtr); - ListMethodKeys(in, cmdTable, pattern, noProcs, noCmds, 1, 0); - } - ml = ml->next; + int guardOk = TCL_OK; + mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); + if (inContext) { + XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; + if (!cs->guardCount) { + guardOk = GuardCall(obj, 0, 0, in, ml->clientData, 1); + } + } + if (mixin && guardOk == TCL_OK) { + Tcl_HashTable *cmdTable = Tcl_Namespace_cmdTable(mixin->nsPtr); + ListMethodKeys(in, cmdTable, pattern, noProcs, noCmds, 1, 0); + } + ml = ml->next; } } } @@ -5901,7 +5974,7 @@ static int ListClass(Tcl_Interp *in, XOTclObject *obj, char *pattern, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { if (pattern == 0) { Tcl_SetObjResult(in, obj->cl->object.cmdName); return TCL_OK; @@ -5948,7 +6021,7 @@ for (pl = ComputeOrder(cl, cl->order, Super); pl; pl = pl->next) { if (pl->cl == isc) { Tcl_SetIntObj(Tcl_GetObjResult(in), 1); - break; + break; } } if (pl == 0) @@ -5984,8 +6057,8 @@ */ for (pl = ComputeOrder(cl, cl->order, Sub); pl; pl = pl->next) { if (pl->cl == isc) { - Tcl_SetIntObj(Tcl_GetObjResult(in), 1); - break; + Tcl_SetIntObj(Tcl_GetObjResult(in), 1); + break; } } if (pl == 0) @@ -6060,14 +6133,14 @@ ListProcArgs(Tcl_Interp *in, Tcl_HashTable *table, char *name) { Proc* proc = FindProc(in, table, name); if (proc) { - CompiledLocal *args = proc->firstLocalPtr; - Tcl_ResetResult(in); - for (;args != NULL; args = args->nextPtr) { - if (TclIsCompiledLocalArgument(args)) + CompiledLocal *args = proc->firstLocalPtr; + Tcl_ResetResult(in); + for (;args != NULL; args = args->nextPtr) { + if (TclIsCompiledLocalArgument(args)) Tcl_AppendElement(in, args->name); - } - return TCL_OK; + } + return TCL_OK; } return XOTclErrBadVal(in, "info args", "a tcl method name", name); } @@ -6078,14 +6151,14 @@ Tcl_Obj **ordinaryArgsDefv, **defaultValueObjv, *ordinaryArg, *argList = Tcl_NewListObj(0, NULL); rc = Tcl_ListObjGetElements(in, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); + &ordinaryArgsDefc, &ordinaryArgsDefv); if (rc != TCL_OK) return TCL_ERROR; for (i=0; i < ordinaryArgsDefc; i++) { ordinaryArg = ordinaryArgsDefv[i]; rc = Tcl_ListObjGetElements(in, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); + &defaultValueObjc, &defaultValueObjv); if (rc == TCL_OK && defaultValueObjc == 2) { ordinaryArg = defaultValueObjv[0]; } @@ -6097,7 +6170,7 @@ static int GetProcDefault(Tcl_Interp *in, Tcl_HashTable *table, - char *name, char *arg, Tcl_Obj **resultObj) { + char *name, char *arg, Tcl_Obj **resultObj) { Proc* proc = FindProc(in, table, name); *resultObj = 0; if (proc) { @@ -6107,8 +6180,8 @@ if (strcmp(arg, ap->name) != 0) continue; if (ap->defValuePtr != NULL) { - *resultObj = ap->defValuePtr; - return TCL_OK; + *resultObj = ap->defValuePtr; + return TCL_OK; } return TCL_OK; } @@ -6130,7 +6203,7 @@ } } else { if (Tcl_ObjSetVar2(in, var, NULL, - XOTclGlobalObjects[XOTE_EMPTY], 0) != NULL) { + XOTclGlobalObjects[XOTE_EMPTY], 0) != NULL) { Tcl_SetIntObj(Tcl_GetObjResult(in), 0); } else { result = TCL_ERROR; @@ -6147,7 +6220,7 @@ static int ListProcDefault(Tcl_Interp *in, Tcl_HashTable *table, - char *name, char *arg, Tcl_Obj *var) { + char *name, char *arg, Tcl_Obj *var) { Tcl_Obj *defVal; int result; if (GetProcDefault(in, table, name, arg, &defVal) == TCL_OK) { @@ -6163,22 +6236,22 @@ static int ListDefaultFromOrdinaryArgs(Tcl_Interp *in, char *procName, - XOTclNonposArgs* nonposArgs, char *arg, Tcl_Obj *var) { + XOTclNonposArgs* nonposArgs, char *arg, Tcl_Obj *var) { int i, rc, ordinaryArgsDefc, defaultValueObjc; Tcl_Obj **ordinaryArgsDefv, **defaultValueObjv, *ordinaryArg; rc = Tcl_ListObjGetElements(in, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); + &ordinaryArgsDefc, &ordinaryArgsDefv); if (rc != TCL_OK) return TCL_ERROR; for (i=0; i < ordinaryArgsDefc; i++) { ordinaryArg = ordinaryArgsDefv[i]; rc = Tcl_ListObjGetElements(in, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); + &defaultValueObjc, &defaultValueObjv); if (rc == TCL_OK && !strcmp(arg, ObjStr(defaultValueObjv[0]))) { return SetProcDefault(in, var, defaultValueObjc == 2 ? - defaultValueObjv[1] : NULL); + defaultValueObjv[1] : NULL); } } XOTclVarErrMsg(in, "method '", procName, "' doesn't have an argument '", @@ -6218,9 +6291,9 @@ if (pattern && noMetaChars(pattern)) { XOTcl_PushFrame(in, obj); if ((childobj = XOTclpGetObject(in, pattern)) && - (!classesOnly || XOTclObjectIsClass(childobj)) && - (childobj->id && Tcl_Command_nsPtr(childobj->id) == obj->nsPtr) /* true children */ - ) { + (!classesOnly || XOTclObjectIsClass(childobj)) && + (childobj->id && Tcl_Command_nsPtr(childobj->id) == obj->nsPtr) /* true children */ + ) { Tcl_SetObjResult(in, childobj->cmdName); } else { Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); @@ -6235,12 +6308,12 @@ for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { key = Tcl_GetHashKey(cmdTable, hPtr); if (!pattern || Tcl_StringMatch(key, pattern)) { - if ((childobj = XOTclpGetObject(in, key)) && - (!classesOnly || XOTclObjectIsClass(childobj)) && - (childobj->id && Tcl_Command_nsPtr(childobj->id) == obj->nsPtr) /* true children */ - ) { - Tcl_ListObjAppendElement(in, list, childobj->cmdName); - } + if ((childobj = XOTclpGetObject(in, key)) && + (!classesOnly || XOTclObjectIsClass(childobj)) && + (childobj->id && Tcl_Command_nsPtr(childobj->id) == obj->nsPtr) /* true children */ + ) { + Tcl_ListObjAppendElement(in, list, childobj->cmdName); + } } } XOTcl_PopFrame(in,obj); @@ -6290,9 +6363,9 @@ */ XOTCLINLINE static void NextSearchMethod(XOTclObject *obj, Tcl_Interp *in, XOTclCallStackContent *csc, - XOTclClass **cl, char **method, Tcl_ObjCmdProc **proc, Tcl_Command *cmd, - ClientData *cp, int* isMixinEntry, int* isFilterEntry, - int* endOfFilterChain, Tcl_Command* currentCmd) { + XOTclClass **cl, char **method, Tcl_ObjCmdProc **proc, Tcl_Command *cmd, + ClientData *cp, int* isMixinEntry, int* isFilterEntry, + int* endOfFilterChain, Tcl_Command* currentCmd) { XOTclClasses *pl = 0; int endOfChain = 0; *endOfFilterChain = 0; @@ -6313,13 +6386,13 @@ if (*proc == 0) { if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) { - /* reset the information to the values of method, cl - to the values they had before calling the filters */ - *method = ObjStr(obj->filterStack->calledProc); - endOfChain = 1; - *endOfFilterChain = 1; - *cl = 0; - /*fprintf(stderr,"EndOfChain resetting cl\n");*/ + /* reset the information to the values of method, cl + to the values they had before calling the filters */ + *method = ObjStr(obj->filterStack->calledProc); + endOfChain = 1; + *endOfFilterChain = 1; + *cl = 0; + /*fprintf(stderr,"EndOfChain resetting cl\n");*/ } } else { *method = (char *) Tcl_GetCommandName(in, *cmd); @@ -6343,8 +6416,8 @@ /*fprintf(stderr,"nextsearch: mixinsearch cmd %p, proc=%p\n",*cmd,*proc);*/ if (*proc == 0) { if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_MIXIN) { - endOfChain = 1; - *cl = 0; + endOfChain = 1; + *cl = 0; } } else { *isMixinEntry = 1; @@ -6372,7 +6445,7 @@ if (!*cmd) { for (pl = ComputeOrder(obj->cl, obj->cl->order, Super); pl && *cl; pl = pl->next) { if (pl->cl == *cl) - *cl = 0; + *cl = 0; } /* @@ -6394,8 +6467,8 @@ static int XOTclNextMethod(XOTclObject *obj, Tcl_Interp *in, XOTclClass *givenCl, - char *givenMethod, int objc, Tcl_Obj *CONST objv[], - int useCallstackObjs) { + char *givenMethod, int objc, Tcl_Obj *CONST objv[], + int useCallstackObjs) { XOTclCallStackContent *csc = CallStackGetTopFrame(in); Tcl_ObjCmdProc *proc = 0; Tcl_Command cmd, currentCmd = NULL; @@ -6414,32 +6487,32 @@ int found = 0; while (cf) { /* fprintf(stderr, " ... compare fp = %p and cfp %p procFrame %p oc=%d\n", - cf, csc->currentFramePtr, - Tcl_Interp_framePtr(in), Tcl_CallFrame_objc(Tcl_Interp_framePtr(in)) - );*/ + cf, csc->currentFramePtr, + Tcl_Interp_framePtr(in), Tcl_CallFrame_objc(Tcl_Interp_framePtr(in)) + );*/ if (cf == csc->currentFramePtr) { - found = 1; - break; + found = 1; + break; } cf = (Tcl_CallFrame *)((CallFrame *)cf)->callerPtr; } /* - if (!found) { + if (!found) { if (Tcl_Interp_varFramePtr(in)) { - fprintf(stderr,"found (csc->currentFramePtr %p)= %d cur level=%d\n", - csc->currentFramePtr,found, - Tcl_CallFrame_level(Tcl_Interp_varFramePtr(in))); + fprintf(stderr,"found (csc->currentFramePtr %p)= %d cur level=%d\n", + csc->currentFramePtr,found, + Tcl_CallFrame_level(Tcl_Interp_varFramePtr(in))); } else { - fprintf(stderr,"no varFramePtr\n"); + fprintf(stderr,"no varFramePtr\n"); } return TCL_OK; - } + } */ } #endif /* - fprintf(stderr,"givenMethod = %s, csc = %p, useCallstackObj %d, objc %d\n", - givenMethod, csc, useCallstackObjs, objc); + fprintf(stderr,"givenMethod = %s, csc = %p, useCallstackObj %d, objc %d\n", + givenMethod, csc, useCallstackObjs, objc); */ /* if no args are given => use args from stack */ @@ -6455,16 +6528,16 @@ * Search the next method & compute its method data */ NextSearchMethod(obj, in, csc, cl, method, &proc, &cmd, &cp, - &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); + &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); /* - fprintf(stderr, "NextSearchMethod -- RETURN: method=%s eoffc=%d,", - *method, endOfFilterChain); - if (obj) + fprintf(stderr, "NextSearchMethod -- RETURN: method=%s eoffc=%d,", + *method, endOfFilterChain); + if (obj) fprintf(stderr, " obj=%s,", ObjStr(obj->cmdName)); - if ((*cl)) + if ((*cl)) fprintf(stderr, " cl=%s,", (*cl)->nsPtr->fullName); - fprintf(stderr, " mixin=%d, filter=%d, proc=%p\n", + fprintf(stderr, " mixin=%d, filter=%d, proc=%p\n", isMixinEntry, isFilterEntry, proc); */ @@ -6476,25 +6549,25 @@ */ if (obj->mixinStack) { if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_MIXIN) - csc->frameType = XOTCL_CSC_TYPE_INACTIVE_MIXIN; + csc->frameType = XOTCL_CSC_TYPE_INACTIVE_MIXIN; /* otherwise move the command pointer forward */ if (isMixinEntry) { - frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; - obj->mixinStack->currentCmdPtr = currentCmd; + frameType = XOTCL_CSC_TYPE_ACTIVE_MIXIN; + obj->mixinStack->currentCmdPtr = currentCmd; } } /* * change filter state */ if (obj->filterStack) { if (csc->frameType == XOTCL_CSC_TYPE_ACTIVE_FILTER) - csc->frameType = XOTCL_CSC_TYPE_INACTIVE_FILTER; + csc->frameType = XOTCL_CSC_TYPE_INACTIVE_FILTER; /* otherwise move the command pointer forward */ if (isFilterEntry) { - frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; - obj->filterStack->currentCmdPtr = currentCmd; + frameType = XOTCL_CSC_TYPE_ACTIVE_FILTER; + obj->filterStack->currentCmdPtr = currentCmd; } } @@ -6506,14 +6579,14 @@ if (nobjc > 1) { char *nobjv1 = ObjStr(nobjv[1]); if (nobjv1[0] == '-' && !strcmp(nobjv1, "--noArgs")) - nobjc = 1; + nobjc = 1; } csc->callType |= XOTCL_CSC_CALL_IS_NEXT; RUNTIME_STATE(in)->unknown = 0; result = DoCallProcCheck(cp, (ClientData)obj, in, nobjc, nobjv, cmd, - obj, *cl, *method, frameType, 1/*fromNext*/); + obj, *cl, *method, frameType, 1/*fromNext*/); csc->callType &= ~XOTCL_CSC_CALL_IS_NEXT; @@ -6541,7 +6614,7 @@ return XOTclErrMsg(in, "next: no executing proc", TCL_STATIC); return XOTclNextMethod(csc->self, in, csc->cl, - (char *)Tcl_GetCommandName(in, csc->cmdPtr), + (char *)Tcl_GetCommandName(in, csc->cmdPtr), objc, objv, 1); } @@ -6637,11 +6710,11 @@ return TCL_OK; NextSearchMethod(o, in, csc, &cl, &methodName, &proc, &cmd, &cp, - &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); + &isMixinEntry, &isFilterEntry, &endOfFilterChain, ¤tCmd); if (cmd) { Tcl_SetObjResult(in, getFullProcQualifier(in, Tcl_GetCommandName(in, cmd), - o, cl, cmd)); + o, cl, cmd)); } return TCL_OK; } @@ -6698,93 +6771,93 @@ switch (*option) { /* other callstack information */ case 'a': if (!strcmp(option, "activelevel")) { - Tcl_SetObjResult(in, computeLevelObj(in, ACTIVE_LEVEL)); - return TCL_OK; + Tcl_SetObjResult(in, computeLevelObj(in, ACTIVE_LEVEL)); + return TCL_OK; } else if (!strcmp(option,"args")) { - int nobjc; - Tcl_Obj **nobjv; - csc = CallStackGetTopFrame(in); - nobjc = Tcl_CallFrame_objc(csc->currentFramePtr); - nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(csc->currentFramePtr); - Tcl_SetObjResult(in, Tcl_NewListObj(nobjc-1,nobjv+1)); - return TCL_OK; + int nobjc; + Tcl_Obj **nobjv; + csc = CallStackGetTopFrame(in); + nobjc = Tcl_CallFrame_objc(csc->currentFramePtr); + nobjv = (Tcl_Obj **)Tcl_CallFrame_objv(csc->currentFramePtr); + Tcl_SetObjResult(in, Tcl_NewListObj(nobjc-1,nobjv+1)); + return TCL_OK; } #if defined(ACTIVEMIXIN) else if (!strcmp(option, "activemixin")) { - XOTclObject *o = NULL; - csc = CallStackGetTopFrame(in); - /*CmdListPrint(in,"self a....\n", obj->mixinOrder); - fprintf(stderr,"current cmdPtr = %p cl = %p, mo=%p %p\n", csc->cmdPtr, csc->cl, - obj->mixinOrder, RUNTIME_STATE(in)->cmdPtr);*/ - if (RUNTIME_STATE(in)->cmdPtr) { - o = XOTclGetObjectFromCmdPtr(RUNTIME_STATE(in)->cmdPtr); - } - Tcl_SetObjResult(in, o ? o->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); - return TCL_OK; - } + XOTclObject *o = NULL; + csc = CallStackGetTopFrame(in); + /*CmdListPrint(in,"self a....\n", obj->mixinOrder); + fprintf(stderr,"current cmdPtr = %p cl = %p, mo=%p %p\n", csc->cmdPtr, csc->cl, + obj->mixinOrder, RUNTIME_STATE(in)->cmdPtr);*/ + if (RUNTIME_STATE(in)->cmdPtr) { + o = XOTclGetObjectFromCmdPtr(RUNTIME_STATE(in)->cmdPtr); + } + Tcl_SetObjResult(in, o ? o->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); + return TCL_OK; + } #endif break; case 'c': if (!strcmp(option, "calledproc")) { - if (!(csc = CallStackFindActiveFilter(in))) - return XOTclVarErrMsg(in, - "self calledproc called from outside of a filter", + if (!(csc = CallStackFindActiveFilter(in))) + return XOTclVarErrMsg(in, + "self calledproc called from outside of a filter", (char *) NULL); - Tcl_SetObjResult(in, csc->filterStackEntry->calledProc); - return TCL_OK; + Tcl_SetObjResult(in, csc->filterStackEntry->calledProc); + return TCL_OK; } else if (!strcmp(option, "calledclass")) { - Tcl_SetResult(in, className(FindCalledClass(in, obj)), TCL_VOLATILE); - return TCL_OK; + Tcl_SetResult(in, className(FindCalledClass(in, obj)), TCL_VOLATILE); + return TCL_OK; } else if (!strcmp(option, "callingproc")) { - csc = XOTclCallStackFindLastInvocation(in, 1); - Tcl_SetResult(in, csc ? (char *)Tcl_GetCommandName(in, csc->cmdPtr) : "", - TCL_VOLATILE); - return TCL_OK; + csc = XOTclCallStackFindLastInvocation(in, 1); + Tcl_SetResult(in, csc ? (char *)Tcl_GetCommandName(in, csc->cmdPtr) : "", + TCL_VOLATILE); + return TCL_OK; } else if (!strcmp(option, "callingclass")) { - csc = XOTclCallStackFindLastInvocation(in, 1); - Tcl_SetObjResult(in, csc && csc->cl ? csc->cl->object.cmdName : - XOTclGlobalObjects[XOTE_EMPTY]); - return TCL_OK; + csc = XOTclCallStackFindLastInvocation(in, 1); + Tcl_SetObjResult(in, csc && csc->cl ? csc->cl->object.cmdName : + XOTclGlobalObjects[XOTE_EMPTY]); + return TCL_OK; } else if (!strcmp(option, "callinglevel")) { - Tcl_SetObjResult(in, computeLevelObj(in, CALLING_LEVEL)); - return TCL_OK; + Tcl_SetObjResult(in, computeLevelObj(in, CALLING_LEVEL)); + return TCL_OK; } else if (!strcmp(option, "callingobject")) { - /*XOTclStackDump(in); XOTclCallStackDump(in);*/ + /*XOTclStackDump(in); XOTclCallStackDump(in);*/ - csc = XOTclCallStackFindLastInvocation(in, 1); - Tcl_SetObjResult(in, csc ? csc->self->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); - return TCL_OK; + csc = XOTclCallStackFindLastInvocation(in, 1); + Tcl_SetObjResult(in, csc ? csc->self->cmdName : XOTclGlobalObjects[XOTE_EMPTY]); + return TCL_OK; } break; case 'f': if (!strcmp(option, "filterreg")) { - if (!(csc = CallStackFindActiveFilter(in))) { - return XOTclVarErrMsg(in, + if (!(csc = CallStackFindActiveFilter(in))) { + return XOTclVarErrMsg(in, "self filterreg called from outside of a filter", (char *) NULL); } - Tcl_SetObjResult(in, FilterFindReg(in, obj, GetSelfProcCmdPtr(in))); - return TCL_OK; + Tcl_SetObjResult(in, FilterFindReg(in, obj, GetSelfProcCmdPtr(in))); + return TCL_OK; } break; case 'i': if (!strcmp(option, "isnextcall")) { - XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; - csc = cs->top; - csc--; - Tcl_SetBooleanObj(Tcl_GetObjResult(in), - (csc > cs->content && - (csc->callType & XOTCL_CSC_CALL_IS_NEXT))); - return TCL_OK; + XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; + csc = cs->top; + csc--; + Tcl_SetBooleanObj(Tcl_GetObjResult(in), + (csc > cs->content && + (csc->callType & XOTCL_CSC_CALL_IS_NEXT))); + return TCL_OK; } break; case 'n': if (!strcmp(option, "next")) - return FindSelfNext(in, obj); + return FindSelfNext(in, obj); break; } } @@ -6793,14 +6866,14 @@ } /* -int -XOTclKObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { + int + XOTclKObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { if (objc < 2) - return XOTclVarErrMsg(in, "wrong # of args for K", (char *) NULL); + return XOTclVarErrMsg(in, "wrong # of args for K", (char *) NULL); Tcl_SetObjResult(in, objv[1]); return TCL_OK; -} + } */ int @@ -6838,43 +6911,43 @@ static int unsetInAllNamespaces(Tcl_Interp *in, Namespace *nsPtr, char *name) { + int rc = 0; + fprintf(stderr, "### unsetInAllNamespaces %s\n",name); + if (nsPtr != NULL) { + Tcl_HashSearch search; + Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); + Tcl_Var *varPtr; int rc = 0; - fprintf(stderr, "### unsetInAllNamespaces %s\n",name); - if (nsPtr != NULL) { - Tcl_HashSearch search; - Tcl_HashEntry *entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search); - Tcl_Var *varPtr; - int rc = 0; - varPtr = (Tcl_Var *) Tcl_FindNamespaceVar(in, name, (Tcl_Namespace *) nsPtr, 0); - /*fprintf(stderr, "found %s in %s -> %p\n",name, nsPtr->fullName, varPtr);*/ - if (varPtr) { - Tcl_DString dFullname, *dsPtr = &dFullname; - Tcl_DStringInit(dsPtr); - Tcl_DStringAppend(dsPtr, "unset ", -1); - Tcl_DStringAppend(dsPtr, nsPtr->fullName, -1); - Tcl_DStringAppend(dsPtr, "::", 2); - Tcl_DStringAppend(dsPtr, name, -1); - /*rc = Tcl_UnsetVar2(in, Tcl_DStringValue(dsPtr), NULL, TCL_LEAVE_ERR_MSG);*/ - rc = Tcl_Eval(in, Tcl_DStringValue(dsPtr)); - /* fprintf(stderr, "fqName = '%s' unset => %d %d\n",Tcl_DStringValue(dsPtr), rc, TCL_OK);*/ - if (rc == TCL_OK) { - rc = 1; - } else { - Tcl_Obj *resultObj = Tcl_GetObjResult(in); - fprintf(stderr, " err = '%s'\n", ObjStr(resultObj)); - } - Tcl_DStringFree(dsPtr); - } + varPtr = (Tcl_Var *) Tcl_FindNamespaceVar(in, name, (Tcl_Namespace *) nsPtr, 0); + /*fprintf(stderr, "found %s in %s -> %p\n",name, nsPtr->fullName, varPtr);*/ + if (varPtr) { + Tcl_DString dFullname, *dsPtr = &dFullname; + Tcl_DStringInit(dsPtr); + Tcl_DStringAppend(dsPtr, "unset ", -1); + Tcl_DStringAppend(dsPtr, nsPtr->fullName, -1); + Tcl_DStringAppend(dsPtr, "::", 2); + Tcl_DStringAppend(dsPtr, name, -1); + /*rc = Tcl_UnsetVar2(in, Tcl_DStringValue(dsPtr), NULL, TCL_LEAVE_ERR_MSG);*/ + rc = Tcl_Eval(in, Tcl_DStringValue(dsPtr)); + /* fprintf(stderr, "fqName = '%s' unset => %d %d\n",Tcl_DStringValue(dsPtr), rc, TCL_OK);*/ + if (rc == TCL_OK) { + rc = 1; + } else { + Tcl_Obj *resultObj = Tcl_GetObjResult(in); + fprintf(stderr, " err = '%s'\n", ObjStr(resultObj)); + } + Tcl_DStringFree(dsPtr); + } - while (entryPtr != NULL) { - Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); - /*fprintf(stderr, "child = %s\n", childNsPtr->fullName);*/ - entryPtr = Tcl_NextHashEntry(&search); - rc |= unsetInAllNamespaces(in, childNsPtr, name); - } + while (entryPtr != NULL) { + Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entryPtr); + /*fprintf(stderr, "child = %s\n", childNsPtr->fullName);*/ + entryPtr = Tcl_NextHashEntry(&search); + rc |= unsetInAllNamespaces(in, childNsPtr, name); } - return rc; + } + return rc; } static int @@ -6895,10 +6968,10 @@ if (rc != TCL_OK) { int rc = Tcl_UnsetVar2(in, obj->opt->volatileVarName, NULL, TCL_GLOBAL_ONLY); if (rc != TCL_OK) { - Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(in); - if (unsetInAllNamespaces(in, nsPtr, obj->opt->volatileVarName) == 0) { - fprintf(stderr, "### don't know how to delete variable '%s' of volatile object\n", - obj->opt->volatileVarName); + Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(in); + if (unsetInAllNamespaces(in, nsPtr, obj->opt->volatileVarName) == 0) { + fprintf(stderr, "### don't know how to delete variable '%s' of volatile object\n", + obj->opt->volatileVarName); } } } @@ -6926,13 +6999,13 @@ /* clear variable, destroy is called from trace */ if (o->opt && o->opt->volatileVarName) { - o->opt->volatileVarName = NULL; + o->opt->volatileVarName = NULL; } if (callMethod((ClientData)o, in, XOTclGlobalObjects[XOTE_DESTROY],2,0,0) != TCL_OK) { - result = "Destroy for volatile object failed"; + result = "Destroy for volatile object failed"; } else - result = "No XOTcl Object passed"; + result = "No XOTcl Object passed"; Tcl_SetObjResult(in, res); /* restore the result */ DECR_REF_COUNT(res); @@ -6963,8 +7036,8 @@ * destroyedCmd. */ if (Tcl_Command_refCount(csc->destroyedCmd) > 1) { - Tcl_Command_refCount(csc->destroyedCmd)--; - MEM_COUNT_FREE("command refCount",csc->destroyedCmd); + Tcl_Command_refCount(csc->destroyedCmd)--; + MEM_COUNT_FREE("command refCount",csc->destroyedCmd); } csc->destroyedCmd = 0; } @@ -7000,8 +7073,8 @@ if (obj->varTable) { TclDeleteVars(((Interp *)in), obj->varTable); ckfree((char *)obj->varTable); - /* - FREE(obj->varTable, obj->varTable);*/ + /* + FREE(obj->varTable, obj->varTable);*/ obj->varTable = 0; } @@ -7015,32 +7088,12 @@ #endif if (!softrecreate) { - /* - * Remove this object from all mixinof lists and clear the mixin list - */ - XOTclClass *cl = NULL; - XOTclClassOpt *clopt = NULL; - XOTclCmdList *cmdlist; - XOTclCmdList *del; - Tcl_Command cmd = Tcl_GetCommandFromObj(in, obj->cmdName); - cmdlist = opt->mixins; - while (cmdlist != 0) { - cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); - if (cl) clopt = cl->opt; - if (clopt) { - del = CmdListFindCmdInList(cmd, clopt->mixinofs); - if (del) { - /* fprintf(stderr,"Removing object %s from mixinofs of Class %s\n", - ObjStr(obj->cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ - del = CmdListRemoveFromList(&clopt->mixinofs,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - } /* else fprintf(stderr,"CleanupDestroyObject %s: NULL pointer in mixins!\n",ObjStr(obj->cmdName)); */ - cmdlist = cmdlist->next; - } - + /* + * Remove this object from all mixinof lists and clear the mixin list + */ + RemoveFromMixinofs(obj->id, opt->mixins); + CmdListRemoveList(&opt->mixins, GuardDel); - CmdListRemoveList(&opt->filters, GuardDel); FREE(XOTclObjectOpt,opt); @@ -7067,7 +7120,7 @@ */ static void CleanupInitObject(Tcl_Interp *in, XOTclObject *obj, - XOTclClass *cl, Tcl_Namespace *namespacePtr, int softrecreate) { + XOTclClass *cl, Tcl_Namespace *namespacePtr, int softrecreate) { #ifdef OBJDELETION_TRACE fprintf(stderr,"+++ CleanupInitObject\n"); #endif @@ -7121,7 +7174,7 @@ #ifdef OBJDELETION_TRACE fprintf(stderr," physical delete of %p id=%p destroyCalled=%d '%s'\n", - obj, obj->id, (obj->flags & XOTCL_DESTROY_CALLED), ObjStr(obj->cmdName)); + obj, obj->id, (obj->flags & XOTCL_DESTROY_CALLED), ObjStr(obj->cmdName)); #endif CleanupDestroyObject(in, obj, 0); @@ -7133,16 +7186,16 @@ #if 0 { - /* Prevent that PrimitiveODestroy is called more than once. - This code was used in earlier versions of XOTcl - but does not seem necessary any more. If it has to be used - again in the future, don't use Tcl_GetCommandFromObj() - in Tcl 8.4.* versions. - */ - Tcl_Command cmd = Tcl_FindCommand(in, ObjStr(obj->cmdName), 0, 0); + /* Prevent that PrimitiveODestroy is called more than once. + This code was used in earlier versions of XOTcl + but does not seem necessary any more. If it has to be used + again in the future, don't use Tcl_GetCommandFromObj() + in Tcl 8.4.* versions. + */ + Tcl_Command cmd = Tcl_FindCommand(in, ObjStr(obj->cmdName), 0, 0); - if (cmd != NULL) - Tcl_Command_deleteProc(cmd) = 0; + if (cmd != NULL) + Tcl_Command_deleteProc(cmd) = 0; } #endif @@ -7158,11 +7211,11 @@ objTrace("ODestroy", obj); #if REFCOUNT_TRACE fprintf(stderr,"ODestroy %p flags %d rc %d destr %d dc %d\n", - obj, obj->flags, - (obj->flags & XOTCL_REFCOUNTED) != 0, - (obj->flags & XOTCL_DESTROYED) != 0, - (obj->flags & XOTCL_DESTROY_CALLED) != 0 - ); + obj, obj->flags, + (obj->flags & XOTCL_REFCOUNTED) != 0, + (obj->flags & XOTCL_DESTROYED) != 0, + (obj->flags & XOTCL_DESTROY_CALLED) != 0 + ); #endif #if REFCOUNTED if (!(obj->flags & XOTCL_REFCOUNTED)) { @@ -7200,7 +7253,7 @@ if (Tcl_FindNamespace(in, name, NULL, 0)) { CleanupInitObject(in, obj, cl, - NSGetFreshNamespace(in, (ClientData)obj, name), 0); + NSGetFreshNamespace(in, (ClientData)obj, name), 0); } else { CleanupInitObject(in, obj, cl, NULL, 0); } @@ -7236,7 +7289,7 @@ return 0; } obj->id = Tcl_CreateObjCommand(in, name, XOTclObjDispatch, - (ClientData)obj, PrimitiveODestroy); + (ClientData)obj, PrimitiveODestroy); PrimitiveOInit(obj, in, name, cl); #if 0 @@ -7262,82 +7315,36 @@ static void CleanupDestroyClass(Tcl_Interp *in, XOTclClass *cl, int softrecreate) { Tcl_HashSearch hSrch; - Tcl_HashEntry* hPtr; - Tcl_Command cmd = Tcl_GetCommandFromObj(in, cl->object.cmdName); + Tcl_HashEntry *hPtr; XOTclClass *theobj = RUNTIME_STATE(in)->theObject; XOTclObject *obj = (XOTclObject*)cl; - XOTclClassOpt* opt = cl->opt; + XOTclClassOpt *opt = cl->opt; - if (opt) { - XOTclObjectOpt* objopt; - XOTclClass* ncl = NULL; - XOTclClassOpt* nclopt = NULL; - XOTclCmdList* del; - XOTclCmdList* cmdlist; + /* + * Remove this class from all instmixinofs and clear the instmixin list + */ -/* - * Remove this class from all instmixinofs and clear the instmixin list - */ - - cmdlist = opt->instmixins; - while (cmdlist != 0) { - ncl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); - if (ncl) nclopt = ncl->opt; - if (nclopt) { - del = CmdListFindCmdInList(cmd, nclopt->instmixinofs); - if (del) { - /* fprintf(stderr,"Removing class %s from instmixinofs of class %s\n", - ObjStr(cl->object.cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ - del = CmdListRemoveFromList(&nclopt->instmixinofs,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - } /* else fprintf(stderr,"CleanupDestroyClass %s: NULL pointer in instmixins!\n",ObjStr(cl->object.cmdName)); */ - cmdlist = cmdlist->next; - } - + RemoveFromInstmixinsofs(cl->object.id, opt->instmixins); + CmdListRemoveList(&opt->instmixins, GuardDel); MixinInvalidateObjOrders(in, cl); CmdListRemoveList(&opt->instfilters, GuardDel); FilterInvalidateObjOrders(in, cl); -/* - * Remove this class from all mixin lists and clear the mixinofs list - */ - - cmdlist = opt->mixinofs; - while (cmdlist != 0) { - objopt = XOTclRequireObjectOpt(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)); - del = CmdListFindCmdInList(cmd, objopt->mixins); - if (del) { - /* fprintf(stderr,"Removing class %s from mixins of object %s\n", - ObjStr(cl->object.cmdName),ObjStr(XOTclGetObjectFromCmdPtr(cmdlist->cmdPtr)->cmdName)); */ - del = CmdListRemoveFromList(&objopt->mixins,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - cmdlist = cmdlist->next; - } - + /* + * Remove this class from all mixin lists and clear the mixinofs list + */ + + RemoveFromMixins(cl->object.id, opt->mixinofs); CmdListRemoveList(&opt->mixinofs, GuardDel); + + /* + * Remove this class from all instmixin lists and clear the instmixinofs list + */ -/* - * Remove this class from all instmixin lists and clear the instmixinofs list - */ - - cmdlist = opt->instmixinofs; - while (cmdlist != 0) { - nclopt = XOTclRequireClassOpt(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)); - del = CmdListFindCmdInList(cmd, nclopt->instmixins); - if (del) { - /* fprintf(stderr,"Removing class %s from instmixins of class %s\n", - ObjStr(cl->object.cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ - del = CmdListRemoveFromList(&nclopt->instmixins,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - cmdlist = cmdlist->next; - } - + RemoveFromInstmixins(cl->object.id, opt->instmixinofs); CmdListRemoveList(&opt->instmixinofs, GuardDel); /* remove dependent filters of this class from all subclasses*/ @@ -7347,7 +7354,7 @@ XOTclFreeObjectData(cl); #endif } - + Tcl_ForgetImport(in, cl->nsPtr, "*"); /* don't destroy namespace imported objects */ NSCleanupNamespace(in, cl->nsPtr); NSDeleteChildren(in, cl->nsPtr); @@ -7358,13 +7365,13 @@ if (cl != theobj) { hPtr = &cl->instances ? Tcl_FirstHashEntry(&cl->instances, &hSrch) : 0; for (; hPtr != 0; hPtr = Tcl_NextHashEntry(&hSrch)) { - XOTclObject *inst = (XOTclObject*)Tcl_GetHashKey(&cl->instances, hPtr); - if (inst && (inst != (XOTclObject*)cl) && inst->id) { - if (inst != &(theobj->object)) { - (void)RemoveInstance(inst, obj->cl); - AddInstance(inst, theobj); - } - } + XOTclObject *inst = (XOTclObject*)Tcl_GetHashKey(&cl->instances, hPtr); + if (inst && (inst != (XOTclObject*)cl) && inst->id) { + if (inst != &(theobj->object)) { + (void)RemoveInstance(inst, obj->cl); + AddInstance(inst, theobj); + } + } } } Tcl_DeleteHashTable(&cl->instances); @@ -7405,7 +7412,7 @@ * -> don't do that for Object itself! */ if (subClass->super == 0 && cl != theobj) - AddSuper(subClass, theobj); + AddSuper(subClass, theobj); } while (cl->super) (void)RemoveSuper(cl, cl->super->cl); } @@ -7417,7 +7424,7 @@ */ static void CleanupInitClass(Tcl_Interp *in, XOTclClass *cl, Tcl_Namespace *namespacePtr, - int softrecreate) { + int softrecreate) { XOTclObject *obj = (XOTclObject*)cl; #ifdef OBJDELETION_TRACE @@ -7428,7 +7435,7 @@ * during init of Object and Class the theClass value is not set */ /* - if (RUNTIME_STATE(in)->theClass != 0) + if (RUNTIME_STATE(in)->theClass != 0) obj->type = RUNTIME_STATE(in)->theClass; */ XOTclObjectSetClass(obj); @@ -7519,7 +7526,7 @@ * ie. kill it, if it exists already */ if (Tcl_PushCallFrame(in, (Tcl_CallFrame *)framePtr, - RUNTIME_STATE(in)->XOTclClassesNS, 0) != TCL_OK) + RUNTIME_STATE(in)->XOTclClassesNS, 0) != TCL_OK) return; ns = NSGetFreshNamespace(in, (ClientData)cl, name); Tcl_PopCallFrame(in); @@ -7543,12 +7550,12 @@ memset(cl, 0, sizeof(XOTclClass)); MEM_COUNT_ALLOC("XOTclObject/XOTclClass",cl); /* - fprintf(stderr, " +++ CLS alloc: %s\n", name); + fprintf(stderr, " +++ CLS alloc: %s\n", name); */ assert(isAbsolutePath(name)); length = strlen(name); /* - fprintf(stderr,"Class alloc %p '%s'\n", cl, name); + fprintf(stderr,"Class alloc %p '%s'\n", cl, name); */ /* check whether Object parent NS already exists, otherwise: error */ @@ -7557,7 +7564,7 @@ return 0; } obj->id = Tcl_CreateObjCommand(in, name, XOTclObjDispatch, - (ClientData)cl, PrimitiveCDestroy); + (ClientData)cl, PrimitiveCDestroy); PrimitiveOInit(obj, in, name, class); @@ -7578,9 +7585,9 @@ if (cl != obj->cl) { if (IsMetaClass(in, cl) && !IsMetaClass(in, obj->cl)) { return XOTclVarErrMsg(in, "cannot change class of object ", - ObjStr(obj->cmdName), - " to metaclass ", - ObjStr(cl->object.cmdName),(char *) NULL); + ObjStr(obj->cmdName), + " to metaclass ", + ObjStr(cl->object.cmdName),(char *) NULL); } (void)RemoveInstance(obj, obj->cl); AddInstance(obj, cl); @@ -7597,7 +7604,7 @@ */ static int doCleanup(Tcl_Interp *in, XOTclObject *newobj, XOTclObject *classobj, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { int destroyed = 0, result; XOTclCallStack *cs = &RUNTIME_STATE(in)->cs; XOTclCallStackContent *csc; @@ -7645,7 +7652,7 @@ */ if (!(obj->flags & XOTCL_INIT_CALLED)) { result = callParameterMethodWithArg(obj, in, XOTclGlobalObjects[XOTE_SEARCH_DEFAULTS], - obj->cmdName, 3, 0, 0); + obj->cmdName, 3, 0, 0); if (result != TCL_OK) return result; } @@ -7658,7 +7665,7 @@ */ result = callMethod((ClientData) obj, in, - XOTclGlobalObjects[XOTE_CONFIGURE], objc, objv+2, 0); + XOTclGlobalObjects[XOTE_CONFIGURE], objc, objv+2, 0); if (result != TCL_OK) return result; @@ -7679,7 +7686,7 @@ if (result == TCL_OK && newargs+2 < objc) initArgsC = newargs+2; result = callMethod((ClientData) obj, in, XOTclGlobalObjects[XOTE_INIT], - initArgsC, objv+2, 0); + initArgsC, objv+2, 0); obj->flags |= XOTCL_INIT_CALLED; } @@ -7698,7 +7705,7 @@ #ifdef NOT_USED static int XOTclResolveCmd(Tcl_Interp *in, char *name, Tcl_Namespace *contextNsPtr, - int flags, Tcl_Command *rPtr) { + int flags, Tcl_Command *rPtr) { Tcl_Namespace *nsPtr[2], *cxtNsPtr; char *simpleName; @@ -7722,7 +7729,7 @@ } TclGetNamespaceForQualName(in, name, (Namespace *) contextNsPtr, - flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); + flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName); /*fprintf(stderr, " ***Found %s, %s\n", nsPtr[0]->fullName, nsPtr[0]->fullName);*/ @@ -7738,16 +7745,16 @@ cmdTable = Tcl_Namespace_cmdTable(nsPtr[search]); entryPtr = Tcl_FindHashEntry(cmdTable, simpleName); if (entryPtr != NULL) { - cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); } } } if (cmd != NULL) { Tcl_ObjCmdProc* objProc = Tcl_Command_objProc(cmd); if (cxtNsPtr->deleteProc == NSNamespaceDeleteProc && - objProc != XOTclObjDispatch && - objProc != XOTclNextObjCmd && - objProc != XOTclGetSelfObjCmd) { + objProc != XOTclObjDispatch && + objProc != XOTclNextObjCmd && + objProc != XOTclGetSelfObjCmd) { /* * the cmd is defined in an XOTcl object or class namespace, but @@ -7757,15 +7764,15 @@ cmd = 0; nsPtr[0] = Tcl_GetGlobalNamespace(in); if ((nsPtr[0] != NULL) && (simpleName != NULL)) { - cmdTable = Tcl_Namespace_cmdTable(nsPtr[0]); - if ((entryPtr = Tcl_FindHashEntry(cmdTable, simpleName))) { - cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); - } + cmdTable = Tcl_Namespace_cmdTable(nsPtr[0]); + if ((entryPtr = Tcl_FindHashEntry(cmdTable, simpleName))) { + cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + } } /* - XOTclStackDump(in); - XOTclCallStackDump(in); + XOTclStackDump(in); + XOTclCallStackDump(in); */ } *rPtr = cmd; @@ -7776,7 +7783,7 @@ } static int XOTclResolveVar(Tcl_Interp *in, char *name, Tcl_Namespace *context, - Tcl_ResolvedVarInfo *rPtr) { + Tcl_ResolvedVarInfo *rPtr) { /*fprintf(stderr, "Resolving %s in %s\n", name, context->fullName);*/ return TCL_CONTINUE; @@ -7799,8 +7806,8 @@ * call instdestroy for [self] */ return XOTclCallMethodWithArgs((ClientData)obj->cl, in, - XOTclGlobalObjects[XOTE_INSTDESTROY], obj->cmdName, - objc, objv+1, 0); + XOTclGlobalObjects[XOTE_INSTDESTROY], obj->cmdName, + objc, objv+1, 0); } static int @@ -7845,7 +7852,7 @@ XOTclObject *obj = (XOTclObject*)cd, *o; if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc < 1 || objc > 2) return XOTclObjErrArgCnt(in, obj->cmdName, - "isclass ?className?"); + "isclass ?className?"); className = (objc == 2) ? objv[1] : obj->cmdName; Tcl_SetIntObj(Tcl_GetObjResult(in), @@ -7887,9 +7894,9 @@ XOTclClassOpt* opt = pl->cl->opt; if (opt && opt->instmixins) { MixinComputeOrderFullList(in, - &opt->instmixins, - &mixinClasses, - &checkList, 0); + &opt->instmixins, + &mixinClasses, + &checkList, 0); } } @@ -7914,7 +7921,7 @@ Tcl_Obj *className; if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc < 1 || objc > 2) return XOTclObjErrArgCnt(in, obj->cmdName, - "ismetaclass ?metaClassName?"); + "ismetaclass ?metaClassName?"); className = (objc == 2) ? objv[1] : obj->cmdName; @@ -7939,8 +7946,8 @@ success = 0; for (t = ComputeOrder(subcl, subcl->order, Super); t && t->cl; t = t->next) { if (t->cl == cl) { - success = 1; - break; + success = 1; + break; } } } @@ -7976,7 +7983,7 @@ for (ml = obj->mixinOrder; ml; ml = ml->next) { XOTclClass *mixin = XOTclGetClassFromCmdPtr(ml->cmdPtr); if (mixin == cl) { - return 1; + return 1; } } } @@ -8008,7 +8015,7 @@ if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName, "exists var"); Tcl_SetIntObj(Tcl_GetObjResult(in), - varExists(in, obj, ObjStr(objv[1]),NULL, 1,1)); + varExists(in, obj, ObjStr(objv[1]),NULL, 1,1)); return TCL_OK; } @@ -8070,119 +8077,119 @@ case 'a': if (isArgsString(cmd)) { if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info args "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info args "); if (obj->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(obj->nonposArgsTable, pattern); - if (nonposArgs) { - return ListArgsFromOrdinaryArgs(in, nonposArgs); - } + XOTclNonposArgs* nonposArgs = + NonposArgsGet(obj->nonposArgsTable, pattern); + if (nonposArgs) { + return ListArgsFromOrdinaryArgs(in, nonposArgs); + } } if (nsp) - return ListProcArgs(in, Tcl_Namespace_cmdTable(nsp), pattern); + return ListProcArgs(in, Tcl_Namespace_cmdTable(nsp), pattern); else - return TCL_OK; + return TCL_OK; } break; case 'b': if (!strcmp(cmd, "body")) { if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info body "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info body "); if (nsp) - return ListProcBody(in, Tcl_Namespace_cmdTable(nsp), pattern); + return ListProcBody(in, Tcl_Namespace_cmdTable(nsp), pattern); else - return TCL_OK; + return TCL_OK; } break; case 'c': if (isClassString(cmd)) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info class ?class?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info class ?class?"); return ListClass(in, obj, pattern, objc, objv); } else if (!strcmp(cmd, "commands")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info commands ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info commands ?pat?"); if (nsp) - return ListKeys(in, Tcl_Namespace_cmdTable(nsp), pattern); + return ListKeys(in, Tcl_Namespace_cmdTable(nsp), pattern); else - return TCL_OK; + return TCL_OK; } else if (!strcmp(cmd, "children")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info children ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info children ?pat?"); return ListChildren(in, obj, pattern, 0); } else if (!strcmp(cmd, "check")) { if (objc != 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info check"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info check"); return AssertionListCheckOption(in, obj); } break; case 'd': if (!strcmp(cmd, "default")) { if (objc != 5 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info default "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info default "); if (obj->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(obj->nonposArgsTable, pattern); - if (nonposArgs) { - return ListDefaultFromOrdinaryArgs(in, pattern, nonposArgs, - ObjStr(objv[3]), objv[4]); - } + XOTclNonposArgs* nonposArgs = + NonposArgsGet(obj->nonposArgsTable, pattern); + if (nonposArgs) { + return ListDefaultFromOrdinaryArgs(in, pattern, nonposArgs, + ObjStr(objv[3]), objv[4]); + } } if (nsp) - return ListProcDefault(in, Tcl_Namespace_cmdTable(nsp), pattern, - ObjStr(objv[3]), objv[4]); + return ListProcDefault(in, Tcl_Namespace_cmdTable(nsp), pattern, + ObjStr(objv[3]), objv[4]); else - return TCL_OK; + return TCL_OK; } break; case 'f': if (!strcmp(cmd, "filter")) { int withGuards = 0, withOrder = 0; if (objc-modifiers > 3) - return XOTclObjErrArgCnt(in, obj->cmdName, - "info filter ?-guards? ?-order? ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, + "info filter ?-guards? ?-order? ?pat?"); if (modifiers > 0) { - withGuards = checkForModifier(objv, modifiers, "-guards"); - withOrder = checkForModifier(objv, modifiers, "-order"); + withGuards = checkForModifier(objv, modifiers, "-guards"); + withOrder = checkForModifier(objv, modifiers, "-order"); - if (withGuards == 0 && withOrder == 0) - return XOTclVarErrMsg(in, "info filter: unknown modifier ", - ObjStr(objv[2]), (char *) NULL); - /* - if (withGuards && withOrder) - return XOTclVarErrMsg(in, "info filter: cannot use -guards and -order together", - ObjStr(objv[2]), (char *) NULL); - */ + if (withGuards == 0 && withOrder == 0) + return XOTclVarErrMsg(in, "info filter: unknown modifier ", + ObjStr(objv[2]), (char *) NULL); + /* + if (withGuards && withOrder) + return XOTclVarErrMsg(in, "info filter: cannot use -guards and -order together", + ObjStr(objv[2]), (char *) NULL); + */ } if (withOrder) { - if (!(obj->flags & XOTCL_FILTER_ORDER_VALID)) - FilterComputeDefined(in, obj); - return FilterInfo(in, obj->filterOrder, pattern, withGuards, 1); + if (!(obj->flags & XOTCL_FILTER_ORDER_VALID)) + FilterComputeDefined(in, obj); + return FilterInfo(in, obj->filterOrder, pattern, withGuards, 1); } return opt ? FilterInfo(in, opt->filters, pattern, withGuards, 0) : TCL_OK; } else if (!strcmp(cmd, "filterguard")) { if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info filterguard filter"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info filterguard filter"); return opt ? GuardList(in, opt->filters, pattern) : TCL_OK; } else if (!strcmp(cmd, "forward")) { int argc = objc-modifiers; int definition; if (argc < 2 || argc > 3) - return XOTclObjErrArgCnt(in, obj->cmdName, - "info forward ?-definition? ?name?"); + return XOTclObjErrArgCnt(in, obj->cmdName, + "info forward ?-definition? ?name?"); definition = checkForModifier(objv, modifiers, "-definition"); if (nsp) - return forwardList(in, Tcl_Namespace_cmdTable(nsp), pattern, definition); + return forwardList(in, Tcl_Namespace_cmdTable(nsp), pattern, definition); else - return TCL_OK; + return TCL_OK; } break; @@ -8197,13 +8204,13 @@ case 'i': if (!strcmp(cmd, "invar")) { if (objc != 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info invar"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info invar"); if (opt && opt->assertions) - Tcl_SetObjResult(in, AssertionList(in, opt->assertions->invariants)); + Tcl_SetObjResult(in, AssertionList(in, opt->assertions->invariants)); return TCL_OK; } else if (!strcmp(cmd, "info")) { if (objc > 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info info"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info info"); return ListInfo(in, GetXOTclClassFromObj(in,obj->cmdName,NULL,0) == TCL_OK); } break; @@ -8212,47 +8219,47 @@ if (!strcmp(cmd, "mixin")) { int withOrder = 0, withGuards = 0; if (objc-modifiers > 3) - return XOTclObjErrArgCnt(in, obj->cmdName, - "info mixin ?-guards? ?-order? ?class?"); + return XOTclObjErrArgCnt(in, obj->cmdName, + "info mixin ?-guards? ?-order? ?class?"); if (modifiers > 0) { - withOrder = checkForModifier(objv, modifiers, "-order"); - withGuards = checkForModifier(objv, modifiers, "-guards"); + withOrder = checkForModifier(objv, modifiers, "-order"); + withGuards = checkForModifier(objv, modifiers, "-guards"); - if (withOrder == 0 && withGuards == 0) - return XOTclVarErrMsg(in, "info mixin: unknown modifier . ", - ObjStr(objv[2]), (char *) NULL); + if (withOrder == 0 && withGuards == 0) + return XOTclVarErrMsg(in, "info mixin: unknown modifier . ", + ObjStr(objv[2]), (char *) NULL); } if (withOrder) { - if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) - MixinComputeDefined(in, obj); - return MixinInfo(in, obj->mixinOrder, pattern, withGuards); + if (!(obj->flags & XOTCL_MIXIN_ORDER_VALID)) + MixinComputeDefined(in, obj); + return MixinInfo(in, obj->mixinOrder, pattern, withGuards); } return opt ? MixinInfo(in, opt->mixins, pattern, withGuards) : TCL_OK; } else if (!strcmp(cmd, "mixinguard")) { if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info mixinguard mixin"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info mixinguard mixin"); return opt ? GuardList(in, opt->mixins, pattern) : TCL_OK; } else if (!strcmp(cmd, "methods")) { int noprocs = 0, nocmds = 0, nomixins = 0, inContext = 0; if (objc-modifiers > 3) - return XOTclObjErrArgCnt(in, obj->cmdName, - "info methods ?-noprocs? ?-nocmds? ?-nomixins? ?-incontext? ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, + "info methods ?-noprocs? ?-nocmds? ?-nomixins? ?-incontext? ?pat?"); if (modifiers > 0) { - noprocs = checkForModifier(objv, modifiers, "-noprocs"); - nocmds = checkForModifier(objv, modifiers, "-nocmds"); - nomixins = checkForModifier(objv, modifiers, "-nomixins"); - inContext = checkForModifier(objv, modifiers, "-incontext"); + noprocs = checkForModifier(objv, modifiers, "-noprocs"); + nocmds = checkForModifier(objv, modifiers, "-nocmds"); + nomixins = checkForModifier(objv, modifiers, "-nomixins"); + inContext = checkForModifier(objv, modifiers, "-incontext"); } return ListMethods(in, obj, pattern, noprocs, nocmds, nomixins, inContext); } #ifdef XOTCL_METADATA - else if (!strcmp(cmd, "metadata")) { + else if (!strcmp(cmd, "metadata")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info metadata ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info metadata ?pat?"); return ListKeys(in, &obj->metaData, pattern); } #endif @@ -8261,13 +8268,13 @@ case 'n': if (!strcmp(cmd, "nonposargs")) { if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info nonposargs "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info nonposargs "); if (obj->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(obj->nonposArgsTable, pattern); - if (nonposArgs) { - Tcl_SetObjResult(in, NonposArgsFormat(in, nonposArgs->nonposArgs)); - } + XOTclNonposArgs* nonposArgs = + NonposArgsGet(obj->nonposArgsTable, pattern); + if (nonposArgs) { + Tcl_SetObjResult(in, NonposArgsFormat(in, nonposArgs->nonposArgs)); + } } return TCL_OK; } @@ -8276,32 +8283,32 @@ case 'p': if (!strcmp(cmd, "procs")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info procs ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info procs ?pat?"); if (nsp) - return ListMethodKeys(in, Tcl_Namespace_cmdTable(nsp), pattern, - /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0 ); + return ListMethodKeys(in, Tcl_Namespace_cmdTable(nsp), pattern, + /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0 ); else - return TCL_OK; + return TCL_OK; } else if (!strcmp(cmd, "parent")) { if (objc > 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info parent"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info parent"); return ListParent(in, obj); } else if (!strcmp(cmd, "pre")) { XOTclProcAssertion* procs; if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info pre "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info pre "); if (opt) { - procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); - if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre)); + procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); + if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre)); } return TCL_OK; } else if (!strcmp(cmd, "post")) { XOTclProcAssertion* procs; if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info post "); + return XOTclObjErrArgCnt(in, obj->cmdName, "info post "); if (opt) { - procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); - if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post)); + procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); + if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post)); } return TCL_OK; } else if (!strcmp(cmd, "precedence")) { @@ -8311,13 +8318,13 @@ case 'v': if (!strcmp(cmd, "vars")) { if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, obj->cmdName, "info vars ?pat?"); + return XOTclObjErrArgCnt(in, obj->cmdName, "info vars ?pat?"); return ListVars(in, obj, pattern); } break; } return XOTclErrBadVal(in, "info", - "an info option (use 'info info' to list all info options)", cmd); + "an info option (use 'info info' to list all info options)", cmd); } @@ -8331,7 +8338,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc < 4 || objc > 7) return XOTclObjErrArgCnt(in, obj->cmdName, - "proc name ?non-positional-args? args body ?preAssertion postAssertion?"); + "proc name ?non-positional-args? args body ?preAssertion postAssertion?"); if (objc == 5 || objc == 7) { incr = 1; @@ -8352,12 +8359,12 @@ if (objc > 5) { opt = XOTclRequireObjectOpt(obj); if (!opt->assertions) - opt->assertions = AssertionCreateStore(); + opt->assertions = AssertionCreateStore(); aStore = opt->assertions; } requireObjNamespace(in, obj); result = MakeProc(obj->nsPtr, aStore, &(obj->nonposArgsTable), - in, objc, (Tcl_Obj **) objv, obj); + in, objc, (Tcl_Obj **) objv, obj); } /* could be a filter => recompute filter order */ @@ -8380,18 +8387,18 @@ Tcl_Obj* XOTclOSetInstVar(XOTcl_Object *obj, Tcl_Interp *in, - Tcl_Obj *name, Tcl_Obj *value, int flgs) { + Tcl_Obj *name, Tcl_Obj *value, int flgs) { return XOTclOSetInstVar2(obj, in, name, (Tcl_Obj *)NULL, value, (flgs|TCL_PARSE_PART1)); } Tcl_Obj* XOTclOGetInstVar(XOTcl_Object *obj, Tcl_Interp *in, Tcl_Obj *name, int flgs) { - return XOTclOGetInstVar2(obj, in, name, (Tcl_Obj *)NULL, (flgs|TCL_PARSE_PART1)); + return XOTclOGetInstVar2(obj, in, name, (Tcl_Obj *)NULL, (flgs|TCL_PARSE_PART1)); } int XOTclUnsetInstVar(XOTcl_Object *obj, Tcl_Interp *in, char *name, int flgs) { - return XOTclUnsetInstVar2 (obj, in, name,(char *)NULL, flgs); + return XOTclUnsetInstVar2 (obj, in, name,(char *)NULL, flgs); } extern int @@ -8400,7 +8407,7 @@ int result; INCR_REF_COUNT(name); result = XOTclCallMethodWithArgs((ClientData)cl, in, - XOTclGlobalObjects[XOTE_CREATE], name, 1, 0, 0); + XOTclGlobalObjects[XOTE_CREATE], name, 1, 0, 0); DECR_REF_COUNT(name); return result; } @@ -8411,7 +8418,7 @@ int result; INCR_REF_COUNT(name); result = XOTclCallMethodWithArgs((ClientData)cl, in, - XOTclGlobalObjects[XOTE_CREATE], name, 1, 0, 0); + XOTclGlobalObjects[XOTE_CREATE], name, 1, 0, 0); DECR_REF_COUNT(name); return result; } @@ -8430,7 +8437,7 @@ extern Tcl_Obj* XOTclOSetInstVar2(XOTcl_Object *obji, Tcl_Interp *in, Tcl_Obj *name1, Tcl_Obj *name2, - Tcl_Obj *value, int flgs) { + Tcl_Obj *value, int flgs) { XOTclObject *obj = (XOTclObject*) obji; Tcl_Obj *result; XOTcl_FrameDecls; @@ -8446,7 +8453,7 @@ extern int XOTclUnsetInstVar2(XOTcl_Object *obji, Tcl_Interp *in, char *name1, char *name2, - int flgs) { + int flgs) { XOTclObject *obj = (XOTclObject*) obji; int result; XOTcl_FrameDecls; @@ -8462,7 +8469,7 @@ static int GetInstVarIntoCurrentScope(Tcl_Interp *in, XOTclObject *obj, - Tcl_Obj *varName, Tcl_Obj *newName) { + Tcl_Obj *varName, Tcl_Obj *newName) { Var *varPtr = NULL, *otherPtr = NULL, *arrayPtr; int new; Tcl_CallFrame *varFramePtr; @@ -8478,12 +8485,12 @@ } otherPtr = XOTclObjLookupVar(in, varName, (char *) NULL, flgs, "define", - /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); + /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); XOTcl_PopFrame(in, obj); if (otherPtr == NULL) { return XOTclVarErrMsg(in, "can't make instvar ", ObjStr(varName), - ": can't find variable on ", ObjStr(obj->cmdName), + ": can't find variable on ", ObjStr(obj->cmdName), (char *) NULL); } @@ -8498,9 +8505,9 @@ */ if (arrayPtr) { return XOTclVarErrMsg(in, "can't make instvar ", ObjStr(varName), - " on ", ObjStr(obj->cmdName), - ": variable cannot be an element in an array;", - " use an alias or objeval.", (char *) NULL); + " on ", ObjStr(obj->cmdName), + ": variable cannot be an element in an array;", + " use an alias or objeval.", (char *) NULL); } newName = varName; @@ -8523,28 +8530,28 @@ for (i = 0; i < localCt; i++) { /* look in compiled locals */ /* fprintf(stderr,"%d of %d %s flags %x not isTemp %d\n",i,localCt, - localPtr->name,localPtr->flags, - !TclIsCompiledLocalTemporary(localPtr));*/ + localPtr->name,localPtr->flags, + !TclIsCompiledLocalTemporary(localPtr));*/ if (!TclIsCompiledLocalTemporary(localPtr)) { - char *localName = localPtr->name; - if ((newNameString[0] == localName[0]) - && (nameLen == localPtr->nameLength) - && (strcmp(newNameString, localName) == 0)) { - varPtr = getNthVar(localVarPtr,i); - new = 0; - break; - } + char *localName = localPtr->name; + if ((newNameString[0] == localName[0]) + && (nameLen == localPtr->nameLength) + && (strcmp(newNameString, localName) == 0)) { + varPtr = getNthVar(localVarPtr,i); + new = 0; + break; + } } localPtr = localPtr->nextPtr; } if (varPtr == NULL) { /* look in frame's local var hashtable */ tablePtr = Tcl_CallFrame_varTablePtr(varFramePtr); if (tablePtr == NULL) { - tablePtr = (TclVarHashTable *) ckalloc(varHashTableSize); - InitVarHashTable(tablePtr, NULL); - Tcl_CallFrame_varTablePtr(varFramePtr) = tablePtr; + tablePtr = (TclVarHashTable *) ckalloc(varHashTableSize); + InitVarHashTable(tablePtr, NULL); + Tcl_CallFrame_varTablePtr(varFramePtr) = tablePtr; } varPtr = VarHashCreateVar(tablePtr, newName, &new); } @@ -8554,29 +8561,29 @@ */ if (!new) { if (varPtr == otherPtr) - return XOTclVarErrMsg(in, "can't instvar to variable itself", + return XOTclVarErrMsg(in, "can't instvar to variable itself", (char *) NULL); if (TclIsVarLink(varPtr)) { - /* we try to make the same instvar again ... this is ok */ - Var *linkPtr = valueOfVar(Var,varPtr,linkPtr); - if (linkPtr == otherPtr) { - return TCL_OK; - } + /* we try to make the same instvar again ... this is ok */ + Var *linkPtr = valueOfVar(Var,varPtr,linkPtr); + if (linkPtr == otherPtr) { + return TCL_OK; + } - /*fprintf(stderr, "linkvar flags=%x\n",linkPtr->flags); + /*fprintf(stderr, "linkvar flags=%x\n",linkPtr->flags); panic("new linkvar %s... When does this happen?",newNameString,NULL);*/ /* We have already a variable with the same name imported from a different object. Get rid of this old variable */ - VarHashRefCount(linkPtr)--; - if (TclIsVarUndefined(linkPtr)) { + VarHashRefCount(linkPtr)--; + if (TclIsVarUndefined(linkPtr)) { CleanupVar(linkPtr, (Var *) NULL); } } else if (!TclIsVarUndefined(varPtr)) { - return XOTclVarErrMsg(in, "variable '", ObjStr(newName), + return XOTclVarErrMsg(in, "variable '", ObjStr(newName), "' exists already", (char *) NULL); } else if (TclIsVarTraced(varPtr)) { return XOTclVarErrMsg(in, "variable '", ObjStr(newName), @@ -8588,25 +8595,25 @@ TclClearVarUndefined(varPtr); #if FORWARD_COMPATIBLE if (forwardCompatibleMode) { - Var85 *vPtr = (Var85 *)varPtr; - vPtr->value.linkPtr = (Var85 *)otherPtr; + Var85 *vPtr = (Var85 *)varPtr; + vPtr->value.linkPtr = (Var85 *)otherPtr; } else { - varPtr->value.linkPtr = otherPtr; + varPtr->value.linkPtr = otherPtr; } #else varPtr->value.linkPtr = otherPtr; #endif VarHashRefCount(otherPtr)++; - /* - { - Var85 *p = (Var85 *)varPtr; - fprintf(stderr,"defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n", - ObjStr(newName), ObjStr(obj->cmdName), forwardCompatibleMode, - varFlags(varPtr), - TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr)); - } - */ + /* + { + Var85 *p = (Var85 *)varPtr; + fprintf(stderr,"defining an alias var='%s' in obj %s fwd %d flags %x isLink %d isTraced %d isUndefined %d\n", + ObjStr(newName), ObjStr(obj->cmdName), forwardCompatibleMode, + varFlags(varPtr), + TclIsVarLink(varPtr), TclIsVarTraced(varPtr), TclIsVarUndefined(varPtr)); + } + */ } return TCL_OK; } @@ -8730,7 +8737,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc < 2) return XOTclObjErrArgCnt(in, obj->cmdName, - "?level? otherVar localVar ?otherVar localVar ...?"); + "?level? otherVar localVar ?otherVar localVar ...?"); if (objc % 2 == 0) { frameInfo = ObjStr(objv[1]); @@ -8748,7 +8755,7 @@ for ( ; i < objc; i += 2) { result = Tcl_UpVar2(in, frameInfo, ObjStr(objv[i]), NULL, - ObjStr(objv[i+1]), 0 /*flags*/); + ObjStr(objv[i+1]), 0 /*flags*/); if (result != TCL_OK) break; } @@ -8834,8 +8841,8 @@ static int forwardArg(Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[], - Tcl_Obj *o, forwardCmdClientData *tcd, Tcl_Obj **out, - Tcl_Obj **freeList, int *inputarg, int *mapvalue) { + Tcl_Obj *o, forwardCmdClientData *tcd, Tcl_Obj **out, + Tcl_Obj **freeList, int *inputarg, int *mapvalue) { char *element = ObjStr(o), *p; int totalargs = objc + tcd->nr_args - 1; char c = *element, c1; @@ -8854,10 +8861,10 @@ } if (element == remainder || abs(pos) > totalargs) { return XOTclVarErrMsg(in, "forward: invalid index specified in argument ", - ObjStr(o), (char *) NULL); + ObjStr(o), (char *) NULL); } if (!remainder || *remainder != ' ') { return XOTclVarErrMsg(in, "forward: invaild syntax in '", ObjStr(o), - "' use: %@ ",(char *) NULL); + "' use: %@ ",(char *) NULL); } element = ++remainder; @@ -8880,43 +8887,43 @@ *out = objv[0]; } else if (c == '1' && (c1 == '\0' || c1 == ' ')) { /*fprintf(stderr, " nrargs=%d, subcommands=%d inputarg=%d, objc=%d\n", - nrargs, tcd->nr_subcommands, inputarg, objc);*/ + nrargs, tcd->nr_subcommands, inputarg, objc);*/ if (c1 != '\0') { - if (Tcl_ListObjIndex(in, o, 1, &list) != TCL_OK) { - return XOTclVarErrMsg(in, "forward: %1 must by a valid list, given: '", - ObjStr(o), "'", (char *) NULL); - } - if (Tcl_ListObjGetElements(in, list, &nrElements, &listElements) != TCL_OK) { - return XOTclVarErrMsg(in, "forward: %1 contains invalid list '", - ObjStr(list),"'", (char *) NULL); - } + if (Tcl_ListObjIndex(in, o, 1, &list) != TCL_OK) { + return XOTclVarErrMsg(in, "forward: %1 must by a valid list, given: '", + ObjStr(o), "'", (char *) NULL); + } + if (Tcl_ListObjGetElements(in, list, &nrElements, &listElements) != TCL_OK) { + return XOTclVarErrMsg(in, "forward: %1 contains invalid list '", + ObjStr(list),"'", (char *) NULL); + } } else if (tcd->subcommands) { /* deprecated part */ - if (Tcl_ListObjGetElements(in, tcd->subcommands,&nrElements,&listElements) != TCL_OK) { - return XOTclVarErrMsg(in, "forward: %1 contains invalid list '", - ObjStr(list),"'", (char *) NULL); - } + if (Tcl_ListObjGetElements(in, tcd->subcommands,&nrElements,&listElements) != TCL_OK) { + return XOTclVarErrMsg(in, "forward: %1 contains invalid list '", + ObjStr(list),"'", (char *) NULL); + } } if (nrElements > nrargs) { - /* insert default subcommand depending on number of arguments */ - *out = listElements[nrargs]; + /* insert default subcommand depending on number of arguments */ + *out = listElements[nrargs]; } else if (objc<=1) { - return XOTclObjErrArgCnt(in, objv[0], "no argument given"); + return XOTclObjErrArgCnt(in, objv[0], "no argument given"); } else { - *out = objv[1]; - *inputarg = 2; + *out = objv[1]; + *inputarg = 2; } } else if (c == 'a' && !strncmp(element,"argcl", 4)) { if (Tcl_ListObjIndex(in, o, 1, &list) != TCL_OK) { - return XOTclVarErrMsg(in, "forward: %argclindex must by a valid list, given: '", - ObjStr(o), "'", (char *) NULL); + return XOTclVarErrMsg(in, "forward: %argclindex must by a valid list, given: '", + ObjStr(o), "'", (char *) NULL); } if (Tcl_ListObjGetElements(in, list, &nrElements, &listElements) != TCL_OK) { - return XOTclVarErrMsg(in, "forward: %argclindex contains invalid list '", - ObjStr(list),"'", (char *) NULL); + return XOTclVarErrMsg(in, "forward: %argclindex contains invalid list '", + ObjStr(list),"'", (char *) NULL); } if (nrargs >= nrElements) { - return XOTclVarErrMsg(in, "forward: not enough elements in specified list of ARGC argument ", - ObjStr(o), (char *) NULL); + return XOTclVarErrMsg(in, "forward: not enough elements in specified list of ARGC argument ", + ObjStr(o), (char *) NULL); } *out = listElements[nrargs]; } else if (c == '%') { @@ -8928,7 +8935,7 @@ int result; /*fprintf(stderr,"evaluating '%s'\n",element);*/ if ((result = Tcl_EvalEx(in, element, -1, 0)) != TCL_OK) - return result; + return result; *out = Tcl_DuplicateObj(Tcl_GetObjResult(in)); /*fprintf(stderr,"result = '%s'\n",ObjStr(*out));*/ goto add_to_freelist; @@ -8971,7 +8978,7 @@ if (tcd->objProc) { result = (tcd->objProc)(tcd->cd, in, objc, objv); } else if (tcd->cmdName->typePtr == &XOTclObjectType - && XOTclObjConvertObject(in, tcd->cmdName, (void*)&cd) == TCL_OK) { + && XOTclObjConvertObject(in, tcd->cmdName, (void*)&cd) == TCL_OK) { /*fprintf(stderr, "XOTcl object %s, objc=%d\n", ObjStr(tcd->cmdName),objc);*/ result = ObjDispatch(cd, in, objc, objv, 0); } else { @@ -8996,8 +9003,8 @@ (Tcl_CallFrame *) Tcl_Interp_varFramePtr(in); /* fprintf(stderr,"...setting currentFramePtr %p to %p (ForwardMethod)\n", - RUNTIME_STATE(in)->cs.top->currentFramePtr, - (Tcl_CallFrame *) Tcl_Interp_varFramePtr(in)); */ + RUNTIME_STATE(in)->cs.top->currentFramePtr, + (Tcl_CallFrame *) Tcl_Interp_varFramePtr(in)); */ if (tcd->passthrough) { /* two short cuts for simple cases */ @@ -9024,17 +9031,17 @@ #if 0 fprintf(stderr,"command %s (%p) objc=%d, subcommand=%d, args=%p, nrargs\n", - ObjStr(objv[0]), tcd, objc, - tcd->nr_subcommands, - tcd->args - ); + ObjStr(objv[0]), tcd, objc, + tcd->nr_subcommands, + tcd->args + ); #endif /* the first argument is always the command, to which we forward */ if ((result = forwardArg(in, objc, objv, tcd->cmdName, tcd, - &ov[outputarg], &freeList, &inputarg, - &objvmap[outputarg])) != TCL_OK) { + &ov[outputarg], &freeList, &inputarg, + &objvmap[outputarg])) != TCL_OK) { goto exitforwardmethod; } outputarg++; @@ -9046,20 +9053,20 @@ Tcl_ListObjGetElements(in, tcd->args, &nrElements, &listElements); for (j=0; jnr_subcommands=%d size=%d\n", + fprintf(stderr, "objc=%d, tcd->nr_subcommands=%d size=%d\n", objc, tcd->nr_subcommands, objc+ 2 );*/ if (objc-inputarg>0) { /*fprintf(stderr, " copying remaining %d args starting at [%d]\n", - objc-inputarg, outputarg);*/ + objc-inputarg, outputarg);*/ memcpy(ov+outputarg, objv+inputarg, sizeof(Tcl_Obj *)*(objc-inputarg)); } else { /*fprintf(stderr, " nothing to copy, objc=%d, inputarg=%d\n", objc, inputarg);*/ @@ -9076,27 +9083,27 @@ if (tcd->needobjmap) for (j=0; jpos) { - for(i=j; i>pos; i--) { - /*fprintf(stderr,"...moving right %d to %d\n",i-1,i);*/ - ov[i] = ov[i-1]; - objvmap[i] = objvmap[i-1]; - } - } else { - for(i=j; i %s\n",pos,ObjStr(tmp)); */ - ov[pos] = tmp; - objvmap[pos] = -1; + Tcl_Obj *tmp; + int pos = objvmap[j], i; + if (pos == -1 || pos == j) + continue; + tmp = ov[j]; + if (j>pos) { + for(i=j; i>pos; i--) { + /*fprintf(stderr,"...moving right %d to %d\n",i-1,i);*/ + ov[i] = ov[i-1]; + objvmap[i] = objvmap[i-1]; + } + } else { + for(i=j; i %s\n",pos,ObjStr(tmp)); */ + ov[pos] = tmp; + objvmap[pos] = -1; } if (tcd->prefix) { @@ -9144,7 +9151,7 @@ if (!Tcl_Interp_varFramePtr(in)) { CallStackRestoreSavedFrames(in, &ctx); return XOTclVarErrMsg(in, "instvar used on ", ObjStr(obj->cmdName), - ", but callstack is not in procedure scope", + ", but callstack is not in procedure scope", (char *) NULL); } @@ -9158,13 +9165,13 @@ case 2: {varname = ov[0]; alias = ov[1]; break;} } if (varname) { - result = GetInstVarIntoCurrentScope(in, obj, varname, alias); + result = GetInstVarIntoCurrentScope(in, obj, varname, alias); } else { - result = XOTclVarErrMsg(in, "invalid variable specification '", - ObjStr(objv[i]), "'", (char *) NULL); + result = XOTclVarErrMsg(in, "invalid variable specification '", + ObjStr(objv[i]), "'", (char *) NULL); } if (result != TCL_OK) { - break; + break; } } else { break; @@ -9179,16 +9186,16 @@ */ static char * VwaitVarProc(clientData, interp, name1, name2, flags) - ClientData clientData; /* Pointer to integer to set to 1. */ - Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable. */ - char *name2; /* Second part of variable name. */ - int flags; /* Information about what happened. */ + ClientData clientData; /* Pointer to integer to set to 1. */ + Tcl_Interp *interp; /* Interpreter containing variable. */ + char *name1; /* Name of variable. */ + char *name2; /* Second part of variable name. */ + int flags; /* Information about what happened. */ { - int *donePtr = (int *) clientData; + int *donePtr = (int *) clientData; - *donePtr = 1; - return (char *) NULL; + *donePtr = 1; + return (char *) NULL; } static int XOTclOVwaitMethod(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) { @@ -9200,7 +9207,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc != 2) - return XOTclObjErrArgCnt(in, obj->cmdName, "vwait varname"); + return XOTclObjErrArgCnt(in, obj->cmdName, "vwait varname"); nameString = ObjStr(objv[1]); @@ -9209,7 +9216,7 @@ */ if (NSRequireVariableOnObj(in, obj, nameString, flgs) == 0) return XOTclVarErrMsg(in, "Can't lookup (and create) variable ", - nameString, " on ", ObjStr(obj->cmdName), + nameString, " on ", ObjStr(obj->cmdName), (char *) NULL); XOTcl_PushFrame(in, obj); @@ -9219,7 +9226,7 @@ * obj->varTable vars */ if (Tcl_TraceVar(in, nameString, flgs, (Tcl_VarTraceProc *)VwaitVarProc, - (ClientData) &done) != TCL_OK) { + (ClientData) &done) != TCL_OK) { return TCL_ERROR; } done = 0; @@ -9228,7 +9235,7 @@ foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); } Tcl_UntraceVar(in, nameString, flgs, (Tcl_VarTraceProc *)VwaitVarProc, - (ClientData) &done); + (ClientData) &done); XOTcl_PopFrame(in, obj); /* * Clear out the interpreter's result, since it may have been set @@ -9250,7 +9257,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc != 2) - return XOTclObjErrArgCnt(in, obj->cmdName, "invar "); + return XOTclObjErrArgCnt(in, obj->cmdName, "invar "); opt = XOTclRequireObjectOpt(obj); @@ -9284,8 +9291,8 @@ } else return XOTclVarErrMsg(in, - "Autoname failed. Probably format string (with %) was not well-formed", - (char *) NULL); + "Autoname failed. Probably format string (with %) was not well-formed", + (char *) NULL); return TCL_OK; } @@ -9301,7 +9308,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc != 2) return XOTclObjErrArgCnt(in, obj->cmdName, - "check (?all? ?pre? ?post? ?invar? ?instinvar?)"); + "check (?all? ?pre? ?post? ?invar? ?instinvar?)"); opt = XOTclRequireObjectOpt(obj); opt->checkoptions = CHECK_NONE; @@ -9311,35 +9318,35 @@ for (i = 0; i < ocArgs; i++) { char *option = ObjStr(ovArgs[i]); if (option != 0) { - switch (*option) { - case 'i': - if (strcmp(option, "instinvar") == 0) { - opt->checkoptions |= CHECK_CLINVAR; - } else if (strcmp(option, "invar") == 0) { - opt->checkoptions |= CHECK_OBJINVAR; - } - break; - case 'p': - if (strcmp(option, "pre") == 0) { - opt->checkoptions |= CHECK_PRE; - } else if (strcmp(option, "post") == 0) { - opt->checkoptions |= CHECK_POST; - } - break; - case 'a': - if (strcmp(option, "all") == 0) { - opt->checkoptions |= CHECK_ALL; - } - break; - } + switch (*option) { + case 'i': + if (strcmp(option, "instinvar") == 0) { + opt->checkoptions |= CHECK_CLINVAR; + } else if (strcmp(option, "invar") == 0) { + opt->checkoptions |= CHECK_OBJINVAR; + } + break; + case 'p': + if (strcmp(option, "pre") == 0) { + opt->checkoptions |= CHECK_PRE; + } else if (strcmp(option, "post") == 0) { + opt->checkoptions |= CHECK_POST; + } + break; + case 'a': + if (strcmp(option, "all") == 0) { + opt->checkoptions |= CHECK_ALL; + } + break; + } } } } if (opt->checkoptions == CHECK_NONE && ocArgs>0) { return XOTclVarErrMsg(in, "Unknown check option in command '", - ObjStr(obj->cmdName), " ", ObjStr(objv[0]), - " ", ObjStr(objv[1]), - "', valid: all pre post invar instinvar", + ObjStr(obj->cmdName), " ", ObjStr(objv[0]), + " ", ObjStr(objv[1]), + "', valid: all pre post invar instinvar", (char *) NULL); } @@ -9360,7 +9367,7 @@ if (objc < 2 || objc>3) return XOTclObjErrArgCnt(in, objv[0], - "::xotcl::configure filter|softrecreate ?on|off?"); + "::xotcl::configure filter|softrecreate ?on|off?"); if (Tcl_GetIndexFromObj(in, objv[1], opts, "option", 0, &opt) != TCL_OK) { return TCL_ERROR; @@ -9373,16 +9380,16 @@ switch (opt) { case filterIdx: Tcl_SetBooleanObj(Tcl_GetObjResult(in), - (RUNTIME_STATE(in)->doFilters)); + (RUNTIME_STATE(in)->doFilters)); if (objc == 3) - RUNTIME_STATE(in)->doFilters = bool; + RUNTIME_STATE(in)->doFilters = bool; break; case softrecreateIdx: Tcl_SetBooleanObj(Tcl_GetObjResult(in), - (RUNTIME_STATE(in)->doSoftrecreate)); + (RUNTIME_STATE(in)->doSoftrecreate)); if (objc == 3) - RUNTIME_STATE(in)->doSoftrecreate = bool; + RUNTIME_STATE(in)->doSoftrecreate = bool; break; } } @@ -9411,7 +9418,7 @@ static int XOTclAliasCommand(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { XOTclObject *obj = NULL; XOTclClass *cl = NULL; Tcl_Command cmd = NULL; @@ -9423,7 +9430,7 @@ if (objc < 4 || objc > 6) { return XOTclObjErrArgCnt(in, objv[0], - "| ?-objscope? ?-per-object? "); + "| ?-objscope? ?-per-object? "); } GetXOTclClassFromObj(in, objv[1], &cl, 1); @@ -9447,19 +9454,19 @@ allocation = 'o'; } else { return XOTclErrBadVal(in, "::xotcl::alias", - "option -objscope or -per-object", optionName); + "option -objscope or -per-object", optionName); } } cmd = Tcl_GetCommandFromObj(in, objv[i]); if (cmd == NULL) return XOTclVarErrMsg(in, "cannot lookup command '", - ObjStr(objv[i]), "'", (char *) NULL); + ObjStr(objv[i]), "'", (char *) NULL); objProc = Tcl_Command_objProc(cmd); if (objc>i+1) { return XOTclVarErrMsg(in, "invalid argument '", - ObjStr(objv[i+1]), "'", (char *) NULL); + ObjStr(objv[i+1]), "'", (char *) NULL); } if (objscope) { @@ -9548,7 +9555,7 @@ GetXOTclClassFromObj(in, objv[1], &cl, 1); if (!cl) return XOTclObjErrType(in, objv[1], "Class"); if (Tcl_ListObjGetElements(in, objv[3], &oc, &ov) != TCL_OK) - return TCL_ERROR; + return TCL_ERROR; return SuperclassAdd(in, cl, oc, ov, objv[3]); } case classIdx: @@ -9565,21 +9572,21 @@ case mixinIdx: { if (objopt->mixins) { - register XOTclCmdList* cmdlist = objopt->mixins; - XOTclCmdList* del; - while (cmdlist != 0) { - cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); - clopt = XOTclRequireClassOpt(cl); - del = CmdListFindCmdInList(obj->id, clopt->mixinofs); - if (del) { - /* fprintf(stderr,"Removing object %s from mixinofs of class %s\n", - ObjStr(obj->cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ - del = CmdListRemoveFromList(&clopt->mixinofs,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - cmdlist = cmdlist->next; - } - CmdListRemoveList(&objopt->mixins, GuardDel); + XOTclCmdList *cmdlist, *del; + for (cmdlist = objopt->mixins; cmdlist; cmdlist = cmdlist->next) { + cl = XOTclGetClassFromCmdPtr(cmdlist->cmdPtr); + clopt = cl ? cl->opt : NULL; + if (clopt) { + del = CmdListFindCmdInList(obj->id, clopt->mixinofs); + if (del) { + /* fprintf(stderr,"Removing object %s from mixinofs of class %s\n", + ObjStr(obj->cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ + del = CmdListRemoveFromList(&clopt->mixinofs,del); + CmdListDeleteCmdListEntry(del, GuardDel); + } + } + } + CmdListRemoveList(&objopt->mixins, GuardDel); } obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; @@ -9588,18 +9595,24 @@ */ obj->flags &= ~XOTCL_FILTER_ORDER_VALID; + /* + * now add the specified mixins + */ for (i = 0; i < oc; i++) { - if (MixinAdd(in, &objopt->mixins, ov[i]) != TCL_OK) - return TCL_ERROR; - /* fprintf(stderr,"Added to mixins of %s: %s\n", ObjStr(obj->cmdName), ObjStr(ov[i])); */ - Tcl_Obj* ocl = NULL; - Tcl_ListObjIndex(in, ov[i], 0, &ocl); - XOTclObjConvertObject(in, ocl, &nobj); - if (nobj) { - /* fprintf(stderr,"Registering object %s to mixinofs of class %s\n",ObjStr(obj->cmdName),ObjStr(nobj->cmdName)); */ - nclopt = XOTclRequireClassOpt((XOTclClass*) nobj); - CmdListAdd(&nclopt->mixinofs, obj->id, NULL, /*noDuplicates*/ 1); - } /* else fprintf(stderr,"Problem registering %s as a mixinof of %s\n",ObjStr(ov[i]),ObjStr(cl->object.cmdName)); */ + Tcl_Obj* ocl = NULL; + if (MixinAdd(in, &objopt->mixins, ov[i]) != TCL_OK) { + return TCL_ERROR; + } + /* fprintf(stderr,"Added to mixins of %s: %s\n", ObjStr(obj->cmdName), ObjStr(ov[i])); */ + Tcl_ListObjIndex(in, ov[i], 0, &ocl); + XOTclObjConvertObject(in, ocl, &nobj); + if (nobj) { + /* fprintf(stderr,"Registering object %s to mixinofs of class %s\n", + ObjStr(obj->cmdName),ObjStr(nobj->cmdName)); */ + nclopt = XOTclRequireClassOpt((XOTclClass*) nobj); + CmdListAdd(&nclopt->mixinofs, obj->id, NULL, /*noDuplicates*/ 1); + } /* else fprintf(stderr,"Problem registering %s as a mixinof of %s\n", + ObjStr(ov[i]),ObjStr(cl->object.cmdName)); */ } MixinComputeDefined(in, obj); @@ -9612,51 +9625,43 @@ obj->flags &= ~XOTCL_FILTER_ORDER_VALID; for (i = 0; i < oc; i ++) { - if (FilterAdd(in, &objopt->filters, ov[i], obj, 0) != TCL_OK) - return TCL_ERROR; + if (FilterAdd(in, &objopt->filters, ov[i], obj, 0) != TCL_OK) + return TCL_ERROR; } /*FilterComputeDefined(in, obj);*/ break; } - + case instmixinIdx: { if (clopt->instmixins) { - register XOTclCmdList* cmdlist = clopt->instmixins; - XOTclCmdList* del; - Tcl_Command cmd = Tcl_GetCommandFromObj(in, cl->object.cmdName); - while (cmdlist != 0) { - nclopt = XOTclRequireClassOpt(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)); - del = CmdListFindCmdInList(cmd, nclopt->instmixinofs); - if (del) { - /* fprintf(stderr,"Removing class %s from instmixinofs of class %s\n", - ObjStr(cl->object.cmdName),ObjStr(XOTclGetClassFromCmdPtr(cmdlist->cmdPtr)->object.cmdName)); */ - del = CmdListRemoveFromList(&nclopt->instmixinofs,del); - CmdListDeleteCmdListEntry(del, GuardDel); - } - cmdlist = cmdlist->next; - } - CmdListRemoveList(&clopt->instmixins, GuardDel); + RemoveFromInstmixinsofs(cl->object.id, clopt->instmixins); + CmdListRemoveList(&clopt->instmixins, GuardDel); } - + MixinInvalidateObjOrders(in, cl); /* * since mixin procs may be used as filters -> we have to invalidate */ FilterInvalidateObjOrders(in, cl); for (i = 0; i < oc; i++) { - if (MixinAdd(in, &clopt->instmixins, ov[i]) != TCL_OK) - return TCL_ERROR; - /* fprintf(stderr,"Added to instmixins of %s: %s\n", ObjStr(cl->object.cmdName), ObjStr(ov[i])); */ - Tcl_Obj* ocl = NULL; - Tcl_ListObjIndex(in, ov[i], 0, &ocl); - XOTclObjConvertObject(in, ocl, &nobj); - if (nobj) { - /* fprintf(stderr,"Registering class %s to instmixinofs of class %s\n",ObjStr(cl->object.cmdName),ObjStr(nobj->cmdName)); */ - nclopt = XOTclRequireClassOpt((XOTclClass*) nobj); - CmdListAdd(&nclopt->instmixinofs, cl->object.id, NULL, /*noDuplicates*/ 1); - } /* else fprintf(stderr,"Problem registering %s as a instmixinof of %s\n",ObjStr(ov[i]),ObjStr(cl->object.cmdName)); */ + Tcl_Obj* ocl = NULL; + if (MixinAdd(in, &clopt->instmixins, ov[i]) != TCL_OK) { + return TCL_ERROR; + } + /* fprintf(stderr,"Added to instmixins of %s: %s\n", + ObjStr(cl->object.cmdName), ObjStr(ov[i])); */ + + Tcl_ListObjIndex(in, ov[i], 0, &ocl); + XOTclObjConvertObject(in, ocl, &nobj); + if (nobj) { + /* fprintf(stderr,"Registering class %s to instmixinofs of class %s\n", + ObjStr(cl->object.cmdName),ObjStr(nobj->cmdName)); */ + nclopt = XOTclRequireClassOpt((XOTclClass*) nobj); + CmdListAdd(&nclopt->instmixinofs, cl->object.id, NULL, /*noDuplicates*/ 1); + } /* else fprintf(stderr,"Problem registering %s as a instmixinof of %s\n", + ObjStr(ov[i]),ObjStr(cl->object.cmdName)); */ } break; } @@ -9667,8 +9672,8 @@ FilterInvalidateObjOrders(in, cl); for (i = 0; i < oc; i ++) { - if (FilterAdd(in, &clopt->instfilters, ov[i], 0, cl) != TCL_OK) - return TCL_ERROR; + if (FilterAdd(in, &clopt->instfilters, ov[i], 0, cl) != TCL_OK) + return TCL_ERROR; } break; } @@ -9697,17 +9702,17 @@ if (mixinCmd) { h = CmdListFindCmdInList(mixinCmd, opt->mixins); if (h) { - if (h->clientData) - GuardDel((XOTclCmdList*) h); - GuardAdd(in, h, objv[2]); - obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; - return TCL_OK; + if (h->clientData) + GuardDel((XOTclCmdList*) h); + GuardAdd(in, h, objv[2]); + obj->flags &= ~XOTCL_MIXIN_ORDER_VALID; + return TCL_OK; } } } return XOTclVarErrMsg(in, "Mixinguard: can't find mixin ", - ObjStr(objv[1]), " on ", ObjStr(obj->cmdName), + ObjStr(objv[1]), " on ", ObjStr(obj->cmdName), (char *) NULL); } @@ -9727,15 +9732,15 @@ h = CmdListFindNameInList(in, ObjStr(objv[1]), opt->filters); if (h) { if (h->clientData) - GuardDel((XOTclCmdList*) h); + GuardDel((XOTclCmdList*) h); GuardAdd(in, h, objv[2]); obj->flags &= ~XOTCL_FILTER_ORDER_VALID; return TCL_OK; } } return XOTclVarErrMsg(in, "Filterguard: can't find filter ", - ObjStr(objv[1]), " on ", ObjStr(obj->cmdName), + ObjStr(objv[1]), " on ", ObjStr(obj->cmdName), (char *) NULL); } @@ -9782,8 +9787,8 @@ } Tcl_SetObjResult(in, - getFullProcQualifier(in, methodName, fobj, fcl, - cmdList->cmdPtr)); + getFullProcQualifier(in, methodName, fobj, fcl, + cmdList->cmdPtr)); return TCL_OK; } @@ -9811,11 +9816,11 @@ if (obj->flags & XOTCL_MIXIN_ORDER_DEFINED_AND_VALID) { XOTclCmdList* mixinList = obj->mixinOrder; while (mixinList) { - XOTclClass *mcl = XOTclpGetClass(in, (char *)Tcl_GetCommandName(in, mixinList->cmdPtr)); - if (mcl && (pcl = SearchCMethod(mcl, methodName, &cmd))) { - break; - } - mixinList = mixinList->next; + XOTclClass *mcl = XOTclpGetClass(in, (char *)Tcl_GetCommandName(in, mixinList->cmdPtr)); + if (mcl && (pcl = SearchCMethod(mcl, methodName, &cmd))) { + break; + } + mixinList = mixinList->next; } } } @@ -9852,7 +9857,7 @@ assert(obj); /* fetch list type, if not set already; if used on more places, this should - be moved into the interpreter state + be moved into the interpreter state */ if (listType == NULL) { #if defined(PRE82) @@ -9875,8 +9880,8 @@ flag = ObjStr(*objv[0]); /*fprintf(stderr, "we have a list starting with '%s'\n", flag);*/ if (*flag == '-') { - *methodName = flag+1; - return LIST_DASH; + *methodName = flag+1; + return LIST_DASH; } } } @@ -9892,7 +9897,7 @@ static int callConfigureMethod(Tcl_Interp *in, XOTclObject *obj, - char *methodName, int argc, Tcl_Obj *CONST argv[]) { + char *methodName, int argc, Tcl_Obj *CONST argv[]) { int result; Tcl_Obj *method = Tcl_NewStringObj(methodName,-1); @@ -9929,7 +9934,7 @@ if (!obj) return XOTclObjErrType(in, objv[0], "Object"); if (objc < 1) return XOTclObjErrArgCnt(in, obj->cmdName, - "configure ?args?"); + "configure ?args?"); /* find arguments without leading dash */ for (i=1; i < objc; i++) { if ((isdasharg = isDashArg(in, objv[i], &methodName, &argc, &argv))) @@ -9942,28 +9947,28 @@ switch (isdasharg) { case SKALAR_DASH: /* argument is a skalar with a leading dash */ { int j; - for (j = i+1; j < objc; j++, argc++) { - if ((isdasharg = isDashArg(in, objv[j], &nextMethodName, &nextArgc, &nextArgv))) - break; - } - result = callConfigureMethod(in, obj, methodName, argc+1, objv+i+1); - if (result != TCL_OK) - return result; - i += argc; - break; + for (j = i+1; j < objc; j++, argc++) { + if ((isdasharg = isDashArg(in, objv[j], &nextMethodName, &nextArgc, &nextArgv))) + break; + } + result = callConfigureMethod(in, obj, methodName, argc+1, objv+i+1); + if (result != TCL_OK) + return result; + i += argc; + break; } case LIST_DASH: /* argument is a list with a leading dash, grouping determined by list */ { i++; - if (icmdName), + return XOTclVarErrMsg(in, ObjStr(obj->cmdName), " configure: unexpected argument '", ObjStr(objv[i]), "' between parameters", (char *) NULL); @@ -9989,11 +9994,11 @@ if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc < 2) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "instdestroy "); + return XOTclObjErrArgCnt(in, cl->object.cmdName, "instdestroy "); if (XOTclObjConvertObject(in, objv[1], &delobj) != TCL_OK) return XOTclVarErrMsg(in, "Can't destroy object ", - ObjStr(objv[1]), " that does not exist.", + ObjStr(objv[1]), " that does not exist.", (char *) NULL); /* fprintf(stderr,"instdestroy obj=%s, opt=%p\n",ObjStr(delobj->cmdName),delobj->opt);*/ @@ -10039,12 +10044,12 @@ ns = Tcl_GetCurrentNamespace(in); /* find last incovation outside ::xotcl (for things like relmgr) */ while (ns == RUNTIME_STATE(in)->XOTclNS) { - if (f) { - ns = f->nsPtr; - f = Tcl_CallFrame_callerPtr(f); - } else { - ns = Tcl_GetGlobalNamespace(in); - } + if (f) { + ns = f->nsPtr; + f = Tcl_CallFrame_callerPtr(f); + } else { + ns = Tcl_GetGlobalNamespace(in); + } } /*fprintf(stderr, "found ns %p '%s'\n",ns, ns?ns->fullName:"NULL");*/ } @@ -10057,14 +10062,14 @@ /* get calling tcl environment */ Tcl_CallFrame *f = Tcl_CallFrame_callerPtr(bot->currentFramePtr); if (f) { - ns = f->nsPtr; - /*fprintf(stderr, "top=%p, bot=%p b->c=%p f=%p ns=%p\n", - top,bot,bot->currentFramePtr, f, ns);*/ - /*fprintf(stderr,"ns from calling tcl environment %p '%s'\n", - ns, ns?ns->fullName : "" );*/ + ns = f->nsPtr; + /*fprintf(stderr, "top=%p, bot=%p b->c=%p f=%p ns=%p\n", + top,bot,bot->currentFramePtr, f, ns);*/ + /*fprintf(stderr,"ns from calling tcl environment %p '%s'\n", + ns, ns?ns->fullName : "" );*/ } else { - /* fprintf(stderr, "nothing found, use ::\n"); */ - ns = Tcl_GetGlobalNamespace(in); + /* fprintf(stderr, "nothing found, use ::\n"); */ + ns = Tcl_GetGlobalNamespace(in); } } } @@ -10090,10 +10095,10 @@ #if 0 fprintf(stderr, "type(%s)=%p %s %d\n", - ObjStr(objv[1]), objv[1]->typePtr, objv[1]->typePtr? - objv[1]->typePtr->name:"NULL", - XOTclObjConvertObject(in, objv[1], &newobj) - ); + ObjStr(objv[1]), objv[1]->typePtr, objv[1]->typePtr? + objv[1]->typePtr->name:"NULL", + XOTclObjConvertObject(in, objv[1], &newobj) + ); /* * if the lookup via GetObject for the object succeeds, * the object exists already, @@ -10112,46 +10117,46 @@ Tcl_Obj *tmpName = NULL; if (!isAbsolutePath(objName)) { - /*fprintf(stderr, "CallocMethod\n");*/ - tmpName = NameInNamespaceObj(in,objName,callingNameSpace(in)); - /*fprintf(stderr, "NoAbsoluteName for '%s' -> determined = '%s'\n", - objName, ObjStr(tmpName));*/ - objName = ObjStr(tmpName); + /*fprintf(stderr, "CallocMethod\n");*/ + tmpName = NameInNamespaceObj(in,objName,callingNameSpace(in)); + /*fprintf(stderr, "NoAbsoluteName for '%s' -> determined = '%s'\n", + objName, ObjStr(tmpName));*/ + objName = ObjStr(tmpName); - /*fprintf(stderr," **** name is '%s'\n", objName);*/ - INCR_REF_COUNT(tmpName); + /*fprintf(stderr," **** name is '%s'\n", objName);*/ + INCR_REF_COUNT(tmpName); } if (IsMetaClass(in, cl)) { - /* - * if the base class is a meta-class, we create a class - */ - newcl = PrimitiveCCreate(in, objName, cl); - if (newcl == 0) - result = XOTclVarErrMsg(in, "Class alloc failed for '",objName, + /* + * if the base class is a meta-class, we create a class + */ + newcl = PrimitiveCCreate(in, objName, cl); + if (newcl == 0) + result = XOTclVarErrMsg(in, "Class alloc failed for '",objName, "' (possibly parent namespace does not exist)", (char *) NULL); - else { - Tcl_SetObjResult(in, newcl->object.cmdName); - result = TCL_OK; - } + else { + Tcl_SetObjResult(in, newcl->object.cmdName); + result = TCL_OK; + } } else { - /* - * if the base class is an ordinary class, we create an object - */ - newobj = PrimitiveOCreate(in, objName, cl); - if (newobj == 0) - result = XOTclVarErrMsg(in, "Object alloc failed for '",objName, - "' (possibly parent namespace does not exist)", + /* + * if the base class is an ordinary class, we create an object + */ + newobj = PrimitiveOCreate(in, objName, cl); + if (newobj == 0) + result = XOTclVarErrMsg(in, "Object alloc failed for '",objName, + "' (possibly parent namespace does not exist)", (char *) NULL); - else { - result = TCL_OK; - Tcl_SetObjResult(in, newobj->cmdName); - } + else { + result = TCL_OK; + Tcl_SetObjResult(in, newobj->cmdName); + } } if (tmpName) { - DECR_REF_COUNT(tmpName); + DECR_REF_COUNT(tmpName); } } @@ -10162,7 +10167,7 @@ static int createMethod(Tcl_Interp *in, XOTclClass *cl, XOTclObject *obj, - int objc, Tcl_Obj *CONST objv[]) { + int objc, Tcl_Obj *CONST objv[]) { XOTclObject *newobj = NULL; Tcl_Obj *nameObj, *tmpObj = NULL; int result; @@ -10199,7 +10204,7 @@ ObjStr(tov[1]),objc+1);*/ /* call recreate --> initialization */ result = callMethod((ClientData) obj, in, - XOTclGlobalObjects[XOTE_RECREATE], objc+1, tov+1, 0); + XOTclGlobalObjects[XOTE_RECREATE], objc+1, tov+1, 0); if (result != TCL_OK) goto create_method_exit; @@ -10211,13 +10216,13 @@ if (!NSCheckColons(specifiedName, 0)) { result = XOTclVarErrMsg(in, "Cannot create object -- illegal name '", - specifiedName, "'", (char *) NULL); + specifiedName, "'", (char *) NULL); goto create_method_exit; } /* fprintf(stderr, "alloc ... %s\n", ObjStr(tov[1]));*/ result = callMethod((ClientData) obj, in, - XOTclGlobalObjects[XOTE_ALLOC], objc+1, tov+1, 0); + XOTclGlobalObjects[XOTE_ALLOC], objc+1, tov+1, 0); if (result != TCL_OK) goto create_method_exit; @@ -10286,7 +10291,7 @@ if (*option == '-' && strcmp(option,"-childof")==0 && iflags |= XOTCL_RECREATE; result = doCleanup(in, newobj, &cl->object, objc, objv); if (result == TCL_OK) { - result = doObjInitialization(in, newobj, objc, objv); - if (result == TCL_OK) - Tcl_SetObjResult(in, objv[1]); + result = doObjInitialization(in, newobj, objc, objv); + if (result == TCL_OK) + Tcl_SetObjResult(in, objv[1]); } DECR_REF_COUNT(objv[1]); return result; @@ -10410,287 +10415,287 @@ switch (*cmd) { case 'c': if (!strcmp(cmd, "classchildren")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "info classchildren ?pat?"); - return ListChildren(in, (XOTclObject*) cl, pattern, 1); + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, "info classchildren ?pat?"); + return ListChildren(in, (XOTclObject*) cl, pattern, 1); } else if (!strcmp(cmd, "classparent")) { - if (objc > 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "info classparent"); - return ListParent(in, &cl->object); + if (objc > 2 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, "info classparent"); + return ListParent(in, &cl->object); } break; case 'h': if (!strcmp(cmd, "heritage")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "info heritage ?pat?"); - return ListHeritage(in, cl, pattern); + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, "info heritage ?pat?"); + return ListHeritage(in, cl, pattern); } break; case 'i': if (cmd[1] == 'n' && cmd[2] == 's' && cmd[3] == 't') { - char *cmdTail = cmd + 4; - switch (*cmdTail) { - case 'a': - if (!strcmp(cmdTail, "ances")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "info instances ?pat?"); - return ListObjPtrHashTable(in, &cl->instances, pattern); - } else if (!strcmp(cmdTail, "args")) { - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instargs "); - if (cl->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(cl->nonposArgsTable, pattern); - if (nonposArgs) { - return ListArgsFromOrdinaryArgs(in, nonposArgs); - } - } - return ListProcArgs(in, Tcl_Namespace_cmdTable(nsp), pattern); - } - break; + char *cmdTail = cmd + 4; + switch (*cmdTail) { + case 'a': + if (!strcmp(cmdTail, "ances")) { + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, "info instances ?pat?"); + return ListObjPtrHashTable(in, &cl->instances, pattern); + } else if (!strcmp(cmdTail, "args")) { + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instargs "); + if (cl->nonposArgsTable) { + XOTclNonposArgs* nonposArgs = + NonposArgsGet(cl->nonposArgsTable, pattern); + if (nonposArgs) { + return ListArgsFromOrdinaryArgs(in, nonposArgs); + } + } + return ListProcArgs(in, Tcl_Namespace_cmdTable(nsp), pattern); + } + break; - case 'b': - if (!strcmp(cmdTail, "body")) { - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instbody "); - return ListProcBody(in, Tcl_Namespace_cmdTable(nsp), pattern); - } - break; + case 'b': + if (!strcmp(cmdTail, "body")) { + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instbody "); + return ListProcBody(in, Tcl_Namespace_cmdTable(nsp), pattern); + } + break; - case 'c': - if (!strcmp(cmdTail, "commands")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instcommands ?pat?"); - return ListKeys(in, Tcl_Namespace_cmdTable(nsp), pattern); - } - break; + case 'c': + if (!strcmp(cmdTail, "commands")) { + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instcommands ?pat?"); + return ListKeys(in, Tcl_Namespace_cmdTable(nsp), pattern); + } + break; - case 'd': - if (!strcmp(cmdTail, "default")) { - if (objc != 5 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instdefault "); + case 'd': + if (!strcmp(cmdTail, "default")) { + if (objc != 5 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instdefault "); - if (cl->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(cl->nonposArgsTable, pattern); - if (nonposArgs) { - return ListDefaultFromOrdinaryArgs(in, pattern, nonposArgs, - ObjStr(objv[3]), objv[4]); - } - } - return ListProcDefault(in, Tcl_Namespace_cmdTable(nsp), pattern, - ObjStr(objv[3]), objv[4]); - } - break; + if (cl->nonposArgsTable) { + XOTclNonposArgs* nonposArgs = + NonposArgsGet(cl->nonposArgsTable, pattern); + if (nonposArgs) { + return ListDefaultFromOrdinaryArgs(in, pattern, nonposArgs, + ObjStr(objv[3]), objv[4]); + } + } + return ListProcDefault(in, Tcl_Namespace_cmdTable(nsp), pattern, + ObjStr(objv[3]), objv[4]); + } + break; - case 'f': - if (!strcmp(cmdTail, "filter")) { - int withGuards = 0; - if (objc-modifiers > 3) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instfilter ?-guards? ?pat?"); - if (modifiers > 0) { - withGuards = checkForModifier(objv, modifiers, "-guards"); - if (withGuards == 0) - return XOTclVarErrMsg(in, "info instfilter: unknown modifier ", - ObjStr(objv[2]), (char *) NULL); - } - return opt ? FilterInfo(in, opt->instfilters, pattern, withGuards, 0) : TCL_OK; + case 'f': + if (!strcmp(cmdTail, "filter")) { + int withGuards = 0; + if (objc-modifiers > 3) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instfilter ?-guards? ?pat?"); + if (modifiers > 0) { + withGuards = checkForModifier(objv, modifiers, "-guards"); + if (withGuards == 0) + return XOTclVarErrMsg(in, "info instfilter: unknown modifier ", + ObjStr(objv[2]), (char *) NULL); + } + return opt ? FilterInfo(in, opt->instfilters, pattern, withGuards, 0) : TCL_OK; - } else if (!strcmp(cmdTail, "filterguard")) { - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instfilterguard filter"); - return opt ? GuardList(in, opt->instfilters, pattern) : TCL_OK; - } else if (!strcmp(cmdTail, "forward")) { - int argc = objc-modifiers; - int definition; - if (argc < 2 || argc > 3) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instforward ?-definition? ?name?"); - definition = checkForModifier(objv, modifiers, "-definition"); - if (nsp) - return forwardList(in, Tcl_Namespace_cmdTable(nsp), pattern, definition); - else - return TCL_OK; - } - break; + } else if (!strcmp(cmdTail, "filterguard")) { + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instfilterguard filter"); + return opt ? GuardList(in, opt->instfilters, pattern) : TCL_OK; + } else if (!strcmp(cmdTail, "forward")) { + int argc = objc-modifiers; + int definition; + if (argc < 2 || argc > 3) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instforward ?-definition? ?name?"); + definition = checkForModifier(objv, modifiers, "-definition"); + if (nsp) + return forwardList(in, Tcl_Namespace_cmdTable(nsp), pattern, definition); + else + return TCL_OK; + } + break; - case 'i': - if (!strcmp(cmdTail, "invar")) { - XOTclAssertionStore *assertions = opt ? opt->assertions : 0; - if (objc != 2 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instinvar"); + case 'i': + if (!strcmp(cmdTail, "invar")) { + XOTclAssertionStore *assertions = opt ? opt->assertions : 0; + if (objc != 2 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instinvar"); + + if (assertions && assertions->invariants) + Tcl_SetObjResult(in, AssertionList(in, assertions->invariants)); + return TCL_OK; + } + break; + + case 'm': + if (!strcmp(cmdTail, "mixin")) { + int withGuards = 0; + + if (objc-modifiers > 3 || modifiers > 1) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instmixin ?-guards? ?class?"); + if (modifiers > 0) { + withGuards = checkForModifier(objv, modifiers, "-guards"); + if (withGuards == 0) + return XOTclVarErrMsg(in, "info instfilter: unknown modifier ", + ObjStr(objv[2]), (char *) NULL); + } + return opt ? MixinInfo(in, opt->instmixins, pattern, withGuards) : TCL_OK; + + } else if (!strcmp(cmdTail, "mixinof")) { + if (objc-modifiers > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instmixinof ?class?"); + return opt ? MixinOfInfo(in, opt->instmixinofs, pattern) : TCL_OK; + } else if (!strcmp(cmdTail, "mixinguard")) { + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instmixinguard mixin"); + return opt ? GuardList(in, opt->instmixins, pattern) : TCL_OK; + } + break; - if (assertions && assertions->invariants) - Tcl_SetObjResult(in, AssertionList(in, assertions->invariants)); - return TCL_OK; - } - break; + case 'n': + if (!strcmp(cmdTail, "nonposargs")) { + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instnonposargs "); + if (cl->nonposArgsTable) { + XOTclNonposArgs* nonposArgs = + NonposArgsGet(cl->nonposArgsTable, pattern); + if (nonposArgs) { + Tcl_SetObjResult(in, NonposArgsFormat(in, + nonposArgs->nonposArgs)); + } + } + return TCL_OK; + } + break; - case 'm': - if (!strcmp(cmdTail, "mixin")) { - int withGuards = 0; - - if (objc-modifiers > 3 || modifiers > 1) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instmixin ?-guards? ?class?"); - if (modifiers > 0) { - withGuards = checkForModifier(objv, modifiers, "-guards"); - if (withGuards == 0) - return XOTclVarErrMsg(in, "info instfilter: unknown modifier ", - ObjStr(objv[2]), (char *) NULL); - } - return opt ? MixinInfo(in, opt->instmixins, pattern, withGuards) : TCL_OK; - - } else if (!strcmp(cmdTail, "mixinof")) { - if (objc-modifiers > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instmixinof ?class?"); - return opt ? MixinOfInfo(in, opt->instmixinofs, pattern) : TCL_OK; - } else if (!strcmp(cmdTail, "mixinguard")) { - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instmixinguard mixin"); - return opt ? GuardList(in, opt->instmixins, pattern) : TCL_OK; - } - break; - - case 'n': - if (!strcmp(cmdTail, "nonposargs")) { - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instnonposargs "); - if (cl->nonposArgsTable) { - XOTclNonposArgs* nonposArgs = - NonposArgsGet(cl->nonposArgsTable, pattern); - if (nonposArgs) { - Tcl_SetObjResult(in, NonposArgsFormat(in, - nonposArgs->nonposArgs)); - } - } - return TCL_OK; - } - break; - - case 'p': - if (!strcmp(cmdTail, "procs")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, "info instprocs ?pat?"); - return ListMethodKeys(in, Tcl_Namespace_cmdTable(nsp), pattern, - /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0); - } else if (!strcmp(cmdTail, "pre")) { - XOTclProcAssertion* procs; - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instpre "); - if (opt && opt->assertions) { - procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); - if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre)); - } - return TCL_OK; - } else if (!strcmp(cmdTail, "post")) { - XOTclProcAssertion* procs; - if (objc != 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info instpost "); - if (opt && opt->assertions) { - procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); - if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post)); - } - return TCL_OK; - } - break; - } + case 'p': + if (!strcmp(cmdTail, "procs")) { + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, "info instprocs ?pat?"); + return ListMethodKeys(in, Tcl_Namespace_cmdTable(nsp), pattern, + /*noProcs*/ 0, /*noCmds*/ 1, /* noDups */ 0, 0); + } else if (!strcmp(cmdTail, "pre")) { + XOTclProcAssertion* procs; + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instpre "); + if (opt && opt->assertions) { + procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); + if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->pre)); + } + return TCL_OK; + } else if (!strcmp(cmdTail, "post")) { + XOTclProcAssertion* procs; + if (objc != 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info instpost "); + if (opt && opt->assertions) { + procs = AssertionFindProcs(opt->assertions, ObjStr(objv[2])); + if (procs) Tcl_SetObjResult(in, AssertionList(in, procs->post)); + } + return TCL_OK; + } + break; + } } break; case 'm': if (!strcmp(cmd, "mixinof")) { - if (objc-modifiers > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info mixinof ?object?"); - return opt ? MixinOfInfo(in, opt->mixinofs, pattern) : TCL_OK; + if (objc-modifiers > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info mixinof ?object?"); + return opt ? MixinOfInfo(in, opt->mixinofs, pattern) : TCL_OK; } break; case 'p': if (!strcmp(cmd, "parameterclass")) { - if (opt && opt->parameterClass) { - Tcl_SetObjResult(in, opt->parameterClass); - } else { - Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_PARAM_CL]); - } - return TCL_OK; + if (opt && opt->parameterClass) { + Tcl_SetObjResult(in, opt->parameterClass); + } else { + Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_PARAM_CL]); + } + return TCL_OK; } else if (!strcmp(cmd, "parameter")) { - Tcl_DString ds, *dsPtr = &ds; - XOTclObject *o; - DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, className(cl), -1); - Tcl_DStringAppend(dsPtr, "::slot", 6); - o = XOTclpGetObject(in, Tcl_DStringValue(dsPtr)); - if (o) { - Tcl_Obj *varNameObj = Tcl_NewStringObj("__parameter",-1); - Tcl_Obj *parameters = XOTclOGetInstVar2((XOTcl_Object*)o, - in, varNameObj, NULL, - TCL_LEAVE_ERR_MSG); - if (parameters) { - Tcl_SetObjResult(in, parameters); - } else { - fprintf(stderr, "info parameters: No value for %s\n", - Tcl_DStringValue(dsPtr)); - Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); - } - DECR_REF_COUNT(varNameObj); - } else { - Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); - } - DSTRING_FREE(dsPtr); + Tcl_DString ds, *dsPtr = &ds; + XOTclObject *o; + DSTRING_INIT(dsPtr); + Tcl_DStringAppend(dsPtr, className(cl), -1); + Tcl_DStringAppend(dsPtr, "::slot", 6); + o = XOTclpGetObject(in, Tcl_DStringValue(dsPtr)); + if (o) { + Tcl_Obj *varNameObj = Tcl_NewStringObj("__parameter",-1); + Tcl_Obj *parameters = XOTclOGetInstVar2((XOTcl_Object*)o, + in, varNameObj, NULL, + TCL_LEAVE_ERR_MSG); + if (parameters) { + Tcl_SetObjResult(in, parameters); + } else { + fprintf(stderr, "info parameters: No value for %s\n", + Tcl_DStringValue(dsPtr)); + Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); + } + DECR_REF_COUNT(varNameObj); + } else { + Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); + } + DSTRING_FREE(dsPtr); #if 0 - if (cl->parameters) { - Tcl_SetObjResult(in, cl->parameters); - } else { - Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); - } + if (cl->parameters) { + Tcl_SetObjResult(in, cl->parameters); + } else { + Tcl_SetObjResult(in, XOTclGlobalObjects[XOTE_EMPTY]); + } #endif - return TCL_OK; + return TCL_OK; } break; case 's': if (!strcmp(cmd, "superclass")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info superclass ?class?"); - return ListSuperclasses(in, cl, pattern); + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info superclass ?class?"); + return ListSuperclasses(in, cl, pattern); } else if (!strcmp(cmd, "subclass")) { - if (objc > 3 || modifiers > 0) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "info subclass ?class?"); - return ListSubclasses(in, cl, pattern); + if (objc > 3 || modifiers > 0) + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "info subclass ?class?"); + return ListSubclasses(in, cl, pattern); } else if (!strcmp(cmd, "slots")) { - Tcl_DString ds, *dsPtr = &ds; - XOTclObject *o; - int rc; - DSTRING_INIT(dsPtr); - Tcl_DStringAppend(dsPtr, className(cl), -1); - Tcl_DStringAppend(dsPtr, "::slot", 6); - o = XOTclpGetObject(in, Tcl_DStringValue(dsPtr)); - if (o) { - rc = ListChildren(in, o, NULL, 0); - } else { - rc = TCL_OK; - } - DSTRING_FREE(dsPtr); - return rc; + Tcl_DString ds, *dsPtr = &ds; + XOTclObject *o; + int rc; + DSTRING_INIT(dsPtr); + Tcl_DStringAppend(dsPtr, className(cl), -1); + Tcl_DStringAppend(dsPtr, "::slot", 6); + o = XOTclpGetObject(in, Tcl_DStringValue(dsPtr)); + if (o) { + rc = ListChildren(in, o, NULL, 0); + } else { + rc = TCL_OK; + } + DSTRING_FREE(dsPtr); + return rc; } break; } @@ -10728,10 +10733,10 @@ if (result == TCL_OK) { for (elts = 0; elts < pc; elts++) { result = callParameterMethodWithArg(&cl->object, in, - XOTclGlobalObjects[XOTE_MKGETTERSETTER], - cl->object.cmdName, 3+1, &pv[elts],0); + XOTclGlobalObjects[XOTE_MKGETTERSETTER], + cl->object.cmdName, 3+1, &pv[elts],0); if (result != TCL_OK) - break; + break; } } return result; @@ -10765,24 +10770,24 @@ static int XOTclCInstParameterCmdMethod(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj * CONST objv[]) { + int objc, Tcl_Obj * CONST objv[]) { XOTclClass *cl = XOTclObjectToClass(cd); if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc < 2) return XOTclObjErrArgCnt(in, cl->object.cmdName, "instparametercmd name"); XOTclAddIMethod(in, (XOTcl_Class*) cl, ObjStr(objv[1]), - (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0); + (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0); return TCL_OK; } static int XOTclCParameterCmdMethod(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj * CONST objv[]) { + int objc, Tcl_Obj * CONST objv[]) { XOTclObject *obj = (XOTclObject*) cd; if (objc < 2) return XOTclObjErrArgCnt(in, obj->cmdName, "parametercmd name"); XOTclAddPMethod(in, (XOTcl_Object*) obj, ObjStr(objv[1]), - (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0); + (Tcl_ObjCmdProc*)XOTclSetterMethod, 0, 0); return TCL_OK; } @@ -10797,7 +10802,7 @@ static int forwardProcessOptions(Tcl_Interp *in, int objc, Tcl_Obj * CONST objv[], - forwardCmdClientData **tcdp) { + forwardCmdClientData **tcdp) { forwardCmdClientData *tcd; int i, rc = 0, earlybinding = 0; @@ -10852,16 +10857,16 @@ if (tcd->objscope) { /* when we evaluating objscope, and define ... - o forward append -objscope append + o forward append -objscope append a call to - o append ... + o append ... would lead to a recursive call; so we add the appropriate namespace */ char *name = ObjStr(tcd->cmdName); if (!isAbsolutePath(name)) { tcd->cmdName = NameInNamespaceObj(in, name, callingNameSpace(in)); /*fprintf(stderr,"name %s not absolute, therefore qualifying %s\n", name, - ObjStr(tcd->cmdName));*/ + ObjStr(tcd->cmdName));*/ } } INCR_REF_COUNT(tcd->cmdName); @@ -10873,8 +10878,8 @@ tcd->objProc = Tcl_Command_objProc(cmd); if (tcd->objProc == XOTclObjDispatch /* don't do direct invoke on xotcl objects */ - || tcd->objProc == TclObjInterpProc /* don't do direct invoke on tcl procs */ - ) { + || tcd->objProc == TclObjInterpProc /* don't do direct invoke on tcl procs */ + ) { /* silently ignore earlybinding flag */ tcd->objProc = NULL; } else { @@ -10896,7 +10901,7 @@ static int XOTclCInstForwardMethod(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj * CONST objv[]) { + int objc, Tcl_Obj * CONST objv[]) { XOTclClass *cl = XOTclObjectToClass(cd); forwardCmdClientData *tcd; int rc; @@ -10908,19 +10913,19 @@ if (rc == TCL_OK) { tcd->obj = &cl->object; XOTclAddIMethod(in, (XOTcl_Class*) cl, NSTail(ObjStr(objv[1])), - (Tcl_ObjCmdProc*)XOTclForwardMethod, - (ClientData)tcd, forwardCmdDeleteProc); + (Tcl_ObjCmdProc*)XOTclForwardMethod, + (ClientData)tcd, forwardCmdDeleteProc); return TCL_OK; } else { forward_argc_error: return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instforward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); + "instforward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); } } static int XOTclOForwardMethod(ClientData cd, Tcl_Interp *in, - int objc, Tcl_Obj * CONST objv[]) { + int objc, Tcl_Obj * CONST objv[]) { XOTcl_Object *obj = (XOTcl_Object*) cd; forwardCmdClientData *tcd; int rc; @@ -10933,13 +10938,13 @@ if (rc == TCL_OK) { tcd->obj = (XOTclObject*)obj; XOTclAddPMethod(in, obj, NSTail(ObjStr(objv[1])), - (Tcl_ObjCmdProc*)XOTclForwardMethod, - (ClientData)tcd, forwardCmdDeleteProc); + (Tcl_ObjCmdProc*)XOTclForwardMethod, + (ClientData)tcd, forwardCmdDeleteProc); return TCL_OK; } else { forward_argc_error: return XOTclObjErrArgCnt(in, obj->cmdName, - "forward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); + "forward method ?target? ?-default name? ?-objscope? ?-methodprefix string? ?args?"); } } @@ -10954,7 +10959,7 @@ callFrameContext ctx = {0}; if (objc != 1) - return XOTclObjErrArgCnt(in, obj->cmdName, "volatile"); + return XOTclObjErrArgCnt(in, obj->cmdName, "volatile"); if (RUNTIME_STATE(in)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) { fprintf(stderr,"### Can't make objects volatile during shutdown\n"); @@ -10965,12 +10970,12 @@ vn = NSTail(fullName); if (Tcl_SetVar2(in, vn, NULL, fullName, 0) != NULL) { - XOTclObjectOpt *opt = XOTclRequireObjectOpt(obj); + XOTclObjectOpt *opt = XOTclRequireObjectOpt(obj); - /*fprintf(stderr,"### setting trace for %s\n", fullName);*/ - result = Tcl_TraceVar(in, vn, TCL_TRACE_UNSETS, (Tcl_VarTraceProc*)XOTclUnsetTrace, - (ClientData)o); - opt->volatileVarName = vn; + /*fprintf(stderr,"### setting trace for %s\n", fullName);*/ + result = Tcl_TraceVar(in, vn, TCL_TRACE_UNSETS, (Tcl_VarTraceProc*)XOTclUnsetTrace, + (ClientData)o); + opt->volatileVarName = vn; } CallStackRestoreSavedFrames(in, &ctx); @@ -10990,7 +10995,7 @@ if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc < 4 || objc > 7) return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instproc name ?non-positional-args? args body ?preAssertion postAssertion?"); + "instproc name ?non-positional-args? args body ?preAssertion postAssertion?"); if (objc == 5 || objc == 7) { incr = 1; @@ -11005,8 +11010,8 @@ (cl == RUNTIME_STATE(in)->theClass && isAllocString(name)) || (cl == RUNTIME_STATE(in)->theClass && isCreateString(name))) return XOTclVarErrMsg(in, className(cl), " instproc: '", name, "' of ", - className(cl), " can not be overwritten. Derive a ", - "sub-class", (char *) NULL); + className(cl), " can not be overwritten. Derive a ", + "sub-class", (char *) NULL); if (*argStr == 0 && *bdyStr == 0) { int rc; @@ -11016,17 +11021,17 @@ rc = NSDeleteCmd(in, cl->nsPtr, name); if (rc < 0) return XOTclVarErrMsg(in, className(cl), " cannot delete instproc: '", name, - "' of class ", className(cl), (char *) NULL); + "' of class ", className(cl), (char *) NULL); } else { XOTclAssertionStore* aStore = NULL; if (objc > 5) { opt = XOTclRequireClassOpt(cl); if (!opt->assertions) - opt->assertions = AssertionCreateStore(); + opt->assertions = AssertionCreateStore(); aStore = opt->assertions; } result = MakeProc(cl->nsPtr, aStore, &(cl->nonposArgsTable), - in, objc, (Tcl_Obj **) objv, &cl->object); + in, objc, (Tcl_Obj **) objv, &cl->object); } /* could be a filter or filter inheritance ... update filter orders */ @@ -11044,22 +11049,22 @@ if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc != 3) return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instfilterguard filtername filterGuard"); + "instfilterguard filtername filterGuard"); opt = cl->opt; if (opt && opt->instfilters) { h = CmdListFindNameInList(in, ObjStr(objv[1]), opt->instfilters); if (h) { if (h->clientData) - GuardDel(h); + GuardDel(h); GuardAdd(in, h, objv[2]); FilterInvalidateObjOrders(in, cl); return TCL_OK; } } return XOTclVarErrMsg(in, "Instfilterguard: can't find filter ", - ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName), + ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName), (char *) NULL); } @@ -11071,7 +11076,7 @@ if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc != 3) return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instmixinguard mixin guard"); + "instmixinguard mixin guard"); if (cl->opt && cl->opt->instmixins) { XOTclClass *mixinCl = XOTclpGetClass(in, ObjStr(objv[1])); @@ -11081,18 +11086,18 @@ } if (mixinCmd) { h = CmdListFindCmdInList(mixinCmd, cl->opt->instmixins); - if (h) { - if (h->clientData) - GuardDel((XOTclCmdList*) h); - GuardAdd(in, h, objv[2]); - MixinInvalidateObjOrders(in, cl); - return TCL_OK; - } + if (h) { + if (h->clientData) + GuardDel((XOTclCmdList*) h); + GuardAdd(in, h, objv[2]); + MixinInvalidateObjOrders(in, cl); + return TCL_OK; + } } } return XOTclVarErrMsg(in, "Instmixinguard: can't find mixin ", - ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName), + ObjStr(objv[1]), " on ", ObjStr(cl->object.cmdName), (char *) NULL); } @@ -11103,8 +11108,8 @@ if (!cl) return XOTclObjErrType(in, objv[0], "Class"); if (objc != 2) - return XOTclObjErrArgCnt(in, cl->object.cmdName, - "instinvar "); + return XOTclObjErrArgCnt(in, cl->object.cmdName, + "instinvar "); opt = XOTclRequireClassOpt(cl); if (opt->assertions) @@ -11125,7 +11130,7 @@ if (objc < 2) return XOTclObjErrArgCnt(in, objv[0], "message ?args .. args?"); if (isCreateString(self)) return XOTclVarErrMsg(in, "error ", self, ": unable to dispatch '", - ObjStr(objv[1]), "'", (char *) NULL); + ObjStr(objv[1]), "'", (char *) NULL); rc = callMethod(cd, in, XOTclGlobalObjects[XOTE_CREATE], objc+1, objv+1, 0); return rc; @@ -11154,7 +11159,7 @@ newNs = ObjFindNamespace(in, objv[2]); if (!newNs) return XOTclVarErrMsg(in, "CopyCmds: Destination namespace ", - ObjStr(objv[2]), " does not exist", (char *) NULL); + ObjStr(objv[2]), " does not exist", (char *) NULL); /* * copy all procs & commands in the ns */ @@ -11184,14 +11189,14 @@ if (cmd != NULL) { /*fprintf(stderr, "%s already exists\n", newName);*/ if (!XOTclpGetObject(in, newName)) { - /* command or instproc will be deleted & then copied */ - Tcl_DeleteCommandFromToken(in, cmd); + /* command or instproc will be deleted & then copied */ + Tcl_DeleteCommandFromToken(in, cmd); } else { - /* don't overwrite objects -> will be recreated */ - hPtr = Tcl_NextHashEntry(&hSrch); - DECR_REF_COUNT(newFullCmdName); + /* don't overwrite objects -> will be recreated */ + hPtr = Tcl_NextHashEntry(&hSrch); + DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName); - continue; + continue; } } @@ -11203,7 +11208,7 @@ if (cmd == NULL) { Tcl_AppendStringsToObj(Tcl_GetObjResult(in), "can't copy ", " \"", - oldName, "\": command doesn't exist", + oldName, "\": command doesn't exist", (char *) NULL); DECR_REF_COUNT(newFullCmdName); DECR_REF_COUNT(oldFullCmdName); @@ -11214,107 +11219,107 @@ */ if (!XOTclpGetObject(in, oldName)) { if (TclIsProc((Command*)cmd)) { - Proc *procPtr = TclFindProc((Interp *)in, oldName); - Tcl_Obj *arglistObj; - CompiledLocal *localPtr; + Proc *procPtr = TclFindProc((Interp *)in, oldName); + Tcl_Obj *arglistObj; + CompiledLocal *localPtr; - /* - * Build a list containing the arguments of the proc - */ + /* + * Build a list containing the arguments of the proc + */ - arglistObj = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(arglistObj); + arglistObj = Tcl_NewListObj(0, NULL); + INCR_REF_COUNT(arglistObj); - for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; - localPtr = localPtr->nextPtr) { + for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; + localPtr = localPtr->nextPtr) { - if (TclIsCompiledLocalArgument(localPtr)) { - Tcl_Obj *defVal, *defStringObj = Tcl_NewStringObj(localPtr->name, -1); - INCR_REF_COUNT(defStringObj); - /* check for default values */ - if ((GetProcDefault(in, cmdTable, name, - localPtr->name, &defVal) == TCL_OK) && - (defVal != 0)) { - Tcl_AppendStringsToObj(defStringObj, " ", ObjStr(defVal), + if (TclIsCompiledLocalArgument(localPtr)) { + Tcl_Obj *defVal, *defStringObj = Tcl_NewStringObj(localPtr->name, -1); + INCR_REF_COUNT(defStringObj); + /* check for default values */ + if ((GetProcDefault(in, cmdTable, name, + localPtr->name, &defVal) == TCL_OK) && + (defVal != 0)) { + Tcl_AppendStringsToObj(defStringObj, " ", ObjStr(defVal), (char *) NULL); - } - Tcl_ListObjAppendElement(in, arglistObj, defStringObj); - DECR_REF_COUNT(defStringObj); - } - } + } + Tcl_ListObjAppendElement(in, arglistObj, defStringObj); + DECR_REF_COUNT(defStringObj); + } + } - if (Tcl_Command_objProc(cmd) == RUNTIME_STATE(in)->objInterpProc) { - Tcl_DString ds, *dsPtr = &ds; + if (Tcl_Command_objProc(cmd) == RUNTIME_STATE(in)->objInterpProc) { + Tcl_DString ds, *dsPtr = &ds; - if (isClassName(ns->fullName)) { - /* it started with ::xotcl::classes */ - XOTclClass *cl = XOTclpGetClass(in, NSCutXOTclClasses(ns->fullName)); - XOTclProcAssertion* procs; + if (isClassName(ns->fullName)) { + /* it started with ::xotcl::classes */ + XOTclClass *cl = XOTclpGetClass(in, NSCutXOTclClasses(ns->fullName)); + XOTclProcAssertion* procs; - if (cl) { - procs = cl->opt ? - AssertionFindProcs(cl->opt->assertions, name) : 0; - } else { - DECR_REF_COUNT(newFullCmdName); - DECR_REF_COUNT(oldFullCmdName); - DECR_REF_COUNT(arglistObj); - return XOTclVarErrMsg(in, "No class for inst - assertions", (char *) NULL); - } + if (cl) { + procs = cl->opt ? + AssertionFindProcs(cl->opt->assertions, name) : 0; + } else { + DECR_REF_COUNT(newFullCmdName); + DECR_REF_COUNT(oldFullCmdName); + DECR_REF_COUNT(arglistObj); + return XOTclVarErrMsg(in, "No class for inst - assertions", (char *) NULL); + } - /* XOTcl InstProc */ - DSTRING_INIT(dsPtr); - Tcl_DStringAppendElement(dsPtr, NSCutXOTclClasses(newNs->fullName)); - Tcl_DStringAppendElement(dsPtr, "instproc"); - Tcl_DStringAppendElement(dsPtr, name); - Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj)); - Tcl_DStringAppendElement(dsPtr, StripBodyPrefix(ObjStr(procPtr->bodyPtr))); - if (procs) { - XOTclRequireClassOpt(cl); - AssertionAppendPrePost(in, dsPtr, procs); - } - Tcl_EvalEx(in, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr),0); - DSTRING_FREE(dsPtr); - } else { - XOTclObject *obj = XOTclpGetObject(in, ns->fullName); - XOTclProcAssertion* procs; - if (obj) { - procs = obj->opt ? - AssertionFindProcs(obj->opt->assertions, name) : 0; - } else { - DECR_REF_COUNT(newFullCmdName); - DECR_REF_COUNT(oldFullCmdName); - DECR_REF_COUNT(arglistObj); - return XOTclVarErrMsg(in, "No object for assertions", (char *) NULL); - } + /* XOTcl InstProc */ + DSTRING_INIT(dsPtr); + Tcl_DStringAppendElement(dsPtr, NSCutXOTclClasses(newNs->fullName)); + Tcl_DStringAppendElement(dsPtr, "instproc"); + Tcl_DStringAppendElement(dsPtr, name); + Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj)); + Tcl_DStringAppendElement(dsPtr, StripBodyPrefix(ObjStr(procPtr->bodyPtr))); + if (procs) { + XOTclRequireClassOpt(cl); + AssertionAppendPrePost(in, dsPtr, procs); + } + Tcl_EvalEx(in, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr),0); + DSTRING_FREE(dsPtr); + } else { + XOTclObject *obj = XOTclpGetObject(in, ns->fullName); + XOTclProcAssertion* procs; + if (obj) { + procs = obj->opt ? + AssertionFindProcs(obj->opt->assertions, name) : 0; + } else { + DECR_REF_COUNT(newFullCmdName); + DECR_REF_COUNT(oldFullCmdName); + DECR_REF_COUNT(arglistObj); + return XOTclVarErrMsg(in, "No object for assertions", (char *) NULL); + } - /* XOTcl Proc */ - DSTRING_INIT(dsPtr); - Tcl_DStringAppendElement(dsPtr, newNs->fullName); - Tcl_DStringAppendElement(dsPtr, "proc"); - Tcl_DStringAppendElement(dsPtr, name); - Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj)); - Tcl_DStringAppendElement(dsPtr, StripBodyPrefix(ObjStr(procPtr->bodyPtr))); - if (procs) { - XOTclRequireObjectOpt(obj); - AssertionAppendPrePost(in, dsPtr, procs); - } - Tcl_EvalEx(in, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr),0); - DSTRING_FREE(dsPtr); - } - DECR_REF_COUNT(arglistObj); - } else { - /* Tcl Proc */ - Tcl_VarEval(in, "proc ", newName, " {", ObjStr(arglistObj),"} {\n", - ObjStr(procPtr->bodyPtr), "}", (char *) NULL); - } + /* XOTcl Proc */ + DSTRING_INIT(dsPtr); + Tcl_DStringAppendElement(dsPtr, newNs->fullName); + Tcl_DStringAppendElement(dsPtr, "proc"); + Tcl_DStringAppendElement(dsPtr, name); + Tcl_DStringAppendElement(dsPtr, ObjStr(arglistObj)); + Tcl_DStringAppendElement(dsPtr, StripBodyPrefix(ObjStr(procPtr->bodyPtr))); + if (procs) { + XOTclRequireObjectOpt(obj); + AssertionAppendPrePost(in, dsPtr, procs); + } + Tcl_EvalEx(in, Tcl_DStringValue(dsPtr), Tcl_DStringLength(dsPtr),0); + DSTRING_FREE(dsPtr); + } + DECR_REF_COUNT(arglistObj); + } else { + /* Tcl Proc */ + Tcl_VarEval(in, "proc ", newName, " {", ObjStr(arglistObj),"} {\n", + ObjStr(procPtr->bodyPtr), "}", (char *) NULL); + } } else { - /* - * Otherwise copy command - */ - Tcl_ObjCmdProc* objProc = Tcl_Command_objProc(cmd); - Tcl_CmdDeleteProc *deleteProc = Tcl_Command_deleteProc(cmd); + /* + * Otherwise copy command + */ + Tcl_ObjCmdProc* objProc = Tcl_Command_objProc(cmd); + Tcl_CmdDeleteProc *deleteProc = Tcl_Command_deleteProc(cmd); ClientData cd; - if (objProc) { + if (objProc) { cd = Tcl_Command_objClientData(cmd); if (cd == 0 || cd == XOTCL_NONLEAF_METHOD) { /* if client data not null, we would have to copy @@ -11323,13 +11328,13 @@ Tcl_CreateObjCommand(in, newName, objProc, Tcl_Command_objClientData(cmd), deleteProc); } - } else { + } else { cd = Tcl_Command_clientData(cmd); if (cd == 0 || cd == XOTCL_NONLEAF_METHOD) { Tcl_CreateCommand(in, newName, Tcl_Command_proc(cmd), Tcl_Command_clientData(cmd), deleteProc); } - } + } } } hPtr = Tcl_NextHashEntry(&hSrch); @@ -11363,7 +11368,7 @@ newNs = ObjFindNamespace(in, objv[2]); if (!newNs) return XOTclVarErrMsg(in, "CopyVars: Destination namespace ", - ObjStr(objv[2]), " does not exist", (char *) NULL); + ObjStr(objv[2]), " does not exist", (char *) NULL); obj = XOTclpGetObject(in, ObjStr(objv[1])); destFullName = newNs->fullName; @@ -11375,11 +11380,11 @@ XOTclObject *newObj; if (XOTclObjConvertObject(in, objv[1], &obj) != TCL_OK) { return XOTclVarErrMsg(in, "CopyVars: Origin object/namespace ", - ObjStr(objv[1]), " does not exist", (char *) NULL); + ObjStr(objv[1]), " does not exist", (char *) NULL); } if (XOTclObjConvertObject(in, objv[2], &newObj) != TCL_OK) { return XOTclVarErrMsg(in, "CopyVars: Destination object/namespace ", - ObjStr(objv[2]), " does not exist", (char *) NULL); + ObjStr(objv[2]), " does not exist", (char *) NULL); } varTable = obj->varTable; destFullNameObj = newObj->cmdName; @@ -11401,62 +11406,62 @@ if (!TclIsVarUndefined(varPtr) && !TclIsVarLink(varPtr)) { if (TclIsVarScalar(varPtr)) { - /* it may seem odd that we do not copy obj vars with the - * same SetVar2 as normal vars, but we want to dispatch it in order to - * be able to intercept the copying */ + /* it may seem odd that we do not copy obj vars with the + * same SetVar2 as normal vars, but we want to dispatch it in order to + * be able to intercept the copying */ - if (obj) { - nobjv[2] = varNameObj; - nobjv[3] = valueOfVar(Tcl_Obj,varPtr,objPtr); - rc = Tcl_EvalObjv(in, nobjc, nobjv, 0); - } else { - Tcl_ObjSetVar2(in, varNameObj, NULL, - valueOfVar(Tcl_Obj,varPtr,objPtr), - TCL_NAMESPACE_ONLY); - } + if (obj) { + nobjv[2] = varNameObj; + nobjv[3] = valueOfVar(Tcl_Obj,varPtr,objPtr); + rc = Tcl_EvalObjv(in, nobjc, nobjv, 0); + } else { + Tcl_ObjSetVar2(in, varNameObj, NULL, + valueOfVar(Tcl_Obj,varPtr,objPtr), + TCL_NAMESPACE_ONLY); + } } else { - if (TclIsVarArray(varPtr)) { - /* HERE!! PRE85 Why not [array get/set] based? Let the core iterate*/ - TclVarHashTable *aTable = valueOfVar(TclVarHashTable,varPtr,tablePtr); - Tcl_HashSearch ahSrch; - Tcl_HashEntry* ahPtr = aTable ? Tcl_FirstHashEntry(VarHashTable(aTable), &ahSrch) :0; - for (; ahPtr != 0; ahPtr = Tcl_NextHashEntry(&ahSrch)) { - Tcl_Obj *eltNameObj; - Var *eltVar; + if (TclIsVarArray(varPtr)) { + /* HERE!! PRE85 Why not [array get/set] based? Let the core iterate*/ + TclVarHashTable *aTable = valueOfVar(TclVarHashTable,varPtr,tablePtr); + Tcl_HashSearch ahSrch; + Tcl_HashEntry* ahPtr = aTable ? Tcl_FirstHashEntry(VarHashTable(aTable), &ahSrch) :0; + for (; ahPtr != 0; ahPtr = Tcl_NextHashEntry(&ahSrch)) { + Tcl_Obj *eltNameObj; + Var *eltVar; - getVarAndNameFromHash(ahPtr, &eltVar, &eltNameObj); + getVarAndNameFromHash(ahPtr, &eltVar, &eltNameObj); - INCR_REF_COUNT(eltNameObj); + INCR_REF_COUNT(eltNameObj); - if (TclIsVarScalar(eltVar)) { - if (obj) { - Tcl_Obj *fullVarNameObj = Tcl_DuplicateObj(varNameObj); + if (TclIsVarScalar(eltVar)) { + if (obj) { + Tcl_Obj *fullVarNameObj = Tcl_DuplicateObj(varNameObj); - INCR_REF_COUNT(fullVarNameObj); - Tcl_AppendStringsToObj(fullVarNameObj, "(", - ObjStr(eltNameObj), ")", NULL); - nobjv[2] = fullVarNameObj; - nobjv[3] = valueOfVar(Tcl_Obj,eltVar,objPtr); + INCR_REF_COUNT(fullVarNameObj); + Tcl_AppendStringsToObj(fullVarNameObj, "(", + ObjStr(eltNameObj), ")", NULL); + nobjv[2] = fullVarNameObj; + nobjv[3] = valueOfVar(Tcl_Obj,eltVar,objPtr); - rc = Tcl_EvalObjv(in, nobjc, nobjv, 0); - DECR_REF_COUNT(fullVarNameObj); - } else { - Tcl_ObjSetVar2(in, varNameObj, eltNameObj, - valueOfVar(Tcl_Obj,eltVar,objPtr), + rc = Tcl_EvalObjv(in, nobjc, nobjv, 0); + DECR_REF_COUNT(fullVarNameObj); + } else { + Tcl_ObjSetVar2(in, varNameObj, eltNameObj, + valueOfVar(Tcl_Obj,eltVar,objPtr), TCL_NAMESPACE_ONLY); - } - } - DECR_REF_COUNT(eltNameObj); - } - } + } + } + DECR_REF_COUNT(eltNameObj); + } + } } } DECR_REF_COUNT(varNameObj); hPtr = Tcl_NextHashEntry(&hSrch); } if (ns) { - DECR_REF_COUNT(destFullNameObj); - Tcl_PopCallFrame(in); + DECR_REF_COUNT(destFullNameObj); + Tcl_PopCallFrame(in); } DECR_REF_COUNT(setObj); return rc; @@ -11471,7 +11476,7 @@ result = callMethod((ClientData)self, in, objv[1], objc, objv+2, 0); } else { result = XOTclVarErrMsg(in, "Cannot resolve 'self', probably called outside the context of an XOTcl Object", - (char *) NULL); + (char *) NULL); } return result; } @@ -11484,25 +11489,25 @@ #if 0 Tcl_Namespace *nsPtr = Tcl_Command_nsPtr(RUNTIME_STATE(in)->cs.top->cmdPtr); fprintf(stderr,"initProcNS self=%s cmd=%p, '%s'\n", - ObjStr(RUNTIME_STATE(in)->cs.top->self->cmdName), - nsPtr, nsPtr->fullName); + ObjStr(RUNTIME_STATE(in)->cs.top->self->cmdName), + nsPtr, nsPtr->fullName); fprintf(stderr,"\tsetting currentFramePtr in %p to %p in initProcNS\n", - RUNTIME_STATE(in)->cs.top->currentFramePtr, varFramePtr); + RUNTIME_STATE(in)->cs.top->currentFramePtr, varFramePtr); XOTclCallStackDump(in); #endif if (RUNTIME_STATE(in)->cs.top->currentFramePtr == 0) { RUNTIME_STATE(in)->cs.top->currentFramePtr = varFramePtr; } /* else { - fprintf(stderr,"not overwriting currentFramePtr in %p from %p to %p\n", - RUNTIME_STATE(in)->cs.top, - RUNTIME_STATE(in)->cs.top->currentFramePtr, varFramePtr); + fprintf(stderr,"not overwriting currentFramePtr in %p from %p to %p\n", + RUNTIME_STATE(in)->cs.top, + RUNTIME_STATE(in)->cs.top->currentFramePtr, varFramePtr); } */ #if !defined(NAMESPACEINSTPROCS) if (varFramePtr) { - varFramePtr->nsPtr = GetCallerVarFrame(in,varFramePtr); + varFramePtr->nsPtr = GetCallerVarFrame(in,varFramePtr); } #endif return TCL_OK; @@ -11513,21 +11518,21 @@ */ int isNonposArg(Tcl_Interp *in, char * argStr, - int nonposArgsDefc, Tcl_Obj **nonposArgsDefv, - Tcl_Obj **var, char **type) { + int nonposArgsDefc, Tcl_Obj **nonposArgsDefv, + Tcl_Obj **var, char **type) { int i, npac; Tcl_Obj **npav; char *varName; if (argStr[0] == '-') { for (i=0; i < nonposArgsDefc; i++) { if (Tcl_ListObjGetElements(in, nonposArgsDefv[i], - &npac, &npav) == TCL_OK && npac > 0) { - varName = argStr+1; - if (!strcmp(varName, ObjStr(npav[0]))) { - *var = npav[0]; - *type = ObjStr(npav[1]); - return 1; - } + &npac, &npav) == TCL_OK && npac > 0) { + varName = argStr+1; + if (!strcmp(varName, ObjStr(npav[0]))) { + *var = npav[0]; + *type = ObjStr(npav[1]); + return 1; + } } } } @@ -11536,7 +11541,7 @@ int XOTclCheckBooleanArgs(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]) { + Tcl_Obj *CONST objv[]) { int result, bool; Tcl_Obj* boolean; @@ -11546,41 +11551,41 @@ return TCL_OK; } else if (objc != 3) { return XOTclObjErrArgCnt(in, NULL, - "::xotcl::nonposArgs boolean name ?value?"); + "::xotcl::nonposArgs boolean name ?value?"); } boolean = Tcl_DuplicateObj(objv[2]); INCR_REF_COUNT(boolean); result = Tcl_GetBooleanFromObj(in, boolean, &bool); DECR_REF_COUNT(boolean); /* - result = TCL_OK; + result = TCL_OK; */ if (result != TCL_OK) return XOTclVarErrMsg(in, - "non-positional argument: '", ObjStr(objv[1]), "' with value '", - ObjStr(objv[2]), "' is not of type boolean", - (char *) NULL); + "non-positional argument: '", ObjStr(objv[1]), "' with value '", + ObjStr(objv[2]), "' is not of type boolean", + (char *) NULL); return TCL_OK; } int XOTclCheckRequiredArgs(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]) { + Tcl_Obj *CONST objv[]) { if (objc != 2 && objc != 3) return XOTclObjErrArgCnt(in, NULL, - "::xotcl::nonposArgs required ?currentValue?"); + "::xotcl::nonposArgs required ?currentValue?"); if (objc != 3) return XOTclVarErrMsg(in, - "required arg: '", ObjStr(objv[1]), "' missing", - (char *) NULL); + "required arg: '", ObjStr(objv[1]), "' missing", + (char *) NULL); return TCL_OK; } int XOTclInterpretNonpositionalArgsCmd(ClientData cd, Tcl_Interp *in, int objc, - Tcl_Obj *CONST objv[]) { + Tcl_Obj *CONST objv[]) { Tcl_Obj **npav, **checkv, **checkArgv, **argsv, **nonposArgsDefv, *invocation[4], **ordinaryArgsDefv, **defaultValueObjv, *list, *checkObj, *ordinaryArg; @@ -11600,47 +11605,47 @@ if (objc != 2) return XOTclObjErrArgCnt(in, NULL, - "::xotcl::interpretNonpositionalArgs "); + "::xotcl::interpretNonpositionalArgs "); if (selfClass) { nonposArgsTable = selfClass->nonposArgsTable; } else if ((selfObj = GetSelfObj(in))) { nonposArgsTable = selfObj->nonposArgsTable; } else { return XOTclVarErrMsg(in, "Non positional args: can't find self/self class", - (char *) NULL); + (char *) NULL); } nonposArgs = NonposArgsGet(nonposArgsTable, methodName); if (nonposArgs == 0) { return XOTclVarErrMsg(in, - "Non positional args: can't find hash entry for: ", - methodName, - (char *) NULL); + "Non positional args: can't find hash entry for: ", + methodName, + (char *) NULL); } r1 = Tcl_ListObjGetElements(in, nonposArgs->nonposArgs, - &nonposArgsDefc, &nonposArgsDefv); + &nonposArgsDefc, &nonposArgsDefv); r2 = Tcl_ListObjGetElements(in, nonposArgs->ordinaryArgs, - &ordinaryArgsDefc, &ordinaryArgsDefv); + &ordinaryArgsDefc, &ordinaryArgsDefv); r3 = Tcl_ListObjGetElements(in, objv[1], &argsc, &argsv); if (r1 != TCL_OK || r2 != TCL_OK || r3 != TCL_OK) { return XOTclVarErrMsg(in, - "Cannot split non positional args list: ", - methodName, - (char *) NULL); + "Cannot split non positional args list: ", + methodName, + (char *) NULL); } /* setting variables to default values */ for (i=0; i < nonposArgsDefc; i++) { r1 = Tcl_ListObjGetElements(in, nonposArgsDefv[i], &npac, &npav); if (r1 == TCL_OK) { if (npac == 3) { - Tcl_ObjSetVar2(in, npav[0], NULL, npav[2], 0); + Tcl_ObjSetVar2(in, npav[0], NULL, npav[2], 0); } else if (npac == 2 && !strcmp(ObjStr(npav[1]), "switch")) { - Tcl_ObjSetVar2(in, npav[0], NULL, Tcl_NewBooleanObj(0), 0); + Tcl_ObjSetVar2(in, npav[0], NULL, Tcl_NewBooleanObj(0), 0); } } } @@ -11661,64 +11666,64 @@ argStr = ObjStr(argsv[i]); if (isDoubleDashString(argStr)) { - endOfNonposArgsReached = 1; - i++; + endOfNonposArgsReached = 1; + i++; } if (isNonposArg(in, argStr, nonposArgsDefc, nonposArgsDefv, &var,&type)) { - if (*type == 's' && !strcmp(type, "switch")) { - int bool; + if (*type == 's' && !strcmp(type, "switch")) { + int bool; Tcl_Obj *boolObj = Tcl_ObjGetVar2(in, var, 0, 0); - if (Tcl_GetBooleanFromObj(in, boolObj, &bool) != TCL_OK) { - return XOTclVarErrMsg(in, "Non positional arg '",argStr, + if (Tcl_GetBooleanFromObj(in, boolObj, &bool) != TCL_OK) { + return XOTclVarErrMsg(in, "Non positional arg '",argStr, "': no boolean value", (char *) NULL); } Tcl_ObjSetVar2(in, var, NULL, Tcl_NewBooleanObj(!bool), 0); - } else { - i++; - if (i >= argsc) - return XOTclVarErrMsg(in, "Non positional arg '", - argStr, "': value missing", (char *) NULL); - Tcl_ObjSetVar2(in, var, NULL, argsv[i], 0); - } + } else { + i++; + if (i >= argsc) + return XOTclVarErrMsg(in, "Non positional arg '", + argStr, "': value missing", (char *) NULL); + Tcl_ObjSetVar2(in, var, NULL, argsv[i], 0); + } } else { - endOfNonposArgsReached = 1; + endOfNonposArgsReached = 1; } } if (endOfNonposArgsReached && i < argsc) { if (ordinaryArgsCounter >= ordinaryArgsDefc) { - Tcl_Obj *tmp = NonposArgsFormat(in, nonposArgs->nonposArgs); - XOTclVarErrMsg(in, "unknown argument '", - ObjStr(argsv[i]), - "' for method '", - methodName, - "': valid arguments ", - ObjStr(tmp), - " ", - ObjStr(nonposArgs->ordinaryArgs), - (char *) NULL); - DECR_REF_COUNT(tmp); - return TCL_ERROR; + Tcl_Obj *tmp = NonposArgsFormat(in, nonposArgs->nonposArgs); + XOTclVarErrMsg(in, "unknown argument '", + ObjStr(argsv[i]), + "' for method '", + methodName, + "': valid arguments ", + ObjStr(tmp), + " ", + ObjStr(nonposArgs->ordinaryArgs), + (char *) NULL); + DECR_REF_COUNT(tmp); + return TCL_ERROR; } arg = ObjStr(ordinaryArgsDefv[ordinaryArgsCounter]); /* this is the last arg and 'args' is defined */ if (argsDefined && ordinaryArgsCounter+1 == ordinaryArgsDefc) { - list = Tcl_NewListObj(0, NULL); - INCR_REF_COUNT(list); - for(; i < argsc; i++) - Tcl_ListObjAppendElement(in, list, argsv[i]); - Tcl_ObjSetVar2(in, ordinaryArgsDefv[ordinaryArgsCounter], NULL, list, 0); - DECR_REF_COUNT(list); + list = Tcl_NewListObj(0, NULL); + INCR_REF_COUNT(list); + for(; i < argsc; i++) + Tcl_ListObjAppendElement(in, list, argsv[i]); + Tcl_ObjSetVar2(in, ordinaryArgsDefv[ordinaryArgsCounter], NULL, list, 0); + DECR_REF_COUNT(list); } else { - /* break down this argument, if it has a default value, - use only the first part */ - ordinaryArg = ordinaryArgsDefv[ordinaryArgsCounter]; + /* break down this argument, if it has a default value, + use only the first part */ + ordinaryArg = ordinaryArgsDefv[ordinaryArgsCounter]; r4 = Tcl_ListObjGetElements(in, ordinaryArg, - &defaultValueObjc, &defaultValueObjv); - if (r4 == TCL_OK && defaultValueObjc == 2) { - ordinaryArg = defaultValueObjv[0]; - } - Tcl_ObjSetVar2(in, ordinaryArg, NULL, argsv[i], 0); + &defaultValueObjc, &defaultValueObjv); + if (r4 == TCL_OK && defaultValueObjc == 2) { + ordinaryArg = defaultValueObjv[0]; + } + Tcl_ObjSetVar2(in, ordinaryArg, NULL, argsv[i], 0); } ordinaryArgsCounter++; } @@ -11731,26 +11736,26 @@ if ((!argsDefined && ordinaryArgsCounter != ordinaryArgsDefc) || (argsDefined && ordinaryArgsCounter < ordinaryArgsDefc-1)) { - /* we do not have enough arguments, maybe there are default arguments - for the missing args */ + /* we do not have enough arguments, maybe there are default arguments + for the missing args */ while (ordinaryArgsCounter != ordinaryArgsDefc) { if (argsDefined && ordinaryArgsCounter+1 == ordinaryArgsDefc) - break; + break; r4 = Tcl_ListObjGetElements(in, ordinaryArgsDefv[ordinaryArgsCounter], - &defaultValueObjc, &defaultValueObjv); + &defaultValueObjc, &defaultValueObjv); /*fprintf(stderr,"... try to get default for '%s', rc %d, objc %d\n", ObjStr(ordinaryArgsDefv[ordinaryArgsCounter]), r4,defaultValueObjc);*/ if (r4 == TCL_OK && defaultValueObjc == 2) { - Tcl_ObjSetVar2(in, defaultValueObjv[0], NULL, defaultValueObjv[1], 0); + Tcl_ObjSetVar2(in, defaultValueObjv[0], NULL, defaultValueObjv[1], 0); } else { - Tcl_Obj *tmp = NonposArgsFormat(in, nonposArgs->nonposArgs); - XOTclVarErrMsg(in, "wrong # args for method '", - methodName, "': valid arguments ", ObjStr(tmp), " ", - ObjStr(nonposArgs->ordinaryArgs), - (char *) NULL); - DECR_REF_COUNT(tmp); - return TCL_ERROR; + Tcl_Obj *tmp = NonposArgsFormat(in, nonposArgs->nonposArgs); + XOTclVarErrMsg(in, "wrong # args for method '", + methodName, "': valid arguments ", ObjStr(tmp), " ", + ObjStr(nonposArgs->ordinaryArgs), + (char *) NULL); + DECR_REF_COUNT(tmp); + return TCL_ERROR; } ordinaryArgsCounter++; } @@ -11768,39 +11773,39 @@ /* checking vars */ for (i=0; i < nonposArgsDefc; i++) { r1 = Tcl_ListObjGetElements(in, nonposArgsDefv[i], &npac, &npav); - if (r1 == TCL_OK && npac > 1 && *(ObjStr(npav[1])) != '\0') { - r1 = Tcl_ListObjGetElements(in, npav[1], &checkc, &checkv); - if (r1 == TCL_OK) { - checkObj = XOTclGlobalObjects[XOTE_NON_POS_ARGS_OBJ]; - for (j=0; j < checkc; j++) { - r1 = Tcl_ListObjGetElements(in, checkv[j], &checkArgc, &checkArgv); - if (r1 == TCL_OK && checkArgc > 1) { - if (isCheckObjString((ObjStr(checkArgv[0]))) && checkArgc == 2) { - checkObj = checkArgv[1]; - continue; - } - } - invocation[0] = checkObj; - invocation[1] = checkv[j]; - varPtr = TclVarTraceExists(in, ObjStr(npav[0])); - invocation[2] = npav[0]; - ic = 3; - if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) { - invocation[3] = Tcl_ObjGetVar2(in, npav[0], 0, 0); - ic = 4; - } - result = Tcl_EvalObjv(in, ic, invocation, 0); - /* - objPtr = Tcl_ConcatObj(ic, invocation); - fprintf(stderr,"eval on <%s>\n",ObjStr(objPtr)); - result = Tcl_EvalObjEx(in, objPtr, TCL_EVAL_DIRECT); - */ - if (result != TCL_OK) { - return result; - } - } - } - } + if (r1 == TCL_OK && npac > 1 && *(ObjStr(npav[1])) != '\0') { + r1 = Tcl_ListObjGetElements(in, npav[1], &checkc, &checkv); + if (r1 == TCL_OK) { + checkObj = XOTclGlobalObjects[XOTE_NON_POS_ARGS_OBJ]; + for (j=0; j < checkc; j++) { + r1 = Tcl_ListObjGetElements(in, checkv[j], &checkArgc, &checkArgv); + if (r1 == TCL_OK && checkArgc > 1) { + if (isCheckObjString((ObjStr(checkArgv[0]))) && checkArgc == 2) { + checkObj = checkArgv[1]; + continue; + } + } + invocation[0] = checkObj; + invocation[1] = checkv[j]; + varPtr = TclVarTraceExists(in, ObjStr(npav[0])); + invocation[2] = npav[0]; + ic = 3; + if ((varPtr != NULL) && !TclIsVarUndefined(varPtr)) { + invocation[3] = Tcl_ObjGetVar2(in, npav[0], 0, 0); + ic = 4; + } + result = Tcl_EvalObjv(in, ic, invocation, 0); + /* + objPtr = Tcl_ConcatObj(ic, invocation); + fprintf(stderr,"eval on <%s>\n",ObjStr(objPtr)); + result = Tcl_EvalObjEx(in, objPtr, TCL_EVAL_DIRECT); + */ + if (result != TCL_OK) { + return result; + } + } + } + } } return TCL_OK; } @@ -11847,7 +11852,7 @@ extern Tcl_Obj* XOTclOGetInstVar2(XOTcl_Object *obj, Tcl_Interp *in, Tcl_Obj *name1, Tcl_Obj *name2, - int flgs) { + int flgs) { Tcl_Obj *result; XOTcl_FrameDecls; @@ -11870,13 +11875,13 @@ if (cl && cl->object.refCount>0) { /*fprintf(stderr,"checkallinstances %d cl=%p '%s'\n", lvl, cl, ObjStr(cl->object.cmdName));*/ for (hPtr = Tcl_FirstHashEntry(&cl->instances, &search); hPtr != NULL; - hPtr = Tcl_NextHashEntry(&search)) { + hPtr = Tcl_NextHashEntry(&search)) { XOTclObject *inst = (XOTclObject*) Tcl_GetHashKey(&cl->instances, hPtr); assert(inst); assert(inst->refCount>0); assert(inst->cmdName->refCount>0); if (XOTclObjectIsClass(inst) && (XOTclClass*)inst != RUNTIME_STATE(in)->theClass) { - checkAllInstances(in, (XOTclClass*) inst, lvl+1); + checkAllInstances(in, (XOTclClass*) inst, lvl+1); } } } @@ -11950,12 +11955,12 @@ XOTcl_PushFrame(in, obj); for (hPtr = Tcl_FirstHashEntry(cmdTable, &hSrch); hPtr; - hPtr = Tcl_NextHashEntry(&hSrch)) { + hPtr = Tcl_NextHashEntry(&hSrch)) { char *key = Tcl_GetHashKey(cmdTable, hPtr); if (XOTclpGetObject(in, key)) { - /*fprintf(stderr,"child = %s\n",key);*/ - result = 1; - break; + /*fprintf(stderr,"child = %s\n",key);*/ + result = 1; + break; } } XOTcl_PopFrame(in,obj); @@ -11982,18 +11987,18 @@ char *key = Tcl_GetHashKey(commandTable, hPtr); obj = XOTclpGetObject(in, key); if (obj && !XOTclObjectIsClass(obj) && !ObjectHasChildren(in,obj)) { - /* fprintf(stderr," ... delete object %s %p, class=%s\n",key,obj, - ObjStr(obj->cl->object.cmdName));*/ - freeUnsetTraceVariable(in, obj); - Tcl_DeleteCommandFromToken(in, obj->id); - hDel = hPtr; - deleted++; + /* fprintf(stderr," ... delete object %s %p, class=%s\n",key,obj, + ObjStr(obj->cl->object.cmdName));*/ + freeUnsetTraceVariable(in, obj); + Tcl_DeleteCommandFromToken(in, obj->id); + hDel = hPtr; + deleted++; } else { - hDel = NULL; + hDel = NULL; } hPtr = Tcl_NextHashEntry(&hSrch); if (hDel) - Tcl_DeleteHashEntry(hDel); + Tcl_DeleteHashEntry(hDel); } /* fprintf(stderr, "deleted %d Objects\n",deleted);*/ if (deleted>0) @@ -12006,23 +12011,23 @@ cl = XOTclpGetClass(in, key); /* fprintf(stderr,"cl key = %s %p\n", key, cl); */ if (cl - && !ObjectHasChildren(in, (XOTclObject*)cl) - && !ClassHasInstances(cl) - && !ClassHasSubclasses(cl) - && cl != RUNTIME_STATE(in)->theClass - && cl != RUNTIME_STATE(in)->theObject - ) { - /* fprintf(stderr," ... delete class %s %p\n",key,cl); */ - freeUnsetTraceVariable(in, &cl->object); - Tcl_DeleteCommandFromToken(in, cl->object.id); - hDel = hPtr; - deleted++; + && !ObjectHasChildren(in, (XOTclObject*)cl) + && !ClassHasInstances(cl) + && !ClassHasSubclasses(cl) + && cl != RUNTIME_STATE(in)->theClass + && cl != RUNTIME_STATE(in)->theObject + ) { + /* fprintf(stderr," ... delete class %s %p\n",key,cl); */ + freeUnsetTraceVariable(in, &cl->object); + Tcl_DeleteCommandFromToken(in, cl->object.id); + hDel = hPtr; + deleted++; } else { - hDel = NULL; + hDel = NULL; } hPtr = Tcl_NextHashEntry(&hSrch); if (hDel) - Tcl_DeleteHashEntry(hDel); + Tcl_DeleteHashEntry(hDel); } /* fprintf(stderr, "deleted %d Classes\n",deleted);*/ if (deleted == 0) { @@ -12101,7 +12106,7 @@ * evaluate user-defined exit handler */ result = callMethod((ClientData)RUNTIME_STATE(in)->theObject, in, - XOTclGlobalObjects[XOTE_EXIT_HANDLER], 2, 0, 0); + XOTclGlobalObjects[XOTE_EXIT_HANDLER], 2, 0, 0); if (result != TCL_OK) { fprintf(stderr,"User defined exit handler contains errors!\n" "Error in line %d: %s\nExecution interrupted.\n", @@ -12145,7 +12150,7 @@ /* fprintf(stderr,"key = %s %p %d\n", key, obj, obj && !XOTclObjectIsClass(obj)); */ if (obj && !XOTclObjectIsClass(obj) - && !(obj->flags & XOTCL_DESTROY_CALLED)) + && !(obj->flags & XOTCL_DESTROY_CALLED)) callDestroyMethod((ClientData)obj, in, obj, 0); hPtr = Tcl_NextHashEntry(&hSrch); } @@ -12154,7 +12159,7 @@ char *key = Tcl_GetHashKey(commandTable, hPtr); cl = XOTclpGetClass(in, key); if (cl - && !(cl->object.flags & XOTCL_DESTROY_CALLED)) + && !(cl->object.flags & XOTCL_DESTROY_CALLED)) callDestroyMethod((ClientData)cl, in, (XOTclObject*)cl, 0); hPtr = Tcl_NextHashEntry(&hSrch); } @@ -12261,45 +12266,45 @@ MEM_COUNT_INIT(); /* - fprintf(stderr, "SIZES: obj=%d, tcl_obj=%d, DString=%d, class=%d, namespace=%d, command=%d, HashTable=%d\n", sizeof(XOTclObject), sizeof(Tcl_Obj), sizeof(Tcl_DString), sizeof(XOTclClass), sizeof(Namespace), sizeof(Command), sizeof(Tcl_HashTable)); + fprintf(stderr, "SIZES: obj=%d, tcl_obj=%d, DString=%d, class=%d, namespace=%d, command=%d, HashTable=%d\n", sizeof(XOTclObject), sizeof(Tcl_Obj), sizeof(Tcl_DString), sizeof(XOTclClass), sizeof(Namespace), sizeof(Command), sizeof(Tcl_HashTable)); */ #if FORWARD_COMPATIBLE { - int major, minor, patchlvl, type; - Tcl_GetVersion(&major, &minor, &patchlvl, &type); + int major, minor, patchlvl, type; + Tcl_GetVersion(&major, &minor, &patchlvl, &type); - if ((major == 8) && (minor < 5)) { - /* - * loading a version of xotcl compiled for 8.4 version - * into a 8.4 Tcl - */ - /* - fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.4 Tcl\n"); - */ - forwardCompatibleMode = 0; - lookupVarFromTable = LookupVarFromTable84; - tclVarHashCreateVar = VarHashCreateVar84; - tclInitVarHashTable = InitVarHashTable84; - tclCleanupVar = TclCleanupVar84; - varRefCountOffset = TclOffset(Var, refCount); - varHashTableSize = sizeof(Tcl_HashTable); - } else { - /* - * loading a version of xotcl compiled for 8.4 version - * into a 8.5 Tcl - */ - /* - fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.5 Tcl\n"); - */ - forwardCompatibleMode = 1; - lookupVarFromTable = LookupVarFromTable85; - tclVarHashCreateVar = VarHashCreateVar85; - tclInitVarHashTable = (Tcl_InitVarHashTableFunction*)*((&tclIntStubsPtr->reserved0)+235); - tclCleanupVar = (Tcl_CleanupVarFunction*)*((&tclIntStubsPtr->reserved0)+176); - varRefCountOffset = TclOffset(VarInHash, refCount); - varHashTableSize = sizeof(TclVarHashTable85); - } + if ((major == 8) && (minor < 5)) { + /* + * loading a version of xotcl compiled for 8.4 version + * into a 8.4 Tcl + */ + /* + fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.4 Tcl\n"); + */ + forwardCompatibleMode = 0; + lookupVarFromTable = LookupVarFromTable84; + tclVarHashCreateVar = VarHashCreateVar84; + tclInitVarHashTable = InitVarHashTable84; + tclCleanupVar = TclCleanupVar84; + varRefCountOffset = TclOffset(Var, refCount); + varHashTableSize = sizeof(Tcl_HashTable); + } else { + /* + * loading a version of xotcl compiled for 8.4 version + * into a 8.5 Tcl + */ + /* + fprintf(stderr, "loading a version of xotcl compiled for 8.4 version into a 8.5 Tcl\n"); + */ + forwardCompatibleMode = 1; + lookupVarFromTable = LookupVarFromTable85; + tclVarHashCreateVar = VarHashCreateVar85; + tclInitVarHashTable = (Tcl_InitVarHashTableFunction*)*((&tclIntStubsPtr->reserved0)+235); + tclCleanupVar = (Tcl_CleanupVarFunction*)*((&tclIntStubsPtr->reserved0)+176); + varRefCountOffset = TclOffset(VarInHash, refCount); + varHashTableSize = sizeof(TclVarHashTable85); + } } #endif @@ -12342,13 +12347,13 @@ RUNTIME_STATE(in)->fakeProc.lastLocalPtr = NULL; RUNTIME_STATE(in)->fakeNS = Tcl_CreateNamespace(in, "::xotcl::fakeNS", (ClientData)NULL, - (Tcl_NamespaceDeleteProc*)NULL); + (Tcl_NamespaceDeleteProc*)NULL); MEM_COUNT_ALLOC("TclNamespace",RUNTIME_STATE(in)->fakeNS); /* XOTclClasses in separate Namespace / Objects */ RUNTIME_STATE(in)->XOTclClassesNS = Tcl_CreateNamespace(in, "::xotcl::classes", (ClientData)NULL, - (Tcl_NamespaceDeleteProc*)NULL); + (Tcl_NamespaceDeleteProc*)NULL); MEM_COUNT_ALLOC("TclNamespace",RUNTIME_STATE(in)->XOTclClassesNS); @@ -12499,7 +12504,7 @@ DSTRING_FREE(dsPtr); } - /* + /* * overwritten tcl objs */ result = XOTclShadowTclCommands(in, SHADOW_LOAD); @@ -12512,15 +12517,15 @@ #ifdef XOTCL_BYTECODE instructions[INST_SELF_DISPATCH].cmdPtr = (Command *) #endif - Tcl_CreateObjCommand(in, "::xotcl::my", XOTclSelfDispatchCmd, 0, 0); + Tcl_CreateObjCommand(in, "::xotcl::my", XOTclSelfDispatchCmd, 0, 0); #ifdef XOTCL_BYTECODE instructions[INST_NEXT].cmdPtr = (Command *) #endif - Tcl_CreateObjCommand(in, "::xotcl::next", XOTclNextObjCmd, 0, 0); + Tcl_CreateObjCommand(in, "::xotcl::next", XOTclNextObjCmd, 0, 0); #ifdef XOTCL_BYTECODE instructions[INST_SELF].cmdPtr = (Command *) #endif - Tcl_CreateObjCommand(in, "::xotcl::self", XOTclGetSelfObjCmd, 0, 0); + Tcl_CreateObjCommand(in, "::xotcl::self", XOTclGetSelfObjCmd, 0, 0); /*Tcl_CreateObjCommand(in, "::xotcl::K", XOTclKObjCmd, 0, 0);*/ Tcl_CreateObjCommand(in, "::xotcl::alias", XOTclAliasCommand, 0, 0); @@ -12529,9 +12534,9 @@ #ifdef XOTCL_BYTECODE instructions[INST_INITPROC].cmdPtr = (Command *) #endif - Tcl_CreateObjCommand(in, "::xotcl::initProcNS", XOTclInitProcNSCmd, 0, 0); + Tcl_CreateObjCommand(in, "::xotcl::initProcNS", XOTclInitProcNSCmd, 0, 0); Tcl_CreateObjCommand(in, "::xotcl::interpretNonpositionalArgs", - XOTclInterpretNonpositionalArgsCmd, 0, 0); + XOTclInterpretNonpositionalArgsCmd, 0, 0); Tcl_CreateObjCommand(in, "::xotcl::interp", XOTcl_InterpObjCmd, 0, 0); Tcl_CreateObjCommand(in, "::xotcl::namespace_copyvars", XOTcl_NSCopyVars, 0, 0); Tcl_CreateObjCommand(in, "::xotcl::namespace_copycmds", XOTcl_NSCopyCmds, 0, 0); @@ -12553,19 +12558,19 @@ */ nonposArgsCl = PrimitiveCCreate(in, - XOTclGlobalStrings[XOTE_NON_POS_ARGS_CL], - thecls); + XOTclGlobalStrings[XOTE_NON_POS_ARGS_CL], + thecls); XOTclAddIMethod(in, (XOTcl_Class*) nonposArgsCl, - "required", - (Tcl_ObjCmdProc*) XOTclCheckRequiredArgs, 0, 0); + "required", + (Tcl_ObjCmdProc*) XOTclCheckRequiredArgs, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) nonposArgsCl, - "switch", - (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); + "switch", + (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); XOTclAddIMethod(in, (XOTcl_Class*) nonposArgsCl, - "boolean", - (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); + "boolean", + (Tcl_ObjCmdProc*) XOTclCheckBooleanArgs, 0, 0); PrimitiveOCreate(in, XOTclGlobalStrings[XOTE_NON_POS_ARGS_OBJ], - nonposArgsCl); + nonposArgsCl); /* * Parameter Class @@ -12575,8 +12580,8 @@ paramCl = PrimitiveCCreate(in, XOTclGlobalStrings[XOTE_PARAM_CL], thecls); paramObject = ¶mCl->object; XOTclAddPMethod(in, (XOTcl_Object*) paramObject, - XOTclGlobalStrings[XOTE_SEARCH_DEFAULTS], - (Tcl_ObjCmdProc*) ParameterSearchDefaultsMethod, 0, 0); + XOTclGlobalStrings[XOTE_SEARCH_DEFAULTS], + (Tcl_ObjCmdProc*) ParameterSearchDefaultsMethod, 0, 0); } /*