Make tclreg13.dll work in any Unicode environment (either with 32-bit or 64-bit characters). Adopted from Androwish. Thanks to Christian Werner. version -> 1.3.2

5 files changed, 24 insertions, 20 deletions

diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index 49fd1ac..b1fe234 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,9 @@
 if {([info commands ::tcl::pkgconfig] eq "")
 	|| ([info sharedlibextension] ne ".dll")} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded registry 1.3.1 \
+    package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13g.dll] registry]
 } else {
-    package ifneeded registry 1.3.1 \
+    package ifneeded registry 1.3.2 \
             [list load [file join $dir tclreg13.dll] registry]
 }
diff --git a/tests/registry.test b/tests/registry.test
index 0f78212..2072559 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -19,7 +19,7 @@ testConstraint reg 0
 if {[testConstraint win]} {
     if {![catch {
 	    ::tcltest::loadTestedCommands
-	    set ::regver [package require registry 1.3.1]
+	    set ::regver [package require registry 1.3.2]
 	}]} {
 	testConstraint reg 1
     }
@@ -33,7 +33,7 @@ testConstraint english [expr {
 
 test registry-1.0 {check if we are testing the right dll} {win reg} {
     set ::regver
-} {1.3.1}
+} {1.3.2}
 test registry-1.1 {argument parsing for registry command} {win reg} {
     list [catch {registry} msg] $msg
 } {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
diff --git a/win/Makefile.in b/win/Makefile.in
index 2d27a41..cf72e1c 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -713,14 +713,14 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
 	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
+	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
 
 # Useful target to launch a built tclsh with the proper path,...
 runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
-	package ifneeded registry 1.3.1 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
+	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
 
 # This target can be used to run tclsh from the build directory via
 # `make shell SCRIPT=foo.tcl`
diff --git a/win/makefile.vc b/win/makefile.vc
index ecfcecf..eb9a594 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -589,13 +589,13 @@ test-core: setup $(TCLTEST) dlls $(CAT32)
 !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"

 	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<

 		package ifneeded dde 1.4.0 [list load "$(TCLDDELIB:\=/)" dde]

-		package ifneeded registry 1.3.1 [list load "$(TCLREGLIB:\=/)" registry]

+		package ifneeded registry 1.3.2 [list load "$(TCLREGLIB:\=/)" registry]

 <<

 !else

 	@echo Please wait while the tests are collected...

 	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log

 		package ifneeded dde 1.4.0 "$(TCLDDELIB:\=/)" dde]

-		package ifneeded registry 1.3.1 "$(TCLREGLIB:\=/)" registry]

+		package ifneeded registry 1.3.2 "$(TCLREGLIB:\=/)" registry]

 <<

 	type tests.log | more

 !endif

diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 56aa991..a3bcc81 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -163,7 +163,7 @@ Registry_Init(
     cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
 	    interp, DeleteCmd);
     Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
-    return Tcl_PkgProvide(interp, "registry", "1.3.1");
+    return Tcl_PkgProvide(interp, "registry", "1.3.2");
 }
 
 /*
@@ -803,17 +803,17 @@ GetValue(
 	 * we get bogus data.
 	 */
 
-	while ((p < end) && *((Tcl_UniChar *) p) != 0) {
-	    Tcl_UniChar *up;
+	while ((p < end) && *((WCHAR *) p) != 0) {
+	    WCHAR *wp;
 
 	    Tcl_WinTCharToUtf((TCHAR *) p, -1, &buf);
 	    Tcl_ListObjAppendElement(interp, resultPtr,
 		    Tcl_NewStringObj(Tcl_DStringValue(&buf),
 			    Tcl_DStringLength(&buf)));
-	    up = (Tcl_UniChar *) p;
+	    wp = (WCHAR *) p;
 
-	    while (*up++ != 0) {/* empty body */}
-	    p = (char *) up;
+	    while (*wp++ != 0) {/* empty body */}
+	    p = (char *) wp;
 	    Tcl_DStringFree(&buf);
 	}
 	Tcl_SetObjResult(interp, resultPtr);
@@ -1332,7 +1332,7 @@ SetValue(
 	data = (char *) Tcl_WinUtfToTChar(data, length, &buf);
 
 	/*
-	 * Include the null in the length, padding if needed for Unicode.
+	 * Include the null in the length, padding if needed for WCHAR.
 	 */
 
 	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);
@@ -1393,9 +1393,10 @@ BroadcastValue(
     DWORD_PTR sendResult;
     int timeout = 3000;
     size_t len;
-    int unilen;
     const char *str;
     Tcl_Obj *objPtr;
+    WCHAR *wstr;
+    Tcl_DString ds;
 
     if (objc == 3) {
 	str = Tcl_GetString(objv[1]);
@@ -1408,9 +1409,11 @@ BroadcastValue(
 	}
     }
 
-    str = (char*)Tcl_GetUnicodeFromObj(objv[0], &unilen);
-    if (unilen == 0) {
-	str = NULL;
+    str = Tcl_GetString(objv[0]);
+    len = objv[0]->length;
+    wstr = (WCHAR *) Tcl_WinUtfToTChar(str, len, &ds);
+    if (Tcl_DStringLength(&ds) == 0) {
+	wstr = NULL;
     }
 
     /*
@@ -1418,7 +1421,8 @@ BroadcastValue(
      */
 
     result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
-	    (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+	    (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+    Tcl_DStringFree(&ds);
 
     objPtr = Tcl_NewObj();
     Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));