summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2004-11-25 11:28:17 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2004-11-25 11:28:17 (GMT)
commit5f26f53fc89bc313d43da3f58d2dcdee21d1bc1c (patch)
tree1a17ae1c46cfb383b2682a8591a5acaff563cd87 /win
parent9a60fe478e4153e06a2fadca792181e3826fa0e8 (diff)
downloadtcl-5f26f53fc89bc313d43da3f58d2dcdee21d1bc1c.zip
tcl-5f26f53fc89bc313d43da3f58d2dcdee21d1bc1c.tar.gz
tcl-5f26f53fc89bc313d43da3f58d2dcdee21d1bc1c.tar.bz2
Assorted cleanup and doc-fixes for the dde package.
Diffstat (limited to 'win')
-rw-r--r--win/tclWinDde.c1719
1 files changed, 841 insertions, 878 deletions
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 <dde.h>
#include <ddeml.h>
#include <tchar.h>
+
/*
* TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Registry_Init declaration is in the source file itself, which is only
- * 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:
*/