Add "chan isbinary" for checking whether a _channel_ is binarycore-tip-699

1 files changed, 41 insertions, 0 deletions

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 0357471..a31b64f 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -837,6 +837,46 @@ Tcl_EofObjCmd(
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_Eof(chan)));
     return TCL_OK;
 }
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ChanIsBinaryCmd --
+ *
+ *	This function is invoked to process the Tcl "chan isbinary" command. See the
+ *	user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp's result to boolean true or false depending on whether the
+ *	specified channel is a binary channel.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ChanIsBinaryCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channel");
+	return TCL_ERROR;
+    }
+
+    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(TclChanIsBinary(chan)));
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2033,6 +2073,7 @@ TclInitChanCmd(
 	{"event",	Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
 	{"flush",	Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
 	{"gets",	Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
+	{"isbinary",ChanIsBinaryCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
 	{"names",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
 	{"pending",	ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #287 */
 	{"pipe",	ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},		/* TIP #304 */