summaryrefslogtreecommitdiffstats
path: root/win
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2004-03-04 15:10:41 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2004-03-04 15:10:41 (GMT)
commitc5e44485d15e28508cd8e8a7c7d6da2a6e777888 (patch)
treebd9f3d0e20a77186d2f0628ccca5456059cbc8e2 /win
parent91efcbd1bca5f810db5a35238d96dbf3c6738f30 (diff)
downloadtcl-c5e44485d15e28508cd8e8a7c7d6da2a6e777888.zip
tcl-c5e44485d15e28508cd8e8a7c7d6da2a6e777888.tar.gz
tcl-c5e44485d15e28508cd8e8a7c7d6da2a6e777888.tar.bz2
Added TIP #100 support to the registry package (patch #903831)
This provides a Windows test of the TIP #100 mechanism and a sample to show how unloading an extension can be done.
Diffstat (limited to 'win')
-rw-r--r--win/tclWinReg.c85
1 files changed, 81 insertions, 4 deletions
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 32aa940..29534c8 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinReg.c,v 1.25 2004/01/15 22:20:38 davygrvy Exp $
+ * RCS: @(#) $Id: tclWinReg.c,v 1.26 2004/03/04 15:10:42 patthoyts Exp $
*/
#include <tclPort.h>
@@ -59,6 +59,8 @@ static 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
@@ -165,6 +167,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);
@@ -194,6 +197,7 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *typeObj);
EXTERN int Registry_Init(Tcl_Interp *interp);
+EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
@@ -215,6 +219,8 @@ int
Registry_Init(
Tcl_Interp *interp)
{
+ Tcl_Command cmd;
+
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
@@ -230,8 +236,79 @@ Registry_Init(
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 @@ RegistryObjCmd(
Tcl_Obj * CONST objv[]) /* Argument values. */
{
int index;
- char *errString;
+ char *errString = NULL;
static CONST char *subcommands[] = {
"broadcast", "delete", "get", "keys", "set", "type", "values",