ruby 1.3 cycle

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

3 files changed, 452 insertions, 242 deletions

diff --git a/ext/tcltklib/extconf.rb b/ext/tcltklib/extconf.rb
index 26e7fe7b09..e34e549ca0 100644
--- a/ext/tcltklib/extconf.rb
+++ b/ext/tcltklib/extconf.rb
@@ -1,19 +1,27 @@
 # extconf.rb for tcltklib
 
+require 'mkmf'
+
+have_library("nsl", "t_open")
 have_library("socket", "socket")
-have_library("nsl", "gethostbyname")
+have_library("dl", "dlopen")
+have_library("m", "log") 
 
-def search_file(var, include, *path)
+$includes = []
+def search_header(include, *path)
   pwd = Dir.getwd
   begin
-    for i in path.reverse!
+    for i in path.sort!.reverse!
       dir = Dir[i]
-      for path in dir
+      for path in dir.sort!.reverse!
+	next unless File.directory? path
 	Dir.chdir path
 	files = Dir[include]
 	if files.size > 0
-	  var << path
-	  return files.pop
+	  unless $includes.include? path
+	    $includes << path
+	  end
+	  return
 	end
       end
     end
@@ -22,58 +30,56 @@ def search_file(var, include, *path)
   end
 end
 
-$includes = []
-search_file($includes, 
-	    "tcl.h",
-	    "/usr/include/tcl*",
-	    "/usr/include",
-	    "/usr/local/include/tcl*",
-	    "/usr/local/include")
-search_file($includes, 
-	    "tk.h",
-	    "/usr/include/tk*",
-	    "/usr/include",
-	    "/usr/local/include/tk*",
-	    "/usr/local/include")
-search_file($includes, 
-	    "X11/Xlib.h",
-	    "/usr/include",
-	    "/usr/X11*/include",
-	    "/usr/include",
-	    "/usr/X11*/include")
+search_header("tcl.h",
+	      "/usr/include/tcl{,8*,7*}",
+	      "/usr/include",
+	      "/usr/local/include/tcl{,8*,7*}",
+	      "/usr/local/include")
+search_header("tk.h",
+	      "/usr/include/tk{,8*,4*}",
+	      "/usr/include",
+	      "/usr/local/include/tk{,8*,4*}",
+	      "/usr/local/include")
+search_header("X11/Xlib.h",
+	      "/usr/include/X11*",
+	      "/usr/include",
+	      "/usr/openwin/include",
+	      "/usr/X11*/include")
 
-$CFLAGS = "-Wall " + $includes.collect{|path| "-I" + path}.join(" ")
+$CFLAGS = $includes.collect{|path| "-I" + path}.join(" ")
 
 $libraries = []
-tcllibfile = search_file($libraries,
-			 "libtcl{,7*,8*}.{a,so}",
-			 "/usr/lib",
-			 "/usr/local/lib")
-if tcllibfile
-  tcllibfile.sub!(/^lib/, '')
-  tcllibfile.sub!(/\.(a|so)$/, '')
-end
-tklibfile =  search_file($libraries,
-			 "libtk{,4*,8*}.{a,so}",
-			 "/usr/lib",
-			 "/usr/local/lib")
-if tklibfile
-  tklibfile.sub!(/^lib/, '')
-  tklibfile.sub!(/\.(a|so)$/, '')
+def search_lib(file, func, *path)
+  for i in path.reverse!
+    dir = Dir[i]
+    for path in dir.sort!.reverse!
+      $LDFLAGS = $libraries.collect{|p| "-L" + p}.join(" ") + " -L" + path
+      files = Dir[path+"/"+file]
+      if files.size > 0
+	for lib in files.sort!.reverse!
+	  lib = File::basename(lib)
+	  lib.sub!(/^lib/, '')
+	  lib.sub!(/\.(a|so)$/, '')
+	  if have_library(lib, func)
+	    unless $libraries.include? path
+	      $libraries << path
+	    end
+	    return true
+	  end
+	end
+      end
+    end
+  end
+  return false;
 end
-search_file($libraries,
-	    "libX11.{a,so}",
-	    "/usr/lib",
-	    "/usr/X11*/lib")
 
-$LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ")
-
-have_library("dl", "dlopen")
-if have_header("tcl.h") &&
-    have_header("tk.h") &&
-    have_library("X11", "XOpenDisplay") &&
-    have_library("m", "log") &&
-    have_library(tcllibfile, "Tcl_FindExecutable") &&
-    have_library(tklibfile, "Tk_Init")
+if have_header("tcl.h") && have_header("tk.h") &&
+    search_lib("libX11.{so,a}", "XOpenDisplay",
+	       "/usr/lib", "/usr/openwin/lib", "/usr/X11*/lib") &&
+    search_lib("libtcl{8*,7*,}.{so,a}", "Tcl_FindExecutable",
+	       "/usr/lib", "/usr/local/lib") &&
+    search_lib("libtk{8*,4*,}.{so,a}", "Tk_Init",
+	       "/usr/lib", "/usr/local/lib")
+  $LDFLAGS = $libraries.collect{|path| "-L" + path}.join(" ")
   create_makefile("tcltklib")
 end
