Merge trunk

4 files changed, 815 insertions, 277 deletions

diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 80b8321..f6358d1 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -31,8 +31,10 @@ TCL_DECLARE_MUTEX(consoleMutex)
  * Bit masks used in the flags field of the ConsoleInfo structure below.
  */
 
-#define CONSOLE_PENDING	(1<<0)	/* Message is pending in the queue. */
-#define CONSOLE_ASYNC	(1<<1)	/* Channel is non-blocking. */
+#define CONSOLE_PENDING	 (1<<0)	/* Message is pending in the queue. */
+#define CONSOLE_ASYNC	 (1<<1)	/* Channel is non-blocking. */
+#define CONSOLE_READ_OPS (1<<4)	/* Channel supports read-related ops. */
+#define CONSOLE_RESET    (1<<5)	/* Console mode needs to be reset. */
 
 /*
  * Bit masks used in the sharedFlags field of the ConsoleInfo structure below.
@@ -102,6 +104,7 @@ typedef struct ConsoleInfo {
 				 * readable object. */
     int bytesRead;		/* Number of bytes in the buffer. */
     int offset;			/* Number of bytes read out of the buffer. */
+    DWORD initMode;		/* Initial console mode. */
     char buffer[CONSOLE_BUFFER_SIZE];
 				/* Data consumed by reader thread. */
 } ConsoleInfo;
@@ -144,12 +147,18 @@ static int		ConsoleEventProc(Tcl_Event *evPtr, int flags);
 static void		ConsoleExitHandler(ClientData clientData);
 static int		ConsoleGetHandleProc(ClientData instanceData,
 			    int direction, ClientData *handlePtr);
+static int		ConsoleGetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    Tcl_DString *dsPtr);
 static void		ConsoleInit(void);
 static int		ConsoleInputProc(ClientData instanceData, char *buf,
 			    int toRead, int *errorCode);
 static int		ConsoleOutputProc(ClientData instanceData,
 			    const char *buf, int toWrite, int *errorCode);
 static DWORD WINAPI	ConsoleReaderThread(LPVOID arg);
+static int		ConsoleSetOptionProc(ClientData instanceData,
+			    Tcl_Interp *interp, const char *optionName,
+			    const char *value);
 static void		ConsoleSetupProc(ClientData clientData, int flags);
 static void		ConsoleWatchProc(ClientData instanceData, int mask);
 static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
