Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007 #include "ruby.h"
00008 #include "stubs.h"
00009
00010 #if !defined(RSTRING_PTR)
00011 #define RSTRING_PTR(s) (RSTRING(s)->ptr)
00012 #define RSTRING_LEN(s) (RSTRING(s)->len)
00013 #endif
00014
00015 #include <tcl.h>
00016 #include <tk.h>
00017
00018
00019
00020 #ifdef __MACOS__
00021 # include <tkMac.h>
00022 # include <Quickdraw.h>
00023
00024 static int call_macinit = 0;
00025
00026 static void
00027 _macinit()
00028 {
00029 if (!call_macinit) {
00030 tcl_macQdPtr = &qd;
00031 Tcl_MacSetEventProc(TkMacConvertEvent);
00032 call_macinit = 1;
00033 }
00034 }
00035 #endif
00036
00037
00038
00039 static int nativethread_checked = 0;
00040
00041 static void
00042 _nativethread_consistency_check(ip)
00043 Tcl_Interp *ip;
00044 {
00045 if (nativethread_checked || ip == (Tcl_Interp *)NULL) {
00046 return;
00047 }
00048
00049
00050
00051 if (Tcl_GetVar2(ip, "tcl_platform", "threaded", TCL_GLOBAL_ONLY) != (char*)NULL) {
00052 #ifdef HAVE_NATIVETHREAD
00053
00054 #else
00055 rb_warn("Inconsistency. Loaded Tcl/Tk libraries are enabled nativethread-support. But `tcltklib' is not. The inconsistency causes SEGV or other troubles frequently.");
00056 #endif
00057 } else {
00058 #ifdef HAVE_NATIVETHREAD
00059 rb_warning("Inconsistency.`tcltklib' is enabled nativethread-support. But loaded Tcl/Tk libraries are not. (Probably, the inconsistency doesn't cause any troubles.)");
00060 #else
00061
00062 #endif
00063 }
00064
00065 Tcl_ResetResult(ip);
00066
00067 nativethread_checked = 1;
00068 }
00069
00070
00071
00072 #if defined USE_TCL_STUBS && defined USE_TK_STUBS
00073
00074 #if defined _WIN32 || defined __CYGWIN__
00075 # include "util.h"
00076 # include <windows.h>
00077 typedef HINSTANCE DL_HANDLE;
00078 # define DL_OPEN LoadLibrary
00079 # define DL_SYM GetProcAddress
00080 # define TCL_INDEX 4
00081 # define TK_INDEX 3
00082 # define TCL_NAME "tcl89%s"
00083 # define TK_NAME "tk89%s"
00084 # undef DLEXT
00085 # define DLEXT ".dll"
00086 #elif defined HAVE_DLOPEN
00087 # include <dlfcn.h>
00088 typedef void *DL_HANDLE;
00089 # define DL_OPEN(file) dlopen(file, RTLD_LAZY|RTLD_GLOBAL)
00090 # define DL_SYM dlsym
00091 # define TCL_INDEX 8
00092 # define TK_INDEX 7
00093 # define TCL_NAME "libtcl8.9%s"
00094 # define TK_NAME "libtk8.9%s"
00095 # if defined(__APPLE__) && defined(__MACH__)
00096 # undef DLEXT
00097 # define DLEXT ".dylib"
00098 # endif
00099 #endif
00100
00101 static DL_HANDLE tcl_dll = (DL_HANDLE)0;
00102 static DL_HANDLE tk_dll = (DL_HANDLE)0;
00103
00104 int
00105 #ifdef HAVE_PROTOTYPES
00106 ruby_open_tcl_dll(char *appname)
00107 #else
00108 ruby_open_tcl_dll(appname)
00109 char *appname;
00110 #endif
00111 {
00112 void (*p_Tcl_FindExecutable)(const char *);
00113 int n;
00114 char *ruby_tcl_dll = 0;
00115 char tcl_name[20];
00116
00117 if (tcl_dll) return TCLTK_STUBS_OK;
00118
00119 ruby_tcl_dll = getenv("RUBY_TCL_DLL");
00120 #if defined _WIN32
00121 if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll);
00122 #endif
00123 if (ruby_tcl_dll) {
00124 tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll);
00125 } else {
00126 snprintf(tcl_name, sizeof tcl_name, TCL_NAME, DLEXT);
00127
00128 for (n = '9'; n > '0'; n--) {
00129 tcl_name[TCL_INDEX] = n;
00130 tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name);
00131 if (tcl_dll)
00132 break;
00133 }
00134 }
00135
00136 #if defined _WIN32
00137 if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll);
00138 #endif
00139
00140 if (!tcl_dll)
00141 return NO_TCL_DLL;
00142
00143 p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable");
00144 if (!p_Tcl_FindExecutable)
00145 return NO_FindExecutable;
00146
00147 if (appname) {
00148 p_Tcl_FindExecutable(appname);
00149 } else {
00150 p_Tcl_FindExecutable("ruby");
00151 }
00152
00153 return TCLTK_STUBS_OK;
00154 }
00155
00156 int
00157 ruby_open_tk_dll()
00158 {
00159 int n;
00160 char *ruby_tk_dll = 0;
00161 char tk_name[20];
00162
00163 if (!tcl_dll) {
00164
00165 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00166 if (ret != TCLTK_STUBS_OK) return ret;
00167 }
00168
00169 if (tk_dll) return TCLTK_STUBS_OK;
00170
00171 ruby_tk_dll = getenv("RUBY_TK_DLL");
00172 if (ruby_tk_dll) {
00173 tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll);
00174 } else {
00175 snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT);
00176
00177 for (n = '9'; n > '0'; n--) {
00178 tk_name[TK_INDEX] = n;
00179 tk_dll = (DL_HANDLE)DL_OPEN(tk_name);
00180 if (tk_dll)
00181 break;
00182 }
00183 }
00184
00185 if (!tk_dll)
00186 return NO_TK_DLL;
00187
00188 return TCLTK_STUBS_OK;
00189 }
00190
00191 int
00192 #ifdef HAVE_PROTOTYPES
00193 ruby_open_tcltk_dll(char *appname)
00194 #else
00195 ruby_open_tcltk_dll(appname)
00196 char *appname;
00197 #endif
00198 {
00199 return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
00200 }
00201
00202 int
00203 tcl_stubs_init_p()
00204 {
00205 return(tclStubsPtr != (TclStubs*)NULL);
00206 }
00207
00208 int
00209 tk_stubs_init_p()
00210 {
00211 return(tkStubsPtr != (TkStubs*)NULL);
00212 }
00213
00214
00215 Tcl_Interp *
00216 #ifdef HAVE_PROTOTYPES
00217 ruby_tcl_create_ip_and_stubs_init(int *st)
00218 #else
00219 ruby_tcl_create_ip_and_stubs_init(st)
00220 int *st;
00221 #endif
00222 {
00223 Tcl_Interp *tcl_ip;
00224
00225 if (st) *st = 0;
00226
00227 if (tcl_stubs_init_p()) {
00228 tcl_ip = Tcl_CreateInterp();
00229
00230 if (!tcl_ip) {
00231 if (st) *st = FAIL_CreateInterp;
00232 return (Tcl_Interp*)NULL;
00233 }
00234
00235 _nativethread_consistency_check(tcl_ip);
00236
00237 return tcl_ip;
00238
00239 } else {
00240 Tcl_Interp *(*p_Tcl_CreateInterp)();
00241 Tcl_Interp *(*p_Tcl_DeleteInterp)();
00242
00243 if (!tcl_dll) {
00244
00245 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00246
00247 if (ret != TCLTK_STUBS_OK) {
00248 if (st) *st = ret;
00249 return (Tcl_Interp*)NULL;
00250 }
00251 }
00252
00253 p_Tcl_CreateInterp
00254 = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp");
00255 if (!p_Tcl_CreateInterp) {
00256 if (st) *st = NO_CreateInterp;
00257 return (Tcl_Interp*)NULL;
00258 }
00259
00260 p_Tcl_DeleteInterp
00261 = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp");
00262 if (!p_Tcl_DeleteInterp) {
00263 if (st) *st = NO_DeleteInterp;
00264 return (Tcl_Interp*)NULL;
00265 }
00266
00267 tcl_ip = (*p_Tcl_CreateInterp)();
00268 if (!tcl_ip) {
00269 if (st) *st = FAIL_CreateInterp;
00270 return (Tcl_Interp*)NULL;
00271 }
00272
00273 if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) {
00274 if (st) *st = FAIL_Tcl_InitStubs;
00275 (*p_Tcl_DeleteInterp)(tcl_ip);
00276 return (Tcl_Interp*)NULL;
00277 }
00278
00279 _nativethread_consistency_check(tcl_ip);
00280
00281 return tcl_ip;
00282 }
00283 }
00284
00285 int
00286 ruby_tcl_stubs_init()
00287 {
00288 int st;
00289 Tcl_Interp *tcl_ip;
00290
00291 if (!tcl_stubs_init_p()) {
00292 tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
00293
00294 if (!tcl_ip) return st;
00295
00296 Tcl_DeleteInterp(tcl_ip);
00297 }
00298
00299 return TCLTK_STUBS_OK;
00300 }
00301
00302 int
00303 #ifdef HAVE_PROTOTYPES
00304 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
00305 #else
00306 ruby_tk_stubs_init(tcl_ip)
00307 Tcl_Interp *tcl_ip;
00308 #endif
00309 {
00310 Tcl_ResetResult(tcl_ip);
00311
00312 if (tk_stubs_init_p()) {
00313 if (Tk_Init(tcl_ip) == TCL_ERROR) {
00314 return FAIL_Tk_Init;
00315 }
00316 } else {
00317 int (*p_Tk_Init)(Tcl_Interp *);
00318
00319 if (!tk_dll) {
00320 int ret = ruby_open_tk_dll();
00321 if (ret != TCLTK_STUBS_OK) return ret;
00322 }
00323
00324 p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init");
00325 if (!p_Tk_Init)
00326 return NO_Tk_Init;
00327
00328 #if defined USE_TK_STUBS && defined TK_FRAMEWORK && defined(__APPLE__) && defined(__MACH__)
00329
00330
00331
00332
00333
00334
00335
00336
00337 if (Tcl_Eval(tcl_ip,
00338 "if {[array get env TK_LIBRARY] == {}} { set env(TK_LIBRARY) [regsub -all -nocase {(t)cl} $tcl_library {\\1k}] }"
00339 ) != TCL_OK) {
00340 return FAIL_Tk_Init;
00341 }
00342 #endif
00343
00344 if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR)
00345 return FAIL_Tk_Init;
00346
00347 if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0))
00348 return FAIL_Tk_InitStubs;
00349
00350 #ifdef __MACOS__
00351 _macinit();
00352 #endif
00353 }
00354
00355 return TCLTK_STUBS_OK;
00356 }
00357
00358 int
00359 #ifdef HAVE_PROTOTYPES
00360 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
00361 #else
00362 ruby_tk_stubs_safeinit(tcl_ip)
00363 Tcl_Interp *tcl_ip;
00364 #endif
00365 {
00366 Tcl_ResetResult(tcl_ip);
00367
00368 if (tk_stubs_init_p()) {
00369 if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
00370 return FAIL_Tk_Init;
00371 } else {
00372 int (*p_Tk_SafeInit)(Tcl_Interp *);
00373
00374 if (!tk_dll) {
00375 int ret = ruby_open_tk_dll();
00376 if (ret != TCLTK_STUBS_OK) return ret;
00377 }
00378
00379 p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit");
00380 if (!p_Tk_SafeInit)
00381 return NO_Tk_Init;
00382
00383 if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR)
00384 return FAIL_Tk_Init;
00385
00386 if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0))
00387 return FAIL_Tk_InitStubs;
00388
00389 #ifdef __MACOS__
00390 _macinit();
00391 #endif
00392 }
00393
00394 return TCLTK_STUBS_OK;
00395 }
00396
00397 int
00398 ruby_tcltk_stubs()
00399 {
00400 int st;
00401 Tcl_Interp *tcl_ip;
00402
00403
00404 st = ruby_open_tcltk_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00405 switch(st) {
00406 case NO_FindExecutable:
00407 return -7;
00408 case NO_TCL_DLL:
00409 case NO_TK_DLL:
00410 return -1;
00411 }
00412
00413 tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
00414 if (!tcl_ip) {
00415 switch(st) {
00416 case NO_CreateInterp:
00417 case NO_DeleteInterp:
00418 return -2;
00419 case FAIL_CreateInterp:
00420 return -3;
00421 case FAIL_Tcl_InitStubs:
00422 return -5;
00423 }
00424 }
00425
00426 st = ruby_tk_stubs_init(tcl_ip);
00427 switch(st) {
00428 case NO_Tk_Init:
00429 Tcl_DeleteInterp(tcl_ip);
00430 return -4;
00431 case FAIL_Tk_Init:
00432 case FAIL_Tk_InitStubs:
00433 Tcl_DeleteInterp(tcl_ip);
00434 return -6;
00435 }
00436
00437 Tcl_DeleteInterp(tcl_ip);
00438
00439 return 0;
00440 }
00441
00442
00443 #else
00444
00445
00446 static int open_tcl_dll = 0;
00447 static int call_tk_stubs_init = 0;
00448
00449 int
00450 #ifdef HAVE_PROTOTYPES
00451 ruby_open_tcl_dll(char *appname)
00452 #else
00453 ruby_open_tcl_dll(appname)
00454 char *appname;
00455 #endif
00456 {
00457 if (appname) {
00458 Tcl_FindExecutable(appname);
00459 } else {
00460 Tcl_FindExecutable("ruby");
00461 }
00462 open_tcl_dll = 1;
00463
00464 return TCLTK_STUBS_OK;
00465 }
00466
00467 int
00468 ruby_open_tk_dll()
00469 {
00470 if (!open_tcl_dll) {
00471
00472 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00473 }
00474
00475 return TCLTK_STUBS_OK;
00476 }
00477
00478 int
00479 #ifdef HAVE_PROTOTYPES
00480 ruby_open_tcltk_dll(char *appname)
00481 #else
00482 ruby_open_tcltk_dll(appname)
00483 char *appname;
00484 #endif
00485 {
00486 return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
00487 }
00488
00489 int
00490 tcl_stubs_init_p()
00491 {
00492 return 1;
00493 }
00494
00495 int
00496 tk_stubs_init_p()
00497 {
00498 return call_tk_stubs_init;
00499 }
00500
00501 Tcl_Interp *
00502 #ifdef HAVE_PROTOTYPES
00503 ruby_tcl_create_ip_and_stubs_init(int *st)
00504 #else
00505 ruby_tcl_create_ip_and_stubs_init(st)
00506 int *st;
00507 #endif
00508 {
00509 Tcl_Interp *tcl_ip;
00510
00511 if (!open_tcl_dll) {
00512
00513 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00514 }
00515
00516 if (st) *st = 0;
00517 tcl_ip = Tcl_CreateInterp();
00518 if (!tcl_ip) {
00519 if (st) *st = FAIL_CreateInterp;
00520 return (Tcl_Interp*)NULL;
00521 }
00522
00523 _nativethread_consistency_check(tcl_ip);
00524
00525 return tcl_ip;
00526 }
00527
00528 int
00529 ruby_tcl_stubs_init()
00530 {
00531 return TCLTK_STUBS_OK;
00532 }
00533
00534 int
00535 #ifdef HAVE_PROTOTYPES
00536 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
00537 #else
00538 ruby_tk_stubs_init(tcl_ip)
00539 Tcl_Interp *tcl_ip;
00540 #endif
00541 {
00542 if (Tk_Init(tcl_ip) == TCL_ERROR)
00543 return FAIL_Tk_Init;
00544
00545 if (!call_tk_stubs_init) {
00546 #ifdef __MACOS__
00547 _macinit();
00548 #endif
00549 call_tk_stubs_init = 1;
00550 }
00551
00552 return TCLTK_STUBS_OK;
00553 }
00554
00555 int
00556 #ifdef HAVE_PROTOTYPES
00557 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
00558 #else
00559 ruby_tk_stubs_safeinit(tcl_ip)
00560 Tcl_Interp *tcl_ip;
00561 #endif
00562 {
00563 #if TCL_MAJOR_VERSION >= 8
00564 if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
00565 return FAIL_Tk_Init;
00566
00567 if (!call_tk_stubs_init) {
00568 #ifdef __MACOS__
00569 _macinit();
00570 #endif
00571 call_tk_stubs_init = 1;
00572 }
00573
00574 return TCLTK_STUBS_OK;
00575
00576 #else
00577
00578 return FAIL_Tk_Init;
00579 #endif
00580 }
00581
00582 int
00583 ruby_tcltk_stubs()
00584 {
00585
00586 Tcl_FindExecutable(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00587 return 0;
00588 }
00589
00590 #endif
00591