[ruby-dev:8905] Re: [PATCH] Ruby/Tk

永井＠知能．九工大です．

新井さんの [ruby-dev:8706] のパッチを基本として，
TkBindTag クラスとして実装してみました．
[ruby-dev:8902] のパッチも含んでますので，
そちらを無視して扱ってください．

--- tk.rb~	Tue Jan 11 00:31:09 2000
+++ tk.rb	Tue Jan 11 16:03:56 2000
@@ -347,15 +347,6 @@
   def _bind_append(what, context, cmd, args=nil)
     _bind_core('+', what, context, cmd, args)
   end
-  private :install_bind, :tk_event_sequence, :_bind_core, :_bind, :_bind_append
-
-  def bind_all(context, cmd=Proc.new, args=nil)
-    _bind(['bind', 'all'], context, cmd, args)
-  end
-
-  def bind_append_all(context, cmd=Proc.new, args=nil)
-    _bind_append(['bind', 'all'], context, cmd, args)
-  end
 
   def _bindinfo(what, context=nil)
     if context
@@ -372,11 +363,33 @@
       }
     end
   end
+  private :install_bind, :tk_event_sequence, 
+          :_bind_core, :_bind, :_bind_append, :_bindinfo
+
+  def bind(tagOrClass, context, cmd=Proc.new, args=nil)
+    _bind(["bind", tagOrClass], context, cmd, args)
+  end
+
+  def bind_append(tagOrClass, context, cmd=Proc.new, args=nil)
+    _bind_append(["bind", tagOrClass], context, cmd, args)
+  end
 
   def bindinfo(tagOrClass, context=nil)
     _bindinfo(['bind', tagOrClass], context)
   end
 
+  def bind_all(context, cmd=Proc.new, args=nil)
+    _bind(['bind', 'all'], context, cmd, args)
+  end
+
+  def bind_append_all(context, cmd=Proc.new, args=nil)
+    _bind_append(['bind', 'all'], context, cmd, args)
+  end
+
+  def bindinfo_all(context=nil)
+    _bindinfo(['bind', 'all'], context)
+  end
+
   def pack(*args)
     TkPack.configure *args
   end
@@ -405,7 +418,7 @@
     INTERP = TclTkIp.new
   end
 
-  INTERP._invoke("proc", "rb_out", "args", "if {[set st [catch {ruby [format \"TkCore.callback %%Q!%s!\" $args]} ret]] != 0} {return -code $st $ret} {return $ret}")
+  INTERP._invoke("proc", "rb_out", "args", "if {[set st [catch {ruby [format \"TkCore.callback %%Q!%s!\" $args]} ret]] != 0} {if {[regsub -all {!} $args {\\!} newargs] == 0} {return -code $st $ret} {if {[set st [catch {ruby [format \"TkCore.callback %%Q!%s!\" $newargs]} ret]] != 0} {return -code $st $ret} {return $ret}}} {return $ret}")
 
   def callback_break
     raise TkCallbackBreak, "Tk callback returns 'break' status"
@@ -682,6 +695,46 @@
   end
 end
 
+module TkBindCore
+  def bind(context, cmd=Proc.new, args=nil)
+    Tk.bind(to_eval, context, cmd, args)
+  end
+
+  def bind_append(context, cmd=Proc.new, args=nil)
+    Tk.bind_append(to_eval, context, cmd, args)
+  end
+
+  def bindinfo(context=nil)
+    Tk.bindinfo(to_eval, context)
+  end
+end
+
+class TkBindTag
+  include TkBindCore
+
+  BTagID_TBL = {}
+  Tk_BINDTAG_ID = ["btag00000"]
+
+  def TkBindTag.id2obj(id)
+    BTagID_TBL[id]? BTagID_TBL[id]: id
+  end
+
+  def initialize(*args)
+    @id = Tk_BINDTAG_ID[0]
+    Tk_BINDTAG_ID[0] = Tk_BINDTAG_ID[0].succ
+    BTagID_TBL[@id] = self
+    bind(*args) if args != []
+  end
+
+  def to_eval
+    @id
+  end
+
+  def inspect
+    format "#<TkBindTag: %s>", @id
+  end
+end
+
 class TkVariable
   include Tk
   extend TkCore
@@ -794,7 +847,7 @@
   end
 
   def inspect
-    format "<TkVariable: %s>", @id
+    format "#<TkVariable: %s>", @id
   end
 
   def ==(other)
@@ -1559,6 +1612,7 @@
 class TkObject<TkKernel
   include Tk
   include TkTreatFont
+  include TkBindCore
 
   def path
     return @path
@@ -1655,18 +1709,6 @@
     end
   end
 
-  def bind(context, cmd=Proc.new, args=nil)
-    _bind(["bind", to_eval], context, cmd, args)
-  end
-
-  def bind_append(context, cmd=Proc.new, args=nil)
-    _bind_append(["bind", to_eval], context, cmd, args)
-  end
-
-  def bindinfo(context=nil)
-    _bindinfo(['bind', to_eval], context)
-  end
-
   def event_generate(context, keys=nil)
     if keys
       tk_call('event', 'generate', path, 
@@ -1690,7 +1732,7 @@
 end
 
 class TkWindow<TkObject
-#  extend TkClassBind
+  extend TkBindCore
 
   def initialize(parent=nil, keys=nil)
     install_win(if parent then parent.path end)
@@ -1838,11 +1880,15 @@
       fail unless taglist.kind_of? Array
       tk_call('bindtags', path, taglist)
     else
-      tk_split_list(tk_call('bindtags', path)).collect{|tag|
-	if tag == nil
-	  '.'
-	elsif tag.kind_of?(String) && (cls = WidgetClassNames[tag])
-	  cls
+      list(tk_call('bindtags', path)).collect{|tag|
+	if tag.kind_of?(String) 
+	  if cls = WidgetClassNames[tag]
+	    cls
+	  elsif btag = TkBindTag.id2obj(tag)
+	    btag
+	  else
+	    tag
+	  end
 	else
 	  tag
 	end