From 83185f9ff097beb2946a5abf41c2b180db152f17 Mon Sep 17 00:00:00 2001 From: nagai Date: Wed, 29 Sep 2004 15:54:32 +0000 Subject: [PATCH] * 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 --- ChangeLog | 11 +++++++ ext/tcltklib/tcltklib.c | 9 +++++- ext/tk/MANIFEST | 1 + ext/tk/lib/multi-tk.rb | 52 ++++++++++++++++++++++++++---- ext/tk/lib/tk/text.rb | 34 +++++++++++++++++-- ext/tk/lib/tkextlib/SUPPORT_STATUS | 2 ++ ext/tk/sample/multi-ip_sample2.rb | 29 +++++++++++++++++ ext/tk/tkutil.c | 5 +++ 8 files changed, 133 insertions(+), 10 deletions(-) create mode 100644 ext/tk/sample/multi-ip_sample2.rb diff --git a/ChangeLog b/ChangeLog index c1e361671c..905c7fc040 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +Thu Sep 30 00:50:44 2004 Hidetoshi NAGAI + + * 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 + Wed Sep 29 10:58:07 2004 Nobuyoshi Nakada * enum.c (sort_by_i): internally used object must not be changed 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] [] # If 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] [] # If 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");