Attachment "tclWinDde.c.unique.patch" to
ticket [690354ffff]
added by
patthoyts
2003-03-11 20:59:16.
*** tclWinDde.c.orig Thu Mar 06 21:55:11 2003
--- tclWinDde.c Mon Mar 10 16:36:22 2003
***************
*** 14,21 ****
*/
#include "tclPort.h"
#include <ddeml.h>
!
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
* Registry_Init declaration is in the source file itself, which is only
--- 14,22 ----
*/
#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
***************
*** 91,96 ****
--- 92,101 ----
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 */
***************
*** 226,241 ****
static char *
DdeSetServerName(
Tcl_Interp *interp,
! char *name /* The name that will be used to
* refer to the interpreter in later
* "send" commands. Must be globally
* unique. */
)
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* See if the application is already registered; if so, remove its
--- 231,251 ----
static char *
DdeSetServerName(
Tcl_Interp *interp,
! char *name, /* The name that will be used to
* refer to the interpreter in later
* "send" commands. Must be globally
* unique. */
+ int exactName /* Should we make a unique name? 0 = yes */
)
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ char *actualName;
+ Tcl_Obj *srvListPtr = NULL;
+ Tcl_Obj **srvPtrPtr = NULL;
+ int n, srvCount = 0, lastSuffix, r = TCL_OK;
/*
* See if the application is already registered; if so, remove its
***************
*** 274,289 ****
return "";
}
! /*
! * Pick a name to use for the application. Use "name" if it's not
! * already in use. Otherwise add a suffix such as " #2", trying
! * larger and larger numbers until we eventually find one that is
! * unique.
*/
-
- suffix = 1;
- offset = 0;
Tcl_DStringInit(&dString);
/*
* We have found a unique name. Now add it to the registry.
--- 284,346 ----
return "";
}
! /*
! * Get the list of currently registered Tcl interpreters by calling
! * directly the 'dde services TclEval {}' command.
*/
Tcl_DStringInit(&dString);
+ actualName = name;
+
+ if (! exactName )
+ {
+ r = DdeGetServicesList(interp, "TclEval", NULL);
+ if (r == TCL_OK)
+ srvListPtr = Tcl_GetObjResult(interp);
+ //else
+ // srvListPtr = Tcl_NewListObj(0, NULL);
+ if (r == TCL_OK)
+ r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr);
+ if (r != TCL_OK) {
+ OutputDebugString(Tcl_GetStringResult(interp));
+ return NULL;
+ }
+
+ /*
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ offset = lastSuffix = 0;
+ suffix = 1;
+
+ while (suffix != lastSuffix) {
+ lastSuffix = suffix;
+ if (suffix > 1) {
+ if (suffix == 2) {
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
+ }
+
+ /* see if the name is already in use, if so increment suffix */
+ for (n = 0; n < srvCount; ++n) {
+ Tcl_Obj* namePtr;
+
+ Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
+ if (strcmp(actualName, Tcl_GetString(namePtr)) == 0)
+ {
+ suffix++;
+ break;
+ }
+ }
+ }
+ }
/*
* We have found a unique name. Now add it to the registry.
***************
*** 291,300 ****
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
! riPtr->name = ckalloc(strlen(name) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
tsdPtr->interpListPtr = riPtr;
! strcpy(riPtr->name, name);
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
--- 348,357 ----
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
! riPtr->name = ckalloc(strlen(actualName) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
tsdPtr->interpListPtr = riPtr;
! strcpy(riPtr->name, actualName);
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
***************
*** 755,760 ****
--- 812,1018 ----
/*
*--------------------------------------------------------------
*
+ * DdeGetServicesList --
+ *
+ * This procedure obtains the list of DDE services.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Sets the services list into the interp result.
+ *
+ *--------------------------------------------------------------
+ */
+
+ #ifdef ORIGINAL_SERVICES_CODE
+
+ static int
+ DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName)
+ {
+ HCONVLIST hConvList;
+ CONVINFO convInfo;
+ HCONV hConv = NULL;
+ HSZ ddeService = NULL, ddeTopic = NULL;
+ Tcl_Obj *convListObjPtr, *elementObjPtr;
+ Tcl_DString dString;
+ char *name;
+ int length, result = TCL_OK;
+
+ if (serviceName)
+ ddeService = DdeCreateStringHandle(ddeInstance, serviceName, CP_WINANSI);
+ if (topicName)
+ ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, CP_WINANSI);
+
+ 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);
+ return result;
+ }
+
+ #else /* ! ORIGINAL_SERVICES_CODE */
+
+ 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));
+ 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;
+ }
+
+ #endif /* ! ORIGINAL_SERVICES_CODE */
+
+ /*
+ *--------------------------------------------------------------
+ *
* SetDdeError --
*
* Sets the interp result to a cogent error message
***************
*** 833,845 ****
DDE_EVAL
};
static CONST char *ddeCommands[] = {"servername", "execute", "poke",
"request", "services", "eval",
(char *) NULL};
static CONST char *ddeOptions[] = {"-async", (char *) NULL};
static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
! int index, argIndex;
! int async = 0, binary = 0;
int result = TCL_OK;
HSZ ddeService = NULL;
HSZ ddeTopic = NULL;
--- 1091,1109 ----
DDE_EVAL
};
+ enum {
+ DDE_SERVERNAME_EXACT,
+ DDE_SERVERNAME_LAST,
+ };
+
static CONST char *ddeCommands[] = {"servername", "execute", "poke",
"request", "services", "eval",
(char *) NULL};
static CONST char *ddeOptions[] = {"-async", (char *) NULL};
static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
! static CONST char *ddeSrvOptions[] = {"-exact", "--", (char *) NULL};
! int index, argIndex, i;
! int async = 0, binary = 0, exact = 0;
int result = TCL_OK;
HSZ ddeService = NULL;
HSZ ddeTopic = NULL;
***************
*** 875,885 ****
switch (index) {
case DDE_SERVERNAME:
! if ((objc != 3) && (objc != 2)) {
! Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
return TCL_ERROR;
}
! firstArg = (objc - 1);
break;
case DDE_EXECUTE:
if ((objc < 5) || (objc > 6)) {
--- 1139,1172 ----
switch (index) {
case DDE_SERVERNAME:
! for (i = 2; i < objc; i++) {
! if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
! "option", 0, &argIndex) != TCL_OK) {
! break;
! } else if (argIndex == DDE_SERVERNAME_EXACT) {
! exact = 1;
! } else if (argIndex == DDE_SERVERNAME_LAST) {
! i++;
! break;
! } else {
! Tcl_ResetResult(interp);
! Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
! "bad option \"", Tcl_GetString(objv[i]),
! "\": must be -exact, or --",
! (char*)NULL);
! return TCL_ERROR;
! }
! }
!
! if ((objc - i) > 1) {
! Tcl_ResetResult(interp);
! Tcl_WrongNumArgs(interp, 1, objv,
! "servername ?-exact ? ?--?"
! " ?serverName?");
return TCL_ERROR;
}
!
! firstArg = (objc == i) ? 1 : i;
break;
case DDE_EXECUTE:
if ((objc < 5) || (objc > 6)) {
***************
*** 1001,1007 ****
switch (index) {
case DDE_SERVERNAME: {
! serviceName = DdeSetServerName(interp, serviceName);
if (serviceName != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
serviceName, -1);
--- 1288,1294 ----
switch (index) {
case DDE_SERVERNAME: {
! serviceName = DdeSetServerName(interp, serviceName, exact);
if (serviceName != NULL) {
Tcl_SetStringObj(Tcl_GetObjResult(interp),
serviceName, -1);
***************
*** 1132,1177 ****
}
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);
break;
}
case DDE_EVAL: {
--- 1419,1425 ----
}
case DDE_SERVICES: {
! result = DdeGetServicesList(interp, serviceName, topicName);
break;
}
case DDE_EVAL: {
