summaryrefslogtreecommitdiffstats
path: root/generic/tclIOCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclIOCmd.c')
-rw-r--r--generic/tclIOCmd.c48
1 files changed, 45 insertions, 3 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index dbf6b2c..94bbb5c 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.60 2008/12/09 20:16:29 dgp Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.61 2008/12/18 01:14:16 ferrieux Exp $
*/
#include "tclInt.h"
@@ -648,8 +648,8 @@ Tcl_CloseObjCmd(
{
Tcl_Channel chan; /* The channel to close. */
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+ if ((objc != 2) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
return TCL_ERROR;
}
@@ -657,6 +657,48 @@ Tcl_CloseObjCmd(
return TCL_ERROR;
}
+ if (objc == 3) {
+ int optionIndex, dir;
+ static const char *const dirOptions[] = {
+ "read", "write", NULL
+ };
+ static int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};
+
+ /*
+ * Get direction requested to close, and check syntax.
+ */
+
+ if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
+ &optionIndex) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dir = dirArray[optionIndex];
+
+ /*
+ * 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 (!(dir & Tcl_GetChannelMode (chan))) {
+ Tcl_AppendResult (interp, "Half-close of ", dirOptions[optionIndex],
+ "-side not possible, side not opened or already closed",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Special handling is needed if and only if the channel mode supports
+ * more than the direction to close. Because if the close the last
+ * direction suppported we can and will go through the regular
+ * process.
+ */
+
+ if ((Tcl_GetChannelMode (chan) & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) {
+ return Tcl_CloseEx (interp, chan, dir) != TCL_OK;
+ }
+ }
+
if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
/*
* If there is an error message and it ends with a newline, remove the