tcltklib.c :

* lib_do_one_event() : change default value of the argument
 * lib_do_one_event() : returns true/false
 * add TclTkLib::EventFlag::NONE ( == 0 )
 * add set_no_event_wait() and get_no_event_wait()
 * modify MANUAL.euc and README.euc

tk.rb :
 * change default value of TkCore.do_one_event argument
 * add TkCore.set_no_event_wait(wait) and TkCore.get_no_event_wait
 * add Tk.exit ( == destroy root widget )

tkafter.rb :
 * rename TkAfter => TkTimer ( TkAfter is an alias name now. )
 * set_callback returns self
 * continue() raises an exception, if already running or no procedure.
 * skip() raises an exception, if not running.

sample/tktimer2.rb
 * new sample for TkTimer class.


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

ext/tcltklib/MANUAL.euc

@@ -1,4 +1,20 @@
 (tof)
+                                    2003/06/19  Hidetoshi NAGAI
+
+本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
+が含まれていますが，その記述内容は古いものとなっています．
+
+tcltk ライブラリ（tcltk.rb）は現在ではメンテナンスが事実上行われて
+いないため，古いドキュメントの説明がそのまま有効です．それに対し，
+tcltklib ライブラリについては，現在の Ruby/Tk（tk.rb 以下のライブラ
+リ群）を稼働させるための中心としてメンテナンスされているため，少々
+違いが生じています．
+
+そこで，まず古い説明文書を示した後，現在の tcltklib ライブラリにつ
+いての説明を加えます．
+
+以下がライブラリの古い説明文書です．
+==============================================================
 	MANUAL.euc
 		Sep. 19, 1997	Y. Shigehiro
 
@@ -121,4 +137,154 @@ require "tcltklib"
     引数: 無し
     戻り値 (Fixnum): 直前の Tcl_Eval() が返した値.
 
