diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | tests/winDde.test | 17 | ||||
| -rw-r--r-- | win/tclWinDde.c | 203 |
3 files changed, 182 insertions, 48 deletions
@@ -1,3 +1,13 @@ +2003-03-22 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/tclWinDde.c: Make dde services conform the the documentation + such that giving only a topic name really returns all services + with that topic. [Bug 219155] + Prevent hangup caused by dde server applications failing to process + messages [Bug 707822] + * tests/winDde.test: Corrected labels and added a test for search + by topic name. + 2003-03-20 Don Porter <dgp@users.sourceforge.net> * generic/tclInt.h (tclOriginalNotifier): diff --git a/tests/winDde.test b/tests/winDde.test index c573d58..bcf0c9b 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.13 2003/01/16 20:51:57 hobbs Exp $ +# RCS: @(#) $Id: winDde.test,v 1.14 2003/03/22 23:01:22 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -53,6 +53,7 @@ proc createChildProcess { ddeServerName } { puts $f [list dde servername $ddeServerName] puts $f { puts ready + flush stdout vwait done update exit @@ -60,7 +61,8 @@ proc createChildProcess { ddeServerName } { close $f set f [open |[list [interpreter] $::scriptName] r] - gets $f + fconfigure $f -buffering line + gets $f line return $f } @@ -82,6 +84,11 @@ test winDde-2.3 {Checking for existence, with only the service specified} \ expr [llength [dde services TclEval {}]] >= 1 } 1 +test winDde-2.4 {Checking for existence, with only the topic specified} \ + {pcOnly} { + expr [llength [dde services {} self]] >= 1 +} 1 + test winDde-3.1 {DDE execute locally} {pcOnly} { set a "" dde execute TclEval self {set a "foo"} @@ -121,7 +128,7 @@ test winDde-4.1 {DDE execute remotely} {stdio pcOnly} { set a } "" -test winDde-4.2 {DDE execute remotely} {stdio pcOnly} { +test winDde-4.2 {DDE execute async remotely} {stdio pcOnly} { set a "" set child [createChildProcess child] dde execute -async TclEval child {set a "foo"} @@ -130,7 +137,7 @@ test winDde-4.2 {DDE execute remotely} {stdio pcOnly} { set a } "" -test winDde-4.3 {DDE request locally} {stdio pcOnly} { +test winDde-4.3 {DDE request remotely} {stdio pcOnly} { set a "" set child [createChildProcess child] dde execute TclEval child {set a "foo"} @@ -140,7 +147,7 @@ test winDde-4.3 {DDE request locally} {stdio pcOnly} { set a } foo -test winDde-4.4 {DDE eval locally} {stdio pcOnly} { +test winDde-4.4 {DDE eval remotely} {stdio pcOnly} { set a "" set child [createChildProcess child] set a [dde eval child set a "foo"] diff --git a/win/tclWinDde.c b/win/tclWinDde.c index 8244b99..08298fd 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -10,12 +10,13 @@ * 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.13 2003/03/03 17:12:48 dgp Exp $ + * RCS: @(#) $Id: tclWinDde.c,v 1.14 2003/03/22 23:01:23 patthoyts Exp $ */ #include "tclPort.h" +#include <dde.h> #include <ddeml.h> - +#include <tchar.h> /* * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the * Registry_Init declaration is in the source file itself, which is only @@ -69,7 +70,7 @@ static DWORD ddeInstance; /* The application instance handle given * to us by DdeInitialize. */ static int ddeIsServer = 0; -#define TCL_DDE_VERSION "1.2.1" +#define TCL_DDE_VERSION "1.2.2" #define TCL_DDE_PACKAGE_NAME "dde" #define TCL_DDE_SERVICE_NAME "TclEval" @@ -91,6 +92,10 @@ static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, HSZ ddeItem, HDDEDATA hData, DWORD dwData1, DWORD dwData2)); static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp)); +static int DdeGetServicesList _ANSI_ARGS_(( + Tcl_Interp *interp, + char *serviceName, + char *topicName)); int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ Tcl_Interp *interp, /* The interp we are sending from */ int objc, /* Number of arguments */ @@ -755,6 +760,157 @@ MakeDdeConnection( /* *-------------------------------------------------------------- * + * DdeGetServicesList -- + * + * This procedure obtains the list of DDE services. + * + * The functions between here and this procedure are all + * involved with handling the DDE callbacks for this. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * Sets the services list into the interp result. + * + *-------------------------------------------------------------- + */ + +typedef struct ddeEnumServices { + Tcl_Interp *interp; + int result; + ATOM service; + ATOM topic; + HWND hwnd; +} ddeEnumServices; + +LRESULT CALLBACK +DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); +static LRESULT +DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); + +static int +DdeCreateClient(ddeEnumServices *es) +{ + WNDCLASSEX wc; + static const char *szDdeClientClassName = "TclEval client class"; + static const char *szDdeClientWindowName = "TclEval client window"; + + memset(&wc, 0, sizeof(wc)); + wc.cbSize = sizeof(wc); + wc.lpfnWndProc = DdeClientWindowProc; + wc.lpszClassName = szDdeClientClassName; + wc.cbWndExtra = sizeof(ddeEnumServices*); + + /* register and create the callback window */ + RegisterClassEx(&wc); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, + szDdeClientWindowName, + WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, + (LPVOID)es); + return TCL_OK; +} + +LRESULT CALLBACK +DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) +{ + LONG lr = 0L; + + switch (uMsg) { + case WM_CREATE: { + LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam; + ddeEnumServices *es; + es = (ddeEnumServices*)lpcs->lpCreateParams; + SetWindowLong(hwnd, GWL_USERDATA, (long)es); + break; + } + case WM_DDE_ACK: + lr = DdeServicesOnAck(hwnd, wParam, lParam); + break; + default: + lr = DefWindowProc(hwnd, uMsg, wParam, lParam); + } + return lr; +} + +static LRESULT +DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam) +{ + HWND hwndRemote = (HWND)wParam; + ATOM service = (ATOM)LOWORD(lParam); + ATOM topic = (ATOM)HIWORD(lParam); + ddeEnumServices *es; + TCHAR sz[255]; + + es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA); + + if ((es->service == (ATOM)NULL || es->service == service) + && (es->topic == (ATOM)NULL || es->topic == topic)) { + Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); + + GlobalGetAtomName(service, sz, 255); + Tcl_ListObjAppendElement(es->interp, matchPtr, + Tcl_NewStringObj(sz, -1)); + GlobalGetAtomName(topic, sz, 255); + Tcl_ListObjAppendElement(es->interp, matchPtr, + Tcl_NewStringObj(sz, -1)); + /* Adding the hwnd as a third list element provides a unique + * identifier in the case of multiple servers with the name + * application and topic names. + */ + /* Needs a TIP though + * Tcl_ListObjAppendElement(es->interp, matchPtr, + * Tcl_NewLongObj((long)hwndRemote)); + */ + Tcl_ListObjAppendElement(es->interp, + Tcl_GetObjResult(es->interp), matchPtr); + } + + /* tell the server we are no longer interested */ + PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L); + return 0L; +} + +static BOOL CALLBACK +DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam) +{ + DWORD dwResult = 0; + ddeEnumServices *es = (ddeEnumServices *)lParam; + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, + (WPARAM)es->hwnd, + MAKELONG(es->service, es->topic), + SMTO_ABORTIFHUNG, 1000, &dwResult); + return TRUE; +} + +static int +DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) +{ + ddeEnumServices es; + int r = TCL_OK; + es.interp = interp; + es.result = TCL_OK; + es.service = (serviceName == NULL) + ? (ATOM)NULL : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) + ? (ATOM)NULL : GlobalAddAtom(topicName); + + Tcl_ResetResult(interp); /* our list is to be appended to result. */ + DdeCreateClient(&es); + EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); + + if (IsWindow(es.hwnd)) + DestroyWindow(es.hwnd); + if (es.service != (ATOM)NULL) + GlobalDeleteAtom(es.service); + if (es.topic != (ATOM)NULL) + GlobalDeleteAtom(es.topic); + return es.result; +} + +/* + *-------------------------------------------------------------- + * * SetDdeError -- * * Sets the interp result to a cogent error message @@ -1132,46 +1288,7 @@ Tcl_DdeObjCmd( } case DDE_SERVICES: { - HCONVLIST hConvList; - CONVINFO convInfo; - Tcl_Obj *convListObjPtr, *elementObjPtr; - Tcl_DString dString; - char *name; - - convInfo.cb = sizeof(CONVINFO); - hConvList = DdeConnectList(ddeInstance, ddeService, - ddeTopic, 0, NULL); - DdeFreeStringHandle(ddeInstance,ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); - hConv = 0; - convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - Tcl_DStringInit(&dString); - - while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) { - elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - DdeQueryConvInfo(hConv, QID_SYNC, &convInfo); - length = DdeQueryString(ddeInstance, - convInfo.hszSvcPartner, NULL, 0, CP_WINANSI); - Tcl_DStringSetLength(&dString, length); - name = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, convInfo.hszSvcPartner, - name, (DWORD) length + 1, CP_WINANSI); - Tcl_ListObjAppendElement(interp, elementObjPtr, - Tcl_NewStringObj(name, length)); - length = DdeQueryString(ddeInstance, convInfo.hszTopic, - NULL, 0, CP_WINANSI); - Tcl_DStringSetLength(&dString, length); - name = Tcl_DStringValue(&dString); - DdeQueryString(ddeInstance, convInfo.hszTopic, name, - (DWORD) length + 1, CP_WINANSI); - Tcl_ListObjAppendElement(interp, elementObjPtr, - Tcl_NewStringObj(name, length)); - Tcl_ListObjAppendElement(interp, convListObjPtr, - elementObjPtr); - } - DdeDisconnectList(hConvList); - Tcl_SetObjResult(interp, convListObjPtr); - Tcl_DStringFree(&dString); + result = DdeGetServicesList(interp, serviceName, topicName); break; } case DDE_EVAL: { |