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