* 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

6 files changed, 1058 insertions, 859 deletions

diff --git a/ChangeLog b/ChangeLog
index 4c2d510..3405dea 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -4,9 +4,11 @@
 	* win/tclWinReg.c:		version 1.1.4 (should have been done
 	for the Tcl 8.4.8 release!)
 
-	* 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!)
+	* 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
 
 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 f993012..3125ada 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.2.4 [list load [file join $dir tcldde12g.dll] dde]
+    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
 } else {
-    package ifneeded dde 1.2.4 [list load [file join $dir tcldde12.dll] dde]
+    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
 }
diff --git a/win/Makefile.in b/win/Makefile.in
index e109014..fcace15 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.4 2006/03/02 21:07:19 hobbs Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.68.2.5 2006/04/05 16:50:04 dgp Exp $
 
 VERSION = @TCL_VERSION@
 
@@ -437,7 +437,7 @@ install-binaries: binaries
 		else true; \
 		fi; \
 	    done;
-	@for i in dde1.2 reg1.1; \
+	@for i in dde1.3 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.2; \
+	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
 	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
-		$(LIB_INSTALL_DIR)/dde1.2; \
+		$(LIB_INSTALL_DIR)/dde1.3; \
 	    fi
 	@if [ -f $(DDE_LIB_FILE) ]; then \
 	    echo installing $(DDE_LIB_FILE); \
-	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.2; \
+	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde1.3; \
 	    fi
 	@if [ -f $(REG_DLL_FILE) ]; then \
 	    echo installing $(REG_DLL_FILE); \
diff --git a/win/configure b/win/configure
index cd4e32e..721fffb 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.2
+TCL_DDE_VERSION=1.3
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
+TCL_DDE_MINOR_VERSION=3
 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 0151749..b63bba0 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.15 2006/03/07 05:30:30 dgp Exp $
+# RCS: @(#) $Id: configure.in,v 1.68.2.16 2006/04/05 16:50:04 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.2
+TCL_DDE_VERSION=1.3
 TCL_DDE_MAJOR_VERSION=1
-TCL_DDE_MINOR_VERSION=2
+TCL_DDE_MINOR_VERSION=3
 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 eb73162..4a47684 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -1,33 +1,33 @@
-/* 
+/*
  * tclWinDde.c --
  *
- *	This file provides procedures that implement the "send"
- *	command, allowing commands to be passed from interpreter
- *	to interpreter.
+ *	This file provides functions 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.5 2006/04/05 16:10:44 dgp Exp $
+ * RCS: @(#) $Id: tclWinDde.c,v 1.13.2.6 2006/04/05 16:50:04 dgp Exp $
  */
 
-#include "tclPort.h"
+#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.
+ * 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.
  */
 
 #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,6 +37,7 @@ 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;
 
@@ -52,64 +53,77 @@ 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.2.4"
-#define TCL_DDE_PACKAGE_NAME "dde"
-#define TCL_DDE_SERVICE_NAME "TclEval"
+#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"
 
 TCL_DECLARE_MUTEX(ddeMutex)
 
 /*
- * Forward declarations for procedures defined later in this file.
+ * Forward declarations for functions defined later in this file.
  */
 
-static void		    DdeExitProc _ANSI_ARGS_((ClientData clientData));
-static void		    DeleteProc _ANSI_ARGS_((ClientData clientData));
-static Tcl_Obj *	    ExecuteRemoteObject _ANSI_ARGS_((
-				RegisteredInterp *riPtr, 
-				Tcl_Obj *ddeObjectPtr));
-static int		    MakeDdeConnection _ANSI_ARGS_((Tcl_Interp *interp,
-				char *name, HCONV *ddeConvPtr));
-static HDDEDATA CALLBACK    DdeServerProc _ANSI_ARGS_((UINT uType,
-				UINT uFmt, HCONV hConv, HSZ ddeTopic,
-				HSZ ddeItem, HDDEDATA hData, DWORD dwData1, 
-				DWORD dwData2));
-static void		    SetDdeError _ANSI_ARGS_((Tcl_Interp *interp));
-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);
+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);
 
 /*
  *----------------------------------------------------------------------
  *
  * Dde_Init --
  *
- *	This procedure initializes the dde command.
+ *	This function initializes the dde command.
  *
  * Results:
  *	A standard Tcl result.
@@ -131,17 +145,41 @@ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Initialize --
  *
  *	Initialize the global DDE instance.
@@ -160,11 +198,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) {
@@ -172,18 +210,16 @@ 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;
 	    }
 	}
@@ -194,7 +230,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 {
@@ -202,54 +238,58 @@ Initialize(void)
 	}
 	Tcl_MutexUnlock(&ddeMutex);
     }
-}    
+}
 
 /*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * DdeSetServerName --
  *
- *	This procedure is called to associate an ASCII name with a Dde
- *	server.  If the interpreter has already been named, the
- *	name replaces the old one.
+ *	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.
  *
  * 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. */
