summaryrefslogtreecommitdiffstats
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/tcltklib/tcltklib.c277
-rw-r--r--ext/tk/lib/multi-tk.rb441
-rw-r--r--ext/tk/lib/remote-tk.rb30
-rw-r--r--ext/tk/lib/tk.rb9
-rw-r--r--ext/tk/sample/remote-ip_sample2.rb7
-rw-r--r--ext/tk/sample/tkoptdb-safeTk.rb14
6 files changed, 570 insertions, 208 deletions
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 6f7017c33..f1a81c996 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -2075,7 +2075,7 @@ rb_threadUpdateProc(clientData)
DUMP1("threadUpdateProc is called");
param->done = 1;
- rb_thread_run(param->thread);
+ rb_thread_wakeup(param->thread);
return;
}
@@ -2171,6 +2171,7 @@ ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
DUMP1("pass argument check");
param = (struct th_update_param *)Tcl_Alloc(sizeof(struct th_update_param));
+ Tcl_Preserve(param);
param->thread = current_thread;
param->done = 0;
@@ -2182,12 +2183,13 @@ ip_rb_threadUpdateCommand(clientData, interp, objc, objv)
rb_thread_stop();
}
+ Tcl_Release(param);
Tcl_Free((char *)param);
DUMP1("finish Ruby's 'thread_update'");
return TCL_OK;
}
-#endif /* update and thread_update don't work internal callback proc */
+#endif /* update and thread_update don't work */
/***************************/
@@ -2245,6 +2247,8 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
int thr_crit_bup;
DUMP1("Ruby's 'vwait' is called");
+ Tcl_Preserve(interp);
+
if (objc != 2) {
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -2263,6 +2267,8 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
#endif
+
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2270,6 +2276,7 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = Qtrue;
#if TCL_MAJOR_VERSION >= 8
+ Tcl_IncrRefCount(objv[1]);
/* nameString = Tcl_GetString(objv[1]); */
nameString = Tcl_GetStringFromObj(objv[1], &dummy);
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2290,6 +2297,10 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[1]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
done = 0;
@@ -2319,8 +2330,17 @@ ip_rbVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[1]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[1]);
+#endif
+ Tcl_Release(interp);
return TCL_OK;
}
@@ -2405,6 +2425,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
#endif
{
Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window window;
int done, index;
static CONST char *optionStrings[] = { "variable", "visibility", "window",
(char *) NULL };
@@ -2415,6 +2436,8 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
DUMP1("Ruby's 'tkwait' is called");
+ Tcl_Preserve(interp);
+
if (objc != 3) {
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
@@ -2435,6 +2458,8 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
#endif
+
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2456,6 +2481,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+ Tcl_Release(interp);
return TCL_ERROR;
}
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2475,6 +2501,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
Tcl_AppendResult(interp, "bad option \"", objv[1],
"\": must be variable, visibility, or window",
(char *) NULL);
+ Tcl_Release(interp);
return TCL_ERROR;
}
}
@@ -2484,6 +2511,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = Qtrue;
#if TCL_MAJOR_VERSION >= 8
+ Tcl_IncrRefCount(objv[2]);
/* nameString = Tcl_GetString(objv[2]); */
nameString = Tcl_GetStringFromObj(objv[2], &dummy);
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2493,7 +2521,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
switch ((enum options) index) {
- case TKWAIT_VARIABLE: {
+ case TKWAIT_VARIABLE:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
/*
@@ -2510,6 +2538,10 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
done = 0;
@@ -2522,20 +2554,30 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
WaitVariableProc, (ClientData) &done);
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
rb_thread_critical = thr_crit_bup;
break;
- }
-
- case TKWAIT_VISIBILITY: {
- Tk_Window window;
+ case TKWAIT_VISIBILITY:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- window = Tk_NameToWindow(interp, nameString, tkwin);
+ if (Tk_MainWindow(interp) == (Tk_Window)NULL) {
+ window = NULL;
+ } else {
+ window = Tk_NameToWindow(interp, nameString, tkwin);
+ }
+
if (window == NULL) {
rb_thread_critical = thr_crit_bup;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2562,12 +2604,20 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
Tk_DeleteEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
WaitVisibilityProc, (ClientData) &done);
@@ -2575,17 +2625,24 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
break;
- }
-
- case TKWAIT_WINDOW: {
- Tk_Window window;
+ case TKWAIT_WINDOW:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- window = Tk_NameToWindow(interp, nameString, tkwin);
+ if (Tk_MainWindow(interp) == (Tk_Window)NULL) {
+ window = NULL;
+ } else {
+ window = Tk_NameToWindow(interp, nameString, tkwin);
+ }
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
if (window == NULL) {
rb_thread_critical = thr_crit_bup;
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2602,7 +2659,6 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
*/
break;
}
- }
/*
* Clear out the interpreter's result, since it may have been set
@@ -2610,6 +2666,7 @@ ip_rbTkWaitCommand(clientData, interp, objc, objv)
*/
Tcl_ResetResult(interp);
+ Tcl_Release(interp);
return TCL_OK;
}
@@ -2645,12 +2702,19 @@ rb_threadVwaitProc(clientData, interp, name1, name2, flags)
{
struct th_vwait_param *param = (struct th_vwait_param *) clientData;
- param->done = 1;
- rb_thread_run(param->thread);
+ if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
+ param->done = -1;
+ } else {
+ param->done = 1;
+ }
+ rb_thread_wakeup(param->thread);
return (char *)NULL;
}
+#define TKWAIT_MODE_VISIBILITY 1
+#define TKWAIT_MODE_DESTROY 2
+
static void rb_threadWaitVisibilityProc _((ClientData, XEvent *));
static void
rb_threadWaitVisibilityProc(clientData, eventPtr)
@@ -2660,12 +2724,12 @@ rb_threadWaitVisibilityProc(clientData, eventPtr)
struct th_vwait_param *param = (struct th_vwait_param *) clientData;
if (eventPtr->type == VisibilityNotify) {
- param->done = 1;
+ param->done = TKWAIT_MODE_VISIBILITY;
}
if (eventPtr->type == DestroyNotify) {
- param->done = 2;
+ param->done = TKWAIT_MODE_DESTROY;
}
- rb_thread_run(param->thread);
+ rb_thread_wakeup(param->thread);
}
static void rb_threadWaitWindowProc _((ClientData, XEvent *));
@@ -2677,9 +2741,9 @@ rb_threadWaitWindowProc(clientData, eventPtr)
struct th_vwait_param *param = (struct th_vwait_param *) clientData;
if (eventPtr->type == DestroyNotify) {
- param->done = 1;
+ param->done = TKWAIT_MODE_DESTROY;
}
- rb_thread_run(param->thread);
+ rb_thread_wakeup(param->thread);
}
#if TCL_MAJOR_VERSION >= 8
@@ -2720,6 +2784,8 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
#endif
}
+ Tcl_Preserve(interp);
+
if (objc != 2) {
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -2738,9 +2804,13 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
#endif
+
+ Tcl_Release(interp);
return TCL_ERROR;
}
+
#if TCL_MAJOR_VERSION >= 8
+ Tcl_IncrRefCount(objv[1]);
/* nameString = Tcl_GetString(objv[1]); */
nameString = Tcl_GetStringFromObj(objv[1], &dummy);
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2750,6 +2820,7 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = Qtrue;
param = (struct th_vwait_param *)Tcl_Alloc(sizeof(struct th_vwait_param));
+ Tcl_Preserve(param);
param->thread = current_thread;
param->done = 0;
@@ -2767,6 +2838,10 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[1]);
+#endif
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2775,18 +2850,24 @@ ip_rb_threadVwaitCommand(clientData, interp, objc, objv)
rb_thread_stop();
}
-
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- Tcl_UntraceVar(interp, nameString,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- rb_threadVwaitProc, (ClientData) param);
+ if (param->done > 0) {
+ Tcl_UntraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ rb_threadVwaitProc, (ClientData) param);
+ }
+ Tcl_Release(param);
Tcl_Free((char *)param);
rb_thread_critical = thr_crit_bup;
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[1]);
+#endif
+ Tcl_Release(interp);
return TCL_OK;
}
@@ -2812,6 +2893,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
{
struct th_vwait_param *param;
Tk_Window tkwin = (Tk_Window) clientData;
+ Tk_Window window;
int index;
static CONST char *optionStrings[] = { "variable", "visibility", "window",
(char *) NULL };
@@ -2833,6 +2915,9 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
#endif
}
+ Tcl_Preserve(interp);
+ Tcl_Preserve(tkwin);
+
if (objc != 3) {
#ifdef Tcl_WrongNumArgs
Tcl_WrongNumArgs(interp, 1, objv, "variable|visibility|window name");
@@ -2853,6 +2938,9 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
#endif
+
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2873,6 +2961,8 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2892,6 +2982,8 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
Tcl_AppendResult(interp, "bad option \"", objv[1],
"\": must be variable, visibility, or window",
(char *) NULL);
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
}
@@ -2901,6 +2993,7 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = Qtrue;
#if TCL_MAJOR_VERSION >= 8
+ Tcl_IncrRefCount(objv[2]);
/* nameString = Tcl_GetString(objv[2]); */
nameString = Tcl_GetStringFromObj(objv[2], &dummy);
#else /* TCL_MAJOR_VERSION < 8 */
@@ -2908,13 +3001,14 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
#endif
param = (struct th_vwait_param *)Tcl_Alloc(sizeof(struct th_vwait_param));
+ Tcl_Preserve(param);
param->thread = current_thread;
param->done = 0;
rb_thread_critical = thr_crit_bup;
switch ((enum options) index) {
- case TKWAIT_VARIABLE: {
+ case TKWAIT_VARIABLE:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
/*
@@ -2931,6 +3025,15 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
if (ret != TCL_OK) {
+ Tcl_Release(param);
+ Tcl_Free((char *)param);
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
@@ -2942,26 +3045,44 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- Tcl_UntraceVar(interp, nameString,
- TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
- rb_threadVwaitProc, (ClientData) param);
+ if (param->done > 0) {
+ Tcl_UntraceVar(interp, nameString,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ rb_threadVwaitProc, (ClientData) param);
+ }
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
rb_thread_critical = thr_crit_bup;
break;
- }
-
- case TKWAIT_VISIBILITY: {
- Tk_Window window;
+ case TKWAIT_VISIBILITY:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- window = Tk_NameToWindow(interp, nameString, tkwin);
+ if (Tk_MainWindow(interp) == (Tk_Window)NULL) {
+ window = NULL;
+ } else {
+ window = Tk_NameToWindow(interp, nameString, tkwin);
+ }
+
if (window == NULL) {
rb_thread_critical = thr_crit_bup;
+
+ Tcl_Release(param);
+ Tcl_Free((char *)param);
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
+ Tcl_Preserve(window);
Tk_CreateEventHandler(window,
VisibilityChangeMask|StructureNotifyMask,
@@ -2970,16 +3091,26 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
/* if (!param->done) { */
+ /*
while(!param->done) {
rb_thread_stop();
}
+ */
+ while(param->done != TKWAIT_MODE_VISIBILITY) {
+ if (param->done == TKWAIT_MODE_DESTROY) break;
+ rb_thread_stop();
+ }
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
- Tk_DeleteEventHandler(window,
- VisibilityChangeMask|StructureNotifyMask,
- rb_threadWaitVisibilityProc, (ClientData) param);
+ /* when a window is destroyed, no need to call Tk_DeleteEventHandler */
+ if (param->done != TKWAIT_MODE_DESTROY) {
+ Tk_DeleteEventHandler(window,
+ VisibilityChangeMask|StructureNotifyMask,
+ rb_threadWaitVisibilityProc,
+ (ClientData) param);
+ }
if (param->done != 1) {
Tcl_ResetResult(interp);
@@ -2989,36 +3120,75 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_thread_critical = thr_crit_bup;
+ Tcl_Release(window);
+
+ Tcl_Release(param);
+ Tcl_Free((char *)param);
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
+ Tcl_Release(window);
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
rb_thread_critical = thr_crit_bup;
break;
- }
-
- case TKWAIT_WINDOW: {
- Tk_Window window;
+ case TKWAIT_WINDOW:
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
-
- window = Tk_NameToWindow(interp, nameString, tkwin);
+
+ if (Tk_MainWindow(interp) == (Tk_Window)NULL) {
+ window = NULL;
+ } else {
+ window = Tk_NameToWindow(interp, nameString, tkwin);
+ }
+
+#if TCL_MAJOR_VERSION >= 8
+ Tcl_DecrRefCount(objv[2]);
+#endif
+
if (window == NULL) {
rb_thread_critical = thr_crit_bup;
+
+ Tcl_Release(param);
+ Tcl_Free((char *)param);
+
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_ERROR;
}
+ Tcl_Preserve(window);
+
Tk_CreateEventHandler(window, StructureNotifyMask,
rb_threadWaitWindowProc, (ClientData) param);
rb_thread_critical = thr_crit_bup;
/* if (!param->done) { */
+ /*
while(!param->done) {
rb_thread_stop();
}
+ */
+ while(param->done != TKWAIT_MODE_DESTROY) {
+ rb_thread_stop();
+ }
+ Tcl_Release(window);
+
+ /* when a window is destroyed, no need to call Tk_DeleteEventHandler
thr_crit_bup = rb_thread_critical;
rb_thread_critical = Qtrue;
@@ -3026,11 +3196,12 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
rb_threadWaitWindowProc, (ClientData) param);
rb_thread_critical = thr_crit_bup;
+ */
break;
- }
} /* end of 'switch' statement */
+ Tcl_Release(param);
Tcl_Free((char *)param);
/*
@@ -3039,6 +3210,9 @@ ip_rb_threadTkWaitCommand(clientData, interp, objc, objv)
*/
Tcl_ResetResult(interp);
+
+ Tcl_Release(tkwin);
+ Tcl_Release(interp);
return TCL_OK;
}
@@ -3048,8 +3222,9 @@ ip_thread_vwait(self, var)
VALUE var;
{
VALUE argv[2];
+ volatile VALUE cmd_str = rb_str_new2("thread_vwait");
- argv[0] = rb_str_new2("thread_vwait");
+ argv[0] = cmd_str;
argv[1] = var;
return ip_invoke_real(2, argv, self);
}
@@ -3061,8 +3236,9 @@ ip_thread_tkwait(self, mode, target)
VALUE target;
{
VALUE argv[3];
+ volatile VALUE cmd_str = rb_str_new2("thread_tkwait");
- argv[0] = rb_str_new2("thread_tkwait");
+ argv[0] = cmd_str;
argv[1] = mode;
argv[2] = target;
return ip_invoke_real(3, argv, self);
@@ -3955,6 +4131,7 @@ ip_eval(self, str)
/* allocate memory (freed by Tcl_ServiceEvent) */
evq = (struct eval_queue *)Tcl_Alloc(sizeof(struct eval_queue));
+ Tcl_Preserve(evq);
/* allocate result obj */
result = rb_ary_new2(1);
@@ -3987,8 +4164,11 @@ ip_eval(self, str)
/* get result & free allocated memory */
ret = RARRAY(result)->ptr[0];
+
free(alloc_done);
free(eval_str);
+ Tcl_Release(evq);
+
if (rb_obj_is_kind_of(ret, rb_eException)) {
rb_exc_raise(ret);
}
@@ -4862,6 +5042,7 @@ ip_invoke_with_position(argc, argv, obj, position)
/* allocate memory (freed by Tcl_ServiceEvent) */
ivq = (struct invoke_queue *)Tcl_Alloc(sizeof(struct invoke_queue));
+ Tcl_Preserve(ivq);
/* allocate result obj */
result = rb_ary_new2(1);
@@ -4895,6 +5076,8 @@ ip_invoke_with_position(argc, argv, obj, position)
ret = RARRAY(result)->ptr[0];
free(alloc_done);
+ Tcl_Release(ivq);
+
/* free allocated memory */
free_invoke_arguments(argc, av);
@@ -5250,7 +5433,7 @@ ip_set_variable(self, varname_arg, value_arg, flag_arg)
Tcl_IncrRefCount(valobj);
# else /* TCL_VERSION >= 8.1 */
{
- VALUE enc = Qnil;
+ volatile VALUE enc = Qnil;
if (RTEST(rb_ivar_defined(value, ID_at_enc))) {
enc = rb_ivar_get(value, ID_at_enc);
diff --git a/ext/tk/lib/multi-tk.rb b/ext/tk/lib/multi-tk.rb
index 2d758fc28..cd4c916a2 100644
--- a/ext/tk/lib/multi-tk.rb
+++ b/ext/tk/lib/multi-tk.rb
@@ -106,9 +106,18 @@ class MultiTkIp
def _check_and_return(thread, exception, wait=0)
unless thread
unless exception.kind_of?(MultiTkIp_OK) || safe?
+ msg = "#{exception.class}: #{exception.message}"
begin
- @interp._eval(@interp._merge_tklist('bgerror', "#{exception.class}: #{exception.message}"))
- rescue Exception
+ if @interp.deleted?
+ warn('Warning: ' + msg)
+ elsif @interp._eval_without_enc('info command bgerror').size != 0
+ @interp._eval(@interp._merge_tklist('bgerror', msg))
+ else
+ warn('Warning: ' + msg)
+ end
+ rescue Exception => e
+ warn('Warning: ' + msg)
+ warn('Warning: ' + e.message)
end
end
return nil
@@ -162,6 +171,17 @@ class MultiTkIp
__getip.safe_level
end
+ def wait_on_mainloop?
+ @wait_on_mainloop[0]
+ end
+ def wait_on_mainloop=(bool)
+ @wait_on_mainloop[0] = bool
+ end
+
+ def running_mainloop?
+ @wait_on_mainloop[1]
+ end
+
def _destroy_slaves_of_slaveIP(ip)
unless ip.deleted?
ip._split_tklist(ip._invoke('interp', 'slaves')).each{|name|
@@ -200,170 +220,211 @@ class MultiTkIp
end
end
- def _create_receiver_and_watchdog(lvl = $SAFE)
- lvl = $SAFE if lvl < $SAFE
-
- # command-procedures receiver
- receiver = Thread.new(lvl){|safe_level|
- loop do
- break if @interp.deleted?
- thread, cmd, *args = @cmd_queue.deq
- if thread == @system
- # control command
- case cmd
- when 'set_safe_level'
- begin
- safe_level = args[0] if safe_level < args[0]
- rescue Exception
- end
- else
- # ignore
- end
-
- else
- # procedure
+ def _receiver_eval_proc_core(safe_level, thread, cmd, *args)
+ begin
+ #ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
+ ret = cmd.call(safe_level, *args)
+
+ rescue SystemExit => e
+ # delete IP
+ unless @interp.deleted?
+ @slave_ip_tbl.each{|name, subip|
+ _destroy_slaves_of_slaveIP(subip)
begin
- #ret = proc{$SAFE = safe_level; cmd.call(*args)}.call
- ret = cmd.call(safe_level, *args)
- rescue SystemExit => e
- # delete IP
- unless @interp.deleted?
- @slave_ip_tbl.each{|name, subip|
- _destroy_slaves_of_slaveIP(subip)
- begin
- subip._eval_without_enc("foreach i [after info] {after cancel $i}")
- rescue Exception
- end
+ subip._eval_without_enc("foreach i [after info] {after cancel $i}")
+ rescue Exception
+ end
=begin
- begin
- subip._invoke('destroy', '.') unless subip.deleted?
- rescue Exception
- end
+ begin
+ subip._invoke('destroy', '.') unless subip.deleted?
+ rescue Exception
+ end
=end
- begin
- # safe_base?
- @interp._eval_without_enc("::safe::interpConfigure #{name}")
- @interp._eval_without_enc("::safe::interpDelete #{name}")
- rescue Exception
- if subip.respond_to?(:safe_base?) && subip.safe_base? &&
- !subip.deleted?
- # do 'exit' to call the delete_hook procedure
- begin
- subip._eval_without_enc('exit')
- rescue Exception
- end
- else
- begin
- subip.delete unless subip.deleted?
- rescue Exception
- end
- end
- end
- }
-
+ begin
+ # safe_base?
+ @interp._eval_without_enc("::safe::interpConfigure #{name}")
+ @interp._eval_without_enc("::safe::interpDelete #{name}")
+ rescue Exception
+ if subip.respond_to?(:safe_base?) && subip.safe_base? &&
+ !subip.deleted?
+ # do 'exit' to call the delete_hook procedure
begin
- @interp._eval_without_enc("foreach i [after info] {after cancel $i}")
+ subip._eval_without_enc('exit')
rescue Exception
end
+ else
begin
- @interp._invoke('destroy', '.') unless @interp.deleted?
+ subip.delete unless subip.deleted?
rescue Exception
end
- if @safe_base && !@interp.deleted?
- # do 'exit' to call the delete_hook procedure
- @interp._eval_without_enc('exit')
- else
- @interp.delete unless @interp.deleted?
- end
end
+ end
+ }
- if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/
- _check_and_return(thread, MultiTkIp_OK.new($3 == 'exit'))
- else
- _check_and_return(thread, MultiTkIp_OK.new(nil))
- end
+ begin
+ @interp._eval_without_enc("foreach i [after info] {after cancel $i}")
+ rescue Exception
+ end
+ begin
+ @interp._invoke('destroy', '.') unless @interp.deleted?
+ rescue Exception
+ end
+ if @safe_base && !@interp.deleted?
+ # do 'exit' to call the delete_hook procedure
+ @interp._eval_without_enc('exit')
+ else
+ @interp.delete unless @interp.deleted?
+ end
+ end
+
+ if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/
+ _check_and_return(thread, MultiTkIp_OK.new($3 == 'exit'))
+ else
+ _check_and_return(thread, MultiTkIp_OK.new(nil))
+ end
- if master? && !safe? && allow_ruby_exit?
+ if master? && !safe? && allow_ruby_exit?
=begin
- ObjectSpace.each_object(TclTkIp){|obj|
- obj.delete unless obj.deleted?
- }
+ ObjectSpace.each_object(TclTkIp){|obj|
+ obj.delete unless obj.deleted?
+ }
=end
- exit
+ exit
+ end
+ # break
+
+ rescue SecurityError => e
+ # in 'exit', 'exit!', and 'abort' : security error --> delete IP
+ if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/
+ ret = ($3 == 'exit')
+ unless @interp.deleted?
+ @slave_ip_tbl.each_value{|subip|
+ _destroy_slaves_of_slaveIP(subip)
+ begin
+ subip._eval_without_enc("foreach i [after info] {after cancel $i}")
+ rescue Exception
end
- break
-
- rescue SecurityError => e
- # in 'exit', 'exit!', and 'abort' : security error --> delete IP
- if e.backtrace[0] =~ /^(.+?):(\d+):in `(exit|exit!|abort)'/
- ret = ($3 == 'exit')
- unless @interp.deleted?
- @slave_ip_tbl.each_value{|subip|
- _destroy_slaves_of_slaveIP(subip)
- begin
- subip._eval_without_enc("foreach i [after info] {after cancel $i}")
- rescue Exception
- end
=begin
- begin
- subip._invoke('destroy', '.') unless subip.deleted?
- rescue Exception
- end
+ begin
+ subip._invoke('destroy', '.') unless subip.deleted?
+ rescue Exception
+ end
=end
- begin
- # safe_base?
- @interp._eval_without_enc("::safe::interpConfigure #{name}")
- @interp._eval_without_enc("::safe::interpDelete #{name}")
- rescue Exception
- if subip.respond_to?(:safe_base?) && subip.safe_base? &&
- !subip.deleted?
- # do 'exit' to call the delete_hook procedure
- begin
- subip._eval_without_enc('exit')
- rescue Exception
- end
- else
- begin
- subip.delete unless subip.deleted?
- rescue Exception
- end
- end
- end
- }
-
+ begin
+ # safe_base?
+ @interp._eval_without_enc("::safe::interpConfigure #{name}")
+ @interp._eval_without_enc("::safe::interpDelete #{name}")
+ rescue Exception
+ if subip.respond_to?(:safe_base?) && subip.safe_base? &&
+ !subip.deleted?
+ # do 'exit' to call the delete_hook procedure
begin
- @interp._eval_without_enc("foreach i [after info] {after cancel $i}")
+ subip._eval_without_enc('exit')
rescue Exception
end
-=begin
+ else
begin
- @interp._invoke('destroy', '.') unless @interp.deleted?
+ subip.delete unless subip.deleted?
rescue Exception
end
-=end
- if @safe_base && !@interp.deleted?
- # do 'exit' to call the delete_hook procedure
- @interp._eval_without_enc('exit')
- else
- @interp.delete unless @interp.deleted?
- end
end
- _check_and_return(thread, MultiTkIp_OK.new(ret))
- break
-
- else
- # raise security error
- _check_and_return(thread, e)
end
+ }
- rescue Exception => e
- # raise exception
- _check_and_return(thread, e)
+ begin
+ @interp._eval_without_enc("foreach i [after info] {after cancel $i}")
+ rescue Exception
+ end
+=begin
+ begin
+ @interp._invoke('destroy', '.') unless @interp.deleted?
+ rescue Exception
+ end
+=end
+ if @safe_base && !@interp.deleted?
+ # do 'exit' to call the delete_hook procedure
+ @interp._eval_without_enc('exit')
+ else
+ @interp.delete unless @interp.deleted?
+ end
+ end
+ _check_and_return(thread, MultiTkIp_OK.new(ret))
+ # break
+
+ else
+ # raise security error
+ _check_and_return(thread, e)
+ end
+
+ rescue Exception => e
+ # raise exception
+ _check_and_return(thread, e)
+
+ else
+ # no exception
+ _check_and_return(thread, MultiTkIp_OK.new(ret))
+ end
+ end
+
+ def _receiver_eval_proc(last_thread, safe_level, thread, cmd, *args)
+ if thread
+ Thread.new{
+ last_thread.join if last_thread
+ unless @interp.deleted?
+ _receiver_eval_proc_core(safe_level, thread, cmd, *args)
+ end
+ }
+ else
+ Thread.new{
+ unless @interp.deleted?
+ _receiver_eval_proc_core(safe_level, thread, cmd, *args)
+ end
+ }
+ last_thread
+ end
+ end
+
+ private :_receiver_eval_proc, :_receiver_eval_proc_core
+
+ def _receiver_mainloop(check_root)
+ Thread.new{
+ while !@interp.deleted?
+ break if @interp._invoke_without_enc('info', 'command', '.').size == 0
+ sleep 0.5
+ end
+ }
+ end
+
+ def _create_receiver_and_watchdog(lvl = $SAFE)
+ lvl = $SAFE if lvl < $SAFE
+
+ # command-procedures receiver
+ receiver = Thread.new(lvl){|safe_level|
+ last_thread = nil
+ loop do
+ break if @interp.deleted?
+ thread, cmd, *args = @cmd_queue.deq
+ if thread == @system
+ # control command
+ case cmd
+ when 'set_safe_level'
+ begin
+ safe_level = args[0] if safe_level < args[0]
+ rescue Exception
+ end
+ when 'call_mainloop'
+ thread = args.shift
+ _check_and_return(thread,
+ MultiTkIp_OK.new(_receiver_mainloop(*args)))
else
- # no exception
- _check_and_return(thread, MultiTkIp_OK.new(ret))
+ # ignore
end
+
+ else
+ # procedure
+ last_thread = _receiver_eval_proc(last_thread, safe_level,
+ thread, cmd, *args)
end
end
}
@@ -431,6 +492,8 @@ class MultiTkIp
@system = Object.new
+ @wait_on_mainloop = [true, false]
+
@threadgroup = Thread.current.group
@safe_base = false
@@ -848,6 +911,8 @@ class MultiTkIp
@system = Object.new
+ @wait_on_mainloop = [true, false]
+
@threadgroup = ThreadGroup.new
@cmd_queue = Queue.new
@@ -1231,7 +1296,17 @@ class MultiTkIp
# send cmd to the proc-queue
unless req_val
- @cmd_queue.enq([nil, cmd, *args])
+ begin
+ @cmd_queue.enq([nil, cmd, *args])
+ rescue Exception => e
+ # ignore
+ if $DEBUG || true
+ warn("Warning: " + e.class.inspect +
+ ((e.message.length > 0)? ' "' + e.message + '"': '') +
+ " on " + self.inspect)
+ end
+ return e
+ end
return nil
end
@@ -1289,6 +1364,9 @@ class MultiTkIp
end
=end
def eval_proc(*args)
+ # The scope of the eval-block of 'eval_proc' method is different from
+ # the enternal. If you want to pass local values to the eval-block,
+ # use arguments of eval_proc method. They are passed to block-arguments.
if block_given?
cmd = Proc.new
else
@@ -1304,6 +1382,26 @@ class MultiTkIp
end
alias call eval_proc
+ def bg_eval_proc(*args)
+ if block_given?
+ cmd = Proc.new
+ else
+ unless (cmd = args.shift)
+ fail ArgumentError, "A Proc or Method object is expected for 1st argument"
+ end
+ end
+ Thread.new{
+ eval_proc_core(false,
+ proc{|safe, *params|
+ $SAFE=safe; Thread.new(*params, &cmd).value
+ },
+ *args)
+ }
+ end
+ alias background_eval_proc bg_eval_proc
+ alias bg_call bg_eval_proc
+ alias background_call bg_eval_proc
+
def eval_string(cmd, *eval_args)
# cmd string ==> proc
unless cmd.kind_of?(String)
@@ -1313,6 +1411,20 @@ class MultiTkIp
eval_proc_core(true, proc{|safe| $SAFE=safe; Kernel.eval(cmd, *eval_args)})
end
alias eval_str eval_string
+
+ def bg_eval_string(*args)
+ # cmd string ==> proc
+ unless cmd.kind_of?(String)
+ raise RuntimeError, "A String object is expected for the 'cmd' argument"
+ end
+ Thread.new{
+ eval_proc_core(true,
+ proc{|safe| $SAFE=safe; Kernel.eval(cmd, *eval_args)})
+ }
+ end
+ alias background_eval_string bg_eval_string
+ alias bg_eval_str bg_eval_string
+ alias background_eval_str bg_eval_string
end
class << MultiTkIp
@@ -1582,11 +1694,50 @@ end
# depend on TclTkIp
class MultiTkIp
def mainloop(check_root = true, restart_on_dead = false)
- return self if self.slave?
+ #return self if self.slave?
+ #return self if self != @@DEFAULT_MASTER
+ if self != @@DEFAULT_MASTER
+ if @wait_on_mainloop[0]
+ begin
+ @wait_on_mainloop[1] = true
+ @cmd_queue.enq([@system, 'call_mainloop',
+ Thread.current, check_root])
+ Thread.stop
+ rescue MultiTkIp_OK => ret
+ # return value
+ @wait_on_mainloop[1] = false
+ return ret.value.value
+ rescue SystemExit
+ # exit IP
+ warn("Warning: " + $! + " on " + self.inspect) if $DEBUG
+ @wait_on_mainloop[1] = false
+ begin
+ self._eval_without_enc('exit')
+ rescue Exception
+ end
+ self.delete
+ rescue Exception => e
+ if $DEBUG
+ warn("Warning: " + e.class.inspect +
+ ((e.message.length > 0)? ' "' + e.message + '"': '') +
+ " on " + self.inspect)
+ end
+ @wait_on_mainloop[1] = false
+ return e
+ ensure
+ @wait_on_mainloop[1] = false
+ end
+ end
+ return
+ end
+
unless restart_on_dead
+ @wait_on_mainloop[1] = true
@interp.mainloop(check_root)
+ @wait_on_mainloop[1] = false
else
begin
+ @wait_on_mainloop[1] = true
loop do
break unless self.alive?
if check_root
@@ -1605,6 +1756,8 @@ class MultiTkIp
" exception (ignore) : ", $!.message, "\n");
end
retry
+ ensure
+ @wait_on_mainloop[1] = false
end
end
self
@@ -2066,7 +2219,7 @@ end
# Safe Base :: manipulating safe interpreter
class MultiTkIp
- def safeip_configure(slave, slot, value=None)
+ def safeip_configure(slot, value=None)
# use for '-noStatics' option ==> {statics=>false}
# for '-nestedLoadOk' option ==> {nested=>true}
if slot.kind_of?(Hash)
@@ -2111,22 +2264,22 @@ class MultiTkIp
ret
end
- def safeip_delete(slave)
+ def safeip_delete
ip = MultiTkIp.__getip
ip._eval("::safe::interpDelete " + @ip_name)
end
- def safeip_add_to_access_path(slave, dir)
+ def safeip_add_to_access_path(dir)
ip = MultiTkIp.__getip
ip._eval("::safe::interpAddToAccessPath #{@ip_name} #{dir}")
end
- def safeip_find_in_access_path(slave, dir)
+ def safeip_find_in_access_path(dir)
ip = MultiTkIp.__getip
ip._eval("::safe::interpFindInAccessPath #{@ip_name} #{dir}")
end
- def safeip_set_log_cmd(slave, cmd = Proc.new)
+ def safeip_set_log_cmd(cmd = Proc.new)
ip = MultiTkIp.__getip
ip._eval("::safe::setLogCmd #{@ip_name} #{_get_eval_string(cmd)}")
end
diff --git a/ext/tk/lib/remote-tk.rb b/ext/tk/lib/remote-tk.rb
index d09b2289e..77dbacfb1 100644
--- a/ext/tk/lib/remote-tk.rb
+++ b/ext/tk/lib/remote-tk.rb
@@ -96,6 +96,8 @@ class RemoteTkIp
@safe_level = [$SAFE]
+ @wait_on_mainloop = [true, false]
+
@cmd_queue = Queue.new
=begin
@@ -403,6 +405,12 @@ class RemoteTkIp
def do_one_evant(flag = nil)
fail RuntimeError, 'not support "do_one_event" on the remote interpreter'
end
+ def mainloop_abort_on_exception
+ fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter'
+ end
+ def mainloop_abort_on_exception=(mode)
+ fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter'
+ end
def set_eventloop_tick(*args)
fail RuntimeError, 'not support "set_eventloop_tick" on the remote interpreter'
end
@@ -421,24 +429,24 @@ class RemoteTkIp
def get_eventloop_weight
fail RuntimeError, 'not support "get_eventloop_weight" on the remote interpreter'
end
- def mainloop_abort_on_exception
- fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter'
- end
- def mainloop_abort_on_exception=(*args)
- fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter'
- end
end
class << RemoteTkIp
- def mainloop
+ def mainloop(*args)
fail RuntimeError, 'not support "mainloop" on the remote interpreter'
end
- def mainloop_watchdog
+ def mainloop_watchdog(*args)
fail RuntimeError, 'not support "mainloop_watchdog" on the remote interpreter'
end
def do_one_evant(flag = nil)
fail RuntimeError, 'not support "do_one_event" on the remote interpreter'
end
+ def mainloop_abort_on_exception
+ fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter'
+ end
+ def mainloop_abort_on_exception=(mode)
+ fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter'
+ end
def set_eventloop_tick(*args)
fail RuntimeError, 'not support "set_eventloop_tick" on the remote interpreter'
end
@@ -457,10 +465,4 @@ class << RemoteTkIp
def get_eventloop_weight
fail RuntimeError, 'not support "get_eventloop_weight" on the remote interpreter'
end
- def mainloop_abort_on_exception
- fail RuntimeError, 'not support "mainloop_abort_on_exception" on the remote interpreter'
- end
- def mainloop_abort_on_exception=(*args)
- fail RuntimeError, 'not support "mainloop_abort_on_exception=" on the remote interpreter'
- end
end
diff --git a/ext/tk/lib/tk.rb b/ext/tk/lib/tk.rb
index e6a4dd14e..499d71d87 100644
--- a/ext/tk/lib/tk.rb
+++ b/ext/tk/lib/tk.rb
@@ -3756,15 +3756,24 @@ class TkWindow<TkObject
INTERP._invoke('tkwait', 'window', epath)
end
end
+ alias wait_window wait_destroy
def eventloop_wait_destroy
wait_destroy(false)
end
+ alias eventloop_wait_window eventloop_wait_destroy
def thread_wait_destroy
wait_destroy(true)
end
+ alias thread_wait_window thread_wait_destroy
+
alias tkwait_destroy wait_destroy
+ alias tkwait_window wait_destroy
+
alias eventloop_tkwait_destroy eventloop_wait_destroy
+ alias eventloop_tkwait_window eventloop_wait_destroy
+
alias thread_tkwait_destroy thread_wait_destroy
+ alias thread_tkwait_window thread_wait_destroy
def bindtags(taglist=nil)
if taglist
diff --git a/ext/tk/sample/remote-ip_sample2.rb b/ext/tk/sample/remote-ip_sample2.rb
index fcc34b73d..cc7f42448 100644
--- a/ext/tk/sample/remote-ip_sample2.rb
+++ b/ext/tk/sample/remote-ip_sample2.rb
@@ -40,8 +40,11 @@ ip.eval_proc{
}
# setup controller-ip window
-btns.each_with_index{|b, idx|
- TkButton.new(:command=>proc{ip.eval_proc{b.flash}},
+btns.each_with_index{|btn, idx|
+ # The scope of the eval-block of 'eval_proc' method is different from
+ # the enternal. If you want to pass local values to the eval-block,
+ # use arguments of eval_proc method. They are passed to block-arguments.
+ TkButton.new(:command=>proc{ip.eval_proc(btn){|b| b.flash}},
:text=>"flash button-#{idx}",
:padx=>10).pack(:padx=>10, :pady=>2)
}
diff --git a/ext/tk/sample/tkoptdb-safeTk.rb b/ext/tk/sample/tkoptdb-safeTk.rb
index f6c3ca4ee..4b0816d30 100644
--- a/ext/tk/sample/tkoptdb-safeTk.rb
+++ b/ext/tk/sample/tkoptdb-safeTk.rb
@@ -37,6 +37,18 @@ ip = MultiTkIp.new_safeTk{
print "ip.eval_proc{$SAFE} ==> ", ip.eval_proc{$SAFE}, "\n"
+print "\ncall 'ip.wait_on_mainloop = false'\n"
+print "If 'ip.wait_on_mainloop? == true', ",
+ "when 'mainloop' is called on 'ip.eval_proc', ",
+ "'ip.eval_proc' does't return while the root window exists.\n",
+ "If you want to avoid that, set wait_on_mainloop to false. ",
+ "Then the mainloop in the eval_proc returns soon ",
+ "and the following steps are evaluated. \n",
+ "If you hate the both of them, use 'ip.bg_eval_proc' or ",
+ "wrap 'ip.eval_proc' by a thread.\n"
+
+ip.wait_on_mainloop = false
+
ret = ip.eval_proc{
# When a block is given to 'eval_proc' method,
# the block is evaluated on the IP's current safe level.
@@ -46,7 +58,7 @@ ret = ip.eval_proc{
load file
}
-print "ip.eval_proc{}, which includes insecure operiation in the given block, returns an exception object: ", ret.inspect, "\n"
+print "\nip.eval_proc{}, which includes insecure operiation in the given block, returns an exception object: ", ret.inspect, "\n"
print "If a proc object is given, the proc is evaluated on the safe-level which is kept on the proc :: ip.eval_proc( proc{$SAFE} ) ==> ", ip.eval_proc(proc{$SAFE}), "\n"
generated by cgit (git 2.34.1) at 2024-11-20 16:17:39 +0000