summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog8
-rw-r--r--library/dde/pkgIndex.tcl4
-rw-r--r--win/Makefile.in10
-rwxr-xr-xwin/configure4
-rw-r--r--win/configure.in6
-rw-r--r--win/tclWinDde.c1885
6 files changed, 859 insertions, 1058 deletions
diff --git a/ChangeLog b/ChangeLog
index 3405dea..4c2d510 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,11 +4,9 @@
* win/tclWinReg.c: version 1.1.4 (should have been done
for the Tcl 8.4.8 release!)
- * library/dde/pkgIndex.tcl: Backport dde 1.3.2 from HEAD.
- * win/tclWinDde.c:
- * win/Makefile.in:
- * win/configure.in:
- * win/configure: autoconf 2.13
+ * library/dde/pkgIndex.tcl: Long overlooked bump to dde package
+ * win/tclWinDde.c: version 1.2.4 (should have been done
+ for the Tcl 8.4.8 release!)
2006-04-05 Donal K. Fellows <donal.k.fellows@man.ac.uk>
diff --git a/library/dde/pkgIndex.tcl b/library/dde/pkgIndex.tcl
index 3125ada..f993012 100644
--- a/library/dde/pkgIndex.tcl
+++ b/library/dde/pkgIndex.tcl
@@ -1,7 +1,7 @@
if {![package vsatisfies [package provide Tcl] 8]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[info exists ::tcl_platform(debug)]} {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
+ package ifneeded dde 1.2.4 [list load [file join $dir tcldde12g.dll] dde]
} else {
- package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
+ package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde]
}
diff --git a/win/Makefile.in b/win/Makefile.in
index fcace15..6c796ed 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.68.2.5 2006/04/05 16:50:04 dgp Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.68.2.6 2006/04/05 20:50:46 dgp Exp $
VERSION = @TCL_VERSION@
@@ -437,7 +437,7 @@ install-binaries: binaries
else true; \
fi; \
done;
- @for i in dde1.3 reg1.1; \
+ @for i in dde1.2 reg1.1; \
do \
if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
@@ -461,13 +461,13 @@ install-binaries: binaries
done
@if [ -f $(DDE_DLL_FILE) ]; then \
echo installing $(DDE_DLL_FILE); \
- $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
$(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
- $(LIB_INSTALL_DIR)/dde1.3; \
+ $(LIB_INSTALL_DIR)/dde1.2; \
fi
@if [ -f $(DDE_LIB_FILE) ]; then \
echo installing $(DDE_LIB_FILE); \
- $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
+ $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
fi
@if [ -f $(REG_DLL_FILE) ]; then \
echo installing $(REG_DLL_FILE); \
diff --git a/win/configure b/win/configure
index 721fffb..cd4e32e 100755
--- a/win/configure
+++ b/win/configure
@@ -537,9 +537,9 @@ TCL_MINOR_VERSION=4
TCL_PATCH_LEVEL=".13"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.2
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=2
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.1
diff --git a/win/configure.in b/win/configure.in
index b63bba0..51f1b5b 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -3,7 +3,7 @@
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.68.2.16 2006/04/05 16:50:04 dgp Exp $
+# RCS: @(#) $Id: configure.in,v 1.68.2.17 2006/04/05 20:50:46 dgp Exp $
AC_INIT(../generic/tcl.h)
AC_PREREQ(2.13)
@@ -14,9 +14,9 @@ TCL_MINOR_VERSION=4
TCL_PATCH_LEVEL=".13"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
-TCL_DDE_VERSION=1.3
+TCL_DDE_VERSION=1.2
TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=3
+TCL_DDE_MINOR_VERSION=2
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION
TCL_REG_VERSION=1.1
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 4a47684..00e41a9 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -1,33 +1,33 @@
-/*
+/*
* tclWinDde.c --
*
- * This file provides functions that implement the "send" command,
- * allowing commands to be passed from interpreter to interpreter.
+ * This file provides procedures that implement the "send"
+ * command, allowing commands to be passed from interpreter
+ * to interpreter.
*
* Copyright (c) 1997 by Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * 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.13.2.6 2006/04/05 16:50:04 dgp Exp $
+ * RCS: @(#) $Id: tclWinDde.c,v 1.13.2.7 2006/04/05 20:50:46 dgp Exp $
*/
-#include "tclInt.h"
+#include "tclPort.h"
#include <dde.h>
#include <ddeml.h>
#include <tchar.h>
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the 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.
+ * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
+ * Registry_Init declaration is in the source file itself, which is only
+ * accessed when we are building a library.
*/
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
-/*
+/*
* The following structure is used to keep track of the interpreters
* registered by this process.
*/
@@ -37,7 +37,6 @@ typedef struct RegisteredInterp {
/* The next interp this application knows
* about. */
char *name; /* Interpreter's name (malloc-ed). */
- Tcl_Obj *handlerPtr; /* The server handler command */
Tcl_Interp *interp; /* The interpreter attached to this name. */
} RegisteredInterp;
@@ -53,77 +52,64 @@ 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;
-} DdeEnumServices;
-
typedef struct ThreadSpecificData {
Conversation *currentConversations;
- /* A list of conversations currently being
- * processed. */
+ /* A list of conversations currently
+ * being processed. */
RegisteredInterp *interpListPtr;
- /* List of all interpreters registered in the
- * current process. */
+ /* List of all interpreters registered
+ * in the current process. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
- * The following variables cannot be placed in thread-local storage. The Mutex
- * ddeMutex guards access to the ddeInstance.
+ * 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 DWORD ddeInstance; /* The application instance handle given
+ * to us by DdeInitialize. */
static int ddeIsServer = 0;
-#define TCL_DDE_VERSION "1.3.2"
-#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
-#define TCL_DDE_EXECUTE_RESULT "$TCLEVAL$EXECUTE$RESULT"
+#define TCL_DDE_VERSION "1.2.4"
+#define TCL_DDE_PACKAGE_NAME "dde"
+#define TCL_DDE_SERVICE_NAME "TclEval"
TCL_DECLARE_MUTEX(ddeMutex)
/*
- * Forward declarations for functions defined later in this file.
+ * Forward declarations for procedures defined later in this file.
*/
-static LRESULT CALLBACK DdeClientWindowProc(HWND hwnd, UINT uMsg,
- WPARAM wParam, LPARAM lParam);
-static int DdeCreateClient(struct DdeEnumServices *es);
-static BOOL CALLBACK DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam);
-static void DdeExitProc(ClientData clientData);
-static int DdeGetServicesList(Tcl_Interp *interp,
- char *serviceName, char *topicName);
-static HDDEDATA CALLBACK DdeServerProc(UINT uType, UINT uFmt, HCONV hConv,
- HSZ ddeTopic, HSZ ddeItem, HDDEDATA hData,
- DWORD dwData1, DWORD dwData2);
-static LRESULT DdeServicesOnAck(HWND hwnd, WPARAM wParam,
- LPARAM lParam);
-static void DeleteProc(ClientData clientData);
-static Tcl_Obj * ExecuteRemoteObject(RegisteredInterp *riPtr,
- Tcl_Obj *ddeObjectPtr);
-static int MakeDdeConnection(Tcl_Interp *interp, char *name,
- HCONV *ddeConvPtr);
-static void SetDdeError(Tcl_Interp *interp);
-
-int Tcl_DdeObjCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[]);
-
-EXTERN int Dde_Init(Tcl_Interp *interp);
-EXTERN int Dde_SafeInit(Tcl_Interp *interp);
+static void DdeExitProc _ANSI_ARGS_((ClientData clientData));
+static void DeleteProc _ANSI_ARGS_((ClientData clientData));
+static Tcl_Obj * ExecuteRemoteObject _ANSI_ARGS_((
+ RegisteredInterp *riPtr,
+ Tcl_Obj *ddeObjectPtr));
+static int MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, HCONV *ddeConvPtr));
+static HDDEDATA CALLBACK DdeServerProc _ANSI_ARGS_((UINT uType,
+ UINT uFmt, HCONV hConv, HSZ ddeTopic,
+ HSZ ddeItem, HDDEDATA hData, DWORD dwData1,
+ DWORD dwData2));
+static void SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
+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);
/*
*----------------------------------------------------------------------
*
* Dde_Init --
*
- * This function initializes the dde command.
+ * This procedure initializes the dde command.
*
* Results:
* A standard Tcl result.
@@ -145,36 +131,12 @@ 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);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Dde_SafeInit --
- *
- * This function initializes the dde command within a safe interp
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-int
-Dde_SafeInit(
- Tcl_Interp *interp)
-{
- int result = Dde_Init(interp);
- if (result == TCL_OK) {
- Tcl_HideCommand(interp, "dde", "dde");
- }
- return result;
+ return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
}
/*
@@ -198,11 +160,11 @@ Initialize(void)
{
int nameFound = 0;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
+
/*
- * See if the application is already registered; if so, remove its current
- * name from the registry. The deletion of the command will take care of
- * disposing of this entry.
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
*/
if (tsdPtr->interpListPtr != NULL) {
@@ -210,16 +172,18 @@ Initialize(void)
}
/*
- * Make sure that the DDE server is there. This is done only once, add an
- * exit handler tear it down.
+ * Make sure that the DDE server is there. This is done only once,
+ * add an exit handler tear it down.
*/
if (ddeInstance == 0) {
Tcl_MutexLock(&ddeMutex);
if (ddeInstance == 0) {
if (DdeInitialize(&ddeInstance, DdeServerProc,
- CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS
- | CBF_FAIL_POKES, 0) != DMLERR_NO_ERROR) {
+ CBF_SKIP_REGISTRATIONS
+ | CBF_SKIP_UNREGISTRATIONS
+ | CBF_FAIL_POKES, 0)
+ != DMLERR_NO_ERROR) {
ddeInstance = 0;
}
}
@@ -230,7 +194,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 {
@@ -238,58 +202,54 @@ Initialize(void)
}
Tcl_MutexUnlock(&ddeMutex);
}
-}
+}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* DdeSetServerName --
*
- * This function is called to associate an ASCII name with a Dde server.
- * If the interpreter has already been named, the name replaces the old
- * one.
+ * This procedure is called to associate an ASCII name with a Dde
+ * server. If the interpreter has already been named, the
+ * name replaces the old one.
*
* Results:
- * The return value is the name actually given to the interp. This will
- * normally be the same as name, but if name was already in use for a Dde
- * Server then a name of the form "name #2" will be chosen, with a high
- * enough number to make the name unique.
+ * The return value is the name actually given to the interp.
+ * This will normally be the same as name, but if name was already
+ * in use for a Dde Server then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
*
* Side effects:
- * Registration info is saved, thereby allowing the "send" command to be
- * used later to invoke commands in the application. In addition, the
- * "send" command is created in the application's interpreter. The
- * registration will be removed automatically if the interpreter is
- * deleted or the "send" command is removed.
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*/
static char *
DdeSetServerName(
Tcl_Interp *interp,
- char *name, /* The name that will be used to refer to the
- * interpreter in later "send" commands. Must
- * be globally unique. */
- int exactName, /* Should we make a unique name? 0 = unique */
- Tcl_Obj *handlerPtr) /* Name of the optional proc/command to handle
- * incoming Dde eval's */
+ char *name /* The name that will be used to
+ * refer to the interpreter in later
+ * "send" commands. Must be globally
+ * unique. */
+ )
{
int suffix, offset;
RegisteredInterp *riPtr, *prevPtr;
Tcl_DString dString;
- char *actualName;
- 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 current
- * name from the registry. The deletion of the command will take care of
- * disposing of this entry.
+ * See if the application is already registered; if so, remove its
+ * current name from the registry. The deletion of the command
+ * will take care of disposing of this entry.
*/
- for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
+ for (riPtr = tsdPtr->interpListPtr, prevPtr = NULL; riPtr != NULL;
prevPtr = riPtr, riPtr = riPtr->nextPtr) {
if (riPtr->interp == interp) {
if (name != NULL) {
@@ -301,8 +261,8 @@ DdeSetServerName(
break;
} else {
/*
- * The name was NULL, so the caller is asking for the name of
- * the current interp.
+ * the name was NULL, so the caller is asking for
+ * the name of the current interp.
*/
return riPtr->name;
@@ -312,74 +272,24 @@ DdeSetServerName(
if (name == NULL) {
/*
- * The name was NULL, so the caller is asking for the name of the
- * current interp, but it doesn't have a name.
+ * the name was NULL, so the caller is asking for
+ * the name of the current interp, but it doesn't
+ * have a name.
*/
return "";
}
-
+
/*
- * Get the list of currently registered Tcl interpreters by calling the
- * internal implementation of the 'dde services' command.
+ * Pick a name to use for the application. Use "name" if it's not
+ * already in use. Otherwise add a suffix such as " #2", trying
+ * larger and larger numbers until we eventually find one that is
+ * unique.
*/
+ suffix = 1;
+ offset = 0;
Tcl_DStringInit(&dString);
- actualName = name;
-
- if (!exactName) {
- r = DdeGetServicesList(interp, TCL_DDE_SERVICE_NAME, NULL);
- if (r == TCL_OK) {
- srvListPtr = Tcl_GetObjResult(interp);
- }
- if (r == TCL_OK) {
- r = Tcl_ListObjGetElements(interp, srvListPtr, &srvCount,
- &srvPtrPtr);
- }
- if (r != TCL_OK) {
- OutputDebugString(Tcl_GetStringResult(interp));
- return NULL;
- }
-
- /*
- * Pick a name to use for the application. Use "name" if it's not
- * already in use. Otherwise add a suffix such as " #2", trying larger
- * and larger numbers until we eventually find one that is unique.
- */
-
- offset = lastSuffix = 0;
- suffix = 1;
-
- while (suffix != lastSuffix) {
- lastSuffix = suffix;
- if (suffix > 1) {
- if (suffix == 2) {
- Tcl_DStringAppend(&dString, name, -1);
- Tcl_DStringAppend(&dString, " #", 2);
- offset = Tcl_DStringLength(&dString);
- Tcl_DStringSetLength(&dString, offset + TCL_INTEGER_SPACE);
- actualName = Tcl_DStringValue(&dString);
- }
- sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
- }
-
- /*
- * See if the name is already in use, if so increment suffix.
- */
-
- for (n = 0; n < srvCount; ++n) {
- Tcl_Obj* namePtr;
-
- Tcl_ListObjIndex(interp, srvPtrPtr[n], 1, &namePtr);
- if (strcmp(actualName, Tcl_GetString(namePtr)) == 0) {
- suffix++;
- break;
- }
- }
- }
- Tcl_DStringSetLength(&dString,
- offset + strlen(Tcl_DStringValue(&dString)+offset));
- }
/*
* We have found a unique name. Now add it to the registry.
@@ -387,18 +297,10 @@ DdeSetServerName(
riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
riPtr->interp = interp;
- riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
+ riPtr->name = ckalloc((unsigned int) strlen(name) + 1);
riPtr->nextPtr = tsdPtr->interpListPtr;
- riPtr->handlerPtr = handlerPtr;
- if (riPtr->handlerPtr != NULL) {
- Tcl_IncrRefCount(riPtr->handlerPtr);
- }
tsdPtr->interpListPtr = riPtr;
- strcpy(riPtr->name, actualName);
-
- if (Tcl_IsSafe(interp)) {
- Tcl_ExposeCommand(interp, "dde", "dde");
- }
+ strcpy(riPtr->name, name);
Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
(ClientData) riPtr, DeleteProc);
@@ -408,52 +310,19 @@ DdeSetServerName(
Tcl_DStringFree(&dString);
/*
- * Re-initialize with the new name.
+ * re-initialize with the new name
*/
-
Initialize();
-
+
return riPtr->name;
}
/*
- *----------------------------------------------------------------------
- *
- * DdeGetRegistrationPtr
- *
- * Retrieve the registration info for an interpreter.
- *
- * Results:
- * Returns a pointer to the registration structure or NULL
- *
- * Side effects:
- * None
- *
- *----------------------------------------------------------------------
- */
-
-static RegisteredInterp *
-DdeGetRegistrationPtr(
- Tcl_Interp *interp)
-{
- RegisteredInterp *riPtr;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (riPtr->interp == interp) {
- break;
- }
- }
- return riPtr;
-}
-
-/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* DeleteProc
*
- * This function is called when the command "dde" is destroyed.
+ * This procedure is called when the command "dde" is destroyed.
*
* Results:
* none
@@ -461,20 +330,20 @@ DdeGetRegistrationPtr(
* Side effects:
* The interpreter given by riPtr is unregistered.
*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*/
static void
-DeleteProc(
- ClientData clientData) /* The interp we are deleting passed as
- * ClientData. */
+DeleteProc(clientData)
+ ClientData clientData; /* The interp we are deleting passed
+ * as ClientData. */
{
RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
RegisteredInterp *searchPtr, *prevPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
for (searchPtr = tsdPtr->interpListPtr, prevPtr = NULL;
- searchPtr != NULL && searchPtr != riPtr;
+ (searchPtr != NULL) && (searchPtr != riPtr);
prevPtr = searchPtr, searchPtr = searchPtr->nextPtr) {
/*
* Empty loop body.
@@ -489,33 +358,31 @@ DeleteProc(
}
}
ckfree(riPtr->name);
- if (riPtr->handlerPtr) {
- Tcl_DecrRefCount(riPtr->handlerPtr);
- }
Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* 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.
+ * A list Tcl_Obj * that describes what happened. The first
+ * element is the numerical return code (TCL_ERROR, etc.).
+ * The second element is the result of the script. If the
+ * return result was TCL_ERROR, then the third element
+ * will be the value of the global "errorCode", and the
+ * fourth will be the value of the global "errorInfo".
+ * The return result will have a refCount of 0.
*
* Side effects:
- * A Tcl script is run, which can cause all kinds of other things to
- * happen.
+ * A Tcl script is run, which can cause all kinds of other
+ * things to happen.
*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*/
static Tcl_Obj *
@@ -523,86 +390,63 @@ ExecuteRemoteObject(
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));
- 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;
- }
- }
-
- if (result == TCL_OK) {
- result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
- }
-
- returnPackagePtr = Tcl_NewListObj(0, NULL);
+ int result;
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, Tcl_NewIntObj(result));
+ result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
+ returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr,
+ Tcl_NewIntObj(result));
Tcl_ListObjAppendElement(NULL, returnPackagePtr,
Tcl_GetObjResult(riPtr->interp));
-
if (result == TCL_ERROR) {
- Tcl_Obj *errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
+ errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorCode", NULL,
TCL_GLOBAL_ONLY);
- if (errorObjPtr) {
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
- }
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
TCL_GLOBAL_ONLY);
- if (errorObjPtr) {
- Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
- }
+ Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
}
return returnPackagePtr;
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* DdeServerProc --
*
- * Handles all transactions for this server. Can handle execute, request,
- * and connect protocols. Dde will call this routine when a client
- * attempts to run a dde command using this server.
+ * 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 (
+ 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, HSZ ddeItem, /* String handles. Transaction-type
+ HSZ ddeTopic, /* A string handle. Transaction-type
+ * dependent. */
+ HSZ ddeItem, /* A string handle. Transaction-type
* dependent. */
HDDEDATA hData, /* DDE data. Transaction-type dependent. */
- DWORD dwData1, DWORD dwData2)
- /* Transaction-dependent data. */
+ DWORD dwData1, /* Transaction-dependent data. */
+ DWORD dwData2) /* Transaction-dependent data. */
{
Tcl_DString dString;
int len;
@@ -615,121 +459,125 @@ DdeServerProc(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
switch(uType) {
- case XTYP_CONNECT:
- /*
- * Dde is trying to initialize a conversation with us. Check and make
- * sure we have a valid topic.
- */
+ case XTYP_CONNECT:
- 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);
+ /*
+ * Dde is trying to initialize a conversation with us. Check
+ * and make sure we have a valid topic.
+ */
- for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
- riPtr = riPtr->nextPtr) {
- if (stricmp(utilString, riPtr->name) == 0) {
- Tcl_DStringFree(&dString);
- return (HDDEDATA) TRUE;
+ 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;
+ }
}
- }
- Tcl_DStringFree(&dString);
- return (HDDEDATA) FALSE;
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) FALSE;
- case XTYP_CONNECT_CONFIRM:
- /*
- * Dde has decided that we can connect, so it gives us a conversation
- * handle. We need to keep track of it so we know which execution
- * result to return in an XTYP_REQUEST.
- */
+ case XTYP_CONNECT_CONFIRM:
- 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;
+ /*
+ * 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;
+ }
}
- }
- Tcl_DStringFree(&dString);
- return (HDDEDATA) TRUE;
+ Tcl_DStringFree(&dString);
+ return (HDDEDATA) TRUE;
- case XTYP_DISCONNECT:
- /*
- * The client has disconnected from our server. Forget this
- * conversation.
- */
+ case XTYP_DISCONNECT:
- 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);
+ /*
+ * 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;
}
- 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.
- */
-
- if (uFmt != CF_TEXT) {
- return (HDDEDATA) FALSE;
- }
+ case XTYP_REQUEST:
- ddeReturn = (HDDEDATA) FALSE;
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
/*
- * Empty loop body.
+ * This could be either a request for a value of a Tcl variable,
+ * or it could be the send command requesting the results of the
+ * last execute.
*/
- }
- if (convPtr != NULL) {
- char *returnString;
+ if (uFmt != CF_TEXT) {
+ return (HDDEDATA) FALSE;
+ }
- 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;
+ 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);
} else {
Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
- convPtr->riPtr->interp, utilString, NULL,
+ convPtr->riPtr->interp, utilString, NULL,
TCL_GLOBAL_ONLY);
if (variableObjPtr != NULL) {
returnString = Tcl_GetStringFromObj(variableObjPtr,
@@ -741,101 +589,106 @@ DdeServerProc(
ddeReturn = NULL;
}
}
+ Tcl_DStringFree(&dString);
}
- Tcl_DStringFree(&dString);
- }
- return ddeReturn;
+ return ddeReturn;
- case XTYP_EXECUTE: {
- /*
- * Execute this script. The results will be saved into a list object
- * which will be retreived later. See ExecuteRemoteObject.
- */
+ case XTYP_EXECUTE: {
- Tcl_Obj *returnPackagePtr;
-
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
/*
- * Empty loop body.
+ * 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;
+
+ for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+ && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ if (convPtr == NULL) {
+ return (HDDEDATA) DDE_FNOTPROCESSED;
+ }
+
+ utilString = (char *) DdeAccessData(hData, &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.
+ */
- 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);
+ }
+ 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;
+ }
}
- convPtr->returnPackagePtr = NULL;
- returnPackagePtr = ExecuteRemoteObject(convPtr->riPtr, ddeObjectPtr);
- Tcl_IncrRefCount(returnPackagePtr);
- for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
- && (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
+
+ case XTYP_WILDCONNECT: {
+
/*
- * Empty loop body.
+ * Dde wants a list of services and topics that we support.
*/
- }
- 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;
- }
- }
- case XTYP_WILDCONNECT: {
- /*
- * Dde wants a list of services and topics that we support.
- */
+ HSZPAIR *returnPtr;
+ int i;
+ int numItems;
- HSZPAIR *returnPtr;
- int i;
- int numItems;
+ for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ i++, riPtr = riPtr->nextPtr) {
+ /*
+ * Empty loop body.
+ */
- 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);
+ 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;
}
- returnPtr[i].hszSvc = NULL;
- returnPtr[i].hszTopic = NULL;
- DdeUnaccessData(ddeReturn);
- return ddeReturn;
- }
- default:
- return NULL;
}
+ return NULL;
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* DdeExitProc --
*
@@ -847,7 +700,7 @@ DdeServerProc(
* Side effects:
* The DDE server is deleted.
*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*/
static void
@@ -860,20 +713,21 @@ DdeExitProc(
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* MakeDdeConnection --
*
- * This function 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
@@ -884,8 +738,8 @@ MakeDdeConnection(
{
HSZ ddeTopic, ddeService;
HCONV ddeConv;
-
- ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+
+ ddeService = DdeCreateStringHandle(ddeInstance, "TclEval", 0);
ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
@@ -895,7 +749,7 @@ MakeDdeConnection(
if (ddeConv == (HCONV) NULL) {
if (interp != NULL) {
Tcl_AppendResult(interp, "no registered server named \"",
- name, "\"", NULL);
+ name, "\"", (char *) NULL);
}
return TCL_ERROR;
}
@@ -905,15 +759,14 @@ MakeDdeConnection(
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* DdeGetServicesList --
*
- * This function obtains the list of DDE services.
+ * This procedure obtains the list of DDE services.
*
- * The functions between here and this function are all involved with
- * handling the DDE callbacks for this. They are: DdeCreateClient,
- * DdeClientWindowProc, DdeServicesOnAck, and DdeEnumWindowsCallback
+ * The functions between here and this procedure are all
+ * involved with handling the DDE callbacks for this.
*
* Results:
* A standard Tcl result.
@@ -921,12 +774,24 @@ 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(
- struct DdeEnumServices *es)
+DdeCreateClient(ddeEnumServices *es)
{
WNDCLASSEX wc;
static const char *szDdeClientClassName = "TclEval client class";
@@ -936,196 +801,177 @@ DdeCreateClient(
wc.cbSize = sizeof(wc);
wc.lpfnWndProc = DdeClientWindowProc;
wc.lpszClassName = szDdeClientClassName;
- wc.cbWndExtra = sizeof(struct DdeEnumServices *);
-
- /*
- * Register and create the callback window.
- */
+ wc.cbWndExtra = sizeof(ddeEnumServices*);
+ /* register and create the callback window */
RegisterClassEx(&wc);
- es->hwnd = CreateWindowEx(0, szDdeClientClassName, szDdeClientWindowName,
- WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL, (LPVOID)es);
+ es->hwnd = CreateWindowEx(0, szDdeClientClassName,
+ szDdeClientWindowName,
+ WS_POPUP, 0, 0, 0, 0, NULL, NULL, NULL,
+ (LPVOID)es);
return TCL_OK;
}
-static LRESULT CALLBACK
-DdeClientWindowProc(
- HWND hwnd, /* What window is the message for */
- UINT uMsg, /* The type of message received */
- WPARAM wParam,
- LPARAM lParam) /* (Potentially) our local handle */
+LRESULT CALLBACK
+DdeClientWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
+ LRESULT lr = 0L;
switch (uMsg) {
- case WM_CREATE: {
- LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
- struct DdeEnumServices *es =
- (struct DdeEnumServices *) lpcs->lpCreateParams;
-
+ case WM_CREATE: {
+ LPCREATESTRUCT lpcs = (LPCREATESTRUCT)lParam;
+ ddeEnumServices *es;
+ es = (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
- return (LRESULT) 0L;
- }
- case WM_DDE_ACK:
- return DdeServicesOnAck(hwnd, wParam, lParam);
- break;
- default:
- return DefWindowProc(hwnd, uMsg, wParam, lParam);
+ break;
+ }
+ case WM_DDE_ACK:
+ lr = DdeServicesOnAck(hwnd, wParam, lParam);
+ break;
+ default:
+ lr = DefWindowProc(hwnd, uMsg, wParam, lParam);
}
+ return lr;
}
static LRESULT
-DdeServicesOnAck(
- HWND hwnd,
- WPARAM wParam,
- LPARAM lParam)
+DdeServicesOnAck(HWND hwnd, WPARAM wParam, LPARAM lParam)
{
HWND hwndRemote = (HWND)wParam;
ATOM service = (ATOM)LOWORD(lParam);
ATOM topic = (ATOM)HIWORD(lParam);
- struct DdeEnumServices *es;
+ ddeEnumServices *es;
TCHAR sz[255];
#ifdef _WIN64
- es = (struct DdeEnumServices *) GetWindowLongPtr(hwnd, GWLP_USERDATA);
+ es = (ddeEnumServices *)GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
- es = (struct DdeEnumServices *) GetWindowLong(hwnd, GWL_USERDATA);
+ es = (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(service, sz, 255);
- Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
+ Tcl_ListObjAppendElement(es->interp, 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(es->interp, 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:
- * Tcl_ListObjAppendElement(NULL, matchPtr,
+ /* Needs a TIP though
+ * Tcl_ListObjAppendElement(es->interp, matchPtr,
* Tcl_NewLongObj((long)hwndRemote));
*/
-
- if (Tcl_IsShared(resultPtr)) {
- resultPtr = Tcl_DuplicateObj(resultPtr);
- }
- if (Tcl_ListObjAppendElement(es->interp, resultPtr,
- matchPtr) == TCL_OK) {
- Tcl_SetObjResult(es->interp, resultPtr);
- }
+ Tcl_ListObjAppendElement(es->interp,
+ Tcl_GetObjResult(es->interp), matchPtr);
}
- /*
- * Tell the server we are no longer interested.
- */
-
+ /* tell the server we are no longer interested */
PostMessage(hwndRemote, WM_DDE_TERMINATE, (WPARAM)hwnd, 0L);
return 0L;
}
-
+
static BOOL CALLBACK
-DdeEnumWindowsCallback(
- HWND hwndTarget,
- LPARAM lParam)
+DdeEnumWindowsCallback(HWND hwndTarget, LPARAM lParam)
{
LRESULT dwResult = 0;
- struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
-
- SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
- MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
- &dwResult);
+ ddeEnumServices *es = (ddeEnumServices *)lParam;
+ SendMessageTimeout(hwndTarget, WM_DDE_INITIATE,
+ (WPARAM)es->hwnd,
+ MAKELONG(es->service, es->topic),
+ SMTO_ABORTIFHUNG, 1000, &dwResult);
return TRUE;
}
-
+
static int
-DdeGetServicesList(
- Tcl_Interp *interp,
- char *serviceName,
- char *topicName)
+DdeGetServicesList(Tcl_Interp *interp, char *serviceName, char *topicName)
{
- struct DdeEnumServices es;
-
+ ddeEnumServices es;
+ int r = TCL_OK;
es.interp = interp;
es.result = TCL_OK;
- es.service = (serviceName == NULL)
- ? (ATOM)NULL : GlobalAddAtom(serviceName);
- es.topic = (topicName == NULL) ? (ATOM)NULL : GlobalAddAtom(topicName);
-
+ es.service = (serviceName == NULL)
+ ? (ATOM)NULL : GlobalAddAtom(serviceName);
+ es.topic = (topicName == NULL)
+ ? (ATOM)NULL : GlobalAddAtom(topicName);
+
Tcl_ResetResult(interp); /* our list is to be appended to result. */
DdeCreateClient(&es);
EnumWindows(DdeEnumWindowsCallback, (LPARAM)&es);
-
- if (IsWindow(es.hwnd)) {
- DestroyWindow(es.hwnd);
- }
- if (es.service != (ATOM)NULL) {
+
+ if (IsWindow(es.hwnd))
+ DestroyWindow(es.hwnd);
+ if (es.service != (ATOM)NULL)
GlobalDeleteAtom(es.service);
- }
- if (es.topic != (ATOM)NULL) {
+ if (es.topic != (ATOM)NULL)
GlobalDeleteAtom(es.topic);
- }
return es.result;
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* 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. */
+ Tcl_Interp *interp) /* The interp to put the message in.*/
{
- char *errorMessage;
-
- 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_Obj *resultPtr = Tcl_GetObjResult(interp);
+ int err;
+
+ err = DdeGetLastError(ddeInstance);
+ switch (err) {
+ case DMLERR_DATAACKTIMEOUT:
+ case DMLERR_EXECACKTIMEOUT:
+ case DMLERR_POKEACKTIMEOUT:
+ Tcl_SetStringObj(resultPtr,
+ "remote interpreter did not respond", -1);
+ break;
+
+ case DMLERR_BUSY:
+ Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
+ break;
+
+ case DMLERR_NOTPROCESSED:
+ Tcl_SetStringObj(resultPtr,
+ "remote server cannot handle this command", -1);
+ break;
- Tcl_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
+ default:
+ Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+ }
}
/*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*
* Tcl_DdeObjCmd --
*
- * This function is invoked to process the "dde" Tcl command. See the
- * user documentation for details on what it does.
+ * This procedure is invoked to process the "dde" Tcl command.
+ * See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
@@ -1133,7 +979,7 @@ SetDdeError(
* Side effects:
* See the user documentation.
*
- *----------------------------------------------------------------------
+ *--------------------------------------------------------------
*/
int
@@ -1141,45 +987,49 @@ 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_Obj *CONST objv[]) /* The arguments */
{
- static CONST char *ddeCommands[] = {
- "servername", "execute", "poke", "request", "services", "eval",
- (char *) NULL
- };
- enum DdeSubcommands {
- DDE_SERVERNAME, DDE_EXECUTE, DDE_POKE, DDE_REQUEST, DDE_SERVICES,
+ enum {
+ DDE_SERVERNAME,
+ DDE_EXECUTE,
+ DDE_POKE,
+ DDE_REQUEST,
+ DDE_SERVICES,
DDE_EVAL
};
- static CONST char *ddeSrvOptions[] = {
- "-force", "-handler", "--", NULL
- };
- enum DdeSrvOptions {
- DDE_SERVERNAME_EXACT, DDE_SERVERNAME_HANDLER, DDE_SERVERNAME_LAST,
- };
- static CONST char *ddeExecOptions[] = {
- "-async", NULL
- };
- static CONST char *ddeReqOptions[] = {
- "-binary", NULL
- };
- int index, i, length;
- int async = 0, binary = 0, exact = 0;
- int result = TCL_OK, firstArg = 0;
- HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
- HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
+ static CONST char *ddeCommands[] = {"servername", "execute", "poke",
+ "request", "services", "eval",
+ (char *) NULL};
+ static CONST char *ddeOptions[] = {"-async", (char *) NULL};
+ static CONST char *ddeReqOptions[] = {"-binary", (char *) NULL};
+ int index, argIndex;
+ int async = 0, binary = 0;
+ int result = TCL_OK;
+ HSZ ddeService = NULL;
+ HSZ ddeTopic = NULL;
+ HSZ ddeItem = NULL;
+ HDDEDATA ddeData = NULL;
+ HDDEDATA ddeItemData = NULL;
HCONV hConv = NULL;
- char *serviceName = NULL, *topicName = NULL, *string;
+ HSZ ddeCookie = 0;
+ char *serviceName, *topicName, *itemString, *dataString;
+ char *string;
+ int firstArg, length, dataLength;
DWORD ddeResult;
- Tcl_Obj *objPtr, *handlerPtr = NULL;
+ HDDEDATA ddeReturn;
+ RegisteredInterp *riPtr;
+ Tcl_Interp *sendInterp;
+ Tcl_Obj *objPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Initialize DDE server/client
*/
-
+
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-async? serviceName topicName value");
return TCL_ERROR;
}
@@ -1188,124 +1038,105 @@ Tcl_DdeObjCmd(
return TCL_ERROR;
}
- switch ((enum DdeSubcommands) index) {
- case DDE_SERVERNAME:
- for (i = 2; i < objc; i++) {
- int argIndex;
- if (Tcl_GetIndexFromObj(interp, objv[i], ddeSrvOptions,
- "option", 0, &argIndex) != TCL_OK) {
- /*
- * If it is the last argument, it might be a server name
- * instead of a bad argument.
- */
-
- if (i != objc-1) {
+ switch (index) {
+ case DDE_SERVERNAME:
+ if ((objc != 3) && (objc != 2)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
+ return TCL_ERROR;
+ }
+ firstArg = (objc - 1);
+ break;
+ case DDE_EXECUTE:
+ if ((objc < 5) || (objc > 6)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
return TCL_ERROR;
}
- Tcl_ResetResult(interp);
- break;
- }
- 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 = 0;
+ firstArg = 2;
+ } else {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "execute ?-async? serviceName topicName value");
+ return TCL_ERROR;
}
- 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;
- } 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) {
+ break;
+ case DDE_POKE:
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "poke serviceName topicName item value");
+ return TCL_ERROR;
+ }
firstArg = 2;
break;
- } else if (objc == 6) {
- int dummy;
+ case DDE_REQUEST:
+ if ((objc < 5) || (objc > 6)) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "request ?-binary? serviceName topicName value");
+ return TCL_ERROR;
+ }
if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
- &dummy) == TCL_OK) {
+ &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;
+ }
binary = 1;
firstArg = 3;
- break;
}
- }
-
- /*
- * 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;
-
+ break;
+ case DDE_SERVICES:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "services serviceName topicName");
+ return TCL_ERROR;
+ }
firstArg = 2;
- if (Tcl_GetIndexFromObj(NULL, objv[2], ddeExecOptions, "option", 0,
- &dummy) == TCL_OK) {
+ break;
+ case DDE_EVAL:
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
+ &argIndex) != TCL_OK) {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
+ }
+ async = 0;
+ firstArg = 2;
+ } else {
if (objc < 5) {
- goto wrongDdeEvalArgs;
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "eval ?-async? serviceName args");
+ return TCL_ERROR;
}
async = 1;
- firstArg++;
+ firstArg = 3;
}
break;
- }
}
Initialize();
@@ -1323,363 +1154,345 @@ 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 ((enum DdeSubcommands) 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;
- }
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
-
- if (hConv == NULL) {
- SetDdeError(interp);
- result = TCL_ERROR;
- break;
- }
-
- ddeData = DdeCreateDataHandle(ddeInstance, dataString,
- (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);
+ switch (index) {
+ case DDE_SERVERNAME: {
+ serviceName = DdeSetServerName(interp, serviceName);
+ if (serviceName != NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ serviceName, -1);
} else {
- ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
- hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
- if (ddeReturn == 0) {
- SetDdeError(interp);
- result = TCL_ERROR;
- }
+ Tcl_ResetResult(interp);
}
- DdeFreeDataHandle(ddeData);
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
+ break;
}
- break;
- }
- case DDE_REQUEST: {
- char *itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ case DDE_EXECUTE: {
+ dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
+ if (dataLength == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "cannot execute null data", -1);
+ result = TCL_ERROR;
+ break;
+ }
+ hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
+ DdeFreeStringHandle(ddeInstance, ddeService);
+ DdeFreeStringHandle(ddeInstance, ddeTopic);
- if (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);
+ if (hConv == NULL) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
+ break;
+ }
- 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;
+ 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 {
- DWORD tmp;
- char *dataString = DdeAccessData(ddeData, &tmp);
-
- if (binary) {
- returnObjPtr = Tcl_NewByteArrayObj(dataString,
- (int) tmp);
- } else {
- returnObjPtr = Tcl_NewStringObj(dataString, -1);
+ ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
+ hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
+ if (ddeReturn == 0) {
+ SetDdeError(interp);
+ result = TCL_ERROR;
}
- 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_SetStringObj(Tcl_GetObjResult(interp),
+ "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;
- }
- 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;
+ break;
}
- dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
-
- hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
- DdeFreeStringHandle(ddeInstance, ddeService);
- DdeFreeStringHandle(ddeInstance, ddeTopic);
+ case DDE_POKE: {
+ itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
+ if (length == 0) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "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);
- 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) {
+ 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;
}
- } else {
- SetDdeError(interp);
- result = TCL_ERROR;
}
+ break;
}
- 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_SERVICES: {
+ result = DdeGetServicesList(interp, serviceName, topicName);
+ break;
}
-
- objc -= (async + 3);
- 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;
+ case DDE_EVAL: {
+ if (serviceName == NULL) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "invalid service name \"\"", -1);
+ goto errorNoResult;
}
- }
-
- if (riPtr != NULL) {
- Tcl_Interp *sendInterp;
-
- /*
- * 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.
+ 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 (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;
+
+ for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+ riPtr = riPtr->nextPtr) {
+ if (stricmp(serviceName, riPtr->name) == 0) {
+ break;
+ }
}
- if (result == TCL_OK) {
- if (objc == 1)
- objPtr = objv[0];
- else {
+ if (riPtr != NULL) {
+ /*
+ * This command is to a local interp. No need to go through
+ * the server.
+ */
+
+ Tcl_Preserve((ClientData) riPtr);
+ sendInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) sendInterp);
+
+ /*
+ * Don't exchange objects between interps. The target interp
+ * would compile an object, producing a bytecode structure that
+ * refers to other objects owned by the target interp. If the
+ * target interp is then deleted, the bytecode structure would
+ * be referring to deallocated objects.
+ */
+
+ if (objc == 1) {
+ result = Tcl_EvalObjEx(sendInterp, objv[0],
+ TCL_EVAL_GLOBAL);
+ } else {
objPtr = Tcl_ConcatObj(objc, objv);
+ Tcl_IncrRefCount(objPtr);
+ result = Tcl_EvalObjEx(sendInterp, objPtr,
+ TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(objPtr);
}
- if (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) {
+ if (interp != sendInterp) {
+ if (result == TCL_ERROR) {
+ /*
+ * An error occurred, so transfer error information
+ * from the destination interpreter back to our
+ * interpreter.
+ */
+
+ Tcl_ResetResult(interp);
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL,
+ TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &length);
Tcl_AddObjErrorInfo(interp, string, length);
- }
-
- objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
- TCL_GLOBAL_ONLY);
- if (objPtr) {
+
+ objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
+ TCL_GLOBAL_ONLY);
Tcl_SetObjErrorCode(interp, objPtr);
}
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
}
- 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);
+ Tcl_Release((ClientData) riPtr);
+ Tcl_Release((ClientData) sendInterp);
} 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".
+ * This is a non-local request. Send the script to the server
+ * and poll it for a result.
*/
-
- 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 (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
+ goto error;
}
- if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
- Tcl_DecrRefCount(resultPtr);
- goto invalidServerResponse;
+
+ 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 (result == TCL_ERROR) {
- Tcl_ResetResult(interp);
- if (Tcl_ListObjIndex(NULL, resultPtr, 3,
- &objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+
+ if (ddeData == 0) {
+ SetDdeError(interp);
+ goto errorNoResult;
+ }
+
+ if (async == 0) {
+ Tcl_Obj *resultPtr;
+
+ /*
+ * The return handle has a two or four element list in
+ * it. The first element is the return code (TCL_OK,
+ * TCL_ERROR, etc.). The second is the result of the
+ * script. If the return code is TCL_ERROR, then the third
+ * element is the value of the variable "errorCode", and
+ * the fourth is the value of the variable "errorInfo".
+ */
+
+ resultPtr = Tcl_NewObj();
+ length = DdeGetData(ddeData, NULL, 0, 0);
+ Tcl_SetObjLength(resultPtr, length);
+ string = Tcl_GetString(resultPtr);
+ DdeGetData(ddeData, string, (DWORD) length, 0);
+ Tcl_SetObjLength(resultPtr, (int) strlen(string));
+
+ if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
+ != TCL_OK) {
Tcl_DecrRefCount(resultPtr);
- goto invalidServerResponse;
+ goto error;
}
- length = -1;
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_AddObjErrorInfo(interp, string, length);
+ if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ if (result == TCL_ERROR) {
+ Tcl_ResetResult(interp);
- Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
- Tcl_SetObjErrorCode(interp, objPtr);
- }
- if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr) != TCL_OK) {
+ if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
+ != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ length = -1;
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_AddObjErrorInfo(interp, string, length);
+
+ Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
+ Tcl_SetObjErrorCode(interp, objPtr);
+ }
+ if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
+ != TCL_OK) {
+ Tcl_DecrRefCount(resultPtr);
+ goto error;
+ }
+ Tcl_SetObjResult(interp, objPtr);
Tcl_DecrRefCount(resultPtr);
- 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;
- cleanup:
+ error:
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "invalid data returned from server", -1);
+
+ errorNoResult:
if (ddeCookie != NULL) {
DdeFreeStringHandle(ddeInstance, ddeCookie);
}
@@ -1695,15 +1508,5 @@ Tcl_DdeObjCmd(
if (hConv != NULL) {
DdeDisconnect(hConv);
}
- return result;
+ return TCL_ERROR;
}
-
-/*
- * Local variables:
- * mode: c
- * indent-tabs-mode: t
- * tab-width: 8
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
generated by cgit v0.12 at 2024-07-03 03:34:53 (GMT)