• 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 # 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__)   /* Mac OS X */
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         /* examine from 8.9 to 8.1 */
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         /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
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         /* examine from 8.9 to 8.1 */
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             /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
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           FIX ME : dirty hack for Mac OS X frameworks.
00331           With stubs, fails to find Resource/Script directory of Tk.framework.
00332           So, teach it to a Tcl interpreter by an environment variable.
00333           e.g. when $tcl_library == 
00334                        /Library/Frameworks/Tcl.framwwork/8.5/Resources/Scripts
00335                    ==> /Library/Frameworks/Tk.framwwork/8.5/Resources/Scripts
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     /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */
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 /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */
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         /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
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         /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
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 /* TCL_MAJOR_VERSION < 8 */
00577 
00578     return FAIL_Tk_Init;
00579 #endif
00580 }
00581 
00582 int
00583 ruby_tcltk_stubs()
00584 {
00585     /* Tcl_FindExecutable(RSTRING_PTR(rb_argv0)); */
00586     Tcl_FindExecutable(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
00587     return 0;
00588 }
00589 
00590 #endif
00591 

Generated on Wed Sep 8 2010 21:54:36 for Ruby by  doxygen 1.7.1