-    )
+    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;
+    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) {
@@ -261,8 +301,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;
@@ -272,24 +312,74 @@ 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 "";
     }
-    
+
     /*
-     * 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.
+     * Get the list of currently registered Tcl interpreters by calling the
+     * internal implementation of the 'dde services' command.
      */
 
-    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.
@@ -297,10 +387,18 @@ DdeSetServerName(
 
     riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
     riPtr->interp = interp;
-    riPtr->name = ckalloc((unsigned int) strlen(name) + 1);
+    riPtr->name = ckalloc((unsigned int) strlen(actualName) + 1);
     riPtr->nextPtr = tsdPtr->interpListPtr;
+    riPtr->handlerPtr = handlerPtr;
+    if (riPtr->handlerPtr != NULL) {
+	Tcl_IncrRefCount(riPtr->handlerPtr);
+    }
     tsdPtr->interpListPtr = riPtr;
-    strcpy(riPtr->name, name);
+    strcpy(riPtr->name, actualName);
+
+    if (Tcl_IsSafe(interp)) {
+	Tcl_ExposeCommand(interp, "dde", "dde");
+    }
 
     Tcl_CreateObjCommand(interp, "dde", Tcl_DdeObjCmd,
 	    (ClientData) riPtr, DeleteProc);
@@ -310,19 +408,52 @@ 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 procedure is called when the command "dde" is destroyed.
+ *	This function is called when the command "dde" is destroyed.
  *
  * Results:
  *	none
@@ -330,20 +461,20 @@ DdeSetServerName(
  * Side effects:
  *	The interpreter given by riPtr is unregistered.
  *
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static void
-DeleteProc(clientData)
-    ClientData clientData;	/* The interp we are deleting passed
-				 * as ClientData. */
+DeleteProc(
+    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.
@@ -358,31 +489,33 @@ DeleteProc(clientData)
 	}
     }
     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 *
@@ -390,63 +523,86 @@ ExecuteRemoteObject(
     RegisteredInterp *riPtr,	    /* Info about this server. */
     Tcl_Obj *ddeObjectPtr)	    /* The object to execute. */
 {
-    Tcl_Obj *errorObjPtr;
     Tcl_Obj *returnPackagePtr;
-    int result;
+    int result = TCL_OK;
 
-    result = Tcl_EvalObjEx(riPtr->interp, ddeObjectPtr, TCL_EVAL_GLOBAL);
-    returnPackagePtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    Tcl_ListObjAppendElement(NULL, returnPackagePtr,
-	    Tcl_NewIntObj(result));
+    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);
+
+    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);
-	Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+	if (errorObjPtr) {
+	    Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+	}
 	errorObjPtr = Tcl_GetVar2Ex(riPtr->interp, "errorInfo", NULL,
 		TCL_GLOBAL_ONLY);
