1/************************************************ 2 3 stubs.c - Tcl/Tk stubs support 4 5************************************************/ 6 7#include "ruby.h" 8#include "stubs.h" 9 10#if !defined(RSTRING_PTR) 11#define RSTRING_PTR(s) (RSTRING(s)->ptr) 12#define RSTRING_LEN(s) (RSTRING(s)->len) 13#endif 14 15#include <tcl.h> 16#include <tk.h> 17 18/*------------------------------*/ 19 20#ifdef __MACOS__ 21# include <tkMac.h> 22# include <Quickdraw.h> 23 24static int call_macinit = 0; 25 26static void 27_macinit() 28{ 29 if (!call_macinit) { 30 tcl_macQdPtr = &qd; /* setup QuickDraw globals */ 31 Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */ 32 call_macinit = 1; 33 } 34} 35#endif 36 37/*------------------------------*/ 38 39static int nativethread_checked = 0; 40 41static void 42_nativethread_consistency_check(ip) 43 Tcl_Interp *ip; 44{ 45 if (nativethread_checked || ip == (Tcl_Interp *)NULL) { 46 return; 47 } 48 49 /* If the variable "tcl_platform(threaded)" exists, 50 then the Tcl interpreter was compiled with threads enabled. */ 51 if (Tcl_GetVar2(ip, "tcl_platform", "threaded", TCL_GLOBAL_ONLY) != (char*)NULL) { 52#ifdef HAVE_NATIVETHREAD 53 /* consistent */ 54#else 55 rb_warn("Inconsistency. Loaded Tcl/Tk libraries are enabled nativethread-support. But `tcltklib' is not. The inconsistency causes SEGV or other troubles frequently."); 56#endif 57 } else { 58#ifdef HAVE_NATIVETHREAD 59 rb_warning("Inconsistency.`tcltklib' is enabled nativethread-support. But loaded Tcl/Tk libraries are not. (Probably, the inconsistency doesn't cause any troubles.)"); 60#else 61 /* consistent */ 62#endif 63 } 64 65 Tcl_ResetResult(ip); 66 67 nativethread_checked = 1; 68} 69 70/*------------------------------*/ 71 72#if defined USE_TCL_STUBS && defined USE_TK_STUBS 73 74#if defined _WIN32 || defined __CYGWIN__ 75# ifdef HAVE_RUBY_RUBY_H 76# include "ruby/util.h" 77# else 78# include "util.h" 79# endif 80# include <windows.h> 81 typedef HINSTANCE DL_HANDLE; 82# define DL_OPEN LoadLibrary 83# define DL_SYM GetProcAddress 84# define TCL_INDEX 4 85# define TK_INDEX 3 86# define TCL_NAME "tcl89" 87# define TK_NAME "tk89" 88# undef DLEXT 89# define DLEXT ".dll" 90#elif defined HAVE_DLOPEN 91# include <dlfcn.h> 92 typedef void *DL_HANDLE; 93# define DL_OPEN(file) dlopen(file, RTLD_LAZY|RTLD_GLOBAL) 94# define DL_SYM dlsym 95# define TCL_INDEX 8 96# define TK_INDEX 7 97# define TCL_NAME "libtcl8.9" 98# define TK_NAME "libtk8.9" 99# ifdef __APPLE__ 100# undef DLEXT 101# define DLEXT ".dylib" 102# endif 103#endif 104 105static DL_HANDLE tcl_dll = (DL_HANDLE)0; 106static DL_HANDLE tk_dll = (DL_HANDLE)0; 107 108int 109#ifdef HAVE_PROTOTYPES 110ruby_open_tcl_dll(char *appname) 111#else 112ruby_open_tcl_dll(appname) 113 char *appname; 114#endif 115{ 116 void (*p_Tcl_FindExecutable)(const char *); 117 int n; 118 char *ruby_tcl_dll = 0; 119 120 if (tcl_dll) return TCLTK_STUBS_OK; 121 122 ruby_tcl_dll = getenv("RUBY_TCL_DLL"); 123#if defined _WIN32 124 if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll); 125#endif 126 if (ruby_tcl_dll) { 127 tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll); 128 } else { 129 char tcl_name[] = TCL_NAME DLEXT; 130 /* examine from 8.9 to 8.1 */ 131 for (n = '9'; n > '0'; n--) { 132 tcl_name[TCL_INDEX] = n; 133 tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name); 134 if (tcl_dll) 135 break; 136 } 137 } 138 139#if defined _WIN32 140 if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll); 141#endif 142 143 if (!tcl_dll) 144 return NO_TCL_DLL; 145 146 p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable"); 147 if (!p_Tcl_FindExecutable) 148 return NO_FindExecutable; 149 150 if (appname) { 151 p_Tcl_FindExecutable(appname); 152 } else { 153 p_Tcl_FindExecutable("ruby"); 154 } 155 156 return TCLTK_STUBS_OK; 157} 158 159int 160ruby_open_tk_dll() 161{ 162 int n; 163 char *ruby_tk_dll = 0; 164 165 if (!tcl_dll) { 166 /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */ 167 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 168 if (ret != TCLTK_STUBS_OK) return ret; 169 } 170 171 if (tk_dll) return TCLTK_STUBS_OK; 172 173 ruby_tk_dll = getenv("RUBY_TK_DLL"); 174 if (ruby_tk_dll) { 175 tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll); 176 } else { 177 char tk_name[] = TK_NAME DLEXT; 178 /* examine from 8.9 to 8.1 */ 179 for (n = '9'; n > '0'; n--) { 180 tk_name[TK_INDEX] = n; 181 tk_dll = (DL_HANDLE)DL_OPEN(tk_name); 182 if (tk_dll) 183 break; 184 } 185 } 186 187 if (!tk_dll) 188 return NO_TK_DLL; 189 190 return TCLTK_STUBS_OK; 191} 192 193int 194#ifdef HAVE_PROTOTYPES 195ruby_open_tcltk_dll(char *appname) 196#else 197ruby_open_tcltk_dll(appname) 198 char *appname; 199#endif 200{ 201 return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); 202} 203 204int 205tcl_stubs_init_p() 206{ 207 return(tclStubsPtr != (TclStubs*)NULL); 208} 209 210int 211tk_stubs_init_p() 212{ 213 return(tkStubsPtr != (TkStubs*)NULL); 214} 215 216 217Tcl_Interp * 218#ifdef HAVE_PROTOTYPES 219ruby_tcl_create_ip_and_stubs_init(int *st) 220#else 221ruby_tcl_create_ip_and_stubs_init(st) 222 int *st; 223#endif 224{ 225 Tcl_Interp *tcl_ip; 226 227 if (st) *st = 0; 228 229 if (tcl_stubs_init_p()) { 230 tcl_ip = Tcl_CreateInterp(); 231 232 if (!tcl_ip) { 233 if (st) *st = FAIL_CreateInterp; 234 return (Tcl_Interp*)NULL; 235 } 236 237 _nativethread_consistency_check(tcl_ip); 238 239 return tcl_ip; 240 241 } else { 242 Tcl_Interp *(*p_Tcl_CreateInterp)(); 243 Tcl_Interp *(*p_Tcl_DeleteInterp)(); 244 245 if (!tcl_dll) { 246 /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */ 247 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 248 249 if (ret != TCLTK_STUBS_OK) { 250 if (st) *st = ret; 251 return (Tcl_Interp*)NULL; 252 } 253 } 254 255 p_Tcl_CreateInterp 256 = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp"); 257 if (!p_Tcl_CreateInterp) { 258 if (st) *st = NO_CreateInterp; 259 return (Tcl_Interp*)NULL; 260 } 261 262 p_Tcl_DeleteInterp 263 = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp"); 264 if (!p_Tcl_DeleteInterp) { 265 if (st) *st = NO_DeleteInterp; 266 return (Tcl_Interp*)NULL; 267 } 268 269 tcl_ip = (*p_Tcl_CreateInterp)(); 270 if (!tcl_ip) { 271 if (st) *st = FAIL_CreateInterp; 272 return (Tcl_Interp*)NULL; 273 } 274 275 if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) { 276 if (st) *st = FAIL_Tcl_InitStubs; 277 (*p_Tcl_DeleteInterp)(tcl_ip); 278 return (Tcl_Interp*)NULL; 279 } 280 281 _nativethread_consistency_check(tcl_ip); 282 283 return tcl_ip; 284 } 285} 286 287int 288ruby_tcl_stubs_init() 289{ 290 int st; 291 Tcl_Interp *tcl_ip; 292 293 if (!tcl_stubs_init_p()) { 294 tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st); 295 296 if (!tcl_ip) return st; 297 298 Tcl_DeleteInterp(tcl_ip); 299 } 300 301 return TCLTK_STUBS_OK; 302} 303 304int 305#ifdef HAVE_PROTOTYPES 306ruby_tk_stubs_init(Tcl_Interp *tcl_ip) 307#else 308ruby_tk_stubs_init(tcl_ip) 309 Tcl_Interp *tcl_ip; 310#endif 311{ 312 Tcl_ResetResult(tcl_ip); 313 314 if (tk_stubs_init_p()) { 315 if (Tk_Init(tcl_ip) == TCL_ERROR) { 316 return FAIL_Tk_Init; 317 } 318 } else { 319 int (*p_Tk_Init)(Tcl_Interp *); 320 321 if (!tk_dll) { 322 int ret = ruby_open_tk_dll(); 323 if (ret != TCLTK_STUBS_OK) return ret; 324 } 325 326 p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init"); 327 if (!p_Tk_Init) 328 return NO_Tk_Init; 329 330#if defined USE_TK_STUBS && defined TK_FRAMEWORK && defined(__APPLE__) 331 /* 332 FIX ME : dirty hack for Mac OS X frameworks. 333 With stubs, fails to find Resource/Script directory of Tk.framework. 334 So, teach it to a Tcl interpreter by an environment variable. 335 e.g. when $tcl_library == 336 /Library/Frameworks/Tcl.framwwork/8.5/Resources/Scripts 337 ==> /Library/Frameworks/Tk.framwwork/8.5/Resources/Scripts 338 */ 339 if (Tcl_Eval(tcl_ip, 340 "if {[array get env TK_LIBRARY] == {}} { set env(TK_LIBRARY) [regsub -all -nocase {(t)cl} $tcl_library {\\1k}] }" 341 ) != TCL_OK) { 342 return FAIL_Tk_Init; 343 } 344#endif 345 346 if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR) 347 return FAIL_Tk_Init; 348 349 if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0)) 350 return FAIL_Tk_InitStubs; 351 352#ifdef __MACOS__ 353 _macinit(); 354#endif 355 } 356 357 return TCLTK_STUBS_OK; 358} 359 360int 361#ifdef HAVE_PROTOTYPES 362ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip) 363#else 364ruby_tk_stubs_safeinit(tcl_ip) 365 Tcl_Interp *tcl_ip; 366#endif 367{ 368 Tcl_ResetResult(tcl_ip); 369 370 if (tk_stubs_init_p()) { 371 if (Tk_SafeInit(tcl_ip) == TCL_ERROR) 372 return FAIL_Tk_Init; 373 } else { 374 int (*p_Tk_SafeInit)(Tcl_Interp *); 375 376 if (!tk_dll) { 377 int ret = ruby_open_tk_dll(); 378 if (ret != TCLTK_STUBS_OK) return ret; 379 } 380 381 p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit"); 382 if (!p_Tk_SafeInit) 383 return NO_Tk_Init; 384 385 if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR) 386 return FAIL_Tk_Init; 387 388 if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0)) 389 return FAIL_Tk_InitStubs; 390 391#ifdef __MACOS__ 392 _macinit(); 393#endif 394 } 395 396 return TCLTK_STUBS_OK; 397} 398 399int 400ruby_tcltk_stubs() 401{ 402 int st; 403 Tcl_Interp *tcl_ip; 404 405 /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */ 406 st = ruby_open_tcltk_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 407 switch(st) { 408 case NO_FindExecutable: 409 return -7; 410 case NO_TCL_DLL: 411 case NO_TK_DLL: 412 return -1; 413 } 414 415 tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st); 416 if (!tcl_ip) { 417 switch(st) { 418 case NO_CreateInterp: 419 case NO_DeleteInterp: 420 return -2; 421 case FAIL_CreateInterp: 422 return -3; 423 case FAIL_Tcl_InitStubs: 424 return -5; 425 } 426 } 427 428 st = ruby_tk_stubs_init(tcl_ip); 429 switch(st) { 430 case NO_Tk_Init: 431 Tcl_DeleteInterp(tcl_ip); 432 return -4; 433 case FAIL_Tk_Init: 434 case FAIL_Tk_InitStubs: 435 Tcl_DeleteInterp(tcl_ip); 436 return -6; 437 } 438 439 Tcl_DeleteInterp(tcl_ip); 440 441 return 0; 442} 443 444/*###################################################*/ 445#else /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */ 446/*###################################################*/ 447 448static int open_tcl_dll = 0; 449static int call_tk_stubs_init = 0; 450 451int 452#ifdef HAVE_PROTOTYPES 453ruby_open_tcl_dll(char *appname) 454#else 455ruby_open_tcl_dll(appname) 456 char *appname; 457#endif 458{ 459 if (appname) { 460 Tcl_FindExecutable(appname); 461 } else { 462 Tcl_FindExecutable("ruby"); 463 } 464 open_tcl_dll = 1; 465 466 return TCLTK_STUBS_OK; 467} 468 469int 470ruby_open_tk_dll() 471{ 472 if (!open_tcl_dll) { 473 /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */ 474 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 475 } 476 477 return TCLTK_STUBS_OK; 478} 479 480int 481#ifdef HAVE_PROTOTYPES 482ruby_open_tcltk_dll(char *appname) 483#else 484ruby_open_tcltk_dll(appname) 485 char *appname; 486#endif 487{ 488 return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() ); 489} 490 491int 492tcl_stubs_init_p() 493{ 494 return 1; 495} 496 497int 498tk_stubs_init_p() 499{ 500 return call_tk_stubs_init; 501} 502 503Tcl_Interp * 504#ifdef HAVE_PROTOTYPES 505ruby_tcl_create_ip_and_stubs_init(int *st) 506#else 507ruby_tcl_create_ip_and_stubs_init(st) 508 int *st; 509#endif 510{ 511 Tcl_Interp *tcl_ip; 512 513 if (!open_tcl_dll) { 514 /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */ 515 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 516 } 517 518 if (st) *st = 0; 519 tcl_ip = Tcl_CreateInterp(); 520 if (!tcl_ip) { 521 if (st) *st = FAIL_CreateInterp; 522 return (Tcl_Interp*)NULL; 523 } 524 525 _nativethread_consistency_check(tcl_ip); 526 527 return tcl_ip; 528} 529 530int 531ruby_tcl_stubs_init() 532{ 533 return TCLTK_STUBS_OK; 534} 535 536int 537#ifdef HAVE_PROTOTYPES 538ruby_tk_stubs_init(Tcl_Interp *tcl_ip) 539#else 540ruby_tk_stubs_init(tcl_ip) 541 Tcl_Interp *tcl_ip; 542#endif 543{ 544 if (Tk_Init(tcl_ip) == TCL_ERROR) 545 return FAIL_Tk_Init; 546 547 if (!call_tk_stubs_init) { 548#ifdef __MACOS__ 549 _macinit(); 550#endif 551 call_tk_stubs_init = 1; 552 } 553 554 return TCLTK_STUBS_OK; 555} 556 557int 558#ifdef HAVE_PROTOTYPES 559ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip) 560#else 561ruby_tk_stubs_safeinit(tcl_ip) 562 Tcl_Interp *tcl_ip; 563#endif 564{ 565#if TCL_MAJOR_VERSION >= 8 566 if (Tk_SafeInit(tcl_ip) == TCL_ERROR) 567 return FAIL_Tk_Init; 568 569 if (!call_tk_stubs_init) { 570#ifdef __MACOS__ 571 _macinit(); 572#endif 573 call_tk_stubs_init = 1; 574 } 575 576 return TCLTK_STUBS_OK; 577 578#else /* TCL_MAJOR_VERSION < 8 */ 579 580 return FAIL_Tk_Init; 581#endif 582} 583 584int 585ruby_tcltk_stubs() 586{ 587 /* Tcl_FindExecutable(RSTRING_PTR(rb_argv0)); */ 588 Tcl_FindExecutable(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0); 589 return 0; 590} 591 592#endif 593