* ext/tk/stubs.c: When --enable-tcltk-stubs, the initialize

  routine creates a Tcl/Tk interpreter and deletes it. However,
  init cost of Tk's MainWindow is not so small. And that makes it
  impossible to use libraries written with Tcl functions only on
  an environment without a graphical display. This changes support
  delaying initalization of Tk_Stubs until the script needs Tk.
* ext/tk/stubs.h: New file. Define prototypes and return codes of
  functions on stubs.c.
* ext/tk/tcltklib.c: Support delaying initalization of Tk_Stubs
  until the script needs Tk.
* ext/tk/tcltklib.c: Show friendly error messages for errors on
  initialization.
* ext/tk/tcltklib.c: Avoid SEGV on ip_finalize() when ruby is
  exiting and $DEBUG is true. (Not fix. If you know the reason of
  why, please fix it.)
* ext/tk/tkutil/tkutil.c (ary2list, ary2list2): bug fix on handling
  of encoding.
* ext/tk/lib/multi-tk.rb: MultiTkIp#eval_string and bg_eval_string
  don't work propery.
* ext/tk/lib/tk.rb: Forget extending Tk::Encoding module to Tk.
* ext/tk/lib/tk/variable.rb: TkVarAccess fails to initialize the
  object for an element of a Tcl's array variable.


git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@8860 b2dd03c8-39d4-4d8f-98ff-823fe69b080e

1 files changed, 392 insertions, 36 deletions

diff --git a/ext/tk/stubs.c b/ext/tk/stubs.c
index 3913abb570..e8b05355a9 100644
--- a/ext/tk/stubs.c
+++ b/ext/tk/stubs.c
@@ -1,7 +1,30 @@
-int ruby_tcltk_stubs();
+#include "stubs.h"
+#include "ruby.h"
+#include <tcl.h>
+#include <tk.h>
+
+/*------------------------------*/
+
+#ifdef __MACOS__
+# include <tkMac.h>
+# include <Quickdraw.h>
+
+static int call_macinit = 0;
+
+static void
+_macinit()
+{
+    if (!call_macinit) {
+        tcl_macQdPtr = &qd; /* setup QuickDraw globals */
+        Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */
+        call_macinit = 1;
+    }
+}
+#endif
+
+/*------------------------------*/
 
 #if defined USE_TCL_STUBS && defined USE_TK_STUBS
-#include "ruby.h"
 
 #if defined _WIN32 || defined __CYGWIN__
 # include "util.h"
@@ -26,42 +49,33 @@ int ruby_tcltk_stubs();
 # define TK_NAME "libtk8.9%s"
 #endif
 
-#include <tcl.h>
-#include <tk.h>
+static DL_HANDLE tcl_dll = (DL_HANDLE)0;
+static DL_HANDLE tk_dll  = (DL_HANDLE)0;
 
 int
-ruby_tcltk_stubs()
+ruby_open_tcl_dll(appname)
+    char *appname;
 {
-    DL_HANDLE tcl_dll;
-    DL_HANDLE tk_dll;
     void (*p_Tcl_FindExecutable)(const char *);
-    Tcl_Interp *(*p_Tcl_CreateInterp)();
-    int (*p_Tk_Init)(Tcl_Interp *);
-    Tcl_Interp *tcl_ip;
     int n;
     char *ruby_tcl_dll = 0;
-    char *ruby_tk_dll = 0;
     char tcl_name[20];
-    char tk_name[20];
+
+    if (tcl_dll) return TCLTK_STUBS_OK;
 
     ruby_tcl_dll = getenv("RUBY_TCL_DLL");
 #if defined _WIN32
     if (ruby_tcl_dll) ruby_tcl_dll = ruby_strdup(ruby_tcl_dll);
 #endif
-    ruby_tk_dll = getenv("RUBY_TK_DLL");
-    if (ruby_tcl_dll && ruby_tk_dll) {
+    if (ruby_tcl_dll) {
         tcl_dll = (DL_HANDLE)DL_OPEN(ruby_tcl_dll);
-        tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll);
     } else {
         snprintf(tcl_name, sizeof tcl_name, TCL_NAME, DLEXT);
-        snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT);
         /* examine from 8.9 to 8.1 */
         for (n = '9'; n > '0'; n--) {
             tcl_name[TCL_INDEX] = n;
-            tk_name[TK_INDEX] = n;
             tcl_dll = (DL_HANDLE)DL_OPEN(tcl_name);
-            tk_dll = (DL_HANDLE)DL_OPEN(tk_name);
-            if (tcl_dll && tk_dll)
+            if (tcl_dll)
                 break;
         }
     }
