TIP #106: Add Encoding Abilities to the [dde] Command

FossilOrigin-Name: caff0b1e8741bc09a96e3813536f7bbc8a0a8f77

10 files changed, 123 insertions, 57 deletions

diff --git a/ChangeLog b/ChangeLog
index 842695f..e981b2b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2012-05-21  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* win/tclWinDde.c:      TIP #106: Add Encoding Abilities to the [dde]
+	* library/dde/pkgIndex.tcl:   Command. Dde version is now 1.4.0.
+	* tests/winDde.test:
+	* doc/dde.n:
+
 2012-05-20  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
diff --git a/doc/dde.n b/doc/dde.n
index a02c582..60dd058 100644
--- a/doc/dde.n
+++ b/doc/dde.n
@@ -17,9 +17,11 @@ dde \- Execute a Dynamic Data Exchange command
 .sp
 \fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
 .sp
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+.VS 8.6
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
 .sp
-\fBdde poke\fR \fIservice topic item data\fR
+\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
+.VE 8.6
 .sp
 \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
 .sp
@@ -69,7 +71,7 @@ procedure is called with all the arguments provided by the remote
 call.
 .RE
 .TP
-\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
+\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
 .
 \fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
 by \fIservice\fR with the topic indicated by \fItopic\fR. Typically,
@@ -80,8 +82,13 @@ script is run in the application.  The \fB\-async\fR option requests
 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.
+.VE 8.6
 .TP
-\fBdde poke \fIservice topic item data\fR
+\fBdde poke ?\fB\-binary\fR? \fIservice topic item data\fR
 .
 \fBdde poke\fR passes the \fIdata\fR to the server indicated by
 \fIservice\fR using the \fItopic\fR and \fIitem\fR specified.  Typically,
@@ -90,6 +97,10 @@ specific but can be a command to the server or the name of a file to work
 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.
+.VE 8.6
 .TP
 \fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
 .
@@ -168,3 +179,6 @@ package require dde
 tk(n), winfo(n), send(n)
 .SH KEYWORDS
 application, dde, name, remote execution
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index ce92028..5b4eae9 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
 if {![package vsatisfies [package provide Tcl] 8.5]} return
 if {[string compare [info sharedlibextension] .dll]} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded dde 1.3.3 [list load [file join $dir tcldde13g.dll] dde]
+    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
 } else {
-    package ifneeded dde 1.3.3 [list load [file join $dir tcldde13.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 ca50a96..bc64a24 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -156,6 +156,20 @@ test winDde-3.5 {DDE request locally} {win dde} {
     dde execute TclEval self {set a "foo"}
     dde request -binary TclEval self a
 } "foo\x00"
+# Set variable a to A with diaeresis (unicode C4) by relying on the fact
+# that utf8 is sent (e.g. "c3 84" on the wire)
+test winDde-3.6 {DDE request utf8} {win dde} {
+    set a "not set"
+    dde execute TclEval self "set a \xc4"
+    scan $a %c
+} 196
+# 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} {win dde} {
+    set a "not set"
+    dde execute -binary TclEval self "set a \xc3\x84\x00"
+    scan $a %c
+} 196
 
 # -------------------------------------------------------------------------
 
@@ -202,13 +216,13 @@ test winDde-4.4 {DDE eval remotely} {stdio win dde} {
 
 test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
     dde execute "" "" ""
 } -returnCodes error -result {cannot execute null data}
 test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
     dde execute -foo "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
 test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
     dde eval "" "foo"
 } -returnCodes error -result {invalid service name ""}
diff --git a/win/Makefile.in b/win/Makefile.in
index 8492b8f..111f455 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -606,23 +606,23 @@ install-binaries: binaries
 	    done
 	@if [ -f $(DDE_DLL_FILE) ]; then \
 	    echo installing $(DDE_DLL_FILE); \
-	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
-		$(LIB_INSTALL_DIR)/dde1.3; \
+		$(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    fi
 	@if [ -f $(DDE_LIB_FILE) ]; then \
 	    echo installing $(DDE_LIB_FILE); \
-	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
 	    fi
 	@if [ -f $(REG_DLL_FILE) ]; then \
 	    echo installing $(REG_DLL_FILE); \
-	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
-		$(LIB_INSTALL_DIR)/reg1.3; \
+		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    fi
 	@if [ -f $(REG_LIB_FILE) ]; then \
 	    echo installing $(REG_LIB_FILE); \
-	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg1.3; \
+	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    fi
 
 install-libraries: libraries install-tzdata install-msgs
diff --git a/win/configure b/win/configure
index 5edf012..fed0959 100755
--- a/win/configure
+++ b/win/configure
@@ -1314,9 +1314,9 @@ TCL_MINOR_VERSION=6
 TCL_PATCH_LEVEL="b2"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=4
 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
 
 TCL_REG_VERSION=1.3
diff --git a/win/configure.in b/win/configure.in
index f4e10ee..2377938 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -17,9 +17,9 @@ TCL_MINOR_VERSION=6
 TCL_PATCH_LEVEL="b2"
 VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
 
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.4
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=4
 DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
 
 TCL_REG_VERSION=1.3
diff --git a/win/makefile.bc b/win/makefile.bc
index 338205e..d17c624 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -126,8 +126,8 @@ STUBPREFIX	= $(NAMEPREFIX)stub
 DOTVERSION	= 8.6
 VERSION		= 86
 
-DDEVERSION = 13
-DDEDOTVERSION = 1.3
+DDEVERSION = 14
+DDEDOTVERSION = 1.4
 
 REGVERSION = 13
 REGDOTVERSION = 1.3
diff --git a/win/makefile.vc b/win/makefile.vc
index bc16584..96ae7f6 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -186,7 +186,7 @@ STUBPREFIX      = $(PROJECT)stub
 DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
 VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
 
-DDEDOTVERSION = 1.3
+DDEDOTVERSION = 1.4
 DDEVERSION = $(DDEDOTVERSION:.=)
 
 REGDOTVERSION = 1.3
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index d508c02..895551a 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -88,7 +88,7 @@ static DWORD ddeInstance;	/* The application instance handle given to us
 				 * by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION		"1.3.3"
+#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")
@@ -1184,13 +1184,19 @@ DdeObjCmd(
 	DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
     };
     static const char *const ddeExecOptions[] = {
-	"-async", NULL
+	"-async", "-binary", NULL
+    };
+    enum DdeExecOptions {
+        DDE_EXEC_ASYNC, DDE_EXEC_BINARY
+    };
+    static const char *const ddePokeOptions[] = {
+	"-binary", NULL
     };
     static const char *const ddeReqOptions[] = {
 	"-binary", NULL
     };
 
-    int index, i, length;
+    int index, i, length, argIndex;
     int async = 0, binary = 0, exact = 0;
     int result = TCL_OK, firstArg = 0;
     HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
@@ -1218,7 +1224,6 @@ DdeObjCmd(
     switch ((enum DdeSubcommands) index) {
     case DDE_SERVERNAME:
 	for (i = 2; i < objc; i++) {
-	    int argIndex;
 	    if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
 		    "option", 0, &argIndex) != TCL_OK) {
 		/*
@@ -1265,39 +1270,53 @@ DdeObjCmd(
 	if (objc == 5) {
 	    firstArg = 2;
 	    break;
-	} else if (objc == 6) {
-	    int dummy;
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
-		    &dummy) == TCL_OK) {
-		async = 1;
-		firstArg = 3;
-		break;
+	} else if (objc >= 6 && objc <= 7) {
+	    firstArg = objc - 3;
+	    for (i = 2; i < firstArg; i++) {
+		if (Tcl_GetIndexFromObj(interp, objv[i], ddeExecOptions,
+			"option", 0, &argIndex) != TCL_OK) {
+		    goto wrongDdeExecuteArgs;
+		}
+		if (argIndex == DDE_EXEC_ASYNC) {
+		    async = 1;
+		} else {
+		    binary = 1;
+		}
 	    }
+	    break;
 	}
 	/* otherwise... */
+    wrongDdeExecuteArgs:
 	Tcl_WrongNumArgs(interp, 2, objv,
-		"?-async? serviceName topicName value");
+		"?-async? ?-binary? serviceName topicName value");
 	return TCL_ERROR;
     case DDE_POKE:
-	if (objc != 6) {
-	    Tcl_WrongNumArgs(interp, 2, objv,
-		    "serviceName topicName item value");
-	    return TCL_ERROR;
+	if (objc == 6) {
+	    firstArg = 2;
+	    break;
+	} else if ((objc == 7) && (Tcl_GetIndexFromObj(NULL, objv[2],
+		ddePokeOptions, "option", 0, &argIndex) == TCL_OK)) {
+	    binary = 1;
+	    firstArg = 3;
+	    break;
 	}
-	firstArg = 2;
-	break;
+
+	/*
+	 * Otherwise...
+	 */
+
+	Tcl_WrongNumArgs(interp, 2, objv,
+		"serviceName ?-binary? topicName item value");
+	return TCL_ERROR;
     case DDE_REQUEST:
 	if (objc == 5) {
 	    firstArg = 2;
 	    break;
-	} else if (objc == 6) {
-	    int dummy;
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
-		    &dummy) == TCL_OK) {
-		binary = 1;
-		firstArg = 3;
-		break;
-	    }
+	} else if ((objc == 6) && (Tcl_GetIndexFromObj(NULL, objv[2],
+		ddeReqOptions, "option", 0, &argIndex) == TCL_OK)) {
+	    binary = 1;
+	    firstArg = 3;
+	    break;
 	}
 
 	/*
@@ -1320,11 +1339,9 @@ DdeObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args");
 	    return TCL_ERROR;
 	} else {
-	    int dummy;
-
 	    firstArg = 2;
 	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option",
-		    0, &dummy) == TCL_OK) {
+		    0, &argIndex) == TCL_OK) {
 		if (objc < 5) {
 		    goto wrongDdeEvalArgs;
 		}
@@ -1373,10 +1390,18 @@ DdeObjCmd(
 
     case DDE_EXECUTE: {
 	int dataLength;
-	BYTE *dataString = (BYTE *) Tcl_GetStringFromObj(
-		objv[firstArg + 2], &dataLength);
+	BYTE *dataString;
+
+	if (binary) {
+	    dataString = (BYTE *)
+		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
+	} else {
+	    dataString = (BYTE *)
+		    Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+	    dataLength += 1;
+	}
 
-	if (dataLength == 0) {
+	if (dataLength <= (binary ? 0 : sizeof(TCHAR))) {
 	    Tcl_SetObjResult(interp,
 		    Tcl_NewStringObj("cannot execute null data", -1));
 	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
@@ -1394,7 +1419,7 @@ DdeObjCmd(
 	}
 
 	ddeData = DdeCreateDataHandle(ddeInstance, dataString,
-		(DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
+		(DWORD) dataLength, 0, 0, CF_TEXT, 0);
 	if (ddeData != NULL) {
 	    if (async) {
 		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
@@ -1481,8 +1506,14 @@ DdeObjCmd(
 	    result = TCL_ERROR;
 	    goto cleanup;
 	}
-	dataString = (BYTE *) Tcl_GetStringFromObj(objv[firstArg + 3],
-		&length);
+	if (binary) {
+	    dataString = (BYTE *)
+		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
+	} else {
+	    dataString = (BYTE *)
+		    Tcl_GetStringFromObj(objv[firstArg + 3], &length);
+	    length += 1;
+	}
 
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
 	DdeFreeStringHandle(ddeInstance, ddeService);
@@ -1495,7 +1526,7 @@ DdeObjCmd(
 	    ddeItem = DdeCreateStringHandle(ddeInstance, (void *) itemString,
 		    CP_WINUNICODE);
 	    if (ddeItem != NULL) {
-		ddeData = DdeClientTransaction(dataString, (DWORD) length+1,
+		ddeData = DdeClientTransaction(dataString, (DWORD) length,
 			hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
 		if (ddeData == NULL) {
 		    SetDdeError(interp);