* tcltklib.c (lib_mainloop_core): fixed signal-trap bug

* multi-tk.rb, tk.rb, tkafter.rb, tkcanvas.rb, tkfont.rb, tktext.rb,
  tkvirtevent.rb : Ruby/Tk works at $SAFE == 4


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

16 files changed, 223 insertions, 79 deletions

diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc
index f04d036c64..8a7143892c 100644
--- a/ext/tcltklib/MANUAL.euc
+++ b/ext/tcltklib/MANUAL.euc
@@ -192,13 +192,16 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : ( �ƻ륹��åɤ�����������˥��٥�ȥ롼�פ�¹Ԥ��� )��
          : �����ΰ�̣�� mainloop ��Ʊ���Ǥ��롥
 
-      do_one_event(flag = TclTkLib::EventFlag::ALL)
+      do_one_event(flag = TclTkLib::EventFlag::ALL | 
+                            TclTkLib::EventFlag::DONT_WAIT)
          : �����Ԥ��Υ��٥�� 1 �Ĥ�¹Ԥ��롥
          : ���٥�Ȥ������������ true ���֤���
          : �ե饰�� DONT_WAIT ����ꤷ�Ƥ��ʤ���硤�ե饰�ǽ�����
          : �ݤȤʤäƤ������Υ��٥�Ȥ�ȯ������ޤ��Ԥ�³���롥
          : DONT_WAIT ����ꤷ�Ƥ�����硤�����оݥ��٥�Ȥ��ʤ��Ƥ�
          : �����˽�λ�� false ���֤���
+         : $SAFE >= 4 ����$SAFE >= 1 ���� flag ����������Ƥ���ʤ��
+         : flag �ˤ� DONT_WAIT ������Ū���դ����롥
 
       set_eventloop_tick(timer_tick)
          : ���٥�ȥ롼�פ�Ʊ�����̥���åɤ���Ư���Ƥ�����ˡ���
@@ -213,6 +216,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : �ꤵ��롥
          : �ܺ٤�������ά����������� CPU �ѥ�����󤷤Ĥİ�����
          : ���ꤷ��ư���¸����뤿��˼����������ͤǤ��롥
+         : $SAFE >= 4 �Ǥϼ¹Ԥ��ػߤ���롥
 
       get_eventloop_tick
          : timer_tick �θ����ͤ��֤���
@@ -222,6 +226,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : ��¸�ߤ��ʤ��ä��ݤ� sleep ���֤��������Ĺ����ꤹ�롥
          : ��Ư����åɤ����٥�ȥ롼�פ����ξ��ˤϰ�̣��ʤ��ʤ���
          : �ǥե���Ȥ��ͤ� 20 (ms)
+         : $SAFE >= 4 �Ǥϼ¹Ԥ��ػߤ���롥
 
       get_no_event_wait
          : no_event_wait �θ����ͤ��֤���
@@ -239,6 +244,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : ������ȯ�����ʤ��ޤޤ� 80 ��ν����Ԥ����٥�ȸ�������λ
 	 : ����Ȥ��ǥ�����Ȥ� 800 �ʾ�ˤʤ�ȥ���åɥ����å���
          : ��ȯ�����뤳�Ȥˤʤ롥
+         : $SAFE >= 4 �Ǥϼ¹Ԥ��ػߤ���롥
 
       get_eventloop_weight
          : ���ߤ� loop_max �� no_event_tick �Ȥ��ͤ��֤���
@@ -258,6 +264,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : ¾�Υ��󥿡��ץ꥿�ν�����³���Բ�ǽ�ˤʤ뤳�Ȥ����롥����
          : �褦�ʾ��Ǥ⥨�顼��̵�뤷�ƥ��٥�ȥ롼�פ���Ư��³����
          : ���Ȥǡ�¾�Υ��󥿡��ץ꥿�������ư�³���뤳�Ȥ��Ǥ��롥
+         : $SAFE >= 4 �Ǥϼ¹Ԥ��ػߤ���롥
 
       mainloop_abort_on_exception
          : Tk ���󥿡��ץ꥿����㳰��ȯ�������ݤˡ����٥�ȥ롼�פ�
@@ -295,6 +302,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : ���Ȥ����Τ� false ����ꤷ�Ƥ����Ȥ��Ƥ⡤�ƤȤʤ륤�󥿡�
          : �ץ꥿�� safe ���󥿡��ץ꥿�Ǥ���С��������������Ѥ��� 
          : safe ���󥿡��ץ꥿�Ȥ�����������롥