@@ -70,35 +84,377 @@ ruby_tcltk_stubs()
     if (ruby_tcl_dll) ruby_xfree(ruby_tcl_dll);
 #endif
 
-    if (!tcl_dll || !tk_dll)
-        return -1;
+    if (!tcl_dll)
+        return NO_TCL_DLL;
 
     p_Tcl_FindExecutable = (void (*)(const char *))DL_SYM(tcl_dll, "Tcl_FindExecutable");
     if (!p_Tcl_FindExecutable)
-        return -7;
+        return NO_FindExecutable;
 
-    p_Tcl_FindExecutable("ruby");
+    if (appname) {
+        p_Tcl_FindExecutable(appname);
+    } else {
+        p_Tcl_FindExecutable("ruby");
+    }
 
-    p_Tcl_CreateInterp = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp");
-    if (!p_Tcl_CreateInterp)
-        return -2;
+    return TCLTK_STUBS_OK;
+}
 
-    tcl_ip = (*p_Tcl_CreateInterp)();
-    if (!tcl_ip)
-        return -3;
+int
+ruby_open_tk_dll()
+{
+    int n;
+    char *ruby_tk_dll = 0;
+    char tk_name[20];
 
-    p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init");
-    if (!p_Tk_Init)
-        return -4;
-    (*p_Tk_Init)(tcl_ip);
+    if (!tcl_dll) {
+        int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
+        if (ret != TCLTK_STUBS_OK) return ret;
+    }
+
+    if (tk_dll) return TCLTK_STUBS_OK;
+
+    ruby_tk_dll = getenv("RUBY_TK_DLL");
+    if (ruby_tk_dll) {
+        tk_dll = (DL_HANDLE)DL_OPEN(ruby_tk_dll);
+    } else {
+        snprintf(tk_name, sizeof tk_name, TK_NAME, DLEXT);
+        /* examine from 8.9 to 8.1 */
+        for (n = '9'; n > '0'; n--) {
+            tk_name[TK_INDEX] = n;
+            tk_dll = (DL_HANDLE)DL_OPEN(tk_name);
+            if (tk_dll)
+                break;
+        }
+    }
+
+    if (!tk_dll)
+        return NO_TK_DLL;
+
+    return TCLTK_STUBS_OK;
+}
+
+int
+ruby_open_tcltk_dll(appname)
+    char *appname;
+{
+    return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
+}
+
+int 
+tcl_stubs_init_p()
+{
+    return(tclStubsPtr != (TclStubs*)NULL);
+}
+
+int 
+tk_stubs_init_p()
+{
+    return(tkStubsPtr != (TkStubs*)NULL);
+}
+
+
+Tcl_Interp *
+ruby_tcl_create_ip_and_stubs_init(st)
+    int *st;
+{
+    if (st) *st = 0;
+
+    if (tcl_stubs_init_p()) {
+        return Tcl_CreateInterp();
+    } else {
+        Tcl_Interp *(*p_Tcl_CreateInterp)();
+        Tcl_Interp *(*p_Tcl_DeleteInterp)();
+        Tcl_Interp *tcl_ip;
+
+        if (!tcl_dll) {
+            int ret = ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
+            if (ret != TCLTK_STUBS_OK) {
+                if (st) *st = ret;
+                return (Tcl_Interp*)NULL;
+            }
+        }
+
+        p_Tcl_CreateInterp 
+            = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_CreateInterp");
+        if (!p_Tcl_CreateInterp) {
+            if (st) *st = NO_CreateInterp;
+            return (Tcl_Interp*)NULL;
+        }
+
+        p_Tcl_DeleteInterp 
+            = (Tcl_Interp *(*)())DL_SYM(tcl_dll, "Tcl_DeleteInterp");
+        if (!p_Tcl_DeleteInterp) {
+            if (st) *st = NO_DeleteInterp;
+            return (Tcl_Interp*)NULL;
+        }
+
+        tcl_ip = (*p_Tcl_CreateInterp)();
+        if (!tcl_ip) {
+            if (st) *st = FAIL_CreateInterp;
+            return (Tcl_Interp*)NULL;
+        }
+
+        if (!Tcl_InitStubs(tcl_ip, "8.1", 0)) {
+            if (st) *st = FAIL_Tcl_InitStubs;
+            (*p_Tcl_DeleteInterp)(tcl_ip);
+            return (Tcl_Interp*)NULL;
+        }
+
+        return tcl_ip;
+    }
+}
+
+int
+ruby_tcl_stubs_init()
+{
+    int st;
+    Tcl_Interp *tcl_ip;
+
+    if (!tcl_stubs_init_p()) {
+        tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
+
+        if (!tcl_ip) return st;
+
+        Tcl_DeleteInterp(tcl_ip);
+    }
+
+    return TCLTK_STUBS_OK;
+}
+
+int
+ruby_tk_stubs_init(tcl_ip)
+    Tcl_Interp *tcl_ip;
+{
+    Tcl_ResetResult(tcl_ip);
+
+    if (tk_stubs_init_p()) {
+        if (Tk_Init(tcl_ip) == TCL_ERROR) {
+            return FAIL_Tk_Init;
+        }
+    } else {
+        int (*p_Tk_Init)(Tcl_Interp *);
+
+        if (!tk_dll) {
+            int ret = ruby_open_tk_dll();
+            if (ret != TCLTK_STUBS_OK) return ret;
+        }
+
+        p_Tk_Init = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_Init");
+        if (!p_Tk_Init)
+            return NO_Tk_Init;
+
+        if ((*p_Tk_Init)(tcl_ip) == TCL_ERROR)
+            return FAIL_Tk_Init;
+
+        if (!Tk_InitStubs(tcl_ip, "8.1", 0))
+            return FAIL_Tk_InitStubs;
+
+#ifdef __MACOS__
+        _macinit();
+#endif
+    }
+
+    return TCLTK_STUBS_OK;
+}
+
+int
+ruby_tk_stubs_safeinit(tcl_ip)
+    Tcl_Interp *tcl_ip;
+{
+    Tcl_ResetResult(tcl_ip);
+
+    if (tk_stubs_init_p()) {
+        if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
+            return FAIL_Tk_Init;
+    } else {
+        int (*p_Tk_SafeInit)(Tcl_Interp *);
+
+        if (!tk_dll) {
+            int ret = ruby_open_tk_dll();
+            if (ret != TCLTK_STUBS_OK) return ret;
+        }
+
+        p_Tk_SafeInit = (int (*)(Tcl_Interp *))DL_SYM(tk_dll, "Tk_SafeInit");
+        if (!p_Tk_SafeInit)
+            return NO_Tk_Init;
+
+        if ((*p_Tk_SafeInit)(tcl_ip) == TCL_ERROR)
+            return FAIL_Tk_Init;
+
+        if (!Tk_InitStubs(tcl_ip, "8.1", 0))
+            return FAIL_Tk_InitStubs;
+
+#ifdef __MACOS__
+        _macinit();
+#endif
+    }
+
+    return TCLTK_STUBS_OK;
+}
 
