* ext/tcltklib/tcltklib.c: fix typo [ruby-talk:111266]

* ext/tk/lib/tk/text.rb: fix typo
* ext/tk/lib/multi-tk.rb: improve safe-level treatment on slave IPs


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

ChangeLog

@@ -1,3 +1,11 @@
+Fri Sep  3 02:12:48 2004  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tcltklib/tcltklib.c: fix typo [ruby-talk:111266]
+
+	* ext/tk/lib/tk/text.rb: fix typo
+
+	* ext/tk/lib/multi-tk.rb: improve safe-level treatment on slave IPs
+
 Fri Sep  3 01:54:20 2004  Nobuyoshi Nakada  <nobu@ruby-lang.org>
 
 	* ext/extmk.rb (extmake): extact target prefix from Makefiles.

ext/tcltklib/README.1st

@@ -5,10 +5,10 @@ Tcl/Tk libraries or header files are installed but are not found, you can
 give the information by arguments of the 'configure' script. Please give 
 some or all of the following options. 
 
- --with-tcllib=<libname>    (e.g. libtcl8.3.so ==> --with-tcllib=tcl8.3)
+ --with-tcllib=<libname>       (e.g. libtcl8.4.so ==> --with-tcllib=tcl8.4)
- --with-tklib=<libname>     (e.g. libtk8.3.so  ==> --with-tklib=tk8.3)
+ --with-tklib=<libname>        (e.g. libtk8.4.so  ==> --with-tklib=tk8.4)
 
- --enable-tcltk_stubs       (if you force to enable stubs)
+ --enable-tcltk_stubs          (if you force to enable stubs)
 
  --with-tcl-dir=<path> 
       equal to "--with-tcl-include=<path>/include --with-tcl-lib=<path>/lib"
@@ -16,18 +16,20 @@ some or all of the following options.
  --with-tk-dir=<path> 
       equal to "--with-tk-include=<path>/include --with-tk-lib=<path>/lib"
 
- --with-tcl-include=<dir>   the directry containts 'tcl.h'
+ --with-tcl-include=<dir>      the directry containts 'tcl.h'
- --with-tk-include=<dir>    the directry containts 'tk.h'
+ --with-tk-include=<dir>       the directry containts 'tk.h'
 
- --with-tcl-lib=<dir>       the directry containts 'libtcl<version>.so'
+ --with-tcl-lib=<dir>          the directry containts 'libtcl<version>.so'
- --with-tk-lib=<dir>        the directry containts 'libtk<version>.so'
+ --with-tk-lib=<dir>           the directry containts 'libtk<version>.so'
+
+ --enable-mac-tcltk-framework  (Mac OSX only) use Tcl/Tk framework
 
 If you forgot to give the options when do 'configure' on toplevel
 directry of Ruby sources, please try something like as the followings.
 
  $ cd ext/tcltklib
  $ rm Makefile
- $ CONFIGURE_ARGS='--with-tcl-include=/usr/local/include/tcl8.3/ --with-tcllib=tcl8.3 --with-tklib=tk8.3 --enable-tcltk_stubs' ruby extconf.rb
+ $ CONFIGURE_ARGS='--with-tcl-include=/usr/local/include/tcl8.4/ --with-tcllib=tcl8.4 --with-tklib=tk8.4' ruby extconf.rb
 
 
  *** ATTENTION ***

ext/tcltklib/README.ActiveTcl

@@ -19,8 +19,8 @@ For example, when you install ActiveTcl-8.4.x to '/usr/local/ActiveTcl',
 
    configure --with-tcl-dir=/usr/local/ActiveTcl/  \
              --with-tk-dir=/usr/local/ActiveTcl/   \
-             --with-tcllib=tcl8.4                  \
+             --with-tcllib=tclstub8.4              \
-             --with-tklib=tk8.4                    \
+             --with-tklib=tkstub8.4                \
              --enable-tcltk-stubs
 
 It depends on your environment that you have to add the directory of 

ext/tcltklib/tcltklib.c