diff --git a/ext/tcltklib/lib/tcltk.rb b/ext/tcltklib/lib/tcltk.rb
index 81d01f930d..54a00e8f3c 100644
--- a/ext/tcltklib/lib/tcltk.rb
+++ b/ext/tcltklib/lib/tcltk.rb
@@ -1,48 +1,44 @@
 # tof
 
-#### tcltk ライブラリ
+#### tcltk library, more direct manipulation of tcl/tk
 ####	Sep. 5, 1997	Y. Shigehiro
 
 require "tcltklib"
 
 ################
 
-# module TclTk: tcl/tk のライブラリ全体で必要になるものを集めたもの
-# (主に, 名前空間の点から module にする使う.)
+# module TclTk: collection of tcl/tk utilities (supplies namespace.)
 module TclTk
 
-  # 単にここに書けば最初に 1 度実行されるのか??
-
-  # 生成した一意な名前を保持しておく連想配列を初期化する.
+  # initialize Hash to hold unique symbols and such
   @namecnt = {}
 
-  # コールバックを保持しておく連想配列を初期化する.
+  # initialize Hash to hold callbacks
   @callback = {}
 end
 
-# TclTk.mainloop(): TclTkLib.mainloop() を呼ぶ.
+# TclTk.mainloop(): call TclTkLib.mainloop()
 def TclTk.mainloop()
   print("mainloop: start\n") if $DEBUG
   TclTkLib.mainloop()
   print("mainloop: end\n") if $DEBUG
 end
 
-# TclTk.deletecallbackkey(ca): コールバックを TclTk module から取り除く.
-#     tcl/tk インタプリタにおいてコールバックが取り消されるわけではない.
-#     これをしないと, 最後に TclTkInterpreter が GC できない.
-#     (GC したくなければ, 別に, これをしなくても良い.)
-#   ca: コールバック(TclTkCallback)
+# TclTk.deletecallbackkey(ca): remove callback from TclTk module
+#     this does not remove callbacks from tcl/tk interpreter
+#     without calling this method, TclTkInterpreter will not be GCed
+#   ca: callback(TclTkCallback)
 def TclTk.deletecallbackkey(ca)
   print("deletecallbackkey: ", ca.to_s(), "\n") if $DEBUG
   @callback.delete(ca.to_s)
 end
 
