*** 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: {
