/tags/rel-1-3-26/SWIG/Lib/tcl/swigtcl8.swg
Unknown | 786 lines | 722 code | 64 blank | 0 comment | 0 complexity | 94d10d0ad7d7e4df156fe5bda97fc004 MD5 | raw file
Possible License(s): LGPL-2.1, Cube, GPL-3.0, 0BSD, GPL-2.0
1/* 2 * $Header$ 3 * 4 * swigtcl8.swg 5 */ 6 7#include <tcl.h> 8#include <errno.h> 9#include <stdlib.h> 10#include <stdarg.h> 11#include <ctype.h> 12 13#ifdef __cplusplus 14extern "C" { 15#endif 16 17/* Constant table */ 18 19#define SWIG_TCL_INT 1 20#define SWIG_TCL_FLOAT 2 21#define SWIG_TCL_STRING 3 22#define SWIG_TCL_POINTER 4 23#define SWIG_TCL_BINARY 5 24 25/* Flags for pointer conversion */ 26#define SWIG_POINTER_EXCEPTION 0x1 27#define SWIG_POINTER_DISOWN 0x2 28 29/* Swig fail macro */ 30 31#define SWIG_fail goto fail 32 33/* Constant information structure */ 34typedef struct swig_const_info { 35 int type; 36 char *name; 37 long lvalue; 38 double dvalue; 39 void *pvalue; 40 swig_type_info **ptype; 41} swig_const_info; 42 43typedef int (*swig_wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); 44typedef int (*swig_wrapper_func)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); 45typedef char *(*swig_variable_func)(ClientData, Tcl_Interp *, char *, char *, int); 46typedef void (*swig_delete_func)(ClientData); 47 48typedef struct swig_method { 49 const char *name; 50 swig_wrapper method; 51} swig_method; 52 53typedef struct swig_attribute { 54 const char *name; 55 swig_wrapper getmethod; 56 swig_wrapper setmethod; 57} swig_attribute; 58 59typedef struct swig_class { 60 const char *name; 61 swig_type_info **type; 62 swig_wrapper constructor; 63 void (*destructor)(void *); 64 swig_method *methods; 65 swig_attribute *attributes; 66 struct swig_class **bases; 67 char **base_names; 68 swig_module_info *module; 69} swig_class; 70 71typedef struct swig_instance { 72 Tcl_Obj *thisptr; 73 void *thisvalue; 74 swig_class *classptr; 75 int destroy; 76 Tcl_Command cmdtok; 77} swig_instance; 78 79#define SWIG_NewPointerObj(ptr, type, flags) \ 80 SWIG_Tcl_NewPointerObj(ptr, type, flags) 81#define SWIG_ConvertPtr(oc, ptr, ty, flags) \ 82 SWIG_Tcl_ConvertPtr(interp, oc, ptr, ty, flags) 83#define SWIG_ConvertPtrFromString(c, ptr, ty, flags) \ 84 SWIG_Tcl_ConvertPtrFromString(interp, c, ptr, ty, flags) 85#define SWIG_ConvertPacked(obj, ptr, sz, ty, flags) \ 86 SWIG_Tcl_ConvertPacked(interp, obj, ptr, sz, ty, flags) 87#define SWIG_MakePtr(c, ptr, ty, flags) \ 88 SWIG_Tcl_MakePtr(c, ptr, ty, flags) 89#define SWIG_NewPackedObj(ptr, sz, type, flags) \ 90 SWIG_Tcl_NewPackedObj(ptr, sz, type, flags) 91#define SWIG_GetArgs SWIG_Tcl_GetArgs 92#define SWIG_PointerTypeFromString(c) \ 93 SWIG_Tcl_PointerTypeFromString(c) 94#define SWIG_Acquire(ptr) \ 95 SWIG_Tcl_Acquire(ptr) 96#define SWIG_Disown(ptr) \ 97 SWIG_Tcl_Disown(ptr) 98#define SWIG_Thisown(ptr) \ 99 SWIG_Tcl_Thisown(ptr) 100#define SWIG_InstallConstants(interp, constants) \ 101 SWIG_Tcl_InstallConstants(interp, constants) 102#define SWIG_GetConstant(key) \ 103 SWIG_Tcl_GetConstant(key) 104#define SWIG_NewInstanceObj(thisvalue, type, flags) \ 105 SWIG_Tcl_NewInstanceObj(interp, thisvalue, type, flags) 106#define SWIG_ObjectConstructor SWIG_Tcl_ObjectConstructor 107#define SWIG_MethodCommand SWIG_Tcl_MethodCommand 108#define SWIG_ObjectDelete SWIG_Tcl_ObjectDelete 109 110/* Runtime API */ 111#define SWIG_GetModule(clientdata) SWIG_Tcl_GetModule((Tcl_Interp *) (clientdata)) 112#define SWIG_SetModule(clientdata, pointer) SWIG_Tcl_SetModule((Tcl_Interp *) (clientdata), pointer) 113#define SWIG_MODULE_CLIENTDATA_TYPE Tcl_Interp * 114 115/* Object support */ 116static Tcl_HashTable swigobjectTable; 117static int swigobjectTableinit = 0; 118 119/* Acquire ownership of a pointer */ 120static void 121SWIG_Tcl_Acquire(void *ptr) { 122 Tcl_HashEntry *entryPtr; 123 int newobj; 124 if (!swigobjectTableinit) { 125 Tcl_InitHashTable(&swigobjectTable, TCL_ONE_WORD_KEYS); 126 swigobjectTableinit = 1; 127 } 128 entryPtr = Tcl_CreateHashEntry(&swigobjectTable, (char *) ptr, &newobj); 129} 130 131/* Disown a pointer. Returns 1 if we owned it to begin with */ 132static int 133SWIG_Tcl_Disown(void *ptr) { 134 Tcl_HashEntry *entryPtr; 135 if (!swigobjectTableinit) return 0; 136 entryPtr = Tcl_FindHashEntry(&swigobjectTable, (char *) ptr); 137 if (entryPtr) { 138 Tcl_DeleteHashEntry(entryPtr); 139 return 1; 140 } 141 return 0; 142} 143 144static int 145SWIG_Tcl_Thisown(void *ptr) { 146 if (!swigobjectTableinit) return 0; 147 if (Tcl_FindHashEntry(&swigobjectTable, (char *) ptr)) { 148 return 1; 149 } 150 return 0; 151} 152 153/* Convert a pointer value */ 154static int 155SWIG_Tcl_ConvertPtrFromString(Tcl_Interp *interp, const char *c, void **ptr, swig_type_info *ty, int flags) { 156 swig_cast_info *tc; 157 /* Pointer values must start with leading underscore */ 158 while (*c != '_') { 159 *ptr = (void *) 0; 160 if (strcmp(c,"NULL") == 0) return TCL_OK; 161 /* Hmmm. It could be an object name. */ 162 if (Tcl_VarEval(interp,c," cget -this", (char *) NULL) == TCL_OK) { 163 Tcl_Obj *result = Tcl_GetObjResult(interp); 164 c = Tcl_GetStringFromObj(result, NULL); 165 continue; 166 } 167 Tcl_ResetResult(interp); 168 if (flags & SWIG_POINTER_EXCEPTION) 169 Tcl_SetResult(interp, (char *) "Type error. Expected a pointer", TCL_STATIC); 170 return TCL_ERROR; 171 } 172 c++; 173 c = SWIG_UnpackData(c,ptr,sizeof(void *)); 174 if (ty) { 175 tc = SWIG_TypeCheck(c,ty); 176 if ((!tc) && (flags & SWIG_POINTER_EXCEPTION)) { 177 Tcl_SetResult(interp, (char *) "Type error. Expected ", TCL_STATIC); 178 Tcl_AppendElement(interp, (char *) ty->name); 179 return TCL_ERROR; 180 } else if (!tc) { 181 Tcl_ResetResult(interp); 182 return TCL_ERROR; 183 } 184 if (flags & SWIG_POINTER_DISOWN) { 185 SWIG_Disown((void *) *ptr); 186 } 187 *ptr = SWIG_TypeCast(tc,(void *) *ptr); 188 } 189 return TCL_OK; 190} 191 192/* Convert a pointer value */ 193static SWIGINLINE int 194SWIG_Tcl_ConvertPtr(Tcl_Interp *interp, Tcl_Obj *oc, void **ptr, swig_type_info *ty, int flags) { 195 return SWIG_Tcl_ConvertPtrFromString(interp, Tcl_GetStringFromObj(oc,NULL), ptr, ty, flags); 196} 197 198/* Convert a pointer value */ 199static char * 200SWIG_Tcl_PointerTypeFromString(char *c) { 201 char d; 202 /* Pointer values must start with leading underscore. NULL has no type */ 203 if (*c != '_') { 204 return 0; 205 } 206 c++; 207 /* Extract hex value from pointer */ 208 while ((d = *c)) { 209 if (!(((d >= '0') && (d <= '9')) || ((d >= 'a') && (d <= 'f')))) break; 210 c++; 211 } 212 return c; 213} 214 215/* Convert a packed value value */ 216static int 217SWIG_Tcl_ConvertPacked(Tcl_Interp *interp, Tcl_Obj *obj, void *ptr, int sz, swig_type_info *ty, int flags) { 218 swig_cast_info *tc; 219 const char *c; 220 221 if (!obj) goto type_error; 222 c = Tcl_GetStringFromObj(obj,NULL); 223 /* Pointer values must start with leading underscore */ 224 if (*c != '_') goto type_error; 225 c++; 226 c = SWIG_UnpackData(c,ptr,sz); 227 if (ty) { 228 tc = SWIG_TypeCheck(c,ty); 229 if (!tc) goto type_error; 230 } 231 return TCL_OK; 232 233type_error: 234 235 if (flags) { 236 if (ty) { 237 Tcl_SetResult(interp, (char *) "Type error. Expected ", TCL_STATIC); 238 Tcl_AppendElement(interp, (char *) ty->name); 239 return TCL_ERROR; 240 } else { 241 Tcl_SetResult(interp, (char *) "Expected packed data.", TCL_STATIC); 242 return TCL_ERROR; 243 } 244 } 245 return TCL_ERROR; 246} 247 248 249/* Take a pointer and convert it to a string */ 250static void 251SWIG_Tcl_MakePtr(char *c, void *ptr, swig_type_info *ty, int flags) { 252 if (ptr) { 253 *(c++) = '_'; 254 c = SWIG_PackData(c,&ptr,sizeof(void *)); 255 strcpy(c,ty->name); 256 } else { 257 strcpy(c,(char *)"NULL"); 258 } 259 flags = 0; 260} 261 262/* Create a new pointer object */ 263static SWIGINLINE Tcl_Obj * 264SWIG_Tcl_NewPointerObj(void *ptr, swig_type_info *type, int flags) { 265 Tcl_Obj *robj; 266 char result[512]; 267 SWIG_MakePtr(result,ptr,type,flags); 268 robj = Tcl_NewStringObj(result,-1); 269 return robj; 270} 271 272static Tcl_Obj * 273SWIG_Tcl_NewPackedObj(void *ptr, int sz, swig_type_info *type, int flags) { 274 char result[1024]; 275 char *r = result; 276 if ((2*sz + 1 + strlen(type->name)) > 1000) return 0; 277 *(r++) = '_'; 278 r = SWIG_PackData(r,ptr,sz); 279 strcpy(r,type->name); 280 flags = 0; 281 return Tcl_NewStringObj(result,-1); 282} 283 284static Tcl_HashTable swigconstTable; 285static int swigconstTableinit = 0; 286 287/* Install Constants */ 288static void 289SWIG_Tcl_InstallConstants(Tcl_Interp *interp, swig_const_info constants[]) { 290 int i; 291 Tcl_Obj *obj; 292 Tcl_HashEntry *entryPtr; 293 int newobj; 294 295 if (!swigconstTableinit) { 296 Tcl_InitHashTable(&swigconstTable, TCL_STRING_KEYS); 297 swigconstTableinit = 1; 298 } 299 for (i = 0; constants[i].type; i++) { 300 switch(constants[i].type) { 301 case SWIG_TCL_INT: 302 obj = Tcl_NewIntObj(constants[i].lvalue); 303 break; 304 case SWIG_TCL_FLOAT: 305 obj = Tcl_NewDoubleObj(constants[i].dvalue); 306 break; 307 case SWIG_TCL_STRING: 308 obj = Tcl_NewStringObj((char *) constants[i].pvalue,-1); 309 break; 310 case SWIG_TCL_POINTER: 311 obj = SWIG_NewPointerObj(constants[i].pvalue, *(constants[i]).ptype,0); 312 break; 313 case SWIG_TCL_BINARY: 314 obj = SWIG_NewPackedObj(constants[i].pvalue, constants[i].lvalue, *(constants[i].ptype),0); 315 break; 316 default: 317 obj = 0; 318 break; 319 } 320 if (obj) { 321 Tcl_ObjSetVar2(interp,Tcl_NewStringObj(constants[i].name,-1), NULL, obj, TCL_GLOBAL_ONLY); 322 entryPtr = Tcl_CreateHashEntry(&swigconstTable, constants[i].name, &newobj); 323 Tcl_SetHashValue(entryPtr, (ClientData) obj); 324 } 325 } 326} 327 328static Tcl_Obj * 329SWIG_Tcl_GetConstant(const char *key) { 330 Tcl_HashEntry *entryPtr; 331 if (!swigconstTableinit) return 0; 332 entryPtr = Tcl_FindHashEntry(&swigconstTable, key); 333 if (entryPtr) { 334 return (Tcl_Obj *) Tcl_GetHashValue(entryPtr); 335 } 336 return 0; 337} 338 339/* Get arguments */ 340static int 341SWIG_Tcl_GetArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], const char *fmt, ...) { 342 int argno = 0, opt = 0; 343 long tempi; 344 double tempd; 345 const char *c; 346 va_list ap; 347 void *vptr; 348 Tcl_Obj *obj = 0; 349 swig_type_info *ty; 350 351 va_start(ap,fmt); 352 for (c = fmt; (*c && (*c != ':') && (*c != ';')); c++,argno++) { 353 if (*c == '|') { 354 opt = 1; 355 c++; 356 } 357 if (argno >= (objc-1)) { 358 if (!opt) { 359 Tcl_SetResult(interp, (char *) "Wrong # args. ", TCL_STATIC); 360 goto argerror; 361 } else { 362 va_end(ap); 363 return TCL_OK; 364 } 365 } 366 367 vptr = va_arg(ap,void *); 368 if (vptr) { 369 if (isupper(*c)) { 370 obj = SWIG_GetConstant(Tcl_GetStringFromObj(objv[argno+1],0)); 371 if (!obj) obj = objv[argno+1]; 372 } else { 373 obj = objv[argno+1]; 374 } 375 switch(*c) { 376 case 'i': case 'I': 377 case 'l': case 'L': 378 case 'h': case 'H': 379 case 'b': case 'B': 380 if (Tcl_GetLongFromObj(interp,obj,&tempi) != TCL_OK) goto argerror; 381 if ((*c == 'i') || (*c == 'I')) *((int *)vptr) = (int)tempi; 382 else if ((*c == 'l') || (*c == 'L')) *((long *)vptr) = (long)tempi; 383 else if ((*c == 'h') || (*c == 'H')) *((short*)vptr) = (short)tempi; 384 else if ((*c == 'b') || (*c == 'B')) *((unsigned char *)vptr) = (unsigned char)tempi; 385 break; 386 case 'f': case 'F': 387 case 'd': case 'D': 388 if (Tcl_GetDoubleFromObj(interp,obj,&tempd) != TCL_OK) goto argerror; 389 if ((*c == 'f') || (*c == 'F')) *((float *) vptr) = (float)tempd; 390 else if ((*c == 'd') || (*c == 'D')) *((double*) vptr) = tempd; 391 break; 392 case 's': case 'S': 393 if (*(c+1) == '#') { 394 int *vlptr = (int *) va_arg(ap, void *); 395 *((char **) vptr) = Tcl_GetStringFromObj(obj, vlptr); 396 c++; 397 } else { 398 *((char **)vptr) = Tcl_GetStringFromObj(obj,NULL); 399 } 400 break; 401 case 'c': case 'C': 402 *((char *)vptr) = *(Tcl_GetStringFromObj(obj,NULL)); 403 break; 404 case 'p': case 'P': 405 ty = (swig_type_info *) va_arg(ap, void *); 406 if (SWIG_Tcl_ConvertPtr(interp, obj, (void **) vptr, ty, SWIG_POINTER_EXCEPTION) == TCL_ERROR) goto argerror; 407 break; 408 case 'o': case 'O': 409 *((Tcl_Obj **)vptr) = objv[argno+1]; 410 break; 411 default: 412 break; 413 } 414 } 415 } 416 417 if ((*c != ';') && ((objc-1) > argno)) { 418 Tcl_SetResult(interp, (char *) "Wrong # args.", TCL_STATIC); 419 goto argerror; 420 } 421 va_end(ap); 422 return TCL_OK; 423 424 argerror: 425 { 426 char temp[32]; 427 sprintf(temp,"%d", argno+1); 428 c = strchr(fmt,':'); 429 if (!c) c = strchr(fmt,';'); 430 if (!c) c = (char *)""; 431 Tcl_AppendResult(interp,c," argument ", temp, NULL); 432 va_end(ap); 433 return TCL_ERROR; 434 } 435} 436 437static void 438SWIG_Tcl_ObjectDelete(ClientData clientData) { 439 swig_instance *si = (swig_instance *) clientData; 440 if ((si) && (si->destroy) && (SWIG_Disown(si->thisvalue))) { 441 if (si->classptr->destructor) { 442 (si->classptr->destructor)(si->thisvalue); 443 } 444 } 445 Tcl_DecrRefCount(si->thisptr); 446 free(si); 447} 448 449/* Function to invoke object methods given an instance */ 450static int 451SWIG_Tcl_MethodCommand(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST _objv[]) { 452 char *method, *attrname; 453 swig_instance *inst = (swig_instance *) clientData; 454 swig_method *meth; 455 swig_attribute *attr; 456 Tcl_Obj *oldarg; 457 Tcl_Obj **objv; 458 int rcode; 459 swig_class *cls; 460 swig_class *cls_stack[64]; 461 int cls_stack_bi[64]; 462 int cls_stack_top = 0; 463 int numconf = 2; 464 int bi; 465 466 objv = (Tcl_Obj **) _objv; 467 if (objc < 2) { 468 Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC); 469 return TCL_ERROR; 470 } 471 method = Tcl_GetStringFromObj(objv[1],NULL); 472 if (strcmp(method,"-acquire") == 0) { 473 inst->destroy = 1; 474 SWIG_Acquire(inst->thisvalue); 475 return TCL_OK; 476 } 477 if (strcmp(method,"-disown") == 0) { 478 if (inst->destroy) { 479 SWIG_Disown(inst->thisvalue); 480 } 481 inst->destroy = 0; 482 return TCL_OK; 483 } 484 if (strcmp(method,"-delete") == 0) { 485 Tcl_DeleteCommandFromToken(interp,inst->cmdtok); 486 return TCL_OK; 487 } 488 cls_stack[cls_stack_top] = inst->classptr; 489 cls_stack_bi[cls_stack_top] = -1; 490 cls = inst->classptr; 491 while (1) { 492 bi = cls_stack_bi[cls_stack_top]; 493 cls = cls_stack[cls_stack_top]; 494 if (bi != -1) { 495 if (!cls->bases[bi] && cls->base_names[bi]) { 496 /* lookup and cache the base class */ 497 swig_type_info *info = SWIG_TypeQueryModule(cls->module, cls->module, cls->base_names[bi]); 498 if (info) cls->bases[bi] = (swig_class *) info->clientdata; 499 } 500 cls = cls->bases[bi]; 501 if (cls) { 502 cls_stack_bi[cls_stack_top]++; 503 cls_stack_top++; 504 cls_stack[cls_stack_top] = cls; 505 cls_stack_bi[cls_stack_top] = -1; 506 continue; 507 } 508 } 509 if (!cls) { 510 cls_stack_top--; 511 if (cls_stack_top < 0) break; 512 else continue; 513 } 514 cls_stack_bi[cls_stack_top]++; 515 516 meth = cls->methods; 517 /* Check for methods */ 518 while (meth && meth->name) { 519 if (strcmp(meth->name,method) == 0) { 520 oldarg = objv[1]; 521 objv[1] = inst->thisptr; 522 Tcl_IncrRefCount(inst->thisptr); 523 rcode = (*meth->method)(clientData,interp,objc,objv); 524 objv[1] = oldarg; 525 Tcl_DecrRefCount(inst->thisptr); 526 return rcode; 527 } 528 meth++; 529 } 530 /* Check class methods for a match */ 531 if (strcmp(method,"cget") == 0) { 532 if (objc < 3) { 533 Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC); 534 return TCL_ERROR; 535 } 536 attrname = Tcl_GetStringFromObj(objv[2],NULL); 537 attr = cls->attributes; 538 while (attr && attr->name) { 539 if ((strcmp(attr->name, attrname) == 0) && (attr->getmethod)) { 540 oldarg = objv[1]; 541 objv[1] = inst->thisptr; 542 Tcl_IncrRefCount(inst->thisptr); 543 rcode = (*attr->getmethod)(clientData,interp,2, objv); 544 objv[1] = oldarg; 545 Tcl_DecrRefCount(inst->thisptr); 546 return rcode; 547 } 548 attr++; 549 } 550 if (strcmp(attrname, "-this") == 0) { 551 Tcl_SetObjResult(interp, Tcl_DuplicateObj(inst->thisptr)); 552 return TCL_OK; 553 } 554 if (strcmp(attrname, "-thisown") == 0) { 555 if (SWIG_Thisown(inst->thisvalue)) { 556 Tcl_SetResult(interp,(char*)"1",TCL_STATIC); 557 } else { 558 Tcl_SetResult(interp,(char*)"0",TCL_STATIC); 559 } 560 return TCL_OK; 561 } 562 } else if (strcmp(method, "configure") == 0) { 563 int i; 564 if (objc < 4) { 565 Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC); 566 return TCL_ERROR; 567 } 568 i = 2; 569 while (i < objc) { 570 attrname = Tcl_GetStringFromObj(objv[i],NULL); 571 attr = cls->attributes; 572 while (attr && attr->name) { 573 if ((strcmp(attr->name, attrname) == 0) && (attr->setmethod)) { 574 oldarg = objv[i]; 575 objv[i] = inst->thisptr; 576 Tcl_IncrRefCount(inst->thisptr); 577 rcode = (*attr->setmethod)(clientData,interp,3, &objv[i-1]); 578 objv[i] = oldarg; 579 Tcl_DecrRefCount(inst->thisptr); 580 if (rcode != TCL_OK) return rcode; 581 numconf += 2; 582 } 583 attr++; 584 } 585 i+=2; 586 } 587 } 588 } 589 if (strcmp(method,"configure") == 0) { 590 if (numconf >= objc) { 591 return TCL_OK; 592 } else { 593 Tcl_SetResult(interp,(char *) "Invalid attribute name.", TCL_STATIC); 594 return TCL_ERROR; 595 } 596 } 597 if (strcmp(method,"cget") == 0) { 598 Tcl_SetResult(interp,(char *) "Invalid attribute name.", TCL_STATIC); 599 return TCL_ERROR; 600 } 601 602 Tcl_SetResult(interp, (char *) "Invalid method. Must be one of: configure cget -acquire -disown -delete", TCL_STATIC); 603 cls = inst->classptr; 604 bi = 0; 605 while (cls) { 606 meth = cls->methods; 607 while (meth && meth->name) { 608 char *cr = (char *) Tcl_GetStringResult(interp); 609 int meth_len = strlen(meth->name); 610 char* where = strchr(cr,':'); 611 while(where) { 612 where = strstr(where, meth->name); 613 if(where) { 614 if(where[-1] == ' ' && (where[meth_len] == ' ' || where[meth_len]==0)) { 615 break; 616 } else { 617 where++; 618 } 619 } 620 } 621 622 if (!where) 623 Tcl_AppendElement(interp, (char *) meth->name); 624 meth++; 625 } 626 cls = inst->classptr->bases[bi++]; 627 } 628 return TCL_ERROR; 629} 630 631/* Function to create objects */ 632static int 633SWIG_Tcl_ObjectConstructor(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { 634 Tcl_Obj *newObj = 0; 635 void *thisvalue = 0; 636 swig_instance *newinst = 0; 637 swig_class *classptr = (swig_class *) clientData; 638 swig_wrapper cons = 0; 639 char *name = 0; 640 int firstarg = 0; 641 int thisarg = 0; 642 int destroy = 1; 643 644 if (!classptr) { 645 Tcl_SetResult(interp, (char *) "swig: internal runtime error. No class object defined.", TCL_STATIC); 646 return TCL_ERROR; 647 } 648 cons = classptr->constructor; 649 if (objc > 1) { 650 char *s = Tcl_GetStringFromObj(objv[1],NULL); 651 if (strcmp(s,"-this") == 0) { 652 thisarg = 2; 653 cons = 0; 654 } else if (strcmp(s,"-args") == 0) { 655 firstarg = 1; 656 } else if (objc == 2) { 657 firstarg = 1; 658 name = s; 659 } else if (objc >= 3) { 660 char *s1; 661 name = s; 662 s1 = Tcl_GetStringFromObj(objv[2],NULL); 663 if (strcmp(s1,"-this") == 0) { 664 thisarg = 3; 665 cons = 0; 666 } else { 667 firstarg = 1; 668 } 669 } 670 } 671 if (cons) { 672 int result; 673 result = (*cons)(0, interp, objc-firstarg, &objv[firstarg]); 674 if (result != TCL_OK) { 675 return result; 676 } 677 newObj = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); 678 if (!name) name = Tcl_GetStringFromObj(newObj,NULL); 679 } else if (thisarg > 0) { 680 if (thisarg < objc) { 681 destroy = 0; 682 newObj = Tcl_DuplicateObj(objv[thisarg]); 683 if (!name) name = Tcl_GetStringFromObj(newObj,NULL); 684 } else { 685 Tcl_SetResult(interp, (char *) "wrong # args.", TCL_STATIC); 686 return TCL_ERROR; 687 } 688 } else { 689 Tcl_SetResult(interp, (char *) "No constructor available.", TCL_STATIC); 690 return TCL_ERROR; 691 } 692 if (SWIG_Tcl_ConvertPtr(interp,newObj, (void **) &thisvalue, *(classptr->type), SWIG_POINTER_EXCEPTION) == TCL_ERROR) { 693 Tcl_DecrRefCount(newObj); 694 return TCL_ERROR; 695 } 696 newinst = (swig_instance *) malloc(sizeof(swig_instance)); 697 newinst->thisptr = newObj; 698 Tcl_IncrRefCount(newObj); 699 newinst->thisvalue = thisvalue; 700 newinst->classptr = classptr; 701 newinst->destroy = destroy; 702 if (destroy) { 703 SWIG_Acquire(thisvalue); 704 } 705 newinst->cmdtok = Tcl_CreateObjCommand(interp,name, (swig_wrapper) SWIG_MethodCommand, (ClientData) newinst, (swig_delete_func) SWIG_ObjectDelete); 706 return TCL_OK; 707} 708 709 710/* This function takes the current result and turns it into an object command */ 711static Tcl_Obj * 712SWIG_Tcl_NewInstanceObj(Tcl_Interp *interp, void *thisvalue, swig_type_info *type, int flags) { 713 Tcl_Obj *robj = SWIG_NewPointerObj(thisvalue, type,0); 714 /* Check to see if this pointer belongs to a class or not */ 715 if ((type->clientdata) && (interp)) { 716 Tcl_CmdInfo ci; 717 char *name; 718 name = Tcl_GetStringFromObj(robj,NULL); 719 if (!Tcl_GetCommandInfo(interp,name, &ci) || (flags)) { 720 swig_instance *newinst = (swig_instance *) malloc(sizeof(swig_instance)); 721 newinst->thisptr = Tcl_DuplicateObj(robj); 722 Tcl_IncrRefCount(newinst->thisptr); 723 newinst->thisvalue = thisvalue; 724 newinst->classptr = (swig_class *) type->clientdata; 725 newinst->destroy = flags; 726 newinst->cmdtok = Tcl_CreateObjCommand(interp, Tcl_GetStringFromObj(robj,NULL), (swig_wrapper_func) SWIG_MethodCommand, (ClientData) newinst, (swig_delete_func) SWIG_ObjectDelete); 727 if (flags) { 728 SWIG_Acquire(thisvalue); 729 } 730 } 731 } 732 return robj; 733} 734 735/* Structure for command table */ 736typedef struct { 737 const char *name; 738 int (*wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); 739 ClientData clientdata; 740} swig_command_info; 741 742/* Structure for variable linking table */ 743typedef struct { 744 const char *name; 745 void *addr; 746 char * (*get)(ClientData, Tcl_Interp *, char *, char *, int); 747 char * (*set)(ClientData, Tcl_Interp *, char *, char *, int); 748} swig_var_info; 749 750 751/* Contract support */ 752 753#define SWIG_contract_assert(expr, msg) if (!(expr)) { Tcl_SetResult(interp, (char *) msg, TCL_STATIC ); goto fail; } else 754 755static swig_module_info * 756SWIG_Tcl_GetModule(Tcl_Interp *interp) { 757 char *data; 758 swig_module_info *ret = 0; 759 760 /* first check if pointer already created */ 761 data = (char *) Tcl_GetVar(interp, "swig_runtime_data_type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, TCL_GLOBAL_ONLY); 762 if (data) { 763 SWIG_UnpackData(data, &ret, sizeof(swig_type_info **)); 764 } 765 766 return ret; 767} 768 769static void 770SWIG_Tcl_SetModule(Tcl_Interp *interp, swig_module_info *module) { 771 char buf[512]; 772 char *data; 773 774 /* create a new pointer */ 775 data = SWIG_PackData(buf, &module, sizeof(swig_type_info **)); 776 *data = 0; 777 Tcl_SetVar(interp, "swig_runtime_data_type_pointer" SWIG_RUNTIME_VERSION SWIG_TYPE_TABLE_NAME, buf, 0); 778} 779 780#ifdef __cplusplus 781} 782#endif 783 784 785 786