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

ChangeLog

@@ -1,3 +1,29 @@
+Wed Oct 15 00:20:15 2003  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tcltklib/tcltklib.c: replace Tcl/Tk's vwait and tkwait to
+	  switch on threads smoothly and avoid seg-fault.
+
+	* ext/tcltklib/tcltklib.c: add TclTkIp._thread_vwait and
+	  _thread_tkwait for waiting on a thread. (Because Tcl/Tk's vwait
+	  and tkwait command wait on an 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).
+
+	* ext/tk/lib/tk.rb: 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.
+
+	* ext/tk/lib/tk.rb: improve of accessing Tcl/Tk's special variables.
+
+	* ext/tk/lib/tkafter.rb: support 'wait on a thread' and 'wait on
+	  an eventloop'.
+
 Wed Oct 15 00:10:24 2003  NAKAMURA, Hiroshi  <nahi@ruby-lang.org>
 
 	* lib/soap/baseData.rb: Introduce SOAPType as the common ancestor of

ext/tcltklib/MANUAL.euc

@@ -1,5 +1,5 @@
 (tof)
-                                    2003/08/07  Hidetoshi NAGAI
+                                    2003/10/12  Hidetoshi NAGAI
 
 本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
 が含まれていますが，その記述内容は古いものとなっています．
@@ -348,6 +348,27 @@ require "tcltklib"
       _fromUTF8(str, encoding)
          : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
 
+      _thread_vwait(var_name)
+      _thread_tkwait(mode, target)
+         : スレッド対応の vwait あるいは tkwait 相当のメソッド．
+         : 通常の vwait あるいは tkwait コマンドと異なるのは，イベン
+         : トループとは異なるスレッドから呼び出した場合に vwait 等の
+         : スタックとは独立に条件の成立待ちがなされることである．
+         : 通常の vwait / tkwait では，vwait / tkwait (1) の待ちの途
+         : 中でさらに vwait / tkwait (2) が呼ばれた場合，待ちの対象
+         : となっている条件の成立順序がどうあれ，(2)->(1) の順で待ち
+         : を終了して戻ってくる．
+         : _thread_vwait / _thread_tkwait は，イベントループのスレッ
+         : ドで呼ばれた場合は通常の vwait / tkwait と同様に動作する
+         : が，イベントループ以外のスレッドで呼ばれた場合にはそのス
+         : レッドを停止させて待ちに入り，条件が成立した時にスレッド
+         : の実行を再開する．「vwait 等の待ちスタックとは独立」とい
+         : う意味は，この再開のタイミングが他のスレッドでの待ち状況
+         : とは無関係ということである．つまり，イベントループ等の他
+         : のスレッドで vwait 等で待ちの状態にあったとしてもその完了
+         : を待つことなく，自らの待ち条件が成立次第，処理を継続する
+         : ことになる．
+
       _return_value
          : 直前の Tcl/Tk 上での評価の実行結果としての戻り値を返す．
 

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

ext/tk/lib/tk.rb

@@ -1089,36 +1089,73 @@ 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
-
-  PLATFORM = Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', 
-						      'tcl_platform'))]
-  PLATFORM.each{|k, v| k.freeze; v.freeze}
-  PLATFORM.freeze
-
-  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
-    end
-  }
-  TK_PREV.freeze
-
   JAPANIZED_TK = (INTERP._invoke("info", "commands", "kanji") != "").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
+
+    else
+      raise NameError, 'uninitialized constant Tk::' + sym.id2name
+    end
+  end
+
+
   def root
     TkRoot.new
   end
@@ -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
+  def wait(on_thread = false, check_root = false)
-    INTERP._eval("tkwait variable #{@id}")
+    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
+  def wait_visibility(on_thread = true)
-    tk_call 'tkwait', 'visibility', path
+    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
+  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
+  def wait_destroy(on_thread = true)
-    tk_call 'tkwait', 'window', epath
+    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

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