This commit was generated by cvs2svn to compensate for changes in r372,

which included commits to RCS files with non-trunk default branches. git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@373 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
author: matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> 1999-01-20 04:59:39 +0000
committer: matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> 1999-01-20 04:59:39 +0000
commit: 210367ec889f5910e270d6ea2c7ddb8a8d939e61 (patch)
tree: feb35473da45947378fbc02defe39bcd79ef600e /ext/tcltklib
parent: 9c5b1986a36c7a700b4c76817e35aa874ba7907c (diff)
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 [email protected]?(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 */
author	matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>	1999-01-20 04:59:39 +0000
committer	matz <matz@b2dd03c8-39d4-4d8f-98ff-823fe69b080e>	1999-01-20 04:59:39 +0000
commit	210367ec889f5910e270d6ea2c7ddb8a8d939e61 (patch)
tree	feb35473da45947378fbc02defe39bcd79ef600e /ext/tcltklib
parent	9c5b1986a36c7a700b4c76817e35aa874ba7907c (diff)