-# TclTk.dcb(ca, wid, W): 配列に入っている複数のコールバックに対して
-#     TclTk.deletecallbackkey() を呼ぶ.
-#     トップレベルの <Destroy> イベントのコールバックとして呼ぶためのもの.
-#   ca: コールバック(TclTkCallback) の Array
-#   wid: トップレベルのウィジェット(TclTkWidget)
-#   w: コールバックに %W で与えられる, ウインドウに関するパラメータ(String)
+# TclTk.dcb(ca, wid, W): call TclTk.deletecallbackkey() for each callbacks
+#     in an array.
+#     this is for callback for top-level <Destroy>
+#   ca: array of callbacks(TclTkCallback)
+#   wid: top-level widget(TclTkWidget)
+#   w: information about window given by %W(String)
 def TclTk.dcb(ca, wid, w)
   if wid.to_s() == w
     ca.each{|i|
@@ -51,33 +47,33 @@ def TclTk.dcb(ca, wid, w)
   end
 end
 
-# TclTk._addcallback(ca): コールバックを登録する.
-#   ca: コールバック(TclTkCallback)
+# TclTk._addcallback(ca): register callback
+#   ca: callback(TclTkCallback)
 def TclTk._addcallback(ca)
   print("_addcallback: ", ca.to_s(), "\n") if $DEBUG
   @callback[ca.to_s()] = ca
 end
 
-# TclTk._callcallback(key, arg): 登録したコールバックを呼び出す.
-#   key: コールバックを選択するキー (TclTkCallback が to_s() で返す値)
-#   arg: tcl/tk インタプリタからのパラメータ
+# TclTk._callcallback(key, arg): invoke registered callback
+#   key: key to select callback (to_s value of the TclTkCallback)
+#   arg: parameter from tcl/tk interpreter
 def TclTk._callcallback(key, arg)
   print("_callcallback: ", @callback[key].inspect, "\n") if $DEBUG
   @callback[key]._call(arg)
-  # コールバックからの返り値はどうせ捨てられる.
-  # String を返さないと, rb_eval_string() がエラーになる.
+  # throw out callback value
+  # should return String to satisfy rb_eval_string()
   return ""
 end
 
-# TclTk._newname(prefix): 一意な名前(String)を生成して返す.
-#   prefix: 名前の接頭語
+# TclTk._newname(prefix): generate unique name(String)
+#   prefix: prefix of the unique name
 def TclTk._newname(prefix)
-  # 生成した名前のカウンタは @namecnt に入っているので, 調べる.
+  # generated name counter is stored in @namecnt
   if !@namecnt.key?(prefix)
-    # 初めて使う接頭語なので初期化する.
+    # first appearing prefix, initialize
     @namecnt[prefix] = 1
   else
-    # 使ったことのある接頭語なので, 次の名前にする.
+    # already appeared prefix, generate next name
     @namecnt[prefix] += 1
   end
   return "#{prefix}#{@namecnt[prefix]}"
@@ -85,51 +81,48 @@ end
 
 ################
 
-# class TclTkInterpreter: tcl/tk のインタプリタ
+# class TclTkInterpreter: tcl/tk interpreter
 class TclTkInterpreter
 
-  # initialize(): 初期化.
+  # initialize(): 
   def initialize()
-    # インタプリタを生成する.
+    # generate interpreter object
     @ip = TclTkIp.new()
 
-    # インタプリタに ruby_fmt コマンドを追加する.
-    # ruby_fmt コマンドとは, 後ろの引数を format コマンドで処理して
-    # ruby コマンドに渡すものである.
-    # (なお, ruby コマンドは, 引数を 1 つしかとれない.)
+    # add ruby_fmt command to tcl interpreter
+    # ruby_fmt command format arguments by `format' and call `ruby' command
+    # (notice ruby command receives only one argument)
     if $DEBUG
       @ip._eval("proc ruby_fmt {fmt args} { puts \"ruby_fmt: $fmt $args\" ; ruby [format $fmt $args] }")
     else
       @ip._eval("proc ruby_fmt {fmt args} { ruby [format $fmt $args] }")
     end
 
-    # @ip._get_eval_string(*args): tcl/tk インタプリタで評価する
-    #     文字列(String)を生成して返す.
-    #   *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
+    # @ip._get_eval_string(*args): generate string to evaluate in tcl interpreter
+    #   *args: script which is going to be evaluated under tcl/tk
     def @ip._get_eval_string(*args)
       argstr = ""
       args.each{|arg|
 	argstr += " " if argstr != ""
-	# もし to_eval() メソッドが
+	# call to_eval if it is defined
 	if (arg.respond_to?(:to_eval))
-	  # 定義されていればそれを呼ぶ.
 	  argstr += arg.to_eval()
 	else
-	  # 定義されていなければ to_s() を呼ぶ.
+	  # call to_s unless defined
 	  argstr += arg.to_s()
 	end
       }
       return argstr
     end
 
-    # @ip._eval_args(*args): tcl/tk インタプリタで評価し,
-    #     その結果(String)を返す.
-    #   *args: tcl/tk で評価するスクリプト(に対応するオブジェクト列)
+    # @ip._eval_args(*args): evaluate string under tcl/tk interpreter
+    #     returns result string.
+    #   *args: script which is going to be evaluated under tcl/tk
     def @ip._eval_args(*args)
-      # インタプリタで評価する文字列を求める.
+      # calculate the string to eval in the interpreter
       argstr = _get_eval_string(*args)
 
-      # インタプリタで評価する.
+      # evaluate under the interpreter
       print("_eval: \"", argstr, "\"") if $DEBUG
       res = _eval(argstr)
       if $DEBUG
@@ -137,219 +130,205 @@ class TclTkInterpreter
       elsif  _return_value() != 0
 	print(res, "\n")
       end
-      fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0
+      fail(%Q/can't eval "#{argstr}"/) if _return_value() != 0 #'
       return res
     end
 
-    # tcl/tk のコマンドに対応するオブジェクトを生成し, 連想配列に入れておく.
+    # generate tcl/tk command object and register in the hash
     @commands = {}
-    # tcl/tk インタプリタに登録されているすべてのコマンドに対して,
+    # for all commands registered in tcl/tk interpreter:
     @ip._eval("info command").split(/ /).each{|comname|
       if comname =~ /^[.]/
-	# コマンドがウィジェット(のパス名)の場合は
-	# TclTkWidget のインスタンスを作って連想配列に入れる.
+	# if command is a widget (path), generate TclTkWidget,
+	# and register it in the hash
 	@commands[comname] = TclTkWidget.new(@ip, comname)
       else
-	# そうでない場合は
-	# TclTkCommand のインスタンスを作って連想配列に入れる.
+	# otherwise, generate TclTkCommand
 	@commands[comname] = TclTkCommand.new(@ip, comname)
       end
     }
   end
 
-  # commands(): tcl/tk のコマンドに対応するオブジェクトを Hash に
-  #     入れたものを返す.
+  # commands(): returns hash of the tcl/tk commands
   def commands()
     return @commands
   end
 
-  # rootwidget(): ルートウィジェット(TclTkWidget)を返す.
+  # rootwidget(): returns root widget(TclTkWidget)
   def rootwidget()
     return @commands["."]
   end
 
-  # _tcltkip(): @ip(TclTkIp) を返す.
+  # _tcltkip(): returns @ip(TclTkIp)
   def _tcltkip()
     return @ip
   end
 
-  # method_missing(id, *args): 未定義のメソッドは tcl/tk のコマンドとみなして
-  #     実行し, その結果(String)を返す.
-  #   id: メソッドのシンボル
-  #   *args: コマンドの引数
+  # method_missing(id, *args): execute undefined method as tcl/tk command
+  #   id: method symbol
+  #   *args: method arguments
   def method_missing(id, *args)
-    # もし, メソッドの tcl/tk コマンドが
+    # if command named by id registered, then execute it
     if @commands.key?(id.id2name)
-      # あれば, 実行して結果を返す.
       return @commands[id.id2name].e(*args)
     else
-      # 無ければもともとの処理.
+      # otherwise, exception
       super
     end
   end
 end
 
-# class TclTkObject: tcl/tk のオブジェクト
-# (基底クラスとして使う.
-#  tcltk ライブラリを使う人が TclTkObject.new() することはないはず.)
+# class TclTkObject: base class of the tcl/tk objects
 class TclTkObject
 
-  # initialize(ip, exp): 初期化.
-  #   ip: インタプリタ(TclTkIp)
-  #   exp: tcl/tk での表現形
+  # initialize(ip, exp): 
+  #   ip: interpreter(TclTkIp)
+  #   exp: tcl/tk representation
   def initialize(ip, exp)
     fail("type is not TclTkIp") if !ip.kind_of?(TclTkIp)
     @ip = ip
     @exp = exp
   end
 
-  # to_s(): tcl/tk での表現形(String)を返す.
+  # to_s(): returns tcl/tk representation
   def to_s()
     return @exp
   end
 end
 
-# class TclTkCommand: tcl/tk のコマンド
-# (tcltk ライブラリを使う人が TclTkCommand.new() することはないはず.
-#  TclTkInterpreter:initialize() から new() される.)
+# class TclTkCommand: tcl/tk commands
+# you should not call TclTkCommand.new()
+# commands are created by TclTkInterpreter:initialize()
 class TclTkCommand < TclTkObject
 
-  # e(*args): コマンドを実行し, その結果(String)を返す.
-  #     (e は exec または eval の e.)
-  #   *args: コマンドの引数
+  # e(*args): execute command.  returns String (e is for exec or eval)
+  #   *args: command arguments
   def e(*args)
     return @ip._eval_args(to_s(), *args)
   end
 end
 
-# class TclTkLibCommand: tcl/tk のコマンド
-# (ライブラリにより実現されるコマンドで, tcl/tk インタプリタに最初から
-#  存在しないものは, インタプリタの commands() では生成できない.
-#  そのようなものに対し, コマンドの名前から TclTkCommand オブジェクトを
-#  生成する.
+# class TclTkLibCommand: tcl/tk commands in the library
 class TclTkLibCommand < TclTkCommand
 
-  # initialize(ip, name): 初期化
-  #   ip: インタプリタ(TclTkInterpreter)
-  #   name: コマンド名 (String)
+  # initialize(ip, name): 
+  #   ip: interpreter(TclTkInterpreter)
+  #   name: command name (String)
   def initialize(ip, name)
     super(ip._tcltkip, name)
   end
 end
 
-# class TclTkVariable: tcl/tk の変数
+# class TclTkVariable: tcl/tk variable
 class TclTkVariable < TclTkObject
 
-  # initialize(interp, dat): 初期化.
-  #   interp: インタプリタ(TclTkInterpreter)
-  #   dat: 設定する値(String)
-  #       nil なら, 設定しない.
+  # initialize(interp, dat): 
+  #   interp: interpreter(TclTkInterpreter)
+  #   dat: the value to set(String)
+  #       if nil, not initialize variable
   def initialize(interp, dat)
-    # tcl/tk での表現形(変数名)を自動生成する.
+    # auto-generate tcl/tk representation (variable name)
     exp = TclTk._newname("v_")
-    # TclTkObject を初期化する.
+    # initialize TclTkObject
     super(interp._tcltkip(), exp)
-    # set コマンドを使うのでとっておく.
+    # safe this for `set' command
     @set = interp.commands()["set"]
-    # 値を設定する.
+    # set value
     set(dat) if dat
   end
 
-  # tcl/tk の set を使えば, 値の設定/参照はできるが,
-  # それだけではなんなので, 一応, メソッドをかぶせたものも用意しておく.
+  # although you can set/refer variable by using set in tcl/tk,
+  # we provide the method for accessing variables
 
-  # set(data): tcl/tk の変数に set を用いて値を設定する.
-  #   data: 設定する値
+  # set(data): set tcl/tk variable using `set'
+  #   data: new value
   def set(data)
     @set.e(to_s(), data.to_s())
   end
 
-  # get(): tcl/tk の変数の値(String)を set を用いて読みだし返す.
+  # get(): read tcl/tk variable(String) using `set'
   def get()
     return @set.e(to_s())
   end
 end
 
-# class TclTkWidget: tcl/tk のウィジェット
+# class TclTkWidget: tcl/tk widget
 class TclTkWidget < TclTkCommand
 
-  # initialize(*args): 初期化.
-  #   *args: パラメータ
+  # initialize(*args): 
+  #   *args: parameters
   def initialize(*args)
     if args[0].kind_of?(TclTkIp)
-      # 最初の引数が TclTkIp の場合:
+      # in case the 1st argument is TclTkIp:
 
-      # 既に tcl/tk に定義されているウィジェットに TclTkWidget の構造を
-      # かぶせる. (TclTkInterpreter:initialize() から使われる.)
+      # Wrap tcl/tk widget by TclTkWidget
+      # (used in TclTkInterpreter#initialize())
 
-      # パラメータ数が 2 でなければエラー.
+      # need two arguments
       fail("illegal # of parameter") if args.size != 2
 
-      # ip: インタプリタ(TclTkIp)
-      # exp: tcl/tk での表現形
+      # ip: interpreter(TclTkIp)
+      # exp: tcl/tk representation
       ip, exp = args
 
-      # TclTkObject を初期化する.
+      # initialize TclTkObject
       super(ip, exp)
     elsif args[0].kind_of?(TclTkInterpreter)
-      # 最初の引数が TclTkInterpreter の場合:
+      # in case 1st parameter is TclTkInterpreter:
 
-      # 親ウィジェットから新たなウィジェトを生成する.
+      # generate new widget from parent widget
 
-      # interp: インタプリタ(TclTkInterpreter)
-      # parent: 親ウィジェット
-      # command: ウィジェットを生成するコマンド(label 等)
-      # *args: command に渡す引数
+      # interp: interpreter(TclTkInterpreter)
+      # parent: parent widget
+      # command: widget generating tk command(label 等)
+      # *args: argument to the command 
       interp, parent, command, *args = args
 
-      # ウィジェットの名前を作る.
+      # generate widget name
       exp = parent.to_s()
       exp += "." if exp !~ /[.]$/
       exp += TclTk._newname("w_")
-      # TclTkObject を初期化する.
+      # initialize TclTkObject
       super(interp._tcltkip(), exp)
-      # ウィジェットを生成する.
+      # generate widget
       res = @ip._eval_args(command, exp, *args)
 #      fail("can't create Widget") if res != exp
-      # tk_optionMenu では, ボタン名を exp で指定すると
-      # res にメニュー名を返すので res != exp となる.
+      # for tk_optionMenu, it is legal res != exp
     else
       fail("first parameter is not TclTkInterpreter")
     end
   end
 end
 
-# class TclTkCallback: tcl/tk のコールバック
+# class TclTkCallback: tcl/tk callbacks
 class TclTkCallback < TclTkObject
 
-  # initialize(interp, pr, arg): 初期化.
-  #   interp: インタプリタ(TclTkInterpreter)
-  #   pr: コールバック手続き(Proc)
-  #   arg: pr のイテレータ変数に渡す文字列
-  #       tcl/tk の bind コマンドではパラメータを受け取るために % 置換を
-  #       用いるが, pr の内部で % を書いてもうまくいかない.
-  #       arg に文字列を書いておくと, その置換結果を, pr で
-  #       イテレータ変数を通して受け取ることができる.
-  #       scrollbar コマンドの -command オプションのように
-  #       何も指定しなくてもパラメータが付くコマンドに対しては,
-  #       arg を指定してはならない.
+  # initialize(interp, pr, arg): 
+  #   interp: interpreter(TclTkInterpreter)
+  #   pr: callback procedure(Proc)
+  #   arg: string to pass as block parameters of pr
+  #       bind command of tcl/tk uses % replacement for parameters
+  #       pr can receive replaced data using block parameter
+  #       its format is specified by arg string
+  #       You should not specify arg for the command like 
+  #       scrollbar with -command option, which receives parameters
+  #       without specifying any replacement
   def initialize(interp, pr, arg = nil)
-    # tcl/tk での表現形(変数名)を自動生成する.
+    # auto-generate tcl/tk representation (variable name)
     exp = TclTk._newname("c_")
-    # TclTkObject を初期化する.
+    # initialize TclTkObject
     super(interp._tcltkip(), exp)
-    # パラメータをとっておく.
+    # save parameters
     @pr = pr
     @arg = arg
-    # モジュールに登録しておく.
+    # register in the module
     TclTk._addcallback(self)
   end
 
-  # to_eval(): @ip._eval_args で評価するときの表現形(String)を返す.
+  # to_eval(): retuens string representation for @ip._eval_args
   def to_eval()
     if @arg
-      # %s は ruby_fmt より前に bind により置換されてしまうので
-      # %%s としてある. したがって, これは bind 専用.
+      # bind replaces %s before calling ruby_fmt, so %%s is used
       s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%%s")} #{@arg}}/
     else
       s = %Q/{ruby_fmt {TclTk._callcallback("#{to_s()}", "%s")}}/
@@ -358,28 +337,28 @@ class TclTkCallback < TclTkObject
     return s
   end
 
-  # _call(arg): コールバックを呼び出す.
-  #   arg: コールバックに渡されるパラメータ
+  # _call(arg): invoke callback
+  #   arg: callback parameter
   def _call(arg)
     @pr.call(arg)
   end
 end
 
-# class TclTkImage: tcl/tk のイメージ
+# class TclTkImage: tcl/tk images
 class TclTkImage < TclTkCommand
 
-  # initialize(interp, t, *args): 初期化.
-  #     イメージの生成は TclTkImage.new() で行うが,
-  #     破壊は image delete で行う. (いまいちだけど仕方が無い.)
-  #   interp: インタプリタ(TclTkInterpreter)
-  #   t: イメージのタイプ (photo, bitmap, etc.)
-  #   *args: コマンドの引数
+  # initialize(interp, t, *args): 
+  #     generating image is done by TclTkImage.new()
+  #     destrying is done by image delete (inconsistent, sigh)
+  #   interp: interpreter(TclTkInterpreter)
+  #   t: image type (photo, bitmap, etc.)
+  #   *args: command argument
   def initialize(interp, t, *args)
-    # tcl/tk での表現形(変数名)を自動生成する.
+    # auto-generate tcl/tk representation
     exp = TclTk._newname("i_")
-    # TclTkObject を初期化する.
+    # initialize TclTkObject
     super(interp._tcltkip(), exp)
-    # イメージを生成する.
+    # generate image
     res = @ip._eval_args("image create", t, exp, *args)
     fail("can't create Image") if res != exp
   end
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index e7fe77d2b7..625fe61ccc 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -5,22 +5,31 @@
  */
 
 #include "ruby.h"
-#include "sig.h"
+#include "rubysig.h"
 #include <stdio.h>
 #include <string.h>
 #include <tcl.h>
 #include <tk.h>
 
-/* for debug */
+#ifdef __MACOS__
+# include <tkMac.h>
+# include <Quickdraw.h>
+#endif
 
-#define DUMP1(ARG1) if (debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);}
-#define DUMP2(ARG1, ARG2) if (debug) { fprintf(stderr, "tcltklib: ");\
+/* for rb_debug */
+
+#define DUMP1(ARG1) if (rb_debug) { fprintf(stderr, "tcltklib: %s\n", ARG1);}
+#define DUMP2(ARG1, ARG2) if (rb_debug) { fprintf(stderr, "tcltklib: ");\
 fprintf(stderr, ARG1, ARG2); fprintf(stderr, "\n"); }
 /*
 #define DUMP1(ARG1)
 #define DUMP2(ARG1, ARG2)
 */
 
+/* for callback break & continue */
+VALUE eTkCallbackBreak;
+VALUE eTkCallbackContinue;
+
 /* from tkAppInit.c */
 
 /*
@@ -33,26 +42,52 @@ int *tclDummyMathPtr = (int *) matherr;
 
 /*---- module TclTkLib ----*/
 
-static VALUE thread_safe = Qnil;
+/* Tk_ThreadTimer */
+typedef struct {
+    Tcl_TimerToken token;
+    int  flag;
+} Tk_TimerData;
+
+/* timer callback */
+void _timer_for_tcl (ClientData clientData)
+{
+    Tk_TimerData *timer = (Tk_TimerData*)clientData;
+
+    timer->flag = 0;
+    CHECK_INTS;
+#ifdef USE_THREAD 
+    if (!rb_thread_critical) rb_thread_schedule();
+#endif
+
+    timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, 
+					 (ClientData)timer);
+    timer->flag = 1;
+}
 
 /* execute Tk_MainLoop */
 static VALUE
 lib_mainloop(VALUE self)
 {
-    int old_trapflg;
-    int flags = RTEST(thread_safe)?TCL_DONT_WAIT:0;
+    Tk_TimerData *timer;
+
+    timer = (Tk_TimerData *) ckalloc(sizeof(Tk_TimerData));
+    timer->flag = 0;
+    timer->token = Tk_CreateTimerHandler(200, _timer_for_tcl, 
+					 (ClientData)timer);
+    timer->flag = 1;
 
     DUMP1("start Tk_Mainloop");
     while (Tk_GetNumMainWindows() > 0) {
-	old_trapflg = trap_immediate;
-	trap_immediate = 1;
-        Tcl_DoOneEvent(flags);
-	trap_immediate = old_trapflg;
-	CHECK_INTS;
-	flags = (thread_safe == 0 || thread_safe == Qnil)?0:TCL_DONT_WAIT;
+        Tcl_DoOneEvent(0);
     }
     DUMP1("stop Tk_Mainloop");
 
+#ifdef USE_THREAD
+    if (timer->flag) {
+      Tk_DeleteTimerHandler(timer->token);
+    }
+#endif
+
     return Qnil;
 }
 