+==============================================================
+
+以下が本ドキュメント作成時点での tcltklib ライブラリの説明です．
+==============================================================
+モジュール TclTkLib
+   : 個々の Tcl/Tk インタープリタに依存しない処理 ( == イベントルー
+   : プに関する処理 ) を呼び出すメソッドを定義したモジュール．
+
+   モジュール TclTkLib::EventFlag
+      : do_one_event を呼び出す際の処理対象イベントを指定するための
+      : フラグ ( WINDOW|DONT_WAIT というようにビット演算子で連結して
+      : 指定 ) を定数として定義したモジュール．以下の定数が含まれる．
+
+      定数  NONE
+         : いかなる種類のイベントも処理対象としない ( == 0 )
+
+      定数  WINDOW
+         : window イベントを処理対象とする
+
+      定数  FILE
+         : file イベントを処理対象とする
+
+      定数  TIMER
+         : timer イベントを処理対象とする
+
+      定数  IDLE
+         : アイドルループ処理 ( 再描画など，他の種類のイベントが発生
+         : していないときに行われる処理 ) を処理対象とする
+
+      定数  ALL
+         : すべての種類のイベントを処理対象とする
+         : WINDOW|FILE|TIMER|IDLE と同じ
+
+      定数  DONT_WAIT
+         : 処理対象イベントが存在しない場合に，イベント発生を待たず
+         : に do_one_event を終了 ( false を返す ) する 
+
+   モジュールメソッド
+      mainloop(check_root = true)
+         : イベントループを起動する．check_root が true であれば，
+         : root widget が存在する限り，このメソッドは終了しない．
+         : check_root が false の場合は，root widget が消滅しても
+         : このメソッドは終了しない ( root widget が消滅しても，
+         : WINDOW 以外のイベントは発生しうるため )．終了には，外部
+         : からの働き掛け ( スレッドを活用するなど ) が必要．
+
+      mainloop_watchdog(check_root = true)
+         : 通常のイベントループでは，イベント処理の内容によっては
+         : デッドロックを引き起こす可能性がある (例えばイベントに
+         : 対するコールバック処理中で widget 操作をし，その終了を
+         : 待つなど)．このメソッドは，そうしたデッドロックを回避す
+         : るための監視スレッド付きでイベントループを起動する
+         : ( 監視スレッドを生成した後にイベントループを実行する )．
+         : 引数の意味は mainloop と同じである．
+
+      do_one_event(flag = TclTkLib::EventFlag::ALL)
+         : 処理待ちのイベント 1 個を実行する．
+         : イベントを処理した場合は true を返す．
+         : フラグで DONT_WAIT を指定していない場合，フラグで処理対
+         : 象となっている種類のイベントが発生するまで待ち続ける．
+         : DONT_WAIT を指定していた場合，処理対象イベントがなくても
+         : すぐに終了し false を返す．
+
+      set_eventloop_tick(timer_tick)
+         : イベントループと同時に別スレッドが稼働している場合に，時
+         : 間に基づいた強制的なスレッドスイッチングをどの程度の頻度
+         : ( 時間間隔 ) で発生させるかをミリ秒単位の整数値で指定する．
+         : 0 を指定すると，この強制的なスイッチングは行われない．
+         : 標準では 0 に設定されており，イベント処理数に基づくスイッ
+         : チングだけが行われる ( see set_eventloop_weight )．
+         : ただし，稼働しているスレッドがイベントループだけの場合，
+         : timer_tick を 0 に設定することはできない．もし設定されて
+         : いたら，200 ms ( see NO_THREAD_INTERRUPT_TIME ) に自動設
+         : 定される．
+         : 詳細な説明は略すが，これは CPU パワーを節約しつつ安全で
+         : 安定した動作を実現するために実装した仕様である．
+
+      get_eventloop_tick
+         : timer_tick の現在値を返す．
+
+      set_no_event_wait(no_event_wait)
+         : 複数のスレッドが稼働している場合で，処理待ちイベントが全
+         : く存在しなかった際に sleep 状態に入る時間長を指定する．
+         : 稼働スレッドがイベントループだけの場合には意味をなさない．
+         : デフォルトの値は 20 (ms)
+
+      get_no_event_wait
+         : no_event_wait の現在値を返す．
+
+      set_eventloop_weight(loop_max, no_event_tick)
+         : 複数のスレッドが稼働している際に Ruby/Tk のイベントルー
+         : プに割り当てる比重を定めるためのパラメータを設定する．
+         : 稼働スレッドがイベントループだけの場合には意味をなさない．
+         : 一度のスレッド切り替えの間に処理するイベントの最大数と，
+         : 処理待ちのイベントが存在しない際の加算数とを設定する．
+         : 処理待ちイベントが存在しない場合は no_event_wait ( see 
+         : set_no_event_wait ) だけの間 sleep 状態に入る．
+         : デフォルトではそれぞれ 800 回と 10 回，つまり，800 個のイ
+         : ベント (アイドルイベントを含む) を処理するとか，イベント
+         : が全く発生しないままに 80 回の処理待ちイベント検査が完了
+	 : するとかでカウントが 800 以上になるとスレッドスイッチング
+         : が発生することになる．
+
+      get_eventloop_weight
+         : 現在の loop_max と no_event_tick との値を返す．
+         : ( see set_eventloop_wait )
+
+クラス TclTkIp
+   インスタンスメソッド
+      restart
+         : Tcl/Tk インタープリタの Tk 部分の初期化，再起動を行う．
+         : 一旦 root widget を破壊した後に再度 Tk の機能が必要と
+         : なった場合に用いる．
+
+      _eval(str)
+      _invoke(*args)
+         : Tcl/Tk インタープリタ上で評価を行う．
+         : _eval は評価スクリプトが一つの文字列であることに対し，
+         : _invoke は評価スクリプトの token ごとに一つの引数とな
+         : るように与える．
+         : _invoke の方は Tcl/Tk インタープリタの字句解析器を用い
+         : ないため，評価の負荷がより少なくてすむ．
+
+
+      _toUTF8(str, encoding)
+      _fromUTF8(str, encoding)
+         : Tcl/Tk が内蔵している UTF8 変換処理を呼び出す．
+
+      _return_value
+         : 直前の Tcl/Tk 上での評価の実行結果としての戻り値を返す．
+
+      mainloop             : 引数を含めて TclTkLib.mainloop に同じ
+      mainloop_watchdog    : 引数を含めて TclTkLib.mainloop_watchdog に同じ
+      do_one_event         : 引数を含めて TclTkLib.do_one_event に同じ
+      set_eventloop_tick   : 引数を含めて TclTkLib.set_eventloop_tick に同じ
+      get_eventloop_tick   : 引数を含めて TclTkLib.get_eventloop_tick に同じ
+      set_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ
+      get_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ
+
+クラス TkCallbackBreak < StandardError
+クラス TkCallbackContinue < StandardError
+   : これらはイベントコールバックにおいて，コールバック処理を適切に中
+   : 断したり，次のバインドタグのバインディング処理に進めたりすること
+   : を可能にするための例外クラスである．
+   : コールバックで break や continue を実現するためには，コールバック
+   : である Ruby 手続きが Tcl/Tk インタープリタ側に適切なリターンコー
+   : ドを返す必要がある．Ruby の手続きが普通に値を返すのでは，それが普
+   : 通の戻り値であるのか否かを区別ができないため，例外発生を利用した
+   : 実装を行っている．
+
 (eof)

