tcltklib.c : add TclTkIp#create_slave , TclTkIp#_make_safe and TclTkIp#safe?

MANUAL.euc : modify descriptions
tk.rb      : bug fix [ruby-talk:76980] and modify to support multi Tk IPs
tkafter.rb : modify to support multi Tk IPs


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

2 files changed, 76 insertions, 24 deletions

diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index e0c11c1c0d..b84b0a7c48 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1,4 +1,4 @@
-#
+
 #		tk.rb - Tk interface module using tcltklib
 #			$Date$
 #			by Yukihiro Matsumoto <matz@netlab.jp>
@@ -251,7 +251,8 @@ module TkComm
   def procedure(val)
     if val =~ /^rb_out (c\d+)/
       #Tk_CMDTBL[$1]
-      TkCore::INTERP.tk_cmd_tbl[$1]
+      #TkCore::INTERP.tk_cmd_tbl[$1]
+      TkCore::INTERP.tk_cmd_tbl[$1].cmd
     else
       #nil
       val
@@ -291,6 +292,7 @@ module TkComm
     return str
   end
   private :_get_eval_string
+  module_function :_get_eval_string
 
   def ruby2tcl(v)
     if v.kind_of?(Hash)
@@ -319,7 +321,7 @@ module TkComm
     return '' if cmd == ''
     id = _next_cmd_id
     #Tk_CMDTBL[id] = cmd
-    TkCore::INTERP.tk_cmd_tbl[id] = cmd
+    TkCore::INTERP.tk_cmd_tbl[id] = TkCore::INTERP.get_cb_entry(cmd)
     @cmdtbl = [] unless defined? @cmdtbl
     @cmdtbl.push id
     return format("rb_out %s", id);
@@ -656,8 +658,8 @@ module TkCore
 
     INTERP = TclTkIp.new(name, opts)
 
-    def INTERP.__ip_id
-      nil
+    def INTERP.__getip
+      self
     end
 
     INTERP.instance_eval{
@@ -667,8 +669,20 @@ module TkCore
       @tk_table_list = []
 
       @init_ip_env  = [] # table of Procs
-      @add_tk_procs = [] # table of [name, body]
+      @add_tk_procs = [] # table of [name, args, body]
+
+      @cb_entry_class = Class.new{|c|
+	def initialize(ip, cmd)
+	  @ip = ip
+	  @cmd = cmd
+	end
+	attr_reader :ip, :cmd
+	def call(*args)
+	  @ip.cb_eval(@cmd, *args)
+	end
+      }
     }
+
     def INTERP.tk_cmd_tbl
       @tk_cmd_tbl
     end
@@ -691,13 +705,20 @@ module TkCore
       return obj
     end
 
+    def INTERP.get_cb_entry(cmd)
+      @cb_entry_class.new(__getip, cmd).freeze
+    end
+    def INTERP.cb_eval(cmd, *args)
+      TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args))
+    end
+
     def INTERP.init_ip_env(script = Proc.new)
       @init_ip_env << script
       script.call(self)
     end
-    def INTERP.add_tk_procs(name, args, body)
+    def INTERP.add_tk_procs(name, args = nil, body = nil)
       @add_tk_procs << [name, args, body]
-      self._invoke('proc', name, args, body)
+      self._invoke('proc', name, args, body) if args && body
     end
     def INTERP.init_ip_internal
       ip = self
@@ -726,6 +747,20 @@ module TkCore
     fail TkCallbackContinue, "Tk callback returns 'continue' status"
   end
 
+  def TkCore.callback(arg)
+    # arg = tk_split_list(arg)
+    arg = tk_split_simplelist(arg)
+    #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
+    #_get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift], 
+    #  			     *arg))
+    cb_obj = TkCore::INTERP.tk_cmd_tbl[arg.shift]
+    cb_obj.call(*arg)
+  end
+
+  def load_cmd_on_ip(tk_cmd)
+    bool(tk_call('auto_load', tk_cmd))
+  end
+
   def after(ms, cmd=Proc.new)
     myid = _curr_cmd_id
     cmdid = install_cmd(cmd)
