summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/tcltklib/MANIFEST5
-rw-r--r--ext/tcltklib/MANUAL.euc35
-rw-r--r--ext/tcltklib/demo/safeTk.rb22
-rw-r--r--ext/tcltklib/tcltklib.c348
-rw-r--r--ext/tk/MANIFEST2
-rw-r--r--ext/tk/lib/README1
-rw-r--r--ext/tk/lib/multi-tk.rb796
-rw-r--r--ext/tk/lib/tk.rb7
-rw-r--r--ext/tk/lib/tkafter.rb22
-rw-r--r--ext/tk/sample/safe-tk.rb48
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