* ext/tcltklib/tcltklib.c (ip_init): bug fix

* ext/tk/tkutil.c (get_eval_string_core): accept a Regexp object
* ext/tk/lib/multi-tk.rb: fix bug on 'exit' operation
* ext/tk/lib/tk/text.rb: 'tksearch' accepts a Regexp object as a
  matting pattern argument


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

7 files changed, 122 insertions, 10 deletions

diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index f1a81c9964..8b180bf493 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -3271,6 +3271,8 @@ delete_slaves(ip)
     char *slave_name;
     int i, len;
 
+    DUMP2("delete slaves of ip(%lx)", ip);
+
     Tcl_Preserve(ip);
 
     if (Tcl_Eval(ip, "info slaves") == TCL_ERROR) {
@@ -3339,7 +3341,10 @@ ip_free(ptr)
 	thr_crit_bup = rb_thread_critical;
 	rb_thread_critical = Qtrue;
 
+	DUMP2("IP ref_count = %d", ptr->ref_count);
+
 	if (!Tcl_InterpDeleted(ptr->ip)) {
+	    DUMP2("IP(%lx) is not deleted", ptr->ip);
 	    /* Tcl_Preserve(ptr->ip); */
 	    rbtk_preserve_ip(ptr);
 
@@ -3369,6 +3374,7 @@ ip_free(ptr)
 	}
 
 	rbtk_release_ip(ptr);
+	DUMP2("IP ref_count = %d", ptr->ref_count);
 
 	free(ptr);
 
@@ -3418,7 +3424,8 @@ ip_init(argc, argv, self)
 	rb_raise(rb_eRuntimeError, "fail to create a new Tk interpreter");
     }
 
-    rbtk_preserve_ip((ClientData)ptr->ip);
+    rbtk_preserve_ip(ptr);
+    DUMP2("IP ref_count = %d", ptr->ref_count);
     current_interp = ptr->ip;
 
     ptr->has_orig_exit 
diff --git a/ext/tk/MANIFEST b/ext/tk/MANIFEST
index 158c8dd5b9..64d260a672 100644
--- a/ext/tk/MANIFEST
+++ b/ext/tk/MANIFEST
@@ -268,6 +268,7 @@ sample/iso2022-kr.txt
 sample/menubar1.rb
 sample/menubar2.rb
 sample/multi-ip_sample.rb
+sample/multi-ip_sample2.rb
 sample/optobj_sample.rb
 sample/propagate.rb
 sample/remote-ip_sample.rb
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index 5299eee06c..061123b79e 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -125,7 +125,10 @@ class MultiTkIp
 
     if wait == 0
       # no wait
-      thread.raise exception
+      Thread.pass
+      if thread.stop?
+	thread.raise exception
+      end
       return thread
     end
 
@@ -294,7 +297,8 @@ class MultiTkIp
 	  obj.delete unless obj.deleted?
 	}
 =end
-	exit
+	#exit(e.status)
+	fail e
       end
       # break
 
@@ -1325,14 +1329,19 @@ class MultiTkIp
     rescue MultiTkIp_OK => ret
       # return value
       return ret.value
-    rescue SystemExit
+    rescue SystemExit => e
       # exit IP
       warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
       begin
 	self._eval_without_enc('exit')
       rescue Exception
       end
-      self.delete
+      if !safe? && allow_ruby_exit?
+	self.delete
+	fail e
+      else
+	self.delete
+      end
     rescue Exception => e
       if $DEBUG
 	warn("Warning: " + e.class.inspect + 
@@ -1542,10 +1551,18 @@ class << MultiTkIp
     __getip.deleted?
   end
 
-  def exit(st = 0)
+  def abort(msg = nil)
+    __getip.abort(msg)
+  end
+
+  def exit(st = true)
     __getip.exit(st)
   end
 
+  def exit!(st = false)
+    __getip.exit!(st)
+  end
+
   def restart(app_name = nil, keys = {})
     init_ip_internal
 
@@ -1852,7 +1869,21 @@ class MultiTkIp
     @interp.deleted?
   end
 
-  def exit(st = 0)
+  def abort(msg = nil)
+    if master?
+      if msg
+	Kernel.abort(msg)
+      else
+	Kernel.abort
+      end
+    else
+      # ignore msg
+      delete
+      1
+    end
+  end
+
+  def exit(st = true)
     if master?
       Kernel.exit(st)
     else
@@ -1861,6 +1892,15 @@ class MultiTkIp
     end
   end
 
+  def exit!(st = false)
+    if master? && !safe? && allow_ruby_exit?
+      Kernel.exit!(st)
+    else
+      delete
+      st
+    end
+  end
+
   def restart(app_name = nil, keys = {})
     _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS)
 
diff --git a/ext/tk/lib/tk/text.rb b/ext/tk/lib/tk/text.rb
index c05e3f03ad..123f49af03 100644
--- a/ext/tk/lib/tk/text.rb
+++ b/ext/tk/lib/tk/text.rb
@@ -971,12 +971,25 @@ class TkText<TkTextWin
     # call 'search' subcommand of text widget
     #   args ::= [<array_of_opts>] <pattern> <start_index> [<stop_index>]
     # If <pattern> is regexp, then it must be a regular expression of Tcl
+    nocase = false
     if args[0].kind_of?(Array)
