#! /bin/bash

TMPFILE="${TMPDIR:-/tmp}/DELETEME_testmk4vfs-$$${RANDOM}${RANDOM}${RANDOM}.mk"
export TMPFILE

cat << \__EOF__ | base64 -d | gzip -dc > "${TMPFILE}"
H4sICMoPukwCA3Rlc3QubWsA8/KRYmBgYKu3KcrPL7FjYGcAgf8NDQ2N7R1t/Q2NU5umNexJySwq
js5LzE21CtYpSCxKzSux8tRJy8xJhYsWZ1alAsVSEktAVHJ+Xj9TQ2PXnzbGtoYmxp4Wxj7Wfvb5
TTcQxk69xaycXJRfXKxXkJfOwAW2tp/pAe8un84AP3deLimQEK+nh0sQkBYAYQ42ICn/+X8ikGJJ
d/R1ZGBYf8KcteslkC9Z4hpREpyfVlIOdB2DY0p+UqqCZ25iempQamJKZeHJVBsGBiZFTxfHEIvT
Uye/9hMOFGnt7DzZeX5BWGfbiYkNR6Sdotk01vJyqF343Rq3pGHL0rdLfBeaveL3rRGaz+1y9N6G
SzPLrC4/XTfDS1f14XG/cynnfn1bs/U7D4PEDp+r152un7MrjxcwttK6F/6Gv+jm297rOX7O+gt0
z71ZNPWcU7d6tUJpfMN15kQTs20fXj899fzVo0t76xv2Jz25v9B1qaqLifl2a4Gbu4+ttJ510WLC
6cW1dmbRj59KXp4a7KB1NoozMPvtPka7uqZpZ7cyZrA4xXz7YVnavkmW+cXeN/wPKv7tjBJ7tq4s
8kIS57J9fStnzWC8V98wy2uxHE/zLuebXUw399o/7zrp9CiyLK/j7Am17JZrV9NK2t/sYf32SeUM
40ydlH7+qZabo+bNS/y7vEBKbHJMHG/kpsffGPnMFZYFzpx73cut8W/9fnYFS9u3gYwmvDfmHOiS
veE5KZ+bSzj4j1PDk4Lik08bhfoYPCe2aCq4lWk4VF7t23Sv433y4z8xDmffPZp0mVd1C98FCdV2
bpFpUXOMMtS7TzukMG8VP61hU9NzeGHiPdYFZx9dkfX6IFrq67DIf/mGK4+WNIrO89mw+KN71tUU
tibFORFrLKQkjx5c63iP8UIap+lsZi8FlsyrjFzeunaXy5l+mxkd28d3P7xeitXjGusfidqGv9JW
C08z5U4LiI1wOmmwNjDCNlP+nmxSPNv7FelHbRWnfXFb+KFk0tffM/lKtt/893X2odbkPTl/2Yp2
Lzl+++0+EVBi9HT1c1nnlNCEmZAZJzWxLUSk5Glsi8nKISVARcVWTrGxjT1sOxvAGYC5HUg7AWlX
Lx9Q+md6MZoZRjPDIMoMFCb07veQdM6WD6SBSZZNDwAplnesfwYAAA==
__EOF__

#! /usr/bin/env tclsh

set haveMk4vfs 0
catch {
	package require vfs::mk4
	set haveMk4vfs 1
}

if {!$haveMk4vfs} {
	# This test only applies to kits that include Mk4vfs
	exit 0
}

set TMPFILE $::env(TMPFILE)

set ::fcopy_complete 0
proc fcopy_complete {args} {
	set ::fcopy_complete 1
}

vfs::mk4::Mount $TMPFILE /TEST
set fd [open /TEST/cross.png]
fconfigure $fd -translation binary
set out [open /dev/null w]
fcopy $fd $out -command fcopy_complete
after 3000
update

if {$::fcopy_complete != 1} {
	puts "Expected:  Fcopy Complete = 1"
	puts "Got:       Fcopy Complete = $::fcopy_complete"
	exit 1
}

exit 0

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