ext/tcltklib/tcltklib.c:

 * replace Tcl/Tk's vwait and tkwait to switch on threads smoothly and
   avoid seg-fault.
 * add TclTkIp._thread_vwait and _thread_tkwait for waiting on a thread.
   ( Because Tcl/Tk's vwait and tkwait command wait on a eventloop. )
ext/tk/lib/multi-tk.rb:
 * support TclTkIp._thread_vwait and _thread_tkwait
ext/tk/lib/tk.rb:
 * now, TkVariable#wait has 2 arguments.
   If 1st argument is true, waits on a thread. If false, waits on an eventloop.
   If 2nd argument is true, checks existence of rootwidgets. If false, doesn't.
   Default is wait(true, false).
 * add TkVariable#tkwait(arg) which is equal to TkVariable#wait(arg, true)
 * wait_visibility and wait_destroy have an argument for waiting on a
   thread or an eventloop.
 * improve of accessing Tcl/Tk's special variables
ext/tk/lib/tkafter.rb:
 * support 'wait on a thread' and 'wait on an eventloop'


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

3 files changed, 187 insertions, 31 deletions

diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index 750a2b79d9..288b5be443 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -306,7 +306,8 @@ class MultiTkIp
     # check 'display'
     if !new_keys.key?('display')
       begin
-	new_keys['display'] = @interp._eval('winfo screen .')
+	#new_keys['display'] = @interp._invoke('winfo screen .')
+	new_keys['display'] = @interp._invoke('winfo', 'screen', '.')
       rescue
 	if ENV[DISPLAY]
 	  new_keys['display'] = ENV[DISPLAY]
@@ -323,7 +324,8 @@ class MultiTkIp
       case new_keys['use']
       when TkWindow
 	new_keys['use'] = TkWinfo.id(new_keys['use'])
-	assoc_display = @interp._eval('winfo screen .')
+	#assoc_display = @interp._eval('winfo screen .')
+	assoc_display = @interp._invoke('winfo', 'screen', '.')
       when /^\..*/
 	new_keys['use'] = @interp._invoke('winfo', 'id', new_keys['use'])
 	assoc_display = @interp._invoke('winfo', 'screen', new_keys['use'])
@@ -925,6 +927,14 @@ class << MultiTkIp
     __getip._fromUTF8(str, encoding)
   end
 
+  def _thread_vwait(var)
+    __getip._thread_vwait(var)
+  end
+
+  def _thread_tkwait(mode, target)
+    __getip._thread_tkwait(mode, target)
+  end
+
   def _return_value
     __getip._return_value
   end
@@ -1039,6 +1049,14 @@ class MultiTkIp
     @interp._fromUTF8(str, encoding)
   end
 
+  def _thread_vwait(var)
+    @interp._thread_vwait(var)
+  end
+
+  def _thread_tkwait(mode, target)
+    @interp._thread_tkwait(mode, target)
+  end
+
   def _return_value
     @interp._return_value
   end
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index 3dd3b3edb7..47148e43ce 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1089,35 +1089,72 @@ module Tk
   extend Tk
 
   TCL_VERSION = INTERP._invoke("info", "tclversion").freeze
-  TK_VERSION  = INTERP._invoke("set", "tk_version").freeze
-
   TCL_PATCHLEVEL = INTERP._invoke("info", "patchlevel").freeze
+
+  TK_VERSION  = INTERP._invoke("set", "tk_version").freeze
   TK_PATCHLEVEL  = INTERP._invoke("set", "tk_patchLevel").freeze
 
-  TCL_LIBRARY = INTERP._invoke("set", "tcl_library").freeze
-  TK_LIBRARY  = INTERP._invoke("set", "tk_library").freeze
-  LIBRARY     = INTERP._invoke("info", "library").freeze
+  JAPANIZED_TK = (INTERP._invoke("info", "commands", "kanji") != "").freeze
 
-  PLATFORM = Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 
-						      'tcl_platform'))]
-  PLATFORM.each{|k, v| k.freeze; v.freeze}
-  PLATFORM.freeze
+  def Tk.const_missing(sym)
+    case(sym)
+    when :TCL_LIBRARY
+      INTERP._invoke("set", "tcl_library").freeze
+
+    when :TK_LIBRARY
+      INTERP._invoke("set", "tk_library").freeze
+
+    when :LIBRARY
+      INTERP._invoke("info", "library").freeze
+
+    #when :PKG_PATH, :PACKAGE_PATH, :TCL_PACKAGE_PATH
+    #  tk_split_simplelist(INTERP._invoke('set', 'tcl_pkgPath'))
+
+    #when :LIB_PATH, :LIBRARY_PATH, :TCL_LIBRARY_PATH
+    #  tk_split_simplelist(INTERP._invoke('set', 'tcl_libPath'))
+
+    when :PLATFORM, :TCL_PLATFORM
+      Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 
+					       'tcl_platform'))]
+
+    when :ENV
+      Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 'env'))]
+
+    #when :AUTO_PATH   #<=== 
+    #  tk_split_simplelist(INTERP._invoke('set', 'auto_path'))
+
+    #when :AUTO_OLDPATH
+    #  tk_split_simplelist(INTERP._invoke('set', 'auto_oldpath'))
+
+    when :AUTO_INDEX
+      Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 'auto_index'))]
+
+    when :PRIV, :PRIVATE, :TK_PRIV
+      priv = {}
+      if INTERP._invoke('info', 'vars', 'tk::Priv') != ""
+	var_nam = 'tk::Priv'
+      else
+	var_nam = 'tkPriv'
+      end
+      Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 
+					       var_nam))].each{|k,v|
+	k.freeze
+	case v
+	when /^-?\d+$/
+	  priv[k] = v.to_i
+	when /^-?\d+\.?\d*(e[-+]?\d+)?$/
+	  priv[k] = v.to_f
+	else
+	  priv[k] = v.freeze
+	end
+      }
+      priv
 