@@ -4139,7 +4139,7 @@ invoke_queue_handler(evPtr, flags)
     if (rb_safe_level() != q->safe_level) {
 	volatile VALUE q_dat;
 	q_dat = Data_Wrap_Struct(rb_cData,invoke_queue_mark,0,q);
-	ret = rb_funcall(rb_proc_new(evq_safelevel_handler, q_dat), 
+	ret = rb_funcall(rb_proc_new(ivq_safelevel_handler, q_dat), 
 			 ID_call, 0);
     } else {
 	DUMP2("call invoke_real (for caller thread:%lx)", q->thread);

ext/tk/lib/multi-tk.rb

@@ -112,18 +112,32 @@ class MultiTkIp
   ######################################
 
   def set_safe_level(safe)
+    @safe_level[0] = safe
     @cmd_queue.enq([@system, 'set_safe_level', safe])
     self
   end
+  def safe_level=(safe)
+    set_safe_level(safe)
+  end
   def self.set_safe_level(safe)
     __getip.set_safe_level(safe)
     self
   end
+  def self.safe_level=(safe)
+    self.set_safe_level(safe)
+  end
+  def safe_level
+    @safe_level[0]
+  end
+  def self.safe_level
+    __getip.safe_level
+  end
+
+  def _create_receiver_and_watchdog(lvl = $SAFE)
+    lvl = $SAFE if lvl < $SAFE
 
-  def _create_receiver_and_watchdog()
     # command-procedures receiver
-    receiver = Thread.new{
+    receiver = Thread.new(lvl){|safe_level|
-      safe_level = $SAFE
       loop do
 	thread, cmd, *args = @cmd_queue.deq
 	if thread == @system
@@ -143,17 +157,88 @@ class MultiTkIp
 	  # procedure
 	  begin
 	    ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
-	  rescue SystemExit
+	  rescue SystemExit => e
 	    # delete IP
 	    unless @interp.deleted?
-	      # if @interp._invoke('info', 'command', '.') != ""
+	      @slave_ip_tbl.each_value{|subip|
-	      #   @interp._invoke('destroy', '.')
+		unless subip.deleted?
-	      # end
+		  begin
-	      # @interp.delete
+		    subip._invoke('destroy', '.') 
-	      @interp._eval_without_enc('exit')
+		  rescue Exception
+		  end
+		  subip.delete
+		  # subip._invoke('exit') 
+		  # subip._eval_without_enc('exit') 
+		end
+	      }
+	      begin
+		@interp._invoke('destroy', '.')
+	      rescue Exception
+	      end
+	      if safe?
+		# do 'exit' to call the delete_hook procedure
+		@interp._eval_without_enc('exit')
+	      else
+		@interp.delete
+	      end
+	    end
+	    if e.backtrace[0] =~ /\`exit'/
+	      _check_and_return(thread, MultiTkIp_OK.new(true))
+	    elsif e.backtrace[0] =~ /\`(exit!|abort)'/
+	      _check_and_return(thread, MultiTkIp_OK.new(false))
+	    else
+	      _check_and_return(thread, MultiTkIp_OK.new(nil))
 	    end
-	    _check_and_return(thread, MultiTkIp_OK.new(nil))
 	    break
+	  rescue SecurityError => e
+	    # ignore security error in 'exit', 'exit!', and 'abort'
+	    if e.backtrace[0] =~ /\`exit'/
+	      unless @interp.deleted?
+		@slave_ip_tbl.each_value{|subip|
+		  unless subip.deleted?
+		    begin
+		      subip._invoke('destroy', '.') 
+		    rescue Exception
+		    end
+		    subip.delete 
+		    # subip._invoke('exit') 
+		    # subip._eval_without_enc('exit') 
+		  end
+		}
+		begin
+		  @interp._invoke('destroy', '.')
+		rescue Exception
+		end
+		# @interp.delete
+		@interp._eval_without_enc('exit')
+	      end
+	      _check_and_return(thread, MultiTkIp_OK.new(true))
+	      break
+	    elsif e.backtrace[0] =~ /\`(exit!|abort)'/
+	      unless @interp.deleted?
+		@slave_ip_tbl.each_value{|subip|
+		  unless subip.deleted?
+		    begin
+		      subip._invoke('destroy', '.') 
+		    rescue Exception
+		    end
+		    subip.delete 
+		    # subip._invoke('exit') 
+		    # subip._eval_without_enc('exit') 
+		  end
+		}
+		begin
+		  @interp._invoke('destroy', '.')
+		rescue Exception
+		end
+		# @interp.delete
+		@interp._eval_without_enc('exit')
+	      end
+	      _check_and_return(thread, MultiTkIp_OK.new(false))
+	      break
+	    else
+	      _check_and_return(thread, e)
+	    end
 	  rescue Exception => e
 	    # raise exception
 	    _check_and_return(thread, e)
@@ -230,9 +315,11 @@ class MultiTkIp
 
     @threadgroup  = Thread.current.group
 
+    @safe_level = [$SAFE]
+
     @cmd_queue = Queue.new
 
-    @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog()
+    @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0])
 
     @threadgroup.add @cmd_receiver
     @threadgroup.add @receiver_watchdog
@@ -535,17 +622,37 @@ class MultiTkIp
 
     name, safe, safe_opts, tk_opts = _parse_slaveopts(keys)
 
+    safe = 4 if safe && !safe.kind_of?(Fixnum)
+
     if safeip == nil
       # create master-ip
       @interp = TclTkIp.new(name, _keys2opts(tk_opts))
       @ip_name = nil
+      if safe
+	safe = $SAFE if safe < $SAFE
+	@safe_level = [safe]
+      else
+	@safe_level = [$SAFE]
+      end
     else
       # create slave-ip
       if safeip || master.safe?
 	@interp, @ip_name = master.__create_safe_slave_obj(safe_opts, 
 							   name, tk_opts)
+	if safe
+	  safe = master.safe_level if safe < master.safe_level
+	  @safe_level = [safe]
+	else
+	  @safe_level = [4]
+	end
       else
 	@interp, @ip_name = master.__create_trusted_slave_obj(name, tk_opts)
+	if safe
+	  safe = master.safe_level if safe < master.safe_level
+	  @safe_level = [safe]
+	else
+	  @safe_level = [master.safe_level]
+	end
       end
       @set_alias_proc = proc{|name| 
 	master._invoke('interp', 'alias', @ip_name, name, '', name)
@@ -558,7 +665,7 @@ class MultiTkIp
 
     @cmd_queue = Queue.new
 
-    @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog()
+    @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog(@safe_level[0])
 
     @threadgroup.add @cmd_receiver
     @threadgroup.add @receiver_watchdog
@@ -634,24 +741,25 @@ class << MultiTkIp
   alias __new new
   private :__new
 
-  def new_master(keys={}, &b)
+
+  def new_master(keys={})
     ip = __new(__getip, nil, keys)
-    ip.eval_proc(&b) if b
+    ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given?
     ip
   end
 
   alias new new_master
 
-  def new_slave(keys={}, &b)
+  def new_slave(keys={})
     ip = __new(__getip, false, keys)
-    ip.eval_proc(&b) if b
+    ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given?
     ip
   end
   alias new_trusted_slave new_slave
 
-  def new_safe_slave(keys={},&b)
+  def new_safe_slave(keys={})
     ip = __new(__getip, true, keys)
-    ip.eval_proc(&b) if b
+    ip.eval_proc(proc{$SAFE=ip.safe_level; Proc.new}.call) if block_given?
     ip
   end
   alias new_safeTk new_safe_slave
@@ -857,12 +965,15 @@ class MultiTkIp
     if cmd.kind_of?(String)
       xcmd  = cmd
       xargs = args
-      cmd = proc{ TkComm._get_eval_string(eval(xcmd, *xargs)) }
+      cmd = proc{ 
+	$SAFE=@safe_level[0]
+	TkComm._get_eval_string(eval(xcmd, *xargs))
+      }
       args = []
     end
 
     # check
-    unless cmd.kind_of?(Proc)
+    unless cmd.kind_of?(Proc) || cmd.kind_of?(Method)
       raise RuntimeError, "A Proc object is expected for the 'cmd' argument"
     end
 
@@ -919,11 +1030,11 @@ class MultiTkIp
   end
   private :eval_proc_core
 
-  def eval_callback(cmd = Proc.new, *args)
+  def eval_callback(cmd = proc{$SAFE=@safe_level[0]; Proc.new}.call, *args)
     eval_proc_core(false, cmd, *args)
   end
 
-  def eval_proc(cmd = Proc.new, *args)
+  def eval_proc(cmd = proc{$SAFE=@safe_level[0]; Proc.new}.call, *args)
     eval_proc_core(true, cmd, *args)
   end
   alias call eval_proc
@@ -931,7 +1042,7 @@ class MultiTkIp
 end
 class << MultiTkIp
   # class method
-  def eval_proc(cmd = Proc.new, *args)
+  def eval_proc(cmd = proc{$SAFE=__getip.safe_level; Proc.new}.call, *args)
     # class ==> interp object
     __getip.eval_proc(cmd, *args)
   end
@@ -994,6 +1105,10 @@ class << MultiTkIp
     __getip.safe?
   end
 
+  def exit(st = 0)
+    __getip.exit(st)
+  end
+
   def restart(app_name = nil, keys = {})
     init_ip_internal
 
@@ -1187,17 +1302,36 @@ class MultiTkIp
   end
 
   def delete
+    @slave_ip_tbl.each_value{|subip|
+      unless subip.deleted?
+	begin
+	  subip._invoke('destroy', '.') 
+	rescue Exception
+	end
+	subip.delete 
+	#subip._invoke('exit') 
+      end
+    }
     if safe?
       # do 'exit' to call the delete_hook procedure
       @interp._eval_without_enc('exit')
     end
-    @interp.delete
+    @interp.delete unless @interp.deleted?
   end
 
   def deleted?
     @interp.deleted?
   end
 
+  def exit(st = 0)
+    if master?
+      Kernel.exit(st)
+    else
+      delete
+      st
+    end
+  end
+
   def restart(app_name = nil, keys = {})
     _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS)
 

ext/tk/lib/tk/optiondb.rb

@@ -17,15 +17,15 @@ module TkOptionDB
   end
 
   def add(pat, value, pri=None)
-    if $SAFE >= 4
+    # if $SAFE >= 4
-      fail SecurityError, "can't call 'TkOptionDB.add' at $SAFE >= 4"
+    #   fail SecurityError, "can't call 'TkOptionDB.add' at $SAFE >= 4"
-    end
+    # end
     tk_call('option', 'add', pat, value, pri)
   end
   def clear
-    if $SAFE >= 4
+    # if $SAFE >= 4
-      fail SecurityError, "can't call 'TkOptionDB.crear' at $SAFE >= 4"
+    #   fail SecurityError, "can't call 'TkOptionDB.crear' at $SAFE >= 4"
-    end
+    # end
     tk_call_without_enc('option', 'clear')
   end
   def get(win, name, klass)

ext/tk/lib/tk/text.rb

@@ -722,7 +722,7 @@ class TkText<TkTextWin
 
   def tag_remove(tag, *indices)
     tk_send_without_enc('tag', 'remove', _get_eval_enc_str(tag), 
-			*(indces.collect{|idx| _get_eval_enc_str(idx)}))
+			*(indices.collect{|idx| _get_eval_enc_str(idx)}))
     self
   end
 

ext/tk/sample/tkoptdb-safeTk.rb

@@ -26,10 +26,29 @@ else
 						File.dirname(__FILE__)))
 end
 file = File.expand_path('tkoptdb.rb', File.dirname(__FILE__))
-MultiTkIp.new_safeTk{
+
-  ent.each{|pat, val| TkOptionDB.add(pat, val)}
+ip = MultiTkIp.new_safeTk{
+  # When a block is given to 'new_safeTk' method, 
+  # the block is evaluated on $SAFE==4.
+  ent.each{|pat, val| Tk.tk_call('option', 'add', pat, val)}
+}
+
+=begin
+ip.eval_proc{
+  # When a block is given to 'eval_proc' method, 
+  # the block is evaluated on the IP's current safe level.
+  # So, the followings raises exceptions. 
   load file
 }
+=end
+
+ip.eval_proc(proc{
+  # When a Procedure object is given to 'eval_proc' method as an argument, 
+  # the proc is evaluated on the proc's binding.
+  # So, the followings are evaluated on $SAFE==0
+  load file
+})
+
 # Tk.mainloop is ignored on the slave-IP
 
 Tk.mainloop