ext/tcltklib/README.euc

@@ -1,4 +1,30 @@
 (tof)
+                                    2003/06/19  Hidetoshi NAGAI
+
+本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明
+が含まれていますが，その記述内容は古いものとなっています．
+
+まず，現在の Ruby/Tk の中心である tk.rb は wish を呼び出したりはせ
+ず，tcltklib ライブラリを wrap して動作するものとなっています．その
+ため，古い説明記述で述べられているようなプロセス間通信によるオーバ
+ヘッドは存在しません．
+
+現在の tcltklib ライブラリでも，Tcl/Tk の C ライブラリをリンクして
+直接に動かすことで，オーバヘッドを押さえつつ Tcl/Tk インタープリタ
+のほぼ全機能（拡張ライブラリを含む）を使える点は同じです．しかし，
+その役割はほぼ「tk.rb 以下のライブラリを効果的に働かせるためのもの」
+と見なされており，その目的でメンテナンスされています．
+
+tk.rb の高機能化に伴って，中水準のライブラリである tcltk ライブラリ
+（tcltk.rb）はその存在意義を減じており，現在ではメンテナンスは行わ
+れていません．
+
+なお，古い説明ではバインディングにおけるスクリプトの追加はできないこ
+ととなっていますが，現在の tk.rb ではこれも可能であることを補足して
+おきます．
+
+以下がライブラリの古い説明文書です．
+==============================================================
 	tcltk ライブラリ
 	tcltklib ライブラリ
 		Sep. 19, 1997	Y. Shigehiro

ext/tcltklib/tcltklib.c

@@ -152,6 +152,30 @@ get_eventloop_tick(self)
     return INT2NUM(timer_tick);
 }
 
+static VALUE
+set_no_event_wait(self, wait)
+    VALUE self;
+    VALUE wait;
+{
+    int t_wait = NUM2INT(wait);
+
+    if (t_wait <= 0) {
+      rb_raise(rb_eArgError, 
+	       "no_event_wait parameter must be positive number");
+    }
+
+    no_event_wait = t_wait;
+
+    return wait;
+}
+
+static VALUE
+get_no_event_wait(self)
+    VALUE self;
+{
+    return INT2NUM(no_event_wait);
+}
+
 static VALUE
 set_eventloop_weight(self, loop_max, no_event)
     VALUE self;
