diff options
Diffstat (limited to 'generic/tclIO.c')
| -rw-r--r-- | generic/tclIO.c | 127 |
1 files changed, 126 insertions, 1 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index 12905de..3815c66 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.154 2008/12/11 17:30:18 andreas_kupries Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.155 2008/12/18 01:14:16 ferrieux Exp $ */ #include "tclInt.h" @@ -3074,6 +3074,131 @@ Tcl_Close( /* *---------------------------------------------------------------------- * + * Tcl_CloseEx -- + * + * Half closes a channel. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Closes one direction of the channel. + * + * NOTE: + * Tcl_CloseEx closes the specified direction of the channel as far as + * the user is concerned. The channel keeps existing however. You cannot + * calls this function to close the last possible direction of the + * channel. Use Tcl_Close for that. + * + *---------------------------------------------------------------------- + */ + + /* ARGSUSED */ +int +Tcl_CloseEx( + Tcl_Interp *interp, /* Interpreter for errors. */ + Tcl_Channel chan, /* The channel being closed. May still be used by some interpreter */ + int flags) /* Flags telling us which side to close. */ +{ + Channel *chanPtr; /* The real IO channel. */ + ChannelState *statePtr; /* State of real IO channel. */ + int result; /* Of calling FlushChannel. */ + + if (chan == NULL) { + return TCL_OK; + } + + /* TODO: assert flags validity ? */ + + chanPtr = (Channel *) chan; + statePtr = chanPtr->state; + + /* + * Does the channel support half-close anyway ? Error if not. + */ + + if (!chanPtr->typePtr->close2Proc) { + Tcl_AppendResult (interp, "Half-close of channels not supported by ", + chanPtr->typePtr->typeName, "s", NULL); + return TCL_ERROR; + } + + /* + * Is the channel unstacked ? If not we fail. + */ + + if (chanPtr != statePtr->topChanPtr) { + Tcl_AppendResult (interp, + "Half-close not applicable to stack of transformations", + NULL); + return TCL_ERROR; + } + + /* + * Check direction against channel mode. It is an error if we try to close + * a direction not supported by the channel (already closed, or never + * opened for that direction). + */ + + if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) { + const char *msg; + if (flags & TCL_CLOSE_READ) { + msg = "read"; + } else { + msg = "write"; + } + Tcl_AppendResult (interp, "Half-close of ", msg, + "-side not possible, side not opened or already closed", + NULL); + return TCL_ERROR; + } + + /* + * A user may try to call half-close from within a channel close + * handler. That won't do. + */ + + if (statePtr->flags & CHANNEL_INCLOSE) { + if (interp) { + Tcl_AppendResult(interp, "Illegal recursive call to close " + "through close-handler of channel", NULL); + } + return TCL_ERROR; + } + + /* + * Finally do what is asked of us. + */ + + result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, + flags); + + /* + * 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)) { + result = EINVAL; + } + + if (result != 0) { + return TCL_ERROR; + } + + /* + * Remove the closed side from the channel mode/flags. + */ + + statePtr->flags &= ~(flags & (TCL_READABLE | TCL_WRITABLE)); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_ClearChannelHandlers -- * * Removes all channel handlers and event scripts from the channel, |