@@ -794,14 +829,6 @@ module TkCore
     tk_call('clock','seconds').to_i
   end
 
-  def TkCore.callback(arg)
-    # arg = tk_split_list(arg)
-    arg = tk_split_simplelist(arg)
-    #_get_eval_string(TkUtil.eval_cmd(Tk_CMDTBL[arg.shift], *arg))
-    _get_eval_string(TkUtil.eval_cmd(TkCore::INTERP.tk_cmd_tbl[arg.shift], 
-				     *arg))
-  end
-
   def windowingsystem
     tk_call('tk', 'windowingsystem')
   end
@@ -898,7 +925,7 @@ module TkCore
     TkCore::INTERP.init_ip_internal
 
     tk_call('set', 'argv0', app_name) if app_name
-    if keys.kind_of?(Hash) && keys.size > 0
+    if keys.kind_of?(Hash)
       # tk_call('set', 'argc', keys.size * 2)
       tk_call('set', 'argv', hash_kv(keys).join(' '))
     end
@@ -937,10 +964,6 @@ module TkCore
     tk_call 'tk_chooseColor', *hash_kv(keys)
   end
 
-  def chooseDirectory(keys = nil)
-    tk_call 'tk_chooseDirectory', *hash_kv(keys)
-  end
-
   def ip_eval(cmd_string)
     res = INTERP._eval(cmd_string)
     if  INTERP._return_value() != 0
@@ -1484,11 +1507,11 @@ if /^8\.[1-9]/ =~ Tk::TCL_VERSION && !Tk::JAPANIZED_TK
       TkCommandNames = ['encoding'.freeze].freeze
 
       def encoding=(name)
-	INTERP.encoding = name
+	TkCore::INTERP.encoding = name
       end
 
       def encoding
-	INTERP.encoding
+	TkCore::INTERP.encoding
       end
 
       def encoding_names
diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb
index 4401bce719..2ff60fe1e9 100644
--- a/ext/tk/lib/tkafter.rb
+++ b/ext/tk/lib/tkafter.rb
@@ -25,7 +25,8 @@ class TkTimer
     @after_id = nil
     ex_obj = Tk_CBTBL[obj_id]
     return nil if ex_obj == nil; # canceled
-    _get_eval_string(ex_obj.do_callback)
+    #_get_eval_string(ex_obj.do_callback)
+    ex_obj.cb_call
   end
 
   def self.info
@@ -103,6 +104,8 @@ class TkTimer
     @id = Tk_CBID.join
     Tk_CBID[1].succ!
 
+    @cb_cmd = TkCore::INTERP.get_cb_entry(self.method(:do_callback))
+
     @set_next = true
 
     @init_sleep = 0
@@ -142,6 +145,10 @@ class TkTimer
 
   attr_accessor :loop_exec
 
+  def cb_call
+    @cb_cmd.call
+  end
+
   def get_procs
     [@init_sleep, @init_proc, @init_args, @sleep_time, @loop_exec, @loop_proc]
   end
@@ -220,6 +227,28 @@ class TkTimer
     self
   end
 
+  def delete_procs(*procs)
+    procs.each{|e|
+      if e.kind_of? Proc
+	@loop_proc.delete([e])
+      else
+	@loop_proc.delete(e)
+      end
+    }
+    @proc_max = @loop_proc.size
+
+    cancel if @proc_max == 0
+
+    self
+  end
+
+  def delete_at(n)
+    @loop_proc.delete_at(n)
+    @proc_max = @loop_proc.size
+    cancel if @proc_max == 0
+    self
+  end
+
   def set_start_proc(sleep, init_proc, *init_args)
     if !sleep == 'idle' && !sleep.kind_of?(Integer)
       fail format("%s need to be Integer", sleep.inspect)