TIP#183 IMPLEMENTATION [Patch 577093]

        * generic/tclIOUtil.c (TclGetOpenModeEx):       New routine.
        * generic/tclInt.h:

        * generic/tclIO.c (Tcl_OpenObjCmd):     Support for "b" and
        * doc/open.n:           "BINARY" in "access" argument to [open].
        * tests/ioCmd.test:

3 files changed, 91 insertions, 27 deletions

diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 732b162..fc14619 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.22 2004/10/07 00:24:49 dgp Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.23 2005/04/27 18:48:25 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -960,14 +960,14 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
     if (!pipeline) {
         chan = Tcl_FSOpenFileChannel(interp, objv[1], modeString, prot);
     } else {
-	int mode, seekFlag, cmdObjc;
+	int mode, seekFlag, cmdObjc, binary;
 	CONST char **cmdArgv;
 
         if (Tcl_SplitList(interp, what+1, &cmdObjc, &cmdArgv) != TCL_OK) {
             return TCL_ERROR;
         }
 
-        mode = TclGetOpenMode(interp, modeString, &seekFlag);
+        mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
         if (mode == -1) {
 	    chan = NULL;
         } else {
@@ -987,6 +987,9 @@ Tcl_OpenObjCmd(notUsed, interp, objc, objv)
 		    break;
 	    }
 	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
+	    if (binary) {
+		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
+	    }
 	}
         ckfree((char *) cmdArgv);
     }
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 6fc27f0..17d6efa 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.116 2005/04/16 08:04:56 vasiljevic Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.117 2005/04/27 18:48:25 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1412,9 +1412,43 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
  * TclGetOpenMode --
  *
  * Description:
+ * 	This routine is an obsolete, limited version of
+ * 	TclGetOpenModeEx() below.  It exists only to satisfy any
+ * 	extensions imprudently using it via Tcl's internal stubs table.
+ *
+ * Results:
+ * 	Same as TclGetOpenModeEx().
+ *
+ * Side effects:
+ * 	Same as TclGetOpenModeEx().
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclGetOpenMode(interp, modeString, seekFlagPtr)
+    Tcl_Interp *interp;			/* Interpreter to use for error
+					 * reporting - may be NULL. */
+    CONST char *modeString;		/* Mode string, e.g. "r+" or
+					 * "RDONLY CREAT". */
+    int *seekFlagPtr;			/* Set this to 1 if the caller
+                                         * should seek to EOF during the
+                                         * opening of the file. */
+{
+    int binary = 0;
+    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclGetOpenModeEx --
+ *
+ * Description:
  *	Computes a POSIX mode mask for opening a file, from a given string,
- *	and also sets a flag to indicate whether the caller should seek to
- *	EOF after opening the file.
+ *	and also sets flags to indicate whether the caller should seek to
+ *	EOF after opening the file, and whether the caller should
+ *	configure the channel for binary data.
  *
  * Results:
  *	On success, returns mode to pass to "open". If an error occurs, the
@@ -1423,7 +1457,9 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
  *
  * Side effects:
  *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller
- *	to seek to EOF after opening the file.
+ *	to seek to EOF after opening the file, or to 0 otherwise.  Sets the
+ *	integer referenced by binaryPtr to 1 to tell the caller	to seek to
+ *	configure the channel for binary data, or to 0 otherwise.
  *
  * Special note:
  *	This code is based on a prototype implementation contributed
@@ -1431,16 +1467,18 @@ TclFSNormalizeToUniquePath(interp, pathPtr, startAt, clientDataPtr)
  *
  *---------------------------------------------------------------------------
  */
-
 int
-TclGetOpenMode(interp, string, seekFlagPtr)
+TclGetOpenModeEx(interp, modeString, seekFlagPtr, binaryPtr)
     Tcl_Interp *interp;			/* Interpreter to use for error
 					 * reporting - may be NULL. */
-    CONST char *string;			/* Mode string, e.g. "r+" or
+    CONST char *modeString;		/* Mode string, e.g. "r+" or
 					 * "RDONLY CREAT". */
     int *seekFlagPtr;			/* Set this to 1 if the caller
                                          * should seek to EOF during the
                                          * opening of the file. */
+    int *binaryPtr;			/* Set this to 1 if the caller
+					 * should configure the opened
+					 * channel for binary operations */
 {
     int mode, modeArgc, c, i, gotRW;
     CONST char **modeArgv, *flag;
@@ -1453,6 +1491,7 @@ TclGetOpenMode(interp, string, seekFlagPtr)
      */
 
     *seekFlagPtr = 0;
+    *binaryPtr = 0;
     mode = 0;
 
     /*
@@ -1460,9 +1499,9 @@ TclGetOpenMode(interp, string, seekFlagPtr)
      * routines.
      */
 
-    if (!(string[0] & 0x80)
-	    && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
-	switch (string[0]) {
+    if (!(modeString[0] & 0x80)
+	    && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
+	switch (modeString[0]) {
 	    case 'r':
 		mode = O_RDONLY;
 		break;
@@ -1475,20 +1514,33 @@ TclGetOpenMode(interp, string, seekFlagPtr)
 		break;
 	    default:
 		error:
+                *seekFlagPtr = 0;
+		*binaryPtr = 0;
                 if (interp != (Tcl_Interp *) NULL) {
                     Tcl_AppendResult(interp,
-                            "illegal access mode \"", string, "\"",
+                            "illegal access mode \"", modeString, "\"",
                             (char *) NULL);
                 }
 		return -1;
 	}
-	if (string[1] == '+') {
-	    mode &= ~(O_RDONLY|O_WRONLY);
-	    mode |= O_RDWR;
-	    if (string[2] != 0) {
+	i=1;
+	while (i<3 && modeString[i]) {
+	    if (modeString[i] == modeString[i-1]) {
 		goto error;
 	    }
-	} else if (string[1] != 0) {
+	    switch (modeString[i++]) {
+		case '+':
+		    mode &= ~(O_RDONLY|O_WRONLY);
+		    mode |= O_RDWR;
+		    break;
+		case 'b':
+		    *binaryPtr = 1;
+		    break;
+		default:
+		    goto error;
+	    }
+	}
+	if (modeString[i] != 0) {
 	    goto error;
 	}
         return mode;
@@ -1502,11 +1554,11 @@ TclGetOpenMode(interp, string, seekFlagPtr)
      * a NULL interpreter is passed in.
      */
 
-    if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
+    if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
         if (interp != (Tcl_Interp *) NULL) {
             Tcl_AddErrorInfo(interp,
                     "\n    while processing open access modes \"");
-            Tcl_AddErrorInfo(interp, string);
+            Tcl_AddErrorInfo(interp, modeString);
             Tcl_AddErrorInfo(interp, "\"");
         }
         return -1;
@@ -1560,11 +1612,14 @@ TclGetOpenMode(interp, string, seekFlagPtr)
 #endif
 	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
 	    mode |= O_TRUNC;
+	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
+	    *binaryPtr = 1;
 	} else {
             if (interp != (Tcl_Interp *) NULL) {
                 Tcl_AppendResult(interp, "invalid access mode \"", flag,
-                        "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
-                        " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
+			"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
+			"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC",
+			(char *) NULL);
             }
 	    ckfree((char *) modeArgv);
 	    return -1;
@@ -2086,8 +2141,8 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
     if (fsPtr != NULL) {
 	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
 	if (proc != NULL) {
-	    int mode, seekFlag;
-	    mode = TclGetOpenMode(interp, modeString, &seekFlag);
+	    int mode, seekFlag, binary;
+	    mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
 	    if (mode == -1) {
 	        return NULL;
 	    }
@@ -2106,6 +2161,10 @@ Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions)
 			return NULL;
 		    }
 		}
+		if (binary) {
+		    Tcl_SetChannelOption(interp, retVal,
+			    "-translation", "binary");
+		}
 	    }
 	    return retVal;
 	}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 727b879..e0779ef 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.225 2005/04/22 15:46:57 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.226 2005/04/27 18:48:25 dgp Exp $
  */
 
 #ifndef _TCLINT
@@ -1889,7 +1889,9 @@ MODULE_SCOPE int	TclGetEncodingFromObj _ANSI_ARGS_((Tcl_Interp *interp,
 MODULE_SCOPE int        TclGetNamespaceFromObj _ANSI_ARGS_((
 			    Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    Tcl_Namespace **nsPtrPtr));
-
+MODULE_SCOPE int	TclGetOpenModeEx _ANSI_ARGS_((Tcl_Interp *interp,
+			    CONST char *modeString, int *seekFlagPtr,
+			    int *binaryPtr));
 MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue _ANSI_ARGS_ ((
 			    ProcessGlobalValue *pgvPtr));
 MODULE_SCOPE int	TclGlob _ANSI_ARGS_((Tcl_Interp *interp,