diff options
Diffstat (limited to 'generic/tclIOCmd.c')
| -rw-r--r-- | generic/tclIOCmd.c | 51 |
1 files changed, 50 insertions, 1 deletions
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 6549e98..b24b856 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.55 2008/07/13 23:15:22 nijtmans Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.56 2008/07/21 21:02:17 ferrieux Exp $ */ #include "tclInt.h" @@ -1799,6 +1799,54 @@ ChanTruncateObjCmd( return TCL_OK; } +/* + *---------------------------------------------------------------------- + * + * ChanPipeObjCmd -- + * + * This function is invoked to process the "chan pipe" Tcl command. + * See the user documentation for details on what it does. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Creates a pair of Tcl channels wrapping both ends of a new + * anonymous pipe. + * + *---------------------------------------------------------------------- + */ + +static int +ChanPipeObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Channel rchan,wchan; + const char *channelNames [2]; + Tcl_Obj *resultPtr; + + if (objc != 1) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + if (Tcl_CreatePipe (interp, &rchan, &wchan, 0) != TCL_OK) { + return TCL_ERROR; + } + + channelNames [0] = Tcl_GetChannelName (rchan); + channelNames [1] = Tcl_GetChannelName (wchan); + + resultPtr = Tcl_NewObj(); + Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[0],-1)); + Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[1],-1)); + Tcl_SetObjResult(interp, resultPtr); + + return TCL_OK; +} /* *---------------------------------------------------------------------- @@ -1844,6 +1892,7 @@ TclInitChanCmd( {"puts", Tcl_PutsObjCmd}, {"read", Tcl_ReadObjCmd}, {"seek", Tcl_SeekObjCmd}, + {"pipe", ChanPipeObjCmd}, /* TIP #304 */ {"tell", Tcl_TellObjCmd}, {"truncate", ChanTruncateObjCmd}, /* TIP #208 */ {NULL} |