From 24ff3f444882ba60418a6736d6c5d57ba3c0b80c Mon Sep 17 00:00:00 2001 From: nagai Date: Fri, 29 Aug 2003 08:34:14 +0000 Subject: * doc/ChangeLog-1.8.0: add changes of Ruby/Tk * ext/tcltklib/tcltklib.c : some methods have no effect if on slave-IP * ext/tcltklib/tcltklib.c : can create a interpreter without Tk * ext/tcltklib/tcltklib.c : bug fix on handling exceptions * ext/tcltklib/MANUAL.euc : modify * ext/tk/lib/tk.rb : freeze some core modules * ext/tk/lib/multi-tk.rb : more secure * ext/tk/lib/tk.rb: TkVariable.new(array) --> treat the array as the Tk's list * ext/tk/lib/tk.rb: improve accessibility of TkVariable object * ext/tk/lib/tk.rb, ext/tk/lib/tkfont.rb, ext/tk/lib/tkcanvas.rb, ext/tk/lib/tktext.rb : fix bug of font handling * ext/tk/lib/tkfont.rb TkFont.new() accepts compound fonts * process.c: bug fix * process.c: add rb_secure(2) to methods of Process::{UID,GID,Sys} * process.c: deny handling IDs during evaluating the block given to the Process::{UID,GID}.switch method git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4456 b2dd03c8-39d4-4d8f-98ff-823fe69b080e --- ext/tcltklib/MANUAL.euc | 40 +++++-- ext/tcltklib/tcltklib.c | 304 +++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 289 insertions(+), 55 deletions(-) (limited to 'ext/tcltklib') diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc index 30cfd8c107..f04d036c64 100644 --- a/ext/tcltklib/MANUAL.euc +++ b/ext/tcltklib/MANUAL.euc @@ -1,5 +1,5 @@ (tof) - 2003/07/25 Hidetoshi NAGAI + 2003/08/07 Hidetoshi NAGAI 本ドキュメントには古い tcltk ライブラリ，tcltklib ライブラリの説明 が含まれていますが，その記述内容は古いものとなっています． @@ -263,6 +263,12 @@ require "tcltklib" : Tk インタープリタ上で例外を発生した際に，イベントループをエ : ラー停止させるかどうかの設定状態を true/false で得る． + num_of_mainwindows + : 現在のメインウィンドウ (ルートウィジェット) の数を返す． + : メインウィンドウは一つのインタープリタに付き最大一つである + : ので，この値は現在 Tk の機能が有効であるインタープリタの総 + : 数に等しい． + クラス TclTkIp クラスメソッド @@ -274,6 +280,11 @@ require "tcltklib" : 引数として与えるオプションと同様の情報を文字列として与える． : 与えられた情報は，root widget 生成の際に用いられる． : ( e.g. TclTkIp.new('FOO', '-geometry 500x200 -use 0x2200009') ) + : もし options に敢えて nil または false を与えた場合，Tk ライ + : ブラリが導入されていない (つまりは Tcl のみの) インタープリ + : タを生成する．この場合は GUI 環境は必要ないため，ウインドウ + : システムが存在しない，または使用できない環境でも Tcl インター + : プリタを生成し，Tcl やその拡張ライブラリを活用することができる． インスタンスメソッド create_slave(name, safe=false) @@ -331,17 +342,26 @@ require "tcltklib" _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 に同じ + mainloop + mainloop_watchdog + : スレーブ IP の場合にはイベントループを起動せずに nil を返す． + : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． + + do_one_event + : スレーブ IP の場合には引数のイベントフラグに DONT_WAIT が + : 強制的に追加される (イベント待ちでスリープすることは禁止)． + : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． + + set_eventloop_tick + get_eventloop_tick + set_no_event_wait + get_no_event_wait + set_eventloop_weight + get_eventloop_weight mainloop_abort_on_exception - : 引数を含めて TclTkLib.mainloop_abort_on_exception に同じ mainloop_abort_on_exception= - : 引数を含めて TclTkLib.mainloop_abort_on_exception= に同じ + : スレーブ IP の場合には値の設定が許されない (無視される)． + : それ以外の点では引数を含めて TclTkLib の同名メソッドに同じ． クラス TkCallbackBreak < StandardError クラス TkCallbackContinue < StandardError diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index ec00cea217..cb2036296a 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -8,6 +8,13 @@ #include "rubysig.h" #undef EXTERN /* avoid conflict with tcl.h of tcl8.2 or before */ #include +#ifdef HAVE_STDARG_PROTOTYPES +#include +#define va_init_list(a,b) va_start(a,b) +#else +#include +#define va_init_list(a,b) va_start(a) +#endif #include #include #include @@ -93,6 +100,25 @@ static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*)); static int ip_ruby _((ClientData, Tcl_Interp *, int, char **)); #endif +/*---- class TclTkIp ----*/ +struct tcltkip { + Tcl_Interp *ip; /* the interpreter */ + int return_value; /* return value */ +}; + +static struct tcltkip * +get_ip(self) + VALUE self; +{ + struct tcltkip *ptr; + + Data_Get_Struct(self, struct tcltkip, ptr); + if (ptr == 0) { + rb_raise(rb_eTypeError, "uninitialized TclTkIp"); + } + return ptr; +} + /* Tk_ThreadTimer */ static Tcl_TimerToken timer_token = (Tcl_TimerToken)NULL; @@ -155,6 +181,27 @@ get_eventloop_tick(self) return INT2NUM(timer_tick); } +static VALUE +ip_set_eventloop_tick(self, tick) + VALUE self; + VALUE tick; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return get_eventloop_tick(self); + } + return set_eventloop_tick(self, tick); +} + +static VALUE +ip_get_eventloop_tick(self) + VALUE self; +{ + return get_eventloop_tick(self); +} + static VALUE set_no_event_wait(self, wait) VALUE self; @@ -179,6 +226,27 @@ get_no_event_wait(self) return INT2NUM(no_event_wait); } +static VALUE +ip_set_no_event_wait(self, wait) + VALUE self; + VALUE wait; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return get_no_event_wait(self); + } + return set_no_event_wait(self, wait); +} + +static VALUE +ip_get_no_event_wait(self) + VALUE self; +{ + return get_no_event_wait(self); +} + static VALUE set_eventloop_weight(self, loop_max, no_event) VALUE self; @@ -206,7 +274,29 @@ get_eventloop_weight(self) } static VALUE -rb_evloop_abort_on_exc(self) +ip_set_eventloop_weight(self, loop_max, no_event) + VALUE self; + VALUE loop_max; + VALUE no_event; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return get_eventloop_weight(self); + } + return set_eventloop_weight(self, loop_max, no_event); +} + +static VALUE +ip_get_eventloop_weight(self) + VALUE self; +{ + return get_eventloop_weight(self); +} + +static VALUE +lib_evloop_abort_on_exc(self) VALUE self; { if (event_loop_abort_on_exc > 0) { @@ -219,7 +309,14 @@ rb_evloop_abort_on_exc(self) } static VALUE -rb_evloop_abort_on_exc_set(self, val) +ip_evloop_abort_on_exc(self) + VALUE self; +{ + return lib_evloop_abort_on_exc(self); +} + +static VALUE +lib_evloop_abort_on_exc_set(self, val) VALUE self, val; { rb_secure(4); @@ -230,7 +327,27 @@ rb_evloop_abort_on_exc_set(self, val) } else { event_loop_abort_on_exc = 0; } - return rb_evloop_abort_on_exc(self); + return lib_evloop_abort_on_exc(self); +} + +static VALUE +ip_evloop_abort_on_exc_set(self, val) + VALUE self, val; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return lib_evloop_abort_on_exc(self); + } + return lib_evloop_abort_on_exc_set(self, val); +} + +static VALUE +lib_num_of_mainwindows(self) + VALUE self; +{ + return INT2FIX(Tk_GetNumMainWindows()); } VALUE @@ -379,6 +496,21 @@ lib_mainloop(argc, argv, self) return lib_mainloop_launcher(check_rootwidget); } +static VALUE +ip_mainloop(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return Qnil; + } + return lib_mainloop(argc, argv, self); +} + VALUE lib_watchdog_core(check_rootwidget) VALUE check_rootwidget; @@ -464,10 +596,26 @@ lib_mainloop_watchdog(argc, argv, self) } static VALUE -lib_do_one_event(argc, argv, self) +ip_mainloop_watchdog(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return Qnil; + } + return lib_mainloop_watchdog(argc, argv, self); +} + +static VALUE +lib_do_one_event_core(argc, argv, self, is_ip) int argc; VALUE *argv; VALUE self; + int is_ip; { VALUE vflags; int flags; @@ -479,6 +627,16 @@ lib_do_one_event(argc, argv, self) Check_Type(vflags, T_FIXNUM); flags = FIX2INT(vflags); } + + if (is_ip) { + /* check IP */ + struct tcltkip *ptr = get_ip(self); + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + flags |= TCL_DONT_WAIT; + } + } + ret = Tcl_DoOneEvent(flags); if (ret) { return Qtrue; @@ -487,25 +645,25 @@ lib_do_one_event(argc, argv, self) } } -/*---- class TclTkIp ----*/ -struct tcltkip { - Tcl_Interp *ip; /* the interpreter */ - int return_value; /* return value */ -}; - -static struct tcltkip * -get_ip(self) +static VALUE +lib_do_one_event(argc, argv, self) + int argc; + VALUE *argv; VALUE self; { - struct tcltkip *ptr; + return lib_do_one_event_core(argc, argv, self, 0); +} - Data_Get_Struct(self, struct tcltkip, ptr); - if (ptr == 0) { - rb_raise(rb_eTypeError, "uninitialized TclTkIp"); - } - return ptr; +static VALUE +ip_do_one_event(argc, argv, self) + int argc; + VALUE *argv; + VALUE self; +{ + return lib_do_one_event_core(argc, argv, self, 0); } + /* Tcl command `ruby' */ static VALUE ip_eval_rescue(failed, einfo) @@ -551,6 +709,19 @@ lib_restart(self) return Qnil; } +static VALUE +ip_restart(self) + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_GetMaster(ptr->ip) != (Tcl_Interp*)NULL) { + /* slave IP */ + return Qnil; + } + return lib_restart(self); +} + static int #if TCL_MAJOR_VERSION >= 8 ip_ruby(clientData, interp, argc, argv) @@ -651,6 +822,7 @@ ip_init(argc, argv, self) struct tcltkip *ptr; /* tcltkip data struct */ VALUE argv0, opts; int cnt; + int with_tk = 1; /* create object */ Data_Get_Struct(self, struct tcltkip, ptr); @@ -675,7 +847,12 @@ ip_init(argc, argv, self) switch(cnt) { case 2: /* options */ - Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0); + if (opts == Qnil || opts == Qfalse) { + /* without Tk */ + with_tk = 0; + } else { + Tcl_SetVar(ptr->ip, "argv", StringValuePtr(opts), 0); + } case 1: /* argv0 */ if (argv0 != Qnil) { @@ -687,17 +864,19 @@ ip_init(argc, argv, self) } /* from Tcl_AppInit() */ - DUMP1("Tk_Init"); - if (Tk_Init(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); - } - DUMP1("Tcl_StaticPackage(\"Tk\")"); + if (with_tk) { + DUMP1("Tk_Init"); + if (Tk_Init(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } + DUMP1("Tcl_StaticPackage(\"Tk\")"); #if TCL_MAJOR_VERSION >= 8 - Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit); + Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, Tk_SafeInit); #else - Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, - (Tcl_PackageInitProc *) NULL); + Tcl_StaticPackage(ptr->ip, "Tk", Tk_Init, + (Tcl_PackageInitProc *) NULL); #endif + } /* add ruby command to the interpreter */ #if TCL_MAJOR_VERSION >= 8 @@ -900,6 +1079,32 @@ ip_fromUTF8(self, str, encodename) } +static VALUE +#ifdef HAVE_STDARG_PROTOTYPES +create_ip_exc(VALUE interp, VALUE exc, const char *fmt, ...) +#else +create_ip_exc(interp, exc, fmt, va_alist) + VALUE interp: + VALUE exc; + const char *fmt; + va_dcl +#endif +{ + va_list args; + char buf[BUFSIZ]; + VALUE einfo; + + va_init_list(args,fmt); + vsnprintf(buf, BUFSIZ, fmt, args); + buf[BUFSIZ - 1] = '\0'; + va_end(args); + einfo = rb_exc_new2(exc, buf); + rb_iv_set(einfo, "interp", interp); + Tcl_ResetResult(get_ip(interp)->ip); + return einfo; +} + + static VALUE ip_invoke_real(argc, argv, obj) int argc; @@ -934,7 +1139,9 @@ ip_invoke_real(argc, argv, obj) if (!Tcl_GetCommandInfo(ptr->ip, cmd, &info)) { /* if (event_loop_abort_on_exc || cmd[0] != '.') { */ if (event_loop_abort_on_exc > 0) { - rb_raise(rb_eNameError, "invalid command name `%s'", cmd); + /*rb_ip_raise(obj, rb_eNameError, "invalid command name `%s'", cmd);*/ + return create_ip_exc(obj, rb_eNameError, + "invalid command name `%s'", cmd); } else { if (event_loop_abort_on_exc < 0) { rb_warning("invalid command name `%s' (ignore)", cmd); @@ -1021,7 +1228,8 @@ ip_invoke_real(argc, argv, obj) /* exception on mainloop */ if (ptr->return_value == TCL_ERROR) { if (event_loop_abort_on_exc > 0 && !Tcl_InterpDeleted(ptr->ip)) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + /*rb_ip_raise(obj, rb_eRuntimeError, "%s", ptr->ip->result);*/ + return create_ip_exc(obj, rb_eRuntimeError, "%s", ptr->ip->result); } else { if (event_loop_abort_on_exc < 0) { rb_warning("%s (ignore)", ptr->ip->result); @@ -1137,6 +1345,9 @@ ip_invoke(argc, argv, obj) /* get result & free allocated memory */ result = *alloc_result; + if (rb_obj_is_kind_of(result, rb_eException)) { + rb_exc_raise(result); + } free(alloc_argv); free(alloc_result); @@ -1197,6 +1408,10 @@ Init_tcltklib() rb_define_module_function(lib, "mainloop_watchdog", lib_mainloop_watchdog, -1); rb_define_module_function(lib, "do_one_event", lib_do_one_event, -1); + rb_define_module_function(lib, "mainloop_abort_on_exception", + lib_evloop_abort_on_exc, 0); + rb_define_module_function(lib, "mainloop_abort_on_exception=", + lib_evloop_abort_on_exc_set, 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); @@ -1205,10 +1420,8 @@ Init_tcltklib() set_eventloop_weight, 2); rb_define_module_function(lib, "get_eventloop_weight", get_eventloop_weight, 0); - rb_define_module_function(lib, "mainloop_abort_on_exception", - rb_evloop_abort_on_exc, 0); - rb_define_module_function(lib, "mainloop_abort_on_exception=", - rb_evloop_abort_on_exc_set, 1); + rb_define_module_function(lib, "num_of_mainwindows", + lib_num_of_mainwindows, 0); rb_define_alloc_func(ip, ip_alloc); rb_define_method(ip, "initialize", ip_init, -1); @@ -1222,20 +1435,21 @@ Init_tcltklib() 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, -1); - rb_define_method(ip, "mainloop_watchdog", lib_mainloop_watchdog, -1); - rb_define_method(ip, "do_one_event", lib_do_one_event, -1); + + rb_define_method(ip, "mainloop", ip_mainloop, -1); + rb_define_method(ip, "mainloop_watchdog", ip_mainloop_watchdog, -1); + rb_define_method(ip, "do_one_event", ip_do_one_event, -1); rb_define_method(ip, "mainloop_abort_on_exception", - rb_evloop_abort_on_exc, 0); + ip_evloop_abort_on_exc, 0); rb_define_method(ip, "mainloop_abort_on_exception=", - rb_evloop_abort_on_exc_set, 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); + ip_evloop_abort_on_exc_set, 1); + rb_define_method(ip, "set_eventloop_tick", ip_set_eventloop_tick, 1); + rb_define_method(ip, "get_eventloop_tick", ip_get_eventloop_tick, 0); + rb_define_method(ip, "set_no_event_wait", ip_set_no_event_wait, 1); + rb_define_method(ip, "get_no_event_wait", ip_get_no_event_wait, 0); + rb_define_method(ip, "set_eventloop_weight", ip_set_eventloop_weight, 2); + rb_define_method(ip, "get_eventloop_weight", ip_get_eventloop_weight, 0); + rb_define_method(ip, "restart", ip_restart, 0); eventloop_thread = 0; watchdog_thread = 0; -- cgit v1.2.3