Ruby  2.0.0p451(2014-02-24revision45167)
stubs.c
Go to the documentation of this file.
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 
24 static int call_macinit = 0;
25 
26 static 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 
39 static int nativethread_checked = 0;
40 
41 static void
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 
105 static DL_HANDLE tcl_dll = (DL_HANDLE)0;
106 static DL_HANDLE tk_dll = (DL_HANDLE)0;
107 
108 int
109 #ifdef HAVE_PROTOTYPES
110 ruby_open_tcl_dll(char *appname)
111 #else
112 ruby_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 
159 int
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)); */
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 
193 int
194 #ifdef HAVE_PROTOTYPES
195 ruby_open_tcltk_dll(char *appname)
196 #else
197 ruby_open_tcltk_dll(appname)
198  char *appname;
199 #endif
200 {
201  return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
202 }
203 
204 int
206 {
207  return(tclStubsPtr != (TclStubs*)NULL);
208 }
209 
210 int
212 {
213  return(tkStubsPtr != (TkStubs*)NULL);
214 }
215 
216 
217 Tcl_Interp *
218 #ifdef HAVE_PROTOTYPES
220 #else
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 
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)); */
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 
282 
283  return tcl_ip;
284  }
285 }
286 
287 int
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 
304 int
305 #ifdef HAVE_PROTOTYPES
306 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
307 #else
308 ruby_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 
360 int
361 #ifdef HAVE_PROTOTYPES
362 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
363 #else
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 
399 int
401 {
402  int st;
403  Tcl_Interp *tcl_ip;
404 
405  /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */
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 
448 static int open_tcl_dll = 0;
449 static int call_tk_stubs_init = 0;
450 
451 int
452 #ifdef HAVE_PROTOTYPES
453 ruby_open_tcl_dll(char *appname)
454 #else
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 
469 int
471 {
472  if (!open_tcl_dll) {
473  /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
475  }
476 
477  return TCLTK_STUBS_OK;
478 }
479 
480 int
481 #ifdef HAVE_PROTOTYPES
482 ruby_open_tcltk_dll(char *appname)
483 #else
485  char *appname;
486 #endif
487 {
488  return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
489 }
490 
491 int
493 {
494  return 1;
495 }
496 
497 int
499 {
500  return call_tk_stubs_init;
501 }
502 
503 Tcl_Interp *
504 #ifdef HAVE_PROTOTYPES
506 #else
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)); */
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 
526 
527  return tcl_ip;
528 }
529 
530 int
532 {
533  return TCLTK_STUBS_OK;
534 }
535 
536 int
537 #ifdef HAVE_PROTOTYPES
538 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
539 #else
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 
557 int
558 #ifdef HAVE_PROTOTYPES
559 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
560 #else
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 
584 int
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
int ruby_tcl_stubs_init()
Definition: stubs.c:531
#define FAIL_Tcl_InitStubs
Definition: stubs.h:28
#define Tcl_Eval
Definition: tcltklib.c:291
int ruby_open_tk_dll()
Definition: stubs.c:470
#define FAIL_CreateInterp
Definition: stubs.h:27
#define RSTRING_PTR(str)
static void _nativethread_consistency_check(Tcl_Interp *ip)
Definition: stubs.c:42
#define NO_Tk_Init
Definition: stubs.h:31
RUBY_EXTERN VALUE rb_argv0
Definition: ripper.y:653
int ruby_open_tcltk_dll(char *appname)
Definition: stubs.c:484
static int nativethread_checked
Definition: stubs.c:39
char * ruby_strdup(const char *)
Definition: util.c:456
#define FAIL_Tk_Init
Definition: stubs.h:32
int ruby_tcltk_stubs()
Definition: stubs.c:585
void ruby_xfree(void *x)
Definition: gc.c:3653
int ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
Definition: stubs.c:561
int ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
Definition: stubs.c:540
#define NO_TK_DLL
Definition: stubs.h:22
#define NO_TCL_DLL
Definition: stubs.h:18
char * getenv()
#define FAIL_Tk_InitStubs
Definition: stubs.h:33
#define NO_FindExecutable
Definition: stubs.h:19
#define TCLTK_STUBS_OK
Definition: stubs.h:15
Tcl_Interp * ruby_tcl_create_ip_and_stubs_init(int *st)
Definition: stubs.c:507
int tcl_stubs_init_p()
Definition: stubs.c:492
static int call_tk_stubs_init
Definition: stubs.c:449
#define NO_DeleteInterp
Definition: stubs.h:26
static int open_tcl_dll
Definition: stubs.c:448
void rb_warning(const char *fmt,...)
Definition: error.c:229
#define NO_CreateInterp
Definition: stubs.h:25
int ruby_open_tcl_dll(char *appname)
Definition: stubs.c:455
#define NULL
Definition: _sdbm.c:103
int tk_stubs_init_p()
Definition: stubs.c:498
void rb_warn(const char *fmt,...)
Definition: error.c:216