* 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

7 files changed, 72 insertions, 26 deletions

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)
   }