1 files changed, 351 insertions, 59 deletions
diff --git a/ext/tcltklib/tcltklib.c b/ext/tcltklib/tcltklib.c
index 990fbc38af..ba7fdc5000 100644
--- a/ext/tcltklib/tcltklib.c
+++ b/ext/tcltklib/tcltklib.c
@@ -48,20 +48,44 @@ int *tclDummyMathPtr = (int *) matherr;
 /*---- module TclTkLib ----*/
 
 struct invoke_queue {
+    Tcl_Event ev;
     int argc;
     VALUE *argv;
     VALUE obj;
     int done;
-    VALUE result;
+    int safe_level;
+    VALUE *result;
     VALUE thread;
-    struct invoke_queue *next;
 };
  
-static struct invoke_queue *iqueue;
 static VALUE main_thread;
+static VALUE eventloop_thread;
+static VALUE watchdog_thread;
+Tcl_Interp  *current_interp;
+
+/* 
+ *  'event_loop_max' is a maximum events which the eventloop processes in one 
+ *  term of thread scheduling. 'no_event_tick' is the count-up value when 
+ *  there are no event for processing. 
+ *  'timer_tick' is a limit of one term of thread scheduling. 
+ *  If 'timer_tick' == 0, then not use the timer for thread scheduling.
+ */
+static int tick_counter;
+#define DEFAULT_EVENT_LOOP_MAX  800
+#define DEFAULT_NO_EVENT_TICK    10
+#define DEFAULT_TIMER_TICK        0
+static int event_loop_max = DEFAULT_EVENT_LOOP_MAX;
+static int no_event_tick  = DEFAULT_NO_EVENT_TICK;
+static int timer_tick     = DEFAULT_TIMER_TICK;
+
+#if TCL_MAJOR_VERSION >= 8
+static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
+#else
+static int ip_ruby _((ClientData, Tcl_Interp *, int, char **));
+#endif
 
 /* Tk_ThreadTimer */
-static Tcl_TimerToken timer_token;
+static Tcl_TimerToken timer_token = (Tcl_TimerToken)NULL;
 
 /* timer callback */
 static void _timer_for_tcl _((ClientData));
@@ -73,44 +97,230 @@ _timer_for_tcl(clientData)
     VALUE thread;
 
     Tk_DeleteTimerHandler(timer_token);
-    timer_token = Tk_CreateTimerHandler(100, _timer_for_tcl, (ClientData)0);
-
-    CHECK_INTS;
-    q = iqueue;
-    while (q) {
-	tmp = q;
-	q = q->next;
-	if (!tmp->done) {
-	    tmp->done = 1;
-	    tmp->result = ip_invoke_real(tmp->argc, tmp->argv, tmp->obj);
-	    thread = tmp->thread;
-	    tmp = tmp->next;
-	    rb_thread_run(thread);
+    if (timer_tick > 0) {
+      timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, 
+					  (ClientData)0);
+    } else {
+      timer_token = (Tcl_TimerToken)NULL;
+    }
+
+    /* rb_thread_schedule(); */
+    timer_tick += event_loop_max;
+}
+
+static VALUE
+set_eventloop_tick(self, tick)
+    VALUE self;
+    VALUE tick;
+{
+    int ttick = NUM2INT(tick);
+
+    if (ttick < 0) {
+      rb_raise(rb_eArgError, "timer-tick parameter must be 0 or plus number");
+    }
+
+    /* delete old timer callback */
+    Tk_DeleteTimerHandler(timer_token);
+
+    timer_tick = ttick;
+    if (timer_tick > 0) {
+      /* start timer callback */
+      timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, 
+					  (ClientData)0);
+    } else {
+      timer_token = (Tcl_TimerToken)NULL;
+    }
+
+    return tick;
+}
+
+static VALUE
+get_eventloop_tick(self)
+    VALUE self;
+{
+    return INT2NUM(timer_tick);
+}
+
+static VALUE
+set_eventloop_weight(self, loop_max, no_event)
+    VALUE self;
+    VALUE loop_max;
+    VALUE no_event;
+{
+    int lpmax = NUM2INT(loop_max);
+    int no_ev = NUM2INT(no_event);
+
+    if (lpmax <= 0 || no_ev <= 0) {
+      rb_raise(rb_eArgError, "weight parameters must be plus number");
+    }
+
+    event_loop_max = lpmax;
+    no_event_tick  = no_ev;
+
+    return rb_ary_new3(2, loop_max, no_event);
+}
+
+static VALUE
+get_eventloop_weight(self)
+    VALUE self;
+{
+    return rb_ary_new3(2, INT2NUM(event_loop_max), INT2NUM(no_event_tick));
+}
+
+VALUE
+lib_mainloop_core(check_root_widget)
+    VALUE check_root_widget;
+{
+    VALUE current = eventloop_thread;
+    int check = (check_root_widget == Qtrue);
+
+    Tk_DeleteTimerHandler(timer_token);
+    if (timer_tick > 0) {
+      timer_token = Tk_CreateTimerHandler(timer_tick, _timer_for_tcl, 
+					  (ClientData)0);
+    } else {
+      timer_token = (Tcl_TimerToken)NULL;
+    }
+
+    for(;;) {
+      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;
 	}
+	if (watchdog_thread != 0 && eventloop_thread != current) {
+	  return Qnil;
+	}
+      }
+      if (check && Tk_GetNumMainWindows() == 0) {
+	break;
+      }
+      rb_thread_schedule();
     }
-    rb_thread_schedule();
+    return Qnil;
 }
 
-#if TCL_MAJOR_VERSION >= 8
-static int ip_ruby _((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST*));
-#else
-static int ip_ruby _((ClientData, Tcl_Interp *, int, char **));
-#endif
+
+VALUE
+lib_mainloop_ensure(parent_evloop)
+    VALUE parent_evloop;
+{
+    if (ruby_debug) { 
+      fprintf(stderr, "tcltklib: eventloop-thread : %lx -> %lx\n", 
+	      eventloop_thread, parent_evloop);
+    }
+
+    Tk_DeleteTimerHandler(timer_token);
+    timer_token = (Tcl_TimerToken)NULL;
+    eventloop_thread = parent_evloop;
+    return Qnil;
+}
+
+static VALUE
+lib_mainloop_launcher(check_rootwidget)
+    VALUE check_rootwidget;
+{
+    VALUE parent_evloop = eventloop_thread;
+
+    eventloop_thread = rb_thread_current();
+
+    if (ruby_debug) { 
+      fprintf(stderr, "tcltklib: eventloop-thread : %lx -> %lx\n", 
+	      parent_evloop, eventloop_thread);
+    }
+
+    return rb_ensure(lib_mainloop_core, check_rootwidget, 
+		     lib_mainloop_ensure, parent_evloop);
+}
 
 /* execute Tk_MainLoop */
 static VALUE
-lib_mainloop(self)
+lib_mainloop(argc, argv, self)
+    int   argc;
+    VALUE *argv;
     VALUE self;
 {
-    timer_token = Tk_CreateTimerHandler(100, _timer_for_tcl, (ClientData)0);
-    DUMP1("start Tk_Mainloop");
-    Tk_MainLoop();
-    DUMP1("stop Tk_Mainloop");
-    Tk_DeleteTimerHandler(timer_token);
+    VALUE check_rootwidget;
+
+    if (rb_scan_args(argc, argv, "01", &check_rootwidget) == 0) {
+      check_rootwidget = Qtrue;
+    } else if (RTEST(check_rootwidget)) {
+      check_rootwidget = Qtrue;
+    } else {
+      check_rootwidget = Qfalse;
+    }
+
+    return lib_mainloop_launcher(check_rootwidget);
+}
+
+static VALUE
+lib_mainloop_watchdog(argc, argv, self)
+    int   argc;
+    VALUE *argv;
+    VALUE self;
+{
+    VALUE check_rootwidget;
+    VALUE evloop;
+    int   check;
+    ID    stop;
+
+    if (rb_scan_args(argc, argv, "01", &check_rootwidget) == 0) {
+      check_rootwidget = Qtrue;
+    } else if (RTEST(check_rootwidget)) {
+      check_rootwidget = Qtrue;
+    } else {
+      check_rootwidget = Qfalse;
+    }
+    check = (check_rootwidget == Qtrue);
+    stop = rb_intern("stop?");
+
+    /* 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;
+      }
+    }
+    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);
+      }
+      rb_thread_schedule();
+    } while(!check || Tk_GetNumMainWindows() != 0);
 
     return Qnil;
 }
 
+static VALUE
+lib_do_one_event(argc, argv, self)
+    int   argc;
+    VALUE *argv;
+    VALUE self;
+{
+    VALUE obj, vflags;
+    int flags;
+
+    if (rb_scan_args(argc, argv, "01", &vflags) == 0) {
+      flags = 0;
+    } else {
+      Check_Type(vflags, T_FIXNUM);
+      flags = FIX2INT(vflags);
+    }
+    return INT2NUM(Tcl_DoOneEvent(flags));
+}
+
 /*---- class TclTkIp ----*/
 struct tcltkip {
     Tcl_Interp *ip;		/* the interpreter */
@@ -245,6 +455,7 @@ ip_new(self)
     /* from Tk_Main() */
     DUMP1("Tcl_CreateInterp");
     ptr->ip = Tcl_CreateInterp();
+    current_interp = ptr->ip;
 
     /* from Tcl_AppInit() */
     DUMP1("Tcl_Init");
@@ -459,48 +670,103 @@ ip_invoke_real(argc, argv, obj)
     return rb_str_new2(ptr->ip->result);
 }
 
+VALUE
+ivq_safelevel_handler(arg, ivq)
+    VALUE arg;
+    VALUE ivq;
+{
+    struct invoke_queue *q;
+
+    Data_Get_Struct(ivq, struct invoke_queue, q);
+    DUMP2("(safe-level handler) $SAFE = %d", q->safe_level);
+    rb_set_safe_level(q->safe_level);
+    return ip_invoke_real(q->argc, q->argv, q->obj);
+}
+
+int
+invoke_queue_handler(evPtr, flags)
+    Tcl_Event *evPtr;
+    int flags;
+{
+    struct invoke_queue *tmp, *q = (struct invoke_queue *)evPtr;
+
+    DUMP1("do_invoke_queue_handler");
+    DUMP2("invoke queue_thread : %lx", rb_thread_current());
+    DUMP2("added by thread : %lx", q->thread);
+
+    if (q->done) {
+      /* processed by another event-loop */
+      return 0;
+    }
+
+    /* process it */
+    q->done = 1;
+
+    /* 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);
+    } else {
+      *(q->result) = ip_invoke_real(q->argc, q->argv, q->obj);
+    }
+
+    /* back to caller */
+    rb_thread_run(q->thread);
+
+    /* end of handler : remove it */
+    return 1;
+}
+
 static VALUE
 ip_invoke(argc, argv, obj)
     int argc;
     VALUE *argv;
     VALUE obj;
 {
-    struct invoke_queue *tmp, *p;
-    VALUE result = rb_thread_current();
+    struct invoke_queue *tmp;
+    VALUE current = rb_thread_current();
+    VALUE result;
+    VALUE *alloc_argv, *alloc_result;
+    Tcl_QueuePosition position;
 
-    if (result == main_thread) {
-	return ip_invoke_real(argc, argv, obj);
+    if (eventloop_thread == 0 || current == eventloop_thread) {
+      DUMP2("invoke from current eventloop %lx", current);
+      return ip_invoke_real(argc, argv, obj);
     }
-    tmp = ALLOC(struct invoke_queue);
+
+    DUMP2("invoke from thread %lx (NOT current eventloop)", current);
+
+    /* allocate memory (protected from Tcl_ServiceEvent) */
+    alloc_argv =  ALLOC_N(VALUE,argc);
+    MEMCPY(alloc_argv, argv, VALUE, argc);
+    alloc_result = ALLOC(VALUE);
+
+    /* allocate memory (freed by Tcl_ServiceEvent */
+    tmp = (struct invoke_queue *)Tcl_Alloc(sizeof(struct invoke_queue));
+
+    /* construct event data */
+    tmp->done = 0;
     tmp->obj = obj;
     tmp->argc = argc;
-    tmp->argv = ALLOC_N(VALUE, argc);
-    MEMCPY(tmp->argv, argv, VALUE, argc);
-    tmp->thread = result;
-    tmp->done = 0;
+    tmp->argv = alloc_argv;
+    tmp->result = alloc_result;
+    tmp->thread = current;
+    tmp->safe_level = rb_safe_level();
+    tmp->ev.proc = invoke_queue_handler;
+    position = TCL_QUEUE_TAIL;
 
-    tmp->next = iqueue;
-    iqueue = tmp;
+    /* add the handler to Tcl event queue */
+    Tcl_QueueEvent(&tmp->ev, position);
 
+    /* wait for the handler to be processed */
     rb_thread_stop();
-    result = tmp->result;
-    if (iqueue == tmp) {
-	iqueue = tmp->next;
-	free(tmp->argv);
-	free(tmp);
-	return result;
-    }
 
-    p = iqueue;
-    while (p->next) {
-	if (p->next == tmp) {
-	    p->next = tmp->next;
-	    free(tmp->argv);
-	    free(tmp);
-	    break;
-	}
-	p = p->next;
-    }
+    /* get result & free allocated memory */
+    result = *alloc_result;
+    free(alloc_argv);
+    free(alloc_result);
+
     return result;
 }
 
@@ -533,6 +799,14 @@ Init_tcltklib()
     VALUE lib = rb_define_module("TclTkLib");
     VALUE ip = rb_define_class("TclTkIp", rb_cObject);
 
+    VALUE ev_flag = rb_define_module_under(lib, "EventFlag");
+    rb_define_const(ev_flag, "WINDOW",    INT2FIX(TCL_WINDOW_EVENTS));
+    rb_define_const(ev_flag, "FILE",      INT2FIX(TCL_FILE_EVENTS));
+    rb_define_const(ev_flag, "TIMER",     INT2FIX(TCL_TIMER_EVENTS));
+    rb_define_const(ev_flag, "IDLE",      INT2FIX(TCL_IDLE_EVENTS));
+    rb_define_const(ev_flag, "ALL",       INT2FIX(TCL_ALL_EVENTS));
+    rb_define_const(ev_flag, "DONT_WAIT", INT2FIX(TCL_DONT_WAIT));
+
 #if defined USE_TCL_STUBS && defined USE_TK_STUBS
     extern int ruby_tcltk_stubs();
     int ret = ruby_tcltk_stubs();
@@ -543,7 +817,16 @@ Init_tcltklib()
     eTkCallbackBreak = rb_define_class("TkCallbackBreak", rb_eStandardError);
     eTkCallbackContinue = rb_define_class("TkCallbackContinue",rb_eStandardError);
 
-    rb_define_module_function(lib, "mainloop", lib_mainloop, 0);
+    rb_define_module_function(lib, "mainloop", lib_mainloop, -1);
+    rb_define_module_function(lib, "mainloop_watchdog", 
+			      lib_mainloop_watchdog, -1);
+    rb_define_module_function(lib, "do_one_event", lib_do_one_event, -1);
+    rb_define_module_function(lib, "set_eventloop_tick",set_eventloop_tick,1);
+    rb_define_module_function(lib, "get_eventloop_tick",get_eventloop_tick,0);
+    rb_define_module_function(lib, "set_eventloop_weight", 
+			      set_eventloop_weight, 2);
+    rb_define_module_function(lib, "get_eventloop_weight", 
+			      get_eventloop_weight, 0);
 
     rb_define_singleton_method(ip, "new", ip_new, 0);
     rb_define_method(ip, "_eval", ip_eval, 1);
@@ -551,10 +834,19 @@ Init_tcltklib()
     rb_define_method(ip, "_fromUTF8",ip_fromUTF8,2);
     rb_define_method(ip, "_invoke", ip_invoke, -1);
     rb_define_method(ip, "_return_value", ip_retval, 0);
-    rb_define_method(ip, "mainloop", lib_mainloop, 0);
+    rb_define_method(ip, "mainloop", lib_mainloop, -1);
+    rb_define_method(ip, "mainloop_watchdog", lib_mainloop_watchdog, -1);
+    rb_define_method(ip, "do_one_event", lib_do_one_event, -1);
+    rb_define_method(ip, "set_eventloop_tick", set_eventloop_tick, 1);
+    rb_define_method(ip, "get_eventloop_tick", get_eventloop_tick, 0);
+    rb_define_method(ip, "set_eventloop_weight", set_eventloop_weight, 2);
+    rb_define_method(ip, "get_eventloop_weight", get_eventloop_weight, 0);
     rb_define_method(ip, "restart", lib_restart, 0);
 
     main_thread = rb_thread_current();
+    eventloop_thread = 0;
+    watchdog_thread  = 0;
+
 #ifdef __MACOS__
     _macinit();
 #endif