Update dde to version 1.3.3.

Update registry to version 1.2.2. 
(the same as distributed with Tcl 8.5.14)

7 files changed, 687 insertions, 421 deletions

diff --git a/win/configure b/win/configure
index 51a86a7..0f36f24 100755
--- a/win/configure
+++ b/win/configure
@@ -541,14 +541,14 @@ TCL_MINOR_VERSION=4
 TCL_PATCH_LEVEL=".19"
 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
+TCL_REG_VERSION=1.2
 TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=1
+TCL_REG_MINOR_VERSION=2
 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
 
 #------------------------------------------------------------------------
diff --git a/win/configure.in b/win/configure.in
index 635469b..99dc334 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -12,14 +12,14 @@ TCL_MINOR_VERSION=4
 TCL_PATCH_LEVEL=".19"
 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
+TCL_REG_VERSION=1.2
 TCL_REG_MAJOR_VERSION=1
-TCL_REG_MINOR_VERSION=1
+TCL_REG_MINOR_VERSION=2
 REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION
 
 #------------------------------------------------------------------------
diff --git a/win/makefile.bc b/win/makefile.bc
index 3c0ea73..6a3cd9d 100644
--- a/win/makefile.bc
+++ b/win/makefile.bc
@@ -110,11 +110,11 @@ STUBPREFIX	= $(NAMEPREFIX)stub
 DOTVERSION	= 8.4
 VERSION		= 84
 
-DDEVERSION = 12
-DDEDOTVERSION = 1.2
+DDEVERSION = 13
+DDEDOTVERSION = 1.3
 
-REGVERSION = 11
-REGDOTVERSION = 1.1
+REGVERSION = 12
+REGDOTVERSION = 1.2
 
 BINROOT		= ..
 !IF "$(NODEBUG)" == "1"
diff --git a/win/makefile.vc b/win/makefile.vc
index 94a585b..41a0006 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -159,10 +159,10 @@ STUBPREFIX = $(PROJECT)stub
 DOTVERSION = 8.4
 VERSION = $(DOTVERSION:.=)
 
-DDEDOTVERSION = 1.2
+DDEDOTVERSION = 1.3
 DDEVERSION = $(DDEDOTVERSION:.=)
 
-REGDOTVERSION = 1.1
+REGDOTVERSION = 1.2
 REGVERSION = $(REGDOTVERSION:.=)
 
 BINROOT		= .
diff --git a/win/rules.vc b/win/rules.vc
index 425f5fb..38e8175 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -477,8 +477,8 @@ TCLSH		= "$(_INSTALLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
 TCLSTUBLIB	= "$(_INSTALLDIR)\lib\tclstub$(TCL_VERSION).lib"
 TCLIMPLIB	= "$(_INSTALLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
 TCL_LIBRARY	= $(_INSTALLDIR)\lib
-TCLREGLIB	= "$(_INSTALLDIR)\lib\tclreg11$(SUFX:t=).lib"
-TCLDDELIB	= "$(_INSTALLDIR)\lib\tcldde12$(SUFX:t=).lib"
+TCLREGLIB	= "$(_INSTALLDIR)\lib\tclreg12$(SUFX:t=).lib"
+TCLDDELIB	= "$(_INSTALLDIR)\lib\tcldde13$(SUFX:t=).lib"
 COFFBASE	= \must\have\tcl\sources\to\build\this\target
 TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
 !else
@@ -486,8 +486,8 @@ TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
 TCLSTUBLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
 TCLIMPLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
 TCL_LIBRARY	= $(_TCLDIR)\library
-TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg11$(SUFX:t=).lib"
-TCLDDELIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib"
+TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib"
+TCLDDELIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib"
 COFFBASE	= "$(_TCLDIR)\win\coffbase.txt"
 TCLTOOLSDIR	= $(_TCLDIR)\tools
 !endif
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 4aa6f71..eef5caa 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -10,6 +10,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#include "tclInt.h"
 #include "tclPort.h"
 #include <dde.h>
 #include <ddeml.h>
@@ -34,6 +35,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;
 
@@ -49,6 +51,14 @@ 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
@@ -69,23 +79,33 @@ static DWORD ddeInstance;	/* The application instance handle given to us
 				 * by DdeInitialize. */
 static int ddeIsServer = 0;
 
-#define TCL_DDE_VERSION		"1.2.5"
 #define TCL_DDE_PACKAGE_NAME	"dde"
 #define TCL_DDE_SERVICE_NAME	"TclEval"
 #define TCL_DDE_EXECUTE_RESULT	"$TCLEVAL$EXECUTE$RESULT"
 
+#define DDE_FLAG_ASYNC 1
+#define DDE_FLAG_BINARY 2
+#define DDE_FLAG_FORCE 4
+
 TCL_DECLARE_MUTEX(ddeMutex)
 
 /*
  * Forward declarations for functions 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,
 			    const char *serviceName, const 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);
@@ -97,6 +117,7 @@ static int		DdeObjCmd(ClientData clientData,
 			    Tcl_Obj *const objv[]);
 
 EXTERN int		Dde_Init(Tcl_Interp *interp);
+EXTERN int		Dde_SafeInit(Tcl_Interp *interp);
 
 /*
  *----------------------------------------------------------------------
@@ -124,7 +145,34 @@ Dde_Init(
 
     Tcl_CreateObjCommand(interp, "dde", DdeObjCmd, NULL, NULL);
     Tcl_CreateExitHandler(DdeExitProc, NULL);
-    return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION);
+    return Tcl_PkgProvide(interp, TCL_DDE_PACKAGE_NAME, "1.3.3");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
 }
 
 /*
@@ -181,7 +229,7 @@ Initialize(void)
 	    ddeIsServer = 1;
 	    Tcl_CreateExitHandler(DdeExitProc, NULL);
 	    ddeServiceGlobal = DdeCreateStringHandle(ddeInstance,
-		    TCL_DDE_SERVICE_NAME, CP_WINANSI);
+		    TCL_DDE_SERVICE_NAME, 0);
 	    DdeNameService(ddeInstance, ddeServiceGlobal, 0L, DNS_REGISTER);
 	} else {
 	    ddeIsServer = 0;
@@ -218,13 +266,19 @@ Initialize(void)
 static const char *
 DdeSetServerName(
     Tcl_Interp *interp,
-    const char *name /* The name that will be used to refer to the
+    const char *name, /* The name that will be used to refer to the
 				 * interpreter in later "send" commands. Must
 				 * be globally unique. */
-    )
+    int flags,		/* DDE_FLAG_FORCE or 0 */
+    Tcl_Obj *handlerPtr)	/* Name of the optional proc/command to handle
+				 * incoming Dde eval's */
 {
+    int suffix, offset;
     RegisteredInterp *riPtr, *prevPtr;
     Tcl_DString dString;
+    const char *actualName;
+    Tcl_Obj *srvListPtr = NULL, **srvPtrPtr = NULL;
+    int n, srvCount = 0, lastSuffix, r = TCL_OK;
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     /*
@@ -263,7 +317,67 @@ DdeSetServerName(
 	return "";
     }
 
+    /*
+     * Get the list of currently registered Tcl interpreters by calling the
+     * internal implementation of the 'dde services' command.
+     */
+
     Tcl_DStringInit(&dString);
+    actualName = name;
+
+    if (!(flags & DDE_FLAG_FORCE)) {
+	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 + (int)strlen(Tcl_DStringValue(&dString)+offset));
+    }
 
     /*
      * We have found a unique name. Now add it to the registry.
@@ -271,10 +385,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", DdeObjCmd,
 	    (ClientData) riPtr, DeleteProc);
@@ -295,6 +417,38 @@ DdeSetServerName(
 /*
  *----------------------------------------------------------------------
  *
+ * 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.
@@ -333,6 +487,9 @@ DeleteProc(
 	}
     }
     ckfree(riPtr->name);
+    if (riPtr->handlerPtr) {
+	Tcl_DecrRefCount(riPtr->handlerPtr);
+    }
     Tcl_EventuallyFree(clientData, TCL_DYNAMIC);
 }
 
@@ -365,10 +522,35 @@ ExecuteRemoteObject(
     Tcl_Obj *ddeObjectPtr)	    /* The object to execute. */
 {
     Tcl_Obj *returnPackagePtr;
-    int result;
+    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);
 
