[ruby-dev:8676] embed Ruby/Tk root window in another window

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

ruby-list に書いた Ruby/Tk window の埋め込みの件に関するパッチです．
ruby-1.4.3 用になってます．
テストは以下のようにしてみてください．
Ruby/Tk が使える状況なら wish も使えるでしょうから，まず wish で，
-------------------------------------
% toplevel .top
% winfo id .top
-------------------------------------
とでもして埋め込み対象の window id を獲得しておきます．
ここではこのトップレベルウィジェットに埋め込むわけです．
仮に window id が 0x440001c であるとすると，
-------------------------------------
module TkCore
  TK_EMBEDDED_WINDOW = '0x440001c'
end
require 'tk'
TkButton.new(nil, 'text'=>'Ruby exit', 'command'=>proc{exit}).pack
Tk.mainloop
-------------------------------------
のようにすれば，wish のトップレベルウィジェット中に 
Ruby/Tk のボタンが生成されると思います．
TK_EMBEDDED_WINDOW の定義は require 'tk' の前でなければなりません．
require 'tk' で Tk のインタープリタが初期化されますが，
その際にチェックして，埋め込みにするのかどうかを決定しているためです．

Ruby/Tk Plugin を本当に実現するには，
Plugin API 関連の作成や security 関連の検討が必要ですが，
このパッチは，まぁ，それに向けての取り掛かりということで．(^_^)

パッチの対象ファイルは 3 個です．
----------< ext/tcltklib/tcltklib.c >-------------------------
--- tcltklib.c~	Tue Oct 12 18:11:28 1999
+++ tcltklib.c	Mon Dec 20 01:54:58 1999
@@ -198,11 +198,18 @@
 
 /* create and initialize interpreter */
 static VALUE
-ip_new(self)
+ip_new(argc, argv, self)
+    int argc;
+    VALUE argv[];
     VALUE self;
 {
     struct tcltkip *ptr;	/* tcltkip data struct */
     VALUE obj;			/* newly created object */
+    VALUE win_id;
+    char *s;
+
+    /* scan arguments */
+    rb_scan_args(argc, argv, "01", &win_id);
 
     /* create object */
     obj = Data_Make_Struct(self, struct tcltkip, 0, ip_free, ptr);
@@ -217,6 +224,34 @@
     if (Tcl_Init(ptr->ip) == TCL_ERROR) {
 	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
     }
+
+#if TCL_MAJOR_VERSION >= 8
+    /* embed Tk root window in another window */
+    if (argc == 1 && TYPE(win_id) == T_STRING) {
+      s = STR2CSTR(win_id);
+      if (strlen(s) > 0) {
+	char *buf;
+	char *esf = "set argv [list {-use} {";
+	char *est = "}]";
+
+	DUMP2("set embedded window-id(%s)", s);
+	buf = ALLOCA_N(char, strlen(esf) + strlen(s) + strlen(est) + 1);
+	strcpy(buf, esf);
+	strcat(buf, s);
+	strcat(buf, est);
+	ptr->return_value = Tcl_Eval(ptr->ip, buf);
+	if (ptr->return_value == TCL_ERROR) {
+	  rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+	}
+	ptr->return_value = Tcl_Eval(ptr->ip, "set argc 2");
+	if (ptr->return_value == TCL_ERROR) {
+	  rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
+	}
+      }
+    }
+#endif
+
+    /* from Tcl_AppInit() */
     DUMP1("Tk_Init");
     if (Tk_Init(ptr->ip) == TCL_ERROR) {
 	rb_raise(rb_eRuntimeError, "%s", ptr->ip->result);
@@ -499,7 +534,7 @@
 
     rb_define_module_function(lib, "mainloop", lib_mainloop, 0);
 
-    rb_define_singleton_method(ip, "new", ip_new, 0);
+    rb_define_singleton_method(ip, "new", ip_new, -1);
     rb_define_method(ip, "_eval", ip_eval, 1);
     rb_define_method(ip, "_toUTF8",ip_toUTF8,2);
     rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
-------------------------------------------------------------- 

----------< ext/tcltklib/lib/tcltk.rb >-----------------------
--- tcltk.rb~	Tue Oct 12 18:11:28 1999
+++ tcltk.rb	Mon Dec 20 01:21:56 1999
@@ -85,9 +85,9 @@
 class TclTkInterpreter
 
   # initialize(): 
-  def initialize()
+  def initialize(win_id = nil)
     # generate interpreter object
-    @ip = TclTkIp.new()
+    @ip = TclTkIp.new(win_id)
 
     # add ruby_fmt command to tcl interpreter
     # ruby_fmt command format arguments by `format' and call `ruby' command
-------------------------------------------------------------- 

----------< ext/tk/lib/tk.rb >--------------------------------
--- tk.rb~	Mon Dec  6 18:03:37 1999
+++ tk.rb	Mon Dec 20 01:41:33 1999
@@ -399,7 +399,11 @@
   include TkComm
   extend TkComm
 
-  INTERP = TclTkIp.new
+  if const_defined? 'TK_EMBEDDED_WINDOW'
+    INTERP = TclTkIp.new(TK_EMBEDDED_WINDOW)
+  else
+    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}")
 
-------------------------------------------------------------- 
-- 
                                         永井 秀利 （九工大 知能情報）
                                             [e-mail]