-    if (!Tcl_InitStubs(tcl_ip, "8.1", 0))
-        return -5;
-    if (!Tk_InitStubs(tcl_ip, "8.1", 0))
+int
+ruby_tcltk_stubs()
+{
+    int st;
+    Tcl_Interp *tcl_ip;
+
+    st = ruby_open_tcltk_dll(RSTRING(rb_argv0)->ptr);
+    switch(st) {
+    case NO_FindExecutable:
+        return -7;
+    case NO_TCL_DLL:
+    case NO_TK_DLL:
+        return -1;
+    }
+
+    tcl_ip = ruby_tcl_create_ip_and_stubs_init(&st);
+    if (!tcl_ip) {
+        switch(st) {
+        case NO_CreateInterp:
+        case NO_DeleteInterp:
+            return -2;
+        case FAIL_CreateInterp:
+            return -3;
+        case FAIL_Tcl_InitStubs:
+            return -5;
+        }
+    }
+
+    st = ruby_tk_stubs_init(tcl_ip);
+    switch(st) {
+    case NO_Tk_Init:
+        Tcl_DeleteInterp(tcl_ip);
+        return -4;
+    case FAIL_Tk_Init:
+    case FAIL_Tk_InitStubs:
+        Tcl_DeleteInterp(tcl_ip);
         return -6;
+    }
 
     Tcl_DeleteInterp(tcl_ip);
 
     return 0;
 }
+
+/*###################################################*/
+#else /* ! USE_TCL_STUBS || ! USE_TK_STUBS) */
+/*###################################################*/
+
+static int open_tcl_dll = 0;
+static int call_tk_stubs_init = 0;
+
+int
+ruby_open_tcl_dll(appname)
+    char *appname;
+{
+    if (appname) {
+        Tcl_FindExecutable(appname);
+    } else {
+        Tcl_FindExecutable("ruby");
+    }
+    open_tcl_dll = 1;
+
+    return TCLTK_STUBS_OK;
+}
+
+int ruby_open_tk_dll()
+{
+    if (!open_tcl_dll) {
+        ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
+    }
+
+    return TCLTK_STUBS_OK;
+}
+
+int ruby_open_tcltk_dll(appname)
+    char *appname;
+{
+    return( ruby_open_tcl_dll(appname) || ruby_open_tk_dll() );
+}
+
+int 
+tcl_stubs_init_p()
+{
+    return 1;
+}
+
+int 
+tk_stubs_init_p()
+{
+    return call_tk_stubs_init;
+}
+
+Tcl_Interp *
+ruby_tcl_create_ip_and_stubs_init(st)
+    int *st;
+{
+    Tcl_Interp *tcl_ip;
+
+    if (!open_tcl_dll) {
+        ruby_open_tcl_dll(RSTRING(rb_argv0)->ptr);
+    }
+
+    if (st) *st = 0;
+    tcl_ip = Tcl_CreateInterp();
+    if (!tcl_ip) {
+        if (st) *st = FAIL_CreateInterp;
+        return (Tcl_Interp*)NULL;
+    }
+    return tcl_ip;
+}
+
+int 
+ruby_tcl_stubs_init()
+{
+    return TCLTK_STUBS_OK;
+}
+
+int 
+ruby_tk_stubs_init(tcl_ip)
+    Tcl_Interp *tcl_ip;
+{
+    if (Tk_Init(tcl_ip) == TCL_ERROR)
+        return FAIL_Tk_Init;
+
+    if (!call_tk_stubs_init) {
+#ifdef __MACOS__
+        _macinit();
+#endif
+        call_tk_stubs_init = 1;
+    }
+
+    return TCLTK_STUBS_OK;
+}
+
+int
+ruby_tk_stubs_safeinit(tcl_ip)
+    Tcl_Interp *tcl_ip;
+{
+#if TCL_MAJOR_VERSION >= 8
+    if (Tk_SafeInit(tcl_ip) == TCL_ERROR)
+        return FAIL_Tk_Init;
+
+    if (!call_tk_stubs_init) {
+#ifdef __MACOS__
+        _macinit();
+#endif
+        call_tk_stubs_init = 1;
+    }
+
+    return TCLTK_STUBS_OK;
+
+#else /* TCL_MAJOR_VERSION < 8 */
+
+    return FAIL_Tk_Init;
+#endif
+}
+
+int 
+ruby_tcltk_stubs()
+{
+    Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
+    return 0;
+}
+
 #endif