merge trunk

4 files changed, 81 insertions, 34 deletions

diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 94c008d..d0600e6 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -26,6 +26,12 @@
 #   define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
 #endif
 
+#if !defined(NDEBUG)
+    /* test POKE server Implemented for debug mode only */
+#   undef CBF_FAIL_POKES
+#   define CBF_FAIL_POKES 0
+#endif
+
 /*
  * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the Dde_Init
  * declaration is in the source file itself, which is only accessed when we
@@ -750,7 +756,7 @@ DdeServerProc(
 		} else {
 		    returnString = (char *)
 			    Tcl_GetUnicodeFromObj(convPtr->returnPackagePtr, &len);
-		    len = 2 * len + 1;
+		    len = sizeof(TCHAR) * len + 1;
 		}
 		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
 			(DWORD) len+1, 0, ddeItem, uFmt, 0);
@@ -771,7 +777,7 @@ DdeServerProc(
 			} else {
 			    returnString = (char *) Tcl_GetUnicodeFromObj(
 				    variableObjPtr, &len);
-			    len = 2 * len + 1;
+			    len = sizeof(TCHAR) * len + 1;
 			}
 			ddeReturn = DdeCreateDataHandle(ddeInstance,
 				(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
@@ -786,6 +792,53 @@ DdeServerProc(
 	}
 	return ddeReturn;
 
+#if !CBF_FAIL_POKES
+    case XTYP_POKE:
+	/*
+	 * This is a poke for a Tcl variable, only implemented in
+	 * debug/UNICODE mode.
+	 */
+	ddeReturn = DDE_FNOTPROCESSED;
+
+	if ((uFmt != CF_TEXT) && (uFmt != CF_UNICODETEXT)) {
+	    return ddeReturn;
+	}
+
+	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+	    /*
+	     * Empty loop body.
+	     */
+	}
+
+	if (convPtr && !Tcl_IsSafe(convPtr->riPtr->interp)) {
+	    Tcl_DString ds;
+	    Tcl_Obj *variableObjPtr;
+
+	    len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINUNICODE);
+	    Tcl_DStringInit(&dString);
+	    Tcl_DStringSetLength(&dString, (len + 1) * sizeof(TCHAR) - 1);
+	    utilString = (TCHAR *) Tcl_DStringValue(&dString);
+	    DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1,
+		    CP_WINUNICODE);
+	    Tcl_WinTCharToUtf(utilString, -1, &ds);
+	    utilString = (TCHAR *) DdeAccessData(hData, &dlen);
+	    if (uFmt == CF_TEXT) {
+		variableObjPtr = Tcl_NewStringObj((char *)utilString, -1);
+	    } else {
+		variableObjPtr = Tcl_NewUnicodeObj(utilString, -1);
+	    }
+
+	    Tcl_SetVar2Ex(convPtr->riPtr->interp, Tcl_DStringValue(&ds), NULL,
+		    variableObjPtr, TCL_GLOBAL_ONLY);
+
+	    Tcl_DStringFree(&ds);
+	    Tcl_DStringFree(&dString);
+		ddeReturn = (HDDEDATA) DDE_FACK;
+	}
+	return ddeReturn;
+
+#endif
     case XTYP_EXECUTE: {
 	/*
 	 * Execute this script. The results will be saved into a list object
@@ -1573,8 +1626,8 @@ DdeObjCmd(
 		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
 	} else {
 	    dataString = (BYTE *)
-		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);
-	    length += 1;
+		    Tcl_GetUnicodeFromObj(objv[firstArg + 3], &length);
+	    length = 2 * length + 1;
 	}
 
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 23e79b0..c6ac2b7 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -14,7 +14,7 @@
 #ifndef _TCLWINPORT
 #define _TCLWINPORT
 
-#ifndef _WIN64
+#if !defined(_WIN64) && defined(BUILD_tcl)
 /* See [Bug 3354324]: file mtime sets wrong time */
 #   define _USE_32BIT_TIME_T
 #endif
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index c4a89e6..6ac5caf 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -15,6 +15,7 @@
 #undef STATIC_BUILD
 #undef USE_TCL_STUBS
 #define USE_TCL_STUBS
+
 #include "tclInt.h"
 #ifdef _MSC_VER
 #   pragma comment (lib, "advapi32.lib")
@@ -23,20 +24,20 @@
 
 #ifndef UNICODE
 #   undef Tcl_WinTCharToUtf
-#   define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+#   define Tcl_WinTCharToUtf(a,b,c)	Tcl_ExternalToUtfDString(NULL,a,b,c)
 #   undef Tcl_WinUtfToTChar
-#   define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif
+#   define Tcl_WinUtfToTChar(a,b,c)	Tcl_UtfToExternalDString(NULL,a,b,c)
+#endif /* !UNICODE */
 
 /*
  * Ensure that we can say which registry is being accessed.
  */
 
 #ifndef KEY_WOW64_64KEY
-#define KEY_WOW64_64KEY		(0x0100)
+#   define KEY_WOW64_64KEY	(0x0100)
 #endif
 #ifndef KEY_WOW64_32KEY
-#define KEY_WOW64_32KEY		(0x0200)
+#   define KEY_WOW64_32KEY	(0x0200)
 #endif
 
 /*
@@ -44,7 +45,7 @@
  */
 
 #ifndef MAX_KEY_LENGTH
-#define MAX_KEY_LENGTH		256
+#   define MAX_KEY_LENGTH	256
 #endif
 
 /*
@@ -57,14 +58,6 @@
 #define TCL_STORAGE_CLASS DLLEXPORT
 
 /*
- * The maximum length of a sub-key name.
- */
-
-#ifndef MAX_KEY_LENGTH
-#define MAX_KEY_LENGTH		256
-#endif
-
-/*
  * The following macros convert between different endian ints.
  */
 
@@ -817,16 +810,16 @@ GetValue(
 	 * we get bogus data.
 	 */
 
-	while ((p < end)
-		&& (*((Tcl_UniChar *) p)) != 0) {
+	while ((p < end) && *((Tcl_UniChar *) p) != 0) {
 	    Tcl_UniChar *up;
+
 	    Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
 	    Tcl_ListObjAppendElement(interp, resultPtr,
 		    Tcl_NewStringObj(Tcl_DStringValue(&buf),
 			    Tcl_DStringLength(&buf)));
 	    up = (Tcl_UniChar *) p;
 
-	    while (*up++ != 0) {}
+	    while (*up++ != 0) {/* empty body */}
 	    p = (char *) up;
 	    Tcl_DStringFree(&buf);
 	}
@@ -1226,8 +1219,8 @@ RecursiveDeleteKey(
 	    }
 	    break;
 	} else if (result == ERROR_SUCCESS) {
-	    result = RecursiveDeleteKey(hKey, (const TCHAR *) Tcl_DStringValue(&subkey),
-		    mode);
+	    result = RecursiveDeleteKey(hKey,
+		    (const TCHAR *) Tcl_DStringValue(&subkey), mode);
 	}
     }
     Tcl_DStringFree(&subkey);
@@ -1294,8 +1287,8 @@ SetValue(
 	    return TCL_ERROR;
 	}
 
-	value = ConvertDWORD((DWORD)type, (DWORD)value);
-	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+	value = ConvertDWORD((DWORD) type, (DWORD) value);
+	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
 		(DWORD) type, (BYTE *) &value, sizeof(DWORD));
     } else if (type == REG_MULTI_SZ) {
 	Tcl_DString data, buf;
@@ -1329,7 +1322,7 @@ SetValue(
 
 	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
 		&buf);
-	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
 		(DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
 		(DWORD) Tcl_DStringLength(&buf));
 	Tcl_DStringFree(&data);
@@ -1338,7 +1331,7 @@ SetValue(
 	Tcl_DString buf;
 	const char *data = Tcl_GetStringFromObj(dataObj, &length);
 
-	data = (char *)Tcl_WinUtfToTChar(data, length, &buf);
+	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
 
 	/*
 	 * Include the null in the length, padding if needed for Unicode.
@@ -1347,7 +1340,7 @@ SetValue(
 	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
 	length = Tcl_DStringLength(&buf) + 1;
 
-	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
 		(DWORD) type, (BYTE *) data, (DWORD) length);
 	Tcl_DStringFree(&buf);
     } else {
@@ -1358,7 +1351,7 @@ SetValue(
 	 */
 
 	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
-	result = RegSetValueEx(key, (TCHAR *)valueName, 0,
+	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
 		(DWORD) type, data, (DWORD) length);
     }
 
@@ -1529,14 +1522,15 @@ ConvertDWORD(
     DWORD type,			/* Either REG_DWORD or REG_DWORD_BIG_ENDIAN */
     DWORD value)		/* The value to be converted. */
 {
-    DWORD order = 1;
+    const DWORD order = 1;
     DWORD localType;
 
     /*
      * Check to see if the low bit is in the first byte.
      */
 
-    localType = (*((char *) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+    localType = (*((const char *) &order) == 1)
+	    ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
     return (type != localType) ? (DWORD) SWAPLONG(value) : value;
 }
 
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index fb7f69b..9e9d1af 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -2002,7 +2002,7 @@ SerialSetOptionProc(
     if (interp != NULL) {
 	TclWinConvertError(GetLastError());
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't get comm state: ", Tcl_PosixError(interp)));
+		"can't get comm state: %s", Tcl_PosixError(interp)));
     }
     return TCL_ERROR;
 
@@ -2010,7 +2010,7 @@ SerialSetOptionProc(
     if (interp != NULL) {
 	TclWinConvertError(GetLastError());
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"can't set comm state: ", Tcl_PosixError(interp)));
+		"can't set comm state: %s", Tcl_PosixError(interp)));
     }
     return TCL_ERROR;
 }