-  TK_PREV = {}
-  Hash[*tk_split_simplelist(INTERP._invoke('array','get','tkPriv'))].each{|k,v|
-    k.freeze
-    case v
-    when /^-?\d+$/
-      TK_PREV[k] = v.to_i
-    when /^-?\d+\.?\d*(e[-+]?\d+)?$/
-      TK_PREV[k] = v.to_f
     else
-      TK_PREV[k] = v.freeze
+      raise NameError, 'uninitialized constant Tk::' + sym.id2name
     end
-  }
-  TK_PREV.freeze
+  end
 
-  JAPANIZED_TK = (INTERP._invoke("info", "commands", "kanji") != "").freeze
 
   def root
     TkRoot.new
@@ -1709,7 +1746,8 @@ class TkVariable
 
   include Comparable
 
-  TkCommandNames = ['tkwait'.freeze].freeze
+  #TkCommandNames = ['tkwait'.freeze].freeze
+  TkCommandNames = ['vwait'.freeze].freeze
 
   #TkVar_CB_TBL = {}
   #TkVar_ID_TBL = {}
@@ -1768,8 +1806,38 @@ class TkVariable
     end
   end
 
-  def wait
-    INTERP._eval("tkwait variable #{@id}")
+  def wait(on_thread = false, check_root = false)
+    if $SAFE >= 4
+      fail SecurityError, "can't wait variable at $SAFE >= 4"
+    end
+    if on_thread
+      if check_root
+	INTERP._thread_tkwait('variable', @id)
+      else
+	INTERP._thread_vwait(@id)
+      end
+    else 
+      if check_root
+	INTERP._invoke('tkwait', 'variable', @id)
+      else
+	INTERP._invoke('vwait', @id)
+      end
+    end
+  end
+  def eventloop_wait(check_root = false)
+    wait(false, check_root)
+  end
+  def thread_wait(check_root = false)
+    wait(true, check_root)
+  end
+  def tkwait(on_thread = true)
+    wait(on_thread, true)
+  end
+  def eventloop_tkwait
+    wait(false, true)
+  end
+  def thread_tkwait
+    wait(true, true)
   end
 
   def id
@@ -2178,8 +2246,13 @@ module Tk
     end
   end
   AUTO_PATH = TkVarAccess.new('auto_path', auto_path)
+  AUTO_OLDPATH = TkVarAccess.new('auto_oldpath', auto_path)
 
   TCL_PACKAGE_PATH = TkVarAccess.new('tcl_pkgPath')
