* ext/tk/tcltklib.c: make SEGV risk lower at exit.

* ext/tk/lib/tk.rb: ditto.

* ext/tk/lib/multi-tk.rb: fail to call function-style methods on slave
  interpreters. The strategy (MultiTkIp_PseudoToplevel_Evaluable) to
  fix the problem is a little tricky. You may have to take care of
  conflicting with it.
* ext/tk/lib/tk.rb: a little change for the pseudo-toplevel strategy.
* ext/tk/lib/tk/font.rb: ditto.
* ext/tk/lib/tk/msgcat.rb: ditto.
* ext/tk/lib/tkextlib/itk/incr_tk.rb: ditto.

* ext/tk/sample/demos-en/widget: fail to call function-style methods
  on sample scripts. To fix it, a strategy which similar to the way
  on MultiTiIp is used. Please take care when re-write and re-run a
  demo script on the Widget-Demo code viewer.
* ext/tk/sample/demos-jp/widget: ditto.


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

1 files changed, 60 insertions, 3 deletions

diff --git a/ext/tk/tcltklib.c b/ext/tk/tcltklib.c
index 2ec4233d47..5644dc98f2 100644
--- a/ext/tk/tcltklib.c
+++ b/ext/tk/tcltklib.c
@@ -4,7 +4,7 @@
  *              Oct. 24, 1997   Y. Matsumoto
  */
 
-#define TCLTKLIB_RELEASE_DATE "2006-07-03"
+#define TCLTKLIB_RELEASE_DATE "2006-07-10"
 
 #include "ruby.h"
 #include "rubysig.h"
@@ -81,6 +81,8 @@ static char *finalize_hook_name = "INTERP_FINALIZE_HOOK";
 
 static void ip_finalize _((Tcl_Interp*));
 
+static int at_exit = 0;
+
 
 /* for callback break & continue */
 static VALUE eTkCallbackReturn;
@@ -4358,6 +4360,33 @@ delete_slaves(ip)
 
 
 /* finalize operation */
+static VALUE
+lib_mark_at_exit(self)
+    VALUE self;
+{
+    at_exit = 1;
+    return Qnil;
+}
+
+static int
+#if TCL_MAJOR_VERSION >= 8
+ip_null_proc(clientData, interp, argc, argv)
+    ClientData clientData;
+    Tcl_Interp *interp; 
+    int argc;
+    Tcl_Obj *CONST argv[];
+#else /* TCL_MAJOR_VERSION < 8 */
+ip_null_proc(clientData, interp, argc, argv)
+    ClientData clientData;
+    Tcl_Interp *interp;
+    int argc;
+    char *argv[];
+#endif
+{
+    Tcl_ResetResult(interp);
+    return TCL_OK;
+}
+
 static void
 ip_finalize(ip)
     Tcl_Interp *ip;
@@ -4403,6 +4432,29 @@ ip_finalize(ip)
     /* delete slaves */
     delete_slaves(ip);
 
+    /* shut off some connections from Tcl-proc to Ruby */
+    if (at_exit) {
+	/* NOTE: Only when at exit. 
+	   Because, ruby removes objects, which depends on the deleted 
+	   interpreter, on some callback operations. 
+	   It is important for GC. */
+#if TCL_MAJOR_VERSION >= 8
+	Tcl_CreateObjCommand(ip, "ruby", ip_null_proc, 
+			     (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+	Tcl_CreateObjCommand(ip, "ruby_eval", ip_null_proc, 
+			     (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+	Tcl_CreateObjCommand(ip, "ruby_cmd", ip_null_proc, 
+			     (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#else /* TCL_MAJOR_VERSION < 8 */
+	Tcl_CreateCommand(ip, "ruby", ip_null_proc, 
+			  (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+	Tcl_CreateCommand(ip, "ruby_eval", ip_null_proc, 
+			  (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+	Tcl_CreateCommand(ip, "ruby_cmd", ip_null_proc, 
+			  (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
+#endif
+    }
+
     /* delete root widget */
 #if 0
     DUMP1("check `destroy'");
@@ -4425,7 +4477,7 @@ ip_finalize(ip)
 
     /* call finalize-hook-proc */
     DUMP1("check `finalize-hook-proc'");
-    if (Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
+    if ( Tcl_GetCommandInfo(ip, finalize_hook_name, &info)) {
         DUMP2("call finalize hook proc '%s'", finalize_hook_name);
         ruby_debug   = Qfalse;
         ruby_verbose = Qnil;
@@ -4680,7 +4732,6 @@ ip_CallWhenDeleted(clientData, ip)
     rb_thread_critical = thr_crit_bup;
 }
 
-
 /* initialize interpreter */
 static VALUE
 ip_init(argc, argv, self)
@@ -7925,6 +7976,8 @@ Init_tcltklib()
 
     /* --------------------------------------------------------------- */
 
+    rb_define_module_function(lib, "_mark_at_exit", lib_mark_at_exit, 0);
+
     rb_define_module_function(lib, "mainloop", lib_mainloop, -1);
     rb_define_module_function(lib, "mainloop_thread?", 
                               lib_evloop_thread_p, 0);
@@ -8061,6 +8114,10 @@ Init_tcltklib()
 
     /* --------------------------------------------------------------- */
 
+    rb_eval_string("at_exit{ TclTkLib._mark_at_exit }");
+
+    /* --------------------------------------------------------------- */
+
     ret = ruby_open_tcl_dll(rb_argv0 ? RSTRING(rb_argv0)->ptr : 0);
     switch(ret) {
     case TCLTK_STUBS_OK: