/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwindde.c
ViewVC logotype

Diff of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwindde.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclwindde.c revision 29 by dashley, Sat Oct 8 07:08:47 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclwindde.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwindde.c,v 1.1.1.1 2001/06/13 04:48:43 dtashley Exp $ */  
   
 /*  
  * tclWinDde.c --  
  *  
  *      This file provides procedures that implement the "send"  
  *      command, allowing commands to be passed from interpreter  
  *      to interpreter.  
  *  
  * Copyright (c) 1997 by Sun Microsystems, Inc.  
  *  
  * 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.1.1.1 2001/06/13 04:48:43 dtashley Exp $  
  */  
   
 #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  
  * accessed when we are building a library.  
  */  
   
 #undef TCL_STORAGE_CLASS  
 #define TCL_STORAGE_CLASS DLLEXPORT  
   
 /*  
  * The following structure is used to keep track of the interpreters  
  * registered by this process.  
  */  
   
 typedef struct RegisteredInterp {  
     struct RegisteredInterp *nextPtr;  
                                 /* The next interp this application knows  
                                  * about. */  
     char *name;                 /* Interpreter's name (malloc-ed). */  
     Tcl_Interp *interp;         /* The interpreter attached to this name. */  
 } RegisteredInterp;  
   
 /*  
  * Used to keep track of conversations.  
  */  
   
 typedef struct Conversation {  
     struct Conversation *nextPtr;  
                                 /* The next conversation in the list. */  
     RegisteredInterp *riPtr;    /* The info we know about the conversation. */  
     HCONV hConv;                /* The DDE handle for this conversation. */  
     Tcl_Obj *returnPackagePtr;  /* The result package for this conversation. */  
 } Conversation;  
   
 typedef struct ThreadSpecificData {  
     Conversation *currentConversations;  
                                 /* A list of conversations currently  
                                  * being processed. */  
     RegisteredInterp *interpListPtr;  
                                 /* List of all interpreters registered  
                                  * in the current process. */  
 } ThreadSpecificData;  
 static Tcl_ThreadDataKey dataKey;  
   
 /*  
  * The following variables cannot be placed in thread-local storage.  
  * The Mutex ddeMutex guards access to the ddeInstance.  
  */  
 static HSZ ddeServiceGlobal = 0;  
 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_PACKAGE_NAME "dde"  
 #define TCL_DDE_SERVICE_NAME "TclEval"  
   
 TCL_DECLARE_MUTEX(ddeMutex)  
   
 /*  
  * Forward declarations for procedures defined later in this file.  
  */  
   
 static void                 DdeExitProc _ANSI_ARGS_((ClientData clientData));  
 static void                 DeleteProc _ANSI_ARGS_((ClientData clientData));  
 static Tcl_Obj *            ExecuteRemoteObject _ANSI_ARGS_((  
                                 RegisteredInterp *riPtr,  
                                 Tcl_Obj *ddeObjectPtr));  
 static int                  MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,  
                                 char *name, HCONV *ddeConvPtr));  
 static HDDEDATA CALLBACK    DdeServerProc _ANSI_ARGS_((UINT uType,  
                                 UINT uFmt, HCONV hConv, HSZ ddeTopic,  
                                 HSZ ddeItem, HDDEDATA hData, DWORD dwData1,  
                                 DWORD dwData2));  
 static void                 SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));  
 int Tcl_DdeObjCmd(ClientData clientData,        /* Used only for deletion */  
         Tcl_Interp *interp,             /* The interp we are sending from */  
         int objc,                       /* Number of arguments */  
         Tcl_Obj *CONST objv[]); /* The arguments */  
   
 EXTERN int Dde_Init(Tcl_Interp *interp);  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Dde_Init --  
  *  
  *      This procedure initializes the dde command.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Dde_Init(  
     Tcl_Interp *interp)  
 {  
     ThreadSpecificData *tsdPtr;  
       
     if (!Tcl_InitStubs(interp, "8.0", 0)) {  
         return TCL_ERROR;  
     }  
   
     Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);  
   
     tsdPtr = (ThreadSpecificData *)  
         Tcl_GetThreadData((Tcl_ThreadDataKey *) &dataKey, sizeof(ThreadSpecificData));  
       
     if (tsdPtr == NULL) {  
         tsdPtr = TCL_TSD_INIT(&dataKey);  
         tsdPtr->currentConversations = NULL;  
         tsdPtr->interpListPtr = NULL;  
     }  
     Tcl_CreateExitHandler(DdeExitProc, NULL);  
   
     return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Initialize --  
  *  
  *      Initialize the global DDE instance.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Registers the DDE server proc.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 Initialize(void)  
 {  
     int nameFound = 0;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
       
     /*  
      * See if the application is already registered; if so, remove its  
      * current name from the registry. The deletion of the command  
      * will take care of disposing of this entry.  
      */  
   
     if (tsdPtr->interpListPtr != NULL) {  
         nameFound = 1;  
     }  
   
     /*  
      * Make sure that the DDE server is there. This is done only once,  
      * add an exit handler tear it down.  
      */  
   
     if (ddeInstance == 0) {  
         Tcl_MutexLock(&ddeMutex);  
         if (ddeInstance == 0) {  
             if (DdeInitialize(&ddeInstance, DdeServerProc,  
                     CBF_SKIP_REGISTRATIONS  
                     | CBF_SKIP_UNREGISTRATIONS  
                     | CBF_FAIL_POKES, 0)  
                     != DMLERR_NO_ERROR) {  
                 ddeInstance = 0;  
             }  
         }  
         Tcl_MutexUnlock(&ddeMutex);  
     }  
     if ((ddeServiceGlobal == 0) && (nameFound != 0)) {  
         Tcl_MutexLock(&ddeMutex);  
         if ((ddeServiceGlobal == 0) && (nameFound != 0)) {  
             ddeIsServer = 1;  
             Tcl_CreateExitHandler(DdeExitProc, NULL);  
             ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \  
                     TCL_DDE_SERVICE_NAME, 0);  
             DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);  
         } else {  
             ddeIsServer = 0;  
         }  
         Tcl_MutexUnlock(&ddeMutex);  
     }  
 }      
   
 /*  
  *--------------------------------------------------------------  
  *  
  * DdeSetServerName --  
  *  
  *      This procedure is called to associate an ASCII name with a Dde  
  *      server.  If the interpreter has already been named, the  
  *      name replaces the old one.  
  *  
  * Results:  
  *      The return value is the name actually given to the interp.  
  *      This will normally be the same as name, but if name was already  
  *      in use for a Dde Server then a name of the form "name #2" will  
  *      be chosen,  with a high enough number to make the name unique.  
  *  
  * Side effects:  
  *      Registration info is saved, thereby allowing the "send" command  
  *      to be used later to invoke commands in the application.  In  
  *      addition, the "send" command is created in the application's  
  *      interpreter.  The registration will be removed automatically  
  *      if the interpreter is deleted or the "send" command is removed.  
  *  
  *--------------------------------------------------------------  
  */  
   
 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  
      * current name from the registry. The deletion of the command  
      * will take care of disposing of this entry.  
      */  
   
     for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;  
             prevPtr = riPtr, riPtr = riPtr->nextPtr) {  
         if (riPtr->interp == interp) {  
             if (name != NULL) {  
                 if (prevPtr == NULL) {  
                     tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;  
                 } else {  
                     prevPtr->nextPtr = riPtr->nextPtr;  
                 }  
                 break;  
             } else {  
                 /*  
                  * the name was NULL, so the caller is asking for  
                  * the name of the current interp.  
                  */  
   
                 return riPtr->name;  
             }  
         }  
     }  
   
     if (name == NULL) {  
         /*  
          * the name was NULL, so the caller is asking for  
          * the name of the current interp, but it doesn't  
          * have a name.  
          */  
   
         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.  
      */  
   
     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);  
     if (Tcl_IsSafe(interp)) {  
         Tcl_HideCommand(interp, "dde", "dde");  
     }  
     Tcl_DStringFree(&dString);  
   
     /*  
      * re-initialize with the new name  
      */  
     Initialize();  
       
     return riPtr->name;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * DeleteProc  
  *  
  *      This procedure is called when the command "dde" is destroyed.  
  *  
  * Results:  
  *      none  
  *  
  * Side effects:  
  *      The interpreter given by riPtr is unregistered.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static void  
 DeleteProc(clientData)  
     ClientData clientData;      /* The interp we are deleting passed  
                                  * as ClientData. */  
 {  
     RegisteredInterp *riPtr = (RegisteredInterp *) clientData;  
     RegisteredInterp *searchPtr, *prevPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;  
             (searchPtr != NULL) && (searchPtr != riPtr);  
             prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {  
         /*  
          * Empty loop body.  
          */  
     }  
   
     if (searchPtr != NULL) {  
         if (prevPtr == NULL) {  
             tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;  
         } else {  
             prevPtr->nextPtr = searchPtr->nextPtr;  
         }  
     }  
     ckfree(riPtr->name);  
     Tcl_EventuallyFree(clientData, TCL_DYNAMIC);  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * ExecuteRemoteObject --  
  *  
  *      Takes the package delivered by DDE and executes it in  
  *      the server's interpreter.  
  *  
  * Results:  
  *      A list Tcl_Obj * that describes what happened. The first  
  *      element is the numerical return code (TCL_ERROR, etc.).  
  *      The second element is the result of the script. If the  
  *      return result was TCL_ERROR, then the third element  
  *      will be the value of the global "errorCode", and the  
  *      fourth will be the value of the global "errorInfo".  
  *      The return result will have a refCount of 0.  
  *  
  * Side effects:  
  *      A Tcl script is run, which can cause all kinds of other  
  *      things to happen.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static Tcl_Obj *  
 ExecuteRemoteObject(  
     RegisteredInterp *riPtr,        /* Info about this server. */  
     Tcl_Obj *ddeObjectPtr)          /* The object to execute. */  
 {  
     Tcl_Obj *errorObjPtr;  
     Tcl_Obj *returnPackagePtr;  
     int result;  
   
     result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);  
     returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);  
     Tcl_ListObjAppendElement(NULL, returnPackagePtr,  
             Tcl_NewIntObj(result));  
     Tcl_ListObjAppendElement(NULL, returnPackagePtr,  
             Tcl_GetObjResult(riPtr->interp));  
     if (result == TCL_ERROR) {  
         errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,  
                 TCL_GLOBAL_ONLY);  
         Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);  
         errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,  
                 TCL_GLOBAL_ONLY);  
         Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);  
     }  
   
     return returnPackagePtr;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * DdeServerProc --  
  *  
  *      Handles all transactions for this server. Can handle  
  *      execute, request, and connect protocols. Dde will  
  *      call this routine when a client attempts to run a dde  
  *      command using this server.  
  *  
  * Results:  
  *      A DDE Handle with the result of the dde command.  
  *  
  * Side effects:  
  *      Depending on which command is executed, arbitrary  
  *      Tcl scripts can be run.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static HDDEDATA CALLBACK  
 DdeServerProc (  
     UINT uType,                 /* The type of DDE transaction we  
                                  * are performing. */  
     UINT uFmt,                  /* The format that data is sent or  
                                  * received. */  
     HCONV hConv,                /* The conversation associated with the  
                                  * current transaction. */  
     HSZ ddeTopic,               /* A string handle. Transaction-type  
                                  * dependent. */  
     HSZ ddeItem,                /* A string handle. Transaction-type  
                                  * dependent. */  
     HDDEDATA hData,             /* DDE data. Transaction-type dependent. */  
     DWORD dwData1,              /* Transaction-dependent data. */  
     DWORD dwData2)              /* Transaction-dependent data. */  
 {  
     Tcl_DString dString;  
     int len;  
     char *utilString;  
     Tcl_Obj *ddeObjectPtr;  
     HDDEDATA ddeReturn = NULL;  
     RegisteredInterp *riPtr;  
     Conversation *convPtr, *prevConvPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     switch(uType) {  
         case XTYP_CONNECT:  
   
             /*  
              * Dde is trying to initialize a conversation with us. Check  
              * and make sure we have a valid topic.  
              */  
   
             len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);  
             Tcl_DStringInit(&dString);  
             Tcl_DStringSetLength(&dString, len);  
             utilString = Tcl_DStringValue(&dString);  
             DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,  
                     CP_WINANSI);  
   
             for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;  
                     riPtr = riPtr->nextPtr) {  
                 if (stricmp(utilString, riPtr->name) == 0) {  
                     Tcl_DStringFree(&dString);  
                     return (HDDEDATA) TRUE;  
                 }  
             }  
   
             Tcl_DStringFree(&dString);  
             return (HDDEDATA) FALSE;  
   
         case XTYP_CONNECT_CONFIRM:  
   
             /*  
              * Dde has decided that we can connect, so it gives us a  
              * conversation handle. We need to keep track of it  
              * so we know which execution result to return in an  
              * XTYP_REQUEST.  
              */  
   
             len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);  
             Tcl_DStringInit(&dString);  
             Tcl_DStringSetLength(&dString, len);  
             utilString = Tcl_DStringValue(&dString);  
             DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,  
                     CP_WINANSI);  
             for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;  
                     riPtr = riPtr->nextPtr) {  
                 if (stricmp(riPtr->name, utilString) == 0) {  
                     convPtr = (Conversation *) ckalloc(sizeof(Conversation));  
                     convPtr->nextPtr = tsdPtr->currentConversations;  
                     convPtr->returnPackagePtr = NULL;  
                     convPtr->hConv = hConv;  
                     convPtr->riPtr = riPtr;  
                     tsdPtr->currentConversations = convPtr;  
                     break;  
                 }  
             }  
             Tcl_DStringFree(&dString);  
             return (HDDEDATA) TRUE;  
   
         case XTYP_DISCONNECT:  
   
             /*  
              * The client has disconnected from our server. Forget this  
              * conversation.  
              */  
   
             for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;  
                     convPtr != NULL;  
                     prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {  
                 if (hConv == convPtr->hConv) {  
                     if (prevConvPtr == NULL) {  
                         tsdPtr->currentConversations = convPtr->nextPtr;  
                     } else {  
                         prevConvPtr->nextPtr = convPtr->nextPtr;  
                     }  
                     if (convPtr->returnPackagePtr != NULL) {  
                         Tcl_DecrRefCount(convPtr->returnPackagePtr);  
                     }  
                     ckfree((char *) convPtr);  
                     break;  
                 }  
             }  
             return (HDDEDATA) TRUE;  
   
         case XTYP_REQUEST:  
   
             /*  
              * This could be either a request for a value of a Tcl variable,  
              * or it could be the send command requesting the results of the  
              * last execute.  
              */  
   
             if (uFmt != CF_TEXT) {  
                 return (HDDEDATA) FALSE;  
             }  
   
             ddeReturn = (HDDEDATA) FALSE;  
             for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)  
                     && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {  
                 /*  
                  * Empty loop body.  
                  */  
             }  
   
             if (convPtr != NULL) {  
                 char *returnString;  
   
                 len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,  
                         CP_WINANSI);  
                 Tcl_DStringInit(&dString);  
                 Tcl_DStringSetLength(&dString, len);  
                 utilString = Tcl_DStringValue(&dString);  
                 DdeQueryString(ddeInstance, ddeItem, utilString,  
                         len + 1, CP_WINANSI);  
                 if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {  
                     returnString =  
                         Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);  
                     ddeReturn = DdeCreateDataHandle(ddeInstance,  
                             returnString, len+1, 0, ddeItem, CF_TEXT,  
                             0);  
                 } else {  
                     Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(  
                             convPtr->riPtr->interp, utilString, NULL,  
                             TCL_GLOBAL_ONLY);  
                     if (variableObjPtr != NULL) {  
                         returnString = Tcl_GetStringFromObj(variableObjPtr,  
                                 &len);  
                         ddeReturn = DdeCreateDataHandle(ddeInstance,  
                                 returnString, len+1, 0, ddeItem, CF_TEXT, 0);  
                     } else {  
                         ddeReturn = NULL;  
                     }  
                 }  
                 Tcl_DStringFree(&dString);  
             }  
             return ddeReturn;  
   
         case XTYP_EXECUTE: {  
   
             /*  
              * Execute this script. The results will be saved into  
              * a list object which will be retreived later. See  
              * ExecuteRemoteObject.  
              */  
   
             Tcl_Obj *returnPackagePtr;  
   
             for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)  
                     && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {  
                 /*  
                  * Empty loop body.  
                  */  
   
             }  
   
             if (convPtr == NULL) {  
                 return (HDDEDATA) DDE_FNOTPROCESSED;  
             }  
   
             utilString = (char *) DdeAccessData(hData, &len);  
             ddeObjectPtr = Tcl_NewStringObj(utilString, -1);  
             Tcl_IncrRefCount(ddeObjectPtr);  
             DdeUnaccessData(hData);  
             if (convPtr->returnPackagePtr != NULL) {  
                 Tcl_DecrRefCount(convPtr->returnPackagePtr);  
             }  
             convPtr->returnPackagePtr = NULL;  
             returnPackagePtr =  
                     ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);  
             for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)  
                     && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {  
                 /*  
                  * Empty loop body.  
                  */  
   
             }  
             if (convPtr != NULL) {  
                 Tcl_IncrRefCount(returnPackagePtr);  
                 convPtr->returnPackagePtr = returnPackagePtr;  
             }  
             Tcl_DecrRefCount(ddeObjectPtr);  
             if (returnPackagePtr == NULL) {  
                 return (HDDEDATA) DDE_FNOTPROCESSED;  
             } else {  
                 return (HDDEDATA) DDE_FACK;  
             }  
         }  
               
         case XTYP_WILDCONNECT: {  
   
             /*  
              * Dde wants a list of services and topics that we support.  
              */  
   
             HSZPAIR *returnPtr;  
             int i;  
             int numItems;  
   
             for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;  
                     i++, riPtr = riPtr->nextPtr) {  
                 /*  
                  * Empty loop body.  
                  */  
   
             }  
   
             numItems = i;  
             ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,  
                     (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);  
             returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);  
             for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;  
                     i++, riPtr = riPtr->nextPtr) {  
                 returnPtr[i].hszSvc = DdeCreateStringHandle(  
                         ddeInstance, "TclEval", CP_WINANSI);  
                 returnPtr[i].hszTopic = DdeCreateStringHandle(  
                         ddeInstance, riPtr->name, CP_WINANSI);  
             }  
             returnPtr[i].hszSvc = NULL;  
             returnPtr[i].hszTopic = NULL;  
             DdeUnaccessData(ddeReturn);  
             return ddeReturn;  
         }  
   
     }  
     return NULL;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * DdeExitProc --  
  *  
  *      Gets rid of our DDE server when we go away.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The DDE server is deleted.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static void  
 DdeExitProc(  
     ClientData clientData)          /* Not used in this handler. */  
 {  
     DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);  
     DdeUninitialize(ddeInstance);  
     ddeInstance = 0;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * MakeDdeConnection --  
  *  
  *      This procedure is a utility used to connect to a DDE  
  *      server when given a server name and a topic name.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *        
  *  
  * Side effects:  
  *      Passes back a conversation through ddeConvPtr  
  *  
  *--------------------------------------------------------------  
  */  
   
 static int  
 MakeDdeConnection(  
     Tcl_Interp *interp,         /* Used to report errors. */  
     char *name,                 /* The connection to use. */  
     HCONV *ddeConvPtr)  
 {  
     HSZ ddeTopic, ddeService;  
     HCONV ddeConv;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
       
     ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);  
     ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);  
   
     ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);  
     DdeFreeStringHandle(ddeInstance, ddeService);  
     DdeFreeStringHandle(ddeInstance, ddeTopic);  
   
     if (ddeConv == (HCONV) NULL) {  
         if (interp != NULL) {  
             Tcl_AppendResult(interp, "no registered server named \"",  
                     name, "\"", (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
   
     *ddeConvPtr = ddeConv;  
     return TCL_OK;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * SetDdeError --  
  *  
  *      Sets the interp result to a cogent error message  
  *      describing the last DDE error.  
  *  
  * Results:  
  *      None.  
  *        
  *  
  * Side effects:  
  *      The interp's result object is changed.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static void  
 SetDdeError(  
     Tcl_Interp *interp)     /* The interp to put the message in.*/  
 {  
     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);  
     int err;  
   
     err = DdeGetLastError(ddeInstance);  
     switch (err) {  
         case DMLERR_DATAACKTIMEOUT:  
         case DMLERR_EXECACKTIMEOUT:  
         case DMLERR_POKEACKTIMEOUT:  
             Tcl_SetStringObj(resultPtr,  
                     "remote interpreter did not respond", -1);  
             break;  
   
         case DMLERR_BUSY:  
             Tcl_SetStringObj(resultPtr, "remote server is busy", -1);  
             break;  
   
         case DMLERR_NOTPROCESSED:  
             Tcl_SetStringObj(resultPtr,  
                     "remote server cannot handle this command", -1);  
             break;  
   
         default:  
             Tcl_SetStringObj(resultPtr, "dde command failed", -1);  
     }  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tcl_DdeObjCmd --  
  *  
  *      This procedure is invoked to process the "dde" Tcl command.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *--------------------------------------------------------------  
  */  
   
 int  
 Tcl_DdeObjCmd(  
     ClientData clientData,      /* Used only for deletion */  
     Tcl_Interp *interp,         /* The interp we are sending from */  
     int objc,                   /* Number of arguments */  
     Tcl_Obj *CONST objv[])      /* The arguments */  
 {  
     enum {  
         DDE_SERVERNAME,  
         DDE_EXECUTE,  
         DDE_POKE,  
         DDE_REQUEST,  
         DDE_SERVICES,  
         DDE_EVAL  
     };  
   
     static char *ddeCommands[] = {"servername", "execute", "poke",  
           "request", "services", "eval",  
           (char *) NULL};  
     static char *ddeOptions[] = {"-async", (char *) NULL};  
     int index, argIndex;  
     int async = 0;  
     int result = TCL_OK;  
     HSZ ddeService = NULL;  
     HSZ ddeTopic = NULL;  
     HSZ ddeItem = NULL;  
     HDDEDATA ddeData = NULL;  
     HDDEDATA ddeItemData = NULL;  
     HCONV hConv = NULL;  
     HSZ ddeCookie = 0;  
     char *serviceName, *topicName, *itemString, *dataString;  
     char *string;  
     int firstArg, length, dataLength;  
     DWORD ddeResult;  
     HDDEDATA ddeReturn;  
     RegisteredInterp *riPtr;  
     Tcl_Interp *sendInterp;  
     Tcl_Obj *objPtr;  
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);  
   
     /*  
      * Initialize DDE server/client  
      */  
       
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv,  
                 "?-async? serviceName topicName value");  
         return TCL_ERROR;  
     }  
   
     if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,  
             &index) != TCL_OK) {  
         return TCL_ERROR;  
     }  
   
     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)) {  
                 Tcl_WrongNumArgs(interp, 1, objv,  
                         "execute ?-async? serviceName topicName value");  
                 return TCL_ERROR;  
             }  
             if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,  
                     &argIndex) != TCL_OK) {  
                 if (objc != 5) {  
                     Tcl_WrongNumArgs(interp, 1, objv,  
                             "execute ?-async? serviceName topicName value");  
                     return TCL_ERROR;  
                 }  
                 async = 0;  
                 firstArg = 2;  
             } else {  
                 if (objc != 6) {  
                     Tcl_WrongNumArgs(interp, 1, objv,  
                             "execute ?-async? serviceName topicName value");  
                     return TCL_ERROR;  
                 }  
                 async = 1;  
                 firstArg = 3;  
             }  
             break;  
         case DDE_POKE:  
             if (objc != 6) {  
                 Tcl_WrongNumArgs(interp, 1, objv,  
                         "poke serviceName topicName item value");  
                 return TCL_ERROR;  
             }  
             firstArg = 2;  
             break;  
         case DDE_REQUEST:  
             if (objc != 5) {  
                 Tcl_WrongNumArgs(interp, 1, objv,  
                         "request serviceName topicName value");  
                 return TCL_ERROR;  
             }  
             firstArg = 2;  
             break;  
         case DDE_SERVICES:  
             if (objc != 4) {  
                 Tcl_WrongNumArgs(interp, 1, objv,  
                         "services serviceName topicName");  
                 return TCL_ERROR;  
             }  
             firstArg = 2;  
             break;  
         case DDE_EVAL:  
             if (objc < 4) {  
                 Tcl_WrongNumArgs(interp, 1, objv,  
                         "eval ?-async? serviceName args");  
                 return TCL_ERROR;  
             }  
             if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,  
                     &argIndex) != TCL_OK) {  
                 if (objc < 4) {  
                     Tcl_WrongNumArgs(interp, 1, objv,  
                             "eval ?-async? serviceName args");  
                     return TCL_ERROR;  
                 }  
                 async = 0;  
                 firstArg = 2;  
             } else {  
                 if (objc < 5) {  
                     Tcl_WrongNumArgs(interp, 1, objv,  
                             "eval ?-async? serviceName args");  
                     return TCL_ERROR;  
                 }  
                 async = 1;  
                 firstArg = 3;  
             }  
             break;  
     }  
   
     Initialize();  
   
     if (firstArg != 1) {  
         serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);  
     } else {  
         length = 0;  
     }  
   
     if (length == 0) {  
         serviceName = NULL;  
     } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {  
         ddeService = DdeCreateStringHandle(ddeInstance, serviceName,  
                 CP_WINANSI);  
     }  
   
     if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {  
         topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);  
         if (length == 0) {  
             topicName = NULL;  
         } else {  
             ddeTopic = DdeCreateStringHandle(ddeInstance,  
                     topicName, CP_WINANSI);  
         }  
     }  
   
     switch (index) {  
         case DDE_SERVERNAME: {  
             serviceName = DdeSetServerName(interp, serviceName);  
             if (serviceName != NULL) {  
                 Tcl_SetStringObj(Tcl_GetObjResult(interp),  
                         serviceName, -1);  
             } else {  
                 Tcl_ResetResult(interp);  
             }  
             break;  
         }  
         case DDE_EXECUTE: {  
             dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);  
             if (dataLength == 0) {  
                 Tcl_SetStringObj(Tcl_GetObjResult(interp),  
                         "cannot execute null data", -1);  
                 result = TCL_ERROR;  
                 break;  
             }  
             hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,  
                     NULL);  
             DdeFreeStringHandle (ddeInstance, ddeService) ;  
             DdeFreeStringHandle (ddeInstance, ddeTopic) ;  
   
             if (hConv == NULL) {  
                 SetDdeError(interp);  
                 result = TCL_ERROR;  
                 break;  
             }  
   
             ddeData = DdeCreateDataHandle(ddeInstance, dataString,  
                     dataLength+1, 0, 0, CF_TEXT, 0);  
             if (ddeData != NULL) {  
                 if (async) {  
                     DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,  
                             CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);  
                     DdeAbandonTransaction(ddeInstance, hConv,  
                             ddeResult);  
                 } else {  
                     ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,  
                             hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);  
                     if (ddeReturn == 0) {  
                         SetDdeError(interp);  
                         result = TCL_ERROR;  
                     }  
                 }  
                 DdeFreeDataHandle(ddeData);  
             } else {  
                 SetDdeError(interp);  
                 result = TCL_ERROR;  
             }  
             break;  
         }  
         case DDE_REQUEST: {  
             itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);  
             if (length == 0) {  
                 Tcl_SetStringObj(Tcl_GetObjResult(interp),  
                         "cannot request value of null data", -1);  
                 return TCL_ERROR;  
             }  
             hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);  
             DdeFreeStringHandle (ddeInstance, ddeService) ;  
             DdeFreeStringHandle (ddeInstance, ddeTopic) ;  
               
             if (hConv == NULL) {  
                 SetDdeError(interp);  
                 result = TCL_ERROR;  
             } else {  
                 Tcl_Obj *returnObjPtr;  
                 ddeItem = DdeCreateStringHandle(ddeInstance,  
                         itemString, CP_WINANSI);  
                 if (ddeItem != NULL) {  
                     ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,  
                             CF_TEXT, XTYP_REQUEST, 5000, NULL);  
                     if (ddeData == NULL) {  
                         SetDdeError(interp);  
                         result = TCL_ERROR;  
                     } else {  
                         dataString = DdeAccessData(ddeData, &dataLength);  
                         returnObjPtr = Tcl_NewStringObj(dataString, -1);  
                         DdeUnaccessData(ddeData);  
                         DdeFreeDataHandle(ddeData);  
                         Tcl_SetObjResult(interp, returnObjPtr);  
                     }  
                 } else {  
                     SetDdeError(interp);  
                     result = TCL_ERROR;  
                 }  
             }  
   
             break;  
         }  
         case DDE_POKE: {  
             itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);  
             if (length == 0) {  
                 Tcl_SetStringObj(Tcl_GetObjResult(interp),  
                         "cannot have a null item", -1);  
                 return TCL_ERROR;  
             }  
             dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);  
               
             hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);  
             DdeFreeStringHandle (ddeInstance,ddeService) ;  
             DdeFreeStringHandle (ddeInstance, ddeTopic) ;  
   
             if (hConv == NULL) {  
                 SetDdeError(interp);  
                 result = TCL_ERROR;  
             } else {  
                 ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \  
                         CP_WINANSI);  
                 if (ddeItem != NULL) {  
                     ddeData = DdeClientTransaction(dataString,length+1, \  
                             hConv, ddeItem,  
                             CF_TEXT, XTYP_POKE, 5000, NULL);  
                     if (ddeData == NULL) {  
                         SetDdeError(interp);  
                         result = TCL_ERROR;  
                     }  
                 } else {  
                     SetDdeError(interp);  
                     result = TCL_ERROR;  
                 }  
             }  
             break;  
         }  
   
         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, 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,  
                         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: {  
             objc -= (async + 3);  
             ((Tcl_Obj **) objv) += (async + 3);  
   
             /*  
              * See if the target interpreter is local.  If so, execute  
              * the command directly without going through the DDE server.  
              * Don't exchange objects between interps.  The target interp could  
              * 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.  
              */  
               
             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  
                  * the server.  
                  */  
                   
                 Tcl_Preserve((ClientData) riPtr);  
                 sendInterp = riPtr->interp;  
                 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.  
                  */  
   
                 if (objc == 1) {  
                     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);  
                     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.    
                          */  
                           
                         Tcl_ResetResult(interp);  
                         objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,  
                                 TCL_GLOBAL_ONLY);  
                         string = Tcl_GetStringFromObj(objPtr, &length);  
                         Tcl_AddObjErrorInfo(interp, string, length);  
                           
                         objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,  
                                 TCL_GLOBAL_ONLY);  
                         Tcl_SetObjErrorCode(interp, objPtr);  
                     }  
                     Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));  
                 }  
                 Tcl_Release((ClientData) riPtr);  
                 Tcl_Release((ClientData) sendInterp);  
             } else {  
                 /*  
                  * 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) {  
                     goto error;  
                 }  
                   
                 objPtr = Tcl_ConcatObj(objc, objv);  
                 string = Tcl_GetStringFromObj(objPtr, &length);  
                 ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0,  
                         CF_TEXT, 0);  
                   
                 if (async) {  
                     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,  
                             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);  
                     }  
                 }  
                   
                   
                 Tcl_DecrRefCount(objPtr);  
                   
                 if (ddeData == 0) {  
                     SetDdeError(interp);  
                     goto errorNoResult;  
                 }  
                   
                 if (async == 0) {  
                     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".  
                      */  
                       
                     resultPtr = Tcl_NewObj();  
                     length = DdeGetData(ddeData, NULL, 0, 0);  
                     Tcl_SetObjLength(resultPtr, length);  
                     string = Tcl_GetString(resultPtr);  
                     DdeGetData(ddeData, string, length, 0);  
                     Tcl_SetObjLength(resultPtr, strlen(string));  
                       
                     if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {  
                         Tcl_DecrRefCount(resultPtr);  
                         goto error;  
                     }  
                     if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {  
                         Tcl_DecrRefCount(resultPtr);  
                         goto error;  
                     }  
                     if (result == TCL_ERROR) {  
                         Tcl_ResetResult(interp);  
                           
                         if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {  
                             Tcl_DecrRefCount(resultPtr);  
                             goto error;  
                         }  
                         length = -1;  
                         string = Tcl_GetStringFromObj(objPtr, &length);  
                         Tcl_AddObjErrorInfo(interp, string, length);  
                           
                         Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);  
                         Tcl_SetObjErrorCode(interp, objPtr);  
                     }  
                     if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {  
                         Tcl_DecrRefCount(resultPtr);  
                         goto error;  
                     }  
                     Tcl_SetObjResult(interp, objPtr);  
                     Tcl_DecrRefCount(resultPtr);  
                 }  
             }  
         }  
     }  
     if (ddeCookie != NULL) {  
         DdeFreeStringHandle(ddeInstance, ddeCookie);  
     }  
     if (ddeItem != NULL) {  
         DdeFreeStringHandle(ddeInstance, ddeItem);  
     }  
     if (ddeItemData != NULL) {  
         DdeFreeDataHandle(ddeItemData);  
     }  
     if (ddeData != NULL) {  
         DdeFreeDataHandle(ddeData);  
     }  
     if (hConv != NULL) {  
         DdeDisconnect(hConv);  
     }  
     return result;  
   
     error:  
     Tcl_SetStringObj(Tcl_GetObjResult(interp),  
             "invalid data returned from server", -1);  
   
     errorNoResult:  
     if (ddeCookie != NULL) {  
         DdeFreeStringHandle(ddeInstance, ddeCookie);  
     }  
     if (ddeItem != NULL) {  
         DdeFreeStringHandle(ddeInstance, ddeItem);  
     }  
     if (ddeItemData != NULL) {  
         DdeFreeDataHandle(ddeItemData);  
     }  
     if (ddeData != NULL) {  
         DdeFreeDataHandle(ddeData);  
     }  
     if (hConv != NULL) {  
         DdeDisconnect(hConv);  
     }  
     return TCL_ERROR;  
 }  
   
   
 /* $History: tclwindde.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 12:50a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLWINDDE.C */  
1    /* $Header$ */
2    /*
3     * tclWinDde.c --
4     *
5     *      This file provides procedures that implement the "send"
6     *      command, allowing commands to be passed from interpreter
7     *      to interpreter.
8     *
9     * Copyright (c) 1997 by Sun Microsystems, Inc.
10     *
11     * See the file "license.terms" for information on usage and redistribution
12     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13     *
14     * RCS: @(#) $Id: tclwindde.c,v 1.1.1.1 2001/06/13 04:48:43 dtashley Exp $
15     */
16    
17    #include "tclPort.h"
18    #include <ddeml.h>
19    
20    /*
21     * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
22     * Registry_Init declaration is in the source file itself, which is only
23     * accessed when we are building a library.
24     */
25    
26    #undef TCL_STORAGE_CLASS
27    #define TCL_STORAGE_CLASS DLLEXPORT
28    
29    /*
30     * The following structure is used to keep track of the interpreters
31     * registered by this process.
32     */
33    
34    typedef struct RegisteredInterp {
35        struct RegisteredInterp *nextPtr;
36                                    /* The next interp this application knows
37                                     * about. */
38        char *name;                 /* Interpreter's name (malloc-ed). */
39        Tcl_Interp *interp;         /* The interpreter attached to this name. */
40    } RegisteredInterp;
41    
42    /*
43     * Used to keep track of conversations.
44     */
45    
46    typedef struct Conversation {
47        struct Conversation *nextPtr;
48                                    /* The next conversation in the list. */
49        RegisteredInterp *riPtr;    /* The info we know about the conversation. */
50        HCONV hConv;                /* The DDE handle for this conversation. */
51        Tcl_Obj *returnPackagePtr;  /* The result package for this conversation. */
52    } Conversation;
53    
54    typedef struct ThreadSpecificData {
55        Conversation *currentConversations;
56                                    /* A list of conversations currently
57                                     * being processed. */
58        RegisteredInterp *interpListPtr;
59                                    /* List of all interpreters registered
60                                     * in the current process. */
61    } ThreadSpecificData;
62    static Tcl_ThreadDataKey dataKey;
63    
64    /*
65     * The following variables cannot be placed in thread-local storage.
66     * The Mutex ddeMutex guards access to the ddeInstance.
67     */
68    static HSZ ddeServiceGlobal = 0;
69    static DWORD ddeInstance;       /* The application instance handle given
70                                     * to us by DdeInitialize. */
71    static int ddeIsServer = 0;
72    
73    #define TCL_DDE_VERSION "1.1"
74    #define TCL_DDE_PACKAGE_NAME "dde"
75    #define TCL_DDE_SERVICE_NAME "TclEval"
76    
77    TCL_DECLARE_MUTEX(ddeMutex)
78    
79    /*
80     * Forward declarations for procedures defined later in this file.
81     */
82    
83    static void                 DdeExitProc _ANSI_ARGS_((ClientData clientData));
84    static void                 DeleteProc _ANSI_ARGS_((ClientData clientData));
85    static Tcl_Obj *            ExecuteRemoteObject _ANSI_ARGS_((
86                                    RegisteredInterp *riPtr,
87                                    Tcl_Obj *ddeObjectPtr));
88    static int                  MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
89                                    char *name, HCONV *ddeConvPtr));
90    static HDDEDATA CALLBACK    DdeServerProc _ANSI_ARGS_((UINT uType,
91                                    UINT uFmt, HCONV hConv, HSZ ddeTopic,
92                                    HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
93                                    DWORD dwData2));
94    static void                 SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
95    int Tcl_DdeObjCmd(ClientData clientData,        /* Used only for deletion */
96            Tcl_Interp *interp,             /* The interp we are sending from */
97            int objc,                       /* Number of arguments */
98            Tcl_Obj *CONST objv[]); /* The arguments */
99    
100    EXTERN int Dde_Init(Tcl_Interp *interp);
101    
102    /*
103     *----------------------------------------------------------------------
104     *
105     * Dde_Init --
106     *
107     *      This procedure initializes the dde command.
108     *
109     * Results:
110     *      A standard Tcl result.
111     *
112     * Side effects:
113     *      None.
114     *
115     *----------------------------------------------------------------------
116     */
117    
118    int
119    Dde_Init(
120        Tcl_Interp *interp)
121    {
122        ThreadSpecificData *tsdPtr;
123        
124        if (!Tcl_InitStubs(interp, "8.0", 0)) {
125            return TCL_ERROR;
126        }
127    
128        Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL);
129    
130        tsdPtr = (ThreadSpecificData *)
131            Tcl_GetThreadData((Tcl_ThreadDataKey *) &dataKey, sizeof(ThreadSpecificData));
132        
133        if (tsdPtr == NULL) {
134            tsdPtr = TCL_TSD_INIT(&dataKey);
135            tsdPtr->currentConversations = NULL;
136            tsdPtr->interpListPtr = NULL;
137        }
138        Tcl_CreateExitHandler(DdeExitProc, NULL);
139    
140        return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
141    }
142    
143    
144    /*
145     *----------------------------------------------------------------------
146     *
147     * Initialize --
148     *
149     *      Initialize the global DDE instance.
150     *
151     * Results:
152     *      None.
153     *
154     * Side effects:
155     *      Registers the DDE server proc.
156     *
157     *----------------------------------------------------------------------
158     */
159    
160    static void
161    Initialize(void)
162    {
163        int nameFound = 0;
164        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
165        
166        /*
167         * See if the application is already registered; if so, remove its
168         * current name from the registry. The deletion of the command
169         * will take care of disposing of this entry.
170         */
171    
172        if (tsdPtr->interpListPtr != NULL) {
173            nameFound = 1;
174        }
175    
176        /*
177         * Make sure that the DDE server is there. This is done only once,
178         * add an exit handler tear it down.
179         */
180    
181        if (ddeInstance == 0) {
182            Tcl_MutexLock(&ddeMutex);
183            if (ddeInstance == 0) {
184                if (DdeInitialize(&ddeInstance, DdeServerProc,
185                        CBF_SKIP_REGISTRATIONS
186                        | CBF_SKIP_UNREGISTRATIONS
187                        | CBF_FAIL_POKES, 0)
188                        != DMLERR_NO_ERROR) {
189                    ddeInstance = 0;
190                }
191            }
192            Tcl_MutexUnlock(&ddeMutex);
193        }
194        if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
195            Tcl_MutexLock(&ddeMutex);
196            if ((ddeServiceGlobal == 0) && (nameFound != 0)) {
197                ddeIsServer = 1;
198                Tcl_CreateExitHandler(DdeExitProc, NULL);
199                ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \
200                        TCL_DDE_SERVICE_NAME, 0);
201                DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
202            } else {
203                ddeIsServer = 0;
204            }
205            Tcl_MutexUnlock(&ddeMutex);
206        }
207    }    
208    
209    /*
210     *--------------------------------------------------------------
211     *
212     * DdeSetServerName --
213     *
214     *      This procedure is called to associate an ASCII name with a Dde
215     *      server.  If the interpreter has already been named, the
216     *      name replaces the old one.
217     *
218     * Results:
219     *      The return value is the name actually given to the interp.
220     *      This will normally be the same as name, but if name was already
221     *      in use for a Dde Server then a name of the form "name #2" will
222     *      be chosen,  with a high enough number to make the name unique.
223     *
224     * Side effects:
225     *      Registration info is saved, thereby allowing the "send" command
226     *      to be used later to invoke commands in the application.  In
227     *      addition, the "send" command is created in the application's
228     *      interpreter.  The registration will be removed automatically
229     *      if the interpreter is deleted or the "send" command is removed.
230     *
231     *--------------------------------------------------------------
232     */
233    
234    static char *
235    DdeSetServerName(
236        Tcl_Interp *interp,
237        char *name                  /* The name that will be used to
238                                     * refer to the interpreter in later
239                                     * "send" commands.  Must be globally
240                                     * unique. */
241        )
242    {
243        int suffix, offset;
244        RegisteredInterp *riPtr, *prevPtr;
245        Tcl_DString dString;
246        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
247    
248        /*
249         * See if the application is already registered; if so, remove its
250         * current name from the registry. The deletion of the command
251         * will take care of disposing of this entry.
252         */
253    
254        for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
255                prevPtr = riPtr, riPtr = riPtr->nextPtr) {
256            if (riPtr->interp == interp) {
257                if (name != NULL) {
258                    if (prevPtr == NULL) {
259                        tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
260                    } else {
261                        prevPtr->nextPtr = riPtr->nextPtr;
262                    }
263                    break;
264                } else {
265                    /*
266                     * the name was NULL, so the caller is asking for
267                     * the name of the current interp.
268                     */
269    
270                    return riPtr->name;
271                }
272            }
273        }
274    
275        if (name == NULL) {
276            /*
277             * the name was NULL, so the caller is asking for
278             * the name of the current interp, but it doesn't
279             * have a name.
280             */
281    
282            return "";
283        }
284        
285        /*
286         * Pick a name to use for the application.  Use "name" if it's not
287         * already in use.  Otherwise add a suffix such as " #2", trying
288         * larger and larger numbers until we eventually find one that is
289         * unique.
290         */
291    
292        suffix = 1;
293        offset = 0;
294        Tcl_DStringInit(&dString);
295    
296        /*
297         * We have found a unique name. Now add it to the registry.
298         */
299    
300        riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
301        riPtr->interp = interp;
302        riPtr->name = ckalloc(strlen(name) + 1);
303        riPtr->nextPtr = tsdPtr->interpListPtr;
304        tsdPtr->interpListPtr = riPtr;
305        strcpy(riPtr->name, name);
306    
307        Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
308                (ClientData) riPtr, DeleteProc);
309        if (Tcl_IsSafe(interp)) {
310            Tcl_HideCommand(interp, "dde", "dde");
311        }
312        Tcl_DStringFree(&dString);
313    
314        /*
315         * re-initialize with the new name
316         */
317        Initialize();
318        
319        return riPtr->name;
320    }
321    
322    /*
323     *--------------------------------------------------------------
324     *
325     * DeleteProc
326     *
327     *      This procedure is called when the command "dde" is destroyed.
328     *
329     * Results:
330     *      none
331     *
332     * Side effects:
333     *      The interpreter given by riPtr is unregistered.
334     *
335     *--------------------------------------------------------------
336     */
337    
338    static void
339    DeleteProc(clientData)
340        ClientData clientData;      /* The interp we are deleting passed
341                                     * as ClientData. */
342    {
343        RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
344        RegisteredInterp *searchPtr, *prevPtr;
345        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
346    
347        for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
348                (searchPtr != NULL) && (searchPtr != riPtr);
349                prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
350            /*
351             * Empty loop body.
352             */
353        }
354    
355        if (searchPtr != NULL) {
356            if (prevPtr == NULL) {
357                tsdPtr->interpListPtr = tsdPtr->interpListPtr->nextPtr;
358            } else {
359                prevPtr->nextPtr = searchPtr->nextPtr;
360            }
361        }
362        ckfree(riPtr->name);
363        Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
364    }
365    
366    /*
367     *--------------------------------------------------------------
368     *
369     * ExecuteRemoteObject --
370     *
371     *      Takes the package delivered by DDE and executes it in
372     *      the server's interpreter.
373     *
374     * Results:
375     *      A list Tcl_Obj * that describes what happened. The first
376     *      element is the numerical return code (TCL_ERROR, etc.).
377     *      The second element is the result of the script. If the
378     *      return result was TCL_ERROR, then the third element
379     *      will be the value of the global "errorCode", and the
380     *      fourth will be the value of the global "errorInfo".
381     *      The return result will have a refCount of 0.
382     *
383     * Side effects:
384     *      A Tcl script is run, which can cause all kinds of other
385     *      things to happen.
386     *
387     *--------------------------------------------------------------
388     */
389    
390    static Tcl_Obj *
391    ExecuteRemoteObject(
392        RegisteredInterp *riPtr,        /* Info about this server. */
393        Tcl_Obj *ddeObjectPtr)          /* The object to execute. */
394    {
395        Tcl_Obj *errorObjPtr;
396        Tcl_Obj *returnPackagePtr;
397        int result;
398    
399        result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
400        returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
401        Tcl_ListObjAppendElement(NULL, returnPackagePtr,
402                Tcl_NewIntObj(result));
403        Tcl_ListObjAppendElement(NULL, returnPackagePtr,
404                Tcl_GetObjResult(riPtr->interp));
405        if (result == TCL_ERROR) {
406            errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
407                    TCL_GLOBAL_ONLY);
408            Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
409            errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
410                    TCL_GLOBAL_ONLY);
411            Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
412        }
413    
414        return returnPackagePtr;
415    }
416    
417    /*
418     *--------------------------------------------------------------
419     *
420     * DdeServerProc --
421     *
422     *      Handles all transactions for this server. Can handle
423     *      execute, request, and connect protocols. Dde will
424     *      call this routine when a client attempts to run a dde
425     *      command using this server.
426     *
427     * Results:
428     *      A DDE Handle with the result of the dde command.
429     *
430     * Side effects:
431     *      Depending on which command is executed, arbitrary
432     *      Tcl scripts can be run.
433     *
434     *--------------------------------------------------------------
435     */
436    
437    static HDDEDATA CALLBACK
438    DdeServerProc (
439        UINT uType,                 /* The type of DDE transaction we
440                                     * are performing. */
441        UINT uFmt,                  /* The format that data is sent or
442                                     * received. */
443        HCONV hConv,                /* The conversation associated with the
444                                     * current transaction. */
445        HSZ ddeTopic,               /* A string handle. Transaction-type
446                                     * dependent. */
447        HSZ ddeItem,                /* A string handle. Transaction-type
448                                     * dependent. */
449        HDDEDATA hData,             /* DDE data. Transaction-type dependent. */
450        DWORD dwData1,              /* Transaction-dependent data. */
451        DWORD dwData2)              /* Transaction-dependent data. */
452    {
453        Tcl_DString dString;
454        int len;
455        char *utilString;
456        Tcl_Obj *ddeObjectPtr;
457        HDDEDATA ddeReturn = NULL;
458        RegisteredInterp *riPtr;
459        Conversation *convPtr, *prevConvPtr;
460        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
461    
462        switch(uType) {
463            case XTYP_CONNECT:
464    
465                /*
466                 * Dde is trying to initialize a conversation with us. Check
467                 * and make sure we have a valid topic.
468                 */
469    
470                len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
471                Tcl_DStringInit(&dString);
472                Tcl_DStringSetLength(&dString, len);
473                utilString = Tcl_DStringValue(&dString);
474                DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
475                        CP_WINANSI);
476    
477                for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
478                        riPtr = riPtr->nextPtr) {
479                    if (stricmp(utilString, riPtr->name) == 0) {
480                        Tcl_DStringFree(&dString);
481                        return (HDDEDATA) TRUE;
482                    }
483                }
484    
485                Tcl_DStringFree(&dString);
486                return (HDDEDATA) FALSE;
487    
488            case XTYP_CONNECT_CONFIRM:
489    
490                /*
491                 * Dde has decided that we can connect, so it gives us a
492                 * conversation handle. We need to keep track of it
493                 * so we know which execution result to return in an
494                 * XTYP_REQUEST.
495                 */
496    
497                len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0);
498                Tcl_DStringInit(&dString);
499                Tcl_DStringSetLength(&dString, len);
500                utilString = Tcl_DStringValue(&dString);
501                DdeQueryString(ddeInstance, ddeTopic, utilString, len + 1,
502                        CP_WINANSI);
503                for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
504                        riPtr = riPtr->nextPtr) {
505                    if (stricmp(riPtr->name, utilString) == 0) {
506                        convPtr = (Conversation *) ckalloc(sizeof(Conversation));
507                        convPtr->nextPtr = tsdPtr->currentConversations;
508                        convPtr->returnPackagePtr = NULL;
509                        convPtr->hConv = hConv;
510                        convPtr->riPtr = riPtr;
511                        tsdPtr->currentConversations = convPtr;
512                        break;
513                    }
514                }
515                Tcl_DStringFree(&dString);
516                return (HDDEDATA) TRUE;
517    
518            case XTYP_DISCONNECT:
519    
520                /*
521                 * The client has disconnected from our server. Forget this
522                 * conversation.
523                 */
524    
525                for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
526                        convPtr != NULL;
527                        prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
528                    if (hConv == convPtr->hConv) {
529                        if (prevConvPtr == NULL) {
530                            tsdPtr->currentConversations = convPtr->nextPtr;
531                        } else {
532                            prevConvPtr->nextPtr = convPtr->nextPtr;
533                        }
534                        if (convPtr->returnPackagePtr != NULL) {
535                            Tcl_DecrRefCount(convPtr->returnPackagePtr);
536                        }
537                        ckfree((char *) convPtr);
538                        break;
539                    }
540                }
541                return (HDDEDATA) TRUE;
542    
543            case XTYP_REQUEST:
544    
545                /*
546                 * This could be either a request for a value of a Tcl variable,
547                 * or it could be the send command requesting the results of the
548                 * last execute.
549                 */
550    
551                if (uFmt != CF_TEXT) {
552                    return (HDDEDATA) FALSE;
553                }
554    
555                ddeReturn = (HDDEDATA) FALSE;
556                for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
557                        && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
558                    /*
559                     * Empty loop body.
560                     */
561                }
562    
563                if (convPtr != NULL) {
564                    char *returnString;
565    
566                    len = DdeQueryString(ddeInstance, ddeItem, NULL, 0,
567                            CP_WINANSI);
568                    Tcl_DStringInit(&dString);
569                    Tcl_DStringSetLength(&dString, len);
570                    utilString = Tcl_DStringValue(&dString);
571                    DdeQueryString(ddeInstance, ddeItem, utilString,
572                            len + 1, CP_WINANSI);
573                    if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) {
574                        returnString =
575                            Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len);
576                        ddeReturn = DdeCreateDataHandle(ddeInstance,
577                                returnString, len+1, 0, ddeItem, CF_TEXT,
578                                0);
579                    } else {
580                        Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
581                                convPtr->riPtr->interp, utilString, NULL,
582                                TCL_GLOBAL_ONLY);
583                        if (variableObjPtr != NULL) {
584                            returnString = Tcl_GetStringFromObj(variableObjPtr,
585                                    &len);
586                            ddeReturn = DdeCreateDataHandle(ddeInstance,
587                                    returnString, len+1, 0, ddeItem, CF_TEXT, 0);
588                        } else {
589                            ddeReturn = NULL;
590                        }
591                    }
592                    Tcl_DStringFree(&dString);
593                }
594                return ddeReturn;
595    
596            case XTYP_EXECUTE: {
597    
598                /*
599                 * Execute this script. The results will be saved into
600                 * a list object which will be retreived later. See
601                 * ExecuteRemoteObject.
602                 */
603    
604                Tcl_Obj *returnPackagePtr;
605    
606                for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
607                        && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
608                    /*
609                     * Empty loop body.
610                     */
611    
612                }
613    
614                if (convPtr == NULL) {
615                    return (HDDEDATA) DDE_FNOTPROCESSED;
616                }
617    
618                utilString = (char *) DdeAccessData(hData, &len);
619                ddeObjectPtr = Tcl_NewStringObj(utilString, -1);
620                Tcl_IncrRefCount(ddeObjectPtr);
621                DdeUnaccessData(hData);
622                if (convPtr->returnPackagePtr != NULL) {
623                    Tcl_DecrRefCount(convPtr->returnPackagePtr);
624                }
625                convPtr->returnPackagePtr = NULL;
626                returnPackagePtr =
627                        ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
628                for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
629                        && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
630                    /*
631                     * Empty loop body.
632                     */
633    
634                }
635                if (convPtr != NULL) {
636                    Tcl_IncrRefCount(returnPackagePtr);
637                    convPtr->returnPackagePtr = returnPackagePtr;
638                }
639                Tcl_DecrRefCount(ddeObjectPtr);
640                if (returnPackagePtr == NULL) {
641                    return (HDDEDATA) DDE_FNOTPROCESSED;
642                } else {
643                    return (HDDEDATA) DDE_FACK;
644                }
645            }
646                
647            case XTYP_WILDCONNECT: {
648    
649                /*
650                 * Dde wants a list of services and topics that we support.
651                 */
652    
653                HSZPAIR *returnPtr;
654                int i;
655                int numItems;
656    
657                for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
658                        i++, riPtr = riPtr->nextPtr) {
659                    /*
660                     * Empty loop body.
661                     */
662    
663                }
664    
665                numItems = i;
666                ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
667                        (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
668                returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &len);
669                for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems;
670                        i++, riPtr = riPtr->nextPtr) {
671                    returnPtr[i].hszSvc = DdeCreateStringHandle(
672                            ddeInstance, "TclEval", CP_WINANSI);
673                    returnPtr[i].hszTopic = DdeCreateStringHandle(
674                            ddeInstance, riPtr->name, CP_WINANSI);
675                }
676                returnPtr[i].hszSvc = NULL;
677                returnPtr[i].hszTopic = NULL;
678                DdeUnaccessData(ddeReturn);
679                return ddeReturn;
680            }
681    
682        }
683        return NULL;
684    }
685    
686    /*
687     *--------------------------------------------------------------
688     *
689     * DdeExitProc --
690     *
691     *      Gets rid of our DDE server when we go away.
692     *
693     * Results:
694     *      None.
695     *
696     * Side effects:
697     *      The DDE server is deleted.
698     *
699     *--------------------------------------------------------------
700     */
701    
702    static void
703    DdeExitProc(
704        ClientData clientData)          /* Not used in this handler. */
705    {
706        DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER);
707        DdeUninitialize(ddeInstance);
708        ddeInstance = 0;
709    }
710    
711    /*
712     *--------------------------------------------------------------
713     *
714     * MakeDdeConnection --
715     *
716     *      This procedure is a utility used to connect to a DDE
717     *      server when given a server name and a topic name.
718     *
719     * Results:
720     *      A standard Tcl result.
721     *      
722     *
723     * Side effects:
724     *      Passes back a conversation through ddeConvPtr
725     *
726     *--------------------------------------------------------------
727     */
728    
729    static int
730    MakeDdeConnection(
731        Tcl_Interp *interp,         /* Used to report errors. */
732        char *name,                 /* The connection to use. */
733        HCONV *ddeConvPtr)
734    {
735        HSZ ddeTopic, ddeService;
736        HCONV ddeConv;
737        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
738        
739        ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
740        ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
741    
742        ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
743        DdeFreeStringHandle(ddeInstance, ddeService);
744        DdeFreeStringHandle(ddeInstance, ddeTopic);
745    
746        if (ddeConv == (HCONV) NULL) {
747            if (interp != NULL) {
748                Tcl_AppendResult(interp, "no registered server named \"",
749                        name, "\"", (char *) NULL);
750            }
751            return TCL_ERROR;
752        }
753    
754        *ddeConvPtr = ddeConv;
755        return TCL_OK;
756    }
757    
758    /*
759     *--------------------------------------------------------------
760     *
761     * SetDdeError --
762     *
763     *      Sets the interp result to a cogent error message
764     *      describing the last DDE error.
765     *
766     * Results:
767     *      None.
768     *      
769     *
770     * Side effects:
771     *      The interp's result object is changed.
772     *
773     *--------------------------------------------------------------
774     */
775    
776    static void
777    SetDdeError(
778        Tcl_Interp *interp)     /* The interp to put the message in.*/
779    {
780        Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
781        int err;
782    
783        err = DdeGetLastError(ddeInstance);
784        switch (err) {
785            case DMLERR_DATAACKTIMEOUT:
786            case DMLERR_EXECACKTIMEOUT:
787            case DMLERR_POKEACKTIMEOUT:
788                Tcl_SetStringObj(resultPtr,
789                        "remote interpreter did not respond", -1);
790                break;
791    
792            case DMLERR_BUSY:
793                Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
794                break;
795    
796            case DMLERR_NOTPROCESSED:
797                Tcl_SetStringObj(resultPtr,
798                        "remote server cannot handle this command", -1);
799                break;
800    
801            default:
802                Tcl_SetStringObj(resultPtr, "dde command failed", -1);
803        }
804    }
805    
806    /*
807     *--------------------------------------------------------------
808     *
809     * Tcl_DdeObjCmd --
810     *
811     *      This procedure is invoked to process the "dde" Tcl command.
812     *      See the user documentation for details on what it does.
813     *
814     * Results:
815     *      A standard Tcl result.
816     *
817     * Side effects:
818     *      See the user documentation.
819     *
820     *--------------------------------------------------------------
821     */
822    
823    int
824    Tcl_DdeObjCmd(
825        ClientData clientData,      /* Used only for deletion */
826        Tcl_Interp *interp,         /* The interp we are sending from */
827        int objc,                   /* Number of arguments */
828        Tcl_Obj *CONST objv[])      /* The arguments */
829    {
830        enum {
831            DDE_SERVERNAME,
832            DDE_EXECUTE,
833            DDE_POKE,
834            DDE_REQUEST,
835            DDE_SERVICES,
836            DDE_EVAL
837        };
838    
839        static char *ddeCommands[] = {"servername", "execute", "poke",
840              "request", "services", "eval",
841              (char *) NULL};
842        static char *ddeOptions[] = {"-async", (char *) NULL};
843        int index, argIndex;
844        int async = 0;
845        int result = TCL_OK;
846        HSZ ddeService = NULL;
847        HSZ ddeTopic = NULL;
848        HSZ ddeItem = NULL;
849        HDDEDATA ddeData = NULL;
850        HDDEDATA ddeItemData = NULL;
851        HCONV hConv = NULL;
852        HSZ ddeCookie = 0;
853        char *serviceName, *topicName, *itemString, *dataString;
854        char *string;
855        int firstArg, length, dataLength;
856        DWORD ddeResult;
857        HDDEDATA ddeReturn;
858        RegisteredInterp *riPtr;
859        Tcl_Interp *sendInterp;
860        Tcl_Obj *objPtr;
861        ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
862    
863        /*
864         * Initialize DDE server/client
865         */
866        
867        if (objc < 2) {
868            Tcl_WrongNumArgs(interp, 1, objv,
869                    "?-async? serviceName topicName value");
870            return TCL_ERROR;
871        }
872    
873        if (Tcl_GetIndexFromObj(interp, objv[1], ddeCommands, "command", 0,
874                &index) != TCL_OK) {
875            return TCL_ERROR;
876        }
877    
878        switch (index) {
879            case DDE_SERVERNAME:
880                if ((objc != 3) && (objc != 2)) {
881                    Tcl_WrongNumArgs(interp, 1, objv,
882                            "servername ?serverName?");
883                    return TCL_ERROR;
884                }
885                firstArg = (objc - 1);
886                break;
887            case DDE_EXECUTE:
888                if ((objc < 5) || (objc > 6)) {
889                    Tcl_WrongNumArgs(interp, 1, objv,
890                            "execute ?-async? serviceName topicName value");
891                    return TCL_ERROR;
892                }
893                if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
894                        &argIndex) != TCL_OK) {
895                    if (objc != 5) {
896                        Tcl_WrongNumArgs(interp, 1, objv,
897                                "execute ?-async? serviceName topicName value");
898                        return TCL_ERROR;
899                    }
900                    async = 0;
901                    firstArg = 2;
902                } else {
903                    if (objc != 6) {
904                        Tcl_WrongNumArgs(interp, 1, objv,
905                                "execute ?-async? serviceName topicName value");
906                        return TCL_ERROR;
907                    }
908                    async = 1;
909                    firstArg = 3;
910                }
911                break;
912            case DDE_POKE:
913                if (objc != 6) {
914                    Tcl_WrongNumArgs(interp, 1, objv,
915                            "poke serviceName topicName item value");
916                    return TCL_ERROR;
917                }
918                firstArg = 2;
919                break;
920            case DDE_REQUEST:
921                if (objc != 5) {
922                    Tcl_WrongNumArgs(interp, 1, objv,
923                            "request serviceName topicName value");
924                    return TCL_ERROR;
925                }
926                firstArg = 2;
927                break;
928            case DDE_SERVICES:
929                if (objc != 4) {
930                    Tcl_WrongNumArgs(interp, 1, objv,
931                            "services serviceName topicName");
932                    return TCL_ERROR;
933                }
934                firstArg = 2;
935                break;
936            case DDE_EVAL:
937                if (objc < 4) {
938                    Tcl_WrongNumArgs(interp, 1, objv,
939                            "eval ?-async? serviceName args");
940                    return TCL_ERROR;
941                }
942                if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
943                        &argIndex) != TCL_OK) {
944                    if (objc < 4) {
945                        Tcl_WrongNumArgs(interp, 1, objv,
946                                "eval ?-async? serviceName args");
947                        return TCL_ERROR;
948                    }
949                    async = 0;
950                    firstArg = 2;
951                } else {
952                    if (objc < 5) {
953                        Tcl_WrongNumArgs(interp, 1, objv,
954                                "eval ?-async? serviceName args");
955                        return TCL_ERROR;
956                    }
957                    async = 1;
958                    firstArg = 3;
959                }
960                break;
961        }
962    
963        Initialize();
964    
965        if (firstArg != 1) {
966            serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
967        } else {
968            length = 0;
969        }
970    
971        if (length == 0) {
972            serviceName = NULL;
973        } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
974            ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
975                    CP_WINANSI);
976        }
977    
978        if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
979            topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
980            if (length == 0) {
981                topicName = NULL;
982            } else {
983                ddeTopic = DdeCreateStringHandle(ddeInstance,
984                        topicName, CP_WINANSI);
985            }
986        }
987    
988        switch (index) {
989            case DDE_SERVERNAME: {
990                serviceName = DdeSetServerName(interp, serviceName);
991                if (serviceName != NULL) {
992                    Tcl_SetStringObj(Tcl_GetObjResult(interp),
993                            serviceName, -1);
994                } else {
995                    Tcl_ResetResult(interp);
996                }
997                break;
998            }
999            case DDE_EXECUTE: {
1000                dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
1001                if (dataLength == 0) {
1002                    Tcl_SetStringObj(Tcl_GetObjResult(interp),
1003                            "cannot execute null data", -1);
1004                    result = TCL_ERROR;
1005                    break;
1006                }
1007                hConv = DdeConnect(ddeInstance, ddeService, ddeTopic,
1008                        NULL);
1009                DdeFreeStringHandle (ddeInstance, ddeService) ;
1010                DdeFreeStringHandle (ddeInstance, ddeTopic) ;
1011    
1012                if (hConv == NULL) {
1013                    SetDdeError(interp);
1014                    result = TCL_ERROR;
1015                    break;
1016                }
1017    
1018                ddeData = DdeCreateDataHandle(ddeInstance, dataString,
1019                        dataLength+1, 0, 0, CF_TEXT, 0);
1020                if (ddeData != NULL) {
1021                    if (async) {
1022                        DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
1023                                CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1024                        DdeAbandonTransaction(ddeInstance, hConv,
1025                                ddeResult);
1026                    } else {
1027                        ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
1028                                hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1029                        if (ddeReturn == 0) {
1030                            SetDdeError(interp);
1031                            result = TCL_ERROR;
1032                        }
1033                    }
1034                    DdeFreeDataHandle(ddeData);
1035                } else {
1036                    SetDdeError(interp);
1037                    result = TCL_ERROR;
1038                }
1039                break;
1040            }
1041            case DDE_REQUEST: {
1042                itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1043                if (length == 0) {
1044                    Tcl_SetStringObj(Tcl_GetObjResult(interp),
1045                            "cannot request value of null data", -1);
1046                    return TCL_ERROR;
1047                }
1048                hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1049                DdeFreeStringHandle (ddeInstance, ddeService) ;
1050                DdeFreeStringHandle (ddeInstance, ddeTopic) ;
1051                
1052                if (hConv == NULL) {
1053                    SetDdeError(interp);
1054                    result = TCL_ERROR;
1055                } else {
1056                    Tcl_Obj *returnObjPtr;
1057                    ddeItem = DdeCreateStringHandle(ddeInstance,
1058                            itemString, CP_WINANSI);
1059                    if (ddeItem != NULL) {
1060                        ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
1061                                CF_TEXT, XTYP_REQUEST, 5000, NULL);
1062                        if (ddeData == NULL) {
1063                            SetDdeError(interp);
1064                            result = TCL_ERROR;
1065                        } else {
1066                            dataString = DdeAccessData(ddeData, &dataLength);
1067                            returnObjPtr = Tcl_NewStringObj(dataString, -1);
1068                            DdeUnaccessData(ddeData);
1069                            DdeFreeDataHandle(ddeData);
1070                            Tcl_SetObjResult(interp, returnObjPtr);
1071                        }
1072                    } else {
1073                        SetDdeError(interp);
1074                        result = TCL_ERROR;
1075                    }
1076                }
1077    
1078                break;
1079            }
1080            case DDE_POKE: {
1081                itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
1082                if (length == 0) {
1083                    Tcl_SetStringObj(Tcl_GetObjResult(interp),
1084                            "cannot have a null item", -1);
1085                    return TCL_ERROR;
1086                }
1087                dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
1088                
1089                hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
1090                DdeFreeStringHandle (ddeInstance,ddeService) ;
1091                DdeFreeStringHandle (ddeInstance, ddeTopic) ;
1092    
1093                if (hConv == NULL) {
1094                    SetDdeError(interp);
1095                    result = TCL_ERROR;
1096                } else {
1097                    ddeItem = DdeCreateStringHandle(ddeInstance, itemString, \
1098                            CP_WINANSI);
1099                    if (ddeItem != NULL) {
1100                        ddeData = DdeClientTransaction(dataString,length+1, \
1101                                hConv, ddeItem,
1102                                CF_TEXT, XTYP_POKE, 5000, NULL);
1103                        if (ddeData == NULL) {
1104                            SetDdeError(interp);
1105                            result = TCL_ERROR;
1106                        }
1107                    } else {
1108                        SetDdeError(interp);
1109                        result = TCL_ERROR;
1110                    }
1111                }
1112                break;
1113            }
1114    
1115            case DDE_SERVICES: {
1116                HCONVLIST hConvList;
1117                CONVINFO convInfo;
1118                Tcl_Obj *convListObjPtr, *elementObjPtr;
1119                Tcl_DString dString;
1120                char *name;
1121                
1122                convInfo.cb = sizeof(CONVINFO);
1123                hConvList = DdeConnectList(ddeInstance, ddeService,
1124                        ddeTopic, 0, NULL);
1125                DdeFreeStringHandle (ddeInstance,ddeService) ;
1126                DdeFreeStringHandle (ddeInstance, ddeTopic) ;
1127                hConv = 0;
1128                convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1129                Tcl_DStringInit(&dString);
1130    
1131                while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
1132                    elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
1133                    DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
1134                    length = DdeQueryString(ddeInstance,
1135                            convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
1136                    Tcl_DStringSetLength(&dString, length);
1137                    name = Tcl_DStringValue(&dString);
1138                    DdeQueryString(ddeInstance, convInfo.hszSvcPartner,
1139                            name, length + 1, CP_WINANSI);
1140                    Tcl_ListObjAppendElement(interp, elementObjPtr,
1141                            Tcl_NewStringObj(name, length));
1142                    length = DdeQueryString(ddeInstance, convInfo.hszTopic,
1143                            NULL, 0, CP_WINANSI);
1144                    Tcl_DStringSetLength(&dString, length);
1145                    name = Tcl_DStringValue(&dString);
1146                    DdeQueryString(ddeInstance, convInfo.hszTopic, name,
1147                            length + 1, CP_WINANSI);
1148                    Tcl_ListObjAppendElement(interp, elementObjPtr,
1149                            Tcl_NewStringObj(name, length));
1150                    Tcl_ListObjAppendElement(interp, convListObjPtr, elementObjPtr);
1151                }
1152                DdeDisconnectList(hConvList);
1153                Tcl_SetObjResult(interp, convListObjPtr);
1154                Tcl_DStringFree(&dString);
1155                break;
1156            }
1157            case DDE_EVAL: {
1158                objc -= (async + 3);
1159                ((Tcl_Obj **) objv) += (async + 3);
1160    
1161                /*
1162                 * See if the target interpreter is local.  If so, execute
1163                 * the command directly without going through the DDE server.
1164                 * Don't exchange objects between interps.  The target interp could
1165                 * compile an object, producing a bytecode structure that refers to
1166                 * other objects owned by the target interp.  If the target interp
1167                 * is then deleted, the bytecode structure would be referring to
1168                 * deallocated objects.
1169                 */
1170                
1171                for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr
1172                         = riPtr->nextPtr) {
1173                    if (stricmp(serviceName, riPtr->name) == 0) {
1174                        break;
1175                    }
1176                }
1177                
1178                if (riPtr != NULL) {
1179                    /*
1180                     * This command is to a local interp. No need to go through
1181                     * the server.
1182                     */
1183                    
1184                    Tcl_Preserve((ClientData) riPtr);
1185                    sendInterp = riPtr->interp;
1186                    Tcl_Preserve((ClientData) sendInterp);
1187                    
1188                    /*
1189                     * Don't exchange objects between interps.  The target interp would
1190                     * compile an object, producing a bytecode structure that refers to
1191                     * other objects owned by the target interp.  If the target interp
1192                     * is then deleted, the bytecode structure would be referring to
1193                     * deallocated objects.
1194                     */
1195    
1196                    if (objc == 1) {
1197                        result = Tcl_EvalObjEx(sendInterp, objv[0], TCL_EVAL_GLOBAL);
1198                    } else {
1199                        objPtr = Tcl_ConcatObj(objc, objv);
1200                        Tcl_IncrRefCount(objPtr);
1201                        result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL);
1202                        Tcl_DecrRefCount(objPtr);
1203                    }
1204                    if (interp != sendInterp) {
1205                        if (result == TCL_ERROR) {
1206                            /*
1207                             * An error occurred, so transfer error information from the
1208                             * destination interpreter back to our interpreter.  
1209                             */
1210                            
1211                            Tcl_ResetResult(interp);
1212                            objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
1213                                    TCL_GLOBAL_ONLY);
1214                            string = Tcl_GetStringFromObj(objPtr, &length);
1215                            Tcl_AddObjErrorInfo(interp, string, length);
1216                            
1217                            objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
1218                                    TCL_GLOBAL_ONLY);
1219                            Tcl_SetObjErrorCode(interp, objPtr);
1220                        }
1221                        Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
1222                    }
1223                    Tcl_Release((ClientData) riPtr);
1224                    Tcl_Release((ClientData) sendInterp);
1225                } else {
1226                    /*
1227                     * This is a non-local request. Send the script to the server and poll
1228                     * it for a result.
1229                     */
1230                    
1231                    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
1232                        goto error;
1233                    }
1234                    
1235                    objPtr = Tcl_ConcatObj(objc, objv);
1236                    string = Tcl_GetStringFromObj(objPtr, &length);
1237                    ddeItemData = DdeCreateDataHandle(ddeInstance, string, length+1, 0, 0,
1238                            CF_TEXT, 0);
1239                    
1240                    if (async) {
1241                        ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
1242                                CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
1243                        DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
1244                    } else {
1245                        ddeData = DdeClientTransaction((LPBYTE) ddeItemData, 0xFFFFFFFF, hConv, 0,
1246                                CF_TEXT, XTYP_EXECUTE, 30000, NULL);
1247                        if (ddeData != 0) {
1248                            
1249                            ddeCookie = DdeCreateStringHandle(ddeInstance,
1250                                    "$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
1251                            ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie,
1252                                    CF_TEXT, XTYP_REQUEST, 30000, NULL);
1253                        }
1254                    }
1255                    
1256                    
1257                    Tcl_DecrRefCount(objPtr);
1258                    
1259                    if (ddeData == 0) {
1260                        SetDdeError(interp);
1261                        goto errorNoResult;
1262                    }
1263                    
1264                    if (async == 0) {
1265                        Tcl_Obj *resultPtr;
1266                        
1267                        /*
1268                         * The return handle has a two or four element list in it. The first
1269                         * element is the return code (TCL_OK, TCL_ERROR, etc.). The
1270                         * second is the result of the script. If the return code is TCL_ERROR,
1271                         * then the third element is the value of the variable "errorCode",
1272                         * and the fourth is the value of the variable "errorInfo".
1273                         */
1274                        
1275                        resultPtr = Tcl_NewObj();
1276                        length = DdeGetData(ddeData, NULL, 0, 0);
1277                        Tcl_SetObjLength(resultPtr, length);
1278                        string = Tcl_GetString(resultPtr);
1279                        DdeGetData(ddeData, string, length, 0);
1280                        Tcl_SetObjLength(resultPtr, strlen(string));
1281                        
1282                        if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) {
1283                            Tcl_DecrRefCount(resultPtr);
1284                            goto error;
1285                        }
1286                        if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
1287                            Tcl_DecrRefCount(resultPtr);
1288                            goto error;
1289                        }
1290                        if (result == TCL_ERROR) {
1291                            Tcl_ResetResult(interp);
1292                            
1293                            if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr) != TCL_OK) {
1294                                Tcl_DecrRefCount(resultPtr);
1295                                goto error;
1296                            }
1297                            length = -1;
1298                            string = Tcl_GetStringFromObj(objPtr, &length);
1299                            Tcl_AddObjErrorInfo(interp, string, length);
1300                            
1301                            Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
1302                            Tcl_SetObjErrorCode(interp, objPtr);
1303                        }
1304                        if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
1305                            Tcl_DecrRefCount(resultPtr);
1306                            goto error;
1307                        }
1308                        Tcl_SetObjResult(interp, objPtr);
1309                        Tcl_DecrRefCount(resultPtr);
1310                    }
1311                }
1312            }
1313        }
1314        if (ddeCookie != NULL) {
1315            DdeFreeStringHandle(ddeInstance, ddeCookie);
1316        }
1317        if (ddeItem != NULL) {
1318            DdeFreeStringHandle(ddeInstance, ddeItem);
1319        }
1320        if (ddeItemData != NULL) {
1321            DdeFreeDataHandle(ddeItemData);
1322        }
1323        if (ddeData != NULL) {
1324            DdeFreeDataHandle(ddeData);
1325        }
1326        if (hConv != NULL) {
1327            DdeDisconnect(hConv);
1328        }
1329        return result;
1330    
1331        error:
1332        Tcl_SetStringObj(Tcl_GetObjResult(interp),
1333                "invalid data returned from server", -1);
1334    
1335        errorNoResult:
1336        if (ddeCookie != NULL) {
1337            DdeFreeStringHandle(ddeInstance, ddeCookie);
1338        }
1339        if (ddeItem != NULL) {
1340            DdeFreeStringHandle(ddeInstance, ddeItem);
1341        }
1342        if (ddeItemData != NULL) {
1343            DdeFreeDataHandle(ddeItemData);
1344        }
1345        if (ddeData != NULL) {
1346            DdeFreeDataHandle(ddeData);
1347        }
1348        if (hConv != NULL) {
1349            DdeDisconnect(hConv);
1350        }
1351        return TCL_ERROR;
1352    }
1353    
1354    /* End of tclwindde.c */

Legend:
Removed from v.29  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25