tclrun.swg 22 KB

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