@@ -71,27 +106,49 @@ ip_eval_rescue(VALUE *failed, VALUE einfo)
 }
 
 static int
+#if TCL_MAJOR_VERSION >= 8
+ip_ruby(ClientData clientData, Tcl_Interp *interp, 
+	int argc, Tcl_Obj *CONST argv[])
+#else
 ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
+#endif
 {
     VALUE res;
     int old_trapflg;
     VALUE failed = 0;
+    char *arg;
+    int  dummy;
 
     /* ruby command has 1 arg. */
     if (argc != 2) {
-	ArgError("wrong # of arguments (%d for 1)", argc);
+	rb_raise(rb_eArgError, "wrong # of arguments (%d for 1)", argc);
     }
 
+    /* get C string from Tcl object */
+#if TCL_MAJOR_VERSION >= 8
+    arg = Tcl_GetStringFromObj(argv[1], &dummy);
+#else
+    arg = argv[1];
+#endif
+
     /* evaluate the argument string by ruby */
-    DUMP2("rb_eval_string(%s)", argv[1]);
-    old_trapflg = trap_immediate;
-    trap_immediate = 0;
-    res = rb_rescue(rb_eval_string, argv[1], ip_eval_rescue, &failed);
-    trap_immediate = old_trapflg;
+    DUMP2("rb_eval_string(%s)", arg);
+    old_trapflg = rb_trap_immediate;
+    rb_trap_immediate = 0;
+    res = rb_rescue(rb_eval_string, (VALUE)arg, ip_eval_rescue, (VALUE)&failed);
+    rb_trap_immediate = old_trapflg;
 
+    Tcl_ResetResult(interp);
     if (failed) {
-	Tcl_AppendResult(interp, RSTRING(failed)->ptr, (char*)NULL);
-	return TCL_ERROR;
+        VALUE eclass = CLASS_OF(failed);
+	Tcl_AppendResult(interp, STR2CSTR(failed), (char*)NULL);
+        if (eclass == eTkCallbackBreak) {
+	  return TCL_BREAK;
+	} else if (eclass == eTkCallbackContinue) {
+	  return TCL_CONTINUE;
+	} else {
+	  return TCL_ERROR;
+	}
     }
 
     /* result must be string or nil */
@@ -99,12 +156,11 @@ ip_ruby(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
 	DUMP1("(rb_eval_string result) nil");
 	return TCL_OK;
     }
-    Check_Type(res, T_STRING);
 
     /* copy result to the tcl interpreter */
-    DUMP2("(rb_eval_string result) %s", RSTRING(res)->ptr);
+    DUMP2("(rb_eval_string result) %s", STR2CSTR(res));
     DUMP1("Tcl_AppendResult");
-    Tcl_AppendResult(interp, RSTRING(res)->ptr, (char *)NULL);
+    Tcl_AppendResult(interp, STR2CSTR(res), (char *)NULL);
 
     return TCL_OK;
 }
@@ -115,6 +171,7 @@ ip_free(struct tcltkip *ptr)
 {
     DUMP1("Tcl_DeleteInterp");
     Tcl_DeleteInterp(ptr->ip);
+    free(ptr);
 }
 
 /* create and initialize interpreter */
@@ -135,20 +192,26 @@ ip_new(VALUE self)
     /* from Tcl_AppInit() */
     DUMP1("Tcl_Init");
     if (Tcl_Init(ptr->ip) == TCL_ERROR) {
-	Fail("Tcl_Init");
+	rb_raise(rb_eRuntimeError, "Tcl_Init");
     }
     DUMP1("Tk_Init");
     if (Tk_Init(ptr->ip) == TCL_ERROR) {
-	Fail("Tk_Init");
+	rb_raise(rb_eRuntimeError, "Tk_Init");
     }
     DUMP1("Tcl_StaticPackage(\"Tk\")");
     Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init,
 		      (Tcl_PackageInitProc *) NULL);
 
     /* add ruby command to the interpreter */
+#if TCL_MAJOR_VERSION >= 8
+    DUMP1("Tcl_CreateObjCommand(\"ruby\")");
+    Tcl_CreateObjCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL,
+			 (Tcl_CmdDeleteProc *)NULL);
+#else
     DUMP1("Tcl_CreateCommand(\"ruby\")");
     Tcl_CreateCommand(ptr->ip, "ruby", ip_ruby, (ClientData *)NULL,
 		      (Tcl_CmdDeleteProc *)NULL);
