diff options
| -rw-r--r-- | doc/dde.n | 67 | ||||
| -rw-r--r-- | tests/winDde.test | 32 | ||||
| -rw-r--r-- | win/tclWinDde.c | 141 |
3 files changed, 140 insertions, 100 deletions
@@ -1,24 +1,33 @@ '\" '\" Copyright (c) 1997 Sun Microsystems, Inc. +'\" Copyright (c) 2001 ActiveState Corporation. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: dde.n,v 1.6 2000/09/07 14:27:47 poenitz Exp $ +'\" RCS: @(#) $Id: dde.n,v 1.7 2001/08/22 23:56:14 hobbs Exp $ '\" .so man.macros -.TH dde n 8.1 Tcl "Tcl Built-In Commands" +.TH dde n 8.4 Tcl "Tcl Built-In Commands" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME dde \- Execute a Dynamic Data Exchange command .SH SYNOPSIS .sp -\fBpackage require dde 1.1\fR +\fBpackage require dde 1.2\fR .sp -\fBdde \fIservername \fR?\fItopic\fR? +\fBdde \fIservername\fR ?\fItopic\fR? .sp -\fBdde ?\-async?\fR \fIcommand service topic \fR?\fIdata\fR? +\fBdde \fIexecute\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? +.sp +\fBdde \fIpoke\fR \fIservice topic item data\fR +.sp +\fBdde \fIrequest\fR ?\fI\-binary\fR? \fIservice topic \fR?\fIdata\fR? +.sp +\fBdde \fIservices\fR \fIservice topic \fR?\fIdata\fR? +.sp +\fBdde \fIeval\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? .BE .SH DESCRIPTION @@ -33,14 +42,9 @@ interpreter given by \fBdde servername\fR. Other applications have their own \fIservice names\fR and \fItopics\fR. For instance, Microsoft Excel has the service name \fBExcel\fR. .PP -The only option to the \fBdde\fR command is: +The \fBeval\fR and \fBexecute\fR commands accept the option \fB\-async\fR: .TP -\fB\-async\fR -Requests asynchronous invocation. This is valid only for the -\fBexecute\fR subcommand. Normally, the \fBdde execute\fR subcommand -waits until the command completes, returning appropriate error -messages. When the \fB\-async\fR option is used, the command returns -immediately, and no error information is available. + .SH "DDE COMMANDS" .PP The following commands are a subset of the full Dynamic Data Exchange @@ -52,16 +56,16 @@ the service name \fBTclEval\fR and the topic name specified by \fItopic\fR. If no \fItopic\fR is given, \fBdde servername\fR returns the name of the current topic or the empty string if it is not registered as a service. .TP -\fBdde execute \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, \fIservice\fR is the name of an application, -and \fItopic\fR is a file to work on. The \fIdata\fR field is given -to the remote application. Typically, the application treats the -\fIdata\fR field as a script, and the script is run in the -application. The command returns an error if the script did not -run. If the \fB\-async\fR flag was used, the command -returns immediately with no error. +\fBdde execute\fR ?\fI\-async\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, +\fIservice\fR is the name of an application, and \fItopic\fR is a file to +work on. The \fIdata\fR field is given to the remote application. +Typically, the application treats the \fIdata\fR field as a script, and the +script is run in the application. The \fI\-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. .TP \fBdde poke \fIservice topic item data\fR \fBdde poke\fR passes the \fIdata\fR to the server indicated by @@ -72,13 +76,15 @@ 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. .TP -\fBdde request \fIservice topic item\fR +\fBdde request\fR ?\fI\-binary\fR? \fIservice topic item\fR \fBdde request\fR is typically used to get the value of something; the value of a cell in Microsoft Excel or the text of a selection in Microsoft Word. \fIservice\fR is typically the name of an application, \fItopic\fR is typically the name of the file, and \fIitem\fR is application-specific. The command returns the value of \fIitem\fR as -defined in the application. +defined in the application. Normally this is interpreted to be a +string with terminating null. If \fI\-binary\fR is specified, the +result is returned as a byte array. .TP \fBdde services \fIservice topic\fR \fBdde services\fR returns a list of service-topic pairs that @@ -91,11 +97,14 @@ for a given service are returned. If both are not null, if that service-topic pair currently exists, it is returned; otherwise, null is returned. .TP -\fBdde eval \fItopic cmd \fR?\fIarg arg ...\fR? -\fBdde eval\fR evaluates a command and its arguments using the -interpreter specified by \fItopic\fR. The DDE service must be the -\fBTclEval\fR service. This command can be used to replace send on -Windows. +\fBdde eval\fR ?\fI\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? +\fBdde eval\fR evaluates a command and its arguments using the interpreter +specified by \fItopic\fR. The DDE service must be the \fBTclEval\fR +service. The \fI\-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. This command can be used to replace send on Windows. + .SH "DDE AND TCL" A Tcl interpreter always has a service name of \fBTclEval\fR. Each different interpreter of all running Tcl applications must be diff --git a/tests/winDde.test b/tests/winDde.test index 3657d43..5afae757 100644 --- a/tests/winDde.test +++ b/tests/winDde.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: winDde.test,v 1.10 2001/07/31 19:12:07 vincentdarley Exp $ +# RCS: @(#) $Id: winDde.test,v 1.11 2001/08/22 23:56:14 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -22,7 +22,7 @@ if {$tcl_platform(platform) == "windows"} { [info nameofexecutable]]] tcldde*.dll] 0] load $lib dde }] { - puts "Unable to find the dde package. Skipping dde tests." + puts "WARNING: Unable to find the dde package. Skipping dde tests." ::tcltest::cleanupTests return } @@ -30,16 +30,19 @@ if {$tcl_platform(platform) == "windows"} { set scriptName script1.tcl - proc createChildProcess { ddeServerName } { - file delete -force $::scriptName - + set f [open $::scriptName w+] puts $f { + if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* + } if [catch { - set lib [lindex [glob -directory [file join [pwd] [file dirname \ - [info nameofexecutable]]] tcldde*.dll] 0] + set lib [lindex [glob -directory \ + [file join [pwd] [file dirname [info nameofexecutable]]] \ + tcldde*.dll] 0] load $lib dde }] { puts "Unable to find the dde package. Skipping dde tests." @@ -47,7 +50,7 @@ proc createChildProcess { ddeServerName } { return } } - puts $f "dde servername $ddeServerName" + puts $f [list dde servername $ddeServerName] puts $f { puts ready vwait done @@ -103,11 +106,16 @@ test winDde-3.4 {DDE eval locally} {pcOnly} { dde eval self set a "foo" } foo +test winDde-3.5 {DDE request locally} {pcOnly} { + set a "" + dde execute TclEval self {set a "foo"} + dde request -binary TclEval self a +} "foo\x00" + test winDde-4.1 {DDE execute remotely} {pcOnly} { set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} - dde execute TclEval child {set done 1} set a @@ -117,7 +125,6 @@ test winDde-4.2 {DDE execute remotely} {pcOnly} { set a "" set child [createChildProcess child] dde execute -async TclEval child {set a "foo"} - dde execute TclEval child {set done 1} set a @@ -128,8 +135,6 @@ test winDde-4.3 {DDE request locally} {pcOnly} { set child [createChildProcess child] dde execute TclEval child {set a "foo"} set a [dde request TclEval child a] - - dde execute TclEval child {set done 1} set a @@ -139,7 +144,6 @@ test winDde-4.4 {DDE eval locally} {pcOnly} { set a "" set child [createChildProcess child] set a [dde eval child set a "foo"] - dde execute TclEval child {set done 1} set a @@ -160,9 +164,7 @@ test winDde-5.3 {check for bad arguments} {pcOnly} { set result } {wrong # args: should be "dde execute ?-async? serviceName topicName value"} - #cleanup file delete -force $::scriptName ::tcltest::cleanupTests return - diff --git a/win/tclWinDde.c b/win/tclWinDde.c index d406db4..04a306f 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinDde.c,v 1.6 2000/06/13 20:30:23 ericm Exp $ + * RCS: @(#) $Id: tclWinDde.c,v 1.7 2001/08/22 23:56:14 hobbs Exp $ */ #include "tclPort.h" @@ -69,7 +69,7 @@ static DWORD ddeInstance; /* The application instance handle given * to us by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.1" +#define TCL_DDE_VERSION "1.2" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME "TclEval" @@ -838,8 +838,9 @@ Tcl_DdeObjCmd( "request", "services", "eval", (char *) NULL}; static char *ddeOptions[] = {"-async", (char *) NULL}; + static char *ddeReqOptions[] = {"-binary", (char *) NULL}; int index, argIndex; - int async = 0; + int async = 0, binary = 0; int result = TCL_OK; HSZ ddeService = NULL; HSZ ddeTopic = NULL; @@ -876,8 +877,7 @@ Tcl_DdeObjCmd( switch (index) { case DDE_SERVERNAME: if ((objc != 3) && (objc != 2)) { - Tcl_WrongNumArgs(interp, 1, objv, - "servername ?serverName?"); + Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?"); return TCL_ERROR; } firstArg = (objc - 1); @@ -916,12 +916,29 @@ Tcl_DdeObjCmd( firstArg = 2; break; case DDE_REQUEST: - if (objc != 5) { + if ((objc < 5) || (objc > 6)) { Tcl_WrongNumArgs(interp, 1, objv, - "request serviceName topicName value"); + "request ?-binary? serviceName topicName value"); return TCL_ERROR; } - firstArg = 2; + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, + &argIndex) != TCL_OK) { + if (objc != 5) { + Tcl_WrongNumArgs(interp, 1, objv, + "request ?-binary? serviceName topicName value"); + return TCL_ERROR; + } + binary = 0; + firstArg = 2; + } else { + if (objc != 6) { + Tcl_WrongNumArgs(interp, 1, objv, + "request ?-binary? serviceName topicName value"); + return TCL_ERROR; + } + binary = 1; + firstArg = 3; + } break; case DDE_SERVICES: if (objc != 4) { @@ -1002,10 +1019,9 @@ Tcl_DdeObjCmd( result = TCL_ERROR; break; } - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, - NULL); - DdeFreeStringHandle (ddeInstance, ddeService) ; - DdeFreeStringHandle (ddeInstance, ddeTopic) ; + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); @@ -1020,7 +1036,7 @@ Tcl_DdeObjCmd( DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, - ddeResult); + ddeResult); } else { ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); @@ -1044,8 +1060,8 @@ Tcl_DdeObjCmd( return TCL_ERROR; } hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle (ddeInstance, ddeService) ; - DdeFreeStringHandle (ddeInstance, ddeTopic) ; + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); @@ -1062,7 +1078,12 @@ Tcl_DdeObjCmd( result = TCL_ERROR; } else { dataString = DdeAccessData(ddeData, &dataLength); - returnObjPtr = Tcl_NewStringObj(dataString, -1); + if (binary) { + returnObjPtr = Tcl_NewByteArrayObj(dataString, + dataLength); + } else { + returnObjPtr = Tcl_NewStringObj(dataString, -1); + } DdeUnaccessData(ddeData); DdeFreeDataHandle(ddeData); Tcl_SetObjResult(interp, returnObjPtr); @@ -1085,19 +1106,18 @@ Tcl_DdeObjCmd( dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length); hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle (ddeInstance,ddeService) ; - DdeFreeStringHandle (ddeInstance, ddeTopic) ; + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); if (hConv == NULL) { SetDdeError(interp); result = TCL_ERROR; } else { - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \ + ddeItem = DdeCreateStringHandle(ddeInstance, itemString, CP_WINANSI); if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString,length+1, \ - hConv, ddeItem, - CF_TEXT, XTYP_POKE, 5000, NULL); + ddeData = DdeClientTransaction(dataString,length+1, + hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); if (ddeData == NULL) { SetDdeError(interp); result = TCL_ERROR; @@ -1120,8 +1140,8 @@ Tcl_DdeObjCmd( convInfo.cb = sizeof(CONVINFO); hConvList = DdeConnectList(ddeInstance, ddeService, ddeTopic, 0, NULL); - DdeFreeStringHandle (ddeInstance,ddeService) ; - DdeFreeStringHandle (ddeInstance, ddeTopic) ; + DdeFreeStringHandle(ddeInstance,ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); hConv = 0; convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); Tcl_DStringInit(&dString); @@ -1145,7 +1165,8 @@ Tcl_DdeObjCmd( length + 1, CP_WINANSI); Tcl_ListObjAppendElement(interp, elementObjPtr, Tcl_NewStringObj(name, length)); - Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr); + Tcl_ListObjAppendElement(interp, convListObjPtr, + elementObjPtr); } DdeDisconnectList(hConvList); Tcl_SetObjResult(interp, convListObjPtr); @@ -1166,13 +1187,13 @@ Tcl_DdeObjCmd( * deallocated objects. */ - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr - = riPtr->nextPtr) { + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + riPtr = riPtr->nextPtr) { if (stricmp(serviceName, riPtr->name) == 0) { break; } } - + if (riPtr != NULL) { /* * This command is to a local interp. No need to go through @@ -1184,26 +1205,29 @@ Tcl_DdeObjCmd( Tcl_Preserve((ClientData) sendInterp); /* - * Don't exchange objects between interps. The target interp would - * compile an object, producing a bytecode structure that refers to - * other objects owned by the target interp. If the target interp - * is then deleted, the bytecode structure would be referring to - * deallocated objects. + * Don't exchange objects between interps. The target interp + * would compile an object, producing a bytecode structure that + * refers to other objects owned by the target interp. If the + * target interp is then deleted, the bytecode structure would + * be referring to deallocated objects. */ if (objc == 1) { - result = Tcl_EvalObjEx(sendInterp, objv[0], TCL_EVAL_GLOBAL); + result = Tcl_EvalObjEx(sendInterp, objv[0], + TCL_EVAL_GLOBAL); } else { objPtr = Tcl_ConcatObj(objc, objv); Tcl_IncrRefCount(objPtr); - result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL); + result = Tcl_EvalObjEx(sendInterp, objPtr, + TCL_EVAL_GLOBAL); Tcl_DecrRefCount(objPtr); } if (interp != sendInterp) { if (result == TCL_ERROR) { /* - * An error occurred, so transfer error information from the - * destination interpreter back to our interpreter. + * An error occurred, so transfer error information + * from the destination interpreter back to our + * interpreter. */ Tcl_ResetResult(interp); @@ -1222,8 +1246,8 @@ Tcl_DdeObjCmd( Tcl_Release((ClientData) sendInterp); } else { /* - * This is a non-local request. Send the script to the server and poll - * it for a result. + * This is a non-local request. Send the script to the server + * and poll it for a result. */ if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) { @@ -1232,26 +1256,27 @@ Tcl_DdeObjCmd( objPtr = Tcl_ConcatObj(objc, objv); string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0, - CF_TEXT, 0); + ddeItemData = DdeCreateDataHandle(ddeInstance, string, + length+1, 0, 0, CF_TEXT, 0); if (async) { - ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, + ddeData = DdeClientTransaction((LPBYTE) ddeItemData, + 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult); DdeAbandonTransaction(ddeInstance, hConv, ddeResult); } else { - ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0, + ddeData = DdeClientTransaction((LPBYTE) ddeItemData, + 0xFFFFFFFF, hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); if (ddeData != 0) { ddeCookie = DdeCreateStringHandle(ddeInstance, "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI); - ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, - CF_TEXT, XTYP_REQUEST, 30000, NULL); + ddeData = DdeClientTransaction(NULL, 0, hConv, + ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL); } } - - + Tcl_DecrRefCount(objPtr); if (ddeData == 0) { @@ -1263,11 +1288,12 @@ Tcl_DdeObjCmd( Tcl_Obj *resultPtr; /* - * The return handle has a two or four element list in it. The first - * element is the return code (TCL_OK, TCL_ERROR, etc.). The - * second is the result of the script. If the return code is TCL_ERROR, - * then the third element is the value of the variable "errorCode", - * and the fourth is the value of the variable "errorInfo". + * The return handle has a two or four element list in + * it. The first element is the return code (TCL_OK, + * TCL_ERROR, etc.). The second is the result of the + * script. If the return code is TCL_ERROR, then the third + * element is the value of the variable "errorCode", and + * the fourth is the value of the variable "errorInfo". */ resultPtr = Tcl_NewObj(); @@ -1277,7 +1303,8 @@ Tcl_DdeObjCmd( DdeGetData(ddeData, string, length, 0); Tcl_SetObjLength(resultPtr, strlen(string)); - if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { + if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) + != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto error; } @@ -1287,8 +1314,9 @@ Tcl_DdeObjCmd( } if (result == TCL_ERROR) { Tcl_ResetResult(interp); - - if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) { + + if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) + != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto error; } @@ -1299,7 +1327,8 @@ Tcl_DdeObjCmd( Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); Tcl_SetObjErrorCode(interp, objPtr); } - if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) { + if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) + != TCL_OK) { Tcl_DecrRefCount(resultPtr); goto error; } |