From cc66b1fae449cd360ab33fbbe8b598510e3fec26 Mon Sep 17 00:00:00 2001 From: nagai Date: Fri, 25 Jul 2003 16:43:03 +0000 Subject: tcltklib.c : add TclTkIp#create_slave , TclTkIp#_make_safe and TclTkIp#safe? MANUAL.euc : modify descriptions tk.rb : bug fix [ruby-talk:76980] and modify to support multi Tk IPs tkafter.rb : modify to support multi Tk IPs git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4163 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tcltklib/MANUAL.euc | 39 +++++++++++++++++++++-- ext/tcltklib/tcltklib.c | 83 +++++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 110 insertions(+), 12 deletions(-) (limited to 'ext/tcltklib') diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc index 757cd40a4d..f44e491e46 100644 --- a/ext/tcltklib/MANUAL.euc +++ b/ext/tcltklib/MANUAL.euc @@ -1,5 +1,5 @@ (tof) - 2003/06/19 Hidetoshi NAGAI + 2003/07/25 Hidetoshi NAGAI 本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明 が含まれていますが，その記述内容は古いものとなっています． @@ -245,7 +245,35 @@ require "tcltklib" : ( see set_eventloop_wait ) クラス TclTkIp + クラスメソッド + new(ip_name=nil, options='') + : TclTkIp クラスのインスタンスを生成する． + : ip_name に文字列を与えた場合は，それが winfo interps などで + : 表示される名前になる． + : options には，-geometry や -use など，wish のコマンドライン + : 引数として与えるオプションと同様の情報を文字列として与える． + : 与えられた情報は，root widget 生成の際に用いられる． + : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') ) + インスタンスメソッド + create_slave(name, safe=false) + : レシーバを親とする name という名前のスレーブインタープリタを + : 生成する． + : safe には生成するインタープリタを safe インタープリタとする + : かを指定する．デフォルトは false ということになっているが， + : たとえ明確に false を指定していたとしても，親となるインター + : プリタが safe インタープリタであれば，その設定を引き継いで + : safe インタープリタとして生成される． + + make_safe + : Tcl/Tk インタープリタを safe インタープリタに変更する． + : 戻り値はレシーバであるインタープリタ自身である． + : 失敗した場合は RuntimeError の例外を発生する． + + safe? + : Tcl/Tk インタープリタを safe インタープリタであるかを調べる． + : safe インタープリタであれば true を返す． + restart : Tcl/Tk インタープリタの Tk 部分の初期化，再起動を行う． : 一旦 root widget を破壊した後に再度 Tk の機能が必要と @@ -258,8 +286,13 @@ require "tcltklib" : _invoke は評価スクリプトの token ごとに一つの引数とな : るように与える． : _invoke の方は Tcl/Tk インタープリタの字句解析器を用い - : ないため，評価の負荷がより少なくてすむ． - + : ないため，評価の負荷がより少なくてすむ．ただし，その代 + : わりに auto_load のような機構は働かず，load 等によって + : Tcl/Tk インタープリタ上に既に登録済みのコマンドしか呼 + : び出すことができない． + : _eval では auto_load 機構が働くため，一度 _eval を実行 + : して登録に成功しさえすれば，以降は _invoke でも利用で + : きるようになる． _toUTF8(str, encoding) _fromUTF8(str, encoding) diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index 5331e1fd03..9df98742b7 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -614,22 +614,22 @@ ip_init(argc, argv, self) cnt = rb_scan_args(argc, argv, "02", &argv0, &opts); switch(cnt) { case 2: - /* options */ - Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0); + /* options */ + Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0); case 1: - /* argv0 */ - if (argv0 != Qnil) { - Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0); - } + /* argv0 */ + if (argv0 != Qnil) { + Tcl_SetVar(ptr->ip, "argv0", StringValuePtr(argv0), 0); + } case 0: - /* no args */ - ; + /* no args */ + ; } /* from Tcl_AppInit() */ DUMP1("Tk_Init"); if (Tk_Init(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); } DUMP1("Tcl_StaticPackage(\"Tk\")"); #if TCL_MAJOR_VERSION >= 8 @@ -653,6 +653,68 @@ ip_init(argc, argv, self) return self; } +static VALUE +ip_create_slave(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + struct tcltkip *master = get_ip(self); + struct tcltkip *slave = ALLOC(struct tcltkip); + VALUE name; + VALUE safemode; + int safe; + + /* safe-mode check */ + if (rb_scan_args(argc, argv, "11", &name, &safemode) == 1) { + safemode = Qfalse; + } + if (Tcl_IsSafe(master->ip) == 1) { + safe = 1; + } else if (safemode == Qfalse || safemode == Qnil) { + safe = 0; + } else { + safe = 1; + } + + /* create slave-ip */ + if ((slave->ip = Tcl_CreateSlave(master->ip, StringValuePtr(name), safe)) + == NULL) { + rb_raise(rb_eRuntimeError, "fail to create the new slave interpreter"); + } + slave->return_value = 0; + + return Data_Wrap_Struct(CLASS_OF(self), 0, ip_free, slave); +} + +/* make ip "safe" */ +static VALUE +ip_make_safe(self) + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } + + return self; +} + +/* is safe? */ +static VALUE +ip_is_safe_p(self) + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_IsSafe(ptr->ip)) { + return Qtrue; + } else { + return Qfalse; + } +} + /* eval string in tcl by Tcl_Eval() */ static VALUE ip_eval(self, str) @@ -1012,6 +1074,9 @@ Init_tcltklib() rb_define_alloc_func(ip, ip_alloc); rb_define_method(ip, "initialize", ip_init, -1); + rb_define_method(ip, "create_slave", ip_create_slave, -1); + rb_define_method(ip, "make_safe", ip_make_safe, 0); + rb_define_method(ip, "safe?", ip_is_safe_p, 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); -- cgit v1.2.3