+#endif
 
     return obj;
 }
@@ -157,6 +220,7 @@ ip_new(VALUE self)
 static VALUE
 ip_eval(VALUE self, VALUE str)
 {
+    char *s;
     char *buf;			/* Tcl_Eval requires re-writable string region */
     struct tcltkip *ptr;	/* tcltkip data struct */
 
@@ -164,18 +228,162 @@ ip_eval(VALUE self, VALUE str)
     Data_Get_Struct(self, struct tcltkip, ptr);
 
     /* call Tcl_Eval() */
-    Check_Type(str, T_STRING);
-    buf = ALLOCA_N(char,RSTRING(str)->len+1);
-    strcpy(buf, RSTRING(str)->ptr);
+    s = STR2CSTR(str);
+    buf = ALLOCA_N(char, strlen(s)+1);
+    strcpy(buf, s);
     DUMP2("Tcl_Eval(%s)", buf);
     ptr->return_value = Tcl_Eval(ptr->ip, buf);
     if (ptr->return_value == TCL_ERROR) {
-	Fail(ptr->ip->result);
+	rb_raise(rb_eRuntimeError, ptr->ip->result);
     }
     DUMP2("(TCL_Eval result) %d", ptr->return_value);
 
     /* pass back the result (as string) */
-    return(str_new2(ptr->ip->result));
+    return(rb_str_new2(ptr->ip->result));
+}
+
+
+static VALUE
+ip_toUTF8(VALUE self, VALUE str, VALUE encodename)
+{
+#ifndef TCL_UTF_MAX
+  return str;
+#else
+  Tcl_Interp *interp;
+  Tcl_Encoding encoding;
+  Tcl_DString dstr;
+  struct tcltkip *ptr;
+  char *buff1,*buff2;
+
+  Data_Get_Struct(self,struct tcltkip, ptr);
+  interp = ptr->ip;
+
+  encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename));
+  buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1);
+  strcpy(buff1,STR2CSTR(str));
+
+  Tcl_DStringInit(&dstr);
+  Tcl_DStringFree(&dstr);
+  Tcl_ExternalToUtfDString(encoding,buff1,strlen(buff1),&dstr);
+  buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1);
+  strcpy(buff2,Tcl_DStringValue(&dstr));
+
+  Tcl_FreeEncoding(encoding);
+  Tcl_DStringFree(&dstr);
+
+  return rb_str_new2(buff2);
+#endif
+}
+
+static VALUE
+ip_fromUTF8(VALUE self, VALUE str, VALUE encodename)
+{
+#ifndef TCL_UTF_MAX
+  return str;
+#else
+  Tcl_Interp *interp;
+  Tcl_Encoding encoding;
+  Tcl_DString dstr;
+  struct tcltkip *ptr;
+  char *buff1,*buff2;
+
+  Data_Get_Struct(self,struct tcltkip, ptr);
+  interp = ptr->ip;
+
+  encoding = Tcl_GetEncoding(interp,STR2CSTR(encodename));
+  buff1 = ALLOCA_N(char,strlen(STR2CSTR(str))+1);
+  strcpy(buff1,STR2CSTR(str));
+
+  Tcl_DStringInit(&dstr);
+  Tcl_DStringFree(&dstr);
+  Tcl_UtfToExternalDString(encoding,buff1,strlen(buff1),&dstr);
+  buff2 = ALLOCA_N(char,Tcl_DStringLength(&dstr)+1);
+  strcpy(buff2,Tcl_DStringValue(&dstr));
+
+  Tcl_FreeEncoding(encoding);
+  Tcl_DStringFree(&dstr);
+
+  return rb_str_new2(buff2);
+#endif
+}
+
+
+static VALUE
+ip_invoke(int argc, VALUE *argv, VALUE obj)
+{
+    struct tcltkip *ptr;	/* tcltkip data struct */
+    int i;
+    int object = 0;
+    Tcl_CmdInfo info;
+    char *cmd;
+    char **av = (char **)NULL;
+#if TCL_MAJOR_VERSION >= 8
+    Tcl_Obj **ov = (Tcl_Obj **)NULL;
+    Tcl_Obj *resultPtr;
+#endif
+
+    /* get the data struct */
+    Data_Get_Struct(obj, struct tcltkip, ptr);
+
+    /* get the command name string */
+    cmd = STR2CSTR(argv[0]);
+
+    /* map from the command name to a C procedure */
+    if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) {
+	rb_raise(rb_eNameError, "invalid command name `%s'", cmd);
+    }
+#if TCL_MAJOR_VERSION >= 8
+    object = info.isNativeObjectProc;
+#endif
+
+    /* memory allocation for arguments of this command */
+    if (object) {
+#if TCL_MAJOR_VERSION >= 8
+      /* object interface */
+      ov = (Tcl_Obj **)ALLOCA_N(Tcl_Obj *, argc+1);
+      for (i = 0; i < argc; ++i) {
+	char *s = STR2CSTR(argv[i]);
+        ov[i] = Tcl_NewStringObj(s, strlen(s));
+      }
+      ov[argc] = (Tcl_Obj *)NULL;
+#endif
+    } else {
+      /* string interface */
+      av = (char **)ALLOCA_N(char *, argc+1);
+      for (i = 0; i < argc; ++i) {
+	char *s = STR2CSTR(argv[i]);
+
+        av[i] = ALLOCA_N(char, strlen(s)+1);
+	strcpy(av[i], s);
+      }
+      av[argc] = (char *)NULL;
+    }
+
+    Tcl_ResetResult(ptr->ip);
+
+    /* Invoke the C procedure */
+    if (object) {
+#if TCL_MAJOR_VERSION >= 8
+      int dummy;
+      ptr->return_value = (*info.objProc)(info.objClientData,
+					  ptr->ip, argc, ov);
+
+      /* get the string value from the result object */
+      resultPtr = Tcl_GetObjResult(ptr->ip);
+      Tcl_SetResult(ptr->ip, Tcl_GetStringFromObj(resultPtr, &dummy),
+		    TCL_VOLATILE);
+#endif
+    } else {
+      ptr->return_value = (*info.proc)(info.clientData,
+				       ptr->ip, argc, av);
+    }
+
+    if (ptr->return_value == TCL_ERROR) {
+	rb_raise(rb_eRuntimeError, ptr->ip->result);
+    }
+
+    /* pass back the result (as string) */
+    return(rb_str_new2(ptr->ip->result));
 }
 
 /* get return code from Tcl_Eval() */
