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