Index: generic/xotcl.c
===================================================================
diff -u -rd1b7134131d60a023d74c6d0b878afff993b4ddb -rc7463312d92f53e9d3815408fe9537e9755cab8b
--- generic/xotcl.c	(.../xotcl.c)	(revision d1b7134131d60a023d74c6d0b878afff993b4ddb)
+++ generic/xotcl.c	(.../xotcl.c)	(revision c7463312d92f53e9d3815408fe9537e9755cab8b)
@@ -79,8 +79,7 @@
 /* maybe move to stubs? */
 int XOTclObjErrArgCntObj(Tcl_Interp *interp, Tcl_Obj *cmdName,  Tcl_Obj *methodName, Tcl_Obj *msg);
 
-static int createMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *obj,
-                        int objc, Tcl_Obj *CONST objv[]);
+static int createMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, int objc, Tcl_Obj *CONST objv[]);
 static int SetXOTclObjectFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void UpdateStringOfXOTclObject(Tcl_Obj *objPtr);
 static void FreeXOTclObjectInternalRep(Tcl_Obj *objPtr);
@@ -6899,24 +6898,6 @@
   return slotObjects;
 }
 
-static int
-ListSlotObjects(Tcl_Interp *interp, XOTclObject *obj, char *pattern) {
-  XOTclObjects *pl;
-  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
-
-  assert(obj);
-
-  pl = computeSlotObjects(interp, obj, pattern /* not used */ );
-  for (; pl; pl = pl->nextPtr) {
-    Tcl_ListObjAppendElement(interp, list, pl->obj->cmdName);
-  }
-    
-  XOTclObjectListFree(pl);
-  Tcl_SetObjResult(interp, list);
-
-  return TCL_OK;
-}
-
 static XOTclClass*
 FindCalledClass(Tcl_Interp *interp, XOTclObject *obj) {
   XOTclCallStackContent *csc = CallStackGetTopFrame(interp);
@@ -8939,7 +8920,7 @@
 }
 
 extern int