+  PACKAGE_PATH = TCL_PACKAGE_PATH
+
+  TCL_LIBRARY_PATH = TkVarAccess.new('tcl_libPath')
+  LIBRARY_PATH = TCL_LIBRARY_PATH
 
   TCL_PRECISION = TkVarAccess.new('tcl_precision')
 end
@@ -4167,14 +4240,50 @@ class TkWindow<TkObject
     uninstall_win
   end
 
-  def wait_visibility
-    tk_call 'tkwait', 'visibility', path
+  def wait_visibility(on_thread = true)
+    if $SAFE >= 4
+      fail SecurityError, "can't wait visibility at $SAFE >= 4"
+    end
+    if on_thread
+      INTERP._thread_tkwait('visibility', path)
+    else
+      INTERP._invoke('tkwait', 'visibility', path)
+    end
+  end
+  def eventloop_wait_visibility
+    wait_visibility(false)
+  end
+  def thread_wait_visibility
+    wait_visibility(true)
   end
   alias wait wait_visibility
-
-  def wait_destroy
-    tk_call 'tkwait', 'window', epath
+  alias tkwait wait_visibility
+  alias eventloop_wait eventloop_wait_visibility
+  alias eventloop_tkwait eventloop_wait_visibility
+  alias eventloop_tkwait_visibility eventloop_wait_visibility
+  alias thread_wait thread_wait_visibility
+  alias thread_tkwait thread_wait_visibility
+  alias thread_tkwait_visibility thread_wait_visibility
+
+  def wait_destroy(on_thread = true)
+    if $SAFE >= 4
+      fail SecurityError, "can't wait destroy at $SAFE >= 4"
+    end
+    if on_thread
+      INTERP._thread_tkwait('window', epath)
+    else
+      INTERP._invoke('tkwait', 'window', epath)
+    end
+  end
+  def eventloop_wait_destroy
+    wait_destroy(false)
+  end
+  def thread_wait_destroy
+    wait_destroy(true)
   end
+  alias tkwait_destroy wait_destroy
+  alias eventloop_tkwait_destroy eventloop_wait_destroy
+  alias thread_tkwait_destroy thread_wait_destroy
 
   def bindtags(taglist=nil)
     if taglist
diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb
index 239db4b5c9..663b977ed2 100644
--- a/ext/tk/lib/tkafter.rb
+++ b/ext/tk/lib/tkafter.rb
@@ -82,6 +82,7 @@ class TkTimer
     if @running == false || @proc_max == 0 || @do_loop == 0
       Tk_CBTBL.delete(@id) ;# for GC
       @running = false
+      @wait_var.value = 0
       return
     end
     if @current_pos >= @proc_max
@@ -90,6 +91,7 @@ class TkTimer
       else
 	Tk_CBTBL.delete(@id) ;# for GC
 	@running = false
+	@wait_var.value = 0
 	return
       end
     end
@@ -114,6 +116,8 @@ class TkTimer
     @id = Tk_CBID.join
     Tk_CBID[1].succ!
 
+    @wait_var = TkVariable.new(0)
+
     # @cb_cmd = TkCore::INTERP.get_cb_entry(self.method(:do_callback))
     @cb_cmd = TkCore::INTERP.get_cb_entry(proc{
 					    begin
@@ -338,6 +342,7 @@ class TkTimer
 
   def cancel
     @running = false
+    @wait_var.value = 0
     tk_call 'after', 'cancel', @after_id if @after_id
     @after_id = nil
     Tk_CBTBL.delete(@id) ;# for GC
@@ -378,6 +383,30 @@ class TkTimer
       nil
     end
   end
+
+  def wait(on_thread = true, check_root = false)
+    if $SAFE >= 4
+      fail SecurityError, "can't wait timer at $SAFE >= 4"
+    end
+    return self unless @running
+    @wait_var.wait(on_thread, check_root)
+    self
+  end
+  def eventloop_wait(check_root = false)
+    wait(false, check_root)
+  end
+  def thread_wait(check_root = false)
+    wait(true, check_root)
+  end
+  def tkwait(on_thread = true)
+    wait(on_thread, true)
+  end
+  def eventloop_tkwait
+    wait(false, true)
+  end
+  def thread_tkwait
+    wait(true, true)
+  end
 end
 
 TkAfter = TkTimer