@@ -175,8 +184,8 @@ static const Tcl_ChannelType consoleChannelType = {
     ConsoleInputProc,		/* Input proc. */
     ConsoleOutputProc,		/* Output proc. */
     NULL,			/* Seek proc. */
-    NULL,			/* Set option proc. */
-    NULL,			/* Get option proc. */
+    ConsoleSetOptionProc,	/* Set option proc. */
+    ConsoleGetOptionProc,	/* Get option proc. */
     ConsoleWatchProc,		/* Set up notifier to watch the channel. */
     ConsoleGetHandleProc,	/* Get an OS handle from channel. */
     NULL,			/* close2proc. */
@@ -569,6 +578,17 @@ ConsoleCloseProc(
     consolePtr->validMask &= ~TCL_WRITABLE;
 
     /*
+     * If the user has been tinkering with the mode, reset it now. We ignore
+     * any errors from this; we're quite possibly about to close or exit
+     * anyway.
+     */
+
+    if ((consolePtr->flags & CONSOLE_READ_OPS) &&
+	    (consolePtr->flags & CONSOLE_RESET)) {
+	SetConsoleMode(consolePtr->handle, consolePtr->initMode);
+    }
+
+    /*
      * Don't close the Win32 handle if the handle is a standard channel during
      * the thread exit process. Otherwise, one thread may kill the stdio of
      * another.
@@ -590,7 +610,7 @@ ConsoleCloseProc(
      * Remove the file from the list of watched files.
      */
 
-    for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
+    for (nextPtrPtr = &tsdPtr->firstConsolePtr, infoPtr = *nextPtrPtr;
 	    infoPtr != NULL;
 	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
 	if (infoPtr == (ConsoleInfo *) consolePtr) {
@@ -1332,7 +1352,9 @@ TclWinOpenConsoleChannel(
 	 * we only want to catch when complete lines are ready for reading.
 	 */
 
-	GetConsoleMode(infoPtr->handle, &modes);
+	infoPtr->flags |= CONSOLE_READ_OPS;
+	GetConsoleMode(infoPtr->handle, &infoPtr->initMode);
+	modes = infoPtr->initMode;
 	modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
 	modes |= ENABLE_LINE_INPUT;
 	SetConsoleMode(infoPtr->handle, modes);
@@ -1415,6 +1437,213 @@ ConsoleThreadActionProc(
 }
 
 /*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleSetOptionProc --
+ *
+ *	Sets an option on a channel.
+ *
+ * Results:
+ *	A standard Tcl result. Also sets the interp's result on error if
+ *	interp is not NULL.
+ *
+ * Side effects:
+ *	May modify an option on a console. Sets Error message if needed (by
+ *	calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleSetOptionProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Which option to set? */
+    const char *value)		/* New value for option. */
+{
+    ConsoleInfo *infoPtr = instanceData;
+    int len = strlen(optionName);
+    int vlen = strlen(value);
+
+    /*
+     * Option -inputmode normal|password|raw
+     */
+
+    if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) &&
+	    (strncmp(optionName, "-inputmode", len) == 0)) {
+	DWORD mode;
+
+	if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't read console mode: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) {
+	    mode |= ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT;
+	} else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) {
+	    mode |= ENABLE_LINE_INPUT;
+	    mode &= ~ENABLE_ECHO_INPUT;
+	} else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) {
+	    mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT);
+	} else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) {
+	    /*
+	     * Reset to the initial mode, whatever that is.
+	     */
+
+	    mode = infoPtr->initMode;
+	} else {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad mode \"%s\" for -inputmode: must be"
+			" normal, password, raw, or reset", value));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+	if (SetConsoleMode(infoPtr->handle, mode) == 0) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't set console mode: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * If we've changed the mode from default, schedule a reset later.
+	 */
+
+	if (mode == infoPtr->initMode) {
+	    infoPtr->flags &= ~CONSOLE_RESET;
+	} else {
+	    infoPtr->flags |= CONSOLE_RESET;
+	}
+	return TCL_OK;
+    }
+
+    if (infoPtr->flags & CONSOLE_READ_OPS) {
+	return Tcl_BadChannelOption(interp, optionName, "inputmode");
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "");
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleGetOptionProc --
+ *
+ *	Gets a mode associated with an IO channel. If the optionName arg is
+ *	non-NULL, retrieves the value of that option. If the optionName arg is
+ *	NULL, retrieves a list of alternating option names and values for the
+ *	given channel.
+ *
+ * Results:
+ *	A standard Tcl result. Also sets the supplied DString to the string
+ *	value of the option(s) returned.  Sets error message if needed
+ *	(by calling Tcl_BadChannelOption).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleGetOptionProc(
+    ClientData instanceData,	/* File state. */
+    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
+    const char *optionName,	/* Option to get. */
+    Tcl_DString *dsPtr)		/* Where to store value(s). */
+{
+    ConsoleInfo *infoPtr = instanceData;
+    int valid = 0;		/* Flag if valid option parsed. */
+    unsigned int len;
+    char buf[TCL_INTEGER_SPACE];
+
+    if (optionName == NULL) {
+	len = 0;
+    } else {
+	len = strlen(optionName);
+    }
+
+    /*
+     * Get option -inputmode
+     *
+     * This is a great simplification of the underlying reality, but actually
+     * represents what almost all scripts really want to know.
+     */
+
+    if (infoPtr->flags & CONSOLE_READ_OPS) {
+	if (len == 0) {
+	    Tcl_DStringAppendElement(dsPtr, "-inputmode");
+	}
+	if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) {
+	    DWORD mode;
+
+	    valid = 1;
+	    if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
+		TclWinConvertError(GetLastError());
+		if (interp != NULL) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "couldn't read console mode: %s",
+			    Tcl_PosixError(interp)));
+		}
+		return TCL_ERROR;
+	    }
+	    if (mode & ENABLE_LINE_INPUT) {
+		if (mode & ENABLE_ECHO_INPUT) {
+		    Tcl_DStringAppendElement(dsPtr, "normal");
+		} else {
+		    Tcl_DStringAppendElement(dsPtr, "password");
+		}
+	    } else {
+		Tcl_DStringAppendElement(dsPtr, "raw");
+	    }
+	}
+    }
+
+    /*
+     * Get option -winsize
+     * Option is readonly and returned by [fconfigure chan -winsize] but not
+     * returned by [fconfigure chan] without explicit option name.
+     */
+
+    if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) {
+	CONSOLE_SCREEN_BUFFER_INFO consoleInfo;
+
+	valid = 1;
+	if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) {
+	    TclWinConvertError(GetLastError());
+	    if (interp != NULL) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"couldn't read console size: %s",
+			Tcl_PosixError(interp)));
+	    }
+	    return TCL_ERROR;
+	}
+	sprintf(buf, "%d",
+		consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1);
+	Tcl_DStringAppendElement(dsPtr, buf);
+	sprintf(buf, "%d",
+		consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1);
+	Tcl_DStringAppendElement(dsPtr, buf);
+    }
+
+    if (valid) {
+	return TCL_OK;
+    }
+    if (infoPtr->flags & CONSOLE_READ_OPS) {
+	return Tcl_BadChannelOption(interp, optionName, "inputmode winsize");
+    } else {
+	return Tcl_BadChannelOption(interp, optionName, "");
+    }
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index bc5df72..92a300a 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -680,7 +680,8 @@ NativeReadReparse(
     HANDLE hFile;
     DWORD returnedLength;
 
-    hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL, OPEN_EXISTING,
+    hFile = CreateFile(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL,
+	    OPEN_EXISTING,
 	    FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
 
     if (hFile == INVALID_HANDLE_VALUE) {
@@ -832,7 +833,7 @@ tclWinDebugPanic(
 		MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
     }
 }
-
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -1430,11 +1431,16 @@ TclpGetUserHome(
     if (domain == NULL) {
 	const char *ptr;
 
-	/* no domain - firstly check it's the current user */
-	if ( (ptr = TclpGetUserName(&ds)) != NULL
-	  && strcasecmp(name, ptr) == 0
-	) {
-	    /* try safest and fastest way to get current user home */
+	/*
+	 * No domain. Firstly check it's the current user
+	 */
+
+	ptr = TclpGetUserName(&ds);
+	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
+	    /*
+	     * Try safest and fastest way to get current user home
+	     */
+
 	    ptr = TclGetEnv("HOME", &ds);
 	    if (ptr != NULL) {
 		Tcl_JoinPath(1, &ptr, bufferPtr);
@@ -1455,18 +1461,28 @@ TclpGetUserHome(
 	wName = TclUtfToWCharDString(name, nameLen, &ds);
 	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
 	    /*
-	     * user does not exists - if domain was not specified,
-	     * try again using current domain.
+	     * User does not exist; if domain was not specified, try again
+	     * using current domain.
 	     */
+
 	    rc = 1;
-	    if (domain != NULL) break;
-	    /* get current domain */
+	    if (domain != NULL) {
+		break;
+	    }
+
+	    /*
+	     * Get current domain
+	     */
+
 	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
-	    if (rc != 0) break;
+	    if (rc != 0) {
+		break;
+	    }
 	    domain = INT2PTR(-1); /* repeat once */
 	}
 	if (rc == 0) {
 	    DWORD i, size = MAX_PATH;
+
 	    wHomeDir = uiPtr->usri1_home_dir;
 	    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
 		size = lstrlenW(wHomeDir);
@@ -1476,15 +1492,22 @@ TclpGetUserHome(
 		 * User exists but has no home dir. Return
 		 * "{GetProfilesDirectory}/<user>".
 		 */
+
 		GetProfilesDirectoryW(buf, &size);
 		TclWCharToUtfDString(buf, size-1, bufferPtr);
 		Tcl_DStringAppend(bufferPtr, "/", 1);
 		Tcl_DStringAppend(bufferPtr, name, nameLen);
 	    }
 	    result = Tcl_DStringValue(bufferPtr);
-	    /* be sure we return normalized path */
-	    for (i = 0; i < size; ++i){
-		if (result[i] == '\\') result[i] = '/';
+
+	    /*
+	     * Be sure we return normalized path
+	     */
+
+	    for (i = 0; i < size; ++i) {
+		if (result[i] == '\\') {
+		    result[i] = '/';
+		}
 	    }
 	    NetApiBufferFree((void *) uiPtr);
 	}
@@ -1572,48 +1595,72 @@ NativeAccess(
     /*
      * If it's not a directory (assume file), do several fast checks:
      */
+
     if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
 	/*
 	 * If the attributes say this is not writable at all.  The file is a
 	 * regular file (i.e., not a directory), then the file is not
-	 * writable, full stop.	 For directories, the read-only bit is
+	 * writable, full stop.  For directories, the read-only bit is
 	 * (mostly) ignored by Windows, so we can't ascertain anything about
 	 * directory access from the attrib data.  However, if we have the
-	 * advanced 'getFileSecurityProc', then more robust ACL checks
-	 * will be done below.
+	 * advanced 'getFileSecurityProc', then more robust ACL checks will be
+	 * done below.
 	 */
+
 	if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
 	    Tcl_SetErrno(EACCES);
 	    return -1;
 	}
 
-	/* If doesn't have the correct extension, it can't be executable */
+	/*
+	 * If doesn't have the correct extension, it can't be executable
+	 */
+
 	if ((mode & X_OK) && !NativeIsExec(nativePath)) {
 	    Tcl_SetErrno(EACCES);
 	    return -1;
 	}
-	/* Special case for read/write/executable check on file */
+
+	/*
+	 * Special case for read/write/executable check on file
+	 */
+
 	if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
 	    DWORD mask = 0;
 	    HANDLE hFile;
-	    if (mode & R_OK) { mask |= GENERIC_READ;  }
-	    if (mode & W_OK) { mask |= GENERIC_WRITE; }
-	    if (mode & X_OK) { mask |= GENERIC_EXECUTE; }
+
+	    if (mode & R_OK) {
+		mask |= GENERIC_READ;
+	    }
+	    if (mode & W_OK) {
+		mask |= GENERIC_WRITE;
+	    }
+	    if (mode & X_OK) {
+		mask |= GENERIC_EXECUTE;
+	    }
 
 	    hFile = CreateFile(nativePath, mask,
-		FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
-		OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
+		    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+		    NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
 	    if (hFile != INVALID_HANDLE_VALUE) {
 		CloseHandle(hFile);
 		return 0;
 	    }
-	    /* fast exit if access was denied */
+
+	    /*
+	     * Fast exit if access was denied
+	     */
+
 	    if (GetLastError() == ERROR_ACCESS_DENIED) {
 		Tcl_SetErrno(EACCES);
 		return -1;
 	    }
 	}
-	/* We cannnot verify the access fast, check it below using security info. */
+
+	/*
+	 * We cannnot verify the access fast, check it below using security
+	 * info.
+	 */
     }
 
     /*
@@ -1988,13 +2035,12 @@ NativeStat(
      * 'getFileAttributesExProc', and if that isn't available, then on even
      * simpler routines.
      *
-     * Special consideration must be given to Windows hardcoded names
-     * like CON, NULL, COM1, LPT1 etc. For these, we still need to
-     * do the CreateFile as some may not exist (e.g. there is no CON
-     * in wish by default). However the subsequent GetFileInformationByHandle
-     * will fail. We do a WinIsReserved to see if it is one of the special
-     * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
-     * structure.
+     * Special consideration must be given to Windows hardcoded names like
+     * CON, NULL, COM1, LPT1 etc. For these, we still need to do the
+     * CreateFile as some may not exist (e.g. there is no CON in wish by
+     * default). However the subsequent GetFileInformationByHandle will
+     * fail. We do a WinIsReserved to see if it is one of the special names,
+     * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure.
      */
 
     fileHandle = CreateFile(nativePath, GENERIC_READ,
@@ -2012,7 +2058,11 @@ NativeStat(
                 Tcl_SetErrno(ENOENT);
                 return -1;
             }
-            /* Mock up the expected structure */
+
+            /*
+	     * Mock up the expected structure
+	     */
+
             memset(&data, 0, sizeof(data));
             statPtr->st_atime = 0;
             statPtr->st_mtime = 0;
@@ -2295,7 +2345,7 @@ TclpGetNativeCwd(
     }
 
     if (clientData != NULL) {
-	if (wcscmp((const WCHAR*)clientData, buffer) == 0) {
+	if (wcscmp((const WCHAR *) clientData, buffer) == 0) {
 	    return clientData;
 	}
     }
@@ -2523,10 +2573,12 @@ TclpObjNormalizePath(
 				(int)(sizeof(WCHAR) * len));
 			lastValidPathEnd = currentPathEndPosition;
 		    } else if (nextCheckpoint == 0) {
-			/* Path starts with a drive designation
-			 * that's not actually on the system.
-			 * We still must normalize up past the
-			 * first separator.  [Bug 3603434] */
+			/*
+			 * Path starts with a drive designation that's not
+			 * actually on the system. We still must normalize up
+			 * past the first separator. [Bug 3603434]
+			 */
+
 			currentPathEndPosition++;
 		    }
 		}
@@ -2541,11 +2593,10 @@ TclpObjNormalizePath(
 	     */
 
 	    /*
-	     * Check for symlinks, except at last component of path (we
-	     * don't follow final symlinks). Also a drive (C:/) for
-	     * example, may sometimes have the reparse flag set for some
-	     * reason I don't understand. We therefore don't perform this
-	     * check for drives.
+	     * Check for symlinks, except at last component of path (we don't
+	     * follow final symlinks). Also a drive (C:/) for example, may
+	     * sometimes have the reparse flag set for some reason I don't
+	     * understand. We therefore don't perform this check for drives.
 	     */
 
 	    if (cur != 0 && !isDrive &&
@@ -2554,8 +2605,8 @@ TclpObjNormalizePath(
 
 		if (to != NULL) {
 		    /*
-		     * Read the reparse point ok. Now, reparse points need
-		     * not be normalized, otherwise we could use:
+		     * Read the reparse point ok. Now, reparse points need not
+		     * be normalized, otherwise we could use:
 		     *
 		     * Tcl_GetStringFromObj(to, &pathLen);
 		     * nextCheckpoint = pathLen;
@@ -2595,9 +2646,9 @@ TclpObjNormalizePath(
 
 #ifndef TclNORM_LONG_PATH
 	    /*
-	     * Now we convert the tail of the current path to its 'long
-	     * form', and append it to 'dsNorm' which holds the current
-	     * normalized path
+	     * Now we convert the tail of the current path to its 'long form',
+	     * and append it to 'dsNorm' which holds the current normalized
+	     * path
 	     */
 
 	    if (isDrive) {
@@ -2626,10 +2677,10 @@ TclpObjNormalizePath(
 		    int dotLen = currentPathEndPosition-lastValidPathEnd;
 
 		    /*
-		     * Path is just dots. We shouldn't really ever see a
-		     * path like that. However, to be nice we at least
-		     * don't mangle the path - we just add the dots as a
-		     * path segment and continue.
+		     * Path is just dots. We shouldn't really ever see a path
+		     * like that. However, to be nice we at least don't mangle
+		     * the path - we just add the dots as a path segment and
+		     * continue.
 		     */
 
 		    Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
@@ -2647,8 +2698,7 @@ TclpObjNormalizePath(
 		    handle = FindFirstFileW((WCHAR *) nativePath, &fData);
 		    if (handle == INVALID_HANDLE_VALUE) {
 			/*
-			 * This is usually the '/' in 'c:/' at end of
-			 * string.
+			 * This is usually the '/' in 'c:/' at end of string.
 			 */
 
 			Tcl_DStringAppend(&dsNorm, (const char *) L"/",
@@ -2678,8 +2728,8 @@ TclpObjNormalizePath(
 	    }
 
 	    /*
-	     * If we get here, we've got past one directory delimiter, so
-	     * we know it is no longer a drive.
+	     * If we get here, we've got past one directory delimiter, so we
+	     * know it is no longer a drive.
 	     */
 
 	    isDrive = 0;
@@ -2973,7 +3023,11 @@ TclNativeCreateNativeRep(
 	if (validPathPtr == NULL) {
 	    return NULL;
 	}
-	/* refCount of validPathPtr was already incremented in Tcl_FSGetTranslatedPath */
+
+	/*
+	 * refCount of validPathPtr was already incremented in
+	 * Tcl_FSGetTranslatedPath
+	 */
     } else {
 	/*
 	 * Make sure the normalized path is set.
@@ -2983,72 +3037,100 @@ TclNativeCreateNativeRep(
 	if (validPathPtr == NULL) {
 	    return NULL;
 	}
-	/* validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl, so incr refCount here */
+
+	/*
+	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
+	 * so incr refCount here
+	 */
+
 	Tcl_IncrRefCount(validPathPtr);
     }
 
     str = TclGetStringFromObj(validPathPtr, &len);
 
     if (strlen(str) != len) {
-	/* String contains NUL-bytes. This is invalid. */
+	/*
+	 * String contains NUL-bytes. This is invalid.
+	 */
+
 	goto done;
     }
-    /* For a reserved device, strip a possible postfix ':' */
+
+    /*
+     * For a reserved device, strip a possible postfix ':'
+     */
+
     len = WinIsReserved(str);
     if (len == 0) {
-	/* Let MultiByteToWideChar check for other invalid sequences, like
-	 * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames */
+	/*
+	 * Let MultiByteToWideChar check for other invalid sequences, like
+	 * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames
+	 */
+
 	len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
 	if (len==0) {
 	    goto done;
 	}
     }
-    /* Overallocate 6 chars, making some room for extended paths */
-    wp = nativePathPtr = Tcl_Alloc( (len+6) * sizeof(WCHAR) );
+
+    /*
+     * Overallocate 6 chars, making some room for extended paths
+     */
+
+    wp = nativePathPtr = Tcl_Alloc((len + 6) * sizeof(WCHAR));
     if (nativePathPtr==0) {
       goto done;
     }
-    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr, len+1);
+    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr,
+	    len + 1);
+
     /*
-    ** If path starts with "//?/" or "\\?\" (extended path), translate
-    ** any slashes to backslashes but leave the '?' intact
-    */
-    if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
-	    && str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
+     * If path starts with "//?/" or "\\?\" (extended path), translate any
+     * slashes to backslashes but leave the '?' intact
+     */
+
+    if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/')
+	    && str[2] == '?' && (str[3] == '\\' || str[3] == '/')) {
 	wp[0] = wp[1] = wp[3] = '\\';
 	str += 4;
 	wp += 4;
     }
+
     /*
-    ** If there is no "\\?\" prefix but there is a drive or UNC
-    ** path prefix and the path is larger than MAX_PATH chars,
-    ** no Win32 API function can handle that unless it is
-    ** prefixed with the extended path prefix. See:
-    ** <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
-    **/
-    if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
-	    && str[1]==':') {
-	if (wp==nativePathPtr && len>MAX_PATH && (str[2]=='\\' || str[2]=='/')) {
-	    memmove(wp+4, wp, len*sizeof(WCHAR));
-	    memcpy(wp, L"\\\\?\\", 4*sizeof(WCHAR));
+     * If there is no "\\?\" prefix but there is a drive or UNC path prefix
+     * and the path is larger than MAX_PATH chars, no Win32 API function can
+     * handle that unless it is prefixed with the extended path prefix. See:
+     * <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
+     */
+
+    if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z'))
+	    && str[1] == ':') {
+	if (wp == nativePathPtr && len > MAX_PATH
+		&& (str[2] == '\\' || str[2] == '/')) {
+	    memmove(wp + 4, wp, len * sizeof(WCHAR));
+	    memcpy(wp, L"\\\\?\\", 4 * sizeof(WCHAR));
 	    wp += 4;
 	}
+
 	/*
-	 ** If (remainder of) path starts with "<drive>:",
-	 ** leave the ':' intact.
+	 * If (remainder of) path starts with "<drive>:", leave the ':'
+	 * intact.
 	 */
+
 	wp += 2;
-    } else if (wp==nativePathPtr && len>MAX_PATH
-	    && (str[0]=='\\' || str[0]=='/')
-	    && (str[1]=='\\' || str[1]=='/') && str[2]!='?') {
-	memmove(wp+6, wp, len*sizeof(WCHAR));
-	memcpy(wp, L"\\\\?\\UNC", 7*sizeof(WCHAR));
+    } else if (wp == nativePathPtr && len > MAX_PATH
+	    && (str[0] == '\\' || str[0] == '/')
+	    && (str[1] == '\\' || str[1] == '/') && str[2] != '?') {
+	memmove(wp + 6, wp, len * sizeof(WCHAR));
+	memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR));
 	wp += 7;
     }
+
     /*
-    ** In the remainder of the path, translate invalid characters to
-    ** characters in the Unicode private use area.
-    */
+     * In the remainder of the path, translate invalid characters to
+     * characters in the Unicode private use area.
+     */
+
     while (*wp != '\0') {
 	if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
 	    *wp |= 0xF000;
@@ -3059,7 +3141,6 @@ TclNativeCreateNativeRep(
     }
 
   done:
-
     TclDecrRefCount(validPathPtr);
     return nativePathPtr;
 }
@@ -3185,21 +3266,28 @@ TclWinFileOwned(
     native = Tcl_FSGetNativePath(pathPtr);
 
     if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT,
-                             OWNER_SECURITY_INFORMATION, &ownerSid,
-                             NULL, NULL, NULL, &secd) != ERROR_SUCCESS) {
-        /* Either not a file, or we do not have access to it in which
-           case we are in all likelihood not the owner */
+	    OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL,
+	    &secd) != ERROR_SUCCESS) {
+        /*
+	 * Either not a file, or we do not have access to it in which case we
+	 * are in all likelihood not the owner.
+	 */
+
         return 0;
     }
 
     /*
-     * Getting the current process SID is a multi-step process.
-     * We make the assumption that if a call fails, this process is
-     * so underprivileged it could not possibly own anything. Normally
-     * a process can *always* look up its own token.
+     * Getting the current process SID is a multi-step process.  We make the
+     * assumption that if a call fails, this process is so underprivileged it
+     * could not possibly own anything. Normally a process can *always* look
+     * up its own token.
      */
+
     if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
-        /* Find out how big the buffer needs to be */
+        /*
+	 * Find out how big the buffer needs to be.
+	 */
+
         bufsz = 0;
         GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
         if (bufsz) {
@@ -3211,15 +3299,20 @@ TclWinFileOwned(
         CloseHandle(token);
     }
 
-    /* Free allocations and be done */
-    if (secd)
+    /*
+     * Free allocations and be done.
+     */
+
+    if (secd) {
         LocalFree(secd);            /* Also frees ownerSid */
-    if (buf)
+    }
+    if (buf) {
         Tcl_Free(buf);
+    }
 
     return (owned != 0);        /* Convert non-0 to 1 */
 }
-
+
 /*
  * Local Variables:
  * mode: c
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index ffa3fbf..6d8d4aa 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -124,8 +124,7 @@ typedef struct PipeInfo {
 				 * write. Set to 0 if no error has been
 				 * detected. This word is shared with the
 				 * writer thread so access must be
-				 * synchronized with the writable object.
-				 */
+				 * synchronized with the writable object. */
     char *writeBuf;		/* Current background output buffer. Access is
 				 * synchronized with the writable object. */
     int writeBufLen;		/* Size of write buffer. Access is
@@ -218,7 +217,7 @@ static const Tcl_ChannelType pipeChannelType = {
     NULL,			/* handler proc. */
     NULL,			/* wide seek proc */
     PipeThreadActionProc,	/* thread action proc */
-    NULL                       /* truncate */
+    NULL			/* truncate */
 };
 
 /*
@@ -1428,9 +1427,12 @@ ApplicationType(
 static const char *
 BuildCmdLineBypassBS(
     const char *current,
-    const char **bspos
-) {
-    /* mark first backslash possition */
+    const char **bspos)
+{
+    /*
+     * Mark first backslash position.
+     */
+
     if (!*bspos) {
 	*bspos = current;
     }
@@ -1445,14 +1447,14 @@ QuoteCmdLineBackslash(
     Tcl_DString *dsPtr,
     const char *start,
     const char *current,
-    const char *bspos
-) {
+    const char *bspos)
+{
     if (!bspos) {
-	if (current > start) { /* part before current (special) */
+	if (current > start) {	/* part before current (special) */
 	    Tcl_DStringAppend(dsPtr, start, (int) (current - start));
 	}
     } else {
-    	if (bspos > start) { /* part before first backslash */
+    	if (bspos > start) {	/* part before first backslash */
 	    Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
 	}
 	while (bspos++ < current) { /* each backslash twice */
@@ -1467,38 +1469,59 @@ QuoteCmdLinePart(
     const char *start,
     const char *special,
     const char *specMetaChars,
-    const char **bspos
-) {
+    const char **bspos)
+{
     if (!*bspos) {
-	/* rest before special (before quote) */
+	/*
+	 * Rest before special (before quote).
+	 */
+
 	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
 	start = special;
     } else {
-	/* rest before first backslash and backslashes into new quoted block */
+	/*
+	 * Rest before first backslash and backslashes into new quoted block.
+	 */
+
 	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
 	start = *bspos;
     }
+
     /*
-     * escape all special chars enclosed in quotes like `"..."`, note that here we
-     * don't must escape `\` (with `\`), because it's outside of the main quotes,
-     * so `\` remains `\`, but important - not at end of part, because results as
-     * before the quote,  so `%\%\` should be escaped as `"%\%"\\`).
+     * escape all special chars enclosed in quotes like `"..."`, note that
+     * here we don't must escape `\` (with `\`), because it's outside of the
+     * main quotes, so `\` remains `\`, but important - not at end of part,
+     * because results as before the quote, so `%\%\` should be escaped as
+     * `"%\%"\\`).
      */
+
     TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
     do {
     	*bspos = NULL;
 	special++;
 	if (*special == '\\') {
-	    /* bypass backslashes (and mark first backslash possition)*/
+	    /*
+	     * Bypass backslashes (and mark first backslash position).
+	     */
+
 	    special = BuildCmdLineBypassBS(special, bspos);
-	    if (*special == '\0') break;
+	    if (*special == '\0') {
+		break;
+	    }
 	}
     } while (*special && strchr(specMetaChars, *special));
     if (!*bspos) {
-	/* unescaped rest before quote */
+	/*
+	 * Unescaped rest before quote.
+	 */
+
 	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
     } else {
-	/* unescaped rest before first backslash (rather belongs to the main block) */
+	/*
+	 * Unescaped rest before first backslash (rather belongs to the main
+	 * block).
+	 */
+
 	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
     }
     TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
@@ -1517,13 +1540,14 @@ BuildCommandLine(
     const char *arg, *start, *special, *bspos;
     int quote = 0, i;
     Tcl_DString ds;
-
-    /* characters to enclose in quotes if unpaired quote flag set */
     static const char specMetaChars[] = "&|^<>!()%";
-    /* character to enclose in quotes in any case (regardless unpaired-flag) */
+				/* Characters to enclose in quotes if unpaired
+				 * quote flag set. */
     static const char specMetaChars2[] = "%";
-
-    /* Quote flags:
+				/* Character to enclose in quotes in any case
+				 * (regardless of unpaired-flag). */
+    /*
+     * Quote flags:
      *   CL_ESCAPE   - escape argument;
      *   CL_QUOTE    - enclose in quotes;
      *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
@@ -1555,30 +1579,31 @@ BuildCommandLine(
 	    quote = CL_QUOTE;
 	} else {
 	    for (start = arg;
-		*start != '\0' &&
-		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
-		start++
-	    ) {
-		if (*start & 0x80) continue;
+		    *start != '\0' &&
+			(quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
+		    start++) {
+		if (*start & 0x80) {
+		    continue;
+		}
 		if (TclIsSpaceProc(*start)) {
-		    quote |= CL_QUOTE; /* quote only */
-		    if (bspos) { /* if backslash found - escape & quote */
+		    quote |= CL_QUOTE;	/* quote only */
+		    if (bspos) {	/* if backslash found, escape & quote */
 			quote |= CL_ESCAPE;
 			break;
 		    }
 		    continue;
 		}
 		if (strchr(specMetaChars, *start)) {
-		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
+		    quote |= (CL_ESCAPE|CL_QUOTE); /* escape & quote */
 		    break;
 		}
 		if (*start == '"') {
-		    quote |= CL_ESCAPE; /* escape only */
+		    quote |= CL_ESCAPE;		/* escape only */
 		    continue;
 		}
 		if (*start == '\\') {
 		    bspos = start;
-		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
+		    if (quote & CL_QUOTE) {	/* if quote, escape & quote */
 			quote |= CL_ESCAPE;
 			break;
 		    }
@@ -1588,56 +1613,116 @@ BuildCommandLine(
 	    bspos = NULL;
 	}
 	if (quote & CL_QUOTE) {
-	    /* start of argument (main opening quote-char) */
+	    /*
+	     * Start of argument (main opening quote-char).
+	     */
+
 	    TclDStringAppendLiteral(&ds, "\"");
 	}
 	if (!(quote & CL_ESCAPE)) {
-	    /* nothing to escape */
+	    /*
+	     * Nothing to escape.
+	     */
+
 	    Tcl_DStringAppend(&ds, arg, -1);
 	} else {
 	    start = arg;
 	    for (special = arg; *special != '\0'; ) {
-		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
+		/*
+		 * Position of `\` is important before quote or at end (equal
+		 * `\"` because quoted).
+		 */
+
 		if (*special == '\\') {
-		    /* bypass backslashes (and mark first backslash possition)*/
+		    /*
+		     * Bypass backslashes (and mark first backslash position)
+		     */
+
 		    special = BuildCmdLineBypassBS(special, &bspos);
-		    if (*special == '\0') break;
+		    if (*special == '\0') {
+			break;
+		    }
 		}
 		/* ["] */
 		if (*special == '"') {
-		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
-		    /* add part before (and escape backslashes before quote) */
+		    /*
+		     * Invert the unpaired flag - observe unpaired quotes
+		     */
+
+		    quote ^= CL_UNPAIRED;
+
+		    /*
+		     * Add part before (and escape backslashes before quote).
+		     */
+
 		    QuoteCmdLineBackslash(&ds, start, special, bspos);
 		    bspos = NULL;
-		    /* escape using backslash */
+
+		    /*
+		     * Escape using backslash
+		     */
+
 		    TclDStringAppendLiteral(&ds, "\\\"");
 		    start = ++special;
 		    continue;
 		}
-		/* unpaired (escaped) quote causes special handling on meta-chars */
+
+		/*
+		 * Unpaired (escaped) quote causes special handling on
+		 * meta-chars
+		 */
+
 		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
-		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
-		    /* start to current or first backslash */
+		    special = QuoteCmdLinePart(&ds, start, special,
+			    specMetaChars, &bspos);
+
+		    /*
+		     * Start to current or first backslash
+		     */
+
 		    start = !bspos ? special : bspos;
 		    continue;
 		}
-		/* special case for % - should be enclosed always (paired also) */
+
+		/*
+		 * Special case for % - should be enclosed always (paired
+		 * also)
+		 */
+
 		if (strchr(specMetaChars2, *special)) {
-		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
-		    /* start to current or first backslash */
+		    special = QuoteCmdLinePart(&ds, start, special,
+			    specMetaChars2, &bspos);
+
+		    /*
+		     * Start to current or first backslash.
+		     */
+
 		    start = !bspos ? special : bspos;
 		    continue;
 		}
-		/* other not special (and not meta) character */
-		bspos = NULL; /* reset last backslash possition (not interesting) */
+
+		/*
+		 * Other not special (and not meta) character
+		 */
+
+		bspos = NULL;		/* reset last backslash position (not
+					 * interesting) */
 		special++;
 	    }
-	    /* rest of argument (and escape backslashes before closing main quote) */
+
+	    /*
+	     * Rest of argument (and escape backslashes before closing main
+	     * quote)
+	     */
+
 	    QuoteCmdLineBackslash(&ds, start, special,
-	    	(quote & CL_QUOTE) ? bspos : NULL);
+		    (quote & CL_QUOTE) ? bspos : NULL);
 	}
 	if (quote & CL_QUOTE) {
-	    /* end of argument (main closing quote-char) */
+	    /*
+	     * End of argument (main closing quote-char)
+	     */
+
 	    TclDStringAppendLiteral(&ds, "\"");
 	}
     }
@@ -2175,8 +2260,9 @@ PipeOutputProc(
     *errorCode = 0;
 
     /* avoid blocking if pipe-thread exited */
-    timeout = ((infoPtr->flags & PIPE_ASYNC) || !TclPipeThreadIsAlive(&infoPtr->writeTI)
-	|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
+    timeout = ((infoPtr->flags & PIPE_ASYNC)
+	    || !TclPipeThreadIsAlive(&infoPtr->writeTI)
+	    || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
     if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
 	/*
 	 * The writer thread is blocked waiting for a write to complete and
@@ -2362,6 +2448,7 @@ PipeWatchProc(
     infoPtr->watchMask = mask & infoPtr->validMask;
     if (infoPtr->watchMask) {
 	Tcl_Time blockTime = { 0, 0 };
+
 	if (!oldMask) {
 	    infoPtr->nextPtr = tsdPtr->firstPipePtr;
 	    tsdPtr->firstPipePtr = infoPtr;
@@ -2831,7 +2918,7 @@ static DWORD WINAPI
 PipeReaderThread(
     LPVOID arg)
 {
-    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
+    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg;
     PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
     HANDLE handle = NULL;
     DWORD count, err;
@@ -2842,13 +2929,14 @@ PipeReaderThread(
 	 * Wait for the main thread to signal before attempting to wait on the
 	 * pipe becoming readable.
 	 */
+
 	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
 	    /* exit */
 	    break;
 	}
 
 	if (!infoPtr) {
-	    infoPtr = (PipeInfo *)pipeTI->clientData;
+	    infoPtr = (PipeInfo *) pipeTI->clientData;
 	    handle = ((WinFile *) infoPtr->readFile)->handle;
 	}
 
@@ -3195,7 +3283,7 @@ TclPipeThreadCreateTI(
     pipeTI = malloc(sizeof(TclPipeThreadInfo));
 #else
     pipeTI = Tcl_Alloc(sizeof(TclPipeThreadInfo));
-#endif
+#endif /* !_PTI_USE_CKALLOC */
     pipeTI->evControl = CreateEvent(NULL, FALSE, FALSE, NULL);
     pipeTI->state = PTI_STATE_IDLE;
     pipeTI->clientData = clientData;
@@ -3234,40 +3322,64 @@ TclPipeThreadWaitForSignal(
     }
 
     wakeEvent = pipeTI->evWakeUp;
+
     /*
      * Wait for the main thread to signal before attempting to do the work.
      */
 
-    /* reset work state of thread (idle/waiting) */
-    if ((state = InterlockedCompareExchange(&pipeTI->state,
-	    PTI_STATE_IDLE, PTI_STATE_WORK)) & (PTI_STATE_STOP|PTI_STATE_END)) {
-	/* end of work, check the owner of structure */
+    /*
+     * Reset work state of thread (idle/waiting)
+     */
+
+    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE,
+	    PTI_STATE_WORK);
+    if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
+	/*
+	 * End of work, check the owner of structure.
+	 */
+
 	goto end;
     }
-    /* entering wait */
-    waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
 
-    if (waitResult != WAIT_OBJECT_0) {
+    /*
+     * Entering wait
+     */
 
+    waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
+    if (waitResult != WAIT_OBJECT_0) {
 	/*
 	 * The control event was not signaled, so end of work (unexpected
 	 * behaviour, main thread can be dead?).
 	 */
+
 	goto end;
     }
 
-    /* try to set work state of thread */
-    if ((state = InterlockedCompareExchange(&pipeTI->state,
-	    PTI_STATE_WORK, PTI_STATE_IDLE)) & (PTI_STATE_STOP|PTI_STATE_END)) {
-	/* end of work */
+    /*
+     * Try to set work state of thread
+     */
+
+    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK,
+	    PTI_STATE_IDLE);
+    if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
+	/*
+	 * End of work
+	 */
+
 	goto end;
     }
 
-    /* signaled to work */
+    /*
+     * Signaled to work.
+     */
+
     return 1;
 
-end:
-    /* end of work, check the owner of the TI structure */
+  end:
+    /*
+     * End of work, check the owner of the TI structure.
+     */
+
     if (state != PTI_STATE_STOP) {
 	*pipeTIPtr = NULL;
     } else {
@@ -3297,7 +3409,8 @@ end:
 
 int
 TclPipeThreadStopSignal(
-    TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent)
+    TclPipeThreadInfo **pipeTIPtr,
+    HANDLE wakeEvent)
 {
     TclPipeThreadInfo *pipeTI = *pipeTIPtr;
     HANDLE evControl;
@@ -3308,28 +3421,27 @@ TclPipeThreadStopSignal(
     }
     evControl = pipeTI->evControl;
     pipeTI->evWakeUp = wakeEvent;
-    switch (
-	(state = InterlockedCompareExchange(&pipeTI->state,
-	    PTI_STATE_STOP, PTI_STATE_IDLE))
-    ) {
-
-	case PTI_STATE_IDLE:
-
-	    /* Thread was idle/waiting, notify it goes teardown */
-	    SetEvent(evControl);
-
-	    *pipeTIPtr = NULL;
-
-	case PTI_STATE_DOWN:
+    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
+	    PTI_STATE_IDLE);
+    switch (state) {
+    case PTI_STATE_IDLE:
+	/*
+	 * Thread was idle/waiting, notify it goes teardown
+	 */
 
+	SetEvent(evControl);
+	*pipeTIPtr = NULL;
+    case PTI_STATE_DOWN:
 	return 1;
 
-	default:
-	    /*
-	     * Thread works currently, we should try to end it, own the TI structure
-	     * (because of possible sharing the joint structures with thread)
-	     */
-	    InterlockedExchange(&pipeTI->state, PTI_STATE_END);
+    default:
+	/*
+	 * Thread works currently, we should try to end it, own the TI
+	 * structure (because of possible sharing the joint structures with
+	 * thread)
+	 */
+
+	InterlockedExchange(&pipeTI->state, PTI_STATE_END);
 	break;
     }
 
@@ -3372,46 +3484,63 @@ TclPipeThreadStop(
     pipeTI = *pipeTIPtr;
     evControl = pipeTI->evControl;
     pipeTI->evWakeUp = NULL;
+
     /*
      * Try to sane stop the pipe worker, corresponding its current state
      */
-    switch (
-	(state = InterlockedCompareExchange(&pipeTI->state,
-	    PTI_STATE_STOP, PTI_STATE_IDLE))
-    ) {
 
-	case PTI_STATE_IDLE:
+    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
+	    PTI_STATE_IDLE);
+    switch (state) {
+    case PTI_STATE_IDLE:
+	/*
+	 * Thread was idle/waiting, notify it goes teardown
+	 */
 
-	    /* Thread was idle/waiting, notify it goes teardown */
-	    SetEvent(evControl);
+	SetEvent(evControl);
 
-	    /* we don't need to wait for it at all, thread frees himself (owns the TI structure) */
-	    pipeTI = NULL;
+	/*
+	 * We don't need to wait for it at all, thread frees himself (owns the
+	 * TI structure)
+	 */
+
+	pipeTI = NULL;
 	break;
 
-	case PTI_STATE_STOP:
-	    /* already stopped, thread frees himself (owns the TI structure) */
-	    pipeTI = NULL;
+    case PTI_STATE_STOP:
+	/*
+	 * Already stopped, thread frees himself (owns the TI structure)
+	 */
+
+	pipeTI = NULL;
 	break;
-	case PTI_STATE_DOWN:
-	    /* Thread already down (?), do nothing */
+    case PTI_STATE_DOWN:
+	/*
+	 * Thread already down (?), do nothing
+	 */
 
-	    /* we don't need to wait for it, but we should free pipeTI */
-	    hThread = NULL;
+	/*
+	 * We don't need to wait for it, but we should free pipeTI
+	 */
+	hThread = NULL;
 	break;
 
 	/* case PTI_STATE_WORK: */
-	default:
+    default:
+	/*
+	 * Thread works currently, we should try to end it, own the TI
+	 * structure (because of possible sharing the joint structures with
+	 * thread)
+	 */
+
+	state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END,
+		PTI_STATE_WORK);
+	if (state == PTI_STATE_DOWN) {
 	    /*
-	     * Thread works currently, we should try to end it, own the TI structure
-	     * (because of possible sharing the joint structures with thread)
+	     * We don't need to wait for it, but we should free pipeTI
 	     */
-	    if ((state = InterlockedCompareExchange(&pipeTI->state,
-		    PTI_STATE_END, PTI_STATE_WORK)) == PTI_STATE_DOWN
-	    ) {
-		/* we don't need to wait for it, but we should free pipeTI */
-		hThread = NULL;
-	    };
+	    hThread = NULL;
+	}
 	break;
     }
 
@@ -3426,8 +3555,8 @@ TclPipeThreadStop(
 	GetExitCodeThread(hThread, &exitCode);
 
 	if (exitCode == STILL_ACTIVE) {
-
 	    int inExit = (TclInExit() || TclInThreadExit());
+
 	    /*
 	     * Set the stop event so that if the pipe thread is blocked
 	     * somewhere, it may hereafter sane exit cleanly.
@@ -3438,59 +3567,69 @@ TclPipeThreadStop(
 	    /*
 	     * Cancel all sync-IO of this thread (may be blocked there).
 	     */
+
 	    if (tclWinProcs.cancelSynchronousIo) {
 		tclWinProcs.cancelSynchronousIo(hThread);
 	    }
 
 	    /*
-	     * Wait at most 20 milliseconds for the reader thread to
-	     * close (regarding TIP#398-fast-exit).
+	     * Wait at most 20 milliseconds for the reader thread to close
+	     * (regarding TIP#398-fast-exit).
 	     */
 
-	    /* if we want TIP#398-fast-exit. */
-	    if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
+	    /*
+	     * If we want TIP#398-fast-exit.
+	     */
 
+	    if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
 		/*
-		 * The thread must be blocked waiting for the pipe to
-		 * become readable in ReadFile(). There isn't a clean way
-		 * to exit the thread from this condition. We should
-		 * terminate the child process instead to get the reader
-		 * thread to fall out of ReadFile with a FALSE. (below) is
-		 * not the correct way to do this, but will stay here
-		 * until a better solution is found.
+		 * The thread must be blocked waiting for the pipe to become
+		 * readable in ReadFile(). There isn't a clean way to exit the
+		 * thread from this condition. We should terminate the child
+		 * process instead to get the reader thread to fall out of
+		 * ReadFile with a FALSE. (below) is not the correct way to do
+		 * this, but will stay here until a better solution is found.
 		 *
-		 * Note that we need to guard against terminating the
-		 * thread while it is in the middle of Tcl_ThreadAlert
-		 * because it won't be able to release the notifier lock.
+		 * Note that we need to guard against terminating the thread
+		 * while it is in the middle of Tcl_ThreadAlert because it
+		 * won't be able to release the notifier lock.
 		 *
-		 * Also note that terminating threads during their initialization or teardown phase
-		 * may result in ntdll.dll's LoaderLock to remain locked indefinitely.
-		 * This causes ntdll.dll's LdrpInitializeThread() to deadlock trying to acquire LoaderLock.
-		 * LdrpInitializeThread() is executed within new threads to perform
-		 * initialization and to execute DllMain() of all loaded dlls.
-		 * As a result, all new threads are deadlocked in their initialization phase and never execute,
-		 * even though CreateThread() reports successful thread creation.
-		 * This results in a very weird process-wide behavior, which is extremely hard to debug.
+		 * Also note that terminating threads during their
+		 * initialization or teardown phase may result in ntdll.dll's
+		 * LoaderLock to remain locked indefinitely.  This causes
+		 * ntdll.dll's LdrpInitializeThread() to deadlock trying to
+		 * acquire LoaderLock.  LdrpInitializeThread() is executed
+		 * within new threads to perform initialization and to execute
+		 * DllMain() of all loaded dlls.  As a result, all new threads
+		 * are deadlocked in their initialization phase and never
+		 * execute, even though CreateThread() reports successful
+		 * thread creation.  This results in a very weird process-wide
+		 * behavior, which is extremely hard to debug.
 		 *
 		 * THREADS SHOULD NEVER BE TERMINATED. Period.
 		 *
-		 * But for now, check if thread is exiting, and if so, let it die peacefully.
+		 * But for now, check if thread is exiting, and if so, let it
+		 * die peacefully.
 		 *
-		 * Also don't terminate if in exit (otherwise deadlocked in ntdll.dll's).
+		 * Also don't terminate if in exit (otherwise deadlocked in
+		 * ntdll.dll's).
 		 */
 
-		if ( pipeTI->state != PTI_STATE_DOWN
-		  && WaitForSingleObject(hThread,
-			inExit ? 50 : 5000) != WAIT_OBJECT_0
-		) {
+		if (pipeTI->state != PTI_STATE_DOWN
+			&& WaitForSingleObject(hThread,
+				inExit ? 50 : 5000) != WAIT_OBJECT_0) {
 		    /* BUG: this leaks memory */
 		    if (inExit || !TerminateThread(hThread, 0)) {
-			/* in exit or terminate fails, just give thread a chance to exit */
+			/*
+			 * in exit or terminate fails, just give thread a
+			 * chance to exit
+			 */
+
 			if (InterlockedExchange(&pipeTI->state,
 				PTI_STATE_STOP) != PTI_STATE_DOWN) {
 			    pipeTI = NULL;
 			}
-		    };
+		    }
 		}
 	    }
 	}
@@ -3502,11 +3641,11 @@ TclPipeThreadStop(
 	    SetEvent(pipeTI->evWakeUp);
 	}
 	CloseHandle(pipeTI->evControl);
-#   ifndef _PTI_USE_CKALLOC
+#ifndef _PTI_USE_CKALLOC
 	free(pipeTI);
-#   else
+#else
 	Tcl_Free(pipeTI);
-#   endif
+#endif /* !_PTI_USE_CKALLOC */
     }
 }
 
@@ -3535,28 +3674,30 @@ TclPipeThreadExit(
 {
     LONG state;
     TclPipeThreadInfo *pipeTI = *pipeTIPtr;
+
     /*
      * If state of thread was set to stop (exactly), we can sane free its info
      * structure, otherwise it is shared with main thread, so main thread will
      * own it.
      */
+
     if (!pipeTI) {
 	return;
     }
     *pipeTIPtr = NULL;
-    if ((state = InterlockedExchange(&pipeTI->state,
-	    PTI_STATE_DOWN)) == PTI_STATE_STOP) {
+    state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN);
+    if (state == PTI_STATE_STOP) {
 	CloseHandle(pipeTI->evControl);
 	if (pipeTI->evWakeUp) {
 	    SetEvent(pipeTI->evWakeUp);
 	}
-#   ifndef _PTI_USE_CKALLOC
+#ifndef _PTI_USE_CKALLOC
 	free(pipeTI);
-#   else
+#else
 	Tcl_Free(pipeTI);
 	/* be sure all subsystems used are finalized */
 	Tcl_FinalizeThread();
-#   endif
+#endif /* !_PTI_USE_CKALLOC */
     }
 }
 
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index 92750b8..9f559e6 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -44,6 +44,15 @@ TCL_DECLARE_MUTEX(serialMutex)
 #define SERIAL_ERROR	(1<<4)
 
 /*
+ * Bit masks used for noting whether to drain or discard output on close. They
+ * are disjoint from each other; at most one may be set at a time.
+ */
+
+#define SERIAL_CLOSE_DRAIN   (1<<6)	/* Drain all output on close. */
+#define SERIAL_CLOSE_DISCARD (1<<7)	/* Discard all output on close. */
+#define SERIAL_CLOSE_MASK    (3<<6)	/* Both two bits above. */
+
+/*
  * Default time to block between checking status on the serial port.
  */
 
@@ -604,7 +613,6 @@ SerialCloseProc(
     serialPtr->validMask &= ~TCL_READABLE;
 
     if (serialPtr->writeThread) {
-
     	TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
 
 	CloseHandle(serialPtr->osWrite.hEvent);
@@ -1278,7 +1286,7 @@ SerialWriterThread(
 	    /* exit */
 	    break;
 	}
-	infoPtr = (SerialInfo *)pipeTI->clientData;
+	infoPtr = (SerialInfo *) pipeTI->clientData;
 
 	buf = infoPtr->writeBuf;
 	toWrite = infoPtr->toWrite;
@@ -1342,7 +1350,25 @@ SerialWriterThread(
 	Tcl_MutexUnlock(&serialMutex);
     }
 
-    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
+    /*
+     * We're about to close, so do any drain or discard required.
+     */
+
+    if (infoPtr) {
+	switch (infoPtr->flags & SERIAL_CLOSE_MASK) {
+	case SERIAL_CLOSE_DRAIN:
+	    FlushFileBuffers(infoPtr->handle);
+	    break;
+	case SERIAL_CLOSE_DISCARD:
+	    PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
+	    break;
+	}
+    }
+
+    /*
+     * Worker exit, so inform the main thread or free TI-structure (if owned).
+     */
+
     TclPipeThreadExit(&pipeTI);
 
     return 0;
@@ -1610,6 +1636,32 @@ SerialSetOptionProc(
     vlen = strlen(value);
 
     /*
+     * Option -closemode drain|discard|default
+     */
+
+    if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) {
+	if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) {
+	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
+	} else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) {
+	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
+	    infoPtr->flags |= SERIAL_CLOSE_DRAIN;
+	} else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) {
+	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
+	    infoPtr->flags |= SERIAL_CLOSE_DISCARD;
+	} else {
+	    if (interp) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"bad mode \"%s\" for -closemode: must be"
+			" default, discard, or drain", value));
+		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
+			"VALUE", NULL);
+	    }
+	    return TCL_ERROR;
+	}
+	return TCL_OK;
+    }
+
+    /*
      * Option -mode baud,parity,databits,stopbits
      */
 
@@ -1938,7 +1990,8 @@ SerialSetOptionProc(
     }
 
     return Tcl_BadChannelOption(interp, optionName,
-	    "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
+	    "closemode mode handshake pollinterval sysbuffer timeout "
+	    "ttycontrol xchar");
 
   getStateFailed:
     if (interp != NULL) {
@@ -1999,6 +2052,27 @@ SerialGetOptionProc(
     }
 
     /*
+     * Get option -closemode
+     */
+
+    if (len == 0) {
+	Tcl_DStringAppendElement(dsPtr, "-closemode");
+    }
+    if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) {
+	switch (infoPtr->flags & SERIAL_CLOSE_MASK) {
+	case SERIAL_CLOSE_DRAIN:
+	    Tcl_DStringAppendElement(dsPtr, "drain");
+	    break;
+	case SERIAL_CLOSE_DISCARD:
+	    Tcl_DStringAppendElement(dsPtr, "discard");
+	    break;
+	default:
+	    Tcl_DStringAppendElement(dsPtr, "default");
+	    break;
+	}
+    }
+
+    /*
      * Get option -mode
      */
 
@@ -2174,7 +2248,8 @@ SerialGetOptionProc(
 	return TCL_OK;
     }
     return Tcl_BadChannelOption(interp, optionName,
-	    "mode pollinterval lasterror queue sysbuffer ttystatus xchar");
+	    "closemode mode pollinterval lasterror queue sysbuffer ttystatus "
+	    "xchar");
 }
 
 /*