Posted to tcl by mjanssen at Mon Oct 16 14:04:51 GMT 2006view raw
- // objc and objv are coming straight from a Command created with Tcl_CreateObjCommand
- static int ObjectInvokeSlot(Tcl_Interp * interp, ObjectInfo * self, char * slotName, ObjectSlot * slot, int objc, Tcl_Obj * const objv[]) {
- Tcl_Obj * argList, * lambdaExpr;
- int nobjc,res,i;
- Tcl_Obj ** nobjv;
- static Tcl_Obj * applyCmd = NULL;
- if (applyCmd==NULL) {
- applyCmd=Tcl_NewStringObj("apply",-1);
- Tcl_IncrRefCount(applyCmd);
- }
- switch (slot->type) {
- case SELF_METHOD_INTERNAL:
- return (slot->function)(self,interp,Tcl_GetString(self->name),objc,objv);
- case SELF_DATA_SLOT:
- if(objc<2 || objc >3) {
- Tcl_WrongNumArgs(interp,1,objv,"slot_name ?value?");
- return TCL_ERROR;
- }
- if (objc==3) {
- // Set new value for the slot (slot always exist, because it was called through the slot command)
- // Discard the old Tcl_Obj;
- ObjectAddSlot(self,slotName,SELF_DATA_SLOT,Tcl_DuplicateObj(objv[2]));
- ObjectGetSlot(self,slotName,&slot);
- }
- Tcl_SetObjResult(interp, Tcl_DuplicateObj(slot->value));
- return TCL_OK;
- case SELF_METHOD_SLOT:
- argList = Tcl_NewListObj(objc,objv);
- Tcl_ListObjReplace(interp,argList,0,1,1,&applyCmd);
- Tcl_ListObjReplace(interp,argList,1,1,1,&(slot->value));
- Tcl_ListObjGetElements(interp,argList,&nobjc,&nobjv);
- res = Tcl_EvalObjv(interp,nobjc,nobjv,0);
- Tcl_DecrRefCount(argList);
- // something is leaking here.
- return res;
- default:
- Tcl_Panic("unknow slot type %d\n",slot->type,(void *)NULL);
- }
- return TCL_OK;
- }
Comments
Posted by at Mon Oct 16 18:21:15 GMT 2006 [text] [code]
nobjv = (Tcl_Obj **)ckalloc(objc*sizeof(Tcl_Obj *)); nobjv[0] = applyCmd; nobjv[1] = slot->value; for(i=0;i<objc;i++){ if(i>1) { nobjv[i]=Tcl_DuplicateObj(objv[i]); } Tcl_IncrRefCount(nobjv[i]); } res = Tcl_EvalObjv(interp,objc,nobjv,0); for(i=0;i<objc;i++){ fprintf(stderr, "%d ref %d\n",i,nobjv[i]->refCount); Tcl_DecrRefCount(nobjv[i]); } ckfree((char *)nobjv); return res;