-XOTclCreate(Tcl_Interp *interp, XOTcl_Class *class, Tcl_Obj *name, ClientData data,
+XOTclCreate(Tcl_Interp *interp, XOTcl_Class *class, Tcl_Obj *name, ClientData clientData,
             int objc, Tcl_Obj *CONST objv[]) {
   XOTclClass *cl = (XOTclClass *) class;
   int result;
@@ -8952,7 +8933,7 @@
   if (objc>0) {
     memcpy(ov+2, objv, sizeof(Tcl_Obj *)*objc);
   }
-  result = createMethod(interp, (XOTclClass *)cl, data, objc+2, ov);
+  result = createMethod(interp, cl, ObjStr(name), objc+2, ov);
   
   FREE_ON_STACK(ov);
   DECR_REF_COUNT(name);
@@ -10875,42 +10856,8 @@
  * class method implementations
  */
 
-static int
-XOTclCDeallocMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
-  XOTclClass *cl = XOTclObjectToClass(clientData);
-  XOTclObject *delobj;
-  int rc;
 
-  if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
-  if (objc < 2)
-    return XOTclObjErrArgCnt(interp, cl->object.cmdName, objv[0], "<obj/cl>");
 
-  if (XOTclObjConvertObject(interp, objv[1], &delobj) != TCL_OK)
-    return XOTclVarErrMsg(interp, "Can't destroy object ",
-                          ObjStr(objv[1]), " that does not exist.", 
-			  (char *) NULL);
- 
-  /* fprintf(stderr,"dealloc obj=%s, opt=%p\n", objectName(delobj), delobj->opt);*/
-  rc = freeUnsetTraceVariable(interp, delobj);
-  if (rc != TCL_OK) {
-    return rc;
-  }
-
-  /*
-   * latch, and call delete command if not already in progress
-   */
-  delobj->flags |= XOTCL_DESTROY_CALLED;
-  RUNTIME_STATE(interp)->callIsDestroy = 1;
-  /*fprintf(stderr,"dealloc %s : setting callIsDestroy = 1\n", ObjStr(objv[1]));*/
-  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound !=
-      XOTCL_EXITHANDLER_ON_SOFT_DESTROY) {
-    CallStackDestroyObject(interp, delobj);
-  }
-
-  return TCL_OK;
-}
-
-
 static Tcl_Namespace *
 callingNameSpace(Tcl_Interp *interp) {
   Tcl_Namespace *ns = NULL;
@@ -10971,108 +10918,15 @@
 
 
 static int
-XOTclCAllocMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
-  XOTclClass *cl;
-  XOTclClass *newcl;
-  XOTclObject *newobj;
-  int result;
-
-  cl = XOTclObjectToClass(clientData);
-  if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
-  if (objc < 2)
-    return XOTclObjErrArgCnt(interp, cl->object.cmdName, objv[0], "<obj/cl> ?args?");
-
-#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(interp, objv[1], &newobj)
-          );
-  /*
-   * if the lookup via GetObject for the object succeeds,
-   * the object exists already,
-   * and we do not overwrite it, but re-create it
-   */
-  if (XOTclObjConvertObject(interp, objv[1], &newobj) == TCL_OK) {
-    fprintf(stderr, "lookup successful\n");
-    result = doCleanup(interp, newobj, &cl->object, objc, objv);
-  } else
-#endif
-    {
-      /*
-       * create a new object from scratch
-       */
-      char *objName = ObjStr(objv[1]);
-      Tcl_Obj *tmpName = NULL;
-      /*fprintf(stderr, " **** 0 '%s' 1 '%s' %d\n",ObjStr(objv[0]),ObjStr(objv[1]),objc);*/
-
-      if (!NSCheckColons(objName, 0)) {
-	return XOTclVarErrMsg(interp, "Cannot allocate object -- illegal name '",
-			      objName, "'", (char *) NULL);
-      }
-
-      if (!isAbsolutePath(objName)) {
-        /*fprintf(stderr, "CallocMethod\n");*/
-        tmpName = NameInNamespaceObj(interp, objName, callingNameSpace(interp));
-        /*fprintf(stderr, " **** NoAbsoluteName for '%s' -> determined = '%s'\n",
-          objName, ObjStr(tmpName));*/
-        objName = ObjStr(tmpName);
-
-        INCR_REF_COUNT(tmpName);
-      }
-
-      /*fprintf(stderr," **** name is '%s', isMetaClass => %d\n",  
-        objName, IsMetaClass(interp, cl, 1));*/
-
-      if (IsMetaClass(interp, cl, 1)) {
-        /*
-         * if the base class is a meta-class, we create a class
-         */
-        newcl = PrimitiveCCreate(interp, objName, cl);
-        if (newcl == 0) {
-          result = XOTclVarErrMsg(interp, "Class alloc failed for '", objName,
-				  "' (possibly parent namespace does not exist)", 
-				  (char *) NULL);
-        } else {
-          Tcl_SetObjResult(interp, newcl->object.cmdName);
-          result = TCL_OK;
-        }
-      } else {
-        /*
-         * if the base class is an ordinary class, we create an object
-         */
-        newobj = PrimitiveOCreate(interp, objName, cl);
-        if (newobj == 0)
-          result = XOTclVarErrMsg(interp, "Object alloc failed for '", objName,
-                                  "' (possibly parent namespace does not exist)", 
-				  (char *) NULL);
-        else {
-          result = TCL_OK;
-          Tcl_SetObjResult(interp, newobj->cmdName);
-        }
-      }
-
-      if (tmpName) {
-        DECR_REF_COUNT(tmpName);
-      }
-	
-    }
-
-  return result;
-}
-
-static int
-createMethod(Tcl_Interp *interp, XOTclClass *cl, XOTclObject *obj,
-             int objc, Tcl_Obj *CONST objv[]) {
+createMethod(Tcl_Interp *interp, XOTclClass *cl, char *specifiedName, int objc, Tcl_Obj *CONST objv[]) {
   XOTclObject *newobj = NULL;
   Tcl_Obj *nameObj, *tmpObj = NULL;
   int result;
-  char *objName, *specifiedName;
+  char *objName = specifiedName;
 
   ALLOC_ON_STACK(Tcl_Obj*, objc, tov);
 
   memcpy(tov, objv, sizeof(Tcl_Obj *)*(objc));
-  specifiedName = objName = ObjStr(objv[1]);
   /*
    * complete the name if it is not absolute
    */
@@ -11111,7 +10965,7 @@
       ObjStr(tov[1]), objc+1);*/
 
     /* call recreate --> initialization */
-    result = callMethod((ClientData) obj, interp,
+    result = callMethod((ClientData) cl, interp,
                         XOTclGlobalObjects[XOTE_RECREATE], objc+1, tov+1, 0);
     if (result != TCL_OK)
       goto create_method_exit;
@@ -11121,15 +10975,15 @@
     objTrace("RECREATE", newobj);
 
   } else {
+    /* 
+     * newobj might exist here, but will be automatically destroyed by
+     * alloc
+     */
 
-    /* newobj might exist here, but will be automatically destroyed
-       by alloc */
-    
-    result = XOTclVarErrMsg(interp, "Cannot create object -- illegal name '",
-			    specifiedName, "'", (char *) NULL);
     /*fprintf(stderr, "alloc ... %s\n", ObjStr(tov[1]));*/
-    result = callMethod((ClientData) obj, interp,
-                        XOTclGlobalObjects[XOTE_ALLOC], objc+1, tov+1, 0);
+
+    result = callMethod((ClientData) cl, interp,
+                        XOTclGlobalObjects[XOTE_ALLOC], 3, tov+1, 0);
     if (result != TCL_OK)
       goto create_method_exit;
 
@@ -11158,23 +11012,6 @@
 
 
 static int
-XOTclCCreateMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
-  XOTclClass *cl = XOTclObjectToClass(clientData);
-
-  if (!cl) return XOTclObjErrType(interp, objv[0], "Class");
-  if (objc < 2)
-    return XOTclObjErrArgCnt(interp, cl->object.cmdName, objv[0], "<obj> ?args?");
-    
-  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) {
-    fprintf(stderr,"### Can't create object %s during shutdown\n", ObjStr(objv[1]));
-    return TCL_ERROR;
-    return TCL_OK; /* don't fail, if this happens during destroy, it might be canceled */
-  }
-    
-  return createMethod(interp, cl, &cl->object, objc, objv);
-}
-
-static int
 XOTclCNewMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
   XOTclClass  *cl = XOTclObjectToClass(clientData);
   XOTclObject *child = NULL;
@@ -11298,14 +11135,7 @@
 typedef struct {
   ClientData clientData[10];
   Tcl_Obj *objv[10];
-  int flags;
-  int resultIsSet;
-  XOTclObject *obj;
-  XOTclClass *cl;
-  int set;
-  char *pattern;
-  XOTclObject *matchObject;
-  Tcl_DString ds;
+  int args;
 } parseContext;
 
 typedef struct  {
@@ -11319,19 +11149,19 @@
 typedef argDefinition interfaceDefinition[10];
 
 static int
-convertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, char *type, ClientData *clientData) {
+convertToType(Tcl_Interp *interp, Tcl_Obj *objPtr, char *type, ClientData *clientData, int *varArgs) {
   switch (*type) {
+  case 'a': 
+      if (strcmp(type,"allargs") == 0 || strcmp(type,"args") == 0) {
+        *varArgs = 1;
+        break;
+      }
   case 'c': 
       if (strcmp(type,"class") == 0) {
         if (GetXOTclClassFromObj(interp, objPtr, (XOTclClass **)clientData, 0) == TCL_OK)
           break;
         return XOTclObjErrType(interp, objPtr, type);
       }
-  case 't': 
-      if (strcmp(type,"tclobj") == 0) {
-        *clientData = (ClientData)objPtr;
-        break;
-      }
   case 'o': 
     {
       if (strcmp(type,"object") == 0) {
@@ -11367,6 +11197,11 @@
       }
       break;
     }
+  case 't': 
+      if (strcmp(type,"tclobj") == 0) {
+        *clientData = (ClientData)objPtr;
+        break;
+      }
   default: 
     return TCL_ERROR;
   }
@@ -11376,9 +11211,8 @@
 #include "tclAPI.h"
 
 static int
-parse2(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
-       int idx, parseContext *pc) {
-  int i, o, args, flagCount = 0, nrReq = 0, nrOpt = 0;
+parse2(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int idx, parseContext *pc) {
+  int i, o, flagCount = 0, nrReq = 0, nrOpt = 0, varArgs = 0;
   argDefinition *aPtr, *bPtr;
   interfaceDefinition *ifdPtr = &methodDefinitons[idx].ifd;
 
@@ -11423,10 +11257,10 @@
       else
         nrOpt++;
 
-      /*fprintf(stderr,"... arg %s req %d type %s try to set on %d\n",
-        aPtr->name,aPtr->required,aPtr->type,i);*/
+      /*fprintf(stderr,"... arg %s req %d type %s try to set on %d: '%s'\n",
+        aPtr->name,aPtr->required,aPtr->type,i, ObjStr(objv[o]));*/
       if (aPtr->type) {
-        if (convertToType(interp, objv[o], aPtr->type, &pc->clientData[i]) != TCL_OK) {
+        if (convertToType(interp, objv[o], aPtr->type, &pc->clientData[i], &varArgs) != TCL_OK) {
           return TCL_ERROR;
         }
       } else {
@@ -11439,9 +11273,11 @@
       o++; i++; aPtr++;
     }
   }
-  args = objc - flagCount -1;
-  /*fprintf(stderr, "objc = %d, args = %d, nrReq %d, nrReq + nrOpt = %d\n", objc,args,nrReq,nrReq + nrOpt);*/
-  if (args < nrReq || args > nrReq + nrOpt) {
+  pc->args = objc - flagCount - 1;
+  /* fprintf(stderr, "objc = %d, args = %d, nrReq %d, nrReq + nrOpt = %d, varArgs %d\n", 
+     objc,pc->args,nrReq,nrReq + nrOpt, varArgs);*/
+
+  if (pc->args < nrReq || (!varArgs && pc->args > nrReq + nrOpt)) {
     Tcl_Obj *msg = Tcl_NewStringObj("", 0);
     for (aPtr=ifdPtr[0]; aPtr->name; aPtr++) {
       if (aPtr != ifdPtr[0]) {
@@ -11458,8 +11294,8 @@
     return XOTclObjErrArgCntObj(interp, objv[0],  NULL, msg);
   }
 
-  /*fprintf(stderr,"after parse: o %d, i %d, objc %d, req %d opt %d ok? %d\n",
-    o,i,objc, nrReq, nrOpt, objc >= 1+nrReq && objc <= 1+nrReq+nrOpt);*/
+  /* fprintf(stderr,"after parse: o %d, i %d, objc %d, req %d opt %d ok? %d\n",
+     o,i,objc, nrReq, nrOpt, objc >= 1+nrReq && objc <= 1+nrReq+nrOpt); */
   return TCL_OK;
 }
 
@@ -11481,68 +11317,114 @@
   return 0;
 }
 
-#if 0
-static int
-XOTclClassInfoHeritageMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]) {
-  parseContext pc;
-  if (parse2(clientData, interp, objc, objv, XOTclClassInfoHeritageMethodIdx, &pc) != TCL_OK) {
-    return TCL_ERROR;
-  } else {
-    XOTclClass *cl  = (XOTclClass *)pc.clientData[0];
-    char *pattern   = (char *)pc.clientData[1];
+/***************************
+ * Begin Class Methods
+ ***************************/
 
-    return ListHeritage(interp, cl, pattern);
+static int XOTclCAllocMethod(Tcl_Interp *interp, XOTclClass *cl, char *name) {
+  Tcl_Obj *tmpName = NULL;
+  int result;
+
+  /*
+   * create a new object from scratch
+   */
+
+  /*fprintf(stderr, " **** 0 class '%s' wants to alloc '%s'\n",className(cl),name);*/
+  if (!NSCheckColons(name, 0)) {
+    return XOTclVarErrMsg(interp, "Cannot allocate object -- illegal name '",
+                          name, "'", (char *) NULL);
   }
-}
 
-static int
-XOTclClassInfoInstancesMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
-  parseContext pc;
-  if (parse2(clientData, interp, objc, objv, XOTclClassInfoInstancesMethodIdx, &pc) != TCL_OK) {
-    return TCL_ERROR;
+  /*
+   * If the path is not absolute, we add the appropriate namespace 
+   */
+  if (!isAbsolutePath(name)) {
+    tmpName = NameInNamespaceObj(interp, name, callingNameSpace(interp));
+    /*fprintf(stderr, " **** NoAbsoluteName for '%s' -> determined = '%s'\n",
+      name, ObjStr(tmpName));*/
+    name = ObjStr(tmpName);
+    INCR_REF_COUNT(tmpName);
+  }
+
+  if (IsMetaClass(interp, cl, 1)) {
+    /*
+     * if the base class is a meta-class, we create a class
+     */
+    XOTclClass *newcl = PrimitiveCCreate(interp, name, cl);
+    if (newcl == 0) {
+      result = XOTclVarErrMsg(interp, "Class alloc failed for '", name,
+                              "' (possibly parent namespace does not exist)", 
+                              (char *) NULL);
+    } else {
+      Tcl_SetObjResult(interp, newcl->object.cmdName);
+      result = TCL_OK;
+    }
   } else {
-    XOTclClass *cl      = (XOTclClass *)pc.clientData[0];
-    int withClosure     = (int)         pc.clientData[1];
-    Tcl_Obj *patternObj = (Tcl_Obj *)   pc.clientData[2];
-    XOTclObject *matchObject = NULL;
-    char *pattern = NULL;
-    int rc;
-    
-    if (getMatchObject3(interp, patternObj,  &pc, &matchObject, &pattern) == -1) {
-      return TCL_OK;
+    /*
+     * if the base class is an ordinary class, we create an object
+     */
+    XOTclObject *newobj = PrimitiveOCreate(interp, name, cl);
+    if (newobj == 0)
+      result = XOTclVarErrMsg(interp, "Object alloc failed for '", name,
+                              "' (possibly parent namespace does not exist)", 
+                              (char *) NULL);
+    else {
+      result = TCL_OK;
+      Tcl_SetObjResult(interp, newobj->cmdName);
     }
-    rc = listInstances(interp, cl, pattern, withClosure, matchObject);
-    
-    if (matchObject) {
-      Tcl_SetObjResult(interp, rc ? matchObject->cmdName : XOTclGlobalObjects[XOTE_EMPTY]);
-    }
-    DSTRING_FREE(&pc.ds);
   }
-  return TCL_OK;
+
+  if (tmpName) {
+    DECR_REF_COUNT(tmpName);
+  }
+
+  return result;
 }
 
-static int
-XOTclClassInfoInstargsMethod(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
-  parseContext pc;
-  if (parse2(clientData, interp, objc, objv, XOTclClassInfoInstargsMethodIdx, &pc) != TCL_OK) {
-    return TCL_ERROR;
-  } else {
-    XOTclClass *cl   = (XOTclClass *)pc.clientData[0];
-    char *methodName = (char *)pc.clientData[1];
-    Tcl_Namespace *nsp = cl->nsPtr;
+static int XOTclCCreateMethod(Tcl_Interp *interp, XOTclClass *cl, char *name, 
+                              int objc, Tcl_Obj *CONST objv[]) {
+  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound != XOTCL_EXITHANDLER_OFF) {
+    fprintf(stderr,"### Can't create object %s during shutdown\n", ObjStr(objv[1]));
+    return TCL_OK; /* don't fail, if this happens during destroy, it might be canceled */
+  }
+    
+  return createMethod(interp, cl, name, objc, objv);
+}
 
-    if (cl->nonposArgsTable) {
-      XOTclNonposArgs *nonposArgs = NonposArgsGet(cl->nonposArgsTable, methodName);
-      if (nonposArgs && nonposArgs->ordinaryArgs) {
-        return ListArgsFromOrdinaryArgs(interp, nonposArgs);
-      }
-    }
-    return ListProcArgs(interp, Tcl_Namespace_cmdTable(nsp), methodName);
+static int XOTclCDeallocMethod(Tcl_Interp *interp, XOTclClass *cl, Tcl_Obj *object) {
+  XOTclObject *delobj;
+  int rc;
+
+  if (XOTclObjConvertObject(interp, object, &delobj) != TCL_OK)
+    return XOTclVarErrMsg(interp, "Can't destroy object ",
+                          ObjStr(object), " that does not exist.", 
+			  (char *) NULL);
+ 
+  /* fprintf(stderr,"dealloc obj=%s, opt=%p\n", objectName(delobj), delobj->opt);*/
+  rc = freeUnsetTraceVariable(interp, delobj);
+  if (rc != TCL_OK) {
+    return rc;
   }
+
+  /*
+   * latch, and call delete command if not already in progress
+   */
+  delobj->flags |= XOTCL_DESTROY_CALLED;
+  RUNTIME_STATE(interp)->callIsDestroy = 1;
+  /*fprintf(stderr,"dealloc %s : setting callIsDestroy = 1\n", ObjStr(object);*/
+  if (RUNTIME_STATE(interp)->exitHandlerDestroyRound !=
+      XOTCL_EXITHANDLER_ON_SOFT_DESTROY) {
+    CallStackDestroyObject(interp, delobj);
+  }
+
+  return TCL_OK;
 }
-#endif
 
+/***************************
+ * End Class Methods
+ ***************************/
 
+
 /***************************
  * Begin check Methods
  ***************************/
@@ -12082,8 +11964,6 @@
 
 
 
-
-
 static int
 XOTclCInstParameterCmdMethod(ClientData clientData, Tcl_Interp *interp,
                              int objc, Tcl_Obj  *CONST objv[]) {
@@ -13886,9 +13766,9 @@
      };
      
      methodDefinition definitions2[] = {
-       {"alloc",            XOTclCAllocMethod},
-       {"create",           XOTclCCreateMethod},
-       {"dealloc",          XOTclCDeallocMethod},
+       {"alloc",            XOTclCAllocMethodStub},
+       {"create",           XOTclCCreateMethodStub},
+       {"dealloc",          XOTclCDeallocMethodStub},
        {"new",              XOTclCNewMethod},
        {"instfilterguard",  XOTclCInstFilterGuardMethod},
        {"instinvar",        XOTclCInvariantsMethod},