@@ -389,14 +413,20 @@ lib_do_one_event(argc, argv, self)
 {
     VALUE obj, vflags;
     int flags;
+    int ret;
 
     if (rb_scan_args(argc, argv, "01", &vflags) == 0) {
-      flags = 0;
+      flags = TCL_ALL_EVENTS;
     } else {
       Check_Type(vflags, T_FIXNUM);
       flags = FIX2INT(vflags);
     }
-    return INT2NUM(Tcl_DoOneEvent(flags));
+    ret = Tcl_DoOneEvent(flags);
+    if (ret) {
+      return Qtrue;
+    } else {
+      return Qfalse;
+    }
 }
 
 /*---- class TclTkIp ----*/
@@ -911,6 +941,7 @@ Init_tcltklib()
 	rb_raise(rb_eLoadError, "tcltklib: tcltk_stubs init error(%d)", ret);
 #endif
 
+    rb_define_const(ev_flag, "NONE",      INT2FIX(0));
     rb_define_const(ev_flag, "WINDOW",    INT2FIX(TCL_WINDOW_EVENTS));
     rb_define_const(ev_flag, "FILE",      INT2FIX(TCL_FILE_EVENTS));
     rb_define_const(ev_flag, "TIMER",     INT2FIX(TCL_TIMER_EVENTS));
@@ -919,7 +950,8 @@ Init_tcltklib()
     rb_define_const(ev_flag, "DONT_WAIT", INT2FIX(TCL_DONT_WAIT));
 
     eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