-        Tcl_ListObjAppendElement(NULL, returnPackagePtr, errorObjPtr);
+	if (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,		/* A string handle. Transaction-type 
-				 * dependent. */
-    HSZ ddeItem,		/* A string handle. Transaction-type 
+    HSZ ddeTopic, HSZ ddeItem,	/* String handles. Transaction-type
 				 * dependent. */
     HDDEDATA hData,		/* DDE data. Transaction-type dependent. */
-    DWORD dwData1,		/* Transaction-dependent data. */
-    DWORD dwData2)		/* Transaction-dependent data. */
+    DWORD dwData1, DWORD dwData2)
+				/* Transaction-dependent data. */
 {
     Tcl_DString dString;
     int len;
@@ -459,125 +615,121 @@ 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:
+	/*
+	 * 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;
-
-	case XTYP_CONNECT_CONFIRM:
+	Tcl_DStringFree(&dString);
+	return (HDDEDATA) FALSE;
 
-	    /*
-	     * 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:
+	/*
+	 * 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;
-
-	case XTYP_DISCONNECT:
+	}
+	Tcl_DStringFree(&dString);
+	return (HDDEDATA) TRUE;
 
-	    /*
-	     * The client has disconnected from our server. Forget this
-	     * conversation.
-	     */
+    case XTYP_DISCONNECT:
+	/*
+	 * The client has disconnected from our server. Forget this
+	 * conversation.
+	 */
 
-	    for (convPtr = tsdPtr->currentConversations, prevConvPtr = NULL;
-		    convPtr != NULL; 
-		    prevConvPtr = convPtr, convPtr = convPtr->nextPtr) {
-		if (hConv == convPtr->hConv) {
-		    if (prevConvPtr == NULL) {
-			tsdPtr->currentConversations = convPtr->nextPtr;
-		    } else {
-			prevConvPtr->nextPtr = convPtr->nextPtr;
-		    }
-		    if (convPtr->returnPackagePtr != NULL) {
-			Tcl_DecrRefCount(convPtr->returnPackagePtr);
-		    }
-		    ckfree((char *) convPtr);
-		    break;
+	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:
+    case XTYP_REQUEST:
+	/*
+	 * This could be either a request for a value of a Tcl variable, or it
+	 * could be the send command requesting the results of the last
+	 * execute.
+	 */
+
+	if (uFmt != CF_TEXT) {
+	    return (HDDEDATA) FALSE;
+	}
 
+	ddeReturn = (HDDEDATA) FALSE;
+	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
 	    /*
-	     * 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 {
 		    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,
@@ -589,106 +741,101 @@ DdeServerProc (
 			ddeReturn = NULL;
 		    }
 		}
-		Tcl_DStringFree(&dString);
 	    }
-	    return ddeReturn;
+	    Tcl_DStringFree(&dString);
+	}
+	return ddeReturn;
 
-	case XTYP_EXECUTE: {
+    case XTYP_EXECUTE: {
+	/*
+	 * Execute this script. The results will be saved into a list object
+	 * which will be retreived later. See ExecuteRemoteObject.
+	 */
 
+	Tcl_Obj *returnPackagePtr;
+
+	for (convPtr = tsdPtr->currentConversations; (convPtr != NULL)
+		&& (convPtr->hConv != hConv); convPtr = convPtr->nextPtr) {
 	    /*
-	     * Execute this script. The results will be saved into
-	     * a list object which will be retreived later. See
-	     * ExecuteRemoteObject.
+	     * Empty loop body.
 	     */
+	}
 
-	    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.
-		 */
-
-	    }
-	    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: {
+	/*
+	 * Dde wants a list of services and topics that we support.
+	 */
 
-	    for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
-		    i++, riPtr = riPtr->nextPtr) {
-		/*
-		 * Empty loop body.
-		 */
+	HSZPAIR *returnPtr;
+	int i;
+	int numItems;
 
-	    }
+	for (i = 0, riPtr = tsdPtr->interpListPtr; riPtr != NULL;
+		i++, riPtr = riPtr->nextPtr) {
+	    /*
+	     * Empty loop body.
+	     */
+	}
 
-	    numItems = i;
-	    ddeReturn = DdeCreateDataHandle(ddeInstance, NULL,
-		    (numItems + 1) * sizeof(HSZPAIR), 0, 0, 0, 0);
-	    returnPtr = (HSZPAIR *) DdeAccessData(ddeReturn, &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;
+	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 --
  *
@@ -700,7 +847,7 @@ DdeServerProc (
  * Side effects:
  *	The DDE server is deleted.
  *
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 static void
@@ -713,21 +860,20 @@ DdeExitProc(
 }
 
 /*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * MakeDdeConnection --
  *
- *	This procedure is a utility used to connect to a DDE
- *	server when given a server name and a topic name.
+ *	This function 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
@@ -738,8 +884,8 @@ MakeDdeConnection(
 {
     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);
@@ -749,7 +895,7 @@ MakeDdeConnection(
     if (ddeConv == (HCONV) NULL) {
 	if (interp != NULL) {
 	    Tcl_AppendResult(interp, "no registered server named \"",
-		    name, "\"", (char *) NULL);
+		    name, "\"", NULL);
 	}
 	return TCL_ERROR;
     }
@@ -759,14 +905,15 @@ MakeDdeConnection(
 }
 
 /*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * DdeGetServicesList --
  *
- *	This procedure obtains the list of DDE services.
+ *	This function 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 function are all involved with
+ *	handling the DDE callbacks for this. They are: DdeCreateClient,
+ *	DdeClientWindowProc, DdeServicesOnAck, and DdeEnumWindowsCallback
  *
  * Results:
  *	A standard Tcl result.
@@ -774,24 +921,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(
+    struct DdeEnumServices *es)
 {
     WNDCLASSEX wc;
     static const char *szDdeClientClassName = "TclEval client class";
@@ -801,177 +936,196 @@ 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.
+     */
 
-    /* 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 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 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(service, sz, 255);
-	Tcl_ListObjAppendElement(es->interp, matchPtr,
-		Tcl_NewStringObj(sz, -1));
+	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
 	GlobalGetAtomName(topic, sz, 255);
-	Tcl_ListObjAppendElement(es->interp, 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
-	 * Tcl_ListObjAppendElement(es->interp, matchPtr,
+	/*
+	 * Needs a TIP though:
+	 * Tcl_ListObjAppendElement(NULL, matchPtr,
 	 *	Tcl_NewLongObj((long)hwndRemote));
 	 */
-	Tcl_ListObjAppendElement(es->interp,
-		Tcl_GetObjResult(es->interp), matchPtr);
+
+	if (Tcl_IsShared(resultPtr)) {
+	    resultPtr = Tcl_DuplicateObj(resultPtr);
+	}
+	if (Tcl_ListObjAppendElement(es->interp, resultPtr,
+		matchPtr) == TCL_OK) {
+	    Tcl_SetObjResult(es->interp, resultPtr);
+	}
     }
 
-    /* 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;
-    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(
+    Tcl_Interp *interp,
+    char *serviceName,
+    char *topicName)
 {
-    ddeEnumServices es;
-    int r = TCL_OK;
+    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);
-    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. */
 {
-    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-    int err;
-
-    err = DdeGetLastError(ddeInstance);
-    switch (err) {
-	case DMLERR_DATAACKTIMEOUT:
-	case DMLERR_EXECACKTIMEOUT:
-	case DMLERR_POKEACKTIMEOUT:
-	    Tcl_SetStringObj(resultPtr,
-		    "remote interpreter did not respond", -1);
-	    break;
-
-	case DMLERR_BUSY:
-	    Tcl_SetStringObj(resultPtr, "remote server is busy", -1);
-	    break;
-
-	case DMLERR_NOTPROCESSED:
-	    Tcl_SetStringObj(resultPtr, 
-		    "remote server cannot handle this command", -1);
-	    break;
-
-	default:
-	    Tcl_SetStringObj(resultPtr, "dde command failed", -1);
+    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_SetObjResult(interp, Tcl_NewStringObj(errorMessage, -1));
 }
 
 /*
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  *
  * Tcl_DdeObjCmd --
  *
- *	This procedure is invoked to process the "dde" Tcl command.
- *	See the user documentation for details on what it does.
+ *	This function is invoked to process the "dde" Tcl command. See the
+ *	user documentation for details on what it does.
  *
  * Results:
  *	A standard Tcl result.
@@ -979,7 +1133,7 @@ SetDdeError(
  * Side effects:
  *	See the user documentation.
  *
- *--------------------------------------------------------------
+ *----------------------------------------------------------------------
  */
 
 int
@@ -987,49 +1141,45 @@ 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 */
 {
-    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
     };
+    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
+    };
 
-    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;
+    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;
     HCONV hConv = NULL;
-    HSZ ddeCookie = 0;
-    char *serviceName, *topicName, *itemString, *dataString;
-    char *string;
-    int firstArg, length, dataLength;
+    char *serviceName = NULL, *topicName = NULL, *string;
     DWORD ddeResult;
-    HDDEDATA ddeReturn;
-    RegisteredInterp *riPtr;
-    Tcl_Interp *sendInterp;
-    Tcl_Obj *objPtr;
-    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+    Tcl_Obj *objPtr, *handlerPtr = NULL;
 
     /*
      * 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;
     }
 
@@ -1038,105 +1188,124 @@ Tcl_DdeObjCmd(
 	return TCL_ERROR;
     }
 
-    switch (index) {
-	case DDE_SERVERNAME:
-	    if ((objc != 3) && (objc != 2)) {
-		Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
-		return TCL_ERROR;
-	    }
-	    firstArg = (objc - 1);
-	    break;
-	case DDE_EXECUTE:
-	    if ((objc < 5) || (objc > 6)) {
-		Tcl_WrongNumArgs(interp, 1, objv, 
-			"execute ?-async? serviceName topicName value");
-		return TCL_ERROR;
-	    }
-	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
-		    &argIndex) != TCL_OK) {
-		if (objc != 5) {
-		    Tcl_WrongNumArgs(interp, 1, objv,
-			    "execute ?-async? serviceName topicName value");
+    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) {
 		    return TCL_ERROR;
 		}
-		async = 0;
-		firstArg = 2;
-	    } else {
-		if (objc != 6) {
-		    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 = 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();
@@ -1154,345 +1323,363 @@ 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);
-	    if (serviceName != NULL) {
-		Tcl_SetStringObj(Tcl_GetObjResult(interp),
-			serviceName, -1);
-	    } else {
-		Tcl_ResetResult(interp);
-	    }
+    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;
 	}
-	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);
+	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_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;
+	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_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);
+	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_SetStringObj(Tcl_GetObjResult(interp),
-			"invalid service name \"\"", -1);
-		goto errorNoResult;
+
+	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;
 	    }
+	}
+
+	if (riPtr != NULL) {
+	    Tcl_Interp *sendInterp;
 
-	    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.
+	    /*
+	     * 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 (objc == 1) {
-		    result = Tcl_EvalObjEx(sendInterp, objv[0],
-			    TCL_EVAL_GLOBAL);
-		} else {
+	    /*
+	     * 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 (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);
-		    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 (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);
+		    }
+
+		    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);
+		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;
+
 		/*
-		 * This is a non-local request. Send the script to the server
-		 * and poll it for a result.
+		 * 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".
 		 */
-		
-		if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
-		    goto error;
+
+		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;
 		}
-		
-		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 (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
+		    Tcl_DecrRefCount(resultPtr);
+		    goto invalidServerResponse;
 		}
+		if (result == TCL_ERROR) {
+		    Tcl_ResetResult(interp);
 
-		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) {
+		    if (Tcl_ListObjIndex(NULL, resultPtr, 3,
+			    &objPtr) != TCL_OK) {
 			Tcl_DecrRefCount(resultPtr);
-			goto error;
+			goto invalidServerResponse;
 		    }
-		    if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
-			Tcl_DecrRefCount(resultPtr);
-			goto error;
-		    }
-		    if (result == TCL_ERROR) {
-			Tcl_ResetResult(interp);
+		    length = -1;
+		    string = Tcl_GetStringFromObj(objPtr, &length);
+		    Tcl_AddObjErrorInfo(interp, string, length);
 
-			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_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_SetStringObj(Tcl_GetObjResult(interp),
-	    "invalid data returned from server", -1);
-
-    errorNoResult:
+  cleanup:
     if (ddeCookie != NULL) {
 	DdeFreeStringHandle(ddeInstance, ddeCookie);
     }
@@ -1508,5 +1695,15 @@ Tcl_DdeObjCmd(
     if (hConv != NULL) {
 	DdeDisconnect(hConv);
     }
-    return TCL_ERROR;
+    return result;
 }
+
+/*
+ * Local variables:
+ * mode: c
+ * indent-tabs-mode: t
+ * tab-width: 8
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */