diff options
author | nagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2003-07-27 19:35:06 +0000 |
---|---|---|
committer | nagai <nagai@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2003-07-27 19:35:06 +0000 |
commit | b388591ab76c81eb2c7b4a5d66a840235f1365df (patch) | |
tree | d45ad5c93760b70162054cfc085ba34a86d698be /ext | |
parent | e4ffaf6ea862785cef27ec5bd1083d2622ff0121 (diff) |
multi-tk.rb : (new) library to support multiple Tk interpreters (high level)
tcltklib.c : add some methods to support multiple interpreters (low level)
MANUAL.euc : modify descriptions
tcltklib/sample/safeTk.rb : (new) sample : how to use safeTk interpreter
tk/sample/safe-tk.rb : (new) sample : how to use multi-tk.rb
tk.rb, tkafter.rb : bug fix and add feature to supprt multi-tk
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@4186 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'ext')
-rw-r--r-- | ext/tcltklib/MANIFEST | 5 | ||||
-rw-r--r-- | ext/tcltklib/MANUAL.euc | 35 | ||||
-rw-r--r-- | ext/tcltklib/demo/safeTk.rb | 22 | ||||
-rw-r--r-- | ext/tcltklib/tcltklib.c | 348 | ||||
-rw-r--r-- | ext/tk/MANIFEST | 2 | ||||
-rw-r--r-- | ext/tk/lib/README | 1 | ||||
-rw-r--r-- | ext/tk/lib/multi-tk.rb | 796 | ||||
-rw-r--r-- | ext/tk/lib/tk.rb | 7 | ||||
-rw-r--r-- | ext/tk/lib/tkafter.rb | 22 | ||||
-rw-r--r-- | ext/tk/sample/safe-tk.rb | 48 |
10 files changed, 1142 insertions, 144 deletions
diff --git a/ext/tcltklib/MANIFEST b/ext/tcltklib/MANIFEST index 4e37fb900f..7337bbeba5 100644 --- a/ext/tcltklib/MANIFEST +++ b/ext/tcltklib/MANIFEST @@ -6,11 +6,12 @@ stubs.c depend extconf.rb lib/tcltk.rb -demo/lines1.rb demo/lines0.tcl +demo/lines1.rb demo/lines2.rb +demo/safeTk.rb +sample/sample0.rb sample/sample1.rb sample/sample2.rb sample/maru.gif sample/batsu.gif -sample/sample0.rb diff --git a/ext/tcltklib/MANUAL.euc b/ext/tcltklib/MANUAL.euc index f44e491e46..9f52c1ea8f 100644 --- a/ext/tcltklib/MANUAL.euc +++ b/ext/tcltklib/MANUAL.euc @@ -244,6 +244,27 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です. : 現在の loop_max と no_event_tick との値を返す. : ( see set_eventloop_wait ) + mainloop_abort_on_no_widget_cmd=(bool) + : Tk インタープリタ上で widget に対応するコマンドが存在しない + : という例外を発生した際に,イベントループをエラー停止させる + : かどうかを指定する.true を指定した場合はエラー停止するが, + : false の場合は例外を無視してイベントループを継続する. + : デフォルトでは false に設定されている. + : これは,コールバック処理の消去を忘れたままに widget を破壊 + : してしまった場合のエラー停止の回避に役立つ.特に複数のイン + : タープリタが同時に動作している場合には,それらを管理するイ + : ベントループは 1 個であるため,いずれかのインタープリタが強 + : 制停止させられた際にコールバックの完全な消去に失敗する場合 + : がしばしば見られる.そのような場合でもエラーを無視してイベ + : ントループが稼働を続けることで,残りのインタープリタが正常 + : に動作し続けることができる. + + mainloop_abort_on_no_widget_cmd + : Tk インタープリタ上で widget に対応するコマンドが存在しない + : という例外を発生した際に,イベントループをエラー停止させる + : かどうかを設定状態を true/false で得る. + + クラス TclTkIp クラスメソッド new(ip_name=nil, options='') @@ -274,6 +295,16 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です. : Tcl/Tk インタープリタを safe インタープリタであるかを調べる. : safe インタープリタであれば true を返す. + delete + : Tcl/Tk インタープリタを delete する. + : delete されたインタープリタは,以後一切の操作ができなくなり, + : コマンドを送っても例外を発生するようになる. + + deleted? + : Tcl/Tk インタープリタがすでに delete されているかを調べる. + : delete 済みでコマンドを受け付けない状態になっているならば + : true を返す. + restart : Tcl/Tk インタープリタの Tk 部分の初期化,再起動を行う. : 一旦 root widget を破壊した後に再度 Tk の機能が必要と @@ -308,6 +339,10 @@ require "tcltklib" すると, 以下のモジュール, クラスが利用可能です. get_eventloop_tick : 引数を含めて TclTkLib.get_eventloop_tick に同じ set_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ get_eventloop_weight : 引数を含めて TclTkLib.set_eventloop_weight に同じ + mainloop_abort_on_no_widget_cmd= + : 引数を含めて TclTkLib.mainloop_abort_on_no_widget_cmd= に同じ + mainloop_abort_on_no_widget_cmd + : 引数を含めて TclTkLib.mainloop_abort_on_no_widget_cmd に同じ クラス TkCallbackBreak < StandardError クラス TkCallbackContinue < StandardError diff --git a/ext/tcltklib/demo/safeTk.rb b/ext/tcltklib/demo/safeTk.rb new file mode 100644 index 0000000000..5d2c60e700 --- /dev/null +++ b/ext/tcltklib/demo/safeTk.rb @@ -0,0 +1,22 @@ +#!/usr/bin/env ruby +require 'tcltklib' + +master = TclTkIp.new +slave_name = 'slave0' +slave = master.create_slave(slave_name, true) +master._eval("::safe::interpInit #{slave_name}") +master._eval("::safe::loadTk #{slave_name}") + +master._invoke('label', '.l1', '-text', 'master') +master._invoke('pack', '.l1', '-padx', '30', '-pady', '50') +master._eval('label .l2 -text {root widget of master-ip}') +master._eval('pack .l2 -padx 30 -pady 50') + +slave._invoke('label', '.l1', '-text', 'slave') +slave._invoke('pack', '.l1', '-padx', '30', '-pady', '50') +slave._eval('label .l2 -text {root widget of slave-ip}') +slave._eval('pack .l2 -padx 30 -pady 20') +slave._eval('label .l3 -text {( container frame widget of master-ip )}') +slave._eval('pack .l3 -padx 30 -pady 20') + +TclTkLib.mainloop diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c index 9df98742b7..bf258f6d9b 100644 --- a/ext/tcltklib/tcltklib.c +++ b/ext/tcltklib/tcltklib.c @@ -83,6 +83,8 @@ static int timer_tick = DEFAULT_TIMER_TICK; static int req_timer_tick = DEFAULT_TIMER_TICK; static int run_timer_flag = 0; +static int event_loop_abort_no_cmd = 0; +static int loop_counter = 0; #if TCL_MAJOR_VERSION >= 8 static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*)); @@ -108,10 +110,10 @@ _timer_for_tcl(clientData) run_timer_flag = 1; if (timer_tick > 0) { - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); + timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, + (ClientData)0); } else { - timer_token = (Tcl_TimerToken)NULL; + timer_token = (Tcl_TimerToken)NULL; } /* rb_thread_schedule(); */ @@ -126,8 +128,8 @@ set_eventloop_tick(self, tick) int ttick = NUM2INT(tick); if (ttick < 0) { - rb_raise(rb_eArgError, - "timer-tick parameter must be 0 or positive number"); + rb_raise(rb_eArgError, + "timer-tick parameter must be 0 or positive number"); } /* delete old timer callback */ @@ -135,11 +137,11 @@ set_eventloop_tick(self, tick) timer_tick = req_timer_tick = ttick; if (timer_tick > 0) { - /* start timer callback */ - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); + /* start timer callback */ + timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, + (ClientData)0); } else { - timer_token = (Tcl_TimerToken)NULL; + timer_token = (Tcl_TimerToken)NULL; } return tick; @@ -160,8 +162,8 @@ set_no_event_wait(self, wait) int t_wait = NUM2INT(wait); if (t_wait <= 0) { - rb_raise(rb_eArgError, - "no_event_wait parameter must be positive number"); + rb_raise(rb_eArgError, + "no_event_wait parameter must be positive number"); } no_event_wait = t_wait; @@ -186,7 +188,7 @@ set_eventloop_weight(self, loop_max, no_event) int no_ev = NUM2INT(no_event); if (lpmax <= 0 || no_ev <= 0) { - rb_raise(rb_eArgError, "weight parameters must be positive numbers"); + rb_raise(rb_eArgError, "weight parameters must be positive numbers"); } event_loop_max = lpmax; @@ -202,85 +204,110 @@ get_eventloop_weight(self) return rb_ary_new3(2, INT2NUM(event_loop_max), INT2NUM(no_event_tick)); } +static VALUE +rb_evloop_abort_no_cmd(self) + VALUE self; +{ + return event_loop_abort_no_cmd? Qtrue: Qfalse; +} + +static VALUE +rb_evloop_abort_no_cmd_set(self, val) + VALUE self, val; +{ + rb_secure(4); + event_loop_abort_no_cmd = (val == Qtrue)? 1: 0; + return rb_event_loop_abort_no_cmd(); +} + VALUE lib_mainloop_core(check_root_widget) - VALUE check_root_widget; + VALUE check_root_widget; { - VALUE current = eventloop_thread; - int check = (check_root_widget == Qtrue); - int tick_counter; - struct timeval t; - - t.tv_sec = (time_t)0; - t.tv_usec = (time_t)(no_event_wait*1000.0); - - Tk_DeleteTimerHandler(timer_token); - run_timer_flag = 0; - if (timer_tick > 0) { - timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, - (ClientData)0); - } else { - timer_token = (Tcl_TimerToken)NULL; - } + VALUE current = eventloop_thread; + int check = (check_root_widget == Qtrue); + int tick_counter; + struct timeval t; - for(;;) { - if (rb_thread_alone()) { - DUMP1("no other thread"); - if (timer_tick == 0) { - timer_tick = NO_THREAD_INTERRUPT_TIME; + t.tv_sec = (time_t)0; + t.tv_usec = (time_t)(no_event_wait*1000.0); + + Tk_DeleteTimerHandler(timer_token); + run_timer_flag = 0; + if (timer_tick > 0) { timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, (ClientData)0); - } - - Tcl_DoOneEvent(TCL_ALL_EVENTS); - - if (run_timer_flag) { - DUMP1("timer interrupt"); - run_timer_flag = 0; - DUMP1("check Root Widget"); - if (check && Tk_GetNumMainWindows() == 0) { - return Qnil; - } - } - } else { - DUMP1("there are other threads"); - timer_tick = req_timer_tick; - tick_counter = 0; - while(tick_counter < event_loop_max) { - if (Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)) { - tick_counter++; - } else { - tick_counter += no_event_tick; - - DUMP1("check Root Widget"); - if (check && Tk_GetNumMainWindows() == 0) { - return Qnil; - } - - rb_thread_wait_for(t); - } + timer_token = (Tcl_TimerToken)NULL; + } - if (watchdog_thread != 0 && eventloop_thread != current) { - return Qnil; - } + for(;;) { + if (rb_thread_alone()) { + DUMP1("no other thread"); + if (timer_tick == 0) { + timer_tick = NO_THREAD_INTERRUPT_TIME; + timer_token = Tk_CreateTimerHandler(timer_tick, + _timer_for_tcl, + (ClientData)0); + } + + Tcl_DoOneEvent(TCL_ALL_EVENTS); + + if (loop_counter++ > 30000) { + loop_counter = 0; + } + + if (run_timer_flag) { + DUMP1("timer interrupt"); + run_timer_flag = 0; + DUMP1("check Root Widget"); + if (check && Tk_GetNumMainWindows() == 0) { + return Qnil; + } + } - if (run_timer_flag) { - DUMP1("timer interrupt"); - run_timer_flag = 0; - break; /* switch to other thread */ + } else { + DUMP1("there are other threads"); + timer_tick = req_timer_tick; + tick_counter = 0; + while(tick_counter < event_loop_max) { + if (Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)) { + tick_counter++; + } else { + tick_counter += no_event_tick; + + DUMP1("check Root Widget"); + if (check && Tk_GetNumMainWindows() == 0) { + return Qnil; + } + + rb_thread_wait_for(t); + } + + if (loop_counter++ > 30000) { + loop_counter = 0; + } + + if (watchdog_thread != 0 && eventloop_thread != current) { + return Qnil; + } + + if (run_timer_flag) { + DUMP1("timer interrupt"); + run_timer_flag = 0; + break; /* switch to other thread */ + } + } + + DUMP1("check Root Widget"); + if (check && Tk_GetNumMainWindows() == 0) { + return Qnil; + } } - } - DUMP1("check Root Widget"); - if (check && Tk_GetNumMainWindows() == 0) { - return Qnil; - } + rb_thread_schedule(); } - - rb_thread_schedule(); - } - return Qnil; + return Qnil; } VALUE @@ -292,8 +319,8 @@ lib_mainloop_ensure(parent_evloop) DUMP2("mainloop-ensure: current-thread : %lx\n", rb_thread_current()); DUMP2("mainloop-ensure: eventloop-thread : %lx\n", eventloop_thread); if (eventloop_thread == rb_thread_current()) { - DUMP2("tcltklib: eventloop-thread -> %lx\n", parent_evloop); - eventloop_thread = parent_evloop; + DUMP2("tcltklib: eventloop-thread -> %lx\n", parent_evloop); + eventloop_thread = parent_evloop; } return Qnil; } @@ -307,8 +334,8 @@ lib_mainloop_launcher(check_rootwidget) eventloop_thread = rb_thread_current(); if (ruby_debug) { - fprintf(stderr, "tcltklib: eventloop-thread : %lx -> %lx\n", - parent_evloop, eventloop_thread); + fprintf(stderr, "tcltklib: eventloop-thread : %lx -> %lx\n", + parent_evloop, eventloop_thread); } return rb_ensure(lib_mainloop_core, check_rootwidget, @@ -325,11 +352,11 @@ lib_mainloop(argc, argv, self) VALUE check_rootwidget; if (rb_scan_args(argc, argv, "01", &check_rootwidget) == 0) { - check_rootwidget = Qtrue; + check_rootwidget = Qtrue; } else if (RTEST(check_rootwidget)) { - check_rootwidget = Qtrue; + check_rootwidget = Qtrue; } else { - check_rootwidget = Qfalse; + check_rootwidget = Qfalse; } return lib_mainloop_launcher(check_rootwidget); @@ -342,36 +369,37 @@ lib_watchdog_core(check_rootwidget) VALUE current = eventloop_thread; VALUE evloop; int check = (check_rootwidget == Qtrue); - ID stop = rb_intern("stop?"); + int prev_val = -1; struct timeval t; + VALUE ret; t.tv_sec = (time_t)0; t.tv_usec = (time_t)((WATCHDOG_INTERVAL)*1000.0); /* check other watchdog thread */ if (watchdog_thread != 0) { - if (rb_funcall(watchdog_thread, stop, 0) == Qtrue) { - rb_funcall(watchdog_thread, rb_intern("kill"), 0); - } else { - return Qnil; - } + if (rb_funcall(watchdog_thread, rb_intern("stop?"), 0) == Qtrue) { + rb_funcall(watchdog_thread, rb_intern("kill"), 0); + } else { + return Qnil; + } } watchdog_thread = rb_thread_current(); /* watchdog start */ do { - if (eventloop_thread == 0 - || rb_funcall(eventloop_thread, stop, 0) == Qtrue) { - /* start new eventloop thread */ - DUMP2("eventloop thread %lx is sleeping or dead", eventloop_thread); - evloop = rb_thread_create(lib_mainloop_launcher, - (void*)&check_rootwidget); - DUMP2("create new eventloop thread %lx", evloop); - rb_thread_run(evloop); - } else { - rb_thread_wait_for(t); - /* rb_thread_schedule(); */ - } + if (eventloop_thread == 0 || loop_counter == prev_val) { + /* start new eventloop thread */ + DUMP2("eventloop thread %lx is sleeping or dead", + eventloop_thread); + evloop = rb_thread_create(lib_mainloop_launcher, + (void*)&check_rootwidget); + DUMP2("create new eventloop thread %lx", evloop); + rb_thread_run(evloop); + } else { + rb_thread_wait_for(t); + /* rb_thread_schedule(); */ + } } while(!check || Tk_GetNumMainWindows() != 0); return Qnil; @@ -394,11 +422,11 @@ lib_mainloop_watchdog(argc, argv, self) VALUE check_rootwidget; if (rb_scan_args(argc, argv, "01", &check_rootwidget) == 0) { - check_rootwidget = Qtrue; + check_rootwidget = Qtrue; } else if (RTEST(check_rootwidget)) { - check_rootwidget = Qtrue; + check_rootwidget = Qtrue; } else { - check_rootwidget = Qfalse; + check_rootwidget = Qfalse; } return rb_ensure(lib_watchdog_core, check_rootwidget, @@ -416,16 +444,16 @@ lib_do_one_event(argc, argv, self) int ret; if (rb_scan_args(argc, argv, "01", &vflags) == 0) { - flags = TCL_ALL_EVENTS; + flags = TCL_ALL_EVENTS; } else { - Check_Type(vflags, T_FIXNUM); - flags = FIX2INT(vflags); + Check_Type(vflags, T_FIXNUM); + flags = FIX2INT(vflags); } ret = Tcl_DoOneEvent(flags); if (ret) { - return Qtrue; + return Qtrue; } else { - return Qfalse; + return Qfalse; } } @@ -473,15 +501,15 @@ lib_restart(self) /* execute Tk_Init of Tk_SafeInit */ #if TCL_MAJOR_VERSION >= 8 if (Tcl_IsSafe(ptr->ip)) { - DUMP1("Tk_SafeInit"); - if (Tk_SafeInit(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); - } + DUMP1("Tk_SafeInit"); + if (Tk_SafeInit(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } } else { - DUMP1("Tk_Init"); - if (Tk_Init(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); - } + DUMP1("Tk_Init"); + if (Tk_Init(ptr->ip) == TCL_ERROR) { + rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + } } #else DUMP1("Tk_Init"); @@ -569,6 +597,7 @@ ip_free(ptr) { DUMP1("Tcl_DeleteInterp"); if (ptr) { + Tcl_Release((ClientData)ptr->ip); Tcl_DeleteInterp(ptr->ip); free(ptr); } @@ -602,6 +631,7 @@ ip_init(argc, argv, self) /* from Tk_Main() */ DUMP1("Tcl_CreateInterp"); ptr->ip = Tcl_CreateInterp(); + Tcl_Preserve((ClientData)ptr->ip); current_interp = ptr->ip; /* from Tcl_AppInit() */ @@ -680,8 +710,10 @@ ip_create_slave(argc, argv, self) /* 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"); + rb_ip_raise(self, rb_eRuntimeError, + "fail to create the new slave interpreter"); } + Tcl_Preserve((ClientData)slave->ip); slave->return_value = 0; return Data_Wrap_Struct(CLASS_OF(self), 0, ip_free, slave); @@ -695,7 +727,7 @@ ip_make_safe(self) struct tcltkip *ptr = get_ip(self); if (Tcl_MakeSafe(ptr->ip) == TCL_ERROR) { - rb_raise(rb_eRuntimeError, "%s", ptr->ip->result); + rb_ip_raise(self, rb_eRuntimeError, "%s", ptr->ip->result); } return self; @@ -715,6 +747,32 @@ ip_is_safe_p(self) } } +/* delete interpreter */ +static VALUE +ip_delete(self) + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + Tcl_DeleteInterp(ptr->ip); + + return Qnil; +} + +/* is deleted? */ +static VALUE +ip_is_deleted_p(self) + VALUE self; +{ + struct tcltkip *ptr = get_ip(self); + + if (Tcl_InterpDeleted(ptr->ip)) { + return Qtrue; + } else { + return Qfalse; + } +} + /* eval string in tcl by Tcl_Eval() */ static VALUE ip_eval(self, str) @@ -722,7 +780,7 @@ ip_eval(self, str) VALUE str; { char *s; - char *buf; /* Tcl_Eval requires re-writable string region */ + char *buf; /* Tcl_Eval requires re-writable string region */ struct tcltkip *ptr = get_ip(self); /* call Tcl_Eval() */ @@ -741,7 +799,6 @@ ip_eval(self, str) return(rb_tainted_str_new2(ptr->ip->result)); } - static VALUE ip_toUTF8(self, str, encodename) VALUE self; @@ -838,9 +895,21 @@ ip_invoke_real(argc, argv, obj) v = argv[0]; cmd = StringValuePtr(v); + /* ip is deleted? */ + if (Tcl_InterpDeleted(ptr->ip)) { + Tcl_ResetResult(ptr->ip); + return rb_tainted_str_new2(""); + } + /* 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 (event_loop_abort_no_cmd || cmd[0] != '.') + rb_raise(rb_eNameError, "invalid command name `%s'", cmd); + else { + Tcl_ResetResult(ptr->ip); + rb_warning("invalid command name `%s' (ignore)", cmd); + return rb_tainted_str_new2(""); + } } /* memory allocation for arguments of this command */ @@ -859,7 +928,7 @@ ip_invoke_real(argc, argv, obj) else #endif { - /* string interface */ + /* string interface */ av = (char **)ALLOCA_N(char *, argc+1); for (i = 0; i < argc; ++i) { v = argv[i]; @@ -931,8 +1000,8 @@ invoke_queue_handler(evPtr, flags) DUMP2("added by thread : %lx", q->thread); if (q->done) { - /* processed by another event-loop */ - return 0; + /* processed by another event-loop */ + return 0; } /* process it */ @@ -940,11 +1009,12 @@ invoke_queue_handler(evPtr, flags) /* check safe-level */ if (rb_safe_level() != q->safe_level) { - *(q->result) = rb_funcall(rb_proc_new(ivq_safelevel_handler, - Data_Wrap_Struct(rb_cData,0,0,q)), - rb_intern("call"), 0); + *(q->result) + = rb_funcall(rb_proc_new(ivq_safelevel_handler, + Data_Wrap_Struct(rb_cData,0,0,q)), + rb_intern("call"), 0); } else { - *(q->result) = ip_invoke_real(q->argc, q->argv, q->obj); + *(q->result) = ip_invoke_real(q->argc, q->argv, q->obj); } /* back to caller */ @@ -970,8 +1040,8 @@ ip_invoke(argc, argv, obj) rb_raise(rb_eArgError, "command name missing"); } if (eventloop_thread == 0 || current == eventloop_thread) { - DUMP2("invoke from current eventloop %lx", current); - return ip_invoke_real(argc, argv, obj); + DUMP2("invoke from current eventloop %lx", current); + return ip_invoke_real(argc, argv, obj); } DUMP2("invoke from thread %lx (NOT current eventloop)", current); @@ -1071,12 +1141,18 @@ 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_no_widget_cmd", + rb_evloop_abort_no_cmd, 0); + rb_define_module_function(lib, "mainloop_abort_on_no_widget_cmd=", + rb_evloop_abort_no_cmd_set, 1); 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, "delete", ip_delete, 0); + rb_define_method(ip, "deleted?", ip_is_deleted_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); @@ -1085,6 +1161,10 @@ Init_tcltklib() 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_abort_on no_widget_cmd", + rb_evloop_abort_no_cmd, 0); + rb_define_method(ip, "mainloop_abort_on_no_widget_cmd=", + rb_evloop_abort_no_cmd_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); diff --git a/ext/tk/MANIFEST b/ext/tk/MANIFEST index def3d3ddb0..d744c87349 100644 --- a/ext/tk/MANIFEST +++ b/ext/tk/MANIFEST @@ -3,6 +3,7 @@ extconf.rb depend tkutil.c lib/README +lib/multi-tk.rb lib/tk.rb lib/tkafter.rb lib/tkbgerror.rb @@ -20,6 +21,7 @@ lib/tkscrollbox.rb lib/tktext.rb lib/tkvirtevent.rb lib/tkwinpkg.rb +sample/safe-tk.rb sample/tkbiff.rb sample/tkbrowse.rb sample/tkdialog.rb diff --git a/ext/tk/lib/README b/ext/tk/lib/README index 73beaf6414..c003adb2c8 100644 --- a/ext/tk/lib/README +++ b/ext/tk/lib/README @@ -1,4 +1,5 @@ README this file +multi-tk.rb multiple Tk interpreter (included safe-Tk) support tk.rb Tk interface tkafter.rb handles Tcl after tkbgerror.rb Tk error module diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb new file mode 100644 index 0000000000..808370e05f --- /dev/null +++ b/ext/tk/lib/multi-tk.rb @@ -0,0 +1,796 @@ +# +# multi-tk.rb - supports multi Tk interpreters +# by Hidetoshi NAGAI <nagai@ai.kyutech.ac.jp> + +require 'tcltklib' +require 'thread' + +################################################ +# exceptiopn to treat the return value from IP +class MultiTkIp_OK < Exception + def self.send(thred, ret=nil) + thread.raise self.new(ret) + end + + def initialize(ret=nil) + super('succeed') + @return_value = ret + end + + attr_reader :return_value + alias value return_value +end +MultiTkIp_OK.freeze + +################################################ +# methods for construction +class MultiTkIp + SLAVE_IP_ID = ['slave'.freeze, '00000'] + + @@IP_TABLE = {} + + @@INIT_IP_ENV = [] # table of Procs + @@ADD_TK_PROCS = [] # table of [name, args, body] + + @@TK_TABLE_LIST = [] + + @@TK_CMD_TBL = {} + + ###################################### + + @@CB_ENTRY_CLASS = Class.new{|c| + def initialize(ip, cmd) + @ip = ip + @cmd = cmd + end + attr_reader :ip, :cmd + def call(*args) + begin + unless @ip.deleted? + @ip.cb_eval(@cmd, *args) + end + rescue TkCallbackBreak, TkCallbackContinue + fail + rescue Exception + end + end + } + + ###################################### + + def _keys2opts(keys) + keys.collect{|k,v| "-#{k} #{v}"}.join(' ') + end + private :_keys2opts + + def _check_and_return(thread, exception, wait=3) + # wait to stop the caller thread + return nil unless thread + wait.times{ + if thread.stop? + # ready to send exception + thread.raise exception + return thread + end + + # wait + Thread.pass + } + + # unexpected error + thread.raise RuntimeError, "the thread may not wait for the return value" + return thread + end + + def _create_receiver_and_watchdog() + # command-procedures receiver + receiver = Thread.new{ + loop do + thread, cmd, *args = @cmd_queue.deq + begin + ret = cmd.call(*args) + rescue Exception => e + # raise exception + _check_and_return(thread, e) + else + # no exception + _check_and_return(thread, MultiTkIp_OK.new(ret)) + end + end + } + + # watchdog of receiver + watchdog = Thread.new{ + begin + receiver.join + rescue Exception + # ignore all kind of Exception + end + # receiver is dead + loop do + thread, cmd, *args = @cmd_queue.deq + next unless thread + if thread.alive? + if @interp.deleted? + thread.raise RuntimeError, 'the interpreter is already deleted' + else + thread.raise RuntimeError, + 'the interpreter no longer receives command procedures' + end + end + end + } + + # return threads + [receiver, watchdog] + end + private :_check_and_return, :_create_receiver_and_watchdog + + ###################################### + + if self.const_defined? :DEFAULT_MASTER_NAME + name = DEFAULT_MASTER_NAME.to_s + else + name = nil + end + if self.const_defined?(:DEFAULT_MASTER_OPTS) && + DEFAULT_MASTER_OPTS.kind_of?(Hash) + keys = DEFAULT_MASTER_OPTS + else + keys = {} + end + + @@DEFAULT_MASTER = self.allocate + @@DEFAULT_MASTER.instance_eval{ + @tk_windows = {} + + @tk_table_list = [] + + @slave_ip_tbl = {} + + unless keys.kind_of? Hash + fail ArgumentError, "expecting a Hash object for the 2nd argument" + end + + @interp = TclTkIp.new(name, _keys2opts(keys)) + @ip_name = nil + + @threadgroup = Thread.current.group + + @cmd_queue = Queue.new + + @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog() + + @threadgroup.add @cmd_receiver + @threadgroup.add @receiver_watchdog + + # NOT enclose @threadgroup for @@DEFAULT_MASTER + + @@IP_TABLE[ThreadGroup::Default] = self + @@IP_TABLE[@threadgroup] = self + } + @@DEFAULT_MASTER.freeze # defend against modification + + ###################################### + + def self.inherited(subclass) + # trust if on ThreadGroup::Default or @@DEFAULT_MASTER's ThreadGroup + if @@IP_TABLE[Thread.current.group] == @@DEFAULT_MASTER + begin + class << subclass + self.methods.each{|m| + begin + unless m == '__id__' || m == '__send__' || m == 'freeze' + undef_method(m) + end + rescue Exception + # ignore all exceptions + end + } + end + ensure + subclass.freeze + fail SecurityError, + "cannot create subclass of MultiTkIp on a untrusted ThreadGroup" + end + end + end + + ###################################### + + SAFE_OPT_LIST = ['accessPath', 'statics', 'nested', 'deleteHook'] + def _parse_slaveopts(keys) + name = nil + safe = false + safe_opts = {} + tk_opts = {} + + keys.each{|k,v| + if k.to_s == 'name' + name = v + elsif k.to_s == 'safe' + safe = v + elsif SAFE_OPT_LIST.member?(k.to_s) + safe_opts[k] = v + else + tk_opts[k] = v + end + } + + [name, safe, safe_opts, tk_opts] + end + private :_parse_slaveopts + + def _create_slave_ip_name + name = SLAVE_IP_ID.join + SLAVE_IP_ID[1].succ! + name + end + private :_create_slave_ip_name + + ###################################### + + def __check_safetk_optkeys(optkeys) + # based on 'safetk.tcl' + new_keys = {} + optkeys.each{|k,v| new_key[k.to_s] = v} + + # check 'display' + if !new_keys.key?('display') + begin + new_keys['display'] = @interp._eval('winfo screen .') + rescue + if ENV[DISPLAY] + new_keys['display'] = ENV[DISPLAY] + elsif !new_keys.key?('use') + warn "Warning: no screen info or ENV[DISPLAY], so use ':0.0'" + new_keys['display'] = ':0.0' + end + end + end + + # check 'use' + if new_keys.key?('use') + # given 'use' + case new_keys['use'] + when TkWindow + new_keys['use'] = TkWinfo.id(new_keys['use']) + assoc_display = @interp._eval('winfo screen .') + when /^\..*/ + new_keys['use'] = @interp._invoke('winfo', 'id', new_keys['use']) + assoc_display = @interp._invoke('winfo', 'screen', new_keys['use']) + else + begin + pathname = @interp._invoke('winfo', 'pathname', new_keys['use']) + assco_display = @interp._invoke('winfo', 'screen', pathname) + rescue + assoc_display = new_keys['display'] + end + end + + # match display? + if assoc_display != new_keys['display'] + if optkeys.keys?(:display) || optkeys.keys?('display') + fail RuntimeError, + "conflicting 'display'=>#{new_keys['display']} " + + "and display '#{assoc_display}' on 'use'=>#{new_keys['use']}" + else + new_keys['display'] = assoc_display + end + end + end + + # return + new_keys + end + private :__check_safetk_optkeys + + def __create_safetk_frame(slave_ip, slave_name, app_name, keys) + # create toplevel widget + dup_keys = keys.dup + dup_keys['screen'] = dup_keys.delete('display') + dup_keys['classname'] = 'SafeTk' + begin + top = TkToplevel.new(dup_keys) + rescue NameError + fail unless @interp.safe? + fail SecurityError, "unable create toplevel on the safe interpreter" + end + msg = "Untrusted Ruby/Tk applet (#{slave_name})" + if app_name.kind_of?(String) + top.title "#{app_name} (#{slave_name})" + else + top.title msg + end + + # procedure to delete slave interpreter + slave_delete_proc = proc{ + unless slave_ip.deleted? + if slave_ip._invoke('info', 'command', '.') != "" + slave_ip._invoke('destroy', '.') + slave_ip.tk_windows.delete('.') + end + slave_ip.delete + end + } + tag = TkBindTag.new.bind('Destroy', slave_delete_proc) + + # create control frame + TkFrame.new(top, :bg=>'red', :borderwidth=>3, :relief=>'ridge') {|fc| + fc.bindtags = fc.bindtags.unshift(tag) + + TkFrame.new(fc, :bd=>0){|f| + TkButton.new(f, + :text=>'Delete', :bd=>1, :padx=>2, :pady=>0, + :highlightthickness=>0, :command=>slave_delete_proc + ).pack(:side=>:right, :fill=>:both) + f.pack(:side=>:right, :fill=>:both, :expand=>true) + } + + TkLabel.new(fc, :text=>msg, :padx=>2, :pady=>0, + :anchor=>:w).pack(:side=>:left, :fill=>:both, :expand=>true) + + fc.pack(:side=>:bottom, :fill=>:x) + } + + # container frame for slave interpreter + c = TkFrame.new(top, :container=>true).pack(:fill=>:both, :expand=>true) + + # return container's window id + TkWinfo.id(c) + end + private :__create_safetk_frame + + def __create_safe_slave_obj(safe_opts, app_name, tk_opts) + # safe interpreter + # at present, not enough support for '-deleteHook' option + ip_name = _create_slave_ip_name + slave_ip = @interp.create_slave(ip_name, true) + @interp._eval("::safe::interpInit #{ip_name} "+_keys2opts(safe_opts)) + tk_opts = __check_safetk_optkeys(tk_opts) + unless tk_opts.key?('use') + tk_opts['use'] = __create_safetk_frame(slave_ip, ip_name, + app_name, tk_opts) + end + slave_ip._invoke('set', 'argv0', app_name) if app_name.kind_of?(String) + @interp._eval("::safe::loadTk #{ip_name} #{_keys2opts(tk_opts)}") + @slave_ip_tbl[ip_name] = slave_ip + [slave_ip, ip_name] + end + + def __create_trusted_slave_obj(name, keys) + ip_name = _create_slave_ip_name + slave_ip = @interp.create_slave(ip_name, false) + slave_ip._invoke('set', 'argv0', name) if name.kind_of?(String) + slave_ip._invoke('set', 'argv', _keys2opts(keys)) + @interp._invoke('load', '', 'Tk', ip_name) + @slave_ip_tbl[ip_name] = slave_ip + [slave_ip, ip_name] + end + + ###################################### + + def _create_slave_object(keys={}) + ip = MultiTkIp.new_slave(self, keys={}) + @slave_ip_tbl[ip.name] = ip + end + + ###################################### + + def initialize(master, safeip=true, keys={}) + if safeip == nil && !master.master? + fail SecurityError, "slave-ip cannot create master-ip" + end + + unless keys.kind_of? Hash + fail ArgumentError, "expecting a Hash object for the 2nd argument" + end + + @tk_windows = {} + + @tk_table_list = [] + + @slave_ip_tbl = {} + + name, safe, safe_opts, tk_opts = _parse_slaveopts(keys) + + if safeip == nil + # create master-ip + @interp = TclTkIp.new(name, _keys2opts(tk_opts)) + @ip_name = nil + else + # create slave-ip + if safeip || master.safe? + @interp, @ip_name = master.__create_safe_slave_obj(safe_opts, + name, tk_opts) + else + @interp, @ip_name = master.__create_trusted_slave_obj(name, tk_opts) + end + @set_alias_proc = proc{|name| + master._invoke('interp', 'alias', @ip_name, name, '', name) + }.freeze + end + + @threadgroup = ThreadGroup.new + + @cmd_queue = Queue.new + + @cmd_receiver, @receiver_watchdog = _create_receiver_and_watchdog() + + @threadgroup.add @cmd_receiver + @threadgroup.add @receiver_watchdog + + @threadgroup.enclose + + @@IP_TABLE[@threadgroup] = self + _init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS) + @@TK_TABLE_LIST.size.times{ @tk_table_list << {} } + + self.freeze # defend against modification + end +end + + +# get target IP +class MultiTkIp + def self.__getip + if Thread.current.group == ThreadGroup::Default + @@DEFAULT_MASTER + else + ip = @@IP_TABLE[Thread.current.group] + unless ip + fail SecurityError, + "cannot call Tk methods on #{Thread.current.inspect}" + end + ip + end + end +end + + +# aliases of constructor +class << MultiTkIp + alias __new new + private :__new + + def new_master(keys={}) + __new(__getip, nil, keys) + end + + alias new new_master + + def new_slave(keys={}) + __new(__getip, false, keys) + end + alias new_trusted_slave new_master + + def new_safe_slave(keys={}) + __new(__getip, true, keys) + end + alias new_safeTk new_safe_slave +end + + +# get info +class MultiTkIp + def inspect + s = self.to_s.chop! + if master? + s << ':master' + else + if @interp.safe? + s << ':safe-slave' + else + s << ':trusted-slave' + end + end + s << '>' + end + + def master? + if @ip_name + false + else + true + end + end + + def slave? + not master? + end + + def alive? + return false unless @cmd_receiver.alive? + return false if @interp.deleted? + end + + def path + @ip_name + end + + def slaves(all = false) + @interp._invoke('interp','slaves').split.map!{|name| + if @slave_ip_tbl.key?(name) + @slave_ip_tbl[name] + elsif all + name + else + nil + end + }.compact! + end +end + + +# instance methods to treat tables +class MultiTkIp + def _tk_cmd_tbl + MultiTkIp.tk_cmd_tbl.collect{|ent| ent.ip == self } + end + + def _tk_windows + @tk_windows + end + + def _tk_table_list + @tk_table_list + end + + def _init_ip_env(script) + script.call(self) + end + + def _add_tk_procs(name, args, body) + return if slave? + @interp._invoke('proc', name, args, body) if args && body + @interp._invoke('interp', 'slaves').split.each{|slave| + @interp._invoke('interp', 'alias', slave, name, '', name) + } + end + + def _init_ip_internal(init_ip_env, add_tk_procs) + init_ip_env.each{|script| script.call(self)} + add_tk_procs.each{|name, args, body| + if master? + @interp._invoke('proc', name, args, body) if args && body + else + @set_alias_proc.call(name) + end + } + end +end + + +# class methods to treat tables +class MultiTkIp + def self.tk_cmd_tbl + @@TK_CMD_TBL + end + def self.tk_windows + __getip._tk_windows + end + def self.tk_object_table(id) + __getip._tk_table_list[id] + end + def self.create_table + id = @@TK_TABLE_LIST.size + @@IP_TABLE.each{|tg, ip| + ip.instance_eval{@tk_table_list << {}} + } + obj = Object.new + @@TK_TABLE_LIST << obj + obj.instance_eval <<-EOD + def self.method_missing(m, *args) + MultiTkIp.tk_object_table(#{id}).send(m, *args) + end + EOD + obj.freeze + return obj + end + + def self.init_ip_env(script = Proc.new) + @@INIT_IP_ENV << script + @@IP_TABLE.each{|tg, ip| + ip._init_ip_env(script) + } + end + + def self.add_tk_procs(name, args=nil, body=nil) + @@ADD_TK_PROCS << [name, args, body] + @@IP_TABLE.each{|tg, ip| + ip._add_tk_procs(name, args, body) + } + end + + def self.init_ip_internal + __getip._init_ip_internal(@@INIT_IP_ENV, @@ADD_TK_PROCS) + end +end + + +# for callback operation +class MultiTkIp + def self.get_cb_entry(cmd) + @@CB_ENTRY_CLASS.new(__getip, cmd).freeze + end + + def cb_eval(cmd, *args) + self.eval_callback{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) } + end +end + + +# evaluate a procedure on the proper interpreter +class MultiTkIp + # instance method + def eval_proc_core(req_val=true, cmd = Proc.new, *args) + # cmd string ==> proc + if cmd.kind_of?(String) + cmd = proc{ TkComm._get_eval_string(TkUtil.eval_cmd(cmd, *args)) } + args = [] + end + + # on IP thread + if (@cmd_receiver == Thread.current) + return cmd.call(*args) + end + + # send cmd to the proc-queue + if req_val + @cmd_queue.enq([Thread.current, cmd, *args]) + else + @cmd_queue.enq([nil, cmd, *args]) + return nil + end + + # wait and get return value by exception + begin + Thread.stop + rescue MultiTkIp_OK => ret + # return value + return ret.value + end + end + private :eval_proc_core + + def eval_callback(cmd = Proc.new, *args) + eval_proc_core(false, cmd, *args) + end + + def eval_proc(cmd = Proc.new, *args) + eval_proc_core(true, cmd, *args) + end + alias call eval_proc + + # class method + def self.eval_proc(cmd = Proc.new, *args) + # class ==> interp object + __getip.eval_proc(cmd, *args) + end +end + + +# depend on TclTkLib +# all master/slave IPs are controled by only one event-loop +class << MultiTkIp + def mainloop(check_root = true) + TclTkLib.mainloop(check_root) + end + def mainloop_watchdog(check_root = true) + TclTkLib.mainloop_watchdog(check_root) + end + def do_one_event(flag = TclTkLib::EventFlag::ALL) + TclTkLib.do_one_event(flag) + end + def set_eventloop_tick(tick) + TclTkLib.set_eventloop_tick(tick) + end + def get_eventloop_tick + TclTkLib.get_eventloop_tick + end + def set_no_event_wait(tick) + TclTkLib.set_no_event_wait(tick) + end + def get_no_event_wait + TclTkLib.get_no_event_wait + end + def set_eventloop_weight(loop_max, no_event_tick) + TclTkLib.set_eventloop_weight(loop_max, no_event_tick) + end + def get_eventloop_weight + TclTkLib.get_eventloop_weight + end +end + + +# class methods to delegate to TclTkIp +class << MultiTkIp + def make_safe + __getip.make_safe + end + + def safe? + __getip.safe? + end + + def restart + __getip.restart + end + + def _eval(str) + __getip._eval(str) + end + + def _invoke(*args) + __getip._invoke(*args) + end + + def _toUTF8(str, encoding) + __getip._toUTF8(str, encoding) + end + + def _fromUTF8(str, encoding) + __getip._fromUTF8(str, encoding) + end + + def _return_value + __getip._return_value + end +end + + +# depend on TclTkIp +class MultiTkIp + def make_safe + @interp.make_safe + end + + def safe? + @interp.safe? + end + + def delete + @interp.delete + end + + def deleted? + @interp.deleted? + end + + def restart + @interp.restart + end + + def _eval(str) + @interp._eval(str) + end + + def _invoke(*args) + @interp._invoke(*args) + end + + def _toUTF8(str, encoding) + @interp._toUTF8(str, encoding) + end + + def _fromUTF8(str, encoding) + @interp._fromUTF8(str, encoding) + end + + def _return_value + @interp._return_value + end +end + + +# end of MultiTkIp definition + +MultiTkIp.freeze # defend against modification + + +######################################## +# start Tk which depends on MultiTkIp +module TkCore + INTERP = MultiTkIp +end +require 'tk' diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb index aa4d58d6d9..8561a9d222 100644 --- a/ext/tk/lib/tk.rb +++ b/ext/tk/lib/tk.rb @@ -3874,7 +3874,7 @@ class TkToplevel<TkWindow keys.each{|k,v| if Wm.method_defined?(k) case k - when 'screen','class','colormap','container','screen','use','visual' + when 'screen','class','colormap','container','use','visual' new_keys[k] = v else case self.method(k).arity @@ -5074,7 +5074,10 @@ end require 'tkvirtevent' TkBindTag::ALL.bind(TkVirtualEvent.new('Destroy'), proc{|widget| if widget.respond_to? :__destroy_hook__ - widget.__destroy_hook__ + begin + widget.__destroy_hook__ + rescue Exception + end end }, '%W') diff --git a/ext/tk/lib/tkafter.rb b/ext/tk/lib/tkafter.rb index 2ff60fe1e9..b24d6c72d3 100644 --- a/ext/tk/lib/tkafter.rb +++ b/ext/tk/lib/tkafter.rb @@ -12,10 +12,15 @@ class TkTimer TkCommandNames = ['after'.freeze].freeze Tk_CBID = ['a'.freeze, '00000'] - Tk_CBTBL = TkCore::INTERP.create_table + Tk_CBTBL = {} - TkCore::INTERP.add_tk_procs('rb_after', 'id', - "ruby [format \"#{self.name}.callback %%Q!%s!\" $id]") + TkCore::INTERP.add_tk_procs('rb_after', 'id', <<-'EOL') + if {[set st [catch {ruby [format "TkTimer.callback %%Q!%s!" $id]} ret]] != 0} { + return -code $st $ret + } { + return $ret + } + EOL ############################### @@ -24,9 +29,14 @@ class TkTimer def self.callback(obj_id) @after_id = nil ex_obj = Tk_CBTBL[obj_id] - return nil if ex_obj == nil; # canceled + return "" if ex_obj == nil; # canceled #_get_eval_string(ex_obj.do_callback) - ex_obj.cb_call + begin + ex_obj.cb_call + rescue Exception + Tk_CBTBL[obj_id] = nil + "" + end end def self.info @@ -43,7 +53,7 @@ class TkTimer @in_callback = true begin @return_value = @current_proc.call(self) - rescue StandardError, NameError + rescue Exception if @cancel_on_exception cancel return nil diff --git a/ext/tk/sample/safe-tk.rb b/ext/tk/sample/safe-tk.rb new file mode 100644 index 0000000000..77cfc3c87f --- /dev/null +++ b/ext/tk/sample/safe-tk.rb @@ -0,0 +1,48 @@ +#!/usr/bin/env ruby +# This script is a sample of MultiTkIp class + +require "multi-tk" + +# create slave interpreters +trusted_slave = MultiTkIp.new_slave +safe_slave = MultiTkIp.new_safeTk + + +cmd = Proc.new{|txt| + ##################### + ## from TkTimer2.rb + begin + root = TkRoot.new(:title=>'timer sample') + rescue + # safeTk doesn't have permission to call 'wm' command + end + label = TkLabel.new(:parent=>root, :relief=>:raised, :width=>10) \ + .pack(:side=>:bottom, :fill=>:both) + + tick = proc{|aobj| + cnt = aobj.return_value + 5 + label.text format("%d.%02d", *(cnt.divmod(100))) + cnt + } + + timer = TkTimer.new(50, -1, tick).start(0, proc{ label.text('0.00'); 0 }) + + TkButton.new(:text=>'Start') { + command proc{ timer.continue unless timer.running? } + pack(:side=>:left, :fill=>:both, :expand=>true) + } + TkButton.new(:text=>'Stop') { + command proc{ timer.stop if timer.running? } + pack('side'=>'right','fill'=>'both','expand'=>'yes') + } + + ev_quit = TkVirtualEvent.new('Control-c', 'Control-q') + Tk.root.bind(ev_quit, proc{Tk.exit}).focus +} + +# call on the default master interpreter +trusted_slave.eval_proc(cmd, 'trusted') +safe_slave.eval_proc(cmd, 'safe') +cmd.call('master') + +Tk.mainloop |