tk.rb :

  * add and modify :
      TkWidget.database_class, TkWidget.database_classname,
      TkWidget#database_class, TkWidget#database_classname
  * instances of a subclass of TkToplevel or TkFrame are
    created with ":class=>subclass" option as default.
    For example, the followings create similar objects.
      (1) TkFrame.new(:class=>'XXX')
      (2) class XXX < TkFrame; end; XXX.new

sample/tkoptdb.rb :
  * add new part of sample script


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

2 files changed, 154 insertions, 2 deletions

diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index 6d8618a58a..74821f41c4 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -1501,6 +1501,10 @@ class TkBindTag
     bind(*args, &b) if args != []
   end
 
+  def name
+    @id
+  end
+
   def to_eval
     @id
   end
@@ -3283,9 +3287,23 @@ class TkWindow<TkObject
     @db_class || self.class()
   end
 
-  def database_class
+  def database_classname
     TkWinfo.classname(self)
   end
+  def database_class
+    name = database_classname()
+    if WidgetClassNames[name]
+      WidgetClassNames[name]
+    else
+      TkDatabaseClass.new(name)
+    end
+  end
+  def self.database_classname
+    self::WidgetClassName
+  end
+  def self.database_class
+    WidgetClassNames[self::WidgetClassName]
+  end
 
   def pack(keys = nil)
     tk_call 'pack', epath, *hash_kv(keys)
@@ -3717,6 +3735,11 @@ class TkToplevel<TkWindow
   private :_wm_command_option_chk
 
   def initialize(parent=nil, screen=nil, classname=nil, keys=nil)
+    my_class_name = nil
+    if self.class < WidgetClassNames[WidgetClassName]
+      my_class_name = self.class.name
+      my_class_name = nil if my_class_name == ''
+    end
     if parent.kind_of? Hash
       keys = _symbolkey2str(parent)
       if keys.key?('classname')
@@ -3728,6 +3751,9 @@ class TkToplevel<TkWindow
       @screen    = keys['screen']
       @use       = keys['use']
       @visual    = keys['visual']
+      if !@classname && my_class_name
+	keys['class'] = @classname = my_class_name 
+      end
       if @classname.kind_of? TkBindTag
 	@db_class = @classname
 	@classname = @classname.id
@@ -3770,6 +3796,11 @@ class TkToplevel<TkWindow
       @screen    = keys['screen'] unless @screen
       @use       = keys['use']
       @visual    = keys['visual']
+    else
+      keys = {}
+    end
+    if !@classname && my_class_name
+      keys['class'] = @classname = my_class_name 
     end
     if @classname.kind_of? TkBindTag
       @db_class = @classname
@@ -3802,6 +3833,46 @@ class TkToplevel<TkWindow
   def specific_class
     @classname
   end
+
+  def self.database_class
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      self
+    else
+      TkDatabaseClass.new(self.name)
+    end
+  end
+  def self.database_classname
+    self.database_class.name
+  end
+
+  def self.bind(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind(*args)
+    end
+  end
+  def self.bind_append(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind_append(*args)
+    end
+  end
+  def self.bind_remove(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind_remove(*args)
+    end
+  end
+  def self.bindinfo(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bindinfo(*args)
+    end
+  end
 end
 
 class TkFrame<TkWindow
@@ -3831,6 +3902,11 @@ class TkFrame<TkWindow
 #################
 
   def initialize(parent=nil, keys=nil)
+    my_class_name = nil
+    if self.class < WidgetClassNames[WidgetClassName]
+      my_class_name = self.class.name
+      my_class_name = nil if my_class_name == ''
+    end
     if parent.kind_of? Hash
       keys = _symbolkey2str(parent)
     else
@@ -3848,6 +3924,9 @@ class TkFrame<TkWindow
     @colormap  = keys['colormap']
     @container = keys['container']
     @visual    = keys['visual']
+    if !@classname && my_class_name
+      keys['class'] = @classname = my_class_name
+    end
     if @classname.kind_of? TkBindTag
       @db_class = @classname
       @classname = @classname.id
@@ -3868,9 +3947,49 @@ class TkFrame<TkWindow
     end
   end
 
-  def specific_class
+  def database_classname
     @classname
   end
+
+  def self.database_class
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      self
+    else
+      TkDatabaseClass.new(self.name)
+    end
+  end
+  def self.database_classname
+    self.database_class.name
+  end
+
+  def self.bind(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind(*args)
+    end
+  end
+  def self.bind_append(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind_append(*args)
+    end
+  end
+  def self.bind_remove(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bind_remove(*args)
+    end
+  end
+  def self.bindinfo(*args)
+    if self == WidgetClassNames[WidgetClassName] || self.name == ''
+      super(*args)
+    else
+      TkDatabaseClass.new(self.name).bindinfo(*args)
+    end
+  end
 end
 
 class TkLabelFrame<TkFrame
diff --git a/ext/tk/sample/tkoptdb.rb b/ext/tk/sample/tkoptdb.rb
index 930985dc22..066bd9501a 100644
--- a/ext/tk/sample/tkoptdb.rb
+++ b/ext/tk/sample/tkoptdb.rb
@@ -31,6 +31,7 @@ cmd = TkOptionDB.new_proc_class(:BTN_CMD, [:show_msg, :bye_msg], 2) {
   end
 }
 
+# following two frame widgets use same database entry
 TkFrame.new(:class=>'BtnFrame'){|f|
   pack(:padx=>5, :pady=>5)
   TkButton.new(:parent=>f, :widgetname=>'hello'){ 
@@ -46,4 +47,36 @@ TkFrame.new(:class=>'BtnFrame'){|f|
   }
 }
 
+class BtnFrame < TkFrame; end
+BtnFrame.new{|f|
+  pack(:padx=>5, :pady=>5)
+  TkButton.new(:parent=>f, :widgetname=>'hello'){ 
+    command proc{
+      print "($SAFE=#{$SAFE}) : "
+      cmd.show_msg(TkOptionDB.inspect)
+    } 
+    pack(:fill=>:x, :padx=>10, :pady=>10)
+  }
+  TkButton.new(:command=>proc{print "($SAFE=#{$SAFE}) : "; cmd.bye_msg; exit}, 
+	       :parent=>f, :widgetname=>'quit'){
+    pack(:fill=>:x, :padx=>10, :pady=>10)
+  }
+}
+
+# if unknown class, use default option values
+TkFrame.new(:class=>'BtnFrame2'){|f|
+  pack(:padx=>5, :pady=>5)
+  TkButton.new(:parent=>f, :widgetname=>'hello'){ 
+    command proc{
+      print "($SAFE=#{$SAFE}) : "
+      cmd.show_msg(TkOptionDB.inspect)
+    } 
+    pack(:fill=>:x, :padx=>10, :pady=>10)
+  }
+  TkButton.new(:command=>proc{print "($SAFE=#{$SAFE}) : "; cmd.bye_msg; exit}, 
+	       :parent=>f, :widgetname=>'quit'){
+    pack(:fill=>:x, :padx=>10, :pady=>10)
+  }
+}
+
 Tk.mainloop