File mk4tcl/patches/all/metakit-2.4.9.7-fixeventchannels-1pt.diff artifact 8e303e1d43 part of check-in ae7d9fc61b

diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.cpp metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp
--- metakit-2.4.9.7.orig/tcl/mk4tcl.cpp	2007-06-18 16:05:24.000000000 -0500
+++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.cpp	2010-10-16 16:21:41.000000000 -0500
@@ -182,6 +182,8 @@
     Tcl_Channel _chan;
     int _validMask;
     int _watchMask;
+    int _flags;
+    SiasStrategy *_next;
     Tcl_Interp *_interp;
 
     SiasStrategy(c4_Storage &storage_, const c4_View &view_, const c4_BytesProp
@@ -259,23 +261,58 @@
 ///////////////////////////////////////////////////////////////////////////////
 // New in 1.2: channel interface to memo fields
 
-typedef SiasStrategy MkChannel;
-
 typedef struct {
   Tcl_Event header;
   MkChannel *chan;
+  int flags;
 } MkEvent;
 
+#define CHANNEL_FLAG_PENDING (1<<1)
+
 static int mkEventProc(Tcl_Event *evPtr, int flags) {
   MkEvent *me = (MkEvent*)evPtr;
 
-  if (!(flags &TCL_FILE_EVENTS))
+  if (!(flags & TCL_FILE_EVENTS))
     return 0;
 
-  Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask);
+  me->chan->_flags &= ~CHANNEL_FLAG_PENDING;
+  Tcl_NotifyChannel(me->chan->_chan, me->chan->_watchMask & me->flags);
   return 1;
 }
 
+static void SetupProc(ClientData clientData, int flags) {
+  MkWorkspace *ws = (MkWorkspace *)clientData;
+  int msec = 10000;
+  Tcl_Time blockTime = {0, 0};
+  if (!(flags & TCL_FILE_EVENTS))
+    return;
+  for (MkChannel *chan = ws->_chanList; chan != NULL; chan = chan->_next) {
+    msec = 10;
+  }
+  blockTime.sec = msec / 1000;
+  blockTime.usec = (msec % 1000) * 1000;
+  Tcl_SetMaxBlockTime(&blockTime);
+}
+
+static void CheckProc(ClientData clientData, int flags) {
+  MkWorkspace *ws = (MkWorkspace *)clientData;
+  if (!(flags & TCL_FILE_EVENTS))
+    return;
+  for (MkChannel *chan = ws->_chanList; chan != NULL; chan = chan->_next) {
+    if (chan->_watchMask == 0)
+      continue;
+    int mask = TCL_WRITABLE | TCL_READABLE;
+    if (chan->_watchMask & mask) {
+      MkEvent *me = (MkEvent *)ckalloc(sizeof(MkEvent));
+      chan->_flags |= CHANNEL_FLAG_PENDING;
+      me->header.proc = mkEventProc;
+      me->chan = chan;
+      me->flags = mask;
+      Tcl_QueueEvent((Tcl_Event *)me, TCL_QUEUE_TAIL);
+    }
+  }
+}
+
 static int mkEventFilter(Tcl_Event *evPtr, ClientData instanceData) {
   MkEvent *me = (MkEvent*)evPtr;
   MkChannel *chan = (MkChannel*)instanceData;
@@ -285,6 +322,16 @@
 static int mkClose(ClientData instanceData, Tcl_Interp *interp) {
   MkChannel *chan = (MkChannel*)instanceData;
 
+  /* remove this channel from the package list */
+  if (interp) {
+    MkWorkspace *ws = (MkWorkspace*)Tcl_GetAssocData(interp, "mk4tcl", 0);
+    MkChannel **tmpPtrPtr = &ws->_chanList;
+    while (*tmpPtrPtr && *tmpPtrPtr != chan) {
+      tmpPtrPtr = &(*tmpPtrPtr)->_next;
+    }
+    *tmpPtrPtr = chan->_next;
+  }
+  
   Tcl_DeleteEvents(mkEventFilter, (ClientData)chan);
   chan->_chan = 0;
   delete chan;
@@ -726,7 +773,7 @@
   ++generation; // make sure all cached paths refresh on next access
 }
 
-MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_) {
+MkWorkspace::MkWorkspace(Tcl_Interp *ip_): _interp(ip_), _chanList(NULL) {
   new Item("", "", 0, _items, 0);
 
   // never uses entry zero (so atoi failure in ForgetPath is harmless)
@@ -741,6 +788,7 @@
     delete Nth(i);
 
   // need this to prevent recursion in Tcl_DeleteAssocData in 8.2 (not 8.0!)
+  Tcl_DeleteEventSource(SetupProc, CheckProc, this);
   Tcl_SetAssocData(_interp, "mk4tcl", 0, 0);
   Tcl_DeleteAssocData(_interp, "mk4tcl");
 }
@@ -2371,6 +2419,7 @@
 
   mkChan->_watchMask = 0;
   mkChan->_validMask = mode;
+  mkChan->_flags = 0;
   mkChan->_interp = interp;
   mkChan->_chan = Tcl_CreateChannel(&mkChannelType, buffer, (ClientData)mkChan,
     mode);
@@ -2380,6 +2429,10 @@
 
   Tcl_RegisterChannel(interp, mkChan->_chan);
 
+  /* insert this channel at the front of the workspace channels list */
+  mkChan->_next = work._chanList;
+  work._chanList = mkChan;
+
   if (_error)
     return _error;
 
@@ -2603,6 +2656,7 @@
     // since that does not seem to trigger exitproc handling (!)
     Tcl_SetAssocData(interp, "mk4tcl", DelProc, ws);
     Tcl_CreateExitHandler(ExitProc, ws);
+    Tcl_CreateEventSource(SetupProc, CheckProc, ws);
   }
 
   // this list must match the "CmdDef defTab []" above.
@@ -2648,3 +2702,11 @@
 }
 
 ///////////////////////////////////////////////////////////////////////////////
+
+/*
+ * Local variables:
+ * mode: c
+ * c-basic-offset: 2
+ * indent-tabs-mode: nil
+ * End:
+ */
diff -uNr metakit-2.4.9.7.orig/tcl/mk4tcl.h metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h
--- metakit-2.4.9.7.orig/tcl/mk4tcl.h	2007-06-15 18:26:40.000000000 -0500
+++ metakit-2.4.9.7-1ptrsk/tcl/mk4tcl.h	2010-10-16 16:19:00.000000000 -0500
@@ -205,6 +205,9 @@
 ///////////////////////////////////////////////////////////////////////////////
 // A workspace manages a number of storage objects and their associated paths.
 
+class SiasStrategy;
+typedef SiasStrategy MkChannel;
+
 class MkWorkspace {
     c4_PtrArray _items; // items, or null if released
     c4_Bytes _usedBuffer; // buffer, using 1 byte per entry
@@ -213,6 +216,7 @@
 
   public:
     Tcl_Interp *_interp;
+    MkChannel *_chanList;
 
     struct Item {
         const c4_String _name; // the alias for this storage