TIP#287 IMPLEMENTATION

        * doc/chan.n:           New subcommand [chan pending].
        * generic/tclBasic.c:   Thanks to Michael Cleverly for proposal
        * generic/tclInt.h:     and implementation.
        * generic/tclIOCmd.c:
        * library/init.tcl:
        * tests/chan.test:
        * tests/ioCmd.test:

3 files changed, 78 insertions, 3 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5df0a81..a3fb387 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.222 2006/11/29 15:01:26 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.223 2006/12/01 15:55:44 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -574,6 +574,10 @@ Tcl_CreateInterp(void)
     Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
 	    TclChanPostEventObjCmd, (ClientData) NULL, NULL);
 
+    /* TIP #287 */
+    Tcl_CreateObjCommand(interp, "::tcl::chan::Pending",
+	    TclChanPendingObjCmd, (ClientData) NULL, NULL);
+
     /*
      * Register the built-in functions. This is empty now that they are
      * implemented as commands in the ::tcl::mathfunc namespace.
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 4b5974b..c2c1bb8 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.34 2006/07/20 06:17:39 das Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.35 2006/12/01 15:55:44 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1619,6 +1619,74 @@ Tcl_FcopyObjCmd(
 }
 
 /*
+ *---------------------------------------------------------------------------
+ *
+ * TclChanPendingObjCmd --
+ *
+ *	This function is invoked to process the Tcl "chan pending" 
+ *	command (TIP #287). See the user documentation for details on 
+ *	what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp's result to the number of bytes of buffered input or
+ *	output (depending on whether the first argument is "input" or
+ *	"output"), or -1 if the channel wasn't opened for that mode.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+TclChanPendingObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+    int index, mode;
+    char *arg;
+    static CONST char *options[] = {"input", "output", (char *) NULL};
+    enum options {PENDING_INPUT, PENDING_OUTPUT};
+
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0, 
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    arg = Tcl_GetString(objv[2]);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == NULL) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum options) index) {
+    case PENDING_INPUT:
+	if ((mode & TCL_READABLE) == 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
+	}
+	return TCL_OK;
+    case PENDING_OUTPUT:
+	if ((mode & TCL_WRITABLE) == 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+	} else {
+	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
+	}
+	return TCL_OK;
+    }
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_ChanTruncateObjCmd --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0fb2ebf..e28e849 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.299 2006/11/28 22:20:29 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.300 2006/12/01 15:55:45 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -2465,6 +2465,9 @@ MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
 MODULE_SCOPE int	Tcl_CdObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclChanPendingObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]); /* TIP 287 */
 MODULE_SCOPE int	TclChanTruncateObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);