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