+         : $SAFE >= 4 �Ǥϡ�safe ���󥿡��ץ꥿�ʳ����������ػߤ���롥
 
       make_safe
          : Tcl/Tk ���󥿡��ץ꥿�� safe ���󥿡��ץ꥿���ѹ����롥
@@ -319,6 +327,7 @@ require "tcltklib" �����, �ʲ��Υ⥸�塼��, ���饹�����Ѳ�ǽ�Ǥ�.
          : Tcl/Tk ���󥿡��ץ꥿�� Tk ��ʬ�ν�������Ƶ�ư��Ԥ���
          : ��ö root widget ���˲�������˺��� Tk �ε�ǽ��ɬ�פ�
          : �ʤä������Ѥ��롥
+         : $SAFE >= 4 �Ǥϼ¹Ԥ��ػߤ���롥
 
       _eval(str)
       _invoke(*args)
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index ef91fcae3d..fdc4b00305 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -154,6 +154,8 @@ set_eventloop_tick(self, tick)
 {
     int ttick = NUM2INT(tick);
 
+    rb_secure(4);
+
     if (ttick < 0) {
 	rb_raise(rb_eArgError, 
 		 "timer-tick parameter must be 0 or positive number");
@@ -209,6 +211,8 @@ set_no_event_wait(self, wait)
 {
     int t_wait = NUM2INT(wait);
 
+    rb_secure(4);
+
     if (t_wait <= 0) {
 	rb_raise(rb_eArgError, 
 		 "no_event_wait parameter must be positive number");
@@ -256,6 +260,8 @@ set_eventloop_weight(self, loop_max, no_event)
     int lpmax = NUM2INT(loop_max);
     int no_ev = NUM2INT(no_event);
 
+    rb_secure(4);
+
     if (lpmax <= 0 || no_ev <= 0) {
 	rb_raise(rb_eArgError, "weight parameters must be positive numbers");
     }
@@ -336,6 +342,7 @@ ip_evloop_abort_on_exc_set(self, val)
 {
     struct tcltkip *ptr = get_ip(self);
 
+    rb_secure(4);
     if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
 	/* slave IP */
 	return lib_evloop_abort_on_exc(self);
@@ -392,6 +399,8 @@ lib_mainloop_core(check_root_widget)
 	    if (run_timer_flag) {
 		DUMP1("timer interrupt");
 		run_timer_flag = 0;
+		DUMP1("call rb_trap_exec()");
+		rb_trap_exec();
 		DUMP1("check Root Widget");
 		if (check && Tk_GetNumMainWindows() == 0) {
 		    return Qnil;
@@ -619,15 +628,18 @@ lib_do_one_event_core(argc, argv, self, is_ip)
 {
     VALUE vflags;
     int flags;
-    int ret;
 
     if (rb_scan_args(argc, argv, "01", &vflags) == 0) {
-	flags = TCL_ALL_EVENTS;
+	flags = TCL_ALL_EVENTS | TCL_DONT_WAIT;
     } else {
 	Check_Type(vflags, T_FIXNUM);
 	flags = FIX2INT(vflags);
     }
-    
+
+    if (rb_safe_level() >= 4 || (rb_safe_level() >=1 && OBJ_TAINTED(vflags))) {
+      flags |= TCL_DONT_WAIT;
+    }
+
     if (is_ip) {
 	/* check IP */
 	struct tcltkip *ptr = get_ip(self);
@@ -637,8 +649,7 @@ lib_do_one_event_core(argc, argv, self, is_ip)
 	}
     }
 
-    ret = Tcl_DoOneEvent(flags);
-    if (ret) {
+    if (Tcl_DoOneEvent(flags)) {
 	return Qtrue;
     } else {
 	return Qfalse;
@@ -681,6 +692,8 @@ lib_restart(self)
 {
     struct tcltkip *ptr = get_ip(self);
 
+    rb_secure(4);
+
     /* destroy the root wdiget */
     ptr->return_value = Tcl_Eval(ptr->ip, "destroy .");
     /* ignore ERROR */
@@ -715,6 +728,7 @@ ip_restart(self)
 {
     struct tcltkip *ptr = get_ip(self);
 
+    rb_secure(4);
     if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) {
 	/* slave IP */
 	return Qnil;
@@ -912,6 +926,7 @@ ip_create_slave(argc, argv, self)
 	safe = 1;
     } else if (safemode == Qfalse || safemode == Qnil) {
 	safe = 0;
+	rb_secure(4);
     } else {
 	safe = 1;
     }
@@ -961,7 +976,7 @@ ip_delete(self)
     VALUE self;
 {
     struct tcltkip *ptr = get_ip(self);
-    
+
     Tcl_DeleteInterp(ptr->ip);
 
     return Qnil;
@@ -1131,7 +1146,6 @@ ip_invoke_real(argc, argv, obj)
 
     /* ip is deleted? */
     if (Tcl_InterpDeleted(ptr->ip)) {
-	Tcl_ResetResult(ptr->ip);
 	return rb_tainted_str_new2("");
     }
 
@@ -1139,7 +1153,7 @@ ip_invoke_real(argc, argv, obj)
     if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
 	/* if (event_loop_abort_on_exc || cmd[0] != '.') { */
 	if (event_loop_abort_on_exc > 0) {
-	    /*rb_ip_raise(obj, rb_eNameError, "invalid command name `%s'", cmd);*/
+	    /*rb_ip_raise(obj,rb_eNameError,"invalid command name `%s'",cmd);*/
 	    return create_ip_exc(obj, rb_eNameError, 
 				 "invalid command name `%s'", cmd);
 	} else {
@@ -1349,11 +1363,11 @@ ip_invoke(argc, argv, obj)
 
     /* get result & free allocated memory */
     result = *alloc_result;
-    if (rb_obj_is_kind_of(result, rb_eException)) {
-      rb_exc_raise(result);
-    }
     free(alloc_argv);
     free(alloc_result);
+    if (rb_obj_is_kind_of(result, rb_eException)) {
+	rb_exc_raise(result);
+    }
 
     return result;
 }
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index 12ed7aceff..7053dddef9 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -35,16 +35,16 @@ MultiTkIp_OK.freeze
 ################################################
 # methods for construction
 class MultiTkIp
-  SLAVE_IP_ID = ['slave'.freeze, '0'].freeze
+  SLAVE_IP_ID = ['slave'.freeze, '0'.taint].freeze
 
-  @@IP_TABLE = {}
+  @@IP_TABLE = {}.taint
 
-  @@INIT_IP_ENV  = [] # table of Procs
-  @@ADD_TK_PROCS = [] # table of [name, args, body]
+  @@INIT_IP_ENV  = [].taint # table of Procs
+  @@ADD_TK_PROCS = [].taint # table of [name, args, body]
 
-  @@TK_TABLE_LIST = []
+  @@TK_TABLE_LIST = [].taint
 
-  @@TK_CMD_TBL = {}
+  @@TK_CMD_TBL = {}.taint
 
   ######################################
 
@@ -64,7 +64,7 @@ class MultiTkIp
       rescue Exception
       end
     end
-  }
+  }.freeze
 
   ######################################
 
@@ -200,13 +200,13 @@ class MultiTkIp
 
   @@DEFAULT_MASTER = self.allocate
   @@DEFAULT_MASTER.instance_eval{
-    @encoding = []
+    @encoding = [].taint
 
-    @tk_windows = {}
+    @tk_windows = {}.taint
 
-    @tk_table_list = []
+    @tk_table_list = [].taint
 
-    @slave_ip_tbl = {}
+    @slave_ip_tbl = {}.taint
 
     unless keys.kind_of? Hash
       fail ArgumentError, "expecting a Hash object for the 2nd argument"
@@ -266,6 +266,7 @@ class MultiTkIp
     'nested'.freeze, 
     'deleteHook'.freeze
   ].freeze
+
   def _parse_slaveopts(keys)
     name = nil
     safe = false
@@ -462,18 +463,24 @@ class MultiTkIp
       fail SecurityError, "slave-ip cannot create master-ip"
     end
 
+    if safeip == nil && $SAFE >= 4
+      fail SecurityError, "cannot create master-ip at level #{$SAFE}"
+    end
+
     unless keys.kind_of? Hash
       fail ArgumentError, "expecting a Hash object for the 2nd argument"
     end
 
     @encoding = []
-
     @tk_windows = {}
-
     @tk_table_list = []
-
     @slave_ip_tbl = {}
 
+    @encoding.taint unless @encoding.tainted?
+    @tk_windows.taint unless @tk_windows.tainted?
+    @tk_table_list.taint unless @tk_table_list.tainted?
+    @slave_ip_tbl.taint unless @slave_ip_tbl.tainted?
+
     name, safe, safe_opts, tk_opts = _parse_slaveopts(keys)
 
     if safeip == nil
@@ -508,7 +515,10 @@ class MultiTkIp
 
     @@IP_TABLE[@threadgroup] = self
     _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS)
-    @@TK_TABLE_LIST.size.times{ @tk_table_list << {} }
+    @@TK_TABLE_LIST.size.times{ 
+      (tbl = {}).tainted? || tbl.taint
+      @tk_table_list << tbl
+    }
 
     self.freeze  # defend against modification
   end
@@ -661,7 +671,10 @@ class MultiTkIp
   end
 
   def _add_new_tables
-    (@@TK_TABLE_LIST.size - @tk_table_list.size).times{ @tk_table_list << {} }
+    (@@TK_TABLE_LIST.size - @tk_table_list.size).times{ 
+      (tbl = {}).tainted? || tbl.taint
+      @tk_table_list << tbl
+    }
   end
 
   def _init_ip_env(script)
@@ -701,9 +714,9 @@ class MultiTkIp
     __getip._tk_table_list[id]
   end
   def self.create_table
-    if __getip.slave?
-      raise SecurityError, "slave-IP has no permission creating a new table"
-    end
+    #if __getip.slave?
+    #  raise SecurityError, "slave-IP has no permission creating a new table"
+    #end
     id = @@TK_TABLE_LIST.size
     obj = Object.new
     @@TK_TABLE_LIST << obj
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index 6bd2736fe4..3dd3b3edb7 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -8,7 +8,7 @@ require "tcltklib"
 require "tkutil"
 
 module TkComm
-  WidgetClassNames = {}
+  WidgetClassNames = {}.taint
 
   None = Object.new
   def None.to_s
@@ -18,7 +18,7 @@ module TkComm
 
   #Tk_CMDTBL = {}
   #Tk_WINDOWS = {}
-  Tk_IDs = ["00000", "00000"].freeze	# [0]-cmdid, [1]-winid
+  Tk_IDs = ["00000".taint, "00000".taint].freeze  # [0]-cmdid, [1]-winid
 
   # for backward compatibility
   Tk_CMDTBL = Object.new
@@ -33,7 +33,7 @@ module TkComm
   Tk_WINDOWS.freeze
 
   self.instance_eval{
-    @cmdtbl = []
+    @cmdtbl = [].taint
   }
 
   def error_at
@@ -332,6 +332,7 @@ module TkComm
     #Tk_CMDTBL[id] = cmd
     TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
     @cmdtbl = [] unless defined? @cmdtbl
+    @cmdtbl.taint unless @cmdtbl.tainted?
     @cmdtbl.push id
     return format("rb_out %s", id);
   end
@@ -679,13 +680,13 @@ module TkCore
     end
 
     INTERP.instance_eval{
-      @tk_cmd_tbl = {}
-      @tk_windows = {}
+      @tk_cmd_tbl = {}.taint
+      @tk_windows = {}.taint
 
-      @tk_table_list = []
+      @tk_table_list = [].taint
 
-      @init_ip_env  = [] # table of Procs
-      @add_tk_procs = [] # table of [name, args, body]
+      @init_ip_env  = [].taint  # table of Procs
+      @add_tk_procs = [].taint  # table of [name, args, body]
 
       @cb_entry_class = Class.new{|c|
 	def initialize(ip, cmd)
@@ -711,7 +712,8 @@ module TkCore
     end
     def INTERP.create_table
       id = @tk_table_list.size
-      @tk_table_list << {}
+      (tbl = {}).tainted? || tbl.taint
+      @tk_table_list << tbl
       obj = Object.new
       obj.instance_eval <<-EOD
         def self.method_missing(m, *args)
@@ -1636,7 +1638,7 @@ class TkBindTag
 
   #BTagID_TBL = {}
   BTagID_TBL = TkCore::INTERP.create_table
-  Tk_BINDTAG_ID = ["btag".freeze, "00000"].freeze
+  Tk_BINDTAG_ID = ["btag".freeze, "00000".taint].freeze
 
   TkCore::INTERP.init_ip_env{ BTagID_TBL.clear }
 
@@ -1713,7 +1715,7 @@ class TkVariable
   #TkVar_ID_TBL = {}
   TkVar_CB_TBL = TkCore::INTERP.create_table
   TkVar_ID_TBL = TkCore::INTERP.create_table
-  Tk_VARIABLE_ID = ["v".freeze, "00000"].freeze
+  Tk_VARIABLE_ID = ["v".freeze, "00000".taint].freeze
 
   TkCore::INTERP.add_tk_procs('rb_var', 'args', 
 	"ruby [format \"TkVariable.callback %%Q!%s!\" $args]")
@@ -3004,20 +3006,76 @@ module TkOptionDB
   end
 
   def add(pat, value, pri=None)
+    if $SAFE >= 4
+      fail SecurityError, "can't call 'TkOptionDB.add' at $SAFE >= 4"
+    end
     tk_call 'option', 'add', pat, value, pri
   end
   def clear
+    if $SAFE >= 4
+      fail SecurityError, "can't call 'TkOptionDB.crear' at $SAFE >= 4"
+    end
     tk_call 'option', 'clear'
   end
   def get(win, name, klass)
-    tk_call('option', 'get', win ,name, klass).taint
+    tk_call('option', 'get', win ,name, klass)
   end
   def readfile(file, pri=None)
     tk_call 'option', 'readfile', file, pri
   end
   module_function :add, :clear, :get, :readfile
+
+  def read_entries(file, f_enc=nil)
+    if TkCore::INTERP.safe?
+      fail SecurityError, 
+	"can't call 'TkOptionDB.read_entries' on a safe interpreter"
+    end
+
+    i_enc = Tk.encoding()
+
+    unless f_enc
+      f_enc = i_enc
+    end
+
+    ent = []
+    cline = ''
+    open(file, 'r') {|f|
+      while line = f.gets
+	cline += line.chomp!
+	case cline
+	when /\\$/    # continue
+	  cline.chop!
+	  next
+	when /^!/     # coment
+	  cline = ''
+	  next
+	when /^([^:]+):\s(.*)$/
+	  pat = $1
+	  val = $2
+	  p "ResourceDB: #{[pat, val].inspect}" if $DEBUG
+	  pat = TkCore::INTERP._toUTF8(pat, f_enc)
+	  pat = TkCore::INTERP._fromUTF8(pat, i_enc)
+	  val = TkCore::INTERP._toUTF8(val, f_enc)
+	  val = TkCore::INTERP._fromUTF8(val, i_enc)
+	  ent << [pat, val]
+	  cline = ''
+	else          # unknown --> ignore
+	  cline = ''
+	  next
+	end
+      end
+    }
+    ent
+  end
+  module_function :read_entries
       
   def read_with_encoding(file, f_enc=nil, pri=None)
+    # try to read the file as an OptionDB file
+    readfile(file, pri).each{|pat, val|
+      add(pat, val, pri)
+    }
+
+=begin
     i_enc = Tk.encoding()
 
     unless f_enc
@@ -3051,6 +3109,7 @@ module TkOptionDB
 	end
       end
     }
+=end
   end
   module_function :read_with_encoding
 
@@ -4101,7 +4160,10 @@ class TkWindow<TkObject
       TkCore::INTERP.tk_windows.delete(path)
     }
 
-    tk_call 'destroy', epath
+    begin
+      tk_call 'destroy', epath
+    rescue
+    end
     uninstall_win
   end
 
diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb
index 0572106771..239db4b5c9 100644
--- a/ext/tk/lib/tkafter.rb
+++ b/ext/tk/lib/tkafter.rb
@@ -11,8 +11,8 @@ class TkTimer
 
   TkCommandNames = ['after'.freeze].freeze
 
-  Tk_CBID = ['a'.freeze, '00000'].freeze
-  Tk_CBTBL = {}
+  Tk_CBID = ['a'.freeze, '00000'.taint].freeze
+  Tk_CBTBL = {}.taint
 
   TkCore::INTERP.add_tk_procs('rb_after', 'id', <<-'EOL')
     if {[set st [catch {ruby [format "TkTimer.callback %%Q!%s!" $id]} ret]] != 0} {
diff --git a/ext/tk/lib/tkcanvas.rb b/ext/tk/lib/tkcanvas.rb
index 024211aa1d..687f521655 100644
--- a/ext/tk/lib/tkcanvas.rb
+++ b/ext/tk/lib/tkcanvas.rb
@@ -557,7 +557,7 @@ class TkcTag<TkObject
   include TkcTagAccess
 
   CTagID_TBL = TkCore::INTERP.create_table
-  Tk_CanvasTag_ID = ['ctag'.freeze, '00000'].freeze
+  Tk_CanvasTag_ID = ['ctag'.freeze, '00000'.taint].freeze
 
   TkCore::INTERP.init_ip_env{ CTagID_TBL.clear }
 
@@ -688,7 +688,7 @@ class TkcTagCurrent<TkcTag
 end
 
 class TkcGroup<TkcTag
-  Tk_cGroup_ID = ['tkcg'.freeze, '00000'].freeze
+  Tk_cGroup_ID = ['tkcg'.freeze, '00000'.taint].freeze
   def create_self(parent, *args)
     if not parent.kind_of?(TkCanvas)
       fail format("%s need to be TkCanvas", parent.inspect)
@@ -851,7 +851,7 @@ class TkImage<TkObject
   TkCommandNames = ['image'.freeze].freeze
 
   Tk_IMGTBL = TkCore::INTERP.create_table
-  Tk_Image_ID = ['i'.freeze, '00000'].freeze
+  Tk_Image_ID = ['i'.freeze, '00000'.taint].freeze
 
   TkCore::INTERP.init_ip_env{ Tk_IMGTBL.clear }
 
diff --git a/ext/tk/lib/tkfont.rb b/ext/tk/lib/tkfont.rb
index be925dce7a..ff7bbc74e4 100644
--- a/ext/tk/lib/tkfont.rb
+++ b/ext/tk/lib/tkfont.rb
@@ -11,7 +11,7 @@ class TkFont
 
   TkCommandNames = ['font'.freeze].freeze
 
-  Tk_FontID = ["@font".freeze, "00000"].freeze
+  Tk_FontID = ["@font".freeze, "00000".taint].freeze
   Tk_FontNameTBL = TkCore::INTERP.create_table
   Tk_FontUseTBL  = TkCore::INTERP.create_table
 
diff --git a/ext/tk/lib/tktext.rb b/ext/tk/lib/tktext.rb
index cf4fc68ddc..109afad924 100644
--- a/ext/tk/lib/tktext.rb
+++ b/ext/tk/lib/tktext.rb
@@ -807,7 +807,7 @@ class TkTextTag<TkObject
   include TkTreatTagFont
 
   TTagID_TBL = TkCore::INTERP.create_table
-  Tk_TextTag_ID = ['tag'.freeze, '00000'].freeze
+  Tk_TextTag_ID = ['tag'.freeze, '00000'.taint].freeze
 
   TkCore::INTERP.init_ip_env{ TTagID_TBL.clear }
 
@@ -1023,7 +1023,7 @@ end
 
 class TkTextMark<TkObject
   TMarkID_TBL = TkCore::INTERP.create_table
-  Tk_TextMark_ID = ['mark'.freeze, '00000'].freeze
+  Tk_TextMark_ID = ['mark'.freeze, '00000'.taint].freeze
 
   TkCore::INTERP.init_ip_env{ TMarkID_TBL.clear }
 
diff --git a/ext/tk/lib/tkvirtevent.rb b/ext/tk/lib/tkvirtevent.rb
index 49c236f7f0..ccd3448434 100644
--- a/ext/tk/lib/tkvirtevent.rb
+++ b/ext/tk/lib/tkvirtevent.rb
@@ -9,7 +9,7 @@ class TkVirtualEvent<TkObject
 
   TkCommandNames = ['event'.freeze].freeze
 
-  TkVirtualEventID = ["<VirtEvent".freeze, "00000", ">".freeze].freeze
+  TkVirtualEventID = ["<VirtEvent".freeze, "00000".taint, ">".freeze].freeze
   TkVirtualEventTBL = TkCore::INTERP.create_table
 
   TkCore::INTERP.init_ip_env{ TkVirtualEventTBL.clear }
diff --git a/ext/tk/sample/resource.en b/ext/tk/sample/resource.en
index bfdc809278..39b4013971 100644
--- a/ext/tk/sample/resource.en
+++ b/ext/tk/sample/resource.en
@@ -8,5 +8,6 @@
 *hello.text: HELLO
 *quit.text: QUIT
 *BTN_CMD.show_msg: {|arg| print "($SAFE=#{$SAFE}) ";\
-                          print "Hello!! This is a sample of #{arg}.\n"}
-*BTN_CMD.bye_msg:  {print "($SAFE=#{$SAFE}) Good-bye��\n"}
+                          print "Hello!! This is a sample of #{arg}.";\
+                          print "(<<< $SAFE=#{$SAFE})\n"}
+*BTN_CMD.bye_msg:  {print "($SAFE=#{$SAFE} >>>) Good-bye��(<<< $SAFE=#{$SAFE})\n"}
diff --git a/ext/tk/sample/resource.ja b/ext/tk/sample/resource.ja
index 8b715f36b0..a61390f95d 100644
--- a/ext/tk/sample/resource.ja
+++ b/ext/tk/sample/resource.ja
@@ -7,6 +7,7 @@
 *BtnFrame.Button.foreground: red
 *hello.text: ����ˤ���
 *quit.text: ��λ
-*BTN_CMD.show_msg: {|arg| print "($SAFE=#{$SAFE}) ";\
-                          print "����ˤ��ϡ��� #{arg} �Υ���ץ�Ǥ���\n"}
-*BTN_CMD.bye_msg:  {print "($SAFE=#{$SAFE}) ���褦�ʤ顥\n"}
+*BTN_CMD.show_msg: {|arg| print "($SAFE=#{$SAFE} >>>) ";\
+                          print "����ˤ��ϡ��� #{arg} �Υ���ץ�Ǥ���";\
+                          print "(<<< $SAFE=#{$SAFE})\n"}
+*BTN_CMD.bye_msg:  {print "($SAFE=#{$SAFE} >>>) ���褦�ʤ顥(<<< $SAFE=#{$SAFE})\n"}
diff --git a/ext/tk/sample/safe-tk.rb b/ext/tk/sample/safe-tk.rb
index 8be13a32d0..0a25c804f0 100644
--- a/ext/tk/sample/safe-tk.rb
+++ b/ext/tk/sample/safe-tk.rb
@@ -86,6 +86,13 @@ TkTimer.new(2000, -1, proc{p ['safe1', safe_slave1.deleted?]}).start
 TkTimer.new(2000, -1, proc{p ['safe2', safe_slave2.deleted?]}).start
 TkTimer.new(2000, -1, proc{p ['trusted', trusted_slave.deleted?]}).start
 
+TkTimer.new(7000, 1, 
+	    proc{
+	      safe_slave1.eval_proc{Tk.root.destroy}
+	      safe_slave1.delete
+	      print "*** The safe_slave1 is deleted by the timer.\n"
+	    }).start
+
 TkTimer.new(10000, 1, 
 	    proc{
 	      trusted_slave.eval_proc{Tk.root.destroy}
diff --git a/ext/tk/sample/tkhello.rb b/ext/tk/sample/tkhello.rb
index 5188fe1c8c..ab236963e8 100644
--- a/ext/tk/sample/tkhello.rb
+++ b/ext/tk/sample/tkhello.rb
@@ -5,6 +5,6 @@ TkButton.new(nil,
 	     'command' => proc{print "hello\n"}).pack('fill'=>'x')
 TkButton.new(nil,
 	     'text' => 'quit',
-	     'command' => 'exit').pack('fill'=>'x')
+	     'command' => proc{exit}).pack('fill'=>'x')
 
 Tk.mainloop
diff --git a/ext/tk/sample/tkmenubutton.rb b/ext/tk/sample/tkmenubutton.rb
index 02a903ebb8..1c7f51000b 100644
--- a/ext/tk/sample/tkmenubutton.rb
+++ b/ext/tk/sample/tkmenubutton.rb
@@ -113,7 +113,6 @@ TkFrame.new{|f|
   }
 }
 
-
 ############################
 TkFrame.new(:borderwidth=>2, :relief=>:sunken, 
 	    :height=>5).pack(:side=>:top, :fill=>:x, :padx=>20)
diff --git a/ext/tk/sample/tkoptdb-safeTk.rb b/ext/tk/sample/tkoptdb-safeTk.rb
index 169cd3c171..a5e394b230 100644
--- a/ext/tk/sample/tkoptdb-safeTk.rb
+++ b/ext/tk/sample/tkoptdb-safeTk.rb
@@ -5,6 +5,9 @@ require 'multi-tk'
 TkMessage.new(:text => <<EOM).pack
 This is a sample of the safe-Tk slave interpreter. \
 On the slave interpreter, 'tkoptdb.rb' demo is running. 
+( Attention:: a safe-Tk interpreter can't read options \
+from a file. Options are given by the master interpreter \
+in this script. )
 The window shown this message is a root widget of \
 the default master interpreter. The other window \
 is a toplevel widget of the master interpreter, and it \
@@ -12,7 +15,21 @@ has a container frame of the safe-Tk slave interpreter. \
 You can delete the slave by the button on the toplevel widget.
 EOM
 
+if ENV['LANG'] =~ /^ja/
+  # read Japanese resource
+  ent = TkOptionDB.read_entries(File.expand_path('resource.ja', 
+						 File.dirname(__FILE__)),
+				'euc-jp')
+else
+  # read English resource
+  ent = TkOptionDB.read_entries(File.expand_path('resource.en', 
+						File.dirname(__FILE__)))
+end
 file = File.expand_path('tkoptdb.rb', File.dirname(__FILE__))
-MultiTkIp.new_safeTk{load file}
+MultiTkIp.new_safeTk{
+  ent.each{|pat, val| TkOptionDB.add(pat, val)}
+  load file
+}
+# Tk.mainloop is ignored on the slave-IP
 
-# mainloop is started on 'tkoptdb.rb'
+Tk.mainloop
diff --git a/ext/tk/sample/tkoptdb.rb b/ext/tk/sample/tkoptdb.rb
index 6cb3d17993..ab8515ac16 100644
--- a/ext/tk/sample/tkoptdb.rb
+++ b/ext/tk/sample/tkoptdb.rb
@@ -8,26 +8,29 @@
 #
 require "tk"
 
-if ENV['LANG'] =~ /^ja/
-  # read Japanese resource
-  TkOptionDB.read_with_encoding(File.expand_path('resource.ja', 
-						 File.dirname(__FILE__)), 
-				'euc-jp')
-else
-  # read English resource
-  TkOptionDB.readfile(File.expand_path('resource.en', File.dirname(__FILE__)))
+if __FILE__ == $0 || !TkCore::INTERP.safe?
+  if ENV['LANG'] =~ /^ja/
+    # read Japanese resource
+    TkOptionDB.read_with_encoding(File.expand_path('resource.ja', 
+						   File.dirname(__FILE__)), 
+				  'euc-jp')
+  else
+    # read English resource
+    TkOptionDB.readfile(File.expand_path('resource.en', 
+					 File.dirname(__FILE__)))
+  end
 end
 
 # 'show_msg' and 'bye_msg' procedures can be defined on BTN_CMD resource.
 # Those procedures are called under $SAFE==2
-cmd = TkOptionDB.new_proc_class(:BTN_CMD, [:show_msg, :bye_msg], 2) {
+cmd = TkOptionDB.new_proc_class(:BTN_CMD, [:show_msg, :bye_msg], 3) {
   # If you want to check resource string (str), 
   # please define __check_proc_string__(str) like this.
   class << self
     def __check_proc_string__(str)
-      print "($SAFE=#{$SAFE}) check!! str.tainted?::#{str.tainted?}"
+      print "($SAFE=#{$SAFE} >>>) check!! str.tainted?::#{str.tainted?}"
       str.untaint
-      print "==>#{str.tainted?} : "
+      print "==>#{str.tainted?} (<<< $SAFE=#{$SAFE}): "
       str
     end
   end
@@ -38,12 +41,18 @@ TkFrame.new(:class=>'BtnFrame'){|f|
   pack(:padx=>5, :pady=>5)
   TkButton.new(:parent=>f, :widgetname=>'hello'){ 
     command proc{
-      print "($SAFE=#{$SAFE}) : "
+      print "($SAFE=#{$SAFE} >>>) : "
       cmd.show_msg(TkOptionDB.inspect)
+      print "(<<< $SAFE=#{$SAFE})"
     } 
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }
-  TkButton.new(:command=>proc{print "($SAFE=#{$SAFE}) : "; cmd.bye_msg; exit}, 
+  TkButton.new(:command=>proc{
+		 print "($SAFE=#{$SAFE} >>>) : "
+		 cmd.bye_msg
+		 print "(<<< $SAFE=#{$SAFE} ) : "
+		 exit
+	       }, 
 	       :parent=>f, :widgetname=>'quit'){
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }
@@ -54,12 +63,18 @@ BtnFrame.new{|f|
   pack(:padx=>5, :pady=>5)
   TkButton.new(:parent=>f, :widgetname=>'hello'){ 
     command proc{
-      print "($SAFE=#{$SAFE}) : "
+      print "($SAFE=#{$SAFE} >>>) : "
       cmd.show_msg(TkOptionDB.inspect)
+      print "(<<< $SAFE=#{$SAFE})"
     } 
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }
-  TkButton.new(:command=>proc{print "($SAFE=#{$SAFE}) : "; cmd.bye_msg; exit}, 
+  TkButton.new(:command=>proc{
+		 print "($SAFE=#{$SAFE} >>>) : "
+		 cmd.bye_msg
+		 print "(<<< $SAFE=#{$SAFE})"
+		 exit
+	       }, 
 	       :parent=>f, :widgetname=>'quit'){
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }
@@ -70,12 +85,18 @@ TkFrame.new(:class=>'BtnFrame2'){|f|
   pack(:padx=>5, :pady=>5)
   TkButton.new(:parent=>f, :widgetname=>'hello'){ 
     command proc{
-      print "($SAFE=#{$SAFE}) : "
+      print "($SAFE=#{$SAFE} >>>) : "
       cmd.show_msg(TkOptionDB.inspect)
+      print "(<<< $SAFE=#{$SAFE})"
     } 
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }
-  TkButton.new(:command=>proc{print "($SAFE=#{$SAFE}) : "; cmd.bye_msg; exit}, 
+  TkButton.new(:command=>proc{
+		 print "($SAFE=#{$SAFE} >>>) : "
+		 cmd.bye_msg
+		 print "(<<< $SAFE=#{$SAFE})"
+		 exit
+	       }, 
 	       :parent=>f, :widgetname=>'quit'){
     pack(:fill=>:x, :padx=>10, :pady=>10)
   }