[Frq 3527238]: Full unicode support for dde. Dde version is now 1.4.0b2.

7 files changed, 62 insertions, 48 deletions

diff --git a/ChangeLog b/ChangeLog
index 9a17845..ce0146e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2012-09-20  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* win/tclWinDde.c: [Frq 3527238]: Full unicode support
+	for dde. Dde version is now 1.4.0b2.
+	***POTENTIAL INCOMPATIBILITY***
+
 2012-09-19  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* generic/tcl.h:  make Tcl_Interp a fully opaque structure
diff --git a/doc/dde.n b/doc/dde.n
index 0acceac..3fe0f87 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -83,9 +83,11 @@ asynchronous invocation.  The command returns an error message if the
 script did not run, unless the \fB\-async\fR flag was used, in which case
 the command returns immediately with no error.
 .VS 8.6
-The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
-string is sent.  Combining \fB-binary\fR with the result of
-\fBencoding convertto\fR may be used to send data in arbitrary encodings.
+Without the \fB\-binary\fR option all data will be sent in unicode. For
+dde clients which don't implement the CF_UNICODE clipboard format, this
+will automatically be translated to the system encoding. You can use 
+the \fB\-binary\fR option in combination with the result of
+\fBencoding convertto\fR to send data in any other encoding.
 .VE 8.6
 .TP
 \fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
@@ -98,8 +100,11 @@ on.  The \fIitem\fR is also application specific and is often not used, but
 it must always be non-null.  The \fIdata\fR field is given to the remote
 application.
 .VS 8.6
-The \fB\-binary\fR option treats \fIdata\fR as binary data, otherwise an utf-8
-string is sent.
+Without the \fB\-binary\fR option all data will be sent in unicode. For
+dde clients which don't implement the CF_UNICODE clipboard format, this
+will automatically be translated to the system encoding. You can use 
+the \fB\-binary\fR option in combination with the result of
+\fBencoding convertto\fR to send data in any other encoding.
 .VE 8.6
 .TP
 \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index ce8276b..8758bd2 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
 if {([info commands ::tcl::pkgconfig] eq "")
 	|| ([info sharedlibextension] ne ".dll")} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14g.dll] dde]
+    package ifneeded dde 1.4.0b2 [list load [file join $dir tcldde14g.dll] dde]
 } else {
-    package ifneeded dde 1.4.0b1 [list load [file join $dir tcldde14.dll] dde]
+    package ifneeded dde 1.4.0b2 [list load [file join $dir tcldde14.dll] dde]
 }
diff --git a/tests/winDde.test b/tests/winDde.test
index 8d9bd12..9411c92 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -20,7 +20,7 @@ testConstraint dde 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::ddever [package require dde 1.4.0b1]
+	    set ::ddever [package require dde 1.4.0b2]
 	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
 	testConstraint dde 1
     }
@@ -104,7 +104,7 @@ proc createChildProcess {ddeServerName args} {
 # -------------------------------------------------------------------------
 test winDde-1.0 {check if we are testing the right dll} {win dde} {
     set ::ddever
-} {1.4.0b1}
+} {1.4.0b2}
 
 test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
     list [dde servername foobar] [dde servername] [dde servername self]
@@ -203,8 +203,8 @@ test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
     set \xe1 ""
     set name ch\xEDld-4.3
     set child [createChildProcess $name]
-    dde execute TclEval $name [list set a foo]
-    set \xe1 [dde request TclEval $name a]
+    dde execute TclEval $name [list set \xe1 foo]
+    set \xe1 [dde request TclEval $name \xe1]
     dde execute TclEval $name {set done 1}
     update
     set \xe1
diff --git a/win/Makefile.in b/win/Makefile.in
index bef71c0..b616737 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -701,14 +701,14 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
 	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
-	package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+	package ifneeded dde 1.4.0b2 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
 	package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
 
 # Useful target to launch a built tclsh with the proper path,...
 runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
