Ruby 2.0.0p247(2013-06-27revision41674)

- Main Page
- Modules
- Data Structures
- Files

- File List
- Globals

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
42 _nativethread_consistency_check(ip)
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%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
161 ruby_open_tk_dll()
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)); */
169 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
207 tcl_stubs_init_p()
208 {
209 return(tclStubsPtr != (TclStubs*)NULL);
210 }
211
212 int
213 tk_stubs_init_p()
214 {
215 return(tkStubsPtr != (TkStubs*)NULL);
216 }
217
218
219 Tcl_Interp *
220 #ifdef HAVE_PROTOTYPES
221 ruby_tcl_create_ip_and_stubs_init(int *st)
222 #else
223 ruby_tcl_create_ip_and_stubs_init(st)
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
239 _nativethread_consistency_check(tcl_ip);
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)); */
249 int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
283 _nativethread_consistency_check(tcl_ip);
284
285 return tcl_ip;
286 }
287 }
288
289 int
290 ruby_tcl_stubs_init()
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
366 ruby_tk_stubs_safeinit(tcl_ip)
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
402 ruby_tcltk_stubs()
403 {
404 int st;
405 Tcl_Interp *tcl_ip;
406
407 /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */
408 st = ruby_open_tcltk_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
457 ruby_open_tcl_dll(appname)
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
472 ruby_open_tk_dll()
473 {
474 if (!open_tcl_dll) {
475 /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
476 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
477 }
478
479 return TCLTK_STUBS_OK;
480 }
481
482 int
483 #ifdef HAVE_PROTOTYPES
484 ruby_open_tcltk_dll(char *appname)
485 #else
486 ruby_open_tcltk_dll(appname)
487 char *appname;
488 #endif
489 {
490 return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
491 }
492
493 int
494 tcl_stubs_init_p()
495 {
496 return 1;
497 }
498
499 int
500 tk_stubs_init_p()
501 {
502 return call_tk_stubs_init;
503 }
504
505 Tcl_Interp *
506 #ifdef HAVE_PROTOTYPES
507 ruby_tcl_create_ip_and_stubs_init(int *st)
508 #else
509 ruby_tcl_create_ip_and_stubs_init(st)
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)); */
517 ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
527 _nativethread_consistency_check(tcl_ip);
528
529 return tcl_ip;
530 }
531
532 int
533 ruby_tcl_stubs_init()
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
542 ruby_tk_stubs_init(tcl_ip)
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
563 ruby_tk_stubs_safeinit(tcl_ip)
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
587 ruby_tcltk_stubs()
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
595