* ext/tcltklib/tcltklib.c: enforce thread-check and exception-handling to

avoid SEGV trouble.
  [KNOWN BUG] When supports pthread and running multiple Tk interpreters,
  an interrupt signal causes SEGV frequently. That may be a trouble of
  Ruby's signal handler.
* ext/tk/tkutil/tkutil.c; fix a bug on converting a SJIS string array
  to a Tcl's list string.
* ext/tk/tcltklib.c: wrap Tcl's original "namespace" command to
  protect from namespace crash.
* ext/tk/lib/multi-tk.rb: enforce exception-handling.
* ext/tk/lib/multi-tk.rb: catch IRB_EXIT to work on irb.
* ext/tk/lib/tk.rb: ditto.
* ext/tk/tcltklib.c: add TclTkLib.mainloop_thread?
* ext/tk/lib/multi-tk.rb: (bug fix) callback returns a value.
* ext/tk/lib/tk/canvas.rb (delete): bug fix when multiple arguments.
* ext/tk/lib/clock.rb: fix 'no method error'.
* ext/tk/lib/clock.rb (self.clicks): accept a Symbol argument.
* ext/tk/lib/variable.rb: be able to set default_value_type; :numeric,
  :bool, :string, :symbol, :list, :numlist or nil (default; same to
  :string). If set a type, TkVariable#value returns a value of the type.
* ext/tk/lib/tkextlib/tclx/tclx.rb: add Tk::TclX.signal to warn the
  risk of using TclX extension's 'signal' command.
* ext/tk/sample/irbtk.rb: irb with Ruby/Tk.
* ext/tk/sample/demos-*/anilabel.rb: bug fix on 'show code'
* ext/tk/sample/demos-*/aniwave.rb: new Ruby/Tk animation demo.
* ext/tk/sample/demos-*/pendulum.rb: ditto.
* ext/tk/sample/demos-*/goldberg.rb: ditto.
* ext/tk/sample/demos-*/widget: add entries of animation demos.


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

ChangeLog

@@ -1,3 +1,53 @@
+Wed Mar  2 16:00:02 2005  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tcltklib/tcltklib.c: enforce thread-check and exception-handling 
+	  to avoid SEGV trouble.
+	  [KNOWN BUG] When supports pthread and running multiple Tk
+	  interpreters, an interrupt signal causes SEGV frequently. That
+	  may be a trouble of Ruby's signal handler.
+
+	* ext/tk/tkutil/tkutil.c; fix a bug on converting a SJIS string array
+	  to a Tcl's list string. 
+
+	* ext/tk/tcltklib.c: wrap Tcl's original "namespace" command to
+	  protect from namespace crash.
+
+	* ext/tk/lib/multi-tk.rb: enforce exception-handling.
+
+	* ext/tk/lib/multi-tk.rb: catch IRB_EXIT to work on irb.
+
+	* ext/tk/lib/tk.rb: ditto.
+
+	* ext/tk/tcltklib.c: add TclTkLib.mainloop_thread?
+
+	* ext/tk/lib/multi-tk.rb: (bug fix) callback returns a value.
+
+	* ext/tk/lib/tk/canvas.rb (delete): bug fix when multiple arguments.
+
+	* ext/tk/lib/clock.rb: fix 'no method error'.
+
+	* ext/tk/lib/clock.rb (self.clicks): accept a Symbol argument.
+
+	* ext/tk/lib/variable.rb: be able to set default_value_type; :numeric,
+	  :bool, :string, :symbol, :list, :numlist or nil (default; same to 
+	  :string). If set a type, TkVariable#value returns a value of the
+	  type.
+
+	* ext/tk/lib/tkextlib/tclx/tclx.rb: add Tk::TclX.signal to warn the
+	  risk of using TclX extension's 'signal' command.
+
+	* ext/tk/sample/irbtk.rb: irb with Ruby/Tk.
+
+	* ext/tk/sample/demos-*/anilabel.rb: bug fix on 'show code'
+
+	* ext/tk/sample/demos-*/aniwave.rb: new Ruby/Tk animation demo.
+
+	* ext/tk/sample/demos-*/pendulum.rb: ditto.
+
+	* ext/tk/sample/demos-*/goldberg.rb: ditto.
+
+	* ext/tk/sample/demos-*/widget: add entries of animation demos.
+
 Tue Mar  1 00:47:43 2005  Masatoshi SEKI  <m_seki@mva.biglobe.ne.jp>
 
 	* test/rinda/test_rinda.rb: backport from CVS_HEAD. use 

ext/tcltklib/MANUAL.eng

@@ -132,6 +132,16 @@ module TclTklib
        : If 'check_root' is false, doen't return by the other
        : reasons than exceptions.
 
+    mainloop_thread?
+       : Returns whether the current thread executes the eventloop. 
+       : If true, the eventloop is working on the current thread. 
+       : If no eventloop is working, this method returns nil.
+       : And if the other thread executes the eventloop, returns false.
+       : 
+       :  *** ATTENTION ***
+       : When this methods returns false, it is dangerous to call a Tk 
+       : interpreter directly.
+
     mainloop_watchdog(check_root = true)
        : On the normal eventloop, some kinds of callback operations 
        : cause deadlock. To avoid some of such deadlocks, this

ext/tcltklib/MANUAL.euc

@@ -230,6 +230,15 @@ require "tcltklib"
          : WINDOW 以外のイベントは発生しうるため )．終了には，外部
          : からの働き掛け ( スレッドを活用するなど ) が必要．
 
+      mainloop_thread?
+         : カレントスレッドがイベントループを実行しているスレッド
+         : かどうかを返す．
+         : イベントループを実行しているスレッドであれば true を，
+         : どのスレッドでもイベントループが実行されていない場合は 
+         : nil を，他のスレッドでイベントループが実行されている場
+         : 合は false を返す．
+         : false の際に Tk インタープリタを直接呼ぶのは危険である．
+
       mainloop_watchdog(check_root = true)
          : 通常のイベントループでは，イベント処理の内容によっては
          : デッドロックを引き起こす可能性がある (例えばイベントに
@@ -377,7 +386,7 @@ require "tcltklib"
          : 失敗した場合は RuntimeError の例外を発生する．
 
       safe?
-         : Tcl/Tk インタープリタを safe インタープリタであるかを調べる．
+         : Tcl/Tk インタープリタが safe インタープリタであるかを調べる．
          : safe インタープリタであれば true を返す．
 
       allow_ruby_exit?

ext/tk/ChangeLog.tkextlib

@@ -1,3 +1,7 @@
+2005-02-20  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
+
+	* ext/tk/lib/tclx/tclx.rb: warning TclX's 'signal' command.
+
 2005-01-25  Hidetoshi NAGAI  <nagai@ai.kyutech.ac.jp>
 
 	* ext/tk/lib/tkextlib/blt/component.rb: bug fix. cannot accept

ext/tk/lib/multi-tk.rb

@@ -77,18 +77,23 @@ class MultiTkIp
       cmd.inspect
     end
     def call(*args)
-      begin
       unless @ip.deleted?
+        current = Thread.current
+        backup_ip = current['callback_ip']
+        current['callback_ip'] = @ip
+        begin
           @ip.cb_eval(@cmd, *args)
-         end
         rescue TkCallbackBreak, TkCallbackContinue => e
           fail e
         rescue Exception => e
           if @ip.safe?
-          # ignore
+            nil # ignore
           else
             fail e
           end
+        ensure
+          current['callback_ip'] = backup_ip
+        end
       end
     end
   }.freeze
@@ -105,19 +110,23 @@ class MultiTkIp
 
   def _check_and_return(thread, exception, wait=0)
     unless thread
-      unless exception.kind_of?(MultiTkIp_OK) || safe?
+      unless exception.kind_of?(MultiTkIp_OK)
         msg = "#{exception.class}: #{exception.message}"
-        begin
+
         if @interp.deleted?
-            warn('Warning: ' + msg)
+          warn("Warning (#{self}): " + msg)
-          elsif @interp._eval_without_enc('info command bgerror').size != 0
+          return nil
-            @interp._eval(@interp._merge_tklist('bgerror', msg))
-          else
-            warn('Warning: ' + msg)
         end
+
+        if safe?
+          warn("Warning (#{self}): " + msg) if $DEBUG
+          return nil
+        end
+
+        begin
+          @interp._eval_without_enc(@interp._merge_tklist('bgerror', msg))
         rescue Exception => e
-            warn('Warning: ' + msg)
+          warn("Warning (#{self}): " + msg)
-            warn('Warning: ' + e.message)
         end
       end
       return nil
@@ -230,8 +239,18 @@ class MultiTkIp
   def _receiver_eval_proc_core(safe_level, thread, cmd, *args)
     begin
       #ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
-      ret = cmd.call(safe_level, *args)
+      #ret = cmd.call(safe_level, *args)
-
+      normal_ret = false
+      ret = catch(:IRB_EXIT) do  # IRB hack
+        retval = cmd.call(safe_level, *args)
+        normal_ret = true
+        retval
+      end
+      unless normal_ret
+        # catch IRB_EXIT
+        exit(ret)
+      end
+      ret
     rescue SystemExit => e
       # delete IP
       unless @interp.deleted?
@@ -297,7 +316,8 @@ class MultiTkIp
         _check_and_return(thread, MultiTkIp_OK.new(nil))
       end
 
-      if master? && !safe? && allow_ruby_exit?
+      # if master? && !safe? && allow_ruby_exit?
+      if !@interp.deleted? && master? && !safe? && allow_ruby_exit?
 =begin
         ObjectSpace.each_object(TclTkIp){|obj|
           obj.delete unless obj.deleted?
@@ -380,6 +400,16 @@ class MultiTkIp
 
     rescue Exception => e
       # raise exception
+      begin
+        bt = _toUTF8(e.backtrace.join("\n"))
+        bt.instance_variable_set(:@encoding, 'utf-8')
+      rescue Exception
+        bt = e.backtrace.join("\n")
+      end
+      begin
+        @interp._set_global_var('errorInfo', bt)
+      rescue Exception
+      end
       _check_and_return(thread, e)
 
     else
@@ -411,7 +441,8 @@ class MultiTkIp
   def _receiver_mainloop(check_root)
     Thread.new{
       while !@interp.deleted?
-        break if @interp._invoke_without_enc('info', 'command', '.').size == 0
+        inf = @interp._invoke_without_enc('info', 'command', '.')
+        break if !inf.kind_of?(String) || inf != '.'
         sleep 0.5
       end
     }
@@ -742,8 +773,8 @@ class MultiTkIp
     # create toplevel widget
     begin
       top = TkToplevel.new(toplevel_keys)
-    rescue NameError
+    rescue NameError => e
-      fail unless @interp.safe?
+      fail e unless @interp.safe?
       fail SecurityError, "unable create toplevel on the safe interpreter"
     end
     msg = "Untrusted Ruby/Tk applet (#{slave_name})"
@@ -870,7 +901,11 @@ class MultiTkIp
       fail SecurityError, "cannot create a master-ip at level #{$SAFE}"
     end
 
-    if !master.master? && master.safe?
+    if master.deleted? && safeip == nil
+      fail RuntimeError, "cannot create a slave of a deleted interpreter"
+    end
+
+    if !master.deleted? && !master.master? && master.safe?
       fail SecurityError, "safe-slave-ip cannot create a new interpreter"
     end
 
@@ -964,15 +999,20 @@ class MultiTkIp
       undef :instance_eval
     end
 
+    # dummy call for initialization
+    self.eval_proc{ Tk.tk_call('set', 'tcl_patchLevel') }
+
     self.freeze  # defend against modification
   end
 
   ######################################
 
   def _default_delete_hook(slave)
-    if @slave_ip_top[slave].kind_of?(String)
+    @slave_ip_tbl.delete(slave)
+    top = @slave_ip_top.delete(slave)
+    if top.kind_of?(String)
       # call default hook of safetk.tcl (ignore exceptions)
-      if @slave_ip_top[slave] == ''
+      if top == ''
         begin
           @interp._eval("::safe::disallowTk #{slave}")
         rescue
@@ -980,20 +1020,19 @@ class MultiTkIp
         end
       else # toplevel path
         begin
-          @interp._eval("::safe::tkDelete {} #{@slave_ip_top[slave]} #{slave}")
+          @interp._eval("::safe::tkDelete {} #{top} #{slave}")
         rescue
           warn("Waring: fail to call '::safe::tkDelete'") if $DEBUG
           begin
-            @interp._eval("destroy #{@slave_ip_top[slave]}")
+            @interp._eval("destroy #{top}")
           rescue
             warn("Waring: fail to destroy toplevel") if $DEBUG
           end
         end
       end
     end
-    @slave_ip_tbl.delete(slave)
-    @slave_ip_top.delete(slave)
   end
+
 end
 
 
@@ -1007,10 +1046,14 @@ class MultiTkIp
   end
 
   def self.__getip
-    if Thread.current.group == ThreadGroup::Default
+    current = Thread.current
+    if TclTkLib.mainloop_thread? != false && current['callback_ip']
+      return current['callback_ip']
+    end
+    if current.group == ThreadGroup::Default
       @@DEFAULT_MASTER
     else
-      ip = @@IP_TABLE[Thread.current.group]
+      ip = @@IP_TABLE[current.group]
       unless ip
         fail SecurityError, 
           "cannot call Tk methods on #{Thread.current.inspect}"
@@ -1093,9 +1136,15 @@ class MultiTkIp
   def inspect
     s = self.to_s.chop!
     if master?
-      s << ':master'
+      if @interp.deleted?
+        s << ':deleted-master'
       else
-      if @interp.safe?
+        s << ':master'
+      end
+    else
+      if @interp.deleted?
+        s << ':deleted-slave'
+      elsif @interp.safe?
         s << ':safe-slave'
       else
         s << ':trusted-slave'
@@ -1281,11 +1330,13 @@ class MultiTkIp
     #self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
     #ret = self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) }
     ret = self.eval_callback(*args){|safe, *params|
-      $SAFE=safe; TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
+      $SAFE=safe
+      TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *params))
     }
     if ret.kind_of?(Exception)
       raise ret
     end
+    ret
   end
 end
 
@@ -1300,10 +1351,11 @@ class MultiTkIp
     end
 
     # on IP thread
-    if (@cmd_receiver == Thread.current)
+    if @cmd_receiver == Thread.current || 
+        (!req_val && TclTkLib.mainloop_thread? != false) # callback
       begin
         ret = cmd.call(*args)
-      rescue SystemExit
+      rescue SystemExit => e
         # exit IP
         warn("Warning: "+ $! + " on " + self.inspect) if $DEBUG
         begin
@@ -1318,6 +1370,18 @@ class MultiTkIp
                ((e.message.length > 0)? ' "' + e.message + '"': '') +  
                " on " + self.inspect)
         end
+=begin
+        begin
+          bt = _toUTF8(e.backtrace.join("\n"))
+          bt.instance_variable_set(:@encoding, 'utf-8')
+        rescue Exception
+          bt = e.backtrace.join("\n")
+        end
+        begin
+          @interp._set_global_var('errorInfo', bt)
+        rescue Exception
+        end
+=end
         ret = e
       end
       return ret
@@ -1353,7 +1417,7 @@ class MultiTkIp
         self._eval_without_enc('exit')
       rescue Exception
       end
-      if !safe? && allow_ruby_exit?
+      if !self.deleted? && !safe? && allow_ruby_exit?
         self.delete
         fail e
       else
@@ -1380,11 +1444,34 @@ class MultiTkIp
     end
   end
 =end
+=begin
   def eval_callback(*args)
     if block_given?
       eval_proc_core(false, Proc.new, *args)
+#      eval_proc_core(Thread.current, Proc.new, *args)
     else
+      cmd = args.shift
       eval_proc_core(false, *args)
+#      eval_proc_core(Thread.current, *args)
+    end
+  end
+=end
+  def eval_callback(*args)
+    if block_given?
+      cmd = Proc.new
+    else
+      cmd = args.shift
+    end
+    if TclTkLib.mainloop_thread? != false
+      args.unshift(safe_level)
+    end
+    current = Thread.current
+    backup_ip = current['callback_ip']
+    current['callback_ip'] = self
+    begin
+      eval_proc_core(false, cmd, *args)
+    ensure
+      current['callback_ip'] = backup_ip
     end
   end
 
@@ -1399,7 +1486,7 @@ class MultiTkIp
 =end
   def eval_proc(*args)
     # The scope of the eval-block of 'eval_proc' method is different from 
-    # the enternal. If you want to pass local values to the eval-block, 
+    # the external. If you want to pass local values to the eval-block, 
     # use arguments of eval_proc method. They are passed to block-arguments.
     if block_given?
       cmd = Proc.new
@@ -1408,12 +1495,25 @@ class MultiTkIp
         fail ArgumentError, "A Proc or Method object is expected for 1st argument"
       end
     end
+    if TclTkLib.mainloop_thread? == true
+      # call from eventloop
+      current = Thread.current
+      backup_ip = current['callback_ip']
+      current['callback_ip'] = self
+      begin
+        eval_proc_core(false, cmd, safe_level, *args)
+      ensure
+        current['callback_ip'] = backup_ip
+      end
+    else
       eval_proc_core(true, 
                      proc{|safe, *params| 
-                     $SAFE=safe; Thread.new(*params, &cmd).value
+                       $SAFE=safe
+                       Thread.new(*params, &cmd).value
                      },
                      *args)
     end
+  end
   alias call eval_proc
 
   def bg_eval_proc(*args)
@@ -1739,7 +1839,7 @@ end
 
 # depend on TclTkIp
 class MultiTkIp
-  def mainloop(check_root = true, restart_on_dead = false)
+  def mainloop(check_root = true, restart_on_dead = true)
     #return self if self.slave?
     #return self if self != @@DEFAULT_MASTER
     if self != @@DEFAULT_MASTER
@@ -1752,7 +1852,11 @@ class MultiTkIp
         rescue MultiTkIp_OK => ret
           # return value
           @wait_on_mainloop[1] = false
+          if ret.value.kind_of?(Thread)
             return ret.value.value
+          else
+            return ret.value
+          end
         rescue SystemExit
           # exit IP
           warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
@@ -1762,7 +1866,7 @@ class MultiTkIp
           rescue Exception
           end
           self.delete
-        rescue Exception => e
+        rescue StandardError => e
           if $DEBUG
             warn("Warning: " + e.class.inspect + 
                  ((e.message.length > 0)? ' "' + e.message + '"': '') +  
@@ -1779,31 +1883,59 @@ class MultiTkIp
 
     unless restart_on_dead
       @wait_on_mainloop[1] = true
+=begin
+      begin
+        @interp.mainloop(check_root)
+      rescue StandardError => e
+        if $DEBUG
+          warn("Warning: " + e.class.inspect + 
+               ((e.message.length > 0)? ' "' + e.message + '"': '') +  
+               " on " + self.inspect) 
+        end
+      end
+=end
       @interp.mainloop(check_root)
       @wait_on_mainloop[1] = false
     else
-      begin
-        @wait_on_mainloop[1] = true
       loop do
+        @wait_on_mainloop[1] = true
         break unless self.alive?
         if check_root
           begin
             break if TclTkLib.num_of_mainwindows == 0
-            rescue Exception
+          rescue StandardError
             break
           end
         end
+        break if @interp.deleted?
+        begin
           @interp.mainloop(check_root)
-        end
+        rescue StandardError => e
-      #rescue StandardError
-      rescue Exception
           if TclTkLib.mainloop_abort_on_exception != nil
-          STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect, 
+            #STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect, 
-                       " exception (ignore) : ", $!.message, "\n");
+            #             " exception (ignore) : ", $!.message, "\n");
+            if $DEBUG
+              warn("Warning: Tk mainloop receives " << e.class.inspect <<
+                   " exception (ignore) : " << e.message);
             end
-        retry
+          end
+          #raise e
+        rescue Exception => e
+=begin
+          if TclTkLib.mainloop_abort_on_exception != nil
+            #STDERR.print("Warning: Tk mainloop receives ", $!.class.inspect, 
+            #             " exception (ignore) : ", $!.message, "\n");
+            if $DEBUG
+              warn("Warning: Tk mainloop receives " << e.class.inspect <<
+                   " exception (ignore) : " << e.message);
+            end
+          end
+=end
+          raise e
         ensure
           @wait_on_mainloop[1] = false
+          Thread.pass  # avoid eventloop conflict
+        end
       end
     end
     self
@@ -1875,18 +2007,17 @@ class MultiTkIp
       @interp._eval_without_enc("foreach i {#{after_ids}} {after cancel $i}")
     rescue Exception
     end
-=begin
+
     begin
       @interp._invoke('destroy', '.') unless @interp.deleted?
     rescue Exception
     end
-=end
+
     if @safe_base && !@interp.deleted?
       # do 'exit' to call the delete_hook procedure
       @interp._eval_without_enc('exit')
-    else
-      @interp.delete unless @interp.deleted?
     end
+    @interp.delete
     self
   end
 

ext/tk/lib/tk.rb

@@ -565,6 +565,15 @@ end
   module_function :bool, :number, :num_or_str, :string
   module_function :list, :simplelist, :window, :image_obj, :procedure
 
+  def subst(str, *opts)
+    # opts := :nobackslashes | :nocommands | novariables
+    tk_call('subst', 
+            *(opts.collect{|opt|
+                opt = opt.to_s
+                (opt[0] == ?-)? opt: '-' << opt
+              } << str))
+  end
+
   def _toUTF8(str, encoding = nil)
     TkCore::INTERP._toUTF8(str, encoding)
   end
@@ -1110,13 +1119,14 @@ module TkCore
   INTERP._invoke_without_enc('bind', 'all', "<#{WIDGET_DESTROY_HOOK}>",
                              install_cmd(proc{|path|
                                 unless TkCore::INTERP.deleted?
+                                  begin
                                     if (widget=TkCore::INTERP.tk_windows[path])
                                       if widget.respond_to?(:__destroy_hook__)
-                                      begin
                                         widget.__destroy_hook__
-                                      rescue Exception
                                       end
                                     end
+                                  rescue Exception=>e
+                                      p e if $DEBUG
                                   end
                                 end
                              }) << ' %W')
@@ -1175,11 +1185,24 @@ module TkCore
 
   def TkCore.callback(*arg)
     begin
-      TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
+      if TkCore::INTERP.tk_cmd_tbl.kind_of?(Hash)
-    rescue SystemExit
+        #TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
-      exit(0)
+        normal_ret = false
-    rescue Interrupt
+        ret = catch(:IRB_EXIT) do  # IRB hack
-      exit!(1)
+          retval = TkCore::INTERP.tk_cmd_tbl[arg.shift].call(*arg)
+          normal_ret = true
+          retval
+        end
+        unless normal_ret
+          # catch IRB_EXIT
+          exit(ret)
+        end
+        ret
+      end
+    rescue SystemExit=>e
+      exit(e.status)
+    rescue Interrupt=>e
+      fail(e)
     rescue Exception => e
       begin
         msg = _toUTF8(e.class.inspect) + ': ' + 
@@ -1194,6 +1217,8 @@ module TkCore
               e.backtrace.join("\n") + 
               "\n---< backtrace of Tk side >-------"
       end
+      # TkCore::INTERP._set_global_var('errorInfo', msg)
+      # fail(e)
       fail(e, msg)
     end
   end
@@ -1383,6 +1408,22 @@ module TkCore
     TclTkLib.mainloop(check_root)
   end
 
+  def mainloop_thread?
+    # true  : current thread is mainloop
+    # nil   : there is no mainloop
+    # false : mainloop is running on the other thread
+    #         ( At then, it is dangerous to call Tk interpreter directly. )
+    TclTkLib.mainloop_thread?
+  end
+
+  def mainloop_exist?
+    TclTkLib.mainloop_thread? != nil
+  end
+
+  def is_mainloop?
+    TclTkLib.mainloop_thread? == true
+  end
+
   def mainloop_watchdog(check_root = true)
     # watchdog restarts mainloop when mainloop is dead
     TclTkLib.mainloop_watchdog(check_root)
@@ -1738,13 +1779,34 @@ module Tk
   end
 
   def Tk.pack(*args)
-    #TkPack.configure(*args)
+    TkPack.configure(*args)
-    TkPack(*args)
+  end
+  def Tk.pack_forget(*args)
+    TkPack.forget(*args)
+  end
+  def Tk.unpack(*args)
+    TkPack.forget(*args)
   end
 
   def Tk.grid(*args)
     TkGrid.configure(*args)
   end
+  def Tk.grid_forget(*args)
+    TkGrid.forget(*args)
+  end
+  def Tk.ungrid(*args)
+    TkGrid.forget(*args)
+  end
+
+  def Tk.place(*args)
+    TkPlace.configure(*args)
+  end
+  def Tk.place_forget(*args)
+    TkPlace.forget(*args)
+  end
+  def Tk.unplace(*args)
+    TkPlace.forget(*args)
+  end
 
   def Tk.update(idle=nil)
     if idle
@@ -3940,7 +4002,7 @@ end
 #Tk.freeze
 
 module Tk
-  RELEASE_DATE = '2005-01-28'.freeze
+  RELEASE_DATE = '2005-03-02'.freeze
 
   autoload :AUTO_PATH,        'tk/variable'
   autoload :TCL_PACKAGE_PATH, 'tk/variable'
@@ -3950,7 +4012,6 @@ module Tk
   autoload :TCL_PRECISION,    'tk/variable'
 end
 
-
 # call setup script for Tk extension libraries (base configuration)
 begin
   require 'tkextlib/setup.rb'

ext/tk/lib/tk/canvas.rb

@@ -159,9 +159,11 @@ class TkCanvas<TkWindow
 
   def delete(*args)
     if TkcItem::CItemID_TBL[self.path]
-      find('withtag', *args).each{|item| 
+      args.each{|tag|
+        find('withtag', tag).each{|item| 
           TkcItem::CItemID_TBL[self.path].delete(item.id)
         }
+      }
     end
     tk_send_without_enc('delete', *args.collect{|t| tagid(t)})
     self

ext/tk/lib/tk/clock.rb

@@ -5,13 +5,17 @@ require 'tk'
 
 module Tk
   module Clock
+    include Tk
+    extend TkCore
+
     def self.add(clk, *args)
       tk_call_without_enc('clock','add', clk, *args).to_i
     end
 
     def self.clicks(ms=nil)
+      ms = ms.to_s if ms.kind_of?(Symbol)
       case ms
-      when nil
+      when nil, ''
         tk_call_without_enc('clock','clicks').to_i
       when /^mic/
         tk_call_without_enc('clock','clicks','-microseconds').to_i

ext/tk/lib/tk/timer.rb

@@ -420,6 +420,7 @@ class TkTimer
     @wait_var.value = 0
     tk_call 'after', 'cancel', @after_id if @after_id
     @after_id = nil
+
     Tk_CBTBL.delete(@id) ;# for GC
     self
   end

ext/tk/lib/tk/variable.rb

@@ -126,7 +126,81 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
     self
   end
 
-  def initialize(val="")
+  def default_value_type
+    @type
+  end
+
+  def default_value_type=(type)
+    if type.kind_of?(Class)
+      if type == NilClass
+        @type = nil
+      elsif type == Numeric
+        @type = :numeric
+      elsif type == TrueClass || type == FalseClass
+        @type = :bool
+      elsif type == String
+        @type = :string
+      elsif type == Symbol
+        @type = :symbol
+      elsif type == Array
+        @type = :list
+      else
+        @type = nil
+      end
+    else
+      case(type)
+      when nil
+        @type = nil
+      when :numeric, 'numeric'
+        @type = :numeric
+      when true, false, :bool, 'bool'
+        @type = :bool
+      when :string, 'string'
+        @type = :string
+      when :symbol, 'symbol'
+        @type = :symbol
+      when :list, 'list'
+        @type = :list
+      when :numlist, 'numlist'
+        @type = :numlist
+      else
+        self.default_value_type = type.class
+      end
+    end
+    @type
+  end
+
+  def _to_default_type(val)
+    return val unless @type
+    if val.kind_of?(Hash)
+      val.keys.each{|k| val[k] = _to_default_type(val[k]) }
+      val
+    else
+      begin
+        case(@type)
+        when :numeric
+          number(val)
+        when :bool
+          TkComm
+        when :string
+          val
+        when :symbol
+          val.intern
+        when :list
+          tk_split_simplelist(val)
+        when :numlist
+          tk_split_simplelist(val).collect!{|v| number(v)}
+        else
+          val
+        end
+      rescue
+        val
+      end
+    end
+  end
+  private :_to_default_type
+
+  def initialize(val="", type=nil)
     # @id = Tk_VARIABLE_ID.join('')
     @id = Tk_VARIABLE_ID.join(TkCore::INTERP._ip_id_)
     Tk_VARIABLE_ID[1].succ!
@@ -139,6 +213,8 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
     @trace_elem = nil
     @trace_opts = nil
 
+    self.default_value_type = type
+
     begin
       INTERP._unset_global_var(@id)
     rescue
@@ -242,13 +318,25 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
   def is_hash?
     #ITNERP._eval("global #{@id}; array exist #{@id}") == '1'
     INTERP._invoke_without_enc('global', @id)
-    INTERP._invoke_without_enc('array', 'exist', @id) == '1'
+    # INTERP._invoke_without_enc('array', 'exist', @id) == '1'
+    TkComm.bool(INTERP._invoke_without_enc('array', 'exist', @id))
   end
 
   def is_scalar?
     ! is_hash?
   end
 
+  def exist?(idx = nil)
+    INTERP._invoke_without_enc('global', @id)
+    if idx
+      # array
+      TkComm.bool(tk_call('info', 'exist', "#{@id}")) && 
+        TkComm.bool(tk_call('info', 'exist', "#{@id}(#{idx})"))
+    else
+      TkComm.bool(tk_call('info', 'exist', @id))
+    end
+  end
+
   def keys
     if (is_scalar?)
       fail RuntimeError, 'cannot get keys from a scalar variable'
@@ -258,6 +346,11 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
     tk_split_simplelist(INTERP._fromUTF8(INTERP._invoke_without_enc('array', 'names', @id)))
   end
 
+  def size
+    INTERP._invoke_without_enc('global', @id)
+    TkComm.number(INTERP._invoke_without_enc('array', 'size', @id))
+  end
+
   def clear
     if (is_scalar?)
       fail RuntimeError, 'cannot clear a scalar variable'
@@ -274,7 +367,6 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
     self
   end
 
-
 unless const_defined?(:USE_TCLs_SET_VARIABLE_FUNCTIONS)
   USE_TCLs_SET_VARIABLE_FUNCTIONS = true
 end
@@ -284,10 +376,11 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
   # use Tcl function version of set tkvariable
   ###########################################################################
 
-  def value
+  def _value
     #if INTERP._eval("global #{@id}; array exist #{@id}") == '1'
     INTERP._invoke_without_enc('global', @id)
-    if INTERP._invoke('array', 'exist', @id) == '1'
+    # if INTERP._invoke('array', 'exist', @id) == '1'
+    if TkComm.bool(INTERP._invoke('array', 'exist', @id))
       #Hash[*tk_split_simplelist(INTERP._eval("global #{@id}; array get #{@id}"))]
       Hash[*tk_split_simplelist(INTERP._invoke('array', 'get', @id))]
     else
@@ -306,6 +399,7 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
       }
       self.value
     elsif val.kind_of?(Array)
+=begin
       INTERP._set_global_var(@id, '')
       val.each{|v|
         #INTERP._set_variable(@id, _toUTF8(_get_eval_string(v)), 
@@ -316,6 +410,8 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
                              TclTkLib::VarAccessFlag::LIST_ELEMENT)
       }
       self.value
+=end
+      _fromUTF8(INTERP._set_global_var(@id, array2tk_list(val)))
     else
       #_fromUTF8(INTERP._set_global_var(@id, _toUTF8(_get_eval_string(val))))
       _fromUTF8(INTERP._set_global_var(@id, _get_eval_string(val, true)))
@@ -325,7 +421,8 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
   def [](*idxs)
     index = idxs.collect{|idx| _get_eval_string(idx, true)}.join(',')
     begin
-      _fromUTF8(INTERP._get_global_var2(@id, index))
+      # _fromUTF8(INTERP._get_global_var2(@id, index))
+      _to_default_type(_fromUTF8(INTERP._get_global_var2(@id, index)))
     rescue => e
       case @def_default
       when :proc
@@ -365,7 +462,7 @@ else
   # use Ruby script version of set tkvariable (traditional methods)
   ###########################################################################
 
-  def value
+  def _value
     begin
       INTERP._eval(Kernel.format('global %s; set %s', @id, @id))
       #INTERP._eval(Kernel.format('set %s', @id))
@@ -436,7 +533,8 @@ else
   def [](*idxs)
     index = idxs.collect{|idx| _get_eval_string(idx)}.join(',')
     begin
-      INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
+      # INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
+      _to_default_type(INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index)))
     rescue => e
       case @def_default
       when :proc
@@ -483,8 +581,19 @@ else
 
 end
 
+  protected :_value
+
+  def value
+    _to_default_type(_value)
+  end
+
+  def value_type=(val)
+    self.default_value_type = val
+    self.value=(val)
+  end
+
   def numeric
-    number(value)
+    number(_value)
   end
   def numeric=(val)
     case val
@@ -497,17 +606,20 @@ end
     end
     val
   end
+  def numeric_type=(val)
+    @type = :numeric
+    self.numeric=(val)
+  end
 
   def bool
     # see Tcl_GetBoolean man-page
-    case value.downcase
+    case _value.downcase
     when '0', 'false', 'no', 'off'
       false
     else
       true
     end
   end
-
   def bool=(val)
     if ! val
       self.value = '0'
@@ -520,30 +632,48 @@ end
       end
     end
   end
+  def bool_type=(val)
+    @type = :bool
+    self.bool=(val)
+  end
 
   def to_i
-    number(value).to_i
+    number(_value).to_i
   end
 
   def to_f
-    number(value).to_f
+    number(_value).to_f
   end
 
   def to_s
     #string(value).to_s
-    value
+    _value
+  end
+  alias string= value=
+  def string_type=(val)
+    @type = :string
+    self.value=(val)
   end
 
   def to_sym
-    value.intern
+    _value.intern
+  end
+  alias symbol= value=
+  def symbol_type=(val)
+    @type = :symbol
+    self.value=(val)
   end
 
   def list
     #tk_split_list(value)
-    tk_split_simplelist(value)
+    tk_split_simplelist(_value)
   end
   alias to_a list
 
+  def numlist
+    list.collect!{|val| number(val)}
+  end
+
   def list=(val)
     case val
     when Array
@@ -555,6 +685,39 @@ end
     end
     val
   end
+  alias numlist= list=
+
+  def list_type=(val)
+    @type = :list
+    self.list=(val)
+  end
+  def numlist_type=(val)
+    @type = :numlist
+    self.numlist=(val)
+  end
+
+  def lappend(*elems)
+    tk_call('lappend', @id, *elems)
+    self
+  end
+
+  def lindex(idx)
+    tk_call('lindex', self._value, idx)
+  end
+  alias lget lindex
+
+  def lget_i(idx)
+    number(lget(idx)).to_i
+  end
+
+  def lget_f(idx)
+    number(lget(idx)).to_f
+  end
+
+  def lset(idx, val)
+    tk_call('lset', @id, idx, val)
+    self
+  end
 
   def inspect
     #Kernel.format "#<TkVariable: %s>", @id
@@ -564,7 +727,7 @@ end
   def coerce(other)
     case other
     when TkVariable
-      [other.value, self.value]
+      [other._value, self._value]
     when String
       [other, self.to_s]
     when Symbol
@@ -576,7 +739,7 @@ end
     when Array
       [other, self.to_a]
     else
-      [other, self.value]
+      [other, self._value]
     end
   end
 
@@ -599,12 +762,12 @@ end
     when Array
       self.to_a + other
     when String
-      self.value + other
+      self._value + other
     else
       begin
-        number(self.value) + other
+        number(self._value) + other
       rescue
-        self.value + other.to_s
+        self._value + other.to_s
       end
     end
   end
@@ -612,37 +775,40 @@ end
     if other.kind_of?(Array)
       self.to_a - other
     else
-      number(self.value) - other
+      number(self._value) - other
     end
   end
   def *(other)
-    begin
+    num_or_str(self._value) * other.to_i
-      number(self.value) * other
+    #begin
-    rescue
+    #  number(self._value) * other
-      self.value * other
+    #rescue
-    end
+    #  self._value * other
+    #end
   end
   def /(other)
-    number(self.value) / other
+    number(self._value) / other
   end
   def %(other)
-    begin
+    num_or_str(self._value) % other.to_i
-      number(self.value) % other
+    #begin
-    rescue
+    #  number(self._value) % other
-      self.value % other
+    #rescue
-    end
+    #  self._value % other
+    #end
   end
   def **(other)
-    number(self.value) ** other
+    number(self._value) ** other
   end
   def =~(other)
-    self.value =~ other
+    self._value =~ other
   end
 
   def ==(other)
     case other
     when TkVariable
-      self.equal?(other)
+      #self.equal?(other)
+      self._value == other._value
     when String
       self.to_s == other
     when Symbol
@@ -654,7 +820,8 @@ end
     when Array
       self.to_a == other
     when Hash
-      self.value == other
+      # false if self is not an assoc array
+      self._value == other
     else
       false
     end
@@ -673,17 +840,17 @@ end
         val = other.numeric
         other = val
       rescue
-        other = other.value
+        other = other._value
       end
     end
     if other.kind_of?(Numeric)
       begin
         return self.numeric <=> other
       rescue
-        return self.value <=> other.to_s
+        return self._value <=> other.to_s
       end
     else
-      return self.value <=> other
+      return self._value <=> other
     end
   end
 

ext/tk/lib/tkextlib/tclx/tclx.rb

@@ -27,6 +27,16 @@ module Tk
       Tk.tk_call('infox', *args)
     end
 
+    def self.signal(*args)
+      warn("Warning: Don't recommend to use TclX's 'signal' command. Please use Ruby's 'Signal.trap' method")
+      Tk.tk_call('signal', *args)
+    end
+
+    def self.signal_restart(*args)
+      warn("Warning: Don't recommend to use TclX's 'signal' command. Please use Ruby's 'Signal.trap' method")
+      Tk.tk_call('signal', '-restart', *args)
+    end
+
     ##############################
 
     class XPG3_MsgCat

ext/tk/sample/demos-en/anilabel.rb

@@ -37,7 +37,7 @@ TkFrame.new($anilabel_demo) {|frame|
 
   TkButton.new(frame) {
     text 'See Code'
-    command proc{showCode 'label'}
+    command proc{showCode 'anilabel'}
   }.pack('side'=>'left', 'expand'=>'yes')
 
 }.pack('side'=>'bottom', 'fill'=>'x', 'pady'=>'2m')

ext/tk/sample/demos-en/widget

@@ -392,6 +392,12 @@ txt.insert('end', "\n")
 txt.insert('end', "Animation\n", tag_title)
 txt.insert('end', " \n ", tag_demospace)
 txt.insert('end', "1. Animated labels (if supported)\n", tag_demo, "demo-anilabel")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "2. Animated wave (if supported)\n", tag_demo, "demo-aniwave")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "3. Pendulum simulation (if supported)\n", tag_demo, "demo-pendulum")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "4. A celebration of Rube Goldberg (if supported)\n", tag_demo, "demo-goldberg")
 
 txt.insert('end', "\n")
 txt.insert('end', "Miscellaneous\n", tag_title)
@@ -785,7 +791,7 @@ end
 #
 def aboutBox
   Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo', 
-                'message'=>"Ruby/Tk widget demonstration Ver.1.5.0-en\n\n" + 
+                'message'=>"Ruby/Tk widget demonstration Ver.1.5.2-en\n\n" + 
                            "based on demos of Tk8.1 -- 8.5  " + 
                            "( Copyright:: " + 
                            "(c) 1996-1997 Sun Microsystems, Inc. / " + 

ext/tk/sample/demos-jp/anilabel.rb

@@ -39,7 +39,7 @@ TkFrame.new($anilabel_demo) {|frame|
 
   TkButton.new(frame) {
     text 'コード参照'
-    command proc{showCode 'label'}
+    command proc{showCode 'anilabel'}
   }.pack('side'=>'left', 'expand'=>'yes')
 
 }.pack('side'=>'bottom', 'fill'=>'x', 'pady'=>'2m')

ext/tk/sample/demos-jp/widget

@@ -442,6 +442,12 @@ txt.insert('end', "\n")
 txt.insert('end', "アニメーション\n", tag_kanji_title)
 txt.insert('end', " \n ", tag_demospace)
 txt.insert('end', "1. アニメーションラベル (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-anilabel")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "2. 波形のアニメーション (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-aniwave")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "3. 振り子のシミュレーション (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-pendulum")
+txt.insert('end', " \n ", tag_demospace)
+txt.insert('end', "4. A celebration of Rube Goldberg (機能に対応したバージョンのTkが必要)\n", tag_demo, "demo-goldberg")
 
 txt.insert('end', "\n")
 #txt.insert('end', "その他\n", tag_middle)
@@ -813,7 +819,7 @@ end
 #
 def aboutBox
   Tk.messageBox('icon'=>'info', 'type'=>'ok', 'title'=>'About Widget Demo', 
-                'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.0-jp\n\n" + 
+                'message'=>"Ruby/Tk ウィジェットデモ Ver.1.5.2-jp\n\n" + 
                            "based on demos of Tk8.1 -- 8.5  " + 
                            "( Copyright:: " + 
                            "(c) 1996-1997 Sun Microsystems, Inc. / " + 

ext/tk/tkutil.c

@@ -8,12 +8,20 @@
 
 ************************************************/
 
-#define TKUTIL_RELEASE_DATE "2005-02-16"
+#define TKUTIL_RELEASE_DATE "2005-03-02"
 
 #include "ruby.h"
 #include "rubysig.h"
 #include "st.h"
 
+/* check ruby_version */
+#include "version.h"
+#if RUBY_VERSION_MINOR == 9
+#define ST_FOREACH_PASS_ERR_ARG 1  /* Ruby 1.9 */
+#else
+#define ST_FOREACH_PASS_ERR_ARG 0  /* Ruby 1.8 (from 2005/02/08) */
+#endif
+
 static VALUE cMethod;
 
 static VALUE cTclTkLib;
@@ -199,12 +207,36 @@ fromUTF8_toDefaultEnc(str, self)
     return tk_fromUTF8(1, argv, self);
 }
 
+
+#if ST_FOREACH_PASS_ERR_ARG
+static void
+hash_check(err)
+    int err;
+{
+    if (err) {
+        rb_raise(rb_eRuntimeError, "hash modified during iteration");
+    }
+}
+#endif
+
+#if ST_FOREACH_PASS_ERR_ARG
+static int
+to_strkey(key, value, hash, err)
+    VALUE key;
+    VALUE value;
+    VALUE hash;
+    int err;
+#else
 static int
 to_strkey(key, value, hash)
     VALUE key;
     VALUE value;
     VALUE hash;
+#endif
 {
+#if ST_FOREACH_PASS_ERR_ARG
+    hash_check(err);
+#endif
     if (key == Qundef) return ST_CONTINUE;
     rb_hash_aset(hash, rb_funcall(key, ID_to_s, 0, 0), value);
     return ST_CHECK;
@@ -219,9 +251,7 @@ tk_symbolkey2str(self, keys)
 
     if NIL_P(keys) return new_keys;
     keys = rb_convert_type(keys, T_HASH, "Hash", "to_hash");
-    if (st_foreach(RHASH(keys)->tbl, to_strkey, new_keys)) {
+    st_foreach(RHASH(keys)->tbl, to_strkey, new_keys);
-	rb_raise(rb_eRuntimeError, "hash modified during iteration");
-    }
     return new_keys;
 }
 
@@ -454,14 +484,26 @@ assoc2kv_enc(assoc, ary, self)
     }
 }
 
+#if ST_FOREACH_PASS_ERR_ARG
+static int
+push_kv(key, val, args, err)
+    VALUE key;
+    VALUE val;
+    VALUE args;
+    int err;
+#else
 static int
 push_kv(key, val, args)
     VALUE key;
     VALUE val;
     VALUE args;
+#endif
 {
     volatile VALUE ary;
 
+#if ST_FOREACH_PASS_ERR_ARG
+    hash_check(err);
+#endif
     ary = RARRAY(args)->ptr[0];
 
     if (key == Qundef) return ST_CONTINUE;
@@ -493,9 +535,7 @@ hash2kv(hash, ary, self)
     RARRAY(args)->ptr[0] = dst;
     RARRAY(args)->ptr[1] = self;
     RARRAY(args)->len = 2;
-    if (st_foreach(RHASH(hash)->tbl, push_kv, args)) {
+    st_foreach(RHASH(hash)->tbl, push_kv, args);
-	rb_raise(rb_eRuntimeError, "hash modified during iteration");
-    }
 
     if (NIL_P(ary)) {
         return dst;
@@ -504,14 +544,26 @@ hash2kv(hash, ary, self)
     }
 }
 
+#if ST_FOREACH_PASS_ERR_ARG
+static int
+push_kv_enc(key, val, args, err)
+    VALUE key;
+    VALUE val;
+    VALUE args;
+    int err;
+#else
 static int
 push_kv_enc(key, val, args)
     VALUE key;
     VALUE val;
     VALUE args;
+#endif
 {
     volatile VALUE ary;
 
+#if ST_FOREACH_PASS_ERR_ARG
+    hash_check(err);
+#endif
     ary = RARRAY(args)->ptr[0];
 
     if (key == Qundef) return ST_CONTINUE;
@@ -546,9 +598,7 @@ hash2kv_enc(hash, ary, self)
     RARRAY(args)->ptr[0] = dst;
     RARRAY(args)->ptr[1] = self;
     RARRAY(args)->len = 2;
-    if (st_foreach(RHASH(hash)->tbl, push_kv_enc, args)) {
+    st_foreach(RHASH(hash)->tbl, push_kv_enc, args);
-	rb_raise(rb_eRuntimeError, "hash modified during iteration");
-    }
 
     if (NIL_P(ary)) {
         return dst;