-	package ifneeded dde 1.4.0b1 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
+	package ifneeded dde 1.4.0b2 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
 	package ifneeded registry 1.3.0 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
 
 # This target can be used to run tclsh from the build directory via
diff --git a/win/makefile.vc b/win/makefile.vc
index ba5b710..d097e26 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -578,13 +578,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32)
 	set TCL_LIBRARY=$(ROOT:\=/)/library
 !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
 	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
-		package ifneeded dde 1.4.0b1 [list load "$(TCLDDELIB:\=/)" dde]
+		package ifneeded dde 1.4.0b2 [list load "$(TCLDDELIB:\=/)" dde]
 		package ifneeded registry 1.3.0 [list load "$(TCLREGLIB:\=/)" registry]
 <<
 !else
 	@echo Please wait while the tests are collected...
 	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
-		package ifneeded dde 1.4.0b1 "$(TCLDDELIB:\=/)" dde]
+		package ifneeded dde 1.4.0b2 "$(TCLDDELIB:\=/)" dde]
 		package ifneeded registry 1.3.0 "$(TCLREGLIB:\=/)" registry]
 <<
 	type tests.log | more
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 23b3a8e..f5c0484 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -17,13 +17,7 @@
 #include <dde.h>
 #include <ddeml.h>
 
-#ifdef UNICODE
-#   if !defined(NDEBUG)
-	/* test POKE server Implemented for UNICODE in debug mode only */
-#	undef CBF_FAIL_POKES
-#	define CBF_FAIL_POKES 0
-#   endif
-#else
+#ifndef UNICODE
 #   undef CP_WINUNICODE
 #   define CP_WINUNICODE CP_WINANSI
 #   undef Tcl_WinTCharToUtf
