summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/registry.n20
-rw-r--r--tests/registry.test32
-rw-r--r--win/tclWinReg.c79
3 files changed, 112 insertions, 19 deletions
diff --git a/doc/registry.n b/doc/registry.n
index 7f36a20..5264ad4 100644
--- a/doc/registry.n
+++ b/doc/registry.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: registry.n,v 1.6 2002/07/01 18:24:39 jenglish Exp $
+'\" RCS: @(#) $Id: registry.n,v 1.7 2002/10/18 23:58:18 hobbs Exp $
'\"
.so man.macros
.TH registry n 1.0 registry "Tcl Bundled Packages"
@@ -50,6 +50,24 @@ registry key names separated by backslash (\fB\e\fR) characters.
unique abbreviation for \fIoption\fR is acceptable. The valid options
are:
.TP
+.VS 8.4
+\fBregistry broadcast \fIkeyName\fR ?\fI-timeout milliseconds\fR?
+.
+Sends a broadcast message to the system and running programs to notify them
+of certain updates. This is necessary to propagate changes to key registry
+keys like Environment. The timeout specifies the amount of time, in
+milliseconds, to wait for applications to respond to the broadcast message.
+It defaults to 3000. The following example demonstrates how to add a path
+to the global Environment and notify applications of the change without
+reguiring a logoff/logon step (assumes admin privileges):
+.CS
+set regPath {HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment}
+set curPath [registry get $regPath "Path"]
+registry set $regPath "Path" "$curPath;$addPath"
+registry broadcast "Environment"
+.CE
+.VE 8.4
+.TP
\fBregistry delete \fIkeyName\fR ?\fIvalueName\fR?
.
If the optional \fIvalueName\fR argument is present, the specified
diff --git a/tests/registry.test b/tests/registry.test
index 4b22cc8..2ace4d5 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -10,7 +10,7 @@
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
-# RCS: @(#) $Id: registry.test,v 1.11 2001/07/31 19:12:07 vincentdarley Exp $
+# RCS: @(#) $Id: registry.test,v 1.12 2002/10/18 23:58:18 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -44,7 +44,7 @@ test registry-1.1 {argument parsing for registry command} {pcOnly} {
} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
test registry-1.2 {argument parsing for registry command} {pcOnly} {
list [catch {registry foo} msg] $msg
-} {1 {bad option "foo": must be delete, get, keys, set, type, or values}}
+} {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}}
test registry-1.3 {argument parsing for registry command} {pcOnly} {
list [catch {registry d} msg] $msg
@@ -582,21 +582,23 @@ test registry-11.3 {SetValue: failure} {pcOnly nonPortable english} {
list [catch {registry set {\\mom\HKEY_CLASSES_ROOT\TclFoobar} bar foobar} msg] $msg
} {1 {unable to open key: Access is denied.}}
+test registry-12.1 {BroadcastValue} {pcOnly} {
+ list [catch {registry broadcast} msg] $msg
+} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
+test registry-12.2 {BroadcastValue} {pcOnly} {
+ list [catch {registry broadcast "" -time} msg] $msg
+} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
+test registry-12.3 {BroadcastValue} {pcOnly} {
+ list [catch {registry broadcast "" - 500} msg] $msg
+} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
+test registry-12.4 {BroadcastValue} {pcOnly} {
+ list [catch {registry broadcast {Environment}} msg] $msg
+} {0 {1 0}}
+test registry-12.5 {BroadcastValue} {pcOnly} {
+ list [catch {registry b {}} msg] $msg
+} {0 {1 0}}
# cleanup
unset hostname
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 6505878..f806fc3 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.17 2002/01/29 03:18:46 hobbs Exp $
+ * RCS: @(#) $Id: tclWinReg.c,v 1.18 2002/10/18 23:58:18 hobbs Exp $
*/
#include <tclPort.h>
@@ -159,6 +159,8 @@ static RegWinProcs unicodeProcs = {
*/
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 int DeleteKey(Tcl_Interp *interp, Tcl_Obj *keyNameObj);
static int DeleteValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
@@ -256,9 +258,12 @@ RegistryObjCmd(
char *errString;
static CONST char *subcommands[] = {
- "delete", "get", "keys", "set", "type", "values", (char *) NULL
+ "broadcast", "delete", "get", "keys", "set", "type", "values",
+ (char *) NULL
+ };
+ enum SubCmdIdx {
+ BroadcastIdx, DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx
};
- enum SubCmdIdx { DeleteIdx, GetIdx, KeysIdx, SetIdx, TypeIdx, ValuesIdx };
if (objc < 2) {
Tcl_WrongNumArgs(interp, objc, objv, "option ?arg arg ...?");
@@ -271,6 +276,9 @@ RegistryObjCmd(
}
switch (index) {
+ case BroadcastIdx: /* broadcast */
+ return BroadcastValue(interp, objc, objv);
+ break;
case DeleteIdx: /* delete */
if (objc == 3) {
return DeleteKey(interp, objv[2]);
@@ -1299,6 +1307,71 @@ SetValue(
/*
*----------------------------------------------------------------------
*
+ * BroadcastValue --
+ *
+ * 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.
+ *
+ * Side effects:
+ * Will cause other programs to reload their system settings.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BroadcastValue(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj * CONST objv[]) /* Argument values. */
+{
+ DWORD result, sendResult;
+ UINT timeout = 3000;
+ int len;
+ char *str;
+ Tcl_Obj *objPtr;
+
+ if ((objc != 3) && (objc != 5)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
+ return TCL_ERROR;
+ }
+
+ if (objc > 3) {
+ str = Tcl_GetStringFromObj(objv[3], &len);
+ if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
+ Tcl_WrongNumArgs(interp, 2, objv, "keyName ?-timeout millisecs?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[4], (int *) &timeout) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ str = Tcl_GetStringFromObj(objv[2], &len);
+ if (len = 0) {
+ str = NULL;
+ }
+
+ /*
+ * Use the ignore the result.
+ */
+ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
+ (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
+
+ objPtr = Tcl_NewObj();
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(result));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(sendResult));
+ Tcl_SetObjResult(interp, objPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* AppendSystemError --
*
* This routine formats a Windows system error message and places
generated by cgit v0.12 at 2024-11-10 07:12:12 (GMT)