diff options
| -rw-r--r-- | doc/dde.n | 15 | ||||
| -rw-r--r-- | library/dde/pkgIndex.tcl | 4 | ||||
| -rw-r--r-- | tests/winDde.test | 16 | ||||
| -rw-r--r-- | win/Makefile.in | 4 | ||||
| -rw-r--r-- | win/makefile.vc | 4 | ||||
| -rw-r--r-- | win/tclWinDde.c | 47 |
6 files changed, 49 insertions, 41 deletions
@@ -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 ?\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..4cf73d0 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.0 [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.0 [list load [file join $dir tcldde14.dll] dde] } diff --git a/tests/winDde.test b/tests/winDde.test index 01fb54c..5bcf6c2 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -19,7 +19,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.0] set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} { testConstraint dde 1 } @@ -103,7 +103,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.0} test winDde-1.1 {Settings the server's topic name} -constraints dde -body { list [dde servername foobar] [dde servername] [dde servername self] @@ -162,9 +162,9 @@ test winDde-3.6 {DDE request utf8} -constraints dde -body { # Set variable a to A with diaeresis (unicode C4) using binary execute # and compose utf-8 (e.g. "c3 84" ) manualy test winDde-3.7 {DDE request binary} -constraints dde -body { - set a "not set" - dde execute -binary TclEval self [list set a \xc3\x84\x00] - scan $a %c + set \xe1 "not set" + dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00] + scan [set \xe1] %c } -result 196 # ------------------------------------------------------------------------- @@ -192,8 +192,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 @@ -202,7 +202,7 @@ test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body { set \xe1 "" set name ch\xEDld-4.4 set child [createChildProcess $name] - set \xe1 [dde eval $name set a foo] + set \xe1 [dde eval $name set \xe1 foo] dde execute TclEval $name {set done 1} update set \xe1 diff --git a/win/Makefile.in b/win/Makefile.in index 84dcaf7..aa5558b 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -697,14 +697,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.0 [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.0 [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..2784140 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.0 [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.0 "$(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 1cd6c46..b3c8326 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -90,7 +90,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.0" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME TEXT("TclEval") #define TCL_DDE_EXECUTE_RESULT TEXT("$TCLEVAL$EXECUTE$RESULT") @@ -1432,15 +1432,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) { @@ -1461,15 +1461,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; @@ -1511,22 +1511,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); @@ -1579,7 +1580,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; @@ -1722,24 +1723,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); } } @@ -1753,6 +1754,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 @@ -1765,10 +1767,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); |