-      opts = args.shift.collect{|opt| '-' + opt.to_s }
+      opts = args.shift.collect{|opt|
+	s_opt = opt.to_s
+	nocase = true if s_opt == 'nocase'
+	'-' + s_opt
+      }
     else
       opts = []
     end
 
+    if args[0].kind_of?(Regexp)
+      regexp = args.shift
+      if !nocase && (regexp.options & Regexp::IGNORECASE) != 0
+	opts << '-nocase'
+      end
+      args.unshift(regexp.source)
+    end
+
     opts << '--'
 
     ret = tk_send('search', *(opts + args))
@@ -991,13 +1004,28 @@ class TkText<TkTextWin
     # call 'search' subcommand of text widget
     #   args ::= [<array_of_opts>] <var> <pattern> <start_index> [<stop_index>]
     # If <pattern> is regexp, then it must be a regular expression of Tcl
+    nocase = false
     if args[0].kind_of?(Array)
-      opts = args.shift.collect{|opt| '-' + opt.to_s }
+      opts = args.shift.collect{|opt|
+	s_opt = opt.to_s
+	nocase = true if s_opt == 'nocase'
+	'-' + s_opt
+      }
     else
       opts = []
     end
 
-    opts << '-count' << args.shift << '--'
+    opts << '-count' << args.shift
+
+    if args[0].kind_of?(Regexp)
+      regexp = args.shift
+      if !nocase && (regexp.options & Regexp::IGNORECASE) != 0
+	opts << '-nocase'
+      end
+      args.unshift(regexp.source)
+    end
+
+    opts << '--'
 
     ret = tk_send('search', *(opts + args))
     if ret == ""
diff --git a/ext/tk/lib/tkextlib/SUPPORT_STATUS b/ext/tk/lib/tkextlib/SUPPORT_STATUS
index cd2130d0b8..a13e2751e8 100644
--- a/ext/tk/lib/tkextlib/SUPPORT_STATUS
+++ b/ext/tk/lib/tkextlib/SUPPORT_STATUS
@@ -104,8 +104,10 @@ Tkgeomap    http://tkgeomap.sourceforge.net/index.html
 ===< not determined to supprt or not >========================================
 
 BLT         http://sourceforge.net/projects/blt
+                * see tcltk-ext library on RAA (http://raa.ruby-lang.org/)
 
 Tix         http://tixlibrary.sourceforge.net/
+                * see tcltk-ext library on RAA (http://raa.ruby-lang.org/)
 
 TkZinc      http://www.tkzinc.org/
 
diff --git a/ext/tk/sample/multi-ip_sample2.rb b/ext/tk/sample/multi-ip_sample2.rb
new file mode 100644
index 0000000000..e5e3c2920c
--- /dev/null
+++ b/ext/tk/sample/multi-ip_sample2.rb
@@ -0,0 +1,29 @@
+require 'multi-tk.rb'
+
+th = Thread.new{Tk.mainloop}
+
+TkLabel.new(:text=>'this is a primary master').pack
+
+ip1 = MultiTkIp.new_slave(:safe=>1)
+ip2 = MultiTkIp.new_slave(:safe=>2)
+
+cmd = proc{|s|
+  require 'tk'
+
+  TkButton.new(:text=>'b1: p self', :command=>proc{p self}).pack(:fill=>:x)
+  sleep s
+  TkButton.new(:text=>'b2: p $SAFE', :command=>proc{p $SAFE}).pack(:fill=>:x)
+  sleep s
+  TkButton.new(:text=>'b3: p MultiTkIp.ip_name', 
+	       :command=>proc{p MultiTkIp.ip_name}).pack(:fill=>:x)
+  sleep s
+  TkButton.new(:text=>'EXIT', :command=>proc{exit}).pack(:fill=>:x)
+
+  Tk.mainloop
+}
+
+Thread.new{ip1.eval_proc(cmd, 1.1)}
+Thread.new{ip2.eval_proc(cmd, 0.3)}
+cmd.call(0.7)
+
+th.join
diff --git a/ext/tk/tkutil.c b/ext/tk/tkutil.c
index c0dc48e59b..56f018b85f 100644
--- a/ext/tk/tkutil.c
+++ b/ext/tk/tkutil.c
@@ -31,6 +31,7 @@ static ID ID_path;
 static ID ID_at_path;
 static ID ID_to_eval;
 static ID ID_to_s;
+static ID ID_source;
 static ID ID_downcase;
 static ID ID_install_cmd;
 static ID ID_merge_tklist;
@@ -681,6 +682,9 @@ get_eval_string_core(obj, enc_flag, self)
     case T_NIL:
 	return rb_str_new2("");
 
+    case T_REGEXP:
+	return rb_funcall(obj, ID_source, 0, 0);
+
     default:
 	if (rb_obj_is_kind_of(obj, cTkObject)) {
 	    /* return rb_str_new3(rb_funcall(obj, ID_path, 0, 0)); */
@@ -1252,6 +1256,7 @@ Init_tkutil()
     ID_at_path = rb_intern("@path");
     ID_to_eval = rb_intern("to_eval");
     ID_to_s = rb_intern("to_s");
+    ID_source = rb_intern("source");
     ID_downcase = rb_intern("downcase");
     ID_install_cmd = rb_intern("install_cmd");
     ID_merge_tklist = rb_intern("_merge_tklist");