@@ -190,27 +398,44 @@ ip_retval(VALUE self)
     return (INT2FIX(ptr->return_value));
 }
 
+#ifdef __MACOS__
+static void
+_macinit()
+{
+  tcl_macQdPtr = &qd; /* setup QuickDraw globals */
+  Tcl_MacSetEventProc(TkMacConvertEvent); /* setup event handler */
+}
+#endif
+
 /*---- initialization ----*/
 void Init_tcltklib()
 {
     extern VALUE rb_argv0;	/* the argv[0] */
 
     VALUE lib = rb_define_module("TclTkLib");
-    VALUE ip = rb_define_class("TclTkIp", cObject);
+    VALUE ip = rb_define_class("TclTkIp", rb_cObject);
+
+    eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
+    eTkCallbackContinue = rb_define_class("TkCallbackContinue",rb_eStandardError);
 
     rb_define_module_function(lib, "mainloop", lib_mainloop, 0);
 
     rb_define_singleton_method(ip, "new", ip_new, 0);
     rb_define_method(ip, "_eval", ip_eval, 1);
+    rb_define_method(ip, "_toUTF8",ip_toUTF8,2);
+    rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
+    rb_define_method(ip, "_invoke", ip_invoke, -1);
     rb_define_method(ip, "_return_value", ip_retval, 0);
     rb_define_method(ip, "mainloop", lib_mainloop, 0);
 
+#ifdef __MACOS__
+    _macinit();
+#endif
+
     /*---- initialize tcl/tk libraries ----*/
     /* from Tk_Main() */
     DUMP1("Tcl_FindExecutable");
     Tcl_FindExecutable(RSTRING(rb_argv0)->ptr);
-
-    rb_define_variable("$tk_thread_safe", &thread_safe);
 }
 
 /* eof */