-    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,
@@ -549,21 +731,27 @@ DdeServerProc(
 		ddeReturn = DdeCreateDataHandle(ddeInstance, (BYTE *)returnString,
 			(DWORD) len+1, 0, ddeItem, uFmt, 0);
 	    } else {
-		Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
-			convPtr->riPtr->interp, utilString, NULL,
-			TCL_GLOBAL_ONLY);
-		if (variableObjPtr != NULL) {
-		    if (uFmt == CF_TEXT) {
-			returnString = Tcl_GetStringFromObj(variableObjPtr, &len);
+		if (Tcl_IsSafe(convPtr->riPtr->interp)) {
+		    ddeReturn = NULL;
+		} else {
+		    Tcl_Obj *variableObjPtr = Tcl_GetVar2Ex(
+			    convPtr->riPtr->interp, utilString, NULL,
+			    TCL_GLOBAL_ONLY);
+		    if (variableObjPtr != NULL) {
+			if (uFmt == CF_TEXT) {
+			    returnString = Tcl_GetStringFromObj(
+				    variableObjPtr, &len);
+			} else {
+			    returnString = (char *) Tcl_GetUnicodeFromObj(
+				    variableObjPtr, &len);
+			    len = 2 * len + 1;
+			}
+			ddeReturn = DdeCreateDataHandle(ddeInstance,
+				(BYTE *)returnString, (DWORD) len+1, 0, ddeItem,
+				uFmt, 0);
 		    } else {
-			returnString = (char *)
-				Tcl_GetUnicodeFromObj(variableObjPtr, &len);
-			len = 2 * len + 1;
+			ddeReturn = NULL;
 		    }
-		    ddeReturn = DdeCreateDataHandle(ddeInstance,
-			    (BYTE *) returnString, (DWORD) len+1, 0, ddeItem, uFmt, 0);
-		    } else {
-		    ddeReturn = NULL;
 		}
 	    }
 	    Tcl_DStringFree(&dString);
@@ -723,8 +911,8 @@ MakeDdeConnection(
     HSZ ddeTopic, ddeService;
     HCONV ddeConv;
 
-    ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, CP_WINANSI);
-    ddeTopic = DdeCreateStringHandle(ddeInstance, name, CP_WINANSI);
+    ddeService = DdeCreateStringHandle(ddeInstance, TCL_DDE_SERVICE_NAME, 0);
+    ddeTopic = DdeCreateStringHandle(ddeInstance, name, 0);
 
     ddeConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
     DdeFreeStringHandle(ddeInstance, ddeService);
@@ -762,21 +950,9 @@ MakeDdeConnection(
  *----------------------------------------------------------------------
  */
 
-typedef struct ddeEnumServices {
-    Tcl_Interp *interp;
-    int         result;
-    ATOM        service;
-    ATOM        topic;
-    HWND        hwnd;
-} ddeEnumServices;
-
-static 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";
@@ -786,7 +962,7 @@ 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.
@@ -808,8 +984,9 @@ DdeClientWindowProc(
     switch (uMsg) {
     case WM_CREATE: {
 	LPCREATESTRUCT lpcs = (LPCREATESTRUCT) lParam;
-	ddeEnumServices *es =
-		(ddeEnumServices*) lpcs->lpCreateParams;
+	struct DdeEnumServices *es =
+		(struct DdeEnumServices *) lpcs->lpCreateParams;
+
 #ifdef _WIN64
 	SetWindowLongPtr(hwnd, GWLP_USERDATA, (LONG_PTR) es);
 #else
@@ -833,25 +1010,24 @@ DdeServicesOnAck(
     HWND hwndRemote = (HWND)wParam;
     ATOM service = (ATOM)LOWORD(lParam);
     ATOM topic = (ATOM)HIWORD(lParam);
-    ddeEnumServices *es;
+    struct DdeEnumServices *es;
     char 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)0 || es->service == service)
 	    && (es->topic == (ATOM)0 || 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));
+	Tcl_ListObjAppendElement(NULL, matchPtr, Tcl_NewStringObj(sz, -1));
 
 	/*
 	 * Adding the hwnd as a third list element provides a unique
@@ -864,8 +1040,13 @@ DdeServicesOnAck(
 	 *	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);
+	}
     }
 
     /*
@@ -882,7 +1063,7 @@ DdeEnumWindowsCallback(
     LPARAM lParam)
 {
     DWORD_PTR dwResult = 0;
-    ddeEnumServices *es = (ddeEnumServices *) lParam;
+    struct DdeEnumServices *es = (struct DdeEnumServices *) lParam;
 
     SendMessageTimeout(hwndTarget, WM_DDE_INITIATE, (WPARAM)es->hwnd,
 	    MAKELONG(es->service, es->topic), SMTO_ABORTIFHUNG, 1000,
@@ -896,7 +1077,7 @@ DdeGetServicesList(
     const char *serviceName,
     const char *topicName)
 {
-    ddeEnumServices es;
+    struct DdeEnumServices es;
 
     es.interp = interp;
     es.result = TCL_OK;
@@ -989,10 +1170,16 @@ DdeObjCmd(
     static const char *ddeCommands[] = {
 	"servername", "execute", "poke", "request", "services", "eval",
 	(char *) NULL};
-    enum {
+    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
     };
@@ -1000,15 +1187,14 @@ DdeObjCmd(
 	"-binary", NULL
     };
 
-    int index, length, argIndex;
-    int async = 0, binary = 0;
-    int result = TCL_OK, firstArg = 0;
+    int index, i, length, argIndex;
+    int flags = 0, result = TCL_OK, firstArg = 0;
     HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
     HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
     HCONV hConv = NULL;
     const char *serviceName = NULL, *topicName = NULL, *string;
     DWORD ddeResult;
-    Tcl_Obj *objPtr;
+    Tcl_Obj *objPtr, *handlerPtr = NULL;
 
     /*
      * Initialize DDE server/client
@@ -1024,24 +1210,59 @@ DdeObjCmd(
 	return TCL_ERROR;
     }
 
-    switch (index) {
+    switch ((enum DdeSubcommands) index) {
     case DDE_SERVERNAME:
-	if ((objc != 3) && (objc != 2)) {
-	    Tcl_WrongNumArgs(interp, 1, objv, "servername ?serverName?");
+	for (i = 2; i < objc; i++) {
+	    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;
+		}
+		Tcl_ResetResult(interp);
+		break;
+	    }
+	    if (argIndex == DDE_SERVERNAME_EXACT) {
+		flags |= DDE_FLAG_FORCE;
+	    } else if (argIndex == DDE_SERVERNAME_HANDLER) {
+		if ((objc - i) == 1) {	/* return current handler */
+		    RegisteredInterp *riPtr = DdeGetRegistrationPtr(interp);
+
+		    if (riPtr && riPtr->handlerPtr) {
+			Tcl_SetObjResult(interp, riPtr->handlerPtr);
+		    } else {
+			Tcl_ResetResult(interp);
+		    }
+		    return TCL_OK;
+		}
+		handlerPtr = objv[++i];
+	    } else if (argIndex == DDE_SERVERNAME_LAST) {
+		i++;
+		break;
+	    }
+	}
+
+	if ((objc - i) > 1) {
+	    Tcl_ResetResult(interp);
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "?-force? ?-handler proc? ?--? ?serverName?");
 	    return TCL_ERROR;
 	}
 
-	firstArg = (objc - 1);
+	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;
+		    &argIndex) == TCL_OK) {
+		flags |= DDE_FLAG_ASYNC;
 		firstArg = 3;
 		break;
 	    }
@@ -1066,7 +1287,7 @@ DdeObjCmd(
 	    int dummy;
 	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
 		    &dummy) == TCL_OK) {
-		binary = 1;
+		flags |= DDE_FLAG_BINARY;
 		firstArg = 3;
 		break;
 	    }
@@ -1098,7 +1319,7 @@ DdeObjCmd(
 		if (objc < 5) {
 		    goto wrongDdeEvalArgs;
 		}
-		async = 1;
+		flags |= DDE_FLAG_ASYNC;
 		firstArg++;
 	    }
 	    break;
@@ -1130,9 +1351,10 @@ DdeObjCmd(
 	}
     }
 
-    switch (index) {
+    switch ((enum DdeSubcommands) index) {
     case DDE_SERVERNAME:
-	serviceName = DdeSetServerName(interp, serviceName);
+	serviceName = DdeSetServerName(interp, serviceName, flags,
+		handlerPtr);
 	if (serviceName != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
 	} else {
@@ -1152,12 +1374,8 @@ DdeObjCmd(
 	    break;
 	}
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
-	if (ddeService) {
-	    DdeFreeStringHandle(ddeInstance, ddeService);
-	}
-	if (ddeTopic) {
-	    DdeFreeStringHandle(ddeInstance, ddeTopic);
-	}
+	DdeFreeStringHandle(ddeInstance, ddeService);
+	DdeFreeStringHandle(ddeInstance, ddeTopic);
 
 	if (hConv == NULL) {
 	    SetDdeError(interp);
@@ -1168,7 +1386,7 @@ DdeObjCmd(
 	ddeData = DdeCreateDataHandle(ddeInstance, dataString,
 		(DWORD) dataLength+1, 0, 0, CF_TEXT, 0);
 	if (ddeData != NULL) {
-	    if (async) {
+	    if (flags & DDE_FLAG_ASYNC) {
 		DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0,
 			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
 		DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
@@ -1198,12 +1416,8 @@ DdeObjCmd(
 	    goto cleanup;
 	}
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
-	if (ddeService) {
-	    DdeFreeStringHandle(ddeInstance, ddeService);
-	}
-	if (ddeTopic) {
-	    DdeFreeStringHandle(ddeInstance, ddeTopic);
-	}
+	DdeFreeStringHandle(ddeInstance, ddeService);
+	DdeFreeStringHandle(ddeInstance, ddeTopic);
 
 	if (hConv == NULL) {
 	    SetDdeError(interp);
@@ -1222,9 +1436,9 @@ DdeObjCmd(
 		    DWORD tmp;
 		    const char *dataString = (const char *) DdeAccessData(ddeData, &tmp);
 
-		    if (binary) {
-			returnObjPtr = Tcl_NewByteArrayObj((BYTE *) dataString,
-				(int) tmp);
+		    if (flags & DDE_FLAG_BINARY) {
+			returnObjPtr =
+				Tcl_NewByteArrayObj((BYTE *) dataString, (int) tmp);
 		    } else {
 			if (tmp && !dataString[tmp-1]) {
 			    --tmp;
@@ -1259,12 +1473,8 @@ DdeObjCmd(
 		&length);
 
 	hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
-	if (ddeService) {
 	DdeFreeStringHandle(ddeInstance, ddeService);
-	}
-	if (ddeTopic) {
 	DdeFreeStringHandle(ddeInstance, ddeTopic);
-	}
 
 	if (hConv == NULL) {
 	    SetDdeError(interp);
@@ -1302,8 +1512,8 @@ DdeObjCmd(
 	    goto cleanup;
 	}
 
-	objc -= (async + 3);
-	objv += (async + 3);
+	objc -= firstArg + 1;
+	objv += firstArg + 1;
 
 	/*
 	 * See if the target interpreter is local. If so, execute the command
@@ -1341,11 +1551,34 @@ DdeObjCmd(
 	     * referring to deallocated objects.
 	     */
 
-		if (objc == 1) {
-		    result = Tcl_EvalObjEx(sendInterp, objv[0],
-			    TCL_EVAL_GLOBAL);
-		} else {
-		objPtr = Tcl_ConcatObj(objc, objv);
+	    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);
+		}
+		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);
@@ -1384,7 +1617,8 @@ DdeObjCmd(
 	    if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
 	    invalidServerResponse:
 		Tcl_SetObjResult(interp,
-			Tcl_NewStringObj("invalid data returned from server", -1));
+			Tcl_NewStringObj("invalid data returned from server",
+			-1));
 		result = TCL_ERROR;
 		goto cleanup;
 	    }
@@ -1394,7 +1628,7 @@ DdeObjCmd(
 	    ddeItemData = DdeCreateDataHandle(ddeInstance,
 		    (BYTE *) string, (DWORD) length+1, 0, 0, CF_TEXT, 0);
 
-	    if (async) {
+	    if (flags & DDE_FLAG_ASYNC) {
 		ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
 			0xFFFFFFFF, hConv, 0,
 			CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
@@ -1416,10 +1650,9 @@ DdeObjCmd(
 	    if (ddeData == 0) {
 		SetDdeError(interp);
 		result = TCL_ERROR;
-		goto cleanup;
 	    }
 
-	    if (async == 0) {
+	    if (!(flags & DDE_FLAG_ASYNC)) {
 		Tcl_Obj *resultPtr;
 
 		/*
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 701edfb..a6ce2ce 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -1,18 +1,22 @@
 /*
  * tclWinReg.c --
  *
- *	This file contains the implementation of the "registry" Tcl
- *	built-in command.  This command is built as a dynamically
- *	loadable extension in a separate DLL.
+ *	This file contains the implementation of the "registry" Tcl built-in
+ *	command. This command is built as a dynamically loadable extension in
+ *	a separate DLL.
  *
  * Copyright (c) 1997 by Sun Microsystems, Inc.
  * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
- * 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.
  */
 
-#include <tclPort.h>
+#include "tclInt.h"
+#include "tclPort.h"
+#ifdef _MSC_VER
+#   pragma comment (lib, "advapi32.lib")
+#endif
 #include <stdlib.h>
 
 /*
@@ -25,6 +29,14 @@
 #define TCL_STORAGE_CLASS DLLEXPORT
 
 /*
+ * The maximum length of a sub-key name.
+ */
+
+#ifndef MAX_KEY_LENGTH
+#define MAX_KEY_LENGTH		256
+#endif
+
+/*
  * The following macros convert between different endian ints.
  */
 
@@ -32,15 +44,15 @@
 #define SWAPLONG(x) MAKELONG(SWAPWORD(HIWORD(x)), SWAPWORD(LOWORD(x)))
 
 /*
- * The following flag is used in OpenKeys to indicate that the specified
- * key should be created if it doesn't currently exist.
+ * The following flag is used in OpenKeys to indicate that the specified key
+ * should be created if it doesn't currently exist.
  */
 
 #define REG_CREATE 1
 
 /*
- * The following tables contain the mapping from registry root names
- * to the system predefined keys.
+ * The following tables contain the mapping from registry root names to the
+ * system predefined keys.
  */
 
 static CONST char *rootKeyNames[] = {
@@ -54,11 +66,12 @@ static const HKEY rootKeys[] = {
     HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, HKEY_DYN_DATA
 };
 
+static CONST char REGISTRY_ASSOC_KEY[] = "registry::command";
+
 /*
- * The following table maps from registry types to strings.  Note that
- * the indices for this array are the same as the constants for the
- * known registry types so we don't need a separate table to hold the
- * mapping.
+ * The following table maps from registry types to strings. Note that the
+ * indices for this array are the same as the constants for the known registry
+ * types so we don't need a separate table to hold the mapping.
  */
 
 static CONST char *typeNames[] = {
@@ -70,9 +83,9 @@ static DWORD lastType = REG_RESOURCE_LIST;
 
 /*
  * The following structures allow us to select between the Unicode and ASCII
- * interfaces at run time based on whether Unicode APIs are available.  The
- * Unicode APIs are preferable because they will handle characters outside
- * of the current code page.
+ * interfaces at run time based on whether Unicode APIs are available. The
+ * Unicode APIs are preferable because they will handle characters outside of
+ * the current code page.
  */
 
 typedef struct RegWinProcs {
@@ -80,7 +93,7 @@ typedef struct RegWinProcs {
 
     LONG (WINAPI *regConnectRegistryProc)(CONST TCHAR *, HKEY, PHKEY);
     LONG (WINAPI *regCreateKeyExProc)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
-	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *); 
+	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *, DWORD *);
     LONG (WINAPI *regDeleteKeyProc)(HKEY, CONST TCHAR *);
     LONG (WINAPI *regDeleteValueProc)(HKEY, CONST TCHAR *);
     LONG (WINAPI *regEnumKeyProc)(HKEY, DWORD, TCHAR *, DWORD);
@@ -90,9 +103,6 @@ typedef struct RegWinProcs {
 	    DWORD *, BYTE *, DWORD *);
     LONG (WINAPI *regOpenKeyExProc)(HKEY, CONST TCHAR *, DWORD, REGSAM,
 	    HKEY *);
-    LONG (WINAPI *regQueryInfoKeyProc)(HKEY, TCHAR *, DWORD *, DWORD *,
-	    DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
-	    FILETIME *);
     LONG (WINAPI *regQueryValueExProc)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
 	    BYTE *, DWORD *);
     LONG (WINAPI *regSetValueExProc)(HKEY, CONST TCHAR *, DWORD, DWORD,
@@ -107,7 +117,7 @@ static RegWinProcs asciiProcs = {
     (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
 	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
-	    DWORD *)) RegCreateKeyExA, 
+	    DWORD *)) RegCreateKeyExA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueA,
     (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyA,
@@ -117,9 +127,6 @@ static RegWinProcs asciiProcs = {
 	    DWORD *, BYTE *, DWORD *)) RegEnumValueA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
 	    HKEY *)) RegOpenKeyExA,
-    (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
-	    DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
-	    FILETIME *)) RegQueryInfoKeyA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
 	    BYTE *, DWORD *)) RegQueryValueExA,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
@@ -132,7 +139,7 @@ static RegWinProcs unicodeProcs = {
     (LONG (WINAPI *)(CONST TCHAR *, HKEY, PHKEY)) RegConnectRegistryW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, TCHAR *,
 	    DWORD, REGSAM, SECURITY_ATTRIBUTES *, HKEY *,
-	    DWORD *)) RegCreateKeyExW, 
+	    DWORD *)) RegCreateKeyExW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteKeyW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *)) RegDeleteValueW,
     (LONG (WINAPI *)(HKEY, DWORD, TCHAR *, DWORD)) RegEnumKeyW,
@@ -142,9 +149,6 @@ static RegWinProcs unicodeProcs = {
 	    DWORD *, BYTE *, DWORD *)) RegEnumValueW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, REGSAM,
 	    HKEY *)) RegOpenKeyExW,
-    (LONG (WINAPI *)(HKEY, TCHAR *, DWORD *, DWORD *,
-	    DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *, DWORD *,
-	    FILETIME *)) RegQueryInfoKeyW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD *, DWORD *,
 	    BYTE *, DWORD *)) RegQueryValueExW,
     (LONG (WINAPI *)(HKEY, CONST TCHAR *, DWORD, DWORD,
@@ -160,6 +164,7 @@ static void		AppendSystemError(Tcl_Interp *interp, DWORD error);
 static int		BroadcastValue(Tcl_Interp *interp, int objc,
 			    Tcl_Obj * CONST objv[]);
 static DWORD		ConvertDWORD(DWORD type, DWORD value);
+static void		DeleteCmd(ClientData clientData);
 static int		DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
 static int		DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
 			    Tcl_Obj *valueNameObj);
@@ -188,14 +193,15 @@ static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
 			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
 			    Tcl_Obj *typeObj);
 
-EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int		Registry_Init(Tcl_Interp *interp);
+EXTERN int		Registry_Unload(Tcl_Interp *interp, int flags);
 
 /*
  *----------------------------------------------------------------------
  *
  * Registry_Init --
  *
- *	This procedure initializes the registry command.
+ *	This function initializes the registry command.
  *
  * Results:
  *	A standard Tcl result.
@@ -210,7 +216,9 @@ int
 Registry_Init(
     Tcl_Interp *interp)
 {
-    if (!Tcl_InitStubs(interp, "8.0", 0)) {
+    Tcl_Command cmd;
+
+    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -225,8 +233,80 @@ Registry_Init(
 	regWinProcs = &asciiProcs;
     }
 
-    Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
-    return Tcl_PkgProvide(interp, "registry", "1.1.5");
+    cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
+	(ClientData)interp, DeleteCmd);
+    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
+    return Tcl_PkgProvide(interp, "registry", "1.2.2");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Registry_Unload --
+ *
+ *	This function removes the registry command.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	The registry command is deleted and the dll may be unloaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Registry_Unload(
+    Tcl_Interp *interp,		/* Interpreter for unloading */
+    int flags)			/* Flags passed by the unload system */
+{
+    Tcl_Command cmd;
+    Tcl_Obj *objv[3];
+
+    /*
+     * Unregister the registry package. There is no Tcl_PkgForget()
+     */
+
+    objv[0] = Tcl_NewStringObj("package", -1);
+    objv[1] = Tcl_NewStringObj("forget", -1);
+    objv[2] = Tcl_NewStringObj("registry", -1);
+    Tcl_EvalObjv(interp, 3, objv, TCL_EVAL_GLOBAL);
+
+    /*
+     * Delete the originally registered command.
+     */
+
+    cmd = (Tcl_Command)Tcl_GetAssocData(interp, REGISTRY_ASSOC_KEY, NULL);
+    if (cmd != NULL) {
+	Tcl_DeleteCommandFromToken(interp, cmd);
+    }
+
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteCmd --
+ *
+ *	Cleanup the interp command token so that unloading doesn't try to
+ *	re-delete the command (which will crash).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The unload command will not attempt to delete this command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteCmd(
+    ClientData clientData)
+{
+    Tcl_Interp *interp = clientData;
+    Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)NULL);
 }
 
 /*
@@ -256,8 +336,7 @@ RegistryObjCmd(
     char *errString = NULL;
 
     static CONST char *subcommands[] = {
-	"broadcast", "delete", "get", "keys", "set", "type", "values",
-	(char *) NULL
+	"broadcast", "delete", "get", "keys", "set", "type", "values", NULL
     };
     enum SubCmdIdx {
 	BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
@@ -274,65 +353,64 @@ RegistryObjCmd(
     }
 
     switch (index) {
-	case BroadcastIdx:		/* broadcast */
-	    return BroadcastValue(interp, objc, objv);
-	    break;
-	case DeleteIdx:			/* delete */
-	    if (objc == 3) {
-		return DeleteKey(interp, objv[2]);
-	    } else if (objc == 4) {
-		return DeleteValue(interp, objv[2], objv[3]);
-	    }
-	    errString = "keyName ?valueName?";
-	    break;
-	case GetIdx:			/* get */
-	    if (objc == 4) {
-		return GetValue(interp, objv[2], objv[3]);
-	    }
-	    errString = "keyName valueName";
-	    break;
-	case KeysIdx:			/* keys */
-	    if (objc == 3) {
-		return GetKeyNames(interp, objv[2], NULL);
-	    } else if (objc == 4) {
-		return GetKeyNames(interp, objv[2], objv[3]);
-	    }
-	    errString = "keyName ?pattern?";
-	    break;
-	case SetIdx:			/* set */
-	    if (objc == 3) {
-		HKEY key;
+    case BroadcastIdx:		/* broadcast */
+	return BroadcastValue(interp, objc, objv);
+	break;
+    case DeleteIdx:		/* delete */
+	if (objc == 3) {
+	    return DeleteKey(interp, objv[2]);
+	} else if (objc == 4) {
+	    return DeleteValue(interp, objv[2], objv[3]);
+	}
+	errString = "keyName ?valueName?";
+	break;
+    case GetIdx:		/* get */
+	if (objc == 4) {
+	    return GetValue(interp, objv[2], objv[3]);
+	}
+	errString = "keyName valueName";
+	break;
+    case KeysIdx:		/* keys */
+	if (objc == 3) {
+	    return GetKeyNames(interp, objv[2], NULL);
+	} else if (objc == 4) {
+	    return GetKeyNames(interp, objv[2], objv[3]);
+	}
+	errString = "keyName ?pattern?";
+	break;
+    case SetIdx:		/* set */
+	if (objc == 3) {
+	    HKEY key;
 
-		/*
-		 * Create the key and then close it immediately.
-		 */
+	    /*
+	     * Create the key and then close it immediately.
+	     */
 
-		if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key)
-			!= TCL_OK) {
-		    return TCL_ERROR;
-		}
-		RegCloseKey(key);
-		return TCL_OK;
-	    } else if (objc == 5 || objc == 6) {
-		Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
-		return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
-	    }
-	    errString = "keyName ?valueName data ?type??";
-	    break;
-	case TypeIdx:			/* type */
-	    if (objc == 4) {
-		return GetType(interp, objv[2], objv[3]);
-	    }
-	    errString = "keyName valueName";
-	    break;
-	case ValuesIdx:			/* values */
-	    if (objc == 3) {
- 		return GetValueNames(interp, objv[2], NULL);
-	    } else if (objc == 4) {
- 		return GetValueNames(interp, objv[2], objv[3]);
+	    if (OpenKey(interp, objv[2], KEY_ALL_ACCESS, 1, &key) != TCL_OK) {
+		return TCL_ERROR;
 	    }
-	    errString = "keyName ?pattern?";
-	    break;
+	    RegCloseKey(key);
+	    return TCL_OK;
+	} else if (objc == 5 || objc == 6) {
+	    Tcl_Obj *typeObj = (objc == 5) ? NULL : objv[5];
+	    return SetValue(interp, objv[2], objv[3], objv[4], typeObj);
+	}
+	errString = "keyName ?valueName data ?type??";
+	break;
+    case TypeIdx:		/* type */
+	if (objc == 4) {
+	    return GetType(interp, objv[2], objv[3]);
+	}
+	errString = "keyName valueName";
+	break;
+    case ValuesIdx:		/* values */
+	if (objc == 3) {
+	    return GetValueNames(interp, objv[2], NULL);
+	} else if (objc == 4) {
+	    return GetValueNames(interp, objv[2], objv[3]);
+	}
+	errString = "keyName ?pattern?";
+	break;
     }
     Tcl_WrongNumArgs(interp, 2, objv, errString);
     return TCL_ERROR;
@@ -364,7 +442,6 @@ DeleteKey(
     HKEY rootKey, subkey;
     DWORD result;
     int length;
-    Tcl_Obj *resultPtr;
     Tcl_DString buf;
 
     /*
@@ -375,15 +452,15 @@ DeleteKey(
     buffer = ckalloc((unsigned int) length + 1);
     strcpy(buffer, keyName);
 
-    if (ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName)
-	    != TCL_OK) {
+    if (ParseKeyName(interp, buffer, &hostName, &rootKey,
+	    &keyName) != TCL_OK) {
 	ckfree(buffer);
 	return TCL_ERROR;
     }
 
-    resultPtr = Tcl_GetObjResult(interp);
     if (*keyName == '\0') {
-	Tcl_AppendToObj(resultPtr, "bad key: cannot delete root keys", -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"bad key: cannot delete root keys", -1));
 	ckfree(buffer);
 	return TCL_ERROR;
     }
@@ -402,11 +479,11 @@ DeleteKey(
 	ckfree(buffer);
 	if (result == ERROR_FILE_NOT_FOUND) {
 	    return TCL_OK;
-	} else {
-	    Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
-	    AppendSystemError(interp, result);
-	    return TCL_ERROR;
 	}
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"unable to delete key: ", -1));
+	AppendSystemError(interp, result);
+	return TCL_ERROR;
     }
 
     /*
@@ -418,7 +495,8 @@ DeleteKey(
     Tcl_DStringFree(&buf);
 
     if (result != ERROR_SUCCESS && result != ERROR_FILE_NOT_FOUND) {
-	Tcl_AppendToObj(resultPtr, "unable to delete key: ", -1);
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("unable to delete key: ", -1));
 	AppendSystemError(interp, result);
 	result = TCL_ERROR;
     } else {
@@ -456,7 +534,6 @@ DeleteValue(
     char *valueName;
     int length;
     DWORD result;
-    Tcl_Obj *resultPtr;
     Tcl_DString ds;
 
     /*
@@ -468,13 +545,12 @@ DeleteValue(
 	return TCL_ERROR;
     }
 
-    resultPtr = Tcl_GetObjResult(interp);
     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
     Tcl_WinUtfToTChar(valueName, length, &ds);
     result = (*regWinProcs->regDeleteValueProc)(key, Tcl_DStringValue(&ds));
     Tcl_DStringFree(&ds);
     if (result != ERROR_SUCCESS) {
-	Tcl_AppendStringsToObj(resultPtr, "unable to delete value \"",
+	Tcl_AppendResult(interp, "unable to delete value \"",
 		Tcl_GetString(valueNameObj), "\" from key \"",
 		Tcl_GetString(keyNameObj), "\": ", NULL);
 	AppendSystemError(interp, result);
@@ -491,13 +567,13 @@ DeleteValue(
  *
  * GetKeyNames --
  *
- *	This function enumerates the subkeys of a given key.  If the
- *	optional pattern is supplied, then only keys that match the
- *	pattern will be returned.
+ *	This function enumerates the subkeys of a given key. If the optional
+ *	pattern is supplied, then only keys that match the pattern will be
+ *	returned.
  *
  * Results:
- *	Returns the list of subkeys in the result object of the
- *	interpreter, or an error message on failure.
+ *	Returns the list of subkeys in the result object of the interpreter,
+ *	or an error message on failure.
  *
  * Side effects:
  *	None.
@@ -513,9 +589,7 @@ GetKeyNames(
 {
     char *pattern;		/* Pattern being matched against subkeys */
     HKEY key;			/* Handle to the key being examined */
-    DWORD subKeyCount;		/* Number of subkeys to list */
-    DWORD maxSubKeyLen;		/* Maximum string length of any subkey */
-    char *buffer;		/* Buffer to hold the subkey name */
+    TCHAR buffer[MAX_KEY_LENGTH*2];		/* Buffer to hold the subkey name */
     DWORD bufSize;		/* Size of the buffer */
     DWORD index;		/* Position of the current subkey */
     char *name;			/* Subkey name */
@@ -537,43 +611,24 @@ GetKeyNames(
 	return TCL_ERROR;
     }
 
-    /* 
-     * Determine how big a buffer is needed for enumerating subkeys, and
-     * how many subkeys there are
-     */
-
-    result = (*regWinProcs->regQueryInfoKeyProc)
-	(key, NULL, NULL, NULL, &subKeyCount, &maxSubKeyLen, NULL, NULL, 
-	 NULL, NULL, NULL, NULL);
-    if (result != ERROR_SUCCESS) {
-	Tcl_SetObjResult(interp, Tcl_NewObj());
-	Tcl_AppendResult(interp, "unable to query key \"", 
-			 Tcl_GetString(keyNameObj), "\": ", NULL);
-	AppendSystemError(interp, result);
-	RegCloseKey(key);
-	return TCL_ERROR;
-    }
-    if (regWinProcs->useWide) {
-	buffer = ckalloc((maxSubKeyLen+1) * sizeof(WCHAR));
-    } else {
-	buffer = ckalloc(maxSubKeyLen+1);
-    }
-
     /* Enumerate the subkeys */
 
     resultPtr = Tcl_NewObj();
-    for (index = 0; index < subKeyCount; ++index) {
-	bufSize = maxSubKeyLen+1;
+    for (index = 0;; ++index) {
+	bufSize = MAX_KEY_LENGTH;
 	result = (*regWinProcs->regEnumKeyExProc)
 	    (key, index, buffer, &bufSize, NULL, NULL, NULL, NULL);
 	if (result != ERROR_SUCCESS) {
-	    Tcl_SetObjResult(interp, Tcl_NewObj());
-	    Tcl_AppendResult(interp,
-			     "unable to enumerate subkeys of \"",
-			     Tcl_GetString(keyNameObj),
-			     "\": ", NULL);
-	    AppendSystemError(interp, result);
-	    result = TCL_ERROR;
+	    if (result == ERROR_NO_MORE_ITEMS) {
+		result = TCL_OK;
+	    } else {
+		Tcl_SetObjResult(interp, Tcl_NewObj());
+		Tcl_AppendResult(interp,
+			"unable to enumerate subkeys of \"",
+			Tcl_GetString(keyNameObj), "\": ", NULL);
+		AppendSystemError(interp, result);
+		result = TCL_ERROR;
+	    }
 	    break;
 	}
 	if (regWinProcs->useWide) {
@@ -599,7 +654,6 @@ GetKeyNames(
 	Tcl_DecrRefCount(resultPtr); /* BUGFIX: Don't leak on failure. */
     }
 
-    ckfree(buffer);
     RegCloseKey(key);
     return result;
 }
@@ -609,8 +663,8 @@ GetKeyNames(
  *
  * GetType --
  *
- *	This function gets the type of a given registry value and
- *	places it in the interpreter result.
+ *	This function gets the type of a given registry value and places it in
+ *	the interpreter result.
  *
  * Results:
  *	Returns a normal Tcl result.
@@ -628,7 +682,6 @@ GetType(
     Tcl_Obj *valueNameObj)	/* Name of value to get. */
 {
     HKEY key;
-    Tcl_Obj *resultPtr;
     DWORD result;
     DWORD type;
     Tcl_DString ds;
@@ -649,8 +702,6 @@ GetType(
      * Get the type of the value.
      */
 
-    resultPtr = Tcl_GetObjResult(interp);
-
     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
     nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
     result = (*regWinProcs->regQueryValueExProc)(key, nativeValue, NULL, &type,
@@ -659,7 +710,7 @@ GetType(
     RegCloseKey(key);
 
     if (result != ERROR_SUCCESS) {
-	Tcl_AppendStringsToObj(resultPtr, "unable to get type of value \"",
+	Tcl_AppendResult(interp, "unable to get type of value \"",
 		Tcl_GetString(valueNameObj), "\" from key \"",
 		Tcl_GetString(keyNameObj), "\": ", NULL);
 	AppendSystemError(interp, result);
@@ -667,14 +718,14 @@ GetType(
     }
 
     /*
-     * Set the type into the result.  Watch out for unknown types.
-     * If we don't know about the type, just use the numeric value.
+     * Set the type into the result. Watch out for unknown types. If we don't
+     * know about the type, just use the numeric value.
      */
 
     if (type > lastType) {
-	Tcl_SetIntObj(resultPtr, (int) type);
+	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) type));
     } else {
-	Tcl_SetStringObj(resultPtr, typeNames[type], -1);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(typeNames[type], -1));
     }
     return TCL_OK;
 }
@@ -684,9 +735,8 @@ GetType(
  *
  * GetValue --
  *
- *	This function gets the contents of a registry value and places
- *	a list containing the data and the type in the interpreter
- *	result.
+ *	This function gets the contents of a registry value and places a list
+ *	containing the data and the type in the interpreter result.
  *
  * Results:
  *	Returns a normal Tcl result.
@@ -707,7 +757,6 @@ GetValue(
     char *valueName;
     CONST char *nativeValue;
     DWORD result, length, type;
-    Tcl_Obj *resultPtr;
     Tcl_DString data, buf;
     int nameLen;
 
@@ -715,16 +764,15 @@ GetValue(
      * Attempt to open the key for reading.
      */
 
-    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key)
-	    != TCL_OK) {
+    if (OpenKey(interp, keyNameObj, KEY_QUERY_VALUE, 0, &key) != TCL_OK) {
 	return TCL_ERROR;
     }
 
     /*
-     * Initialize a Dstring to maximum statically allocated size
-     * we could get one more byte by avoiding Tcl_DStringSetLength()
-     * and just setting length to TCL_DSTRING_STATIC_SIZE, but this
-     * should be safer if the implementation of Dstrings changes.
+     * Initialize a Dstring to maximum statically allocated size we could get
+     * one more byte by avoiding Tcl_DStringSetLength() and just setting
+     * length to TCL_DSTRING_STATIC_SIZE, but this should be safer if the
+     * implementation of Dstrings changes.
      *
      * This allows short values to be read from the registy in one call.
      * Longer values need a second call with an expanded DString.
@@ -734,8 +782,6 @@ GetValue(
     Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
     length = TCL_DSTRING_STATIC_SIZE / (regWinProcs->useWide ? 2 : 1) - 1;
 
-    resultPtr = Tcl_GetObjResult(interp);
-
     valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
     nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
 
@@ -743,11 +789,12 @@ GetValue(
 	    (BYTE *) Tcl_DStringValue(&data), &length);
     while (result == ERROR_MORE_DATA) {
 	/*
-	 * The Windows docs say that in this error case, we just need
-	 * to expand our buffer and request more data.
-	 * Required for HKEY_PERFORMANCE_DATA
+	 * The Windows docs say that in this error case, we just need to
+	 * expand our buffer and request more data. Required for
+	 * HKEY_PERFORMANCE_DATA
 	 */
-	length *= 2;
+
+	length = Tcl_DStringLength(&data) * (regWinProcs->useWide ? 1 : 2);
 	Tcl_DStringSetLength(&data, (int) length * (regWinProcs->useWide ? 2 : 1));
 	result = (*regWinProcs->regQueryValueExProc)(key, (char *) nativeValue,
 		NULL, &type, (BYTE *) Tcl_DStringValue(&data), &length);
@@ -755,7 +802,7 @@ GetValue(
     Tcl_DStringFree(&buf);
     RegCloseKey(key);
     if (result != ERROR_SUCCESS) {
-	Tcl_AppendStringsToObj(resultPtr, "unable to get value \"",
+	Tcl_AppendResult(interp, "unable to get value \"",
 		Tcl_GetString(valueNameObj), "\" from key \"",
 		Tcl_GetString(keyNameObj), "\": ", NULL);
 	AppendSystemError(interp, result);
@@ -764,26 +811,27 @@ GetValue(
     }
 
     /*
-     * If the data is a 32-bit quantity, store it as an integer object.  If it
-     * is a multi-string, store it as a list of strings.  For null-terminated
-     * strings, append up the to first null.  Otherwise, store it as a binary
+     * If the data is a 32-bit quantity, store it as an integer object. If it
+     * is a multi-string, store it as a list of strings. For null-terminated
+     * strings, append up the to first null. Otherwise, store it as a binary
      * string.
      */
 
     if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
-	Tcl_SetIntObj(resultPtr, (int) ConvertDWORD(type,
-		*((DWORD*) Tcl_DStringValue(&data))));
+	Tcl_SetObjResult(interp, Tcl_NewIntObj((int) ConvertDWORD(type,
+		*((DWORD*) Tcl_DStringValue(&data)))));
     } else if (type == REG_MULTI_SZ) {
 	char *p = Tcl_DStringValue(&data);
 	char *end = Tcl_DStringValue(&data) + length;
+	Tcl_Obj *resultPtr = Tcl_NewObj();
 
 	/*
 	 * Multistrings are stored as an array of null-terminated strings,
-	 * terminated by two null characters.  Also do a bounds check in
-	 * case we get bogus data.
+	 * terminated by two null characters. Also do a bounds check in case
+	 * we get bogus data.
 	 */
- 
-	while (p < end 	&& ((regWinProcs->useWide) 
+
+	while (p < end 	&& ((regWinProcs->useWide)
 		? *((Tcl_UniChar *)p) : *p) != 0) {
 	    Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
 	    Tcl_ListObjAppendElement(interp, resultPtr,
@@ -798,17 +846,17 @@ GetValue(
 	    }
 	    Tcl_DStringFree(&buf);
 	}
+	Tcl_SetObjResult(interp, resultPtr);
     } else if ((type == REG_SZ) || (type == REG_EXPAND_SZ)) {
 	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&data), -1, &buf);
-	Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&buf),
-		Tcl_DStringLength(&buf));
-	Tcl_DStringFree(&buf);
+	Tcl_DStringResult(interp, &buf);
     } else {
 	/*
 	 * Save binary data as a byte array.
 	 */
 
-	Tcl_SetByteArrayObj(resultPtr, (BYTE *) Tcl_DStringValue(&data), (int) length);
+	Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
+		(BYTE *) Tcl_DStringValue(&data), (int) length));
     }
     Tcl_DStringFree(&data);
     return result;
@@ -819,9 +867,9 @@ GetValue(
  *
  * GetValueNames --
  *
- *	This function enumerates the values of the a given key.  If
- *	the optional pattern is supplied, then only value names that
- *	match the pattern will be returned.
+ *	This function enumerates the values of the a given key. If the
+ *	optional pattern is supplied, then only value names that match the
+ *	pattern will be returned.
  *
  * Results:
  *	Returns the list of value names in the result object of the
@@ -841,7 +889,7 @@ GetValueNames(
 {
     HKEY key;
     Tcl_Obj *resultPtr;
-    DWORD index, size, maxSize, result;
+    DWORD index, size, result;
     Tcl_DString buffer, ds;
     char *pattern, *name;
 
@@ -854,29 +902,10 @@ GetValueNames(
 	return TCL_ERROR;
     }
 
-    resultPtr = Tcl_GetObjResult(interp);
-
-    /*
-     * Query the key to determine the appropriate buffer size to hold the
-     * largest value name plus the terminating null.
-     */
-
-    result = (*regWinProcs->regQueryInfoKeyProc)(key, NULL, NULL, NULL, NULL,
-	    NULL, NULL, &index, &maxSize, NULL, NULL, NULL);
-    if (result != ERROR_SUCCESS) {
-	Tcl_AppendStringsToObj(resultPtr, "unable to query key \"",
-		Tcl_GetString(keyNameObj), "\": ", NULL);
-	AppendSystemError(interp, result);
-	RegCloseKey(key);
-	result = TCL_ERROR;
-	goto done;
-    }
-    maxSize++;
-
-
+    resultPtr = Tcl_NewObj();
     Tcl_DStringInit(&buffer);
     Tcl_DStringSetLength(&buffer,
-	    (int) ((regWinProcs->useWide) ? maxSize*2 : maxSize));
+	    (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH*2 : MAX_KEY_LENGTH));
     index = 0;
     result = TCL_OK;
 
@@ -888,11 +917,11 @@ GetValueNames(
 
     /*
      * Enumerate the values under the given subkey until we get an error,
-     * indicating the end of the list.  Note that we need to reset size
-     * after each iteration because RegEnumValue smashes the old value.
+     * indicating the end of the list. Note that we need to reset size after
+     * each iteration because RegEnumValue smashes the old value.
      */
 
-    size = maxSize;
+    size = MAX_KEY_LENGTH;
     while ((*regWinProcs->regEnumValueProc)(key, index,
 	    Tcl_DStringValue(&buffer), &size, NULL, NULL, NULL, NULL)
 	    == ERROR_SUCCESS) {
@@ -901,7 +930,8 @@ GetValueNames(
 	    size *= 2;
 	}
 
-	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size, &ds);
+	Tcl_WinTCharToUtf((TCHAR *) Tcl_DStringValue(&buffer), (int) size,
+		&ds);
 	name = Tcl_DStringValue(&ds);
 	if (!pattern || Tcl_StringMatch(name, pattern)) {
 	    result = Tcl_ListObjAppendElement(interp, resultPtr,
@@ -914,11 +944,10 @@ GetValueNames(
 	Tcl_DStringFree(&ds);
 
 	index++;
-	size = maxSize;
+	size = MAX_KEY_LENGTH;
     }
+    Tcl_SetObjResult(interp, resultPtr);
     Tcl_DStringFree(&buffer);
-
-    done:
     RegCloseKey(key);
     return result;
 }
@@ -928,12 +957,11 @@ GetValueNames(
  *
  * OpenKey --
  *
- *	This function opens the specified key.  This function is a
- *	simple wrapper around ParseKeyName and OpenSubKey.
+ *	This function opens the specified key. This function is a simple
+ *	wrapper around ParseKeyName and OpenSubKey.
  *
  * Results:
- *	Returns the opened key in the keyPtr argument and a Tcl
- *	result code.
+ *	Returns the opened key in the keyPtr argument and a Tcl result code.
  *
  * Side effects:
  *	None.
@@ -962,8 +990,8 @@ OpenKey(
     if (result == TCL_OK) {
 	result = OpenSubKey(hostName, rootKey, keyName, mode, flags, keyPtr);
 	if (result != ERROR_SUCCESS) {
-	    Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
-	    Tcl_AppendToObj(resultPtr, "unable to open key: ", -1);
+	    Tcl_SetObjResult(interp,
+		    Tcl_NewStringObj("unable to open key: ", -1));
 	    AppendSystemError(interp, result);
 	    result = TCL_ERROR;
 	} else {
@@ -980,12 +1008,12 @@ OpenKey(
  *
  * OpenSubKey --
  *
- *	This function opens a given subkey of a root key on the
- *	specified host.
+ *	This function opens a given subkey of a root key on the specified
+ *	host.
  *
  * Results:
- *	Returns the opened key in the keyPtr and a Windows error code
- *	as the return value.
+ *	Returns the opened key in the keyPtr and a Windows error code as the
+ *	return value.
  *
  * Side effects:
  *	None.
@@ -1020,8 +1048,8 @@ OpenSubKey(
     }
 
     /*
-     * Now open the specified key with the requested permissions.  Note
-     * that this key must be closed by the caller.
+     * Now open the specified key with the requested permissions. Note that
+     * this key must be closed by the caller.
      */
 
     keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
@@ -1029,19 +1057,16 @@ OpenSubKey(
 	DWORD create;
 	result = (*regWinProcs->regCreateKeyExProc)(rootKey, keyName, 0, NULL,
 		REG_OPTION_NON_VOLATILE, mode, NULL, keyPtr, &create);
+    } else if (rootKey == HKEY_PERFORMANCE_DATA) {
+	/*
+	 * Here we fudge it for this special root key. See MSDN for more info
+	 * on HKEY_PERFORMANCE_DATA and the peculiarities surrounding it.
+	 */
+	*keyPtr = HKEY_PERFORMANCE_DATA;
+	result = ERROR_SUCCESS;
     } else {
-	if (rootKey == HKEY_PERFORMANCE_DATA) {
-	    /*
-	     * Here we fudge it for this special root key.
-	     * See MSDN for more info on HKEY_PERFORMANCE_DATA and
-	     * the peculiarities surrounding it
-	     */
-	    *keyPtr = HKEY_PERFORMANCE_DATA;
-	    result = ERROR_SUCCESS;
-	} else {
-	    result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0,
-		    mode, keyPtr);
-	}
+	result = (*regWinProcs->regOpenKeyExProc)(rootKey, keyName, 0, mode,
+		keyPtr);
     }
     Tcl_DStringFree(&buf);
 
@@ -1060,15 +1085,12 @@ OpenSubKey(
  *
  * ParseKeyName --
  *
- *	This function parses a key name into the host, root, and subkey
- *	parts.
+ *	This function parses a key name into the host, root, and subkey parts.
  *
  * Results:
- *	The pointers to the start of the host and subkey names are
- *	returned in the hostNamePtr and keyNamePtr variables.  The
- *	specified root HKEY is returned in rootKeyPtr.  Returns
- *	a standard Tcl result.
- *
+ *	The pointers to the start of the host and subkey names are returned in
+ *	the hostNamePtr and keyNamePtr variables. The specified root HKEY is
+ *	returned in rootKeyPtr. Returns a standard Tcl result.
  *
  * Side effects:
  *	Modifies the name string by inserting nulls.
@@ -1086,7 +1108,7 @@ ParseKeyName(
 {
     char *rootName;
     int result, index;
-    Tcl_Obj *rootObj, *resultPtr = Tcl_GetObjResult(interp);
+    Tcl_Obj *rootObj;
 
     /*
      * Split the key into host and root portions.
@@ -1107,7 +1129,7 @@ ParseKeyName(
 	rootName = name;
     }
     if (!rootName) {
-	Tcl_AppendStringsToObj(resultPtr, "bad key \"", name,
+	Tcl_AppendResult(interp, "bad key \"", name,
 		"\": must start with a valid root", NULL);
 	return TCL_ERROR;
     }
@@ -1144,9 +1166,9 @@ ParseKeyName(
  *
  * RecursiveDeleteKey --
  *
- *	This function recursively deletes all the keys below a starting
- *	key.  Although Windows 95 does this automatically, we still need
- *	to do this for Windows NT.
+ *	This function recursively deletes all the keys below a starting key.
+ *	Although Windows 95 does this automatically, we still need to do this
+ *	for Windows NT.
  *
  * Results:
  *	Returns a Windows error code.
@@ -1163,7 +1185,7 @@ RecursiveDeleteKey(
     CONST char *keyName)	/* Name of key to be deleted in external
 				 * encoding, not UTF. */
 {
-    DWORD result, size, maxSize;
+    DWORD result, size;
     Tcl_DString subkey;
     HKEY hKey;
 
@@ -1180,23 +1202,17 @@ RecursiveDeleteKey(
     if (result != ERROR_SUCCESS) {
 	return result;
     }
-    result = (*regWinProcs->regQueryInfoKeyProc)(hKey, NULL, NULL, NULL, NULL,
-	    &maxSize, NULL, NULL, NULL, NULL, NULL, NULL);
-    maxSize++;
-    if (result != ERROR_SUCCESS) {
-	return result;
-    }
 
     Tcl_DStringInit(&subkey);
     Tcl_DStringSetLength(&subkey,
-	    (int) ((regWinProcs->useWide) ? maxSize * 2 : maxSize));
+	    (int) ((regWinProcs->useWide) ? MAX_KEY_LENGTH * 2 : MAX_KEY_LENGTH));
 
     while (result == ERROR_SUCCESS) {
 	/*
 	 * Always get index 0 because key deletion changes ordering.
 	 */
 
-	size = maxSize;
+	size = MAX_KEY_LENGTH;
 	result=(*regWinProcs->regEnumKeyExProc)(hKey, 0,
 		Tcl_DStringValue(&subkey), &size, NULL, NULL, NULL, NULL);
 	if (result == ERROR_NO_MORE_ITEMS) {
@@ -1216,9 +1232,9 @@ RecursiveDeleteKey(
  *
  * SetValue --
  *
- *	This function sets the contents of a registry value.  If
- *	the key or value does not exist, it will be created.  If it
- *	does exist, then the data and type will be replaced.
+ *	This function sets the contents of a registry value. If the key or
+ *	value does not exist, it will be created. If it does exist, then the
+ *	data and type will be replaced.
  *
  * Results:
  *	Returns a normal Tcl result.
@@ -1237,11 +1253,11 @@ SetValue(
     Tcl_Obj *dataObj,		/* Data to be written. */
     Tcl_Obj *typeObj)		/* Type of data to be written. */
 {
-    DWORD type, result;
+    int type;
+    DWORD result;
     HKEY key;
     int length;
     char *valueName;
-    Tcl_Obj *resultPtr;
     Tcl_DString nameBuf;
 
     if (typeObj == NULL) {
@@ -1259,19 +1275,19 @@ SetValue(
 
     valueName = Tcl_GetStringFromObj(valueNameObj, &length);
     valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
-    resultPtr = Tcl_GetObjResult(interp);
 
     if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
-	DWORD value;
-	if (Tcl_GetIntFromObj(interp, dataObj, (int*) &value) != TCL_OK) {
+	int value;
+
+	if (Tcl_GetIntFromObj(interp, dataObj, &value) != TCL_OK) {
 	    RegCloseKey(key);
 	    Tcl_DStringFree(&nameBuf);
 	    return TCL_ERROR;
 	}
 
-	value = ConvertDWORD(type, value);
-	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
-		(BYTE*) &value, sizeof(DWORD));
+	value = ConvertDWORD((DWORD)type, (DWORD)value);
+	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+		(DWORD) type, (BYTE *) &value, sizeof(DWORD));
     } else if (type == REG_MULTI_SZ) {
 	Tcl_DString data, buf;
 	int objc, i;
@@ -1284,9 +1300,9 @@ SetValue(
 	}
 
 	/*
-	 * Append the elements as null terminated strings.  Note that
-	 * we must not assume the length of the string in case there are
-	 * embedded nulls, which aren't allowed in REG_MULTI_SZ values.
+	 * Append the elements as null terminated strings. Note that we must
+	 * not assume the length of the string in case there are embedded
+	 * nulls, which aren't allowed in REG_MULTI_SZ values.
 	 */
 
 	Tcl_DStringInit(&data);
@@ -1294,8 +1310,8 @@ SetValue(
 	    Tcl_DStringAppend(&data, Tcl_GetString(objv[i]), -1);
 
 	    /*
-	     * Add a null character to separate this value from the next.
-	     * We accomplish this by growing the string by one byte.  Since the
+	     * Add a null character to separate this value from the next. We
+	     * accomplish this by growing the string by one byte. Since the
 	     * DString always tacks on an extra null byte, the new byte will
 	     * already be set to null.
 	     */
@@ -1305,16 +1321,16 @@ SetValue(
 
 	Tcl_WinUtfToTChar(Tcl_DStringValue(&data), Tcl_DStringLength(&data)+1,
 		&buf);
-	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
-		(BYTE *) Tcl_DStringValue(&buf),
+	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+                (DWORD) type, (BYTE *) Tcl_DStringValue(&buf),
 		(DWORD) Tcl_DStringLength(&buf));
 	Tcl_DStringFree(&data);
 	Tcl_DStringFree(&buf);
     } else if (type == REG_SZ || type == REG_EXPAND_SZ) {
 	Tcl_DString buf;
-	char *data = Tcl_GetStringFromObj(dataObj, &length);
+	CONST char *data = Tcl_GetStringFromObj(dataObj, &length);
 
-	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
+	data = Tcl_WinUtfToTChar(data, length, &buf);
 
 	/*
 	 * Include the null in the length, padding if needed for Unicode.
@@ -1325,8 +1341,8 @@ SetValue(
 	}
 	length = Tcl_DStringLength(&buf) + 1;
 
-	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
-		(BYTE*)data, (DWORD) length);
+	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+                (DWORD) type, (BYTE *) data, (DWORD) length);
 	Tcl_DStringFree(&buf);
     } else {
 	BYTE *data;
@@ -1335,14 +1351,17 @@ SetValue(
 	 * Store binary data in the registry.
 	 */
 
-	data = Tcl_GetByteArrayFromObj(dataObj, &length);
-	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0, type,
-		data, (DWORD) length);
+	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
+	result = (*regWinProcs->regSetValueExProc)(key, valueName, 0,
+                (DWORD) type, data, (DWORD) length);
     }
+
     Tcl_DStringFree(&nameBuf);
     RegCloseKey(key);
+
     if (result != ERROR_SUCCESS) {
-	Tcl_AppendToObj(resultPtr, "unable to set value: ", -1);
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("unable to set value: ", -1));
 	AppendSystemError(interp, result);
 	return TCL_ERROR;
     }
@@ -1354,9 +1373,8 @@ SetValue(
  *
  * BroadcastValue --
  *
- *	This function broadcasts a WM_SETTINGCHANGE message to indicate
- *	to other programs that we have changed the contents of a registry
- *	value.
+ *	This function broadcasts a WM_SETTINGCHANGE message to indicate to
+ *	other programs that we have changed the contents of a registry value.
  *
  * Results:
  *	Returns a normal Tcl result.
@@ -1371,13 +1389,13 @@ static int
 BroadcastValue(
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
-    Tcl_Obj * CONST objv[])	/* Argument values. */
+    Tcl_Obj *CONST objv[])	/* Argument values. */
 {
     LRESULT result;
     DWORD_PTR sendResult;
     UINT timeout = 3000;
     int len;
-    char *str;
+    CONST char *str;
     Tcl_Obj *objPtr;
 
     if ((objc != 3) && (objc != 5)) {
@@ -1387,7 +1405,8 @@ BroadcastValue(
 
     if (objc > 3) {
 	str = Tcl_GetStringFromObj(objv[3], &len);
-	if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", (size_t) len)) {
+	if ((len < 2) || (*str != '-')
+		|| strncmp(str, "-timeout", (size_t) len)) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
 	    return TCL_ERROR;
 	}
@@ -1404,6 +1423,7 @@ BroadcastValue(
     /*
      * Use the ignore the result.
      */
+
     result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
 	    (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
 
@@ -1420,8 +1440,8 @@ BroadcastValue(
  *
  * AppendSystemError --
  *
- *	This routine formats a Windows system error message and places
- *	it into the interpreter result.
+ *	This routine formats a Windows system error message and places it into
+ *	the interpreter result.
  *
  * Results:
  *	None.
@@ -1438,15 +1458,18 @@ AppendSystemError(
     DWORD error)		/* Result code from error. */
 {
     int length;
-    WCHAR *wMsgPtr;
+    WCHAR *wMsgPtr, **wMsgPtrPtr = &wMsgPtr;
     char *msg;
     char id[TCL_INTEGER_SPACE], msgBuf[24 + TCL_INTEGER_SPACE];
     Tcl_DString ds;
     Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
 
+    if (Tcl_IsShared(resultPtr)) {
+	resultPtr = Tcl_DuplicateObj(resultPtr);
+    }
     length = FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM
 	    | FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, error,
-	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) &wMsgPtr,
+	    MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (WCHAR *) wMsgPtrPtr,
 	    0, NULL);
     if (length == 0) {
 	char *msgPtr;
@@ -1483,6 +1506,7 @@ AppendSystemError(
 	/*
 	 * Trim the trailing CR/LF from the system message.
 	 */
+
 	if (msg[length-1] == '\n') {
 	    msg[--length] = 0;
 	}
@@ -1492,8 +1516,9 @@ AppendSystemError(
     }
 
     sprintf(id, "%ld", error);
-    Tcl_SetErrorCode(interp, "WINDOWS", id, msg, (char *) NULL);
+    Tcl_SetErrorCode(interp, "WINDOWS", id, msg, NULL);
     Tcl_AppendToObj(resultPtr, msg, length);
+    Tcl_SetObjResult(interp, resultPtr);
 
     if (length != 0) {
 	Tcl_DStringFree(&ds);
@@ -1505,8 +1530,8 @@ AppendSystemError(
  *
  * ConvertDWORD --
  *
- *	This function determines whether a DWORD needs to be byte
- *	swapped, and returns the appropriately swapped value.
+ *	This function determines whether a DWORD needs to be byte swapped, and
+ *	returns the appropriately swapped value.
  *
  * Results:
  *	Returns a converted DWORD.
@@ -1529,6 +1554,14 @@ ConvertDWORD(
      * Check to see if the low bit is in the first byte.
      */
 
-    localType = (*((char*)(&order)) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
-    return (type != localType) ? (DWORD)SWAPLONG(value) : value;
+    localType = (*((char*) &order) == 1) ? REG_DWORD : REG_DWORD_BIG_ENDIAN;
+    return (type != localType) ? (DWORD) SWAPLONG(value) : value;
 }
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */