[ruby-list:29132] Re: patch for Tk.bindinfo (Re: TkBindTagAll)

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

遅くなりましてすみません．
Ruby/Tk のパッチです．
ruby-1.6.3 に私の前回のパッチを当てたものに対するパッチとなっています．
最後に添えておきますので，お試しください．

From: Koji Arai <[e-mail]>
Subject: [ruby-list:29005] TkBindTagAll (Re: ruby/tk TkEntry#selection_present bug?)
Date: Thu, 29 Mar 2001 00:39:20 +0900
Message-ID: <[e-mail]>
JCA02266> ひとつお願いを聞いて頂けますか？以前 TkBindTagAll のようなも
JCA02266> のをお願いしたのは私なのですが、これがクラスになっていたので
JCA02266> ちょっと私の想像とは違った物になってて悩んでいるのです。
JCA02266> (つい最近、これが取り込まれてるのを知りました。今ごろ済みません)
JCA02266> TkBindTagAll の代わりに添付のパッチのようなのだとダメでしょうか？
JCA02266> 単なる 'all' の代わりにクラスまで実装されるのはオーバースペッ
JCA02266> クのような気がするのです(ただでさえクラスだらけな tk に、
JCA02266> Bind関係はあちこちに分散しているので)。
JCA02266> もしパッチの内容を考慮して頂けるのならTkBindTagAll は*消した
JCA02266> い*というのが私の希望です。

この方針で TkBindTag::ALL を加えました．
後方互換性のために TkBindTagAll はまだ残してますが，
使用しようとすると「TkBindTagAll は obsolete だよ」と
$stderr に出力するようにしています．

JCA02266> 別件ですが、これ試してて発見したのですが
    (snip)
JCA02266>       tk_split_list(tk_call(*what)).collect{|seq|
JCA02266> 	seq[1..-2].gsub(/></,',')
JCA02266>       }
JCA02266> 
JCA02266> の seq[1..-2] の部分がまずいようです。(でも、パッチなし。すみません)

こちらについてですが，別の部分で行っていた処理をそのまま持ってきて，

JCA02266> require 'tk'
JCA02266> 
JCA02266> tag = TkBindTag.new
JCA02266> tag.bind(['Return']) {}
JCA02266> tag.bind(['Escape','Return']) {}
JCA02266> tag.bind(['Escape','q']) {}
JCA02266> tag.bind(['q','Escape']) {}
JCA02266> tag.bind('1') {}
JCA02266> tag.bind('a,Escape') {}
JCA02266> tag.bind('a,b') {}
JCA02266> tag.bind('q') {}
JCA02266> tag.bind(TkVirtualEvent.new('Return,Escape')) {}
JCA02266> # tag.bind([TkVirtualEvent.new('Return'), 'Escape']) {}	# <- うまくいかない
JCA02266> p tag.bindinfo
JCA02266> 
JCA02266> # bindinfo の返却値を bind できることを確認
JCA02266> tag.bindinfo.each {|seq|
JCA02266>   TkBindTag.new.bind(seq) {}
JCA02266> }

に対して，

-----------------------
[#<TkVirtualEvent:0x4014f4a8 @path="<VirtEvent0000>", @id="<VirtEvent0000>">, "q", ["a", "b"], ["a", "Key-Escape"], "Button-1", ["q", "Key-Escape"], ["Key-Escape", "q"], ["Key-Escape", "Key-Return"], "Key-Return"]
-----------------------

となるようにしました．
さらに，Tk に最初から存在する既存の仮想イベントに対しても
必要に応じて自動的にオブジェクトを生成するようにしましたので，

------------------------------------
require 'tk'
p TkVirtualEvent.info
------------------------------------

に対して

------------------------------------
[#<TkVirtualEvent::PreDefVirtEvent:0x4015185c @path="<PrevWindow>", @id="<PrevWindow>">, #<TkVirtualEvent::PreDefVirtEvent:0x401517bc @path="<PasteSelection>", @id="<PasteSelection>">, #<TkVirtualEvent::PreDefVirtEvent:0x40151654 @path="<Paste>", @id="<Paste>">, #<TkVirtualEvent::PreDefVirtEvent:0x401514ec @path="<Copy>", @id="<Copy>">, #<TkVirtualEvent::PreDefVirtEvent:0x40151384 @path="<Cut>", @id="<Cut>">]
------------------------------------

などとオブジェクトで返します．
これらは Tcl/Tk8.3.1 で最初から登録されている

------------------------------------
<<PrevWindow>> <<PasteSelection>> <<Paste>> <<Copy>> <<Cut>>
------------------------------------

に対応する仮想イベントオブジェクトです．
例えば，

------------------------------------
require 'tk'
tag = TkBindTag.new
tag.bind('<Cut>') {}
p tag.bindinfo
------------------------------------

というように，既存の仮想イベントを指定した場合も，

------------------------------------
[#<TkVirtualEvent::PreDefVirtEvent:0x401cc328 @path="<Cut>", @id="<Cut>">]
------------------------------------

などと返します．

From: Koji Arai <[e-mail]>
Subject: [ruby-list:29006] patch for Tk.bindinfo (Re: TkBindTagAll)
Date: Thu, 29 Mar 2001 04:56:26 +0900
Message-ID: <[e-mail]>
JCA02266> ところで、"<<virtual>><sequence>" というシーケンスはダメなの
JCA02266> でした？上記のコメントアウトした部分がなぜかエラーになるのです。
JCA02266> 
JCA02266> #!/usr/local/bin/wish
JCA02266> event add <<virtual>> <Return>
JCA02266> bind . <<virtual>><Escape>
JCA02266> exit
JCA02266> 
JCA02266> は特にエラーにならずよくわかりませんでした(一箇所 context =>
JCA02266> ev のバグはありました。パッチ参照)

これは確かにエラーにはなりませんが，

bind . <<virtual>><Escape> {puts asdf}

は

virtual events may not be composed

のエラーを生じますから，Ruby/Tk の動作で間違いはないと思います．
-- 
                                         永井 秀利 （九工大 知能情報）
                                             [e-mail]

diff -u 1.6.3p1/tk.rb 1.6/tk.rb
--- 1.6.3p1/tk.rb	Thu Apr  5 22:37:43 2001
+++ 1.6/tk.rb	Fri Apr  6 01:27:54 2001
@@ -351,7 +351,7 @@
     end
     if context.kind_of? Array
       context = context.collect{|ev|
-	if context.kind_of? TkVirtualEvent
+	if ev.kind_of? TkVirtualEvent
 	  ev.path
 	else
 	  ev
@@ -397,8 +397,18 @@
 	end
       }
     else
-      tk_split_list(tk_call(*what)).collect{|seq|
-	seq[1..-2].gsub(/></,',')
+      tk_split_simplelist(tk_call(*what)).collect!{|seq|
+	l = seq.scan(/<*[^<>]+>*/).collect!{|subseq|
+	  case (subseq)
+	  when /^<<[^<>]+>>$/
+	    TkVirtualEvent.getobj(subseq[1..-2])
+	  when /^<[^<>]+>$/
+	    subseq[1..-2]
+	  else
+	    subseq.split('')
+	  end
+	}.flatten
+	(l.size == 1) ? l[0] : l
       }
     end
   end
@@ -1046,6 +1056,12 @@
     BTagID_TBL[id]? BTagID_TBL[id]: id
   end
 
+  ALL = self.new
+  ALL.instance_eval {
+    @id = 'all'
+    BTagID_TBL[@id] = self
+  }
+
   def initialize(*args)
     @id = Tk_BINDTAG_ID[0]
     Tk_BINDTAG_ID[0] = Tk_BINDTAG_ID[0].succ
@@ -1063,20 +1079,11 @@
 end
 
 class TkBindTagAll<TkBindTag
-  BindTagALL = []
   def TkBindTagAll.new(*args)
-    if BindTagALL[0]
-      BindTagALL[0].bind(*args) if args != []
-    else
-      new = super()
-      BindTagALL[0] = new
-    end
-    BindTagALL[0]
-  end
+    $stderr.puts "Warning: TkBindTagALL is obsolete. Use TkBindTag::ALL\n"
 
-  def initialize(*args)
-    @id = 'all'
-    BindTagALL[0].bind(*args) if args != []
+    TkBindTag::ALL.bind(*args) if args != []
+    TkBindTag::ALL
   end
 end
 
@@ -2575,7 +2582,7 @@
 
   def bindtags(taglist=nil)
     if taglist
-      fail unless taglist.kind_of? Array
+      fail ArgumentError unless taglist.kind_of? Array
       tk_call('bindtags', path, taglist)
     else
       list(tk_call('bindtags', path)).collect{|tag|
diff -u 1.6.3p1/tkvirtevent.rb 1.6/tkvirtevent.rb
--- 1.6.3p1/tkvirtevent.rb	Tue Feb 13 22:53:24 2001
+++ 1.6/tkvirtevent.rb	Fri Apr  6 00:50:35 2001
@@ -7,12 +7,27 @@
 class TkVirtualEvent<TkObject
   extend Tk
 
-  TkVirturlEventID = [0]
-  TkVirturlEventTBL = {}
+  TkVirtualEventID = [0]
+  TkVirtualEventTBL = {}
+
+  class PreDefVirtEvent<self
+    def initialize(event)
+      @path = @id = event
+      TkVirtualEvent::TkVirtualEventTBL[@id] = self
+    end
+  end
 
   def TkVirtualEvent.getobj(event)
-    obj = TkVirturlEventTBL[event]
-    obj ? obj : event
+    obj = TkVirtualEventTBL[event]
+    if obj
+      obj
+    else
+      if tk_call('event', 'info').index("<#{event}>")
+	PreDefVirtEvent.new(event)
+      else
+	fail ArgumentError, "undefined virtual event '<#{event}>'"
+      end
+    end
   end
 
   def TkVirtualEvent.info
@@ -22,8 +37,8 @@
   end
 
   def initialize(*sequences)
-    @path = @id = format("<VirtEvent%.4d>", TkVirturlEventID[0])
-    TkVirturlEventID[0] += 1
+    @path = @id = format("<VirtEvent%.4d>", TkVirtualEventID[0])
+    TkVirtualEventID[0] += 1
     add(*sequences)
   end
 
@@ -31,7 +46,7 @@
     if sequences != []
       tk_call('event', 'add', "<#{@id}>", 
 	      *(sequences.collect{|seq| "<#{tk_event_sequence(seq)}>"}) )
-      TkVirturlEventTBL[@id] = self
+      TkVirtualEventTBL[@id] = self
     end
     self
   end
@@ -39,11 +54,11 @@
   def delete(*sequences)
     if sequences == []
       tk_call('event', 'delete', "<#{@id}>")
-      TkVirturlEventTBL[@id] = nil
+      TkVirtualEventTBL[@id] = nil
     else
       tk_call('event', 'delete', "<#{@id}>", 
 	      *(sequences.collect{|seq| "<#{tk_event_sequence(seq)}>"}) )
-      TkVirturlEventTBL[@id] = nil if info == []
+      TkVirtualEventTBL[@id] = nil if info == []
     end
     self
   end