-    eTkCallbackContinue = rb_define_class("TkCallbackContinue",rb_eStandardError);
+    eTkCallbackContinue = rb_define_class("TkCallbackContinue",
+                                          rb_eStandardError);
 
     rb_define_module_function(lib, "mainloop", lib_mainloop, -1);
     rb_define_module_function(lib, "mainloop_watchdog", 
@@ -927,6 +959,8 @@ Init_tcltklib()
     rb_define_module_function(lib, "do_one_event", lib_do_one_event, -1);
     rb_define_module_function(lib, "set_eventloop_tick",set_eventloop_tick,1);
     rb_define_module_function(lib, "get_eventloop_tick",get_eventloop_tick,0);
+    rb_define_module_function(lib, "set_no_event_wait", set_no_event_wait, 1);
+    rb_define_module_function(lib, "get_no_event_wait", get_no_event_wait, 0);
     rb_define_module_function(lib, "set_eventloop_weight", 
 			      set_eventloop_weight, 2);
     rb_define_module_function(lib, "get_eventloop_weight", 
@@ -944,6 +978,8 @@ Init_tcltklib()
     rb_define_method(ip, "do_one_event", lib_do_one_event, -1);
     rb_define_method(ip, "set_eventloop_tick", set_eventloop_tick, 1);
     rb_define_method(ip, "get_eventloop_tick", get_eventloop_tick, 0);
+    rb_define_method(ip, "set_no_event_wait", set_no_event_wait, 1);
+    rb_define_method(ip, "get_no_event_wait", get_no_event_wait, 0);
     rb_define_method(ip, "set_eventloop_weight", set_eventloop_weight, 2);
     rb_define_method(ip, "get_eventloop_weight", get_eventloop_weight, 0);
     rb_define_method(ip, "restart", lib_restart, 0);

ext/tk/MANIFEST

@@ -27,3 +27,4 @@ sample/tkfrom.rb
 sample/tkhello.rb
 sample/tkline.rb
 sample/tktimer.rb
+sample/tktimer2.rb

ext/tk/lib/tk.rb

@@ -765,7 +765,7 @@ module TkCore
     TclTkLib.mainloop_watchdog(check_root)
   end
 
-  def do_one_event(flag = 0)
+  def do_one_event(flag = TclTkLib::EventFlag::ALL)
     TclTkLib.do_one_event(flag)
   end
 
@@ -777,6 +777,14 @@ module TkCore
     TclTkLib.get_eventloop_tick
   end
 
+  def set_no_event_wait(wait)
+    TclTkLib.set_no_even_wait(wait)
+  end
+
+  def get_no_event_wait()
+    TclTkLib.get_no_eventloop_wait
+  end
+
   def set_eventloop_weight(loop_max, no_event_tick)
     TclTkLib.set_eventloop_weight(loop_max, no_event_tick)
   end
@@ -972,6 +980,10 @@ module Tk
     tk_call('destroy', *wins)
   end
 
+  def Tk.exit
+    tk_call('destroy', '.')
+  end
+
   def Tk.current_grabs
     tk_split_list(tk_call('grab', 'current'))
   end

ext/tk/lib/tkafter.rb

@@ -5,7 +5,7 @@
 #
 require 'tk'
 
-class TkAfter
+class TkTimer
   include TkCore
   extend TkCore
 
@@ -20,19 +20,19 @@ class TkAfter
   end
 
   INTERP._invoke("proc", "rb_after", "id", 
-                 "ruby [format \"TkAfter.callback %%Q!%s!\" $id]")
+                 "ruby [format \"#{self.name}.callback %%Q!%s!\" $id]")
 
   ###############################
   # class methods
   ###############################
-  def TkAfter.callback(obj_id)
+  def self.callback(obj_id)
     @after_id = nil
     ex_obj = Tk_CBTBL[obj_id]
     return nil if ex_obj == nil; # canceled
     _get_eval_string(ex_obj.do_callback)
   end
 
-  def TkAfter.info
+  def self.info
     tk_call('after', 'info').split(' ').collect!{|id|
       ret = Tk_CBTBL.find{|key,val| val.after_id == id}
       (ret == nil)? id: ret[1]
@@ -68,6 +68,7 @@ class TkAfter
     @after_id = tk_call('after', sleep, @after_script)
     @current_args = args
     @current_script = [sleep, @after_script]
+    self
   end
 
   def set_next_callback(args)
@@ -286,11 +287,12 @@ class TkAfter
   alias stop cancel
 
   def continue(wait=nil)
+    fail RuntimeError, "is already running" if @running
     sleep, cmd = @current_script
-    return nil if cmd == nil || @running == true
+    fail RuntimeError, "no procedure to continue" unless cmd
     if wait
       if not wait.kind_of? Integer
-	fail format("%s need to be Integer", wait.inspect)
+	fail RuntimeError, format("%s need to be Integer", wait.inspect)
       end
       sleep = wait
     end
@@ -301,7 +303,7 @@ class TkAfter
   end
 
   def skip
-    return nil if @running == false
+    fail RuntimeError, "is not running now" unless @running
     cancel
     Tk_CBTBL[@id] = self
     @running = true
@@ -319,4 +321,4 @@ class TkAfter
   end
 end
 
-TkTimer = TkAfter
+TkAfter = TkTimer

ext/tk/sample/tktimer2.rb

@@ -0,0 +1,29 @@
+#!/usr/bin/env ruby
+# This script is a re-implementation of tktimer.rb with TkTimer(TkAfter) class.
+
+require "tk"
+
+label = TkLabel.new(:relief=>:raised, :width=>10) \
+               .pack(:side=>:bottom, :fill=>:both)
+
+tick = proc{|aobj|
+  cnt = aobj.return_value + 5
+  label.text format("%d.%02d", *(cnt.divmod(100)))
+  cnt
+}
+
+timer = TkTimer.new(50, -1, tick).start(0, proc{ label.text('0.00'); 0 })
+
+TkButton.new(:text=>'Start') {
+  command proc{ timer.continue unless timer.running? }
+  pack(:side=>:left, :fill=>:both, :expand=>true)
+}
+TkButton.new(:text=>'Stop') {
+  command proc{ timer.stop if timer.running? }
+  pack('side'=>'right','fill'=>'both','expand'=>'yes')
+}
+
+ev_quit = TkVirtualEvent.new('Control-c', 'Control-q')
+Tk.root.bind(ev_quit, proc{Tk.exit}).focus
+
+Tk.mainloop