tcltklib.c : add TclTkIp#create_slave , TclTkIp#_make_safe and TclTkIp#safe?

MANUAL.euc : modify descriptions
tk.rb      : bug fix [ruby-talk:76980] and modify to support multi Tk IPs
tkafter.rb : modify to support multi Tk IPs


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

1 files changed, 74 insertions, 9 deletions

diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 5331e1fd03..9df98742b7 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -614,22 +614,22 @@ ip_init(argc, argv, self)
     cnt = rb_scan_args(argc, argv, "02", &argv0, &opts);
     switch(cnt) {
     case 2:
-      /* options */
-      Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
+	/* options */
+	Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0);
     case 1:
-      /* argv0 */
-      if (argv0 != Qnil) {
-	Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0);
-      }
+	/* argv0 */
+	if (argv0 != Qnil) {
+	    Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0);
+	}
     case 0:
-      /* no args */
-      ;
+	/* no args */
+	;
     }
 
     /* from Tcl_AppInit() */
     DUMP1("Tk_Init");
     if (Tk_Init(ptr->ip) == TCL_ERROR) {
-      rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
     }
     DUMP1("Tcl_StaticPackage(\"Tk\")");
 #if TCL_MAJOR_VERSION >= 8
@@ -653,6 +653,68 @@ ip_init(argc, argv, self)
     return self;
 }
 
+static VALUE
+ip_create_slave(argc, argv, self)
+    int   argc;
+    VALUE *argv;
+    VALUE self;
+{
+    struct tcltkip *master = get_ip(self);
+    struct tcltkip *slave = ALLOC(struct tcltkip);
+    VALUE name;
+    VALUE safemode;
+    int safe;
+
+    /* safe-mode check */
+    if (rb_scan_args(argc, argv, "11", &name, &safemode) == 1) {
+	safemode = Qfalse;
+    }
+    if (Tcl_IsSafe(master->ip) == 1) {
+	safe = 1;
+    } else if (safemode == Qfalse || safemode == Qnil) {
+	safe = 0;
+    } else {
+	safe = 1;
+    }
+
+    /* create slave-ip */
+    if ((slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe)) 
+	== NULL) {
+	rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter");
+    }
+    slave->return_value = 0;
+
+    return Data_Wrap_Struct(CLASS_OF(self), 0, ip_free, slave);
+}
+
+/* make ip "safe" */
+static VALUE
+ip_make_safe(self)
+    VALUE self;
+{
+    struct tcltkip *ptr = get_ip(self);
+    
+    if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) {
+	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+    }
+
+    return self;
+}
+
+/* is safe? */
+static VALUE
+ip_is_safe_p(self)
+    VALUE self;
+{
+    struct tcltkip *ptr = get_ip(self);
+    
+    if (Tcl_IsSafe(ptr->ip)) {
+	return Qtrue;
+    } else {
+	return Qfalse;
+    }
+}
+
 /* eval string in tcl by Tcl_Eval() */
 static VALUE
 ip_eval(self, str)
@@ -1012,6 +1074,9 @@ Init_tcltklib()
 
     rb_define_alloc_func(ip, ip_alloc);
     rb_define_method(ip, "initialize", ip_init, -1);
+    rb_define_method(ip, "create_slave", ip_create_slave, -1);
+    rb_define_method(ip, "make_safe", ip_make_safe, 0);
+    rb_define_method(ip, "safe?", ip_is_safe_p, 0);
     rb_define_method(ip, "_eval", ip_eval, 1);
     rb_define_method(ip, "_toUTF8",ip_toUTF8,2);
     rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);