From b5af65e9d69a52d972ebbcb19fcd5bebd1bdc884 Mon Sep 17 00:00:00 2001 From: hobbs Date: Fri, 18 Oct 2002 23:58:18 +0000 Subject: * doc/registry.n: Added support for broadcasting changes to * tests/registry.test: the registry Environment. Noted proper code * win/tclWinReg.c: in the docs. [Patch #625453] --- doc/registry.n | 20 +++++++++++++- tests/registry.test | 32 ++++++++++++---------- win/tclWinReg.c | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 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 @@ -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 -- cgit v0.12