Ruby  2.1.10p492(2016-04-01revision54464)
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 
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%s"
87 # define TK_NAME "tk89%s"
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%s"
98 # define TK_NAME "libtk8.9%s"
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  char tcl_name[20];
120 
121  if (tcl_dll) return TCLTK_STUBS_OK;
122 
123  ruby_tcl_dll = getenv("RUBY_TCL_DLL");
124 #if defined _WIN32
125  if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll);
126 #endif
127  if (ruby_tcl_dll) {
128  tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll);
129  } else {
130  snprintf(tcl_name, sizeof tcl_name, TCL_NAME, DLEXT);
131  /* examine from 8.9 to 8.1 */
132  for (n = '9'; n > '0'; n--) {
133  tcl_name[TCL_INDEX] = n;
134  tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name);
135  if (tcl_dll)
136  break;
137  }
138  }
139 
140 #if defined _WIN32
141  if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll);
142 #endif
143 
144  if (!tcl_dll)
145  return NO_TCL_DLL;
146 
147  p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable");
148  if (!p_Tcl_FindExecutable)
149  return NO_FindExecutable;
150 
151  if (appname) {
152  p_Tcl_FindExecutable(appname);
153  } else {
154  p_Tcl_FindExecutable("ruby");
155  }
156 
157  return TCLTK_STUBS_OK;
158 }
159 
160 int
162 {
163  int n;
164  char *ruby_tk_dll = 0;
165  char tk_name[20];
166 
167  if (!tcl_dll) {
168  /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
170  if (ret != TCLTK_STUBS_OK) return ret;
171  }
172 
173  if (tk_dll) return TCLTK_STUBS_OK;
174 
175  ruby_tk_dll = getenv("RUBY_TK_DLL");
176  if (ruby_tk_dll) {
177  tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll);
178  } else {
179  snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT);
180  /* examine from 8.9 to 8.1 */
181  for (n = '9'; n > '0'; n--) {
182  tk_name[TK_INDEX] = n;
183  tk_dll = (DL_HANDLE)DL_OPEN(tk_name);
184  if (tk_dll)
185  break;
186  }
187  }
188 
189  if (!tk_dll)
190  return NO_TK_DLL;
191 
192  return TCLTK_STUBS_OK;
193 }
194 
195 int
196 #ifdef HAVE_PROTOTYPES
197 ruby_open_tcltk_dll(char *appname)
198 #else
199 ruby_open_tcltk_dll(appname)
200  char *appname;
201 #endif
202 {
203  return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
204 }
205 
206 int
208 {
209  return(tclStubsPtr != (TclStubs*)NULL);
210 }
211 
212 int
214 {
215  return(tkStubsPtr != (TkStubs*)NULL);
216 }
217 
218 
219 Tcl_Interp *
220 #ifdef HAVE_PROTOTYPES
222 #else
224  int *st;
225 #endif
226 {
227  Tcl_Interp *tcl_ip;
228 
229  if (st) *st = 0;
230 
231  if (tcl_stubs_init_p()) {
232  tcl_ip = Tcl_CreateInterp();
233 
234  if (!tcl_ip) {
235  if (st) *st = FAIL_CreateInterp;
236  return (Tcl_Interp*)NULL;
237  }
238 
240 
241  return tcl_ip;
242 
243  } else {
244  Tcl_Interp *(*p_Tcl_CreateInterp)();
245  Tcl_Interp *(*p_Tcl_DeleteInterp)();
246 
247  if (!tcl_dll) {
248  /* int ret = ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
250 
251  if (ret != TCLTK_STUBS_OK) {
252  if (st) *st = ret;
253  return (Tcl_Interp*)NULL;
254  }
255  }
256 
257  p_Tcl_CreateInterp
258  = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp");
259  if (!p_Tcl_CreateInterp) {
260  if (st) *st = NO_CreateInterp;
261  return (Tcl_Interp*)NULL;
262  }
263 
264  p_Tcl_DeleteInterp
265  = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp");
266  if (!p_Tcl_DeleteInterp) {
267  if (st) *st = NO_DeleteInterp;
268  return (Tcl_Interp*)NULL;
269  }
270 
271  tcl_ip = (*p_Tcl_CreateInterp)();
272  if (!tcl_ip) {
273  if (st) *st = FAIL_CreateInterp;
274  return (Tcl_Interp*)NULL;
275  }
276 
277  if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) {
278  if (st) *st = FAIL_Tcl_InitStubs;
279  (*p_Tcl_DeleteInterp)(tcl_ip);
280  return (Tcl_Interp*)NULL;
281  }
282 
284 
285  return tcl_ip;
286  }
287 }
288 
289 int
291 {
292  int st;
293  Tcl_Interp *tcl_ip;
294 
295  if (!tcl_stubs_init_p()) {
296  tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
297 
298  if (!tcl_ip) return st;
299 
300  Tcl_DeleteInterp(tcl_ip);
301  }
302 
303  return TCLTK_STUBS_OK;
304 }
305 
306 int
307 #ifdef HAVE_PROTOTYPES
308 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
309 #else
310 ruby_tk_stubs_init(tcl_ip)
311  Tcl_Interp *tcl_ip;
312 #endif
313 {
314  Tcl_ResetResult(tcl_ip);
315 
316  if (tk_stubs_init_p()) {
317  if (Tk_Init(tcl_ip) == TCL_ERROR) {
318  return FAIL_Tk_Init;
319  }
320  } else {
321  int (*p_Tk_Init)(Tcl_Interp *);
322 
323  if (!tk_dll) {
324  int ret = ruby_open_tk_dll();
325  if (ret != TCLTK_STUBS_OK) return ret;
326  }
327 
328  p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init");
329  if (!p_Tk_Init)
330  return NO_Tk_Init;
331 
332 #if defined USE_TK_STUBS && defined TK_FRAMEWORK && defined(__APPLE__)
333  /*
334  FIX ME : dirty hack for Mac OS X frameworks.
335  With stubs, fails to find Resource/Script directory of Tk.framework.
336  So, teach it to a Tcl interpreter by an environment variable.
337  e.g. when $tcl_library ==
338  /Library/Frameworks/Tcl.framwwork/8.5/Resources/Scripts
339  ==> /Library/Frameworks/Tk.framwwork/8.5/Resources/Scripts
340  */
341  if (Tcl_Eval(tcl_ip,
342  "if {[array get env TK_LIBRARY] == {}} { set env(TK_LIBRARY) [regsub -all -nocase {(t)cl} $tcl_library {\\1k}] }"
343  ) != TCL_OK) {
344  return FAIL_Tk_Init;
345  }
346 #endif
347 
348  if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR)
349  return FAIL_Tk_Init;
350 
351  if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0))
352  return FAIL_Tk_InitStubs;
353 
354 #ifdef __MACOS__
355  _macinit();
356 #endif
357  }
358 
359  return TCLTK_STUBS_OK;
360 }
361 
362 int
363 #ifdef HAVE_PROTOTYPES
364 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
365 #else
367  Tcl_Interp *tcl_ip;
368 #endif
369 {
370  Tcl_ResetResult(tcl_ip);
371 
372  if (tk_stubs_init_p()) {
373  if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
374  return FAIL_Tk_Init;
375  } else {
376  int (*p_Tk_SafeInit)(Tcl_Interp *);
377 
378  if (!tk_dll) {
379  int ret = ruby_open_tk_dll();
380  if (ret != TCLTK_STUBS_OK) return ret;
381  }
382 
383  p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit");
384  if (!p_Tk_SafeInit)
385  return NO_Tk_Init;
386 
387  if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR)
388  return FAIL_Tk_Init;
389 
390  if (!Tk_InitStubs(tcl_ip, (char *)"8.1", 0))
391  return FAIL_Tk_InitStubs;
392 
393 #ifdef __MACOS__
394  _macinit();
395 #endif
396  }
397 
398  return TCLTK_STUBS_OK;
399 }
400 
401 int
403 {
404  int st;
405  Tcl_Interp *tcl_ip;
406 
407  /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */
409  switch(st) {
410  case NO_FindExecutable:
411  return -7;
412  case NO_TCL_DLL:
413  case NO_TK_DLL:
414  return -1;
415  }
416 
417  tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
418  if (!tcl_ip) {
419  switch(st) {
420  case NO_CreateInterp:
421  case NO_DeleteInterp:
422  return -2;
423  case FAIL_CreateInterp:
424  return -3;
425  case FAIL_Tcl_InitStubs:
426  return -5;
427  }
428  }
429 
430  st = ruby_tk_stubs_init(tcl_ip);
431  switch(st) {
432  case NO_Tk_Init:
433  Tcl_DeleteInterp(tcl_ip);
434  return -4;
435  case FAIL_Tk_Init:
436  case FAIL_Tk_InitStubs:
437  Tcl_DeleteInterp(tcl_ip);
438  return -6;
439  }
440 
441  Tcl_DeleteInterp(tcl_ip);
442 
443  return 0;
444 }
445 
446 /*###################################################*/
447 #else /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */
448 /*###################################################*/
449 
450 static int open_tcl_dll = 0;
451 static int call_tk_stubs_init = 0;
452 
453 int
454 #ifdef HAVE_PROTOTYPES
455 ruby_open_tcl_dll(char *appname)
456 #else
458  char *appname;
459 #endif
460 {
461  if (appname) {
462  Tcl_FindExecutable(appname);
463  } else {
464  Tcl_FindExecutable("ruby");
465  }
466  open_tcl_dll = 1;
467 
468  return TCLTK_STUBS_OK;
469 }
470 
471 int
473 {
474  if (!open_tcl_dll) {
475  /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
477  }
478 
479  return TCLTK_STUBS_OK;
480 }
481 
482 int
483 #ifdef HAVE_PROTOTYPES
484 ruby_open_tcltk_dll(char *appname)
485 #else
487  char *appname;
488 #endif
489 {
490  return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
491 }
492 
493 int
495 {
496  return 1;
497 }
498 
499 int
501 {
502  return call_tk_stubs_init;
503 }
504 
505 Tcl_Interp *
506 #ifdef HAVE_PROTOTYPES
508 #else
510  int *st;
511 #endif
512 {
513  Tcl_Interp *tcl_ip;
514 
515  if (!open_tcl_dll) {
516  /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
518  }
519 
520  if (st) *st = 0;
521  tcl_ip = Tcl_CreateInterp();
522  if (!tcl_ip) {
523  if (st) *st = FAIL_CreateInterp;
524  return (Tcl_Interp*)NULL;
525  }
526 
528 
529  return tcl_ip;
530 }
531 
532 int
534 {
535  return TCLTK_STUBS_OK;
536 }
537 
538 int
539 #ifdef HAVE_PROTOTYPES
540 ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
541 #else
543  Tcl_Interp *tcl_ip;
544 #endif
545 {
546  if (Tk_Init(tcl_ip) == TCL_ERROR)
547  return FAIL_Tk_Init;
548 
549  if (!call_tk_stubs_init) {
550 #ifdef __MACOS__
551  _macinit();
552 #endif
553  call_tk_stubs_init = 1;
554  }
555 
556  return TCLTK_STUBS_OK;
557 }
558 
559 int
560 #ifdef HAVE_PROTOTYPES
561 ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
562 #else
564  Tcl_Interp *tcl_ip;
565 #endif
566 {
567 #if TCL_MAJOR_VERSION >= 8
568  if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
569  return FAIL_Tk_Init;
570 
571  if (!call_tk_stubs_init) {
572 #ifdef __MACOS__
573  _macinit();
574 #endif
575  call_tk_stubs_init = 1;
576  }
577 
578  return TCLTK_STUBS_OK;
579 
580 #else /* TCL_MAJOR_VERSION < 8 */
581 
582  return FAIL_Tk_Init;
583 #endif
584 }
585 
586 int
588 {
589  /* Tcl_FindExecutable(RSTRING_PTR(rb_argv0)); */
590  Tcl_FindExecutable(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
591  return 0;
592 }
593 
594 #endif
int ruby_tcl_stubs_init()
Definition: stubs.c:533
#define FAIL_Tcl_InitStubs
Definition: stubs.h:28
#define Tcl_Eval
Definition: tcltklib.c:296
int ruby_open_tk_dll()
Definition: stubs.c:472
#define FAIL_CreateInterp
Definition: stubs.h:27
static void _nativethread_consistency_check(Tcl_Interp *ip)
Definition: stubs.c:42
#define NO_Tk_Init
Definition: stubs.h:31
int ruby_open_tcltk_dll(char *appname)
Definition: stubs.c:486
static int nativethread_checked
Definition: stubs.c:39
char * ruby_strdup(const char *)
Definition: util.c:461
#define snprintf
Definition: subst.h:6
#define FAIL_Tk_Init
Definition: stubs.h:32
int ruby_tcltk_stubs()
Definition: stubs.c:587
void ruby_xfree(void *x)
Definition: gc.c:6245
int ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
Definition: stubs.c:563
int ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
Definition: stubs.c:542
#define NO_TK_DLL
Definition: stubs.h:22
#define NO_TCL_DLL
Definition: stubs.h:18
#define FAIL_Tk_InitStubs
Definition: stubs.h:33
#define NO_FindExecutable
Definition: stubs.h:19
#define getenv(name)
Definition: win32.c:66
#define RSTRING_PTR(str)
Definition: ruby.h:845
#define TCLTK_STUBS_OK
Definition: stubs.h:15
Tcl_Interp * ruby_tcl_create_ip_and_stubs_init(int *st)
Definition: stubs.c:509
int tcl_stubs_init_p()
Definition: stubs.c:494
static int call_tk_stubs_init
Definition: stubs.c:451
#define NO_DeleteInterp
Definition: stubs.h:26
static int open_tcl_dll
Definition: stubs.c:450
void rb_warning(const char *fmt,...)
Definition: error.c:236
#define NO_CreateInterp
Definition: stubs.h:25
int ruby_open_tcl_dll(char *appname)
Definition: stubs.c:457
#define NULL
Definition: _sdbm.c:102
int tk_stubs_init_p()
Definition: stubs.c:500
void rb_warn(const char *fmt,...)
Definition: error.c:223
RUBY_EXTERN VALUE rb_argv0
Definition: intern.h:682