Attachment "reg-unload.patch" to
ticket [903831ffff]
added by
patthoyts
2004-02-25 18:36:58.
Index: library/reg/pkgIndex.tcl
===================================================================
RCS file: /cvsroot/tcl/tcl/library/reg/pkgIndex.tcl,v
retrieving revision 1.16
diff -u -r1.16 pkgIndex.tcl
--- library/reg/pkgIndex.tcl 10 Nov 2003 22:55:47 -0000 1.16
+++ library/reg/pkgIndex.tcl 25 Feb 2004 11:07:25 -0000
@@ -1,9 +1,9 @@
if {![package vsatisfies [package provide Tcl] 8]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[info exists ::tcl_platform(debug)]} {
- package ifneeded registry 1.1.3 \
+ package ifneeded registry 1.1.4 \
[list load [file join $dir tclreg11g.dll] registry]
} else {
- package ifneeded registry 1.1.3 \
+ package ifneeded registry 1.1.4 \
[list load [file join $dir tclreg11.dll] registry]
}
Index: win/tclWinReg.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinReg.c,v
retrieving revision 1.25
diff -u -r1.25 tclWinReg.c
--- win/tclWinReg.c 15 Jan 2004 22:20:38 -0000 1.25
+++ win/tclWinReg.c 25 Feb 2004 11:07:26 -0000
@@ -59,6 +59,8 @@
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
@@ -165,6 +167,7 @@
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);
@@ -194,6 +197,7 @@
Tcl_Obj *typeObj);
EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
@@ -215,6 +219,8 @@
Registry_Init(
Tcl_Interp *interp)
{
+ Tcl_Command cmd;
+
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
@@ -230,8 +236,79 @@
regWinProcs = &asciiProcs;
}
- Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd, NULL, NULL);
- return Tcl_PkgProvide(interp, "registry", "1.1.3");
+ cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
+ (ClientData)interp, DeleteCmd);
+ Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, (ClientData)cmd);
+ return Tcl_PkgProvide(interp, "registry", "1.1.4");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Registry_Unload --
+ *
+ * This procedure 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);
}
/*
@@ -258,7 +335,7 @@
Tcl_Obj * CONST objv[]) /* Argument values. */
{
int index;
- char *errString;
+ char *errString = NULL;
static CONST char *subcommands[] = {
"broadcast", "delete", "get", "keys", "set", "type", "values",
