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
24static int call_macinit = 0;
25
26static 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
39static int nativethread_checked = 0;
40
41static 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"
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
105static DL_HANDLE tcl_dll = (DL_HANDLE)0;
106static DL_HANDLE tk_dll  = (DL_HANDLE)0;
107
108int
109#ifdef HAVE_PROTOTYPES
110ruby_open_tcl_dll(char *appname)
111#else
112ruby_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
159int
160ruby_open_tk_dll()
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)); */
167        int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
193int
194#ifdef HAVE_PROTOTYPES
195ruby_open_tcltk_dll(char *appname)
196#else
197ruby_open_tcltk_dll(appname)
198    char *appname;
199#endif
200{
201    return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
202}
203
204int
205tcl_stubs_init_p()
206{
207    return(tclStubsPtr != (TclStubs*)NULL);
208}
209
210int
211tk_stubs_init_p()
212{
213    return(tkStubsPtr != (TkStubs*)NULL);
214}
215
216
217Tcl_Interp *
218#ifdef HAVE_PROTOTYPES
219ruby_tcl_create_ip_and_stubs_init(int *st)
220#else
221ruby_tcl_create_ip_and_stubs_init(st)
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
237        _nativethread_consistency_check(tcl_ip);
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)); */
247            int ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
281        _nativethread_consistency_check(tcl_ip);
282
283        return tcl_ip;
284    }
285}
286
287int
288ruby_tcl_stubs_init()
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
304int
305#ifdef HAVE_PROTOTYPES
306ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
307#else
308ruby_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
360int
361#ifdef HAVE_PROTOTYPES
362ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
363#else
364ruby_tk_stubs_safeinit(tcl_ip)
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
399int
400ruby_tcltk_stubs()
401{
402    int st;
403    Tcl_Interp *tcl_ip;
404
405    /* st = ruby_open_tcltk_dll(RSTRING_PTR(rb_argv0)); */
406    st = ruby_open_tcltk_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
448static int open_tcl_dll = 0;
449static int call_tk_stubs_init = 0;
450
451int
452#ifdef HAVE_PROTOTYPES
453ruby_open_tcl_dll(char *appname)
454#else
455ruby_open_tcl_dll(appname)
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
469int
470ruby_open_tk_dll()
471{
472    if (!open_tcl_dll) {
473        /* ruby_open_tcl_dll(RSTRING_PTR(rb_argv0)); */
474        ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
475    }
476
477    return TCLTK_STUBS_OK;
478}
479
480int
481#ifdef HAVE_PROTOTYPES
482ruby_open_tcltk_dll(char *appname)
483#else
484ruby_open_tcltk_dll(appname)
485    char *appname;
486#endif
487{
488    return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
489}
490
491int
492tcl_stubs_init_p()
493{
494    return 1;
495}
496
497int
498tk_stubs_init_p()
499{
500    return call_tk_stubs_init;
501}
502
503Tcl_Interp *
504#ifdef HAVE_PROTOTYPES
505ruby_tcl_create_ip_and_stubs_init(int *st)
506#else
507ruby_tcl_create_ip_and_stubs_init(st)
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)); */
515        ruby_open_tcl_dll(rb_argv0 ? RSTRING_PTR(rb_argv0) : 0);
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
525    _nativethread_consistency_check(tcl_ip);
526
527    return tcl_ip;
528}
529
530int
531ruby_tcl_stubs_init()
532{
533    return TCLTK_STUBS_OK;
534}
535
536int
537#ifdef HAVE_PROTOTYPES
538ruby_tk_stubs_init(Tcl_Interp *tcl_ip)
539#else
540ruby_tk_stubs_init(tcl_ip)
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
557int
558#ifdef HAVE_PROTOTYPES
559ruby_tk_stubs_safeinit(Tcl_Interp *tcl_ip)
560#else
561ruby_tk_stubs_safeinit(tcl_ip)
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
584int
585ruby_tcltk_stubs()
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
593