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