Ruby 1.9.2p136(2010-12-25revision30365)

- Main Page
- Modules
- Data Structures
- Files

- File List
- Globals

# ext/tk/stubs.c

Go to the documentation of this file.

    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