TIP#219 IMPLEMENTATION

	* doc/SetChanErr.3: ** New File **. Documentation of the new
	  channel API functions.
	* generic/tcl.decls:  Stub declarations of the new channel API.
	* generic/tclDecls.h: Regenerated
	* generic/tclStubInit.c:

	* tclIORChan.c: ** New File **. Implementation of the reflected
	  channel.
	* generic/tclInt.h: Integration of reflected channel and new error
	* generic/tclIO.c:  propagation into the generic I/O core.
	* generic/tclIOCmd.c:
	* generic/tclIO.h:
	* library/init.tcl:

	* tests/io.test:    Extended testsuite.
	* tests/ioCmd.test:
	* tests/chan.test:
	* generic/tclTest.c:
	* generic/tclThreadTest.c:

	* unix/Makefile.in: Integration into the build machinery.
	* win/Makefile.in:
	* win/Makefile.vc:

20 files changed, 7028 insertions, 89 deletions

diff --git a/ChangeLog b/ChangeLog
index 2b5a7b4..08f3632 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,31 @@
+2005-08-24  Andreas Kupries <andreask@activestate.com>
+
+	TIP#219 IMPLEMENTATION
+
+	* doc/SetChanErr.3: ** New File **. Documentation of the new
+	  channel API functions.	
+	* generic/tcl.decls:  Stub declarations of the new channel API.
+	* generic/tclDecls.h: Regenerated
+	* generic/tclStubInit.c:
+
+	* tclIORChan.c: ** New File **. Implementation of the reflected
+	  channel.
+	* generic/tclInt.h: Integration of reflected channel and new error
+	* generic/tclIO.c:  propagation into the generic I/O core.
+	* generic/tclIOCmd.c:
+	* generic/tclIO.h:
+	* library/init.tcl:
+
+	* tests/io.test:    Extended testsuite.
+	* tests/ioCmd.test:
+	* tests/chan.test:
+	* generic/tclTest.c:
+	* generic/tclThreadTest.c:
+
+	* unix/Makefile.in: Integration into the build machinery.
+	* win/Makefile.in:
+	* win/Makefile.vc:
+
 2005-08-24  Kevin Kenny  <kennykb@acm.org>
 
 	* generic/tclStrToD.c (Tcl_DoubleDigits): Fixed the corner cases of
diff --git a/doc/SetChanErr.3 b/doc/SetChanErr.3
new file mode 100644
index 0000000..881768f
--- /dev/null
+++ b/doc/SetChanErr.3
@@ -0,0 +1,155 @@
+'\"
+'\" Copyright (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: @(#) $Id: SetChanErr.3,v 1.1 2005/08/24 17:56:23 andreas_kupries Exp $
+.so man.macros
+.TH Tcl_SetChannelError 3 8.5 Tcl "Tcl Library Procedures"
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+Tcl_SetChannelError, Tcl_SetChannelErrorInterp, Tcl_GetChannelError, Tcl_GetChannelErrorInterp \- functions to create/intercept Tcl errors by channel drivers.
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_SetChannelError\fR(\fIchan, msg\fR)
+.sp
+void
+\fBTcl_SetChannelErrorInterp\fR(\fIinterp, msg\fR)
+.sp
+void
+\fBTcl_GetChannelError\fR(\fIchan, msgPtr\fR)
+.sp
+void
+\fBTcl_GetChannelErrorInterp\fR(\fIinterp, msgPtr\fR)
+.sp
+.SH ARGUMENTS
+.AS Tcl_Channel chan
+.AP Tcl_Channel chan in
+Refers to the Tcl channel whose bypass area is accessed.
+.AP Tcl_Interp* interp in
+Refers to the Tcl interpreter whose bypass area is accessed.
+.AP Tcl_Obj* msg in
+Error message put into a bypass area.  A list of return options and
+values, followed by a string message.  Both message and the
+option/value information are optional.
+.AP Tcl_Obj** msgPtr out
+Reference to a place where the message stored in the accessed bypass
+area can be stored in.
+.BE
+.SH DESCRIPTION
+.PP
+The current definition of a Tcl channel driver does not permit the
+direct return of arbitrary error messages, except for the setting and
+retrieval of channel options. All other functions are restricted to
+POSIX error codes.
+.PP
+The functions described here overcome this limitation. Channel drivers
+are allowed to use \fBTcl_SetChannelError\fR and
+\fBTcl_SetChannelErrorInterp\fR to place arbitrary error messages in
+\fBbypass areas\fI defined for channels and interpreters. And the
+generic I/O layer uses \fBTcl_GetChannelError\fR and
+\fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass
+areas and arrange for their return as errors. The posix error codes
+set by a driver are used now if and only if no messages are present.
+.PP
+\fBTcl_SetChannelError\fR stores error information in the bypass area
+of the specified channel. The number of references to the \fBmsg\fI
+object goes up by one. Previously stored information will be
+discarded, by releasing the reference held by the channel. The channel
+reference must not be NULL.
+.PP
+\fBTcl_SetChannelErrorInterp\fR stores error information in the bypass
+area of the specified interpreter. The number of references to the
+\fBmsg\fI object goes up by one. Previously stored information will be
+discarded, by releasing the reference held by the interpreter. The
+interpreter reference must not be NULL.
+.PP
+\fBTcl_GetChannelError\fR places either the error message held in the
+bypass area of the specified channel into \fImsgPtr\fR, or NULL; and
+resets the bypass. I.e. after an invokation all following invokations
+will return NULL, until an intervening invokation of
+\fBTcl_SetChannelError\fR with a non-NULL message. The \fImsgPtr\fR
+must not be NULL. The reference count of the message is not touched.
+The reference previously held by the channel is now held by the caller
+of the function and it is its responsibility to release that reference
+when it is done with the object.
+.PP
+\fBTcl_GetChannelErrorInterp\fR places either the error message held
+in the bypass area of the specified interpreter into \fImsgPtr\fR, or
+NULL; and resets the bypass. I.e. after an invokation all following
+invokations will return NULL, until an intervening invokation of
+\fBTcl_SetChannelErrorInterp\fR with a non-NULL message. The
+\fImsgPtr\fR must not be NULL. The reference count of the message is
+not touched.  The reference previously held by the interpreter is now
+held by the caller of the function and it is its responsibility to
+release that reference when it is done with the object.
+.PP
+Which functions of a channel driver are allowed to use which bypass
+function is listed below, as is which functions of the public channel
+API may leave a messages in the bypass areas.
+.PP
+.IP \fBTcl_DriverCloseProc\fR
+May use \fBTcl_SetChannelErrorInterp\fR, and only this function.
+.IP \fBTcl_DriverInputProc\fR
+May use \fBTcl_SetChannelError\fR, and only this function.
+.IP \fBTcl_DriverOutputProc\fR
+May use \fBTcl_SetChannelError\fR, and only this function.
+.IP \fBTcl_DriverSeekProc\fR
+May use \fBTcl_SetChannelError\fR, and only this function.
+.IP \fBTcl_DriverWideSeekProc
+May use \fBTcl_SetChannelError\fR, and only this function.
+.IP \fBTcl_DriverSetOptionProc\fR
+Has already the ability to pass arbitrary error messages. Must
+\fBnot\fR use any of the new functions.
+.IP \fBTcl_DriverGetOptionProc\fR
+Has already the ability to pass arbitrary error messages. Must
+\fBnot\fR use any of the new functions.
+.IP \fBTcl_DriverWatchProc\fR
+Must \fBnot\fR use any of the new functions. Is internally called and
+has no ability to return any type of error whatsoever.
+.IP \fBTcl_DriverBlockModeProc\fR
+May use \fBTcl_SetChannelError\fR, and only this function.
+.IP \fBTcl_DriverGetHandleProc\fR
+Must \fBnot\fR use any of the new functions. It is only a low-level
+function, and not used by Tcl commands.
+.IP \fBTcl_DriverHandlerProc\fR
+Must \fBnot\fR use any of the new functions. Is internally called and
+has no ability to return any type of error whatsoever.
+.PP
+Given the information above the following public functions of the Tcl
+C API are affected by these changes. I.e. when these functions are
+called the channel may now contain a stored arbitrary error message
+requiring processing by the caller.
+.PP
+.IP \fBTcl_StackChannel\fR
+.IP \fBTcl_Seek\fR
+.IP \fBTcl_Tell\fR
+.IP \fBTcl_ReadRaw\fR
+.IP \fBTcl_Read\fR
+.IP \fBTcl_ReadChars\fR
+.IP \fBTcl_Gets\fR
+.IP \fBTcl_GetsObj\fR
+.IP \fBTcl_Flush\fR
+.IP \fBTcl_WriteRaw\fR
+.IP \fBTcl_WriteObj\fR
+.IP \fBTcl_Write\fR
+.IP \fBTcl_WriteChars\fR
+.PP
+All other API functions are unchanged. Especially the functions below
+leave all their error information in the interpreter result.
+.PP
+.IP \fBTcl_Close\fR
+.IP \fBTcl_UnregisterChannel\fR
+.IP \fBTcl_UnstackChannel\fR
+.PP
+
+.SH "SEE ALSO"
+Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3)
+
+.SH KEYWORDS
+channel driver, error messages, channel type
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 6dd904e..b6417ff 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tcl.decls,v 1.112 2005/06/06 23:45:42 dkf Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.113 2005/08/24 17:56:23 andreas_kupries Exp $
 
 library tcl
 
@@ -2013,6 +2013,21 @@ declare 560 generic {
 	    Tcl_ChannelType *chanTypePtr)
 }
 
+# TIP#219 (Tcl Channel Reflection API) akupries
+
+declare 561 generic {
+    void Tcl_SetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj* msg)
+}
+declare 562 generic {
+    void Tcl_GetChannelErrorInterp (Tcl_Interp* interp, Tcl_Obj** msg)
+}
+declare 563 generic {
+    void Tcl_SetChannelError (Tcl_Channel chan, Tcl_Obj* msg)
+}
+declare 564 generic {
+    void Tcl_GetChannelError (Tcl_Channel chan, Tcl_Obj** msg)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface.  These functions are
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 04582b7..df4abd8 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.166 2005/08/17 23:48:33 georgeps Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.167 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -401,6 +401,9 @@ Tcl_CreateInterp()
 
     iPtr->execEnvPtr = TclCreateExecEnv(interp);
 
+    /* TIP #219, Tcl Channel Reflection API */
+    iPtr->chanMsg  = NULL;
+
     /*
      * Initialize the compilation and execution statistics kept for this
      * interpreter.
@@ -527,9 +530,18 @@ Tcl_CreateInterp()
     Tcl_CreateObjCommand(interp,	"::tcl::clock::Oldscan",
 	    TclClockOldscanObjCmd,	(ClientData) NULL,
 	    (Tcl_CmdDeleteProc*) NULL);
+    /* TIP #208 */
     Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
 	    TclChanTruncateObjCmd, (ClientData) NULL,
 	    (Tcl_CmdDeleteProc*) NULL);
+    /* TIP #219 */
+    Tcl_CreateObjCommand(interp, "::tcl::chan::rCreate",
+	    TclChanCreateObjCmd, (ClientData) NULL,
+	    (Tcl_CmdDeleteProc*) NULL);
+
+    Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
+	    TclChanPostEventObjCmd, (ClientData) NULL,
+	    (Tcl_CmdDeleteProc*) NULL);
 
     /*
      * Register the built-in functions
@@ -972,6 +984,15 @@ Tcl_DeleteInterp(interp)
     iPtr->flags |= DELETED;
     iPtr->compileEpoch++;
 
+    /* TIP #219, Tcl Channel Reflection API.
+     * Discard a leftover state.
+     */
+
+    if (iPtr->chanMsg != NULL) {
+        Tcl_DecrRefCount (iPtr->chanMsg);
+	iPtr->chanMsg = NULL;
+    }
+
     /*
      * Ensure that the interpreter is eventually deleted.
      */
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index c410983..d10cb4c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclDecls.h,v 1.114 2005/06/07 02:07:24 dgp Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.115 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #ifndef _TCLDECLS
@@ -3496,6 +3496,30 @@ EXTERN int		Tcl_TruncateChannel _ANSI_ARGS_((Tcl_Channel chan,
 EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc _ANSI_ARGS_((
 				Tcl_ChannelType * chanTypePtr));
 #endif
+#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
+#define Tcl_SetChannelErrorInterp_TCL_DECLARED
+/* 561 */
+EXTERN void		Tcl_SetChannelErrorInterp _ANSI_ARGS_((
+				Tcl_Interp* interp, Tcl_Obj* msg));
+#endif
+#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
+#define Tcl_GetChannelErrorInterp_TCL_DECLARED
+/* 562 */
+EXTERN void		Tcl_GetChannelErrorInterp _ANSI_ARGS_((
+				Tcl_Interp* interp, Tcl_Obj** msg));
+#endif
+#ifndef Tcl_SetChannelError_TCL_DECLARED
+#define Tcl_SetChannelError_TCL_DECLARED
+/* 563 */
+EXTERN void		Tcl_SetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
+				Tcl_Obj* msg));
+#endif
+#ifndef Tcl_GetChannelError_TCL_DECLARED
+#define Tcl_GetChannelError_TCL_DECLARED
+/* 564 */
+EXTERN void		Tcl_GetChannelError _ANSI_ARGS_((Tcl_Channel chan, 
+				Tcl_Obj** msg));
+#endif
 
 typedef struct TclStubHooks {
     struct TclPlatStubs *tclPlatStubs;
@@ -4098,6 +4122,10 @@ typedef struct TclStubs {
     int (*tcl_GetBignumFromObj) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj, mp_int* value)); /* 558 */
     int (*tcl_TruncateChannel) _ANSI_ARGS_((Tcl_Channel chan, Tcl_WideInt length)); /* 559 */
     Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 560 */
+    void (*tcl_SetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* msg)); /* 561 */
+    void (*tcl_GetChannelErrorInterp) _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj** msg)); /* 562 */
+    void (*tcl_SetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj* msg)); /* 563 */
+    void (*tcl_GetChannelError) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj** msg)); /* 564 */
 } TclStubs;
 
 #ifdef __cplusplus
@@ -6382,6 +6410,22 @@ extern TclStubs *tclStubsPtr;
 #define Tcl_ChannelTruncateProc \
 	(tclStubsPtr->tcl_ChannelTruncateProc) /* 560 */
 #endif
+#ifndef Tcl_SetChannelErrorInterp
+#define Tcl_SetChannelErrorInterp \
+	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 561 */
+#endif
+#ifndef Tcl_GetChannelErrorInterp
+#define Tcl_GetChannelErrorInterp \
+	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 562 */
+#endif
+#ifndef Tcl_SetChannelError
+#define Tcl_SetChannelError \
+	(tclStubsPtr->tcl_SetChannelError) /* 563 */
+#endif
+#ifndef Tcl_GetChannelError
+#define Tcl_GetChannelError \
+	(tclStubsPtr->tcl_GetChannelError) /* 564 */
+#endif
 
 #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index dcb4e9d..8b504a8 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.c,v 1.92 2005/08/04 17:29:01 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.93 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -136,6 +136,7 @@ static int		WriteBytes _ANSI_ARGS_((Channel *chanPtr,
 			    CONST char *src, int srcLen));
 static int		WriteChars _ANSI_ARGS_((Channel *chanPtr,
 			    CONST char *src, int srcLen));
+static Tcl_Obj*         FixLevelCode _ANSI_ARGS_ ((Tcl_Obj* msg));
 
 /*
  *---------------------------------------------------------------------------
@@ -743,7 +744,7 @@ Tcl_RegisterChannel(interp, chan)
 	hPtr = Tcl_CreateHashEntry(hTblPtr, statePtr->channelName, &new);
 	if (new == 0) {
 	    if (chan == (Tcl_Channel) Tcl_GetHashValue(hPtr)) {
-		return;
+	        return;
 	    }
 
 	    Tcl_Panic("Tcl_RegisterChannel: duplicate channel names");
@@ -1182,6 +1183,10 @@ Tcl_CreateChannel(typePtr, chanName, instanceData, mask)
     chanPtr->inQueueHead	= (ChannelBuffer *) NULL;
     chanPtr->inQueueTail	= (ChannelBuffer *) NULL;
 
+    /* TIP #219, Tcl Channel Reflection API */
+    statePtr->chanMsg           = NULL;
+    statePtr->unreportedMsg     = NULL;
+
     /*
      * Link the channel into the list of all channels; create an on-exit
      * handler if there is not one already, to close off all the channels in
@@ -1400,7 +1405,7 @@ Tcl_StackChannel(interp, typePtr, instanceData, mask, prevChan)
  *
  * Side effects:
  *	If TCL_ERROR is returned, the posix error code will be set with
- *	Tcl_SetErrno.
+ *	Tcl_SetErrno. May leave a message in interp result as well.
  *
  *----------------------------------------------------------------------
  */
@@ -1446,9 +1451,17 @@ Tcl_UnstackChannel(interp, chan)
 
 	    if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) {
 		statePtr->csPtr = csPtr;
-		Tcl_AppendResult(interp, "could not flush channel \"",
-			Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
-			(char *) NULL);
+		/* TIP #219, Tcl Channel Reflection API.
+		 * Move error messages put by the driver into the chan/ip
+		 * bypass area into the regular interpreter result. Fall back
+		 * to the regular message if nothing was found in the
+		 * bypasses.
+		 */
+		if (!TclChanCaughtErrorBypass (interp, chan)) {
+		    Tcl_AppendResult(interp, "could not flush channel \"",
+				     Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
+				     (char *) NULL);
+		}
 		return TCL_ERROR;
 	    }
 
@@ -1517,6 +1530,11 @@ Tcl_UnstackChannel(interp, chan)
 
 	if (result != 0) {
 	    Tcl_SetErrno(result);
+	    /* TIP #219, Tcl Channel Reflection API.
+	     * Move error messages put by the driver into the chan/ip bypass
+	     * area into the regular interpreter result.
+	     */
+	    TclChanCaughtErrorBypass (interp, chan);
 	    return TCL_ERROR;
 	}
     } else {
@@ -1527,6 +1545,10 @@ Tcl_UnstackChannel(interp, chan)
 
 	if (statePtr->refCount <= 0) {
 	    if (Tcl_Close(interp, chan) != TCL_OK) {
+		/* TIP #219, Tcl Channel Reflection API.
+		 * "TclChanCaughtErrorBypass" is not required here, it was
+		 * done already by "Tcl_Close".
+		 */
 		return TCL_ERROR;
 	    }
 	}
@@ -1959,7 +1981,7 @@ CheckForDeadChannel(interp, statePtr)
  *
  * Results:
  *	0 if successful, else the error code that was returned by the channel
- *	type operation.
+ *	type operation. May leave a message in the interp result.
  *
  * Side effects:
  *	May produce output on a channel. May block indefinitely if the channel
@@ -2099,22 +2121,53 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
 	     */
 
 	    if (calledFromAsyncFlush) {
+		/* TIP #219, Tcl Channel Reflection API.
+		 * When defering the error copy a message from the bypass into
+		 * the unreported area. Or discard it if the new error is to be
+		 * ignored in favor of an earlier defered error.
+		 */
+
+	        Tcl_Obj* msg = statePtr->chanMsg;
+
 		if (statePtr->unreportedError == 0) {
 		    statePtr->unreportedError = errorCode;
+		    statePtr->unreportedMsg   = msg;
+		    if (msg != NULL) {
+		        Tcl_IncrRefCount (msg);
+		    }
+		} else {
+		    /* An old unreported error is kept, and this error
+		     * thrown away.
+		     */
+		    statePtr->chanMsg = NULL;
+		    if (msg != NULL) {
+		        Tcl_DecrRefCount (msg);
+		    }
 		}
 	    } else {
+		/* TIP #219, Tcl Channel Reflection API.
+		 * Move error messages put by the driver into the chan bypass
+		 * area into the regular interpreter result. Fall back to the
+		 * regular message if nothing was found in the bypasses.
+		 */
+
 		Tcl_SetErrno(errorCode);
 		if (interp != NULL) {
+		    if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) {
+		        /*
+			 * Casting away CONST here is safe because the
+			 * TCL_VOLATILE flag guarantees CONST treatment
+			 * of the Posix error string.
+			 */
 
-		    /*
-		     * Casting away CONST here is safe because the
-		     * TCL_VOLATILE flag guarantees CONST treatment of the
-		     * Posix error string.
-		     */
-
-		    Tcl_SetResult(interp,
-			    (char *) Tcl_PosixError(interp), TCL_VOLATILE);
+		        Tcl_SetResult(interp,
+				(char *) Tcl_PosixError(interp),
+				TCL_VOLATILE);
+		    }
 		}
+		/* An unreportable bypassed message is kept, for the
+		 * caller of Tcl_Seek, Tcl_Write, etc.
+		 */
 	    }
 
 	    /*
@@ -2191,7 +2244,7 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
  *	TOP channel, including the data structure itself.
  *
  * Results:
- *	1 if the channel was stacked, 0 otherwise.
+ *	Error code from an unreported error or the driver close operation.
  *
  * Side effects:
  *	May close the actual channel, may free memory, may change the value of
@@ -2251,6 +2304,19 @@ CloseChannel(interp, chanPtr, errorCode)
 	(chanPtr->typePtr->outputProc) (chanPtr->instanceData, &c, 1, &dummy);
     }
 
+    /* TIP #219, Tcl Channel Reflection API.
+     * Move a leftover error message in the channel bypass into the
+     * interpreter bypass. Just clear it if there is no interpreter.
+     */
+
+    if (statePtr->chanMsg != NULL) {
+	if (interp != NULL) {
+	    Tcl_SetChannelErrorInterp (interp,statePtr->chanMsg);
+	}
+        Tcl_DecrRefCount (statePtr->chanMsg);
+	statePtr->chanMsg = NULL;
+    }
+
     /*
      * Remove this channel from of the list of all channels.
      */
@@ -2259,6 +2325,7 @@ CloseChannel(interp, chanPtr, errorCode)
 
     /*
      * Close and free the channel driver state.
+     * This may leave a TIP #219 error message in the interp.
      */
 
     if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
@@ -2293,6 +2360,17 @@ CloseChannel(interp, chanPtr, errorCode)
 
     if (statePtr->unreportedError != 0) {
 	errorCode = statePtr->unreportedError;
+
+	/* TIP #219, Tcl Channel Reflection API.
+	 * Move an error message found in the unreported area into the regular
+	 * bypass (interp). This kills any message in the channel bypass area.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    Tcl_DecrRefCount (statePtr->chanMsg);
+	    statePtr->chanMsg = NULL;
+	}
+        Tcl_SetChannelErrorInterp (interp,statePtr->unreportedMsg);
     }
     if (errorCode == 0) {
 	errorCode = result;
@@ -2500,6 +2578,7 @@ Tcl_Close(interp, chan)
     Channel *chanPtr;			/* The real IO channel. */
     ChannelState *statePtr;		/* State of real IO channel. */
     int result;				/* Of calling FlushChannel. */
+    int flushcode;
 
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_OK;
@@ -2543,6 +2622,19 @@ Tcl_Close(interp, chan)
 	    && (CheckChannelErrors(statePtr, TCL_WRITABLE) == 0)) {
 	statePtr->outputEncodingFlags |= TCL_ENCODING_END;
 	WriteChars(chanPtr, "", 0);
+
+	/* TIP #219, Tcl Channel Reflection API.
+	 * Move an error message found in the channel bypass into the
+	 * interpreter bypass. Just clear it if there is no interpreter.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    if (interp != NULL) {
+		Tcl_SetChannelErrorInterp (interp,statePtr->chanMsg);
+	    }
+	    Tcl_DecrRefCount (statePtr->chanMsg);
+	    statePtr->chanMsg = NULL;
+	}
     }
 
     Tcl_ClearChannelHandlers(chan);
@@ -2588,7 +2680,25 @@ Tcl_Close(interp, chan)
      */
 
     statePtr->flags |= CHANNEL_CLOSED;
-    if ((FlushChannel(interp, chanPtr, 0) != 0) || (result != 0)) {
+
+    flushcode = FlushChannel(interp, chanPtr, 0);
+
+    /* TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result.
+     *
+     * Notes: Due to the assertion of CHANNEL_CLOSED in the flags
+     * "FlushChannel" has called "CloseChannel" and thus freed all the channel
+     * structures. We must not try to access "chan" anymore, hence the NULL
+     * argument in the call below. The only place which may still contain a
+     * message is the interpreter itself, and "CloseChannel" made sure to lift
+     * any channel message it generated into it.
+     */
+    if (TclChanCaughtErrorBypass (interp, NULL)) {
+	result = EINVAL;
+    }
+
+    if ((flushcode != 0) || (result != 0)) {
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -5831,6 +5941,16 @@ CheckChannelErrors(statePtr, flags)
     if (statePtr->unreportedError != 0) {
 	Tcl_SetErrno(statePtr->unreportedError);
 	statePtr->unreportedError = 0;
+
+	/* TIP #219, Tcl Channel Reflection API.
+	 * Move a defered error message back into the channel bypass.
+	 */
+
+	if (statePtr->chanMsg != NULL) {
+	    Tcl_DecrRefCount (statePtr->chanMsg);
+	}
+	statePtr->chanMsg       = statePtr->unreportedMsg;
+	statePtr->unreportedMsg = NULL;
 	return -1;
     }
 
@@ -7725,6 +7845,7 @@ CopyData(csPtr, mask)
 {
     Tcl_Interp *interp;
     Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL;
+    Tcl_Obj* msg = NULL;
     Tcl_Channel inChan, outChan;
     ChannelState *inStatePtr, *outStatePtr;
     int result = TCL_OK, size, total, sizeb;
@@ -7762,12 +7883,14 @@ CopyData(csPtr, mask)
 	 * Check for unreported background errors.
 	 */
 
-	if (inStatePtr->unreportedError != 0) {
+        Tcl_GetChannelError (inChan, &msg);
+	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
 	    Tcl_SetErrno(inStatePtr->unreportedError);
 	    inStatePtr->unreportedError = 0;
 	    goto readError;
 	}
-	if (outStatePtr->unreportedError != 0) {
+        Tcl_GetChannelError (outChan, &msg);
+	if ((outStatePtr->unreportedError != 0) || (msg != NULL)) {
 	    Tcl_SetErrno(outStatePtr->unreportedError);
 	    outStatePtr->unreportedError = 0;
 	    goto writeError;
@@ -7794,8 +7917,15 @@ CopyData(csPtr, mask)
 	readError:
 	    TclNewObj(errObj);
 	    Tcl_AppendStringsToObj(errObj, "error reading \"",
-		    Tcl_GetChannelName(inChan), "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+				   Tcl_GetChannelName(inChan), "\": ",
+				   (char *) NULL);
+	    if (msg != NULL) {
+	        Tcl_AppendObjToObj(errObj,msg);
+	    } else {
+	        Tcl_AppendStringsToObj(errObj,
+		       Tcl_PosixError(interp),
+		       (char *) NULL);
+	    }
 	    break;
 	} else if (underflow) {
 	    /*
@@ -7850,8 +7980,15 @@ CopyData(csPtr, mask)
 	writeError:
 	    TclNewObj(errObj);
 	    Tcl_AppendStringsToObj(errObj, "error writing \"",
-		    Tcl_GetChannelName(outChan), "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+				   Tcl_GetChannelName(outChan), "\": ",
+				   (char *) NULL);
+	    if (msg != NULL) {
+	        Tcl_AppendObjToObj(errObj,msg);
+	    } else {
+	        Tcl_AppendStringsToObj(errObj,
+		       Tcl_PosixError(interp),
+		       (char *) NULL);
+	    }
 	    break;
 	}
 
@@ -8693,8 +8830,26 @@ SetBlockMode(interp, chanPtr, mode)
     result = StackSetBlockMode(chanPtr, mode);
     if (result != 0) {
 	if (interp != (Tcl_Interp *) NULL) {
-	    Tcl_AppendResult(interp, "error setting blocking mode: ",
-		    Tcl_PosixError(interp), (char *) NULL);
+	    /* TIP #219.
+	     * Move error messages put by the driver into the bypass area and
+	     * put them into the regular interpreter result. Fall back to the
+	     * regular message if nothing was found in the bypass.
+	     *
+	     * Note that we cannot have a message in the interpreter bypass
+	     * area, StackSetBlockMode is restricted to the channel bypass.
+	     * We still need the interp as the destination of the move.
+	     */
+	    if (!TclChanCaughtErrorBypass (interp, (Tcl_Channel) chanPtr)) {
+		Tcl_AppendResult(interp, "error setting blocking mode: ",
+				 Tcl_PosixError(interp), (char *) NULL);
+	    }
+	} else {
+	    /* TIP #219.
+	     * If we have no interpreter to put a bypass message into we have
+	     * to clear it, to prevent its propagation and use in other places
+	     * unrelated to the actual occurence of the problem.
+	     */
+	    Tcl_SetChannelError ((Tcl_Channel) chanPtr, NULL);
 	}
 	return TCL_ERROR;
     }
@@ -9376,6 +9531,270 @@ Tcl_ChannelThreadActionProc(chanTypePtr)
 /*
  *----------------------------------------------------------------------
  *
+ * Tcl_SetChannelErrorInterp --
+ *
+ *      TIP #219, Tcl Channel Reflection API.
+ *	Store an error message for the I/O system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Discards a previously stored message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetChannelErrorInterp (interp, msg)
+     Tcl_Interp* interp; /* Interp to store the data into. */
+     Tcl_Obj*    msg;    /* Error message to store. */
+{
+    Interp* iPtr = (Interp*) interp;
+
+    if (iPtr->chanMsg != NULL) {
+        Tcl_DecrRefCount (iPtr->chanMsg);
+	iPtr->chanMsg  = NULL;
+    }
+
+    if (msg != NULL) {
+        iPtr->chanMsg  = FixLevelCode (msg);
+	Tcl_IncrRefCount (iPtr->chanMsg);
+    }
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetChannelError --
+ *
+ *      TIP #219, Tcl Channel Reflection API.
+ *	Store an error message for the I/O system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Discards a previously stored message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetChannelError (chan, msg)
+     Tcl_Channel chan; /* Channel to store the data into. */
+     Tcl_Obj*    msg;  /* Error message to store. */
+{
+    ChannelState* statePtr = ((Channel*) chan)->state;
+
+    if (statePtr->chanMsg != NULL) {
+        Tcl_DecrRefCount (statePtr->chanMsg);
+	statePtr->chanMsg  = NULL;
+    }
+
+    if (msg != NULL) {
+        statePtr->chanMsg  = FixLevelCode (msg);
+	Tcl_IncrRefCount (statePtr->chanMsg);
+    }
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FixLevelCode --
+ *
+ *      TIP #219, Tcl Channel Reflection API.
+ *	Scans an error message for bad -code / -level
+ *	directives. Returns a modified copy with such
+ *	directives corrected, and the input if it had
+ *	no problems.
+ *
+ * Results:
+ *	A Tcl_Obj*
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+FixLevelCode (msg)
+Tcl_Obj* msg;
+{
+    int       lc;
+    Tcl_Obj** lv;
+    int       explicitResult;
+    int       numOptions;
+    int       lcn;
+    Tcl_Obj** lvn;
+    int       res, i, j, val, lignore, cignore;
+    Tcl_Obj*  newlevel = NULL;
+    Tcl_Obj*  newcode  = NULL;
+
+    /* ASSERT msg != NULL */
+
+    /* Process the caught message.
+     *
+     * Syntax = (option value)... ?message?
+     *
+     * Bad syntax causes a panic. Because the other side uses
+     * Tcl_GetReturnOptions and list construction functions to marshall the
+     * information.
+     */
+
+    res = Tcl_ListObjGetElements (NULL, msg, &lc, &lv);
+    if (res != TCL_OK) {
+	Tcl_Panic ("Tcl_SetChannelError(Interp): Bad syntax of message");
+    }
+
+    explicitResult = (1 == (lc % 2));
+    numOptions     = lc - explicitResult;
+
+    /* No options, nothing to do.
+     */
+
+    if (numOptions == 0) {
+	return msg;
+    }
+
+    /* Check for -code x, x != 1|error, and -level x, x != 0 */
+
+    for (i = 0; i < numOptions; i += 2) {
+	if (0 == strcmp (Tcl_GetString (lv [i]), "-code")) {
+	    /* !"error", !integer, integer != 1 (numeric code for error) */
+
+	    res = Tcl_GetIntFromObj (NULL, lv [i+1], &val);
+	    if (((res == TCL_OK) && (val != 1)) ||
+		((res != TCL_OK) && (0 != strcmp (Tcl_GetString (lv [i+1]), "error")))) {
+		newcode = Tcl_NewIntObj (1);
+	    }
+	} else if (0 == strcmp (Tcl_GetString (lv [i]), "-level")) {
+	    /* !integer, integer != 0 */
+	    res = Tcl_GetIntFromObj (NULL, lv [i+1], &val);
+	    if ((res != TCL_OK) || (val != 0)) {
+		newlevel = Tcl_NewIntObj (0);
+	    }
+	}
+    }
+
+    /* -code, -level are either not present or ok. Nothing to do.
+     */
+
+    if (!newlevel && !newcode) {
+	return msg;
+    }
+
+    lcn = numOptions;
+    if (explicitResult) lcn ++;
+    if (newlevel)       lcn += 2;
+    if (newcode)        lcn += 2;
+
+    lvn = (Tcl_Obj**) ckalloc (lcn * sizeof (Tcl_Obj*));
+
+    /* New level/code information is spliced into the first occurence of
+     * -level, -code, further occurences are ignored. The options cannot be
+     * not present, we would not come here. Options which are ok are simply
+     * copied over.
+     */
+
+    lignore = cignore = 0;
+    for (i = 0, j = 0; i < numOptions; i += 2) {
+	if (0 == strcmp (Tcl_GetString (lv [i]), "-level")) {
+	    if (newlevel) {
+		lvn [j] = lv [i];   j++;
+		lvn [j] = newlevel; j++;
+		newlevel = NULL;
+		lignore = 1;
+		continue;
+	    } else if (lignore) {
+		continue;
+	    }
+	} else if (0 == strcmp (Tcl_GetString (lv [i]), "-code")) {
+	    if (newcode) {
+		lvn [j] = lv [i];  j++;
+		lvn [j] = newcode; j++;
+		newcode = NULL;
+		cignore = 1;
+		continue;
+	    } else if (cignore) {
+		continue;
+	    }
+	}
+	/* Keep everything else, possibly copied down */
+	lvn [j] = lv [i];   j++;
+	lvn [j] = lv [i+1]; j++;
+    }
+
+    if (explicitResult) {
+	lvn [j] = lv [i]; j++;
+    }
+
+    msg = Tcl_NewListObj (j, lvn);
+
+    ckfree ((char*) lvn);
+    return msg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelErrorInterp --
+ *
+ *      TIP #219, Tcl Channel Reflection API.
+ *	Return the message stored by the channel driver.
+ *
+ * Results:
+ *	Tcl error message object.
+ *
+ * Side effects:
+ *	Resets the stored data to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void Tcl_GetChannelErrorInterp (interp, msg)
+     Tcl_Interp* interp; /* Interp to query. */
+     Tcl_Obj**   msg;    /* Place for error message. */
+{
+    Interp* iPtr = (Interp*) interp;
+
+    *msg = iPtr->chanMsg;
+    iPtr->chanMsg  = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetChannelError --
+ *
+ *      TIP #219, Tcl Channel Reflection API.
+ *	Return the message stored by the channel driver.
+ *
+ * Results:
+ *	Tcl error message object.
+ *
+ * Side effects:
+ *	Resets the stored data to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void Tcl_GetChannelError (chan, msg)
+     Tcl_Channel chan; /* Channel to query. */
+     Tcl_Obj**   msg;  /* Place for error message. */
+{
+    ChannelState* statePtr = ((Channel*) chan)->state;
+
+    *msg = statePtr->chanMsg;
+    statePtr->chanMsg  = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_ChannelTruncateProc --
  *
  *	TIP #208 (subsection relating to truncation, based on TIP #206).
diff --git a/generic/tclIO.h b/generic/tclIO.h
index c0abec2..9ec4abc 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIO.h,v 1.7 2004/07/15 20:46:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclIO.h,v 1.8 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 /*
@@ -235,6 +235,20 @@ typedef struct ChannelState {
 				/* Next in list of channels currently open. */
     Tcl_ThreadId managingThread; /* TIP #10: Id of the thread managing
 				  * this stack of channels. */
+
+    /* TIP #219 ... Info for the I/O system ...
+     * Error message set by channel drivers, for the propagation of
+     * arbitrary Tcl errors. This information, if present (chanMsg not
+     * NULL), takes precedence over a posix error code returned by a
+     * channel operation.
+     */
+
+    Tcl_Obj* chanMsg;
+    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was
+                                 * deferred because it happened in the
+                                 * background. The value is the
+                                 * chanMg, if any. #219's companion to
+                                 * 'unreportedError'. */
 } ChannelState;
     
 /*
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index fa1fac1..9a7d308 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOCmd.c,v 1.30 2005/07/17 22:06:42 dkf Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.31 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -141,8 +141,15 @@ Tcl_PutsObjCmd(dummy, interp, objc, objv)
     return TCL_OK;
 
   error:
-    Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
-	    Tcl_PosixError(interp), (char *) NULL);
+    /* TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result. Fall back to the regular
+     * message if nothing was found in the bypass.
+     */
+    if (!TclChanCaughtErrorBypass (interp, chan)) {
+	Tcl_AppendResult(interp, "error writing \"", channelId, "\": ",
+			 Tcl_PosixError(interp), (char *) NULL);
+    }
     return TCL_ERROR;
 }
 
@@ -191,8 +198,15 @@ Tcl_FlushObjCmd(dummy, interp, objc, objv)
     }
 
     if (Tcl_Flush(chan) != TCL_OK) {
-	Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
+	/* TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+	if (!TclChanCaughtErrorBypass (interp, chan)) {
+	    Tcl_AppendResult(interp, "error flushing \"", channelId, "\": ",
+			     Tcl_PosixError(interp), (char *) NULL);
+	}
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -250,9 +264,17 @@ Tcl_GetsObjCmd(dummy, interp, objc, objv)
     if (lineLen < 0) {
 	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
 	    Tcl_DecrRefCount(linePtr);
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "error reading \"", name, "\": ",
-		    Tcl_PosixError(interp), (char *) NULL);
+
+	    /* TIP #219.
+	     * Capture error messages put by the driver into the bypass area
+	     * and put them into the regular interpreter result. Fall back to
+	     * the regular message if nothing was found in the bypass.
+	     */
+	    if (!TclChanCaughtErrorBypass (interp, chan)) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+				 Tcl_PosixError(interp), (char *) NULL);
+	    }
 	    return TCL_ERROR;
 	}
 	lineLen = -1;
@@ -372,10 +394,17 @@ Tcl_ReadObjCmd(dummy, interp, objc, objv)
     Tcl_IncrRefCount(resultPtr);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead < 0) {
-	Tcl_ResetResult(interp);
-	Tcl_AppendResult(interp, "error reading \"", name, "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
-	Tcl_DecrRefCount(resultPtr);
+	/* TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+	if (!TclChanCaughtErrorBypass (interp, chan)) {
+	    Tcl_ResetResult(interp);
+	    Tcl_AppendResult(interp, "error reading \"", name, "\": ",
+			     Tcl_PosixError(interp), (char *) NULL);
+	    Tcl_DecrRefCount(resultPtr);
+	}
 	return TCL_ERROR;
     }
 
@@ -457,8 +486,16 @@ Tcl_SeekObjCmd(clientData, interp, objc, objv)
 
     result = Tcl_Seek(chan, offset, mode);
     if (result == Tcl_LongAsWide(-1)) {
-	Tcl_AppendResult(interp, "error during seek on \"",
-		chanName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+	/* TIP #219.
+	 * Capture error messages put by the driver into the bypass area and
+	 * put them into the regular interpreter result. Fall back to the
+	 * regular message if nothing was found in the bypass.
+	 */
+	if (!TclChanCaughtErrorBypass (interp, chan)) {
+	    Tcl_AppendResult(interp, "error during seek on \"",
+			     chanName, "\": ", Tcl_PosixError(interp),
+			     (char *) NULL);
+	}
 	return TCL_ERROR;
     }
     return TCL_OK;
@@ -491,6 +528,7 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
 {
     Tcl_Channel chan;			/* The channel to tell on. */
     char *chanName;
+    Tcl_WideInt newLoc;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
@@ -507,7 +545,18 @@ Tcl_TellObjCmd(clientData, interp, objc, objv)
     if (chan == (Tcl_Channel) NULL) {
 	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_Tell(chan)));
+
+    newLoc = Tcl_Tell(chan);
+
+    /* TIP #219.
+     * Capture error messages put by the driver into the bypass area and put
+     * them into the regular interpreter result.
+     */
+    if (TclChanCaughtErrorBypass (interp, chan)) {
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(newLoc));
     return TCL_OK;
 }
 
@@ -833,10 +882,17 @@ Tcl_ExecObjCmd(dummy, interp, objc, objv)
     resultPtr = Tcl_NewObj();
     if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
 	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
-	    Tcl_ResetResult(interp);
-	    Tcl_AppendResult(interp, "error reading output from command: ",
-		    Tcl_PosixError(interp), (char *) NULL);
-	    Tcl_DecrRefCount(resultPtr);
+	    /* TIP #219.
+	     * Capture error messages put by the driver into the bypass area
+	     * and put them into the regular interpreter result. Fall back to
+	     * the regular message if nothing was found in the bypass.
+	     */
+	    if (!TclChanCaughtErrorBypass (interp, chan)) {
+		Tcl_ResetResult(interp);
+		Tcl_AppendResult(interp, "error reading output from command: ",
+				 Tcl_PosixError(interp), (char *) NULL);
+		Tcl_DecrRefCount(resultPtr);
+	    }
 	    return TCL_ERROR;
 	}
     }
@@ -1630,3 +1686,4 @@ TclChanTruncateObjCmd(dummy, interp, objc, objv)
  * fill-column: 78
  * End:
  */
+
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
new file mode 100644
index 0000000..beebff4
--- /dev/null
+++ b/generic/tclIORChan.c
@@ -0,0 +1,2668 @@
+/* 
+ * tclIORChan.c --
+ *
+ *	This file contains the implementation of Tcl's generic
+ *	channel reflection code, which allows the implementation
+ *	of Tcl channels in Tcl code.
+ *
+ *	Parts of this file are based on code contributed by 
+ *	Jean-Claude Wippler.
+ *
+ *      See TIP #219 for the specification of this functionality.
+ *
+ * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclIORChan.c,v 1.1 2005/08/24 17:56:23 andreas_kupries Exp $
+ */
+
+#include <tclInt.h>
+#include <tclIO.h>
+#include <assert.h>
+
+#ifndef EINVAL
+#define EINVAL 9
+#endif
+#ifndef EOK
+#define EOK    0
+#endif
+
+/*
+ * Signatures of all functions used in the C layer of the reflection.
+ */
+
+/* Required */
+static int	RcClose _ANSI_ARGS_((ClientData clientData,
+		   Tcl_Interp *interp));
+
+/* Required, "read" is optional despite this. */
+static int	RcInput _ANSI_ARGS_((ClientData clientData,
+		    char *buf, int toRead, int *errorCodePtr));
+
+/* Required, "write" is optional despite this. */
+static int	RcOutput _ANSI_ARGS_((ClientData clientData,
+	            CONST char *buf, int toWrite, int *errorCodePtr));
+
+/* Required */
+static void	RcWatch _ANSI_ARGS_((ClientData clientData, int mask));
+
+/* NULL'able - "blocking", is optional */
+static int	RcBlock _ANSI_ARGS_((ClientData clientData,
+				       int mode));
+
+/* NULL'able - "seek", is optional */
+static Tcl_WideInt RcSeekWide _ANSI_ARGS_((ClientData clientData,
+		    Tcl_WideInt offset,
+		    int mode, int *errorCodePtr));
+
+static int RcSeek _ANSI_ARGS_((ClientData clientData,
+		    long offset, int mode, int *errorCodePtr));
+
+/* NULL'able - "cget" / "cgetall", are optional */
+static int	RcGetOption _ANSI_ARGS_((ClientData clientData,
+				       Tcl_Interp* interp,
+				       CONST char *optionName,
+				       Tcl_DString *dsPtr));
+
+/* NULL'able - "configure", is optional */
+static int	RcSetOption _ANSI_ARGS_((ClientData clientData,
+				       Tcl_Interp* interp,
+				       CONST char *optionName,
+				       CONST char *newValue));
+
+
+/*
+ * The C layer channel type/driver definition used by the reflection.
+ * This is a version 3 structure.
+ */
+
+static Tcl_ChannelType tclRChannelType = {
+  "tclrchannel",  /* Type name.                                    */
+  TCL_CHANNEL_VERSION_3,
+  RcClose,        /* Close channel, clean instance data            */
+  RcInput,        /* Handle read request                           */
+  RcOutput,       /* Handle write request                          */
+  RcSeek,         /* Move location of access point.    NULL'able   */
+  RcSetOption,    /* Set options.                      NULL'able   */
+  RcGetOption,    /* Get options.                      NULL'able   */
+  RcWatch,        /* Initialize notifier                           */
+  NULL,           /* Get OS handle from the channel.   NULL'able   */
+  NULL,           /* No close2 support.                NULL'able   */
+  RcBlock,        /* Set blocking/nonblocking.         NULL'able   */
+  NULL,           /* Flush channel. Not used by core.  NULL'able   */
+  NULL,           /* Handle events.                    NULL'able   */
+  RcSeekWide      /* Move access point (64 bit).       NULL'able   */
+};
+
+/*
+ * Instance data for a reflected channel. ===========================
+ */
+
+typedef struct {
+  Tcl_Channel chan;    /* Back reference to generic channel structure.
+		        */
+  Tcl_Interp* interp;  /* Reference to the interpreter containing the
+		        * Tcl level part of the channel. */
+#ifdef TCL_THREADS
+  Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
+#endif
+
+  /* See [==] as well.
+   * Storage for the command prefix and the additional words required
+   * for the invocation of methods in the command handler.
+   *
+   * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
+   *      cmd ... pfx | method   chan     | detail1 detail2
+   *      ~~~~ CT ~~~            ~~ CT ~~
+   *
+   * CT = Belongs to the 'Command handler Thread'.
+   */
+
+  int       argc;       /* Number of preallocated words - 2 */
+  Tcl_Obj** argv;       /* Preallocated array for calling the handler.
+			 * args [0] is placeholder for cmd word.
+			 * Followed by the arguments in the prefix,
+			 * plus 4 placeholders for method, channel,
+			 * and at most two varying (method specific)
+			 * words.
+			 */
+
+  int methods;          /* Bitmask of supported methods */
+
+  /* ---------------------------------------- */
+
+  /* NOTE (9): Should we have predefined shared literals
+   * NOTE (9): for the method names ?
+   */
+
+  /* ---------------------------------------- */
+
+  int mode;             /* Mask of R/W mode */
+  int interest;         /* Mask of events the channel is interested in. */
+
+  /* Note regarding the usage of timers.
+   *
+   * Most channel implementations need a timer in the
+   * C level to ensure that data in buffers is flushed
+   * out through the generation of fake file events.
+   *
+   * See 'rechan', 'memchan', etc.
+   *
+   * Here this is _not_ required. Interest in events is
+   * posted to the Tcl level via 'watch'. And posting of
+   * events is possible from the Tcl level as well, via
+   * 'chan postevent'. This means that the generation of
+   * all events, fake or not, timer based or not, is
+   * completely in the hands of the Tcl level. Therefore
+   * no timer here.
+   */
+
+} ReflectingChannel;
+
+/*
+ * Event literals. ==================================================
+ */
+
+static CONST char *eventOptions[] = {
+  "read", "write", (char *) NULL
+};
+typedef enum {
+  EVENT_READ, EVENT_WRITE
+} EventOption;
+
+/*
+ * Method literals. ==================================================
+ */
+
+static CONST char *methodNames[] = {
+  "blocking",	/* OPT */
+  "cget",	/* OPT \/ Together or none */
+  "cgetall",	/* OPT /\ of these two     */
+  "configure",	/* OPT */
+  "finalize",	/*     */
+  "initialize",	/*     */
+  "read",	/* OPT */
+  "seek",	/* OPT */
+  "watch",	/*     */
+  "write",	/* OPT */
+  (char *) NULL
+};
+typedef enum {
+  METH_BLOCKING,
+  METH_CGET,
+  METH_CGETALL,
+  METH_CONFIGURE,
+  METH_FINAL,
+  METH_INIT,
+  METH_READ,
+  METH_SEEK,
+  METH_WATCH,
+  METH_WRITE,
+} MethodName;
+
+#define FLAG(m) (1 << (m))
+#define REQUIRED_METHODS (FLAG (METH_INIT) | FLAG (METH_FINAL) | FLAG (METH_WATCH))
+#define NULLABLE_METHODS (FLAG (METH_BLOCKING) | FLAG (METH_SEEK) | \
+	FLAG (METH_CONFIGURE) | FLAG (METH_CGET) | FLAG (METH_CGETALL))
+
+#define RANDW (TCL_READABLE|TCL_WRITABLE)
+
+#define IMPLIES(a,b) ((!(a)) || (b))
+#define NEGIMPL(a,b)
+#define HAS(x,f) (x & FLAG(f))
+
+
+#ifdef TCL_THREADS
+/*
+ * Thread specific types and structures.
+ *
+ * We are here essentially creating a very specific implementation of
+ * 'thread send'.
+ */
+
+/*
+ * Enumeration of all operations which can be forwarded.
+ */
+
+typedef enum {
+  RcOpClose,
+  RcOpInput,
+  RcOpOutput,
+  RcOpSeek,
+  RcOpWatch,
+  RcOpBlock,
+  RcOpSetOpt,
+  RcOpGetOpt,
+  RcOpGetOptAll
+} RcOperation;
+
+/*
+ * Event used to forward driver invocations to the thread actually
+ * managing the channel. We cannot construct the command to execute
+ * and forward that. Because then it will contain a mixture of
+ * Tcl_Obj's belonging to both the command handler thread (CT), and
+ * the thread managing the channel (MT), executed in CT. Tcl_Obj's are
+ * not allowed to cross thread boundaries. So we forward an operation
+ * code, the argument details ,and reference to results. The command
+ * is assembled in the CT and belongs fully to that thread. No sharing
+ * problems.
+ */
+
+typedef struct RcForwardParamBase {
+  int   code; /* O: Ok/Fail of the cmd handler */
+  char* msg;  /* O: Error message for handler failure */
+  int   vol;  /* O: True - msg is allocated, False - msg is static */
+} RcForwardParamBase;
+
+/*
+ * Operation specific parameter/result structures.
+ */
+
+typedef struct RcForwardParamClose {
+  RcForwardParamBase b;
+} RcForwardParamClose;
+
+typedef struct RcForwardParamInput {
+  RcForwardParamBase b;
+  char* buf;    /* O: Where to store the read bytes */
+  int   toRead; /* I: #bytes to read,
+		 * O: #bytes actually read */
+} RcForwardParamInput;
+
+typedef struct RcForwardParamOutput {
+  RcForwardParamBase b;
+  CONST char* buf;     /* I: Where the bytes to write come from */
+  int         toWrite; /* I: #bytes to write,
+			* O: #bytes actually written */
+} RcForwardParamOutput;
+
+typedef struct RcForwardParamSeek {
+  RcForwardParamBase b;
+  int         seekMode; /* I: How to seek */
+  Tcl_WideInt offset;   /* I: Where to seek,
+			 * O: New location */
+} RcForwardParamSeek;
+
+typedef struct RcForwardParamWatch {
+  RcForwardParamBase b;
+  int mask; /* I: What events to watch for */
+} RcForwardParamWatch;
+
+typedef struct RcForwardParamBlock {
+  RcForwardParamBase b;
+  int nonblocking; /* I: What mode to activate */
+} RcForwardParamBlock;
+
+typedef struct RcForwardParamSetOpt {
+  RcForwardParamBase b;
+  CONST char* name;  /* Name of option to set */
+  CONST char* value; /* Value to set */
+} RcForwardParamSetOpt;
+
+typedef struct RcForwardParamGetOpt {
+  RcForwardParamBase b;
+  CONST char*  name;  /* Name of option to get, maybe NULL */
+  Tcl_DString* value; /* Result */
+} RcForwardParamGetOpt;
+
+/*
+ * General event structure, with reference to
+ * operation specific data.
+ */
+
+typedef struct RcForwardingEvent {
+  Tcl_Event                  event; /* Basic event data, has to be first item */
+  struct RcForwardingResult* resultPtr;
+
+  RcOperation               op;    /* Forwarded driver operation */
+  ReflectingChannel*        rcPtr; /* Channel instance */
+  CONST RcForwardParamBase* param; /* Arguments, a RcForwardParamXXX pointer */
+} RcForwardingEvent;
+
+/*
+ * Structure to manage the result of the forwarding.  This is not the
+ * result of the operation itself, but about the success of the
+ * forward event itself. The event can be successful, even if the
+ * operation which was forwarded failed. It is also there to manage
+ * the synchronization between the involved threads.
+ */
+
+typedef struct RcForwardingResult {
+
+  Tcl_ThreadId  src;    /* Originating thread. */
+  Tcl_ThreadId  dst;    /* Thread the op was forwarded to. */
+  Tcl_Condition done;   /* Condition variable the forwarder blocks on. */
+  int           result; /* TCL_OK or TCL_ERROR */
+
+  struct RcForwardingEvent*  evPtr; /* Event the result belongs to. */
+
+  struct RcForwardingResult* prevPtr; /* Links into the list of pending */
+  struct RcForwardingResult* nextPtr; /* forwarded results. */
+
+} RcForwardingResult;
+
+/*
+ * List of forwarded operations which have not completed yet, plus the
+ * mutex to protect the access to this process global list.
+ */
+
+static RcForwardingResult* forwardList = (RcForwardingResult*) NULL;
+TCL_DECLARE_MUTEX (rcForwardMutex)
+
+/*
+ * Function containing the generic code executing a forward, and
+ * wrapper macros for the actual operations we wish to forward.
+ */
+
+static void
+RcForwardOp _ANSI_ARGS_ ((ReflectingChannel* rcPtr, RcOperation op,
+			  Tcl_ThreadId dst, CONST VOID* param));
+
+/*
+ * The event function executed by the thread receiving a forwarding
+ * event. Executes the appropriate function and collects the result,
+ * if any.
+ */
+
+static int
+RcForwardProc _ANSI_ARGS_ ((Tcl_Event *evPtr, int mask));
+
+/*
+ * Helpers which intercept when threads are going away, and clean up
+ * after pending forwarding events. Different actions depending on
+ * which thread went away, originator (src), or receiver (dst).
+ */
+
+static void
+RcSrcExitProc _ANSI_ARGS_ ((ClientData clientData));
+
+static void
+RcDstExitProc _ANSI_ARGS_ ((ClientData clientData));
+
+#define RcFreeReceivedError(pb) \
+	if ((pb).vol) {ckfree ((pb).msg);}
+
+#define RcPassReceivedErrorInterp(i,pb) \
+	if ((i)) {Tcl_SetChannelErrorInterp ((i), Tcl_NewStringObj ((pb).msg,-1));} \
+	RcFreeReceivedError (pb)
+
+#define RcPassReceivedError(c,pb) \
+	Tcl_SetChannelError ((c), Tcl_NewStringObj ((pb).msg,-1)); \
+	RcFreeReceivedError (pb)
+
+#define RcForwardSetStaticError(p,emsg) \
+       (p)->code = TCL_ERROR; (p)->vol  = 0; (p)->msg  = (char*) (emsg);
+
+#define RcForwardSetDynError(p,emsg) \
+       (p)->code = TCL_ERROR; (p)->vol  = 1; (p)->msg  = (char*) (emsg);
+
+static void
+RcForwardSetObjError _ANSI_ARGS_ ((RcForwardParamBase* p,
+				   Tcl_Obj*            obj));
+
+#endif /* TCL_THREADS */
+
+#define RcSetChannelErrorStr(c,msg) \
+	Tcl_SetChannelError ((c), Tcl_NewStringObj ((msg),-1))
+
+static Tcl_Obj* RcErrorMarshall _ANSI_ARGS_ ((Tcl_Interp *interp));
+static void     RcErrorReturn   _ANSI_ARGS_ ((Tcl_Interp* interp, Tcl_Obj* msg));
+
+
+
+/*
+ * Static functions for this file:
+ */
+
+static int RcEncodeEventMask _ANSI_ARGS_((Tcl_Interp* interp,
+		 CONST char* objName, Tcl_Obj* obj,
+		 int* mask));
+
+static Tcl_Obj* RcDecodeEventMask _ANSI_ARGS_ ((int mask));
+
+static ReflectingChannel* RcNew _ANSI_ARGS_ ((Tcl_Interp* interp,
+	     Tcl_Obj* cmdpfxObj, int mode,
+	     Tcl_Obj* id));
+
+static Tcl_Obj* RcNewHandle _ANSI_ARGS_ ((void));
+
+static void RcFree _ANSI_ARGS_ ((ReflectingChannel* rcPtr));
+
+static void
+RcInvokeTclMethod _ANSI_ARGS_((ReflectingChannel* rcPtr,
+       CONST char* method, Tcl_Obj* argone, Tcl_Obj* argtwo,
+       int* result, Tcl_Obj** resultObj, int capture));
+
+#define NO_CAPTURE (0)
+#define DO_CAPTURE (1)
+
+/*
+ * Global constant strings (messages). ==================
+ * These string are used directly as bypass errors, thus they have to be valid
+ * Tcl lists where the last element is the message itself. Hence the
+ * list-quoting to keep the words of the message together. See also [x].
+ */
+
+static CONST char* msg_read_unsup       = "{read not supported by Tcl driver}";
+static CONST char* msg_read_toomuch     = "{read delivered more than requested}";
+static CONST char* msg_write_unsup      = "{write not supported by Tcl driver}";
+static CONST char* msg_write_toomuch    = "{write wrote more than requested}";
+static CONST char* msg_seek_beforestart = "{Tried to seek before origin}";
+
+#ifdef TCL_THREADS
+static CONST char* msg_send_originlost  = "{Origin thread lost}";
+static CONST char* msg_send_dstlost     = "{Destination thread lost}";
+#endif /* TCL_THREADS */
+
+/*
+ * Main methods to plug into the 'chan' ensemble'. ==================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanCreateObjCmd --
+ *
+ *	This procedure is invoked to process the "chan create" Tcl
+ *	command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *	The handle of the new channel is placed in the interp result.
+ *
+ * Side effects:
+ *	Creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanCreateObjCmd (/*ignored*/ clientData, interp, objc, objv)
+     ClientData      clientData;
+     Tcl_Interp*     interp;
+     int             objc;
+     Tcl_Obj* CONST* objv;
+{
+    ReflectingChannel* rcPtr;       /* Instance data of the new channel */
+    Tcl_Obj*           rcId;        /* Handle of the new channel */
+    int                mode;        /* R/W mode of new channel. Has to
+				     * match abilities of handler commands */
+    Tcl_Obj*           cmdObj;      /* Command prefix, list of words */
+    Tcl_Obj*           cmdNameObj;  /* Command name */
+    Tcl_Channel        chan;        /* Token for the new channel */
+    Tcl_Obj*           modeObj;     /* mode in obj form for method call */
+    int                listc;       /* Result of 'initialize', and of */
+    Tcl_Obj**          listv;       /* its sublist in the 2nd element */
+    int                methIndex;   /* Encoded method name */
+    int                res;         /* Result code for 'initialize' */
+    Tcl_Obj*           resObj;      /* Result data for 'initialize' */
+    int                methods;     /* Bitmask for supported methods. */
+    Channel*           chanPtr;     /* 'chan' resolved to internal struct. */
+
+    /* Syntax:   chan create MODE CMDPREFIX
+     *           [0]  [1]    [2]  [3]
+     *
+     * Actually: rCreate MODE CMDPREFIX
+     *           [0]     [1]  [2]
+     */
+
+#define MODE (1)
+#define CMD  (2)
+
+    /* Number of arguments ... */
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "mode cmdprefix");
+	return TCL_ERROR;
+    }
+
+    /* First argument is a list of modes. Allowed entries are "read",
+     * "write". Expect at least one list element.  Abbreviations are
+     * ok.
+     */
+
+    modeObj = objv [MODE];
+    if (RcEncodeEventMask (interp, "mode", objv [MODE], &mode) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    /* Second argument is command prefix, i.e. list of words, first
+     * word is name of handler command, other words are fixed
+     * arguments. Run 'initialize' method to get the list of supported
+     * methods. Validate this.
+     */
+
+    cmdObj = objv [CMD];
+
+    /* Basic check that the command prefix truly is a list. */
+
+    if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    /* Now create the channel.
+     */
+
+    rcId  = RcNewHandle ();
+    rcPtr = RcNew (interp, cmdObj, mode, rcId);
+    chan  = Tcl_CreateChannel (&tclRChannelType,
+			       Tcl_GetString (rcId),
+			       rcPtr, mode);
+    rcPtr->chan = chan;
+    chanPtr = (Channel*) chan;
+
+    /* Invoke 'initialize' and validate that the handler
+     * is present and ok. Squash the channel if not.
+     */
+
+    /* Note: The conversion of 'mode' back into a Tcl_Obj ensures that
+     * 'initialize' is invoked with canonical mode names, and no
+     * abbreviations. Using modeObj directly could feed abbreviations
+     * into the handler, and the handler is not specified to handle
+     * such.
+     */
+
+    modeObj = RcDecodeEventMask (mode);
+    RcInvokeTclMethod (rcPtr, "initialize", modeObj, NULL,
+		       &res, &resObj, NO_CAPTURE);
+    Tcl_DecrRefCount (modeObj);
+
+    if (res != TCL_OK) {
+        Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+
+	Tcl_AppendObjToObj(err,resObj);
+	Tcl_SetObjResult (interp,err);
+	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	goto error;
+    }
+
+    /* Verify the result.
+     * - List, of method names. Convert to mask.
+     *   Check for non-optionals through the mask.
+     *   Compare open mode against optional r/w.
+     */
+
+    Tcl_AppendResult (interp, "Initialize failure: ", (char*) NULL);
+
+    if (Tcl_ListObjGetElements (interp, resObj,
+			&listc, &listv) != TCL_OK) {
+        /* The function above replaces my prefix in case of an error,
+	 * so more work for us to get the prefix back into the error
+	 * message
+	 */
+
+        Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+
+	Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
+	Tcl_SetObjResult (interp,err);
+	goto error;
+    }
+
+    methods = 0;
+    while (listc > 0) {
+        if (Tcl_GetIndexFromObj (interp, listv [listc-1],
+				 methodNames, "method", TCL_EXACT, &methIndex) != TCL_OK) {
+	    Tcl_Obj* err = Tcl_NewStringObj ("Initialize failure: ",-1);
+
+	    Tcl_AppendObjToObj(err,Tcl_GetObjResult (interp));
+	    Tcl_SetObjResult (interp,err);
+	    goto error;
+	}
+
+	methods |= FLAG (methIndex);
+	listc --;
+    }
+
+    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
+        Tcl_AppendResult (interp, "Not all required methods supported",
+			  (char*) NULL);
+	goto error;
+    }
+
+    if ((mode & TCL_READABLE) && !HAS(methods,METH_READ)) {
+        Tcl_AppendResult (interp, "Reading not supported, but requested",
+			  (char*) NULL);
+	goto error;
+    }
+
+    if ((mode & TCL_WRITABLE) && !HAS(methods,METH_WRITE)) {
+        Tcl_AppendResult (interp, "Writing not supported, but requested",
+			  (char*) NULL);
+	goto error;
+    }
+
+    if (!IMPLIES (HAS(methods,METH_CGET), HAS(methods,METH_CGETALL))) {
+        Tcl_AppendResult (interp, "'cgetall' not supported, but should be, as 'cget' is",
+			  (char*) NULL);
+	goto error;
+    }
+
+    if (!IMPLIES (HAS(methods,METH_CGETALL),HAS(methods,METH_CGET))) {
+        Tcl_AppendResult (interp, "'cget' not supported, but should be, as 'cgetall' is",
+			  (char*) NULL);
+	goto error;
+    }
+
+    Tcl_ResetResult (interp);
+
+    /* Everything is fine now */
+
+    rcPtr->methods = methods;
+
+    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
+        /* Some of the nullable methods are not supported.  We clone
+	 * the channel type, null the associated C functions, and use
+	 * the result as the actual channel type.
+	 */
+
+        Tcl_ChannelType* clonePtr = (Tcl_ChannelType*) ckalloc (sizeof (Tcl_ChannelType));
+	if (clonePtr == (Tcl_ChannelType*) NULL) {
+	    Tcl_Panic ("Out of memory in Tcl_RcCreate");
+	}
+
+	memcpy (clonePtr, &tclRChannelType, sizeof (Tcl_ChannelType));
+
+	if (!(methods & FLAG (METH_CONFIGURE))) {
+	  clonePtr->setOptionProc = NULL;
+	}
+
+	if (
+	    !(methods & FLAG (METH_CGET)) &&
+	    !(methods & FLAG (METH_CGETALL))
+	    ) {
+	    clonePtr->getOptionProc = NULL;
+	}
+	if (!(methods & FLAG (METH_BLOCKING))) {
+	    clonePtr->blockModeProc = NULL;
+	}
+	if (!(methods & FLAG (METH_SEEK))) {
+	    clonePtr->seekProc     = NULL;
+	    clonePtr->wideSeekProc = NULL;
+	}
+
+	chanPtr->typePtr = clonePtr;
+    }
+
+    Tcl_RegisterChannel (interp, chan);
+
+    /* Return handle as result of command */
+
+    Tcl_SetObjResult (interp, rcId);
+    return TCL_OK;
+
+ error:
+    /* Signal to RcClose to not call 'finalize' */
+    rcPtr->methods = 0;
+    Tcl_Close (interp, chan);
+    return TCL_ERROR;
+
+#undef MODE
+#undef CMD
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChanPostEventObjCmd --
+ *
+ *	This procedure is invoked to process the "chan postevent"
+ *	Tcl command. See the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Posts events to a reflected channel, invokes event handlers.
+ *	The latter implies that arbitrary side effects are possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChanPostEventObjCmd (/*ignored*/ clientData, interp, objc, objv)
+     ClientData      clientData;
+     Tcl_Interp*     interp;
+     int             objc;
+     Tcl_Obj* CONST* objv;
+{
+    /* Syntax:   chan postevent CHANNEL EVENTSPEC
+     *           [0]  [1]       [2]     [3]
+     *
+     * Actually: rPostevent CHANNEL EVENTSPEC
+     *           [0]        [1]     [2]
+     *
+     *         where EVENTSPEC = {read write ...} (Abbreviations allowed as well.
+     */
+
+#define CHAN  (1)
+#define EVENT (2)
+
+    CONST char*        chanId;      /* Tcl level channel handle */
+    Tcl_Channel        chan;        /* Channel associated to the handle */
+    Tcl_ChannelType*   chanTypePtr; /* Its associated driver structure */
+    ReflectingChannel* rcPtr;       /* Associated instance data */
+    int                mode;        /* Dummy, r|w mode of the channel */
+    int                events;      /* Mask of events to post */
+
+    /* Number of arguments ... */
+
+    if (objc != 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
+	return TCL_ERROR;
+    }
+
+    /* First argument is a channel, a reflected channel, and the call
+     * of this command is done from the interp defining the channel
+     * handler cmd.
+     */
+
+    chanId = Tcl_GetString (objv [CHAN]);
+    chan   = Tcl_GetChannel(interp, chanId, &mode);
+
+    if (chan == (Tcl_Channel) NULL) {
+        return TCL_ERROR;
+    }
+
+    chanTypePtr = Tcl_GetChannelType (chan);
+
+    /* We use a function referenced by the channel type as our cookie
+     * to detect calls to non-reflecting channels. The channel type
+     * itself is not suitable, as it might not be the static
+     * definition in this file, but a clone thereof. And while we have
+     * reserved the name of the type nothing in the core checks
+     * against violation, so someone else might have created a channel
+     * type using our name, clashing with ourselves.
+     */
+
+    if (chanTypePtr->watchProc != &RcWatch) {
+        Tcl_AppendResult(interp, "channel \"", chanId,
+			 "\" is not a reflected channel",
+			 (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    rcPtr = (ReflectingChannel*) Tcl_GetChannelInstanceData (chan);
+
+    if (rcPtr->interp != interp) {
+        Tcl_AppendResult(interp, "postevent for channel \"", chanId,
+			 "\" called from outside interpreter",
+			 (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /* Second argument is a list of events. Allowed entries are
+     * "read", "write". Expect at least one list element.
+     * Abbreviations are ok.
+     */
+
+    if (RcEncodeEventMask (interp, "event", objv [EVENT], &events) != TCL_OK) {
+        return TCL_ERROR;
+    }
+    
+    /* Check that the channel is actually interested in the provided
+     * events.
+     */
+
+    if (events & ~rcPtr->interest) {
+        Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
+			 "\" is not interested in",
+			 (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    /* We have the channel and the events to post.
+     */
+
+    Tcl_NotifyChannel (chan, events);
+
+    /* Squash interp results left by the event script.
+     */
+
+    Tcl_ResetResult (interp);
+    return TCL_OK;
+
+#undef CHAN
+#undef EVENT
+}
+
+
+static Tcl_Obj*
+RcErrorMarshall (interp)
+     Tcl_Interp *interp;
+{
+    /* Capture the result status of the interpreter into a string.
+     * => List of options and values, followed by the error message.
+     * The result has refCount 0.
+     */
+    
+    Tcl_Obj* returnOpt = Tcl_GetReturnOptions (interp, TCL_ERROR);
+
+    /* => returnOpt.refCount == 0. We can append directly.
+     */
+
+    Tcl_ListObjAppendElement (NULL, returnOpt, Tcl_GetObjResult (interp));
+    return returnOpt;
+}
+
+static void
+RcErrorReturn (interp, msg)
+     Tcl_Interp *interp;
+     Tcl_Obj    *msg;
+{
+    int       res;
+    int       lc;
+    Tcl_Obj** lv;
+    int       explicitResult;
+    int       numOptions;
+
+    /* Process the caught message.
+     *
+     * Syntax = (option value)... ?message?
+     *
+     * Bad syntax causes a panic. Because the other side uses
+     * Tcl_GetReturnOptions and list construction functions to marshall the
+     * information.
+     */
+
+    res = Tcl_ListObjGetElements (interp, msg, &lc, &lv);
+    if (res != TCL_OK) {
+	Tcl_Panic ("TclChanCaughtErrorBypass: Bad syntax of caught result");
+    }
+
+    explicitResult = (1 == (lc % 2));
+    numOptions     = lc - explicitResult;
+
+    if (explicitResult) {
+	Tcl_SetObjResult (interp, lv [lc-1]);
+    }
+
+    (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj (numOptions, lv));
+}
+
+int
+TclChanCaughtErrorBypass (interp, chan)
+     Tcl_Interp *interp;
+     Tcl_Channel chan;
+{
+    Tcl_Obj* msgc = NULL;
+    Tcl_Obj* msgi = NULL;
+    Tcl_Obj* msg  = NULL;
+
+    /* Get a bypassed error message from channel and/or interpreter, save the
+     * reference, then kill the returned objects, if there were any. If there
+     * are messages in both the channel has preference.
+     */
+
+    if ((chan == NULL) && (interp == NULL)) {
+	return 0;
+    }
+
+    if (chan != NULL) {
+	Tcl_GetChannelError       (chan,   &msgc);
+    }
+    if (interp != NULL) {
+	Tcl_GetChannelErrorInterp (interp, &msgi);
+    }
+
+    if (msgc != NULL) {
+	msg = msgc;
+	Tcl_IncrRefCount (msg);
+    } else if (msgi != NULL) {
+	msg = msgi;
+	Tcl_IncrRefCount (msg);
+    }
+
+    if (msgc != NULL) {
+	Tcl_DecrRefCount (msgc);
+    }
+    if (msgi != NULL) {
+	Tcl_DecrRefCount (msgi);
+    }
+
+    /* No message returned, nothing caught.
+     */
+
+    if (msg == NULL) {
+	return 0;
+    }
+
+    RcErrorReturn (interp, msg);
+
+    Tcl_DecrRefCount (msg);
+    return 1;
+}
+
+/*
+ * Driver functions. ================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcClose --
+ *
+ *	This function is invoked when the channel is closed, to delete
+ *	the driver specific instance data.
+ *
+ * Results:
+ *	A posix error.
+ *
+ * Side effects:
+ *	Releases memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcClose (clientData, interp)
+     ClientData  clientData;
+     Tcl_Interp* interp;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    int                res;         /* Result code for 'close' */
+    Tcl_Obj*           resObj;      /* Result data for 'close' */
+
+    if (interp == (Tcl_Interp*) NULL) {
+        /* This call comes from TclFinalizeIOSystem. There are no
+	 * interpreters, and therefore we cannot call upon the handler
+	 * command anymore. Threading is irrelevant as well.  We
+	 * simply clean up all our C level data structures and leave
+	 * the Tcl level to the other finalization functions.
+	 */
+
+      /* THREADED => Forward this to the origin thread */
+      /* Note: Have a thread delete handler for the origin
+       * thread. Use this to clean up the structure!
+       */
+
+#ifdef TCL_THREADS
+        /* Are we in the correct thread ?
+	 */
+
+        if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+	    RcForwardParamClose p;
+
+	    RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
+	    res = p.b.code;
+
+	    /* RcFree is done in the forwarded operation!,
+	     * in the other thread. rcPtr here is gone!
+	     */
+
+	    if (res != TCL_OK) {
+	        RcFreeReceivedError (p.b);
+	    }
+	} else {
+#endif
+	    RcFree (rcPtr);
+#ifdef TCL_THREADS
+	}
+#endif
+	return EOK;
+    }
+
+    /* -------- */
+
+    /* -- No -- ASSERT rcPtr->methods & FLAG (METH_FINAL) */
+
+    /* A cleaned method mask here implies that the channel creation
+     * was aborted, and "finalize" must not be called.
+     */
+
+    if (rcPtr->methods == 0) {
+        RcFree (rcPtr);
+        return EOK;
+    } else {
+#ifdef TCL_THREADS
+        /* Are we in the correct thread ?
+	 */
+
+        if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+	    RcForwardParamClose p;
+
+	    RcForwardOp (rcPtr, RcOpClose, rcPtr->thread, &p);
+	    res = p.b.code;
+
+	    /* RcFree is done in the forwarded operation!,
+	     * in the other thread. rcPtr here is gone!
+	     */
+
+	    if (res != TCL_OK) {
+	        RcPassReceivedErrorInterp (interp, p.b);
+	    }
+	} else {
+#endif
+	    RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
+			       &res, &resObj, DO_CAPTURE);
+
+	    if ((res != TCL_OK) && (interp != NULL)) {
+	        Tcl_SetChannelErrorInterp (interp, resObj);
+	    }
+
+	    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+#ifdef TCL_THREADS
+	    RcFree (rcPtr);
+	}
+#endif
+	return (res == TCL_OK) ? EOK : EINVAL;
+    }
+
+    Tcl_Panic ("Should not be reached");
+    return EINVAL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcInput --
+ *
+ *	This function is invoked when more data is requested from the
+ *	channel.
+ *
+ * Results:
+ *	The number of bytes read.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcInput (clientData, buf, toRead, errorCodePtr)
+     ClientData clientData;
+     char* buf;
+     int toRead;
+     int* errorCodePtr;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*           toReadObj;
+    int                bytec;       /* Number of returned bytes */
+    unsigned char*     bytev;       /* Array of returned bytes */
+    int                res;         /* Result code for 'read' */
+    Tcl_Obj*           resObj;      /* Result data for 'read' */
+
+    /* The following check can be done before thread redirection,
+     * because we are reading from an item which is readonly, i.e.
+     * will never change during the lifetime of the channel.
+     */
+
+    if (!(rcPtr->methods & FLAG (METH_READ))) {
+        RcSetChannelErrorStr (rcPtr->chan, msg_read_unsup);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        RcForwardParamInput p;
+
+	p.buf    = buf;
+	p.toRead = toRead;
+
+	RcForwardOp (rcPtr, RcOpInput, rcPtr->thread, &p);
+
+	if (p.b.code != TCL_OK) {
+	    RcPassReceivedError (rcPtr->chan, p.b);
+	    *errorCodePtr = EINVAL;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	return p.toRead;
+    }
+#endif
+
+    /* -------- */
+
+    /* ASSERT: rcPtr->method & FLAG (METH_READ) */
+    /* ASSERT: rcPtr->mode & TCL_READABLE */
+
+    toReadObj = Tcl_NewIntObj(toRead);
+    if (toReadObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcInput");
+    }
+
+    RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
+		       &res, &resObj, DO_CAPTURE);
+
+    if (res != TCL_OK) {
+	Tcl_SetChannelError (rcPtr->chan, resObj);
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+    if (toRead < bytec) {
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	RcSetChannelErrorStr (rcPtr->chan, msg_read_toomuch);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    *errorCodePtr = EOK;
+
+    if (bytec > 0) {
+        memcpy (buf, bytev, bytec);
+    }
+
+    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+    return bytec;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcOutput --
+ *
+ *	This function is invoked when data is writen to the
+ *	channel.
+ *
+ * Results:
+ *	The number of bytes actually written.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcOutput (clientData, buf, toWrite, errorCodePtr)
+     ClientData clientData;
+     CONST char* buf;
+     int toWrite;
+     int* errorCodePtr;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*       bufObj;
+    int            res;         /* Result code for 'write' */
+    Tcl_Obj*       resObj;      /* Result data for 'write' */
+    int            written;
+
+    /* The following check can be done before thread redirection,
+     * because we are reading from an item which is readonly, i.e.
+     * will never change during the lifetime of the channel.
+     */
+
+    if (!(rcPtr->methods & FLAG (METH_WRITE))) {
+        RcSetChannelErrorStr (rcPtr->chan, msg_write_unsup);
+        *errorCodePtr = EINVAL;
+	return -1;
+    }
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+      RcForwardParamOutput p;
+
+      p.buf     = buf;
+      p.toWrite = toWrite;
+
+      RcForwardOp (rcPtr, RcOpOutput, rcPtr->thread, &p);
+
+      if (p.b.code != TCL_OK) {
+	  RcPassReceivedError (rcPtr->chan, p.b);
+	  *errorCodePtr = EINVAL;
+      } else {
+	  *errorCodePtr = EOK;
+      }
+
+      return p.toWrite;
+    }
+#endif
+
+    /* -------- */
+
+    /* ASSERT: rcPtr->method & FLAG (METH_WRITE) */
+    /* ASSERT: rcPtr->mode & TCL_WRITABLE */
+    
+    bufObj = Tcl_NewByteArrayObj((unsigned char*) buf, toWrite);
+    if (bufObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcOutput");
+    }
+
+    RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
+		       &res, &resObj, DO_CAPTURE);
+
+    if (res != TCL_OK) {
+	Tcl_SetChannelError (rcPtr->chan, resObj);
+	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    res = Tcl_GetIntFromObj (rcPtr->interp, resObj, &written);
+    if (res != TCL_OK) {
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+
+    if ((written == 0) || (toWrite < written)) {
+        /* The handler claims to have written more than it was given.
+	 * That is bad. Note that the I/O core would crash if we were
+	 * to return this information, trying to write -nnn bytes in
+	 * the next iteration.
+	 */
+
+        RcSetChannelErrorStr (rcPtr->chan, msg_write_toomuch);
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    *errorCodePtr = EOK;
+    return written;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcSeekWide / RcSeek --
+ *
+ *	This function is invoked when the user wishes to seek on
+ *	the channel.
+ *
+ * Results:
+ *	The new location of the access point.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_WideInt
+RcSeekWide (clientData, offset, seekMode, errorCodePtr)
+     ClientData  clientData;
+     Tcl_WideInt offset;
+     int         seekMode;
+     int*        errorCodePtr;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*       offObj;
+    Tcl_Obj*       baseObj;
+    int            res;         /* Result code for 'seek' */
+    Tcl_Obj*       resObj;      /* Result data for 'seek' */
+    Tcl_WideInt    newLoc;
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        RcForwardParamSeek p;
+
+	p.seekMode = seekMode;
+	p.offset   = offset;
+
+	RcForwardOp (rcPtr, RcOpSeek, rcPtr->thread, &p);
+
+	if (p.b.code != TCL_OK) {
+	    RcPassReceivedError (rcPtr->chan, p.b);
+	    *errorCodePtr = EINVAL;
+	} else {
+	    *errorCodePtr = EOK;
+	}
+
+	return p.offset;
+    }
+#endif
+
+    /* -------- */
+
+    /* ASSERT: rcPtr->method & FLAG (METH_SEEK) */
+
+    offObj = Tcl_NewWideIntObj(offset);
+    if (offObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcSeekWide");
+    }
+
+    baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ?
+			       "start" :
+			       ((seekMode == SEEK_CUR) ?
+				"current" :
+				"end"), -1);
+
+    if (baseObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcSeekWide");
+    }
+
+    RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
+		       &res, &resObj, DO_CAPTURE);
+
+    if (res != TCL_OK) {
+	Tcl_SetChannelError (rcPtr->chan, resObj);
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    res = Tcl_GetWideIntFromObj (rcPtr->interp, resObj, &newLoc);
+    if (res != TCL_OK) {
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	Tcl_SetChannelError (rcPtr->chan, RcErrorMarshall (rcPtr->interp));
+	*errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+
+    if (newLoc < Tcl_LongAsWide (0)) {
+        RcSetChannelErrorStr (rcPtr->chan, msg_seek_beforestart);
+        *errorCodePtr = EINVAL;
+	return -1;
+    }
+
+    *errorCodePtr = EOK;
+    return newLoc;
+}
+
+static int
+RcSeek (clientData, offset, seekMode, errorCodePtr)
+     ClientData  clientData;
+     long        offset;
+     int         seekMode;
+     int*        errorCodePtr;
+{
+  /* This function can be invoked from a transformation which is based
+   * on standard seeking, i.e. non-wide. Because o this we have to
+   * implement it, a dummy is not enough. We simply delegate the call
+   * to the wide routine.
+   */
+
+  return (int) RcSeekWide (clientData, Tcl_LongAsWide (offset),
+			   seekMode, errorCodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcWatch --
+ *
+ *	This function is invoked to tell the channel what events
+ *	the I/O system is interested in.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RcWatch (clientData, mask)
+     ClientData clientData;
+     int mask;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj* maskObj;
+
+    /* ASSERT rcPtr->methods & FLAG (METH_WATCH) */
+
+    /* We restrict the interest to what the channel can support
+     * IOW there will never be write events for a channel which is
+     * not writable. Analoguous for read events.
+     */
+
+    mask = mask & rcPtr->mode; 
+
+    if (mask == rcPtr->interest) {
+        /* Same old, same old, why should we do something ? */
+      return;
+    }
+
+    rcPtr->interest = mask;
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        RcForwardParamWatch p;
+
+	p.mask = mask;
+
+	RcForwardOp (rcPtr, RcOpWatch, rcPtr->thread, &p);
+
+	/* Any failure from the forward is ignored. We have no place to
+	 * put this.
+	 */
+	return;
+    }
+#endif
+
+    /* -------- */
+
+    maskObj = RcDecodeEventMask (mask);
+    RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
+		       NULL, NULL, NO_CAPTURE);
+    Tcl_DecrRefCount (maskObj);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcBlock --
+ *
+ *	This function is invoked to tell the channel which blocking
+ *	behaviour is required of it.
+ *
+ * Results:
+ *	A posix error number.
+ *
+ * Side effects:
+ *	Allocates memory. Arbitrary, as it calls upon a script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcBlock (clientData, nonblocking)
+     ClientData clientData;
+     int nonblocking;
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*           blockObj;
+    int                res;         /* Result code for 'blocking' */
+    Tcl_Obj*           resObj;      /* Result data for 'blocking' */
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        RcForwardParamBlock p;
+
+	p.nonblocking = nonblocking;
+
+	RcForwardOp (rcPtr, RcOpBlock, rcPtr->thread, &p);
+
+	if (p.b.code != TCL_OK) {
+	    RcPassReceivedError (rcPtr->chan, p.b);
+	    return EINVAL;
+	} else {
+	    return EOK;
+	}
+    }
+#endif
+
+    /* -------- */
+
+    blockObj = Tcl_NewBooleanObj(!nonblocking);
+    if (blockObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcBlock");
+    }
+
+    RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
+		       &res, &resObj, DO_CAPTURE);
+
+    if (res != TCL_OK) {
+	Tcl_SetChannelError (rcPtr->chan, resObj);
+	res = EINVAL;
+    } else {
+        res = EOK;
+    }
+
+    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+    return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcSetOption --
+ *
+ *	This function is invoked to configure a channel option.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcSetOption (clientData, interp, optionName, newValue)
+     ClientData   clientData;	/* Channel to query */
+     Tcl_Interp   *interp;	/* Interpreter to leave error messages in */
+     CONST char *optionName;	/* Name of requested option */
+     CONST char *newValue;	/* The new value */
+{
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*           optionObj;
+    Tcl_Obj*           valueObj;
+    int                res;         /* Result code for 'configure' */
+    Tcl_Obj*           resObj;      /* Result data for 'configure' */
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        RcForwardParamSetOpt p;
+
+	p.name  = optionName;
+	p.value = newValue;
+
+	RcForwardOp (rcPtr, RcOpSetOpt, rcPtr->thread, &p);
+
+	if (p.b.code != TCL_OK) {
+	    Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+
+	    RcErrorReturn (interp, err);
+
+	    Tcl_DecrRefCount (err);
+	    if (p.b.vol) {ckfree (p.b.msg);}
+	}
+
+	return p.b.code;
+    }
+#endif
+
+  /* -------- */
+
+  optionObj = Tcl_NewStringObj(optionName,-1);
+  if (optionObj == (Tcl_Obj*) NULL) {
+    Tcl_Panic ("Out of memory in RcSetOption");
+  }
+
+  valueObj = Tcl_NewStringObj(newValue,-1);
+  if (valueObj == (Tcl_Obj*) NULL) {
+    Tcl_Panic ("Out of memory in RcSetOption");
+  }
+
+  RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
+		     &res, &resObj, DO_CAPTURE);
+
+  if (res != TCL_OK) {
+    RcErrorReturn (interp, resObj);
+  }
+
+  Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+  return res;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcGetOption --
+ *
+ *	This function is invoked to retrieve all or a channel option.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcGetOption (clientData, interp, optionName, dsPtr)
+     ClientData   clientData;	/* Channel to query */
+     Tcl_Interp*  interp;	/* Interpreter to leave error messages in */
+     CONST char* optionName;	/* Name of reuqested option */
+     Tcl_DString* dsPtr;	/* String to place the result into */
+{
+    /* This code is special. It has regular passing of Tcl result, and
+     * errors. The bypass functions are not required.
+     */
+
+    ReflectingChannel* rcPtr = (ReflectingChannel*) clientData;
+    Tcl_Obj*           optionObj;
+    int                res;         /* Result code for 'configure' */
+    Tcl_Obj*           resObj;      /* Result data for 'configure' */
+    int                listc;
+    Tcl_Obj**          listv;
+    const char*        method;
+
+#ifdef TCL_THREADS
+    /* Are we in the correct thread ?
+     */
+
+    if (rcPtr->thread != Tcl_GetCurrentThread ()) {
+        int opcode;
+        RcForwardParamGetOpt p;
+
+	p.name  = optionName;
+	p.value = dsPtr;
+
+	if (optionName == (char*) NULL) {
+	    opcode = RcOpGetOptAll;
+	} else {
+	    opcode = RcOpGetOpt;
+	}
+
+	RcForwardOp (rcPtr, opcode, rcPtr->thread, &p);
+
+	if (p.b.code != TCL_OK) {
+	    Tcl_Obj* err = Tcl_NewStringObj (p.b.msg, -1);
+
+	    RcErrorReturn (interp, err);
+
+	    Tcl_DecrRefCount (err);
+	    if (p.b.vol) {ckfree (p.b.msg);}
+	}
+
+	return p.b.code;
+    }
+#endif
+
+    /* -------- */
+
+    if (optionName == (char*) NULL) {
+        /* Retrieve all options. */
+        method    = "cgetall";
+	optionObj = NULL;
+    } else {
+        /* Retrieve the value of one option */
+      
+        method    = "cget";
+	optionObj = Tcl_NewStringObj(optionName,-1);
+	if (optionObj == (Tcl_Obj*) NULL) {
+	    Tcl_Panic ("Out of memory in RcGetOption");
+	}
+    }
+
+    RcInvokeTclMethod (rcPtr, method, optionObj, NULL,
+			 &res, &resObj, DO_CAPTURE);
+
+    if (res != TCL_OK) {
+        RcErrorReturn (interp, resObj);
+	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	return res;
+    }
+
+    /* The result has to go into the 'dsPtr' for propagation to the
+     * caller of the driver.
+     */
+
+    if (optionObj != NULL) {
+        Tcl_DStringAppend (dsPtr, Tcl_GetString (resObj), -1);
+	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	return res;
+    }
+
+    /* Extract the list and append each item as element.
+     */
+
+    /* NOTE (4): If we extract the string rep we can assume a
+     * NOTE (4): properly quoted string. Together with a separating
+     * NOTE (4): space this way of simply appending the whole string
+     * NOTE (4): rep might be faster. It also doesn't check if the
+     * NOTE (4): result is a valid list. Nor that the list has an
+     * NOTE (4): even number elements.
+     * NOTE (4): ---
+     */
+
+    res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
+
+    if (res != TCL_OK) {
+        Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	return res;
+    }
+
+    if ((listc % 2) == 1) {
+        /* Odd number of elements is wrong.
+	 */
+
+        char buf [20];
+
+	sprintf (buf, "%d", listc);
+	Tcl_ResetResult  (interp);
+	Tcl_AppendResult (interp,
+			  "Expected list with even number of elements, got ",
+			  buf, (listc == 1 ? " element" : " elements"),
+			  " instead", (char*) NULL);
+
+	Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+	return TCL_ERROR;
+    }
+
+
+    {
+        int len;
+	char* str = Tcl_GetStringFromObj (resObj, &len);
+
+	if (len) {
+	    Tcl_DStringAppend (dsPtr, " ", 1);
+	    Tcl_DStringAppend (dsPtr, str, len);
+	}
+    }
+    Tcl_DecrRefCount (resObj); /* Remove reference we held from the invoke */
+    return res;
+}
+
+/*
+ * Helpers. =========================================================
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcEncodeEventMask --
+ *
+ *	This function takes a list of event items and constructs the
+ *	equivalent internal bitmask. The list has to contain at
+ *	least one element. Elements are "read", "write", or any unique
+ *	abbreviation thereof. Note that the bitmask is not changed if
+ *	problems are encountered.
+ *
+ * Results:
+ *	A standard Tcl error code. A bitmask where TCL_READABLE
+ *	and/or TCL_WRITABLE can be set.
+ *
+ * Side effects:
+ *	May shimmer 'obj' to a list representation. May place an
+ *	error message into the interp result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+RcEncodeEventMask (interp, objName, obj, mask)
+     Tcl_Interp* interp;
+     CONST char* objName;
+     Tcl_Obj*    obj;
+     int*        mask;
+{
+    int        events;	/* Mask of events to post */
+    int        listc;     /* #elements in eventspec list */
+    Tcl_Obj**  listv;     /* Elements of eventspec list */
+    int        evIndex;   /* Id of event for an element of the
+			 * eventspec list */
+
+    if (Tcl_ListObjGetElements (interp, obj,
+				&listc, &listv) != TCL_OK) {
+        return TCL_ERROR;
+    }
+
+    if (listc < 1) {
+        Tcl_AppendResult(interp, "bad ", objName, " list: is empty",
+			 (char *) NULL);
+	return TCL_ERROR;
+    }
+
+    events = 0;
+    while (listc > 0) {
+        if (Tcl_GetIndexFromObj (interp, listv [listc-1],
+				 eventOptions, objName, 0, &evIndex) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (evIndex) {
+	    case EVENT_READ:  events |= TCL_READABLE; break;
+	    case EVENT_WRITE: events |= TCL_WRITABLE; break;
+	}
+	listc --;
+    }
+
+    *mask = events;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcDecodeEventMask --
+ *
+ *	This function takes an internal bitmask of events and
+ *	constructs the equivalent list of event items.
+ *
+ * Results:
+ *	A Tcl_Obj reference. The object will have a refCount of
+ *	one. The user has to decrement it to release the object.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj*
+RcDecodeEventMask (mask)
+{
+    Tcl_Obj* evObj = Tcl_NewStringObj (((mask & RANDW) == RANDW) ?
+				       "read write" :
+				       ((mask & TCL_READABLE) ?
+					"read" :
+					((mask & TCL_WRITABLE) ?
+					 "write" : "")), -1);
+    if (evObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcDecodeEventMask");
+    }
+
+    Tcl_IncrRefCount (evObj);
+    return evObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcNew --
+ *
+ *	This function is invoked to allocate and initialize the
+ *	instance data of a new reflected channel.
+ *
+ * Results:
+ *	A heap-allocated channel instance.
+ *
+ * Side effects:
+ *	Allocates memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ReflectingChannel*
+RcNew (interp, cmdpfxObj, mode, id)
+       Tcl_Interp* interp;
+       Tcl_Obj*    cmdpfxObj;
+       int         mode;
+       Tcl_Obj*    id;
+{
+    ReflectingChannel* rcPtr;
+    int                listc;
+    Tcl_Obj**          listv;
+    Tcl_Obj*           word;
+    int                i;
+
+    rcPtr = (ReflectingChannel*) ckalloc (sizeof(ReflectingChannel));
+
+    /* rcPtr->chan    : Assigned by caller. Dummy data here. */
+    /* rcPtr->methods : Assigned by caller. Dummy data here. */
+
+    rcPtr->chan     = (Tcl_Channel) NULL;
+    rcPtr->methods  = 0;
+    rcPtr->interp   = interp;
+#ifdef TCL_THREADS
+    rcPtr->thread   = Tcl_GetCurrentThread ();
+#endif
+    rcPtr->mode     = mode;
+    rcPtr->interest = 0; /* Initially no interest registered */
+
+    /* Method placeholder */
+
+    /* ASSERT: cmdpfxObj is a Tcl List */
+
+    Tcl_ListObjGetElements (interp, cmdpfxObj, &listc, &listv);
+
+    /* See [==] as well.
+     * Storage for the command prefix and the additional words required
+     * for the invocation of methods in the command handler.
+     *
+     * listv [0] [listc-1] | [listc]  [listc+1] |
+     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
+     *       cmd   ... pfx | method   chan      | detail1 detail2
+     */
+
+    rcPtr->argc = listc + 2;
+    rcPtr->argv = (Tcl_Obj**) ckalloc (sizeof (Tcl_Obj*) * (listc+4));
+
+    for (i = 0; i < listc ; i++) {
+        word = rcPtr->argv [i] = listv [i];
+        Tcl_IncrRefCount (word);
+    }
+
+    i++; /* Skip placeholder for method */
+
+    rcPtr->argv [i] = id ; Tcl_IncrRefCount (id);
+
+    /* The next two objects are kept empty, varying arguments */
+
+    /* Initialization complete */
+    return rcPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcNewHandle --
+ *
+ *	This function is invoked to generate a channel handle for
+ *	a new reflected channel.
+ *
+ * Results:
+ *	A Tcl_Obj containing the string of the new channel handle.
+ *	The refcount of the returned object is -- zero --.
+ *
+ * Side effects:
+ *	May allocate memory. Mutex protected critical section
+ *	locks out other threads for a short time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj*
+RcNewHandle ()
+{
+    /* Count number of generated reflected channels.  Used for id
+     * generation. Ids are never reclaimed and there is no dealing
+     * with wrap around. On the other hand, "unsigned long" should be
+     * big enough except for absolute longrunners (generate a 100 ids
+     * per second => overflow will occur in 1 1/3 years).
+     */
+
+#ifdef TCL_THREADS
+    TCL_DECLARE_MUTEX (rcCounterMutex)
+#endif
+    static unsigned long rcCounter = 0;
+
+    char     channelName [50];
+    Tcl_Obj* res = Tcl_NewStringObj ("rc", -1);
+
+#ifdef TCL_THREADS
+    Tcl_MutexLock (&rcCounterMutex);
+#endif
+
+    sprintf (channelName, "%lu", (unsigned long) rcCounter);
+    rcCounter ++;
+
+#ifdef TCL_THREADS
+    Tcl_MutexUnlock (&rcCounterMutex);
+#endif
+
+    Tcl_AppendStringsToObj (res, channelName, (char*) NULL);
+    return res;
+}
+
+
+static void
+RcFree (rcPtr)
+     ReflectingChannel* rcPtr;
+{
+    Channel* chanPtr = (Channel*) rcPtr->chan;
+    int      i, n;
+
+    if (chanPtr->typePtr != &tclRChannelType) {
+        /* Delete a cloned ChannelType structure. */
+        ckfree ((char*) chanPtr->typePtr);
+    }
+
+    n = rcPtr->argc - 2;
+    for (i = 0; i < n; i++) {
+        Tcl_DecrRefCount (rcPtr->argv[i]);
+    }
+
+    ckfree ((char*) rcPtr->argv);
+    ckfree ((char*) rcPtr);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RcInvokeTclMethod --
+ *
+ *	This function is used to invoke the Tcl level of a reflected
+ *	channel. It handles all the command assembly, invokation, and
+ *	generic state and result mgmt.
+ *
+ * Results:
+ *      Result code and data as returned by the method.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upo na Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RcInvokeTclMethod (rcPtr, method, argone, argtwo, result, resultObj, capture)
+     ReflectingChannel* rcPtr;
+     CONST char*        method;
+     Tcl_Obj*           argone;    /* NULL'able */
+     Tcl_Obj*           argtwo;    /* NULL'able */
+     int*               result;    /* NULL'able */
+     Tcl_Obj**          resultObj; /* NULL'able */
+     int                capture;
+{
+    /* Thread redirection was done by higher layers */
+    /* ASSERT: Tcl_GetCurrentThread () == rcPtr->thread */
+
+    int             cmdc;           /* #words in constructed command */
+    Tcl_Obj*        methObj = NULL; /* Method name in object form */
+    Tcl_InterpState sr;             /* State of handler interp */
+    int             res;            /* Result code of method invokation */
+    Tcl_Obj*        resObj  = NULL; /* Result of method invokation. */
+
+    /* NOTE (5): Decide impl. issue: Cache objects with method names ?
+     * NOTE (5): Requires TSD data as reflections can be created in
+     * NOTE (5): many different threads.
+     * NOTE (5): ---
+     */
+
+    /* Insert method into the pre-allocated area, after the command
+     * prefix, before the channel id.
+     */
+
+    methObj = Tcl_NewStringObj (method, -1);
+    if (methObj == (Tcl_Obj*) NULL) {
+        Tcl_Panic ("Out of memory in RcInvokeTclMethod");
+    }
+    Tcl_IncrRefCount (methObj);
+    rcPtr->argv [rcPtr->argc - 2] = methObj;
+
+    /* Append the additional argument containing method specific
+     * details behind the channel id. If specified.
+     */
+
+    cmdc = rcPtr->argc ;
+    if (argone) {
+        Tcl_IncrRefCount (argone);
+	rcPtr->argv [cmdc] = argone;
+	cmdc++;
+    }
+    if (argtwo) {
+        Tcl_IncrRefCount (argtwo);
+	rcPtr->argv [cmdc] = argtwo;
+	cmdc++;
+    }
+
+    /* And run the handler ...  This is done in auch a manner which
+     * leaves any existing state intact.
+     */
+
+    sr  = Tcl_SaveInterpState (rcPtr->interp, 0 /* Dummy */);
+    res = Tcl_EvalObjv        (rcPtr->interp, cmdc, rcPtr->argv, TCL_EVAL_GLOBAL);
+
+    /* We do not try to extract the result information if the caller has no
+     * interest in it. I.e. there is no need to put effort into creating
+     * something which is discarded immediately after.
+     */
+
+    if (resultObj) {
+	if ((res == TCL_OK) || !capture) {
+	    /* Ok result taken as is, also if the caller requests that there
+	     * is no capture.
+	     */
+
+	    resObj = Tcl_GetObjResult (rcPtr->interp);
+	} else {
+	    /* Non-ok ressult is always treated as an error.
+	     * We have to capture the full state of the result,
+	     * including additional options.
+	     */
+
+	    res    = TCL_ERROR;
+	    resObj = RcErrorMarshall (rcPtr->interp);
+	}
+	Tcl_IncrRefCount(resObj);
+    }
+    Tcl_RestoreInterpState (rcPtr->interp, sr);
+
+    /* ... */
+
+    /* Cleanup of the dynamic parts of the command */
+
+    Tcl_DecrRefCount (methObj);
+    if (argone) {Tcl_DecrRefCount (argone);}
+    if (argtwo) {Tcl_DecrRefCount (argtwo);}
+
+    /* The resObj has a ref count of 1 at this location.  This means
+     * that the caller of RcInvoke has to dispose of it (but only if
+     * it was returned to it).
+     */
+
+    if (result) {
+        *result = res;
+    }
+    if (resultObj) {
+        *resultObj = resObj;
+    }
+    /* There no need to handle the case where nothing is returned, because for
+     * that case resObj was not set anyway.
+     */
+}
+
+#ifdef TCL_THREADS
+static void
+RcForwardOp (rcPtr, op, dst, param)
+  ReflectingChannel* rcPtr; /* Channel instance */
+  RcOperation        op;    /* Forwarded driver operation */
+  Tcl_ThreadId       dst;   /* Destination thread */
+  CONST VOID*        param; /* Arguments */
+{
+    RcForwardingEvent*  evPtr;
+    RcForwardingResult* resultPtr;
+    int                 result;
+
+    /* Create and initialize the event and data structures */
+
+    evPtr     = (RcForwardingEvent*)  ckalloc (sizeof (RcForwardingEvent));
+    resultPtr = (RcForwardingResult*) ckalloc (sizeof (RcForwardingResult));
+
+    evPtr->event.proc = RcForwardProc;
+    evPtr->resultPtr  = resultPtr;
+    evPtr->op         = op;
+    evPtr->rcPtr      = rcPtr;
+    evPtr->param      = param;
+
+    resultPtr->src    = Tcl_GetCurrentThread ();
+    resultPtr->dst    = dst;
+    resultPtr->done   = (Tcl_Condition) NULL;
+    resultPtr->result = -1;
+    resultPtr->evPtr  = evPtr;
+
+    /* Now execute the forward */
+
+    Tcl_MutexLock(&rcForwardMutex);
+    TclSpliceIn(resultPtr, forwardList);
+
+    /*
+     * Ensure cleanup of the event if any of the two involved threads
+     * exits while this event is pending or in progress.
+     */
+
+    Tcl_CreateThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
+    Tcl_CreateThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
+
+    /*
+     * Queue the event and poke the other thread's notifier.
+     */
+
+    Tcl_ThreadQueueEvent(dst, (Tcl_Event*)evPtr, TCL_QUEUE_TAIL);
+    Tcl_ThreadAlert(dst);
+
+    /*
+     * (*) Block until the other thread has either processed the transfer
+     * or rejected it.
+     */
+
+    while (resultPtr->result < 0) {
+        /* NOTE (1): Is it possible that the current thread goes away while waiting here ?
+	 * NOTE (1): IOW Is it possible that "RcSrcExitProc" is called while we are here ?
+	 * NOTE (1): See complementary note (2) in "RcSrcExitProc"
+	 * NOTE (1): ---
+	 */
+
+        Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
+    }
+
+    /*
+     * Unlink result from the forwarder list.
+     */
+
+    TclSpliceOut(resultPtr, forwardList);
+
+    resultPtr->nextPtr  = NULL;
+    resultPtr->prevPtr  = NULL;
+
+    Tcl_MutexUnlock(&rcForwardMutex);
+    Tcl_ConditionFinalize(&resultPtr->done);
+
+    /*
+     * Kill the cleanup handlers now, and the result structure as well,
+     * before returning the success code.
+     *
+     * Note: The event structure has already been deleted.
+     */
+
+    Tcl_DeleteThreadExitHandler(RcSrcExitProc, (ClientData) evPtr);
+    Tcl_DeleteThreadExitHandler(RcDstExitProc, (ClientData) evPtr);
+    
+    result =  resultPtr->result;
+    ckfree ((char*) resultPtr);
+}
+
+static int
+RcForwardProc (evGPtr, mask)
+     Tcl_Event *evGPtr; 
+     int mask;
+{
+    /* Notes regarding access to the referenced data.
+     *
+     * In principle the data belongs to the originating thread (see
+     * evPtr->src), however this thread is currently blocked at (*),
+     * i.e. quiescent. Because of this we can treat the data as
+     * belonging to us, without fear of race conditions. I.e. we can
+     * read and write as we like.
+     *
+     * The only thing we cannot be sure of is the resultPtr. This can be
+     * be NULLed if the originating thread went away while the event
+     * is handled here now.
+     */
+
+    RcForwardingEvent*  evPtr     = (RcForwardingEvent*) evGPtr;
+    RcForwardingResult* resultPtr = evPtr->resultPtr;
+    ReflectingChannel*  rcPtr     = evPtr->rcPtr;
+    Tcl_Interp*         interp    = rcPtr->interp;
+    RcForwardParamBase* paramPtr  = (RcForwardParamBase*) evPtr->param;
+    int                 res       = TCL_OK; /* Result code   of RcInvokeTclMethod */
+    Tcl_Obj*            resObj    = NULL;   /* Interp result of RcInvokeTclMethod */
+
+    /* Ignore the event if no one is waiting for its result anymore.
+     */
+
+    if (!resultPtr) {
+        return 1;
+    }
+
+    paramPtr->code = TCL_OK;
+    paramPtr->msg  = NULL;
+    paramPtr->vol  = 0;
+
+    switch (evPtr->op) {
+      /* The destination thread for the following operations is
+       * rcPtr->thread, which contains rcPtr->interp, the interp
+       * we have to call upon for the driver.
+       */
+
+    case RcOpClose:
+      {
+	  /* No parameters/results */
+	  RcInvokeTclMethod (rcPtr, "finalize", NULL, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	     RcForwardSetObjError (paramPtr, resObj);
+	  }
+
+	  /* Freeing is done here, in the origin thread, because the
+	   * argv[] objects belong to this thread. Deallocating them
+	   * in a different thread is not allowed
+	   */
+
+	  RcFree (rcPtr);
+      }
+      break;
+
+    case RcOpInput:
+      {
+	  RcForwardParamInput* p = (RcForwardParamInput*) paramPtr;
+	  Tcl_Obj*     toReadObj = Tcl_NewIntObj (p->toRead);
+
+	  if (toReadObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcInput");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "read", toReadObj, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	      p->toRead = -1;
+	  } else {
+	      /* Process a regular result. */
+
+	      int            bytec; /* Number of returned bytes */
+	      unsigned char* bytev; /* Array of returned bytes */
+
+	      bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
+
+	      if (p->toRead < bytec) {
+		  RcForwardSetStaticError (paramPtr, msg_read_toomuch);
+		  p->toRead   = -1;
+
+	      } else {
+	          if (bytec > 0) {
+		      memcpy (p->buf, bytev, bytec);
+		  }
+
+		  p->toRead = bytec;
+	      }
+	  }
+      }
+      break;
+
+    case RcOpOutput:
+      {
+	  RcForwardParamOutput* p = (RcForwardParamOutput*) paramPtr;
+	  Tcl_Obj*         bufObj = Tcl_NewByteArrayObj((unsigned char*) p->buf, p->toWrite);
+
+	  if (bufObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcOutput");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "write", bufObj, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	      p->toWrite = -1;
+	  } else {
+	      /* Process a regular result. */
+
+	      int written;
+
+	      res = Tcl_GetIntFromObj (interp, resObj, &written);
+	      if (res != TCL_OK) {
+
+		  RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
+		  p->toWrite = -1;
+
+	      } else if ((written == 0) || (p->toWrite < written)) {
+
+		  RcForwardSetStaticError (paramPtr, msg_write_toomuch);
+		  p->toWrite = -1;
+
+	      } else {
+		  p->toWrite = written;
+	      }
+	  }
+      }
+      break;
+
+    case RcOpSeek:
+      {
+	  RcForwardParamSeek* p = (RcForwardParamSeek*) paramPtr;
+
+	  Tcl_Obj*       offObj;
+	  Tcl_Obj*       baseObj;
+
+	  offObj = Tcl_NewWideIntObj(p->offset);
+	  if (offObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcSeekWide");
+	  }
+
+	  baseObj = Tcl_NewStringObj((p->seekMode == SEEK_SET) ?
+				     "start" :
+				     ((p->seekMode == SEEK_CUR) ?
+				      "current" :
+				      "end"), -1);
+
+	  if (baseObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcSeekWide");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "seek", offObj, baseObj,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	      p->offset = -1;
+	  } else {
+	      /* Process a regular result. If the type is wrong this
+	       * may change into an error.
+	       */
+
+	      Tcl_WideInt newLoc;
+	      res = Tcl_GetWideIntFromObj (interp, resObj, &newLoc);
+
+	      if (res == TCL_OK) {
+		  if (newLoc < Tcl_LongAsWide (0)) {
+		      RcForwardSetStaticError (paramPtr, msg_seek_beforestart);
+		      p->offset = -1;
+		  } else {
+		      p->offset = newLoc;
+		  }
+	      } else {
+		  RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
+		  p->offset = -1;
+	      }
+	  }
+      }
+      break;
+
+    case RcOpWatch:
+      {
+	  RcForwardParamWatch* p = (RcForwardParamWatch*) paramPtr;
+
+	  Tcl_Obj* maskObj = RcDecodeEventMask (p->mask);
+	  RcInvokeTclMethod (rcPtr, "watch", maskObj, NULL,
+			     NULL, NULL, NO_CAPTURE);
+	  Tcl_DecrRefCount (maskObj);
+      }
+    break;
+
+    case RcOpBlock:
+      {
+	  RcForwardParamBlock* p = (RcForwardParamBlock*) evPtr->param;
+	  Tcl_Obj*      blockObj = Tcl_NewBooleanObj(!p->nonblocking);
+
+	  if (blockObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcBlock");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "blocking", blockObj, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	  }
+      }
+      break;
+
+    case RcOpSetOpt:
+      {
+	  RcForwardParamSetOpt* p = (RcForwardParamSetOpt*) paramPtr;
+	  Tcl_Obj* optionObj;
+	  Tcl_Obj* valueObj;
+
+	  optionObj = Tcl_NewStringObj(p->name,-1);
+	  if (optionObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcSetOption");
+	  }
+
+	  valueObj = Tcl_NewStringObj(p->value,-1);
+	  if (valueObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcSetOption");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "configure", optionObj, valueObj,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	  }
+      }
+      break;
+
+    case RcOpGetOpt:
+      {
+	  /* Retrieve the value of one option */
+
+	  RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
+	  Tcl_Obj*           optionObj;
+
+	  optionObj = Tcl_NewStringObj(p->name,-1);
+	  if (optionObj == (Tcl_Obj*) NULL) {
+	      Tcl_Panic ("Out of memory in RcGetOption");
+	  }
+
+	  RcInvokeTclMethod (rcPtr, "cget", optionObj, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	  } else {
+	      Tcl_DStringAppend (p->value, Tcl_GetString (resObj), -1);
+	  }
+      }
+      break;
+
+    case RcOpGetOptAll:
+      {
+	  /* Retrieve all options. */
+
+	  RcForwardParamGetOpt* p = (RcForwardParamGetOpt*) paramPtr;
+
+	  RcInvokeTclMethod (rcPtr, "cgetall", NULL, NULL,
+			     &res, &resObj, DO_CAPTURE);
+
+	  if (res != TCL_OK) {
+	      RcForwardSetObjError (paramPtr, resObj);
+	  } else {
+	      /* Extract list, validate that it is a list, and
+	       * #elements. See NOTE (4) as well.
+	       */
+
+	      int       listc;
+	      Tcl_Obj** listv;
+
+	      res = Tcl_ListObjGetElements (interp, resObj, &listc, &listv);
+	      if (res != TCL_OK) {
+		  RcForwardSetObjError (paramPtr, RcErrorMarshall (interp));
+
+	      } else if ((listc % 2) == 1) {
+	          /* Odd number of elements is wrong.
+		   * [x].
+		   */
+
+	          char* buf = ckalloc (200);
+		  sprintf (buf,
+			   "{Expected list with even number of elements, got %d %s instead}",
+			   listc,
+			   (listc == 1 ? "element" : "elements"));
+		  
+		  RcForwardSetDynError (paramPtr, buf);
+	      } else {
+		  int len;
+		  char* str = Tcl_GetStringFromObj (resObj, &len);
+
+		  if (len) {
+		      Tcl_DStringAppend (p->value, " ", 1);
+		      Tcl_DStringAppend (p->value, str, len);
+		  }
+	      }
+	  }
+      }
+      break;
+
+    default:
+      /* Bad operation code */
+      Tcl_Panic ("Bad operation code in RcForwardProc");
+      break;
+    }
+
+    /* Remove the reference we held on the result of the invoke, if we had
+     * such
+     */
+    if (resObj != NULL) {
+	Tcl_DecrRefCount (resObj);
+    }
+
+    if (resultPtr) {
+        /*
+	 * Report the forwarding result synchronously to the waiting
+	 * caller. This unblocks (*) as well. This is wrapped into a
+	 * conditional because the caller may have exited in the mean
+	 * time.
+	 */
+
+        Tcl_MutexLock(&rcForwardMutex);
+	resultPtr->result = TCL_OK;
+	Tcl_ConditionNotify(&resultPtr->done);
+	Tcl_MutexUnlock(&rcForwardMutex);
+    }
+
+    return 1;
+}
+
+
+static void
+RcSrcExitProc (clientData)
+     ClientData clientData;
+{
+  RcForwardingEvent*  evPtr = (RcForwardingEvent*) clientData;
+  RcForwardingResult* resultPtr;
+  RcForwardParamBase* paramPtr;
+
+  /* NOTE (2): Can this handler be called with the originator blocked ?
+   * NOTE (2): ---
+   */
+
+  /* The originator for the event exited. It is not sure if this
+   * can happen, as the originator should be blocked at (*) while
+   * the event is in transit/pending.
+   */
+
+  /*
+   * We make sure that the event cannot refer to the result anymore,
+   * remove it from the list of pending results and free the
+   * structure. Locking the access ensures that we cannot get in
+   * conflict with "RcForwardProc", should it already execute the
+   * event.
+   */
+
+  Tcl_MutexLock(&rcForwardMutex);
+
+  resultPtr = evPtr->resultPtr;
+  paramPtr  = (RcForwardParamBase*) evPtr->param;
+
+  evPtr->resultPtr  = NULL;
+  resultPtr->evPtr  = NULL;
+  resultPtr->result = TCL_ERROR;
+
+  RcForwardSetStaticError (paramPtr, msg_send_originlost);
+
+  /* See below: TclSpliceOut(resultPtr, forwardList); */
+
+  Tcl_MutexUnlock(&rcForwardMutex);
+
+  /*
+   * This unlocks (*). The structure will be spliced out and freed by
+   * "RcForwardProc". Maybe.
+   */
+
+  Tcl_ConditionNotify(&resultPtr->done);
+}
+
+
+static void
+RcDstExitProc (clientData)
+     ClientData clientData;
+{
+  RcForwardingEvent*  evPtr     = (RcForwardingEvent*) clientData;
+  RcForwardingResult* resultPtr = evPtr->resultPtr;
+  RcForwardParamBase* paramPtr  = (RcForwardParamBase*) evPtr->param;
+
+  /* NOTE (3): It is not clear if the event still exists when this handler is called..
+   * NOTE (3): We might have to use 'resultPtr' as our clientData instead.
+   * NOTE (3): ---
+   */
+
+  /* The receiver for the event exited, before processing the
+   * event. We detach the result now, wake the originator up
+   * and signal failure.
+   */
+
+  evPtr->resultPtr = NULL;
+  resultPtr->evPtr  = NULL;
+  resultPtr->result = TCL_ERROR;
+
+  RcForwardSetStaticError (paramPtr, msg_send_dstlost);
+
+  Tcl_ConditionNotify(&resultPtr->done);
+}
+
+
+static void
+RcForwardSetObjError (p,obj)
+     RcForwardParamBase* p;
+     Tcl_Obj*            obj;
+{
+    int   len;
+    char* msg;
+
+    msg = Tcl_GetStringFromObj (obj, &len);
+
+    p->code = TCL_ERROR;
+    p->vol  = 1;
+    p->msg  = strcpy(ckalloc (1+len), msg);
+}
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8ba85b6..1da1a43 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.245 2005/08/11 22:06:47 kennykb Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.246 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #ifndef _TCLINT
@@ -1515,6 +1515,15 @@ typedef struct Interp {
 				 * inserted by an ensemble. */
     } ensembleRewrite;
 
+    /* TIP #219 ... Global info for the I/O system ...
+     * Error message set by channel drivers, for the propagation of
+     * arbitrary Tcl errors. This information, if present (chanMsg not
+     * NULL), takes precedence over a posix error code returned by a
+     * channel operation.
+     */
+
+    Tcl_Obj* chanMsg;
+
     /*
      * Statistical information about the bytecode compiler and interpreter's
      * operation.
@@ -1527,6 +1536,42 @@ typedef struct Interp {
 } Interp;
 
 /*
+ * General list of interpreters. Doubly linked for easier
+ * removal of items deep in the list.
+ */
+
+typedef struct InterpList {
+   Interp* interpPtr;
+   struct InterpList* prevPtr;
+   struct InterpList* nextPtr;
+} InterpList;
+
+/*
+ * Macros for splicing into and out of doubly linked lists.
+ * They assume existence of struct items 'prevPtr' and 'nextPtr'.
+ *
+ * a = element to add or remove.
+ * b = list head.
+ *
+ * TclSpliceIn adds to the head of the list.
+ */
+
+#define TclSpliceIn(a,b)                       \
+    (a)->nextPtr = (b);                        \
+    if ((b) != NULL)                           \
+        (b)->prevPtr = (a);                    \
+    (a)->prevPtr = NULL, (b) = (a);
+
+#define TclSpliceOut(a,b)                      \
+    if ((a)->prevPtr != NULL)                  \
+        (a)->prevPtr->nextPtr = (a)->nextPtr;  \
+    else                                       \
+        (b) = (a)->nextPtr;                    \
+    if ((a)->nextPtr != NULL)                  \
+        (a)->nextPtr->prevPtr = (a)->prevPtr;
+
+
+/*
  * EvalFlag bits for Interp structures:
  *
  * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with
@@ -1941,6 +1986,12 @@ MODULE_SCOPE int	TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
 MODULE_SCOPE double     TclBignumToDouble _ANSI_ARGS_((mp_int* bignum));
 MODULE_SCOPE int	TclCheckBadOctal _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *value));
+MODULE_SCOPE int        TclChanCreateObjCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+MODULE_SCOPE int        TclChanPostEventObjCmd _ANSI_ARGS_((ClientData clientData,
+			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+MODULE_SCOPE int        TclChanCaughtErrorBypass _ANSI_ARGS_((Tcl_Interp *interp,
+			    Tcl_Channel chan));
 MODULE_SCOPE void	TclCleanupLiteralTable _ANSI_ARGS_((
 			    Tcl_Interp* interp, LiteralTable* tablePtr));
 MODULE_SCOPE int	TclDoubleDigits _ANSI_ARGS_((char* buf,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 5efadc4..b27ab3d 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStubInit.c,v 1.121 2005/08/05 23:57:36 dkf Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.122 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -984,6 +984,10 @@ TclStubs tclStubs = {
     Tcl_GetBignumFromObj, /* 558 */
     Tcl_TruncateChannel, /* 559 */
     Tcl_ChannelTruncateProc, /* 560 */
+    Tcl_SetChannelErrorInterp, /* 561 */
+    Tcl_GetChannelErrorInterp, /* 562 */
+    Tcl_SetChannelError, /* 563 */
+    Tcl_GetChannelError, /* 564 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 974112c..d0f6406 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.91 2005/06/01 21:38:42 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.92 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #define TCL_TEST
@@ -121,6 +121,20 @@ typedef struct TestEvent {
     Tcl_Obj* tag;		/* Tag for this event used to delete it */
 } TestEvent;
 
+
+/*
+ * Simple detach/attach facility for testchannel cut|splice.
+ * Allow testing of channel transfer in core testsuite.
+ */
+
+typedef struct TestChannel {
+    Tcl_Channel         chan;    /* Detached channel */
+    struct TestChannel* nextPtr; /* Next in pool of detached channels */
+} TestChannel;
+
+static TestChannel* firstDetached;
+
+
 /*
  * Forward declarations for procedures defined later in this file:
  */
@@ -5352,10 +5366,33 @@ TestChannelCmd(clientData, interp, argc, argv)
     chanPtr = (Channel *) NULL;
 
     if (argc > 2) {
-        chan = Tcl_GetChannel(interp, argv[2], &mode);
-        if (chan == (Tcl_Channel) NULL) {
-            return TCL_ERROR;
-        }
+        if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
+	    /* For splice access the pool of detached channels.
+	     * Locate channel, remove from the list.
+	     */
+
+	    TestChannel** nextPtrPtr;
+	    TestChannel*  curPtr;
+
+	    chan = (Tcl_Channel) NULL;
+	    for (nextPtrPtr = &firstDetached, curPtr = firstDetached;
+		 curPtr != NULL;
+		 nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {
+
+	        if (strcmp (argv[2], Tcl_GetChannelName (curPtr->chan)) == 0) {
+		    *nextPtrPtr    = curPtr->nextPtr;
+		    curPtr->nextPtr = NULL;
+		    chan = curPtr->chan;
+		    ckfree ((char*) curPtr);
+		    break;
+		}
+	    }
+	} else {
+	    chan = Tcl_GetChannel(interp, argv[2], &mode);
+	}
+	if (chan == (Tcl_Channel) NULL) {
+	    return TCL_ERROR;
+	}
         chanPtr		= (Channel *) chan;
 	statePtr	= chanPtr->state;
         chanPtr		= statePtr->topChanPtr;
@@ -5366,13 +5403,62 @@ TestChannelCmd(clientData, interp, argc, argv)
 	chan		= NULL;
     }
 
+    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerror", len) == 0)) {
+
+	Tcl_Obj* msg = Tcl_NewStringObj (argv [3],-1);
+
+	Tcl_IncrRefCount (msg);
+	Tcl_SetChannelError (chan, msg);
+	Tcl_DecrRefCount (msg);
+
+	Tcl_GetChannelError (chan, &msg);
+	Tcl_SetObjResult (interp, msg);
+	Tcl_DecrRefCount (msg);
+	return TCL_OK;
+    }
+    if ((cmdName[0] == 's') && (strncmp(cmdName, "setchannelerrorinterp", len) == 0)) {
+
+	Tcl_Obj* msg = Tcl_NewStringObj (argv [3],-1);
+
+	Tcl_IncrRefCount (msg);
+	Tcl_SetChannelErrorInterp (interp, msg);
+	Tcl_DecrRefCount (msg);
+
+	Tcl_GetChannelErrorInterp (interp, &msg);
+	Tcl_SetObjResult (interp, msg);
+	Tcl_DecrRefCount (msg);
+	return TCL_OK;
+    }
+
+    /*
+     * "cut" is actually more a simplified detach facility as provided
+     * by the Thread package. Without the safeguards of a regular
+     * command (no checking that the command is truly cut'able, no
+     * mutexes for thread-safety). Its complementary command is
+     * "splice", see below.
+     */
+
     if ((cmdName[0] == 'c') && (strncmp(cmdName, "cut", len) == 0)) {
+        TestChannel* det;
+
         if (argc != 3) {
             Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                     " cut channelName\"", (char *) NULL);
             return TCL_ERROR;
         }
+
+	Tcl_RegisterChannel((Tcl_Interp *) NULL, chan); /* prevent closing */
+	Tcl_UnregisterChannel(interp, chan);
+
         Tcl_CutChannel(chan);
+
+	/* Remember the channel in the pool of detached channels */
+
+	det = (TestChannel*) ckalloc (sizeof(TestChannel));
+	det->chan     = chan;
+	det->nextPtr  = firstDetached;
+	firstDetached = det;
+
         return TCL_OK;
     }
 
@@ -5626,6 +5712,14 @@ TestChannelCmd(clientData, interp, argc, argv)
         return TCL_OK;
     }
 
+    /*
+     * "splice" is actually more a simplified attach facility as
+     * provided by the Thread package. Without the safeguards of a
+     * regular command (no checking that the command is truly
+     * cut'able, no mutexes for thread-safety). Its complementary
+     * command is "cut", see above.
+     */
+
     if ((cmdName[0] == 's') && (strncmp(cmdName, "splice", len) == 0)) {
         if (argc != 3) {
             Tcl_AppendResult(interp, "channel name required", (char *) NULL);
@@ -5633,6 +5727,10 @@ TestChannelCmd(clientData, interp, argc, argv)
         }
 
         Tcl_SpliceChannel(chan);
+
+	Tcl_RegisterChannel(interp, chan);
+	Tcl_UnregisterChannel((Tcl_Interp *)NULL, chan);
+
         return TCL_OK;
     }
 
@@ -6672,3 +6770,11 @@ TestgetintCmd(dummy, interp, argc, argv)
 	return TCL_OK;
     }
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 299a5aa..21487e7 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadTest.c,v 1.19 2005/05/10 18:34:50 kennykb Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.20 2005/08/24 17:56:23 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -479,6 +479,12 @@ NewTestThread(clientData)
     result = Tcl_Init(tsdPtr->interp);
     result = TclThread_Init(tsdPtr->interp);
 
+    /* This is part of the test facility.
+     * Initialize _ALL_ test commands for
+     * use by the new thread.
+     */
+    result = Tcltest_Init(tsdPtr->interp);
+
     /*
      * Update the list of threads.
      */
diff --git a/library/init.tcl b/library/init.tcl
index 626f9f3..527f0b9 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.79 2005/07/27 16:24:14 dgp Exp $
+# RCS: @(#) $Id: init.tcl,v 1.80 2005/08/24 17:56:23 andreas_kupries Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -73,24 +73,27 @@ namespace eval tcl {
 	unsupported::EncodingDirs $Path
     }
 
-    # Set up the 'chan' ensemble
+    # Set up the 'chan' ensemble (TIP #208).
     namespace eval chan {
-	namespace ensemble create -command ::chan -map {
-	    blocked	::fblocked
-	    close	::close
-	    configure	::fconfigure
-	    copy	::fcopy
-	    eof		::eof
-	    event	::fileevent
-	    flush	::flush
-	    gets	::gets
-	    names	{::file channels}
-	    puts	::puts
-	    read	::read
-	    seek	::seek
-	    tell	::tell
-	    truncate	::tcl::chan::Truncate
-	}
+        # TIP #219. Added methods: create, postevent.
+        namespace ensemble create -command ::chan -map {
+            blocked     ::fblocked
+            close       ::close
+            configure   ::fconfigure
+            copy        ::fcopy
+            create      ::tcl::chan::rCreate
+            eof         ::eof
+            event       ::fileevent
+            flush       ::flush
+            gets        ::gets
+            names       {::file channels}
+            postevent   ::tcl::chan::rPostevent
+            puts        ::puts
+            read        ::read
+            seek        ::seek
+            tell        ::tell
+            truncate    ::tcl::chan::Truncate
+        }
     }
 }
 
diff --git a/tests/chan.test b/tests/chan.test
index dd2fea6..f2376a3 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -7,19 +7,24 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: chan.test,v 1.4 2005/06/07 21:31:53 dkf Exp $
+# RCS: @(#) $Id: chan.test,v 1.5 2005/08/24 17:56:24 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+#
+# Note: The tests for the chan methods "create" and "postevent"
+# currently reside in the file "ioCmd.test".
+#
+
 test chan-1.1 {chan command general syntax} -body {
     chan
 } -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\""
 test chan-1.2 {chan command general syntax} -body {
     chan FOOBAR
-} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, eof, event, flush, gets, names, puts, read, seek, tell, or truncate"
+} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate"
 
 test chan-2.1 {chan command: blocked subcommand} -body {
     chan blocked foo bar
diff --git a/tests/io.test b/tests/io.test
index 9d724b8..4edb308 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Functionality covered: operation of all IO commands, and all procedures
 # defined in generic/tclIO.c.
 #
@@ -12,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.68 2005/05/10 18:35:21 kennykb Exp $
+# RCS: @(#) $Id: io.test,v 1.69 2005/08/24 17:56:24 andreas_kupries Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -28,14 +29,14 @@ namespace eval ::tcl::test::io {
     namespace import ::tcltest::testConstraint
     namespace import ::tcltest::viewFile
 
-testConstraint testchannel [llength [info commands testchannel]]
-testConstraint exec [llength [info commands exec]]
-testConstraint openpipe 1
-testConstraint fileevent [llength [info commands fileevent]]
-testConstraint fcopy [llength [info commands fcopy]]
-testConstraint testfevent [llength [info commands testfevent]]
+testConstraint testchannel      [llength [info commands testchannel]]
+testConstraint exec             [llength [info commands exec]]
+testConstraint openpipe         1
+testConstraint fileevent        [llength [info commands fileevent]]
+testConstraint fcopy            [llength [info commands fcopy]]
+testConstraint testfevent       [llength [info commands testfevent]]
 testConstraint testchannelevent [llength [info commands testchannelevent]]
-testConstraint testmainthread [llength [info commands testmainthread]]
+testConstraint testmainthread   [llength [info commands testmainthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
@@ -7111,6 +7112,266 @@ test io-61.1 {Reset eof state after changing the eof char} -setup {
     removeFile eofchar
 } -result {77 = 23431}
 
+
+# Test the cutting and splicing of channels, this is incidentially the
+# attach/detach facility of package Thread, but __without any
+# safeguards__. It can also be used to emulate transfer of channels
+# between threads, and is used for that here.
+
+test io-70.0 {Cutting & Splicing channels} {testchannel} {
+    set f [makeFile {... dummy ...} cutsplice]
+    set c [open $f r]
+
+    set     res {}
+    lappend res [catch {seek $c 0 start}]
+    testchannel cut $c
+
+    lappend res [catch {seek $c 0 start}]
+    testchannel splice $c
+
+    lappend res [catch {seek $c 0 start}]
+    close $c
+
+    removeFile cutsplice
+
+    set res
+} {0 1 0}
+
+
+# Duplicate of code in "thread.test". Find a better way of doing this
+# without duplication. Maybe placement into a proc which transforms to
+# nop after the first call, and placement of its defintion in a
+# central location.
+
+testConstraint testthread [expr {[info commands testthread] != {}}]
+
+if {[testConstraint testthread]} {
+    testthread errorproc ThreadError
+
+    proc ThreadError {id info} {
+	global threadError
+	set threadError $info
+    }
+
+    proc ThreadNullError {id info} {
+	# ignore
+    }
+}
+
+test io-70.1 {Transfer channel} {testchannel testthread} {
+    set f [makeFile {... dummy ...} cutsplice]
+    set c [open $f r]
+
+    set     res {}
+    lappend res [catch {seek $c 0 start}]
+    testchannel cut $c
+    lappend res [catch {seek $c 0 start}]
+
+    set tid [testthread create]
+    testthread send $tid [list set c $c]
+    lappend res [testthread send $tid {
+	testchannel splice $c
+	set res [catch {seek $c 0 start}]
+	close $c
+	set res
+    }]
+
+    tcltest::threadReap
+    removeFile cutsplice
+
+    set res
+} {0 1 0}
+
+# ### ### ### ######### ######### #########
+
+foreach {n msg expected} {
+     0 {}                                 {}
+     1 {{message only}}                   {{message only}}
+     2 {-options x}                       {-options x}
+     3 {-options {x y} {the message}}     {-options {x y} {the message}}
+
+     4 {-code 1     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     5 {-code 0     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     6 {-code 1     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     7 {-code 0     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf}
+     9 {-code ok    -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf}
+    11 {-code ok    -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    12 {-code boss  -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    13 {-code boss  -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    14 {-code 1     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    15 {-code 0     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    16 {-code 1     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    17 {-code 0     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    18 {-code error -level 0 -f ba}       {-code error -level 0 -f ba}
+    19 {-code ok    -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    20 {-code error -level 5 -f ba}       {-code error -level 0 -f ba}
+    21 {-code ok    -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    22 {-code boss  -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    23 {-code boss  -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    24 {-code 1     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    25 {-code 0     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf}
+    27 {-code ok    -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    28 {-code boss  -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    29 {-code 1     -level X -f ba}       {-code 1     -level 0 -f ba}
+    30 {-code 0     -level X -f ba}       {-code 1     -level 0 -f ba}
+    31 {-code error -level X -f ba}       {-code error -level 0 -f ba}
+    32 {-code ok    -level X -f ba}       {-code 1     -level 0 -f ba}
+    33 {-code boss  -level X -f ba}       {-code 1     -level 0 -f ba}
+
+    34 {-code 1 -code 1     -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    35 {-code 1 -code 0     -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    36 {-code 1 -code 1     -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    37 {-code 1 -code 0     -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    39 {-code 1 -code ok    -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    41 {-code 1 -code ok    -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    42 {-code 1 -code boss  -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    43 {-code 1 -code boss  -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    44 {-code 1 -code 1     -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    45 {-code 1 -code 0     -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    46 {-code 1 -code 1     -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    47 {-code 1 -code 0     -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    48 {-code 1 -code error -level 0 -f ba}       {-code 1 -code error -level 0 -f ba}
+    49 {-code 1 -code ok    -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    50 {-code 1 -code error -level 5 -f ba}       {-code 1 -code error -level 0 -f ba}
+    51 {-code 1 -code ok    -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    52 {-code 1 -code boss  -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    53 {-code 1 -code boss  -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    54 {-code 1 -code 1     -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    55 {-code 1 -code 0     -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    57 {-code 1 -code ok    -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    58 {-code 1 -code boss  -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    59 {-code 1 -code 1     -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    60 {-code 1 -code 0     -level X -f ba}       {-code 1             -level 0 -f ba}
+    61 {-code 1 -code error -level X -f ba}       {-code 1 -code error -level 0 -f ba}
+    62 {-code 1 -code ok    -level X -f ba}       {-code 1             -level 0 -f ba}
+    63 {-code 1 -code boss  -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    64 {-code 0 -code 1     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    65 {-code 0 -code 0     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    66 {-code 0 -code 1     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    67 {-code 0 -code 0     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    69 {-code 0 -code ok    -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    71 {-code 0 -code ok    -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    72 {-code 0 -code boss  -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    73 {-code 0 -code boss  -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    74 {-code 0 -code 1     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    75 {-code 0 -code 0     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    76 {-code 0 -code 1     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    77 {-code 0 -code 0     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    78 {-code 0 -code error -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    79 {-code 0 -code ok    -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    80 {-code 0 -code error -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    81 {-code 0 -code ok    -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    82 {-code 0 -code boss  -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    83 {-code 0 -code boss  -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    84 {-code 0 -code 1     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    85 {-code 0 -code 0     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    87 {-code 0 -code ok    -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    88 {-code 0 -code boss  -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    89 {-code 0 -code 1     -level X -f ba}       {-code 1 -level 0 -f ba}
+    90 {-code 0 -code 0     -level X -f ba}       {-code 1 -level 0 -f ba}
+    91 {-code 0 -code error -level X -f ba}       {-code 1 -level 0 -f ba}
+    92 {-code 0 -code ok    -level X -f ba}       {-code 1 -level 0 -f ba}
+    93 {-code 0 -code boss  -level X -f ba}       {-code 1 -level 0 -f ba}
+
+    94 {-code 1     -code 1 -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    95 {-code 0     -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    96 {-code 1     -code 1 -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    97 {-code 0     -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    99 {-code ok    -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    a1 {-code ok    -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a2 {-code boss  -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a3 {-code boss  -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a4 {-code 1     -code 1 -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a5 {-code 0     -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    a6 {-code 1     -code 1 -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a7 {-code 0     -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    a8 {-code error -code 1 -level 0 -f ba}       {-code error -code 1 -level 0 -f ba}
+    a9 {-code ok    -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b0 {-code error -code 1 -level 5 -f ba}       {-code error -code 1 -level 0 -f ba}
+    b1 {-code ok    -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b2 {-code boss  -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b3 {-code boss  -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b4 {-code 1     -code 1 -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    b5 {-code 0     -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    b7 {-code ok    -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b8 {-code boss  -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b9 {-code 1     -code 1 -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    c0 {-code 0     -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c1 {-code error -code 1 -level X -f ba}       {-code error -code 1 -level 0 -f ba}
+    c2 {-code ok    -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c3 {-code boss  -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    c4 {-code 1     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c5 {-code 0     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c6 {-code 1     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c7 {-code 0     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c9 {-code ok    -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d1 {-code ok    -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d2 {-code boss  -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d3 {-code boss  -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d4 {-code 1     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d5 {-code 0     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d6 {-code 1     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d7 {-code 0     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d8 {-code error -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d9 {-code ok    -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e0 {-code error -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e1 {-code ok    -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e2 {-code boss  -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e3 {-code boss  -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e4 {-code 1     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e5 {-code 0     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e7 {-code ok    -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e8 {-code boss  -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e9 {-code 1     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f0 {-code 0     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f1 {-code error -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f2 {-code ok    -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f3 {-code boss  -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+} {
+    test io-71.$n {Tcl_SetChannelError} {testchannel} {
+
+	set f [makeFile {... dummy ...} cutsplice]
+	set c [open $f r]
+
+	set res [testchannel setchannelerror $c [lrange $msg 0 end]]
+	close $c
+	removeFile cutsplice
+
+	set res
+    } [lrange $expected 0 end]
+
+    test io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} {
+
+	set f [makeFile {... dummy ...} cutsplice]
+	set c [open $f r]
+
+	set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]]
+	close $c
+	removeFile cutsplice
+
+	set res
+    } [lrange $expected 0 end]
+}
+
+# ### ### ### ######### ######### #########
+
 # cleanup
 foreach file [list fooBar longfile script output test1 pipe my_script foo \
 	bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index fd09bc7..2c95b13 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
 #		    fblocked, fconfigure, open, channel, fcopy
 #
@@ -12,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: ioCmd.test,v 1.23 2005/05/10 18:35:22 kennykb Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.24 2005/08/24 17:56:24 andreas_kupries Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -572,6 +573,3081 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
 close $rfile
 close $wfile
 
+# ### ### ### ######### ######### #########
+## Testing the reflected channel.
+
+test iocmd-20.0 {chan, wrong#args} {
+    catch {chan} msg
+    set msg
+} {wrong # args: should be "chan subcommand ?argument ...?"}
+
+test iocmd-20.1 {chan, unknown method} {
+    catch {chan foo} msg
+    set msg
+} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate}
+
+# --- --- --- --------- --------- ---------
+# chan create, and method "initalize"
+
+test iocmd-21.0 {chan create, wrong#args, not enough} {
+    catch {chan create} msg
+    set msg
+} {wrong # args: should be "chan create mode cmdprefix"}
+
+test iocmd-21.1 {chan create, wrong#args, too many} {
+    catch {chan create a b c} msg
+    set msg
+} {wrong # args: should be "chan create mode cmdprefix"}
+
+test iocmd-21.2 {chan create, invalid r/w mode, empty} {
+    proc foo {} {}
+    catch {chan create {} foo} msg
+    rename foo {}
+    set msg
+} {bad mode list: is empty}
+
+test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
+    proc foo {} {}
+    catch {chan create {c} foo} msg
+    rename foo {}
+    set msg
+} {bad mode "c": must be read or write}
+
+test iocmd-21.4 {chan create, bad handler, not a list} {
+    catch {chan create {r w} "foo \{"} msg
+    set msg
+} {unmatched open brace in list}
+
+test iocmd-21.5 {chan create, bad handler, not a command} {
+    catch {chan create {r w} foo} msg
+    set msg
+} {Initialize failure: invalid command name "foo"}
+
+test iocmd-21.6 {chan create, initialize failed, bad signature} {
+    proc foo {} {}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: wrong # args: should be "foo"}
+
+test iocmd-21.7 {chan create, initialize failed, bad signature} {
+    proc foo {} {}
+    catch {chan create {r w} ::foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: wrong # args: should be "::foo"}
+
+test iocmd-21.8 {chan create, initialize failed, bad result, not a list} {
+    proc foo {args} {return "\{"}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: unmatched open brace in list}
+
+test iocmd-21.9 {chan create, initialize failed, bad result, not a list} {
+    proc foo {args} {return \{\{\}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: unmatched open brace in list}
+
+test iocmd-21.10 {chan create, initialize failed, bad result, empty list} {
+    proc foo {args} {}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: Not all required methods supported}
+
+test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} {
+    proc foo {args} {return 1}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: bad method "1": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write}
+
+test iocmd-21.12 {chan create, initialize failed, bad result, ambiguous method name} {
+    proc foo {args} {return {a b c}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: ambiguous method "c": must be blocking, cget, cgetall, configure, finalize, initialize, read, seek, watch, or write}
+
+test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} {
+    proc foo {args} {return {initialize finalize}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: Not all required methods supported}
+
+test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} {
+    proc foo {args} {return {initialize finalize watch read}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: Writing not supported, but requested}
+
+test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} {
+    proc foo {args} {return {initialize finalize watch write}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: Reading not supported, but requested}
+
+test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} {
+    proc foo {args} {return {initialize finalize watch cget write read}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: 'cgetall' not supported, but should be, as 'cget' is}
+
+test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} {
+    proc foo {args} {return {initialize finalize watch cgetall read write}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {Initialize failure: 'cget' not supported, but should be, as 'cgetall' is}
+
+test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body {
+    proc foo {args} {
+	global  res
+	lappend res $args
+	if {[lindex $args 0] ne "initialize"} {return}
+	return {initialize finalize watch read write}
+    }
+    set res {}
+    lappend res [file channel rc*]
+    lappend res [chan create {r w} foo]
+    lappend res [close [lindex $res end]]
+    lappend res [file channel rc*]
+    rename foo {}
+    set res
+} -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}}
+
+test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body {
+    proc foo {args} {
+	global  res
+	lappend res $args
+	return {}
+    }
+    set res {}
+    lappend res [file channel rc*]
+    lappend res [catch {chan create {r w} foo} msg]
+    lappend res $msg
+    lappend res [file channel rc*]
+    rename foo {}
+    set res
+} -result {{} {initialize rc* {read write}} 1 {Initialize failure: Not all required methods supported} {}}
+
+# --- --- --- --------- --------- ---------
+# Helper commands to record the arguments to handler methods.
+
+proc note  {item}  {global res ; lappend res $item ; return}
+proc track {}      {upvar args item ; note $item; return}
+proc notes {items} {foreach i $items {note $i}}
+
+# Helper command, canned result for 'initialize' method.
+# Gets the optional methods as arguments. Use return features
+# to post the result higher up.
+
+proc init {args} {
+    lappend args initialize finalize watch read write
+    return -code return $args
+}
+
+proc oninit {args} {
+    upvar args hargs
+    if {[lindex $hargs 0] ne "initialize"} {return}
+    lappend args initialize finalize watch read write
+    return -code return $args
+}
+
+proc onfinal {} {
+    upvar args hargs
+    if {[lindex $hargs 0] ne "finalize"} {return}
+    return -code return ""
+}
+
+# --- --- --- --------- --------- ---------
+# method finalize
+
+test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit; return}
+    note [set c [chan create {r w} foo]]
+
+    rename foo {}
+
+    note [file channels rc*]
+    note [catch {close $c} msg] ; note $msg
+    note [file channels rc*]
+
+    set res
+} -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}}
+
+test iocmd-22.2 {chan finalize, for close} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return {}}
+    note [set c [chan create {r w} foo]]
+
+    close $c
+
+    # Close deleted the channel.
+    note [file channels rc*]
+
+    # Channel destruction does not kill handler command!
+    note [info command foo]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
+
+test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code error 5}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg] ; note $msg
+    # Channel is gone despite error.
+    note [file channels rc*]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
+
+test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; error FOO}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg] ; note $msg
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
+
+test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return SOMETHING}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg]; note $msg
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
+
+test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 3}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg] ; note $msg
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}}
+
+test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 4}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg] ; note $msg
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}}
+
+test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg] ; note $msg
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG}
+
+test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -level 5 -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+
+    note [catch {close $c} msg opt] ; note $msg ; note $opt
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method read
+
+test iocmd-23.1 {chan read, regular data return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return snarf
+    }
+    set c [chan create {r w} foo]
+
+    note [read $c 10]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+
+test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return [string repeat snarf 1000]
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 {read delivered more than requested}}
+
+test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	note MUST_NOT_HAPPEN
+    }
+    set c [chan create {w} foo]
+
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {1 {channel "rc*" wasn't opened for reading}}
+
+test iocmd-23.4 {chan read, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!}
+
+test iocmd-23.5 {chan read, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!}
+
+test iocmd-23.6 {chan read, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!}
+
+test iocmd-23.7 {chan read, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!}
+
+test iocmd-23.8 {chan read, level is squashed} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}}
+
+# --- === *** ###########################
+# method write
+
+test iocmd-24.1 {chan write, regular write} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal ; track
+	set     written [string length [lindex $args 2]]
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+
+    puts -nonewline $c snarf ; flush $c
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 5}
+
+test iocmd-24.2 {chan write, partial write is ok} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	set     written [string length [lindex $args 2]]
+	if {$written > 10} {set written [expr {$written / 2}]}
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+
+    puts -nonewline $c snarfsnarfsnarf ; flush $c
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
+
+test iocmd-24.3 {chan write, failed write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note -1 ; return -1}
+
+    set c [chan create {r w} foo]
+    puts -nonewline $c snarfsnarfsnarf ; flush $c
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} -1}
+
+test iocmd-24.4 {chan write, non-writable channel} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {1 {channel "rc*" wasn't opened for writing}}
+
+test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return 10000}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 1 {write wrote more than requested}}
+
+test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return 0}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 1 {write wrote more than requested}}
+
+test iocmd-24.7 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+
+test iocmd-24.8 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; error BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+
+test iocmd-24.9 {chan write, failed write, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+
+test iocmd-24.10 {chan write, failed write, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+
+test iocmd-24.11 {chan write, failed write, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code 777 BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+
+test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return BANG}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+    note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}}
+
+test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -level 55 -code 777 BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt]
+    note $msg
+    note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}}
+
+# --- === *** ###########################
+# method cgetall
+
+test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+
+test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+
+test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "-bar foo -snarf x"
+    }
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
+
+test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "-bar"
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
+
+test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "\{"
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 {unmatched open brace in list}}
+
+test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!}
+
+test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!}
+
+test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!}
+
+test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!}
+
+test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -level 55 -code 777 BANG
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method configure
+
+test iocmd-26.1 {chan configure, set standard option} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN
+	return
+    }
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -translation lf]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{}}
+
+test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+
+test iocmd-26.3 {chan configure, set option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit configure ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -rc-foo bar]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} {}}
+
+test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+
+test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+
+test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code 444 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+
+test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -level 55 -code 444 BANG
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method cget
+
+test iocmd-27.1 {chan configure, get option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -rc-foo]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} foo}
+
+test iocmd-27.2 {chan configure, get option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+
+test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+
+test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+
+test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code 333 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+
+test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -level 77 -code 333 BANG
+    }
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+# --- === *** ###########################
+# method seek
+
+test iocmd-28.1 {chan tell, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [tell $c]
+    close $c
+
+    rename foo {}
+    set res
+} -result {-1}
+
+test iocmd-28.2 {chan tell, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!}
+
+test iocmd-28.3 {chan tell, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!}
+
+test iocmd-28.4 {chan tell, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!}
+
+test iocmd-28.5 {chan tell, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code 222 BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!}
+
+test iocmd-28.6 {chan tell, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -level 11 -code 222 BANG}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+test iocmd-28.7 {chan tell, regular return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return 88}
+    set c [chan create {r w} foo]
+
+    note [tell $c]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 88}
+
+test iocmd-28.8 {chan tell, negative return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -1}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {Tried to seek before origin}}
+
+test iocmd-28.9 {chan tell, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    note [catch {tell $c} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}}
+
+test iocmd-28.10 {chan seek, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {1 {error during seek on "rc*": invalid argument}}
+
+test iocmd-28.11 {chan seek, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!}
+
+test iocmd-28.12 {chan seek, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!}
+
+test iocmd-28.13 {chan seek, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!}
+
+test iocmd-28.14 {chan seek, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code 99 BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!}
+
+test iocmd-28.15 {chan seek, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -level 33 -code 99 BANG}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -45}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {Tried to seek before origin}}
+
+test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    note [catch {seek $c 0 start} msg] ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}}
+
+test iocmd-28.18 {chan seek, ok result} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return 23}
+    set c [chan create {r w} foo]
+
+    note [seek $c 0 current]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} {}}
+
+foreach {n code} {
+    0 start
+    1 current
+    2 end
+} {
+    test iocmd-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+	set res {}
+	proc foo {args} {oninit seek ; onfinal ; track ; return 0}
+
+	set c [chan create {r w} foo]
+	note [seek $c 0 $code]
+	close $c
+
+	rename foo {}
+	set res
+    } -result [list [list seek rc* 0 $code] {}]
+}
+
+# --- === *** ###########################
+# method blocking
+
+test iocmd-29.1 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -blocking]
+    close $c
+
+    rename foo {}
+    set res
+} -result {1}
+
+test iocmd-29.2 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -blocking 0]
+    note [fconfigure $c -blocking]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{} 0}
+
+test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -blocking]
+    close $c
+
+    rename foo {}
+    set res
+} -result {1}
+
+test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -blocking 0]
+    note [fconfigure $c -blocking]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} {} 0}
+
+test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fconfigure $c -blocking 1]
+    note [fconfigure $c -blocking]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 1} {} 1}
+
+test iocmd-29.6 {chan blocking, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; error BOOM!}
+
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+    # Catch the close. It changes blocking mode internally, and runs into the error result.
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!}
+
+test iocmd-29.7 {chan blocking, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!}
+
+test iocmd-29.8 {chan blocking, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!}
+
+test iocmd-29.9 {chan blocking, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code 44 BOOM!}
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!}
+
+test iocmd-29.10 {chan blocking, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -level 99 -code 44 BANG}
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt
+
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}}
+
+test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 0 {}}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd-30.1 {chan watch, read interest, some return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return IGNORED}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c readable {set tick $tick}]
+    close $c     ;# 2nd watch, interest zero.
+
+    rename foo {}
+    set res
+} -result {{watch rc* read} {} {watch rc* {}}}
+
+test iocmd-30.2 {chan watch, write interest, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!_IGNORED}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c writable {}]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {}} {}}
+
+test iocmd-30.3 {chan watch, accumulated interests} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c readable {set tick $tick}]
+    note [fileevent $c writable {}]
+    note [fileevent $c readable {}]
+    close $c
+
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}}
+
+test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c readable {set tick $tick}] ;# Script is changing,
+    note [fileevent $c readable {set tock $tock}] ;# interest does not.
+
+    close $c ;# 3rd and 4th watch, removing the event handlers.
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}}
+
+# --- === *** ###########################
+# chan postevent
+
+test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body {
+    set c [open [makeFile {} goo] r]
+
+    catch {chan postevent $c {r w}} msg
+
+    close $c
+    removeFile goo
+    set msg
+} -result {channel "file*" is not a reflected channel}
+
+test iocmd-31.2 {chan postevent, unwanted events} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    catch {chan postevent $c {r w}} msg ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{tried to post events channel "rc*" is not interested in}}
+
+test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    catch {chan postevent $c {}} msg ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{bad event list: is empty}}
+
+test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    catch {chan postevent $c goo} msg ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{bad event "goo": must be read or write}}
+
+test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    catch {chan postevent $c "\{"} msg ; note $msg
+    close $c
+
+    rename foo {}
+    set res
+} -result {{unmatched open brace in list}}
+
+test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c readable {note TOCK}]
+
+    set stop [after 10000 {note TIMEOUT}]
+    after  1000 {note [chan postevent $c r]}
+    vwait ::res
+    catch {after cancel $stop}
+    close $c
+
+    rename foo {}
+    set res
+} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
+
+test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    note [fileevent $c writable {note TOCK}]
+
+    set stop [after 10000 {note TIMEOUT}]
+    after  1000 {note [chan postevent $c w]}
+    vwait ::res
+    catch {after cancel $stop}
+    close $c
+
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
+
+# ### ### ### ######### ######### #########
+## Same tests as above, but exercising the code forwarding and
+## receiving driver operations to the originator thread.
+
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Testing the reflected channel (Thread forwarding).
+#
+## The id numbers refer to the original test without thread
+## forwarding, and gaps due to tests not applicable to forwarding are
+## left to keep this asociation.
+
+testConstraint testchannel [llength [info commands testchannel]]
+
+# Duplicate of code in "thread.test". Find a better way of doing this
+# without duplication. Maybe placement into a proc which transforms to
+# nop after the first call, and placement of its defintion in a
+# central location.
+
+testConstraint testthread [expr {[info commands testthread] != {}}]
+
+if {[testConstraint testthread]} {
+    testthread errorproc ThreadError
+
+    proc ThreadError {id info} {
+	global threadError
+	set threadError $info
+    }
+
+    proc ThreadNullError {id info} {
+	# ignore
+    }
+}
+
+# ### ### ### ######### ######### #########
+## Helper command. Runs a script in a separate thread and returns the
+## result. A channel is transfered into the thread as well, and list of
+## configuation variables
+
+proc inthread {chan script args} {
+
+    # Test thread.
+
+    set tid [testthread create]
+
+    # Init thread configuration.
+    # - Listed variables
+    # - Id of main thread
+    # - A number of helper commands
+
+    foreach v $args {
+	upvar 1 $v x
+	testthread send $tid [list set $v $x]
+    }
+    testthread send $tid [list set mid $tcltest::mainThread]
+    testthread send $tid {
+	proc note {item} {global notes ; lappend notes $item}
+	proc notes {} {global notes ; return $notes}
+    }
+    testthread send $tid [list proc s {} [list uplevel 1 $script]] ; # (*)
+
+    # Transfer channel (cut/splice aka detach/attach)
+
+    testchannel cut $chan
+    testthread send $tid [list testchannel splice $chan]
+
+    # Run test script, also run local event loop!
+    # The local event loop waits for the result to come back.
+    # It is also necessary for the execution of forwarded channel
+    # operations.
+
+    set ::tres ""
+    testthread send -async $tid {
+	after 500
+	catch {s} res ; # This runs the script, 's' was defined at (*)
+	testthread send -async $mid [list set ::tres $res]
+    }
+    vwait ::tres
+    # Remove test thread, and return the captured result.
+
+    tcltest::threadReap
+    return $::tres
+}
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return {}}
+    note [set c [chan create {r w} foo]]
+
+    note [inthread $c {
+	close $c
+	# Close the deleted the channel.
+	file channels rc*
+    } c]
+
+    # Channel destruction does not kill handler command!
+    note [info command foo]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
+
+test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code error 5}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg] ; note $msg
+	# Channel is gone despite error.
+	note [file channels rc*]
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
+
+test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; error FOO}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg] ; note $msg
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
+
+test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return SOMETHING}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
+
+test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 3}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg] ; note $msg
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 4}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg] ; note $msg
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 {}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg] ; note $msg
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track ; oninit ; return -level 5 -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+
+    notes [inthread $c {
+	note [catch {close $c} msg opt] ; note $msg ; note $opt
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method read
+
+test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return snarf
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [read $c 10]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+
+test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return [string repeat snarf 1000]
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {[read $c 2]} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}}
+
+test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	note MUST_NOT_HAPPEN
+    }
+    set c [chan create {w} foo]
+    notes [inthread $c {
+	note [catch {[read $c 2]} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}}
+
+test iocmd.tf-23.4 {chan read, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {read $c 2} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {read $c 2} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {read $c 2} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {read $c 2} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {read $c 2} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method write
+
+test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal ; track
+	set     written [string length [lindex $args 2]]
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+
+    inthread $c {
+	puts -nonewline $c snarf ; flush $c
+	close $c
+    } c
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{write rc* snarf} 5}
+
+test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit ; onfinal ; track
+	set     written [string length [lindex $args 2]]
+	if {$written > 10} {set written [expr {$written / 2}]}
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+
+    inthread $c {
+	puts -nonewline $c snarfsnarfsnarf ; flush $c
+	close $c
+    } c
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
+
+test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note -1 ; return -1}
+    set c [chan create {r w} foo]
+
+    inthread $c {
+	puts -nonewline $c snarfsnarfsnarf ; flush $c
+	close $c
+    } c
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1}
+
+test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}}
+
+test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ;  return 10000}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+
+test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return 0}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarf ; flush $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+
+test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; error BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code 777 BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return BANG}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -level 55 -code 777 BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf ; flush $c} msg opt]
+	note $msg
+	note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM! {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BOOM!}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method cgetall
+
+test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+
+test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall ; onfinal ; track ; return ""}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+
+test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "-bar foo -snarf x"
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
+
+test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "-bar"
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
+
+test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return "\{"
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
+
+test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!}
+
+test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -level 55 -code 777 BANG
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method configure
+
+test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track ; note MUST_NOT_HAPPEN
+	return
+    }
+
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -translation lf]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{}}
+
+test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+
+test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit configure ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -rc-foo bar]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}}
+
+test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -code 444 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure ; onfinal ; track
+	return -level 55 -code 444 BANG
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method cget
+
+test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall ; onfinal ; track ; return foo}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -rc-foo]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo}
+
+test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!}
+
+test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -code 333 BOOM!
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall ; onfinal ; track
+	return -level 77 -code 333 BANG
+    }
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method seek
+
+test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [tell $c]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {-1} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code 222 BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -level 11 -code 222 BANG}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return 88}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [tell $c]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 88} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -1}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {tell $c} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {1 {error during seek on "rc*": invalid argument}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code error BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -code 99 BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -level 33 -code 99 BANG}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg opt] ; note $msg ; note $opt
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return -45}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg] ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek ; onfinal ; track ; return 23}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [seek $c 0 current]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} {}} \
+    -constraints {testchannel testthread}
+
+foreach {n code} {
+    0 start
+    1 current
+    2 end
+} {
+    test iocmd.tf-28.19.$n "chan seek, base conversion, $code" -match glob -body {
+	set res {}
+	proc foo {args} {oninit seek ; onfinal ; track ; return 0}
+	set c [chan create {r w} foo]
+
+	notes [inthread $c {
+	    note [seek $c 0 $code]
+	    close $c
+	    notes
+	} c code]
+
+	rename foo {}
+	set res
+    } -result [list [list seek rc* 0 $code] {}] \
+	-constraints {testchannel testthread}
+}
+
+# --- === *** ###########################
+# method blocking
+
+test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {1} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -blocking 0]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{} 0} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; note MUST_NOT_HAPPEN ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {1} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -blocking 0]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} {} 0} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fconfigure $c -blocking 1]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 1} {} 1} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; error BOOM!}
+
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+	# Catch the close. It changes blocking mode internally, and runs into the error result.
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code break BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -code 44 BOOM!}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return -level 99 -code 44 BANG}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg opt] ; note $msg ; note $opt
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BANG {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo BANG}} \
+    -constraints {testchannel testthread}
+
+test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking ; onfinal ; track ; return BOGUS}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg] ; note $msg
+	catch {close $c}
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 0 {}} \
+    -constraints {testchannel testthread}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return IGNORED}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fileevent $c readable {set tick $tick}]
+	close $c     ;# 2nd watch, interest zero.
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}}
+
+test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return -code error BOOM!_IGNORED}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c writable {}]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}}
+
+test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c readable {set tick $tick}]
+	note [fileevent $c writable {}]
+	note [fileevent $c readable {}]
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}}
+
+test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c readable {set tick $tick}] ;# Script is changing,
+	note [fileevent $c readable {set tock $tock}] ;# interest does not.
+	close $c ;# 3rd and 4th watch, removing the event handlers.
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
+
+# --- === *** ###########################
+# postevent
+# Not possible from a thread not containing the command handler.
+# Check that this is rejected.
+
+test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
+    set res {}
+    proc foo {args} {oninit ; onfinal ; track ; return}
+    set c [chan create {r w} foo]
+
+    notes [inthread $c {
+	catch {chan postevent $c r} msg ; note $msg
+	close $c
+	notes
+    } c]
+
+    rename foo {}
+    set res
+} -constraints {testchannel testthread} \
+    -result {{postevent for channel "rc*" called from outside interpreter}}
+
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+rename track {}
 # cleanup
 foreach file [list test1 test2 test3 test4] {
     removeFile $file
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 0875f19..a66fb08 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.172 2005/07/21 21:23:03 kennykb Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.173 2005/08/24 17:56:24 andreas_kupries Exp $
 
 VERSION 		= @TCL_VERSION@
 MAJOR_VERSION		= @TCL_MAJOR_VERSION@
@@ -302,7 +302,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclEncoding.o \
 	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
 	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
-	tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
+	tclIORChan.o tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
 	tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
 	tclObj.o tclPanic.o tclParse.o tclParseExpr.o tclPathObj.o tclPipe.o \
 	tclPkg.o tclPkgConfig.o tclPosixStr.o \
@@ -388,6 +388,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclIOGT.c \
 	$(GENERIC_DIR)/tclIOSock.c \
 	$(GENERIC_DIR)/tclIOUtil.c \
+	$(GENERIC_DIR)/tclIORChan.c \
 	$(GENERIC_DIR)/tclLink.c \
 	$(GENERIC_DIR)/tclListObj.c \
 	$(GENERIC_DIR)/tclLiteral.c \
@@ -1009,6 +1010,9 @@ tclIOSock.o: $(GENERIC_DIR)/tclIOSock.c
 tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c
 
+tclIORChan.o: $(GENERIC_DIR)/tclIORChan.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORChan.c
+
 tclLink.o: $(GENERIC_DIR)/tclLink.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c
 
diff --git a/win/Makefile.in b/win/Makefile.in
index c2beb4b..7a0e7ce 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
 # "autoconf" program (constructs like "@foo@" will get replaced in the
 # actual Makefile.
 #
-# RCS: @(#) $Id: Makefile.in,v 1.90 2005/08/11 22:06:47 kennykb Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.91 2005/08/24 17:56:24 andreas_kupries Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -242,6 +242,7 @@ GENERIC_OBJS = \
 	tclIO.$(OBJEXT) \
 	tclIOCmd.$(OBJEXT) \
 	tclIOGT.$(OBJEXT) \
+	tclIORChan.$(OBJEXT) \
 	tclIOSock.$(OBJEXT) \
 	tclIOUtil.$(OBJEXT) \
 	tclLink.$(OBJEXT) \
diff --git a/win/makefile.vc b/win/makefile.vc
index 84a6867..3ced0df 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -12,7 +12,7 @@
 # Copyright (c) 2001-2004 David Gravereaux.
 #
 #------------------------------------------------------------------------------
-# RCS: @(#) $Id: makefile.vc,v 1.138 2005/08/05 18:15:27 kennykb Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.139 2005/08/24 17:56:24 andreas_kupries Exp $
 #------------------------------------------------------------------------------
 
 # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR)
@@ -284,6 +284,7 @@ TCLOBJS = \
 	$(TMP_DIR)\tclIOGT.obj \
 	$(TMP_DIR)\tclIOSock.obj \
 	$(TMP_DIR)\tclIOUtil.obj \
+	$(TMP_DIR)\tclIORChan.obj \
 	$(TMP_DIR)\tclLink.obj \
 	$(TMP_DIR)\tclListObj.obj \
 	$(TMP_DIR)\tclLiteral.obj \