* ext/tk/, ext/tcltklib/: bug fix

* ext/tk/lib/tk.rb: better operation for SIGINT when processing callbacks.
* ext/tk/lib/tk/msgcat.rb: ditto.
* ext/tk/lib/tk/variable.rb: ditto.
* ext/tk/lib/tk/timer.rb: ditto.
* ext/tk/lib/tk/validation.rb: add Tk::ValidateConfigure.__def_validcmd()
  to define validatecommand methods easier
* ext/tk/lib/tk.rb (_genobj_for_tkwidget): support autoload Tk ext classes
* ext/tk/lib/tk/canvas.rb and so on: remove the parent widget type check
  for items (e.g. canvas items; depends on the class) to avoid some troubles
  on Tk extension widget class definition.
* ext/tk/lib/tkextlib/: add Iwidget and TkTable extension support
* ext/tk/sample/tkextlib/: add samples of Iwidget and TkTable


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

12 files changed, 147 insertions, 58 deletions

diff --git a/ext/tk/lib/tk/canvas.rb b/ext/tk/lib/tk/canvas.rb
index c6799091a7..ac297c8ce5 100644
--- a/ext/tk/lib/tk/canvas.rb
+++ b/ext/tk/lib/tk/canvas.rb
@@ -602,9 +602,9 @@ class TkcItem<TkObject
   ########################################
 
   def initialize(parent, *args)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @parent = @c = parent
     @path = parent.path
 
diff --git a/ext/tk/lib/tk/canvastag.rb b/ext/tk/lib/tk/canvastag.rb
index bcd7a96430..f27111bd84 100644
--- a/ext/tk/lib/tk/canvastag.rb
+++ b/ext/tk/lib/tk/canvastag.rb
@@ -189,9 +189,9 @@ class TkcTag<TkObject
   end
 
   def initialize(parent, mode=nil, *args)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @c = parent
     @cpath = parent.path
     # @path = @id = Tk_CanvasTag_ID.join('')
@@ -276,9 +276,9 @@ class TkcTagString<TkcTag
   end
 
   def initialize(parent, name, mode=nil, *args)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @c = parent
     @cpath = parent.path
     @path = @id = name
@@ -293,9 +293,9 @@ TkcNamedTag = TkcTagString
 
 class TkcTagAll<TkcTag
   def initialize(parent)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @c = parent
     @cpath = parent.path
     @path = @id = 'all'
@@ -306,9 +306,9 @@ end
 
 class TkcTagCurrent<TkcTag
   def initialize(parent)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @c = parent
     @cpath = parent.path
     @path = @id = 'current'
@@ -321,9 +321,9 @@ class TkcGroup<TkcTag
   Tk_cGroup_ID = ['tkcg'.freeze, '00000'.taint].freeze
   #def create_self(parent, *args)
   def initialize(parent, *args)
-    unless parent.kind_of?(TkCanvas)
-      fail ArguemntError, "expect TkCanvas for 1st argument"
-    end
+    #unless parent.kind_of?(TkCanvas)
+    #  fail ArguemntError, "expect TkCanvas for 1st argument"
+    #end
     @c = parent
     @cpath = parent.path
     # @path = @id = Tk_cGroup_ID.join('')
diff --git a/ext/tk/lib/tk/event.rb b/ext/tk/lib/tk/event.rb
index 19fd9dbf00..9c46cb5d75 100644
--- a/ext/tk/lib/tk/event.rb
+++ b/ext/tk/lib/tk/event.rb
@@ -118,6 +118,10 @@ module TkEvent
     #
     _setup_subst_table(KEY_TBL, PROC_TBL);
 
+    #
+    # NOTE: The order of parameters which passed to callback procedure is 
+    #        <extra_arg>, <extra_arg>, ... , <subst_arg>, <subst_arg>, ...
+    #
 
     # If you need support extra arguments given by Tcl/Tk, 
     # please override _get_extra_args_tbl
diff --git a/ext/tk/lib/tk/menu.rb b/ext/tk/lib/tk/menu.rb
index fdb4ec201b..f0f5dcd2e8 100644
--- a/ext/tk/lib/tk/menu.rb
+++ b/ext/tk/lib/tk/menu.rb
@@ -320,9 +320,9 @@ class TkMenuClone<TkMenu
       widgetname = keys.delete('widgetname')
       type = keys.delete('type'); type = None unless type
     end
-    unless parent.kind_of?(TkMenu)
-      fail ArgumentError, "parent must be TkMenu"
-    end
+    #unless parent.kind_of?(TkMenu)
+    #  fail ArgumentError, "parent must be TkMenu"
+    #end
     @parent = parent
     install_win(@parent.path, widgetname)
     tk_call_without_enc(@parent.path, 'clone', @path, type)
@@ -336,9 +336,9 @@ module TkSystemMenu
       keys = _symbolkey2str(parent)
       parent = keys.delete('parent')
     end
-    unless parent.kind_of? TkMenu
-      fail ArgumentError, "parent must be a TkMenu object"
-    end
+    #unless parent.kind_of? TkMenu
+    #  fail ArgumentError, "parent must be a TkMenu object"
+    #end
     # @path = Kernel.format("%s.%s", parent.path, self.class::SYSMENU_NAME)
     @path = parent_path + '.' + self.class::SYSMENU_NAME
     #TkComm::Tk_WINDOWS[@path] = self
diff --git a/ext/tk/lib/tk/menuspec.rb b/ext/tk/lib/tk/menuspec.rb
index b2d66befa7..dfc1871ba9 100644
--- a/ext/tk/lib/tk/menuspec.rb
+++ b/ext/tk/lib/tk/menuspec.rb
@@ -144,6 +144,30 @@ module TkMenuSpec
   end
   private :_create_menu
 
+  def _use_menubar?(parent)
+    use_menubar = false
+    if parent.kind_of?(TkRoot) || parent.kind_of?(TkToplevel)
+      return true 
+    else
+      begin
+	parent.cget('menu')
+	return true 
+      rescue
+      end
+    end
+    false
+  end
+  private :_use_menubar?
+
+  def _create_menu_for_menubar(parent)
+    unless (mbar = parent.menu).kind_of?(TkMenu)
+      mbar = TkMenu.new(parent, :tearoff=>false)
+      parent.menu(mbar)
+    end
+    mbar
+  end
+  private :_create_menu_for_menubar
+
   def _create_menubutton(parent, menu_info, tearoff=false, default_opts = nil)
     btn_info = menu_info[0]
 
@@ -160,12 +184,10 @@ module TkMenuSpec
 
     tearoff = keys.delete('tearoff') if keys.key?('tearoff')
 
-    if parent.kind_of?(TkRoot) || parent.kind_of?(TkToplevel)
+    if _use_menubar?(parent)
       # menubar by menu entries
-      unless (mbar = parent.menu).kind_of?(TkMenu)
-	mbar = TkMenu.new(parent, :tearoff=>false)
-	parent.menu(mbar)
-      end
+
+      mbar = _create_menu_for_menubar(parent)
 
       menu_name = nil
 
diff --git a/ext/tk/lib/tk/text.rb b/ext/tk/lib/tk/text.rb
index d2fdfd9401..bd4586e4e2 100644
--- a/ext/tk/lib/tk/text.rb
+++ b/ext/tk/lib/tk/text.rb
@@ -502,9 +502,9 @@ class TkText<TkTextWin
     if TkTextTag::TTagID_TBL[@path]
       tags.each{|tag|
 	if tag.kind_of? TkTextTag
-	  TTagID_TBL[@path].delete(tag.id) 
+	  TkTextTag::TTagID_TBL[@path].delete(tag.id) 
 	else
-	  TTagID_TBL[@path].delete(tag) 
+	  TkTextTag::TTagID_TBL[@path].delete(tag) 
 	end
       }
     end
diff --git a/ext/tk/lib/tk/textimage.rb b/ext/tk/lib/tk/textimage.rb
index 444d91b0a5..d36d17098a 100644
--- a/ext/tk/lib/tk/textimage.rb
+++ b/ext/tk/lib/tk/textimage.rb
@@ -6,9 +6,9 @@ require 'tk/text'
 
 class TkTextImage<TkObject
   def initialize(parent, index, keys)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @t = parent
     if index == 'end'
       @path = TkTextMark.new(@t, tk_call(@t.path, 'index', 'end - 1 chars'))
diff --git a/ext/tk/lib/tk/textmark.rb b/ext/tk/lib/tk/textmark.rb
index 18d52a5bfc..a5e6f99d20 100644
--- a/ext/tk/lib/tk/textmark.rb
+++ b/ext/tk/lib/tk/textmark.rb
@@ -17,9 +17,9 @@ class TkTextMark<TkObject
   end
 
   def initialize(parent, index)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @parent = @t = parent
     @tpath = parent.path
     # @path = @id = Tk_TextMark_ID.join('')
@@ -101,9 +101,9 @@ class TkTextNamedMark<TkTextMark
   end
 
   def initialize(parent, name, index=nil)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @parent = @t = parent
     @tpath = parent.path
     @path = @id = name
diff --git a/ext/tk/lib/tk/texttag.rb b/ext/tk/lib/tk/texttag.rb
index 17909bbfcf..3196da9b5b 100644
--- a/ext/tk/lib/tk/texttag.rb
+++ b/ext/tk/lib/tk/texttag.rb
@@ -20,14 +20,14 @@ class TkTextTag<TkObject
   end
 
   def initialize(parent, *args)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @parent = @t = parent
     @tpath = parent.path
     # @path = @id = Tk_TextTag_ID.join('')
     @path = @id = Tk_TextTag_ID.join(TkCore::INTERP._ip_id_)
-    TTagID_TBL[@id] = self
+    # TTagID_TBL[@id] = self
     TTagID_TBL[@tpath] = {} unless TTagID_TBL[@tpath]
     TTagID_TBL[@tpath][@id] = self
     Tk_TextTag_ID[1].succ!
@@ -221,9 +221,9 @@ class TkTextNamedTag<TkTextTag
   end
 
   def initialize(parent, name, *args)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @parent = @t = parent
     @tpath = parent.path
     @path = @id = name
diff --git a/ext/tk/lib/tk/textwindow.rb b/ext/tk/lib/tk/textwindow.rb
index 6f609ee5e7..778cf0f733 100644
--- a/ext/tk/lib/tk/textwindow.rb
+++ b/ext/tk/lib/tk/textwindow.rb
@@ -6,9 +6,9 @@ require 'tk/text'
 
 class TkTextWindow<TkObject
   def initialize(parent, index, keys)
-    unless parent.kind_of?(TkText)
-      fail ArguemntError, "expect TkText for 1st argument"
-    end
+    #unless parent.kind_of?(TkText)
+    #  fail ArguemntError, "expect TkText for 1st argument"
+    #end
     @t = parent
     if index == 'end'
       @path = TkTextMark.new(@t, tk_call_without_enc(@t.path, 'index', 
diff --git a/ext/tk/lib/tk/validation.rb b/ext/tk/lib/tk/validation.rb
index a0bb5feb8b..53147178a7 100644
--- a/ext/tk/lib/tk/validation.rb
+++ b/ext/tk/lib/tk/validation.rb
@@ -183,6 +183,7 @@ end
 
 class TkValidateCommand
   include TkComm
+  extend  TkComm
 
   class ValidateArgs < TkUtil::CallbackSubst
     KEY_TBL = [
@@ -227,14 +228,19 @@ class TkValidateCommand
 
     _setup_subst_table(KEY_TBL, PROC_TBL);
 
-    def self.ret_val(val)
-      (val)? '1': '0'
-    end
+    #
+    # NOTE: The order of parameters which passed to callback procedure is 
+    #        <extra_arg>, <extra_arg>, ... , <subst_arg>, <subst_arg>, ...
+    #
 
     #def self._get_extra_args_tbl
     #  # return an array of convert procs
     #  []
     #end
+
+    def self.ret_val(val)
+      (val)? '1': '0'
+    end
   end
 
   ###############################################
@@ -257,7 +263,7 @@ class TkValidateCommand
       else
 	@id = install_cmd(proc{|*arg|
 	     ex_args = []
-	     extra_args_tbl.reverse_each{|conv| ex_args << conv.call(args.pop)}
+	     extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
 	     klass.ret_val(cmd.call(
                *(ex_args.concat(klass.scan_args(keys, arg)))
              ))
@@ -272,9 +278,9 @@ class TkValidateCommand
       else
 	@id = install_cmd(proc{|*arg|
 	     ex_args = []
-	     extra_args_tbl.reverse_each{|conv| ex_args << conv.call(args.pop)}
+	     extra_args_tbl.reverse_each{|conv| ex_args << conv.call(arg.pop)}
 	     klass.ret_val(cmd.call(
-               *(ex_args << klass.new(*klass.scan_args(keys,arg)))
+               *(ex_args << klass.new(*klass.scan_args(keys, arg)))
 	     ))
 	}) + ' ' + args
       end
diff --git a/ext/tk/lib/tk/variable.rb b/ext/tk/lib/tk/variable.rb
index 6398537bfa..22b17eb0e1 100644
--- a/ext/tk/lib/tk/variable.rb
+++ b/ext/tk/lib/tk/variable.rb
@@ -96,12 +96,45 @@ TkCore::INTERP.add_tk_procs('rb_var', 'args', <<-'EOL')
     end
   end
 
+  #
+  # default_value is available only when the variable is an assoc array. 
+  #
+  def default_value(val=nil, &b)
+    if b
+      @def_default = :proc
+      @default_val = proc(&b)
+    else
+      @def_default = :val
+      @default_val = val
+    end
+    self
+  end
+  def default_value=(val)
+    @def_default = :val
+    @default_val = val
+    self
+  end
+  def default_proc(cmd = Proc.new)
+    @def_default = :proc
+    @default_val = cmd
+    self
+  end
+
+  def undef_default
+    @default_val = nil
+    @def_default = false
+    self
+  end
+
   def initialize(val="")
     # @id = Tk_VARIABLE_ID.join('')
     @id = Tk_VARIABLE_ID.join(TkCore::INTERP._ip_id_)
     Tk_VARIABLE_ID[1].succ!
     TkVar_ID_TBL[@id] = self
 
+    @def_default = false
+    @default_val = nil
+
     @trace_var  = nil
     @trace_elem = nil
     @trace_opts = nil
@@ -290,7 +323,19 @@ if USE_TCLs_SET_VARIABLE_FUNCTIONS
 
   def [](*idxs)
     index = idxs.collect{|idx| _get_eval_string(idx, true)}.join(',')
-    _fromUTF8(INTERP._get_global_var2(@id, index))
+    begin
+      _fromUTF8(INTERP._get_global_var2(@id, index))
+    rescue => e
+      case @def_default
+      when :proc
+	@default_val.call(self, *idxs)
+      when :val
+	@default_val
+      else
+	fail e
+      end
+    end
+    #_fromUTF8(INTERP._get_global_var2(@id, index))
     #_fromUTF8(INTERP._get_global_var2(@id, _toUTF8(_get_eval_string(index))))
     #_fromUTF8(INTERP._get_global_var2(@id, _get_eval_string(index, true)))
   end
@@ -389,7 +434,19 @@ else
 
   def [](*idxs)
     index = idxs.collect{|idx| _get_eval_string(idx)}.join(',')
-    INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
+    begin
+      INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
+    rescue => e
+      case @def_default
+      when :proc
+	@default_val.call(self, *idxs)
+      when :val
+	@default_val
+      else
+	fail e
+      end
+    end
+    #INTERP._eval(Kernel.format('global %s; set %s(%s)', @id, @id, index))
     #INTERP._eval(Kernel.format('global %s; set %s(%s)', 
     #                           @id, @id, _get_eval_string(index)))
     #INTERP._eval(Kernel.format('set %s(%s)', @id, _get_eval_string(index)))