From 5f26f53fc89bc313d43da3f58d2dcdee21d1bc1c Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 25 Nov 2004 11:28:17 +0000 Subject: Assorted cleanup and doc-fixes for the dde package. --- ChangeLog | 8 + doc/dde.n | 50 +- win/tclWinDde.c | 1719 +++++++++++++++++++++++++++---------------------------- 3 files changed, 874 insertions(+), 903 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4777d57..6c25f61 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2004-11-25 Donal K. Fellows + + * doc/dde.n: Synchronized the documentation of the commands with + the header of the docs and what the package actually does. Thanks + to Andreas Kupries for spotting this. + * win/tclWinDde.c (Tcl_DdeObjCmd): Much cleanup of argument + parsing code. + 2004-11-24 David Gravereaux * generic/tclPort.h: Relative include of tclWinPort.h returned diff --git a/doc/dde.n b/doc/dde.n index 0251191..a558505 100644 --- a/doc/dde.n +++ b/doc/dde.n @@ -5,29 +5,29 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: dde.n,v 1.16 2004/10/27 14:24:37 dkf Exp $ +'\" RCS: @(#) $Id: dde.n,v 1.17 2004/11/25 11:28:22 dkf Exp $ '\" .so man.macros -.TH dde n 1.2 dde "Tcl Bundled Packages" +.TH dde n 1.3 dde "Tcl Bundled Packages" .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME dde \- Execute a Dynamic Data Exchange command .SH SYNOPSIS .sp -\fBpackage require dde 1.2\fR +\fBpackage require dde 1.3\fR .sp -\fBdde \fIservername\fR ?\fI-force\fR? ?\fI-handler proc\fR? ?\fI--\fR? ?\fItopic\fR? +\fBdde servername\fR ?\fB-force\fR? ?\fB-handler \fIproc\fR? ?\fB--\fR? ?\fItopic\fR? .sp -\fBdde \fIexecute\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? +\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR .sp -\fBdde \fIpoke\fR \fIservice topic item data\fR +\fBdde poke\fR \fIservice topic item data\fR .sp -\fBdde \fIrequest\fR ?\fI\-binary\fR? \fIservice topic \fR?\fIdata\fR? +\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR .sp -\fBdde \fIservices\fR \fIservice topic \fR?\fIdata\fR? +\fBdde services \fIservice topic\fR .sp -\fBdde \fIeval\fR ?\fI\-async\fR? \fIservice topic \fR?\fIdata\fR? +\fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? .BE .SH DESCRIPTION @@ -47,7 +47,7 @@ has the service name \fBExcel\fR. The following commands are a subset of the full Dynamic Data Exchange set of commands. .TP -\fBdde servername \fR?\fI-force\fR? ?\fI-handler proc\fR? ?\fI--\fR? ?\fItopic\fR? +\fBdde servername \fR?\fB-force\fR? ?\fB-handler \fIproc\fR? ?\fB--\fR? ?\fItopic\fR? \fBdde servername\fR registers the interpreter as a DDE server with the service name \fBTclEval\fR and the topic name specified by \fItopic\fR. If no \fItopic\fR is given, \fBdde servername\fR returns the name @@ -55,22 +55,22 @@ of the current topic or the empty string if it is not registered as a service. If the given \fItopic\fR name is already in use, then a suffix of the form ' #2' or ' #3' is appended to the name to make it unique. The command's result will be the name actually used. The -\fI-force\fR option is used to force registration of precisely the +\fB-force\fR option is used to force registration of precisely the given \fItopic\fR name. .IP -The \fI-handler\fR option specifies a Tcl procedure that will be called to +The \fB-handler\fR option specifies a Tcl procedure that will be called to process calls to the dde server. If the package has been loaded into a -safe interpreter then a \fI-handler\fR procedure must be defined. The +safe interpreter then a \fB-handler\fR procedure must be defined. The procedure is called with all the arguments provided by the remote call. .TP -\fBdde execute\fR ?\fI\-async\fR? \fIservice topic data\fR +\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR \fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated by \fIservice\fR with the topic indicated by \fItopic\fR. Typically, \fIservice\fR is the name of an application, and \fItopic\fR is a file to work on. The \fIdata\fR field is given to the remote application. Typically, the application treats the \fIdata\fR field as a script, and the -script is run in the application. The \fI\-async\fR option requests +script is run in the application. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. @@ -84,31 +84,31 @@ on. The \fIitem\fR is also application specific and is often not used, but it must always be non-null. The \fIdata\fR field is given to the remote application. .TP -\fBdde request\fR ?\fI\-binary\fR? \fIservice topic item\fR +\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR \fBdde request\fR is typically used to get the value of something; the value of a cell in Microsoft Excel or the text of a selection in Microsoft Word. \fIservice\fR is typically the name of an application, \fItopic\fR is typically the name of the file, and \fIitem\fR is application-specific. The command returns the value of \fIitem\fR as defined in the application. Normally this is interpreted to be a -string with terminating null. If \fI\-binary\fR is specified, the +string with terminating null. If \fB\-binary\fR is specified, the result is returned as a byte array. .TP \fBdde services \fIservice topic\fR \fBdde services\fR returns a list of service-topic pairs that currently exist on the machine. If \fIservice\fR and \fItopic\fR are -both null strings ({}), then all service-topic pairs currently -available on the system are returned. If \fIservice\fR is null and +both empty strings ({}), then all service-topic pairs currently +available on the system are returned. If \fIservice\fR is empty and \fItopic\fR is not, then all services with the specified topic are -returned. If \fIservice\fR is not null and \fItopic\fR is, all topics -for a given service are returned. If both are not null, if that -service-topic pair currently exists, it is returned; otherwise, null -is returned. +returned. If \fIservice\fR is non-empty and \fItopic\fR is, all topics +for a given service are returned. If both are non-empty, if that +service-topic pair currently exists, it is returned; otherwise, an +empty string is returned. .TP -\fBdde eval\fR ?\fI\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? +\fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR? \fBdde eval\fR evaluates a command and its arguments using the interpreter specified by \fItopic\fR. The DDE service must be the \fBTclEval\fR -service. The \fI\-async\fR option requests asynchronous invocation. The +service. The \fB\-async\fR option requests asynchronous invocation. The command returns an error message if the script did not run, unless the \fB\-async\fR flag was used, in which case the command returns immediately with no error. This command can be used to replace send on Windows. diff --git a/win/tclWinDde.c b/win/tclWinDde.c index b1599f7..a28f7d7 100644 --- a/win/tclWinDde.c +++ b/win/tclWinDde.c @@ -1,4 +1,4 @@ -/* +/* * tclWinDde.c -- * * This file provides procedures that implement the "send" @@ -10,23 +10,26 @@ * 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.23 2004/10/06 16:37:18 dgp Exp $ + * RCS: @(#) $Id: tclWinDde.c,v 1.24 2004/11/25 11:28:22 dkf Exp $ */ #include "tclInt.h" #include #include #include + /* * 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. + * Dde_Init declaration is in the source file itself, which is only + * accessed when we are building a library. DO NOT MOVE BEFORE ANY + * #include LINES. ONLY USE EXTERN TO INDICATE EXPORTED FUNCTIONS FROM + * NOW ON. */ #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT -/* +/* * The following structure is used to keep track of the interpreters * registered by this process. */ @@ -52,12 +55,20 @@ typedef struct Conversation { Tcl_Obj *returnPackagePtr; /* The result package for this conversation. */ } Conversation; +typedef struct DdeEnumServices { + Tcl_Interp *interp; + int result; + ATOM service; + ATOM topic; + HWND hwnd; +}; + typedef struct ThreadSpecificData { Conversation *currentConversations; - /* A list of conversations currently + /* A list of conversations currently * being processed. */ RegisteredInterp *interpListPtr; - /* List of all interpreters registered + /* List of all interpreters registered * in the current process. */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -66,14 +77,16 @@ 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.3.1" -#define TCL_DDE_PACKAGE_NAME "dde" -#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_VERSION "1.3.1" +#define TCL_DDE_PACKAGE_NAME "dde" +#define TCL_DDE_SERVICE_NAME "TclEval" +#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT" TCL_DECLARE_MUTEX(ddeMutex) @@ -81,29 +94,35 @@ TCL_DECLARE_MUTEX(ddeMutex) * Forward declarations for procedures defined later in this file. */ +static LRESULT CALLBACK DdeClientWindowProc _ANSI_ARGS_(( + HWND hwnd, UINT uMsg, WPARAM wParam, + LPARAM lParam)); +static int DdeCreateClient _ANSI_ARGS_(( + struct DdeEnumServices *es)); +static BOOL CALLBACK DdeEnumWindowsCallback _ANSI_ARGS_(( + HWND hwndTarget, LPARAM lParam)); static void DdeExitProc _ANSI_ARGS_((ClientData clientData)); +static int DdeGetServicesList _ANSI_ARGS_((Tcl_Interp *interp, + char *serviceName, char *topicName)); +static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType, + UINT uFmt, HCONV hConv, HSZ ddeTopic, + HSZ ddeItem, HDDEDATA hData, DWORD dwData1, + DWORD dwData2)); +static LRESULT DdeServicesOnAck _ANSI_ARGS_((HWND hwnd, + WPARAM wParam, LPARAM lParam)); static void DeleteProc _ANSI_ARGS_((ClientData clientData)); static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_(( - RegisteredInterp *riPtr, + 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)); -static int DdeGetServicesList _ANSI_ARGS_(( - Tcl_Interp *interp, - char *serviceName, - char *topicName)); -int Tcl_DdeObjCmd(ClientData clientData, /* Used only for deletion */ - Tcl_Interp *interp, /* The interp we are sending from */ - int objc, /* Number of arguments */ - Tcl_Obj *CONST objv[]); /* The arguments */ - -EXTERN int Dde_Init(Tcl_Interp *interp); -EXTERN int Dde_SafeInit(Tcl_Interp *interp); +int Tcl_DdeObjCmd _ANSI_ARGS_((ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); + +EXTERN int Dde_Init _ANSI_ARGS_((Tcl_Interp *interp)); +EXTERN int Dde_SafeInit _ANSI_ARGS_((Tcl_Interp *interp)); /* *---------------------------------------------------------------------- @@ -122,8 +141,8 @@ EXTERN int Dde_SafeInit(Tcl_Interp *interp); */ int -Dde_Init( - Tcl_Interp *interp) +Dde_Init(interp) + Tcl_Interp *interp; { ThreadSpecificData *tsdPtr; @@ -132,11 +151,8 @@ Dde_Init( } Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd, NULL, NULL); - tsdPtr = TCL_TSD_INIT(&dataKey); - Tcl_CreateExitHandler(DdeExitProc, NULL); - return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION); } @@ -157,8 +173,8 @@ Dde_Init( */ int -Dde_SafeInit( - Tcl_Interp *interp) +Dde_SafeInit(interp) + Tcl_Interp *interp; { int result = Dde_Init(interp); if (result == TCL_OK) { @@ -188,7 +204,7 @@ 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 @@ -208,10 +224,8 @@ Initialize(void) Tcl_MutexLock(&ddeMutex); if (ddeInstance == 0) { if (DdeInitialize(&ddeInstance, DdeServerProc, - CBF_SKIP_REGISTRATIONS - | CBF_SKIP_UNREGISTRATIONS - | CBF_FAIL_POKES, 0) - != DMLERR_NO_ERROR) { + CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS + | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) { ddeInstance = 0; } } @@ -222,7 +236,7 @@ Initialize(void) if ((ddeServiceGlobal == 0) && (nameFound != 0)) { ddeIsServer = 1; Tcl_CreateExitHandler(DdeExitProc, NULL); - ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, \ + ddeServiceGlobal = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER); } else { @@ -230,10 +244,10 @@ Initialize(void) } Tcl_MutexUnlock(&ddeMutex); } -} +} /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeSetServerName -- * @@ -254,29 +268,26 @@ Initialize(void) * 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 exactName, /* Should we make a unique name? 0 = unique */ - Tcl_Obj *handlerPtr /* Name of the optional proc/command to handle +DdeSetServerName(interp, name, exactName, handlerPtr) + Tcl_Interp *interp; + char *name; /* The name that will be used to refer to the + * interpreter in later "send" commands. Must + * be globally unique. */ + int exactName; /* Should we make a unique name? 0 = unique */ + Tcl_Obj *handlerPtr; /* Name of the optional proc/command to handle * incoming Dde eval's */ - ) { int suffix, offset; RegisteredInterp *riPtr, *prevPtr; Tcl_DString dString; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); char *actualName; - Tcl_Obj *srvListPtr = NULL; - Tcl_Obj **srvPtrPtr = NULL; + Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL; int n, srvCount = 0, lastSuffix, r = TCL_OK; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * See if the application is already registered; if so, remove its @@ -284,7 +295,7 @@ DdeSetServerName( * will take care of disposing of this entry. */ - for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; + for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (name != NULL) { @@ -314,8 +325,8 @@ DdeSetServerName( return ""; } - - /* + + /* * Get the list of currently registered Tcl interpreters by calling * the internal implementation of the 'dde services' command. */ @@ -323,7 +334,7 @@ DdeSetServerName( actualName = name; if (!exactName) { - r = DdeGetServicesList(interp, "TclEval", NULL); + r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL); if (r == TCL_OK) { srvListPtr = Tcl_GetObjResult(interp); } @@ -331,21 +342,21 @@ DdeSetServerName( r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount, &srvPtrPtr); } - if (r != TCL_OK) { - OutputDebugString(Tcl_GetStringResult(interp)); - return NULL; - } - + if (r != TCL_OK) { + OutputDebugString(Tcl_GetStringResult(interp)); + return NULL; + } + /* * Pick a name to use for the application. Use "name" if it's not * already in use. Otherwise add a suffix such as " #2", trying * larger and larger numbers until we eventually find one that is * unique. */ - + offset = lastSuffix = 0; suffix = 1; - + while (suffix != lastSuffix) { lastSuffix = suffix; if (suffix > 1) { @@ -358,11 +369,11 @@ DdeSetServerName( } sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix); } - + /* see if the name is already in use, if so increment suffix */ for (n = 0; n < srvCount; ++n) { Tcl_Obj* namePtr; - + Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr); if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) { suffix++; @@ -402,12 +413,12 @@ DdeSetServerName( * re-initialize with the new name */ Initialize(); - + return riPtr->name; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeGetRegistrationPtr * @@ -419,18 +430,17 @@ DdeSetServerName( * Side effects: * None * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static RegisteredInterp * -DdeGetRegistrationPtr( - Tcl_Interp *interp - ) +DdeGetRegistrationPtr(interp) + Tcl_Interp *interp; { RegisteredInterp *riPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; + for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { break; @@ -440,7 +450,7 @@ DdeGetRegistrationPtr( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DeleteProc * @@ -452,7 +462,7 @@ DdeGetRegistrationPtr( * Side effects: * The interpreter given by riPtr is unregistered. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void @@ -465,7 +475,7 @@ DeleteProc(clientData) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL; - (searchPtr != NULL) && (searchPtr != riPtr); + searchPtr != NULL && searchPtr != riPtr; prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) { /* * Empty loop body. @@ -487,47 +497,48 @@ DeleteProc(clientData) } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * ExecuteRemoteObject -- * - * Takes the package delivered by DDE and executes it in - * the server's interpreter. + * 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. + * 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. + * 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. */ +ExecuteRemoteObject(riPtr, ddeObjectPtr); + RegisteredInterp *riPtr; /* Info about this server. */ + Tcl_Obj *ddeObjectPtr; /* The object to execute. */ { - Tcl_Obj *errorObjPtr; Tcl_Obj *returnPackagePtr; int result = TCL_OK; if (riPtr->handlerPtr == NULL && Tcl_IsSafe(riPtr->interp)) { - Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied:" - " a handler procedure must be defined for use in a safe interp", -1)); + Tcl_SetObjResult(riPtr->interp, Tcl_NewStringObj("permission denied: " + "a handler procedure must be defined for use in a safe " + "interp", -1)); result = TCL_ERROR; } if (riPtr->handlerPtr != NULL) { /* add the dde request data to the handler proc list */ Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); + result = Tcl_ListObjAppendElement(riPtr->interp, cmdPtr, ddeObjectPtr); if (result == TCL_OK) { ddeObjectPtr = cmdPtr; @@ -539,12 +550,13 @@ ExecuteRemoteObject( } returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); - Tcl_ListObjAppendElement(NULL, returnPackagePtr, - Tcl_NewIntObj(result)); + + 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_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL, TCL_GLOBAL_ONLY); if (errorObjPtr) { Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr); @@ -560,40 +572,35 @@ ExecuteRemoteObject( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * 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. + * 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. + * 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 +DdeServerProc(uType, uFmt, hConv, ddeTopic, ddeItem, hData, dwData1, dwData2) + 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 + HSZ ddeTopic, ddeItem; /* String handles. 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. */ + HDDEDATA hData; /* DDE data. Transaction-type dependent. */ + DWORD dwData1, dwData2; /* Transaction-dependent data. */ { Tcl_DString dString; int len; @@ -606,240 +613,235 @@ DdeServerProc ( ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); switch(uType) { - case XTYP_CONNECT: + case XTYP_CONNECT: - /* - * Dde is trying to initialize a conversation with us. Check - * and make sure we have a valid topic. - */ + /* + * 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, (DWORD) len + 1, - CP_WINANSI); + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) 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; - } + 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; + Tcl_DStringFree(&dString); + return (HDDEDATA) FALSE; - case XTYP_CONNECT_CONFIRM: + 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. - */ + /* + * 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, (DWORD) 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; - } + len = DdeQueryString(ddeInstance, ddeTopic, NULL, 0, 0); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeTopic, utilString, (DWORD) 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; + } + Tcl_DStringFree(&dString); + return (HDDEDATA) TRUE; - case XTYP_DISCONNECT: + case XTYP_DISCONNECT: - /* - * The client has disconnected from our server. Forget this - * conversation. - */ + /* + * 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; + 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; + } + 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. + */ - case XTYP_REQUEST: + if (uFmt != CF_TEXT) { + return (HDDEDATA) FALSE; + } + ddeReturn = (HDDEDATA) FALSE; + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* - * 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. + * Empty loop body. */ + } - if (uFmt != CF_TEXT) { - return (HDDEDATA) FALSE; - } + if (convPtr != NULL) { + char *returnString; - 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, - (DWORD) len + 1, CP_WINANSI); - if (stricmp(utilString, "$TCLEVAL$EXECUTE$RESULT") == 0) { - returnString = - Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); - ddeReturn = DdeCreateDataHandle(ddeInstance, - returnString, (DWORD) len+1, 0, ddeItem, CF_TEXT, - 0); + len = DdeQueryString(ddeInstance, ddeItem, NULL, 0, CP_WINANSI); + Tcl_DStringInit(&dString); + Tcl_DStringSetLength(&dString, len); + utilString = Tcl_DStringValue(&dString); + DdeQueryString(ddeInstance, ddeItem, utilString, (DWORD) len + 1, + CP_WINANSI); + if (stricmp(utilString, TCL_DDE_EXECUTE_RESULT) == 0) { + returnString = + Tcl_GetStringFromObj(convPtr->returnPackagePtr, &len); + ddeReturn = DdeCreateDataHandle(ddeInstance, returnString, + (DWORD) len+1, 0, ddeItem, CF_TEXT, 0); + } else { + if (Tcl_IsSafe(convPtr->riPtr->interp)) { + ddeReturn = NULL; } else { - if (Tcl_IsSafe(convPtr->riPtr->interp)) { - ddeReturn = NULL; + 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, (DWORD) 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, (DWORD) len+1, 0, ddeItem, - CF_TEXT, 0); - } else { - ddeReturn = NULL; - } + 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; + Tcl_DStringFree(&dString); + } + return ddeReturn; - for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) - && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { - /* - * Empty loop body. - */ + case XTYP_EXECUTE: { - } + /* + * Execute this script. The results will be saved into + * a list object which will be retreived later. See + * ExecuteRemoteObject. + */ - if (convPtr == NULL) { - return (HDDEDATA) DDE_FNOTPROCESSED; - } + Tcl_Obj *returnPackagePtr; - utilString = (char *) DdeAccessData(hData, &dlen); - len = dlen; - 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); - Tcl_IncrRefCount(returnPackagePtr); - for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) - && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { - /* - * Empty loop body. - */ + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { + /* + * Empty loop body. + */ + } - } - if (convPtr != NULL) { - convPtr->returnPackagePtr = returnPackagePtr; - } else { - Tcl_DecrRefCount(returnPackagePtr); - } - Tcl_DecrRefCount(ddeObjectPtr); - if (returnPackagePtr == NULL) { - return (HDDEDATA) DDE_FNOTPROCESSED; - } else { - return (HDDEDATA) DDE_FACK; - } + if (convPtr == NULL) { + return (HDDEDATA) DDE_FNOTPROCESSED; } - - case XTYP_WILDCONNECT: { + utilString = (char *) DdeAccessData(hData, &dlen); + len = dlen; + 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); + Tcl_IncrRefCount(returnPackagePtr); + for (convPtr = tsdPtr->currentConversations; (convPtr != NULL) + && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) { /* - * Dde wants a list of services and topics that we support. + * Empty loop body. */ + } + if (convPtr != NULL) { + convPtr->returnPackagePtr = returnPackagePtr; + } else { + Tcl_DecrRefCount(returnPackagePtr); + } + Tcl_DecrRefCount(ddeObjectPtr); + if (returnPackagePtr == NULL) { + return (HDDEDATA) DDE_FNOTPROCESSED; + } else { + return (HDDEDATA) DDE_FACK; + } + } - HSZPAIR *returnPtr; - int i; - int numItems; + case XTYP_WILDCONNECT: { - for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL; - i++, riPtr = riPtr->nextPtr) { - /* - * Empty loop body. - */ + /* + * Dde wants a list of services and topics that we support. + */ - } + HSZPAIR *returnPtr; + int i; + int numItems; - numItems = i; - ddeReturn = DdeCreateDataHandle(ddeInstance, NULL, - (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0); - returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &dlen); - len = dlen; - 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; + 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, &dlen); + len = dlen; + for (i = 0, riPtr = tsdPtr->interpListPtr; i < numItems; + i++, riPtr = riPtr->nextPtr) { + returnPtr[i].hszSvc = DdeCreateStringHandle(ddeInstance, + TCL_DDE_SERVICE_NAME, CP_WINANSI); + returnPtr[i].hszTopic = DdeCreateStringHandle(ddeInstance, + riPtr->name, CP_WINANSI); + } + returnPtr[i].hszSvc = NULL; + returnPtr[i].hszTopic = NULL; + DdeUnaccessData(ddeReturn); + return ddeReturn; + } + + default: + return NULL; } - return NULL; } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeExitProc -- * @@ -851,12 +853,12 @@ DdeServerProc ( * Side effects: * The DDE server is deleted. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ static void -DdeExitProc( - ClientData clientData) /* Not used in this handler. */ +DdeExitProc(clientData) + ClientData clientData; /* Not used in this handler. */ { DdeNameService(ddeInstance, NULL, 0, DNS_UNREGISTER); DdeUninitialize(ddeInstance); @@ -864,33 +866,32 @@ DdeExitProc( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * MakeDdeConnection -- * - * This procedure is a utility used to connect to a DDE - * server when given a server name and a topic name. + * 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) +MakeDdeConnection(interp, name, ddeConvPtr) + Tcl_Interp *interp; /* Used to report errors. */ + char *name; /* The connection to use. */ + HCONV *ddeConvPtr; { HSZ ddeTopic, ddeService; HCONV ddeConv; - - ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0); + + ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0); ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0); ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); @@ -910,14 +911,16 @@ MakeDdeConnection( } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * DdeGetServicesList -- * * This procedure obtains the list of DDE services. * - * The functions between here and this procedure are all - * involved with handling the DDE callbacks for this. + * The functions between here and this procedure are all involved + * with handling the DDE callbacks for this. They are: + * DdeCreateClient, DdeClientWindowProc, DdeServicesOnAck, and + * DdeEnumWindowsCallback * * Results: * A standard Tcl result. @@ -925,24 +928,12 @@ MakeDdeConnection( * Side effects: * Sets the services list into the interp result. * - *-------------------------------------------------------------- + *---------------------------------------------------------------------- */ -typedef struct ddeEnumServices { - Tcl_Interp *interp; - int result; - ATOM service; - ATOM topic; - HWND hwnd; -} ddeEnumServices; - -LRESULT CALLBACK -DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam); -static LRESULT -DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam); - static int -DdeCreateClient(ddeEnumServices *es) +DdeCreateClient(es) + struct DdeEnumServices *es; { WNDCLASSEX wc; static const char *szDdeClientClassName = "TclEval client class"; @@ -952,82 +943,89 @@ DdeCreateClient(ddeEnumServices *es) wc.cbSize = sizeof(wc); wc.lpfnWndProc = DdeClientWindowProc; wc.lpszClassName = szDdeClientClassName; - wc.cbWndExtra = sizeof(ddeEnumServices*); + wc.cbWndExtra = sizeof(struct DdeEnumServices *); /* register and create the callback window */ RegisterClassEx(&wc); - es->hwnd = CreateWindowEx(0, szDdeClientClassName, - szDdeClientWindowName, - WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, - (LPVOID)es); + es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName, + WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es); return TCL_OK; } -LRESULT CALLBACK -DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam) +static LRESULT CALLBACK +DdeClientWindowProc(hwnd, uMsg, wParam, lParam) + HWND hwnd; /* What window is the message for */ + UINT uMsg; /* The type of message received */ + WPARAM wParam; + LPARAM lParam; /* (Potentially) our local handle */ { LRESULT lr = 0L; switch (uMsg) { - case WM_CREATE: { - LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam; - ddeEnumServices *es; - es = (ddeEnumServices*)lpcs->lpCreateParams; + case WM_CREATE: { + LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam; + struct DdeEnumServices *es = + (struct DdeEnumServices *) lpcs->lpCreateParams; + #ifdef _WIN64 - SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es); + SetWindowLongPtr(hwnd, GWLP_USERDATA, (long)es); #else - SetWindowLong(hwnd, GWL_USERDATA, (long)es); + SetWindowLong(hwnd, GWL_USERDATA, (long)es); #endif - break; - } - case WM_DDE_ACK: - lr = DdeServicesOnAck(hwnd, wParam, lParam); - break; - default: - lr = DefWindowProc(hwnd, uMsg, wParam, lParam); + return (LRESULT) 0L; + } + case WM_DDE_ACK: + return DdeServicesOnAck(hwnd, wParam, lParam); + break; + default: + return DefWindowProc(hwnd, uMsg, wParam, lParam); } - return lr; } static LRESULT -DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam) +DdeServicesOnAck(hwnd, wParam, lParam) + HWND hwnd; + WPARAM wParam; + LPARAM lParam; { HWND hwndRemote = (HWND)wParam; ATOM service = (ATOM)LOWORD(lParam); ATOM topic = (ATOM)HIWORD(lParam); - ddeEnumServices *es; + struct DdeEnumServices *es; TCHAR sz[255]; #ifdef _WIN64 - es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA); + es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA); #else - es = (ddeEnumServices *)GetWindowLong(hwnd, GWL_USERDATA); + es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA); #endif if ((es->service == (ATOM)NULL || es->service == service) - && (es->topic == (ATOM)NULL || es->topic == topic)) { + && (es->topic == (ATOM)NULL || es->topic == topic)) { Tcl_Obj *matchPtr = Tcl_NewListObj(0, NULL); Tcl_Obj *resultPtr = Tcl_GetObjResult(es->interp); GlobalGetAtomName((ATOM)service, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, - Tcl_NewStringObj(sz, -1)); + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); GlobalGetAtomName(topic, sz, 255); - Tcl_ListObjAppendElement(NULL, matchPtr, - Tcl_NewStringObj(sz, -1)); - /* Adding the hwnd as a third list element provides a unique + Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1)); + + /* + * Adding the hwnd as a third list element provides a unique * identifier in the case of multiple servers with the name * application and topic names. */ - /* Needs a TIP though + /* + * Needs a TIP though: * Tcl_ListObjAppendElement(NULL, matchPtr, * Tcl_NewLongObj((long)hwndRemote)); */ + if (Tcl_IsShared(resultPtr)) { resultPtr = Tcl_DuplicateObj(resultPtr); } - if (Tcl_ListObjAppendElement(es->interp, resultPtr, matchPtr) - == TCL_OK) { + if (Tcl_ListObjAppendElement(es->interp, resultPtr, + matchPtr) == TCL_OK) { Tcl_SetObjResult(es->interp, resultPtr); } } @@ -1038,35 +1036,38 @@ DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam) } static BOOL CALLBACK -DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam) +DdeEnumWindowsCallback(hwndTarget, lParam) + HWND hwndTarget; + LPARAM lParam; { LRESULT dwResult = 0; - ddeEnumServices *es = (ddeEnumServices *)lParam; - SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, - (WPARAM)es->hwnd, - MAKELONG(es->service, es->topic), - SMTO_ABORTIFHUNG, 1000, &dwResult); + struct DdeEnumServices *es = (struct DdeEnumServices *) lParam; + + SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd, + MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000, + &dwResult); return TRUE; } static int -DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) +DdeGetServicesList(interp, serviceName, topicName) + Tcl_Interp *interp; + char *serviceName, *topicName; { - ddeEnumServices es; + struct DdeEnumServices es; es.interp = interp; es.result = TCL_OK; - es.service = (serviceName == NULL) - ? (ATOM)NULL : GlobalAddAtom(serviceName); - es.topic = (topicName == NULL) - ? (ATOM)NULL : GlobalAddAtom(topicName); - + es.service = (serviceName == NULL) + ? (ATOM)NULL : GlobalAddAtom(serviceName); + es.topic = (topicName == NULL) ? (ATOM)NULL : GlobalAddAtom(topicName); + Tcl_ResetResult(interp); /* our list is to be appended to result. */ DdeCreateClient(&es); EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es); - + if (IsWindow(es.hwnd)) { - DestroyWindow(es.hwnd); + DestroyWindow(es.hwnd); } if (es.service != (ATOM)NULL) { GlobalDeleteAtom(es.service); @@ -1078,53 +1079,49 @@ DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName) } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * SetDdeError -- * - * Sets the interp result to a cogent error message - * describing the last DDE error. + * 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.*/ +SetDdeError(interp) + Tcl_Interp *interp; /* The interp to put the message in. */ { - switch (DdeGetLastError(ddeInstance)) { - case DMLERR_DATAACKTIMEOUT: - case DMLERR_EXECACKTIMEOUT: - case DMLERR_POKEACKTIMEOUT: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "remote interpreter did not respond", -1)); - break; + char *errorMessage; - case DMLERR_BUSY: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "remote server is busy", -1)); - break; - - case DMLERR_NOTPROCESSED: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "remote server cannot handle this command", -1)); - break; - - default: - Tcl_SetObjResult(interp, - Tcl_NewStringObj("dde command failed", -1)); + switch (DdeGetLastError(ddeInstance)) { + case DMLERR_DATAACKTIMEOUT: + case DMLERR_EXECACKTIMEOUT: + case DMLERR_POKEACKTIMEOUT: + errorMessage = "remote interpreter did not respond"; + break; + case DMLERR_BUSY: + errorMessage = "remote server is busy"; + break; + case DMLERR_NOTPROCESSED: + errorMessage = "remote server cannot handle this command"; + break; + default: + errorMessage = "dde command failed"; } + + Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1)); } /* - *-------------------------------------------------------------- + *---------------------------------------------------------------------- * * Tcl_DdeObjCmd -- * @@ -1137,64 +1134,53 @@ SetDdeError( * 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 */ +Tcl_DdeObjCmd(clientData, interp, objc, objv) + 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, + static CONST char *ddeCommands[] = { + "servername", "execute", "poke", "request", "services", "eval", + (char *) NULL + }; + enum DdeSubcommands { + DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES, DDE_EVAL }; - - enum { - DDE_SERVERNAME_EXACT, - DDE_SERVERNAME_HANDLER, - DDE_SERVERNAME_LAST, + static CONST char *ddeSrvOptions[] = { + "-force", "-handler", "--", (char *) NULL + }; + enum DdeSrvOptions { + DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST, + }; + static CONST char *ddeExecOptions[] = { + "-async", (char *) NULL + }; + static CONST char *ddeReqOptions[] = { + "-binary", (char *) NULL }; - static CONST char *ddeCommands[] = {"servername", "execute", "poke", - "request", "services", "eval", - (char *) NULL}; - static CONST char *ddeOptions[] = {"-async", (char *) NULL}; - static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL}; - static CONST char *ddeSrvOptions[] = {"-force", "-handler", "--", (char *) NULL}; - int index, argIndex, i; + int index, i, length; int async = 0, binary = 0, exact = 0; - int result = TCL_OK; - HSZ ddeService = NULL; - HSZ ddeTopic = NULL; - HSZ ddeItem = NULL; - HDDEDATA ddeData = NULL; - HDDEDATA ddeItemData = NULL; + int result = TCL_OK, firstArg = 0; + HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL; + HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn; HCONV hConv = NULL; - HSZ ddeCookie = 0; - char *serviceName = NULL, *topicName = NULL, *itemString, *dataString; - char *string; - int firstArg = 0, length, dataLength; + char *serviceName = NULL, *topicName = NULL, *string; DWORD ddeResult; - HDDEDATA ddeReturn; - RegisteredInterp *riPtr; - Tcl_Interp *sendInterp; Tcl_Obj *objPtr, *handlerPtr = NULL; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Initialize DDE server/client */ - + if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, - "?-async? serviceName topicName value"); + Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } @@ -1203,138 +1189,117 @@ Tcl_DdeObjCmd( return TCL_ERROR; } - switch (index) { - case DDE_SERVERNAME: - for (i = 2; i < objc; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, - "option", 0, &argIndex) != TCL_OK) { - break; - } else if (argIndex == DDE_SERVERNAME_EXACT) { - exact = 1; - } else if (argIndex == DDE_SERVERNAME_HANDLER) { - if ((objc - i) == 1) { /* return current handler */ - RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); - if (riPtr && riPtr->handlerPtr) { - Tcl_SetObjResult(interp, riPtr->handlerPtr); - } else { - Tcl_ResetResult(interp); - } - return TCL_OK; - } - handlerPtr = objv[++i]; - } else if (argIndex == DDE_SERVERNAME_LAST) { - i++; - break; - } else { - Tcl_ResetResult(interp); - Tcl_AppendResult(interp, "bad option \"", - Tcl_GetString(objv[i]), - "\": must be -force, -handler or --", (char*)NULL); + switch ((enum DdeSubcommands) index) { + case DDE_SERVERNAME: + for (i = 2; i < objc; i++) { + enum DdeSrvOptions argIndex; + if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions, + "option", 0, (int *) &argIndex) != TCL_OK) { + /* + * If it is the last argument, it might be a server + * name instead of a bad argument. + */ + if (i != objc-1) { return TCL_ERROR; } - } - - if ((objc - i) > 1) { Tcl_ResetResult(interp); - Tcl_WrongNumArgs(interp, 1, objv, - "servername ?-force? ?-handler proc? ?--?" - " ?serverName?"); - return TCL_ERROR; - } - - firstArg = (objc == i) ? 1 : i; - break; - case DDE_EXECUTE: - if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, - "execute ?-async? serviceName topicName value"); - return TCL_ERROR; + break; } - 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; + if (argIndex == DDE_SERVERNAME_EXACT) { + exact = 1; + } else if (argIndex == DDE_SERVERNAME_HANDLER) { + if ((objc - i) == 1) { /* return current handler */ + RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp); + if (riPtr && riPtr->handlerPtr) { + Tcl_SetObjResult(interp, riPtr->handlerPtr); + } else { + Tcl_ResetResult(interp); + } + return TCL_OK; } - async = 1; - firstArg = 3; + handlerPtr = objv[++i]; + } else if (argIndex == DDE_SERVERNAME_LAST) { + i++; + break; } + } + + if ((objc - i) > 1) { + Tcl_ResetResult(interp); + Tcl_WrongNumArgs(interp, 2, objv, + "?-force? ?-handler proc? ?--? ?serverName?"); + return TCL_ERROR; + } + + firstArg = (objc == i) ? 1 : i; + break; + case DDE_EXECUTE: + if (objc == 5) { + firstArg = 2; break; - case DDE_POKE: - if (objc != 6) { - Tcl_WrongNumArgs(interp, 1, objv, - "poke serviceName topicName item value"); - return TCL_ERROR; + } else if (objc == 6) { + int dummy; + if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &dummy) == TCL_OK) { + async = 1; + firstArg = 3; + break; } + } + /* otherwise... */ + Tcl_WrongNumArgs(interp, 2, objv, + "?-async? serviceName topicName value"); + return TCL_ERROR; + case DDE_POKE: + if (objc != 6) { + Tcl_WrongNumArgs(interp, 2, objv, + "serviceName topicName item value"); + return TCL_ERROR; + } + firstArg = 2; + break; + case DDE_REQUEST: + if (objc == 5) { firstArg = 2; break; - case DDE_REQUEST: - if ((objc < 5) || (objc > 6)) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } + } else if (objc == 6) { + int dummy; if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0, - &argIndex) != TCL_OK) { - if (objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } - binary = 0; - firstArg = 2; - } else { - if (objc != 6) { - Tcl_WrongNumArgs(interp, 1, objv, - "request ?-binary? serviceName topicName value"); - return TCL_ERROR; - } + &dummy) == TCL_OK) { binary = 1; firstArg = 3; + break; } - break; - case DDE_SERVICES: - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, - "services serviceName topicName"); - return TCL_ERROR; - } + } + /* otherwise ... */ + Tcl_WrongNumArgs(interp, 2, objv, + "?-binary? serviceName topicName value"); + return TCL_ERROR; + case DDE_SERVICES: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "serviceName topicName"); + return TCL_ERROR; + } + firstArg = 2; + break; + case DDE_EVAL: + if (objc < 4) { + wrongDdeEvalArgs: + Tcl_WrongNumArgs(interp, 2, objv, "?-async? serviceName args"); + return TCL_ERROR; + } else { + int dummy; 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 (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0, + &dummy) == TCL_OK) { if (objc < 5) { - Tcl_WrongNumArgs(interp, 1, objv, - "eval ?-async? serviceName args"); - return TCL_ERROR; + goto wrongDdeEvalArgs; } async = 1; - firstArg = 3; + firstArg++; } break; + } } Initialize(); @@ -1352,366 +1317,364 @@ Tcl_DdeObjCmd( CP_WINANSI); } - if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) { + 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); + ddeTopic = DdeCreateStringHandle(ddeInstance, topicName, + CP_WINANSI); } } - switch (index) { - case DDE_SERVERNAME: { - serviceName = DdeSetServerName(interp, serviceName, - exact, handlerPtr); - if (serviceName != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); - } else { - Tcl_ResetResult(interp); - } + switch ((enum DdeSubcommand) index) { + case DDE_SERVERNAME: + serviceName = DdeSetServerName(interp, serviceName, exact, handlerPtr); + if (serviceName != NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1)); + } else { + Tcl_ResetResult(interp); + } + break; + + case DDE_EXECUTE: { + int dataLength; + char *dataString = Tcl_GetStringFromObj(objv[firstArg + 2], + &dataLength); + + if (dataLength == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot execute null data", -1)); + result = TCL_ERROR; break; } - case DDE_EXECUTE: { - dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength); - if (dataLength == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot execute null data", -1)); - result = TCL_ERROR; - break; - } - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - break; + if (hConv == NULL) { + SetDdeError(interp); + result = TCL_ERROR; + break; + } + + ddeData = DdeCreateDataHandle(ddeInstance, dataString, + (DWORD) 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: { + char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + if (length == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot request value of null data", -1)); + result = TCL_ERROR; + goto cleanup; + } + hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); + DdeFreeStringHandle(ddeInstance, ddeService); + DdeFreeStringHandle(ddeInstance, ddeTopic); - ddeData = DdeCreateDataHandle(ddeInstance, dataString, - (DWORD) 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); + 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 { - ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, - hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL); - if (ddeReturn == 0) { - SetDdeError(interp); - result = TCL_ERROR; + DWORD tmp; + char *dataString = DdeAccessData(ddeData, &tmp); + + if (binary) { + returnObjPtr = Tcl_NewByteArrayObj(dataString, + (int) tmp); + } else { + returnObjPtr = Tcl_NewStringObj(dataString, -1); } + DdeUnaccessData(ddeData); + DdeFreeDataHandle(ddeData); + Tcl_SetObjResult(interp, returnObjPtr); } - DdeFreeDataHandle(ddeData); } else { SetDdeError(interp); result = TCL_ERROR; } - break; } - case DDE_REQUEST: { - itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - if (length == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot request value of null data", -1)); - goto errorNoResult; - } - 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 { - DWORD tmp; - dataString = DdeAccessData(ddeData, &tmp); - dataLength = tmp; - if (binary) { - returnObjPtr = Tcl_NewByteArrayObj(dataString, - dataLength); - } else { - returnObjPtr = Tcl_NewStringObj(dataString, -1); - } - DdeUnaccessData(ddeData); - DdeFreeDataHandle(ddeData); - Tcl_SetObjResult(interp, returnObjPtr); - } - } else { - SetDdeError(interp); - result = TCL_ERROR; - } - } - break; + break; + } + case DDE_POKE: { + char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); + char *dataString; + + if (length == 0) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("cannot have a null item", -1)); + result = TCL_ERROR; + goto cleanup; } - case DDE_POKE: { - itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length); - if (length == 0) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot have a null item", -1)); - goto errorNoResult; - } - dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length); - - hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL); - DdeFreeStringHandle(ddeInstance, ddeService); - DdeFreeStringHandle(ddeInstance, ddeTopic); + dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length); - if (hConv == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } else { - ddeItem = DdeCreateStringHandle(ddeInstance, itemString, - CP_WINANSI); - if (ddeItem != NULL) { - ddeData = DdeClientTransaction(dataString, (DWORD) length+1, - hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL); - if (ddeData == NULL) { - SetDdeError(interp); - result = TCL_ERROR; - } - } else { + 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, (DWORD) 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; } + break; + } - case DDE_SERVICES: { - result = DdeGetServicesList(interp, serviceName, topicName); - break; + case DDE_SERVICES: + result = DdeGetServicesList(interp, serviceName, topicName); + break; + + case DDE_EVAL: { + RegisteredInterp *riPtr; + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (serviceName == NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid service name \"\"", -1)); + result = TCL_ERROR; + goto cleanup; } - case DDE_EVAL: { - if (serviceName == NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invalid service name \"\"", -1)); - goto errorNoResult; + + 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; } + } - 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. + if (riPtr != NULL) { + Tcl_Interp *sendInterp; + + /* + * This command is to a local interp. No need to go through + * the server. */ - - 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. - */ + Tcl_Preserve((ClientData) riPtr); + sendInterp = riPtr->interp; + Tcl_Preserve((ClientData) sendInterp); - if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { - Tcl_SetResult(riPtr->interp, "permission denied: " - "a handler procedure must be defined for use in a safe interp", TCL_STATIC); - result = TCL_ERROR; - } + /* + * 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 (result == TCL_OK) { - if (objc == 1) - objPtr = objv[0]; - else { - objPtr = Tcl_ConcatObj(objc, objv); - } - if (riPtr->handlerPtr != NULL) { - /* add the dde request data to the handler proc list */ - /*result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1, &(riPtr->handlerPtr));*/ - Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); - result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, objPtr); - if (result == TCL_OK) { - objPtr = cmdPtr; - } - } - } - if (result == TCL_OK) { - 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); - if (objPtr) { - string = Tcl_GetStringFromObj(objPtr, &length); - Tcl_AddObjErrorInfo(interp, string, length); - } - - objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, - TCL_GLOBAL_ONLY); - if (objPtr) { - 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; + if (Tcl_IsSafe(riPtr->interp) && riPtr->handlerPtr == NULL) { + Tcl_SetResult(riPtr->interp, "permission denied: " + "a handler procedure must be defined for use in " + "a safe interp", TCL_STATIC); + result = TCL_ERROR; + } + + if (result == TCL_OK) { + if (objc == 1) + objPtr = objv[0]; + else { + objPtr = Tcl_ConcatObj(objc, objv); } - - objPtr = Tcl_ConcatObj(objc, objv); - string = Tcl_GetStringFromObj(objPtr, &length); - ddeItemData = DdeCreateDataHandle(ddeInstance, string, - (DWORD) 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); + if (riPtr->handlerPtr != NULL) { + /* add the dde request data to the handler proc list */ + /* + *result = Tcl_ListObjReplace(sendInterp, objPtr, 0, 0, 1, + * &(riPtr->handlerPtr)); + */ + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(riPtr->handlerPtr); + result = Tcl_ListObjAppendElement(sendInterp, cmdPtr, + objPtr); + if (result == TCL_OK) { + objPtr = cmdPtr; } } - + } + if (result == TCL_OK) { + Tcl_IncrRefCount(objPtr); + result = Tcl_EvalObjEx(sendInterp, objPtr, TCL_EVAL_GLOBAL); Tcl_DecrRefCount(objPtr); - - if (ddeData == 0) { - SetDdeError(interp); - goto errorNoResult; - } - - if (async == 0) { - Tcl_Obj *resultPtr; - + } + if (interp != sendInterp) { + if (result == TCL_ERROR) { /* - * 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". + * An error occurred, so transfer error information + * from the destination interpreter back to our + * interpreter. */ - - resultPtr = Tcl_NewObj(); - length = DdeGetData(ddeData, NULL, 0, 0); - Tcl_SetObjLength(resultPtr, length); - string = Tcl_GetString(resultPtr); - DdeGetData(ddeData, string, (DWORD) length, 0); - Tcl_SetObjLength(resultPtr, (int) 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; + Tcl_ResetResult(interp); + objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, + TCL_GLOBAL_ONLY); + if (objPtr) { string = Tcl_GetStringFromObj(objPtr, &length); Tcl_AddObjErrorInfo(interp, string, length); - - Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr); + } + + objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL, + TCL_GLOBAL_ONLY); + if (objPtr) { Tcl_SetObjErrorCode(interp, objPtr); } - if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) - != TCL_OK) { + } + 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) { + invalidServerResponse: + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid data returned from server", + -1)); + result = TCL_ERROR; + goto cleanup; + } + + objPtr = Tcl_ConcatObj(objc, objv); + string = Tcl_GetStringFromObj(objPtr, &length); + ddeItemData = DdeCreateDataHandle(ddeInstance, string, + (DWORD) 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, + TCL_DDE_EXECUTE_RESULT, CP_WINANSI); + ddeData = DdeClientTransaction(NULL, 0, hConv, ddeCookie, + CF_TEXT, XTYP_REQUEST, 30000, NULL); + } + } + + Tcl_DecrRefCount(objPtr); + + if (ddeData == 0) { + SetDdeError(interp); + result = TCL_ERROR; + } + + 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, (DWORD) length, 0); + Tcl_SetObjLength(resultPtr, (int) strlen(string)); + + if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr) != TCL_OK) { + Tcl_DecrRefCount(resultPtr); + goto invalidServerResponse; + } + if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) { + Tcl_DecrRefCount(resultPtr); + goto invalidServerResponse; + } + if (result == TCL_ERROR) { + Tcl_ResetResult(interp); + + if (Tcl_ListObjIndex(NULL, resultPtr, 3, + &objPtr) != TCL_OK) { Tcl_DecrRefCount(resultPtr); - goto error; + goto invalidServerResponse; } - Tcl_SetObjResult(interp, objPtr); + 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 invalidServerResponse; } + 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_SetObjResult(interp, Tcl_NewStringObj( - "invalid data returned from server", -1)); - errorNoResult: + cleanup: if (ddeCookie != NULL) { DdeFreeStringHandle(ddeInstance, ddeCookie); } @@ -1727,13 +1690,13 @@ Tcl_DdeObjCmd( if (hConv != NULL) { DdeDisconnect(hConv); } - return TCL_ERROR; + return result; } /* * Local variables: - * mode: c - * indent-tabs-mode: t - * tab-width: 8 + * mode: c + * indent-tabs-mode: t + * tab-width: 8 * End: */ -- cgit v0.12