@@ -32,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
@@ -96,7 +96,7 @@ static DWORD ddeInstance;	/* The application instance handle given to us
 				 * by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION		"1.4.0b1"
+#define TCL_DDE_VERSION		"1.4.0b2"
 #define TCL_DDE_PACKAGE_NAME	"dde"
 #define TCL_DDE_SERVICE_NAME	TEXT("TclEval")
 #define TCL_DDE_EXECUTE_RESULT	TEXT("$TCLEVAL$EXECUTE$RESULT")
@@ -756,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);
@@ -777,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,
@@ -1494,15 +1494,15 @@ DdeObjCmd(
 
     case DDE_EXECUTE: {
 	int dataLength;
-	const char *dataString;
+	const Tcl_UniChar *dataString;
 
 	if (flags & DDE_FLAG_BINARY) {
-	    dataString = (const char *)
+	    dataString = (const Tcl_UniChar *)
 		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
 	} else {
 	    dataString =
-		    Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
-	    dataLength += 1;
+		    Tcl_GetUnicodeFromObj(objv[firstArg + 2], &dataLength);
+	    dataLength = (dataLength + 1) * sizeof(Tcl_UniChar);
 	}
 
 	if (dataLength <= 0) {
@@ -1523,15 +1523,15 @@ DdeObjCmd(
 	}
 
 	ddeData = DdeCreateDataHandle(ddeInstance, (BYTE *) dataString,
-		(DWORD) dataLength, 0, 0, CF_TEXT, 0);
+		(DWORD) dataLength, 0, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, 0);
 	if (ddeData != NULL) {
 	    if (flags & DDE_FLAG_ASYNC) {
 		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
-			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+			(flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
 		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
 	    } else {
 		ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
-			hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+			hConv, 0, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
 		if (ddeReturn == 0) {
 		    SetDdeError(interp);
 		    result = TCL_ERROR;
@@ -1573,22 +1573,23 @@ DdeObjCmd(
 		    CP_WINUNICODE);
 	    if (ddeItem != NULL) {
 		ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
-			CF_TEXT, XTYP_REQUEST, 5000, NULL);
+			(flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_REQUEST, 5000, NULL);
 		if (ddeData == NULL) {
 		    SetDdeError(interp);
 		    result = TCL_ERROR;
 		} else {
 		    DWORD tmp;
-		    const char *dataString = (const char *) DdeAccessData(ddeData, &tmp);
+		    const Tcl_UniChar *dataString = (const Tcl_UniChar *) DdeAccessData(ddeData, &tmp);
 
 		    if (flags & DDE_FLAG_BINARY) {
 			returnObjPtr =
 				Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
 		    } else {
-			if (tmp && !dataString[tmp-1]) {
+			tmp >>= 1;
+			if (tmp && !dataString[(tmp-1)]) {
 			    --tmp;
 			}
-			returnObjPtr = Tcl_NewStringObj(dataString,
+			returnObjPtr = Tcl_NewUnicodeObj(dataString,
 				(int) tmp);
 		    }
 		    DdeUnaccessData(ddeData);
@@ -1625,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);
@@ -1641,7 +1642,7 @@ DdeObjCmd(
 		    CP_WINUNICODE);
 	    if (ddeItem != NULL) {
 		ddeData = DdeClientTransaction(dataString, (DWORD) length,
-			hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
+			hConv, ddeItem, (flags & DDE_FLAG_BINARY) ? CF_TEXT : CF_UNICODETEXT, XTYP_POKE, 5000, NULL);
 		if (ddeData == NULL) {
 		    SetDdeError(interp);
 		    result = TCL_ERROR;
@@ -1784,24 +1785,24 @@ DdeObjCmd(
 	    }
 
 	    objPtr = Tcl_ConcatObj(objc, objv);
-	    string = Tcl_GetStringFromObj(objPtr, &length);
+	    string = (const char *) Tcl_GetUnicodeFromObj(objPtr, &length);
 	    ddeItemData = DdeCreateDataHandle(ddeInstance,
-		    (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
+		    (BYTE *) string, (DWORD) 2*length+2, 0, 0, CF_UNICODETEXT, 0);
 
 	    if (flags & DDE_FLAG_ASYNC) {
 		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
 			0xFFFFFFFF, hConv, 0,
-			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
+			CF_UNICODETEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
 		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
 	    } else {
 		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
 			0xFFFFFFFF, hConv, 0,
-			CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+			CF_UNICODETEXT, XTYP_EXECUTE, 30000, NULL);
 		if (ddeData != 0) {
 		    ddeCookie = DdeCreateStringHandle(ddeInstance,
 			    TCL_DDE_EXECUTE_RESULT, CP_WINUNICODE);
 		    ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
-			    CF_TEXT, XTYP_REQUEST, 30000, NULL);
+			    CF_UNICODETEXT, XTYP_REQUEST, 30000, NULL);
 		}
 	    }
 
@@ -1815,6 +1816,7 @@ DdeObjCmd(
 
 	    if (!(flags & DDE_FLAG_ASYNC)) {
 		Tcl_Obj *resultPtr;
+		Tcl_UniChar *ddeDataString;
 
 		/*
 		 * The return handle has a two or four element list in it. The
@@ -1827,10 +1829,11 @@ DdeObjCmd(
 
 		resultPtr = Tcl_NewObj();
 		length = DdeGetData(ddeData, NULL, 0, 0);
-		Tcl_SetObjLength(resultPtr, (length + 1) * sizeof(TCHAR) - 1);
-		string = Tcl_GetString(resultPtr);
-		DdeGetData(ddeData, (BYTE *) string, (DWORD) length, 0);
-		Tcl_SetObjLength(resultPtr, (int) strlen(string));
+		ddeDataString = ckalloc(length);
+		DdeGetData(ddeData, (BYTE *) ddeDataString, (DWORD) length, 0);
+		length = (length >> 1) - 1;
+		resultPtr = Tcl_NewUnicodeObj(ddeDataString, length);
+		ckfree(ddeDataString);
 
 		if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
 		    Tcl_DecrRefCount(resultPtr);