summaryrefslogtreecommitdiffstats
path: root/win/tclWinReg.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinReg.c')
-rw-r--r--win/tclWinReg.c100
1 files changed, 52 insertions, 48 deletions
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index 327e4a3..5f7fd31 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -49,15 +49,6 @@
#endif
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Registry_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
* The following macros convert between different endian ints.
*/
@@ -140,8 +131,8 @@ static int SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
Tcl_Obj *typeObj, REGSAM mode);
-EXTERN int Registry_Init(Tcl_Interp *interp);
-EXTERN int Registry_Unload(Tcl_Interp *interp, int flags);
+DLLEXPORT int Registry_Init(Tcl_Interp *interp);
+DLLEXPORT int Registry_Unload(Tcl_Interp *interp, int flags);
/*
*----------------------------------------------------------------------
@@ -172,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.0");
+ return Tcl_PkgProvide(interp, "registry", "1.3.2");
}
/*
@@ -415,7 +406,6 @@ DeleteKey(
const TCHAR *nativeTail;
HKEY rootKey, subkey;
DWORD result;
- int length;
Tcl_DString buf;
REGSAM saveMode = mode;
@@ -423,8 +413,8 @@ DeleteKey(
* Find the parent of the key being deleted and open it.
*/
- keyName = Tcl_GetStringFromObj(keyNameObj, &length);
- buffer = ckalloc(length + 1);
+ keyName = Tcl_GetString(keyNameObj);
+ buffer = ckalloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
@@ -509,7 +499,7 @@ DeleteValue(
{
HKEY key;
char *valueName;
- int length;
+ size_t length;
DWORD result;
Tcl_DString ds;
@@ -522,7 +512,8 @@ DeleteValue(
return TCL_ERROR;
}
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
Tcl_WinUtfToTChar(valueName, length, &ds);
result = RegDeleteValue(key, (const TCHAR *)Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
@@ -664,7 +655,7 @@ GetType(
Tcl_DString ds;
const char *valueName;
const TCHAR *nativeValue;
- int length;
+ size_t length;
/*
* Attempt to open the key for reading.
@@ -679,7 +670,8 @@ GetType(
* Get the type of the value.
*/
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, length, &ds);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
NULL, NULL);
@@ -736,7 +728,7 @@ GetValue(
const TCHAR *nativeValue;
DWORD result, length, type;
Tcl_DString data, buf;
- int nameLen;
+ size_t nameLen;
/*
* Attempt to open the key for reading.
@@ -761,7 +753,8 @@ GetValue(
Tcl_DStringSetLength(&data, TCL_DSTRING_STATIC_SIZE - 1);
length = TCL_DSTRING_STATIC_SIZE/sizeof(TCHAR) - 1;
- valueName = Tcl_GetStringFromObj(valueNameObj, &nameLen);
+ valueName = Tcl_GetString(valueNameObj);
+ nameLen = valueNameObj->length;
nativeValue = Tcl_WinUtfToTChar(valueName, nameLen, &buf);
result = RegQueryValueEx(key, nativeValue, NULL, &type,
@@ -810,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);
@@ -951,11 +944,12 @@ OpenKey(
HKEY *keyPtr) /* Returned HKEY. */
{
char *keyName, *buffer, *hostName;
- int length;
+ size_t length;
HKEY rootKey;
DWORD result;
- keyName = Tcl_GetStringFromObj(keyNameObj, &length);
+ keyName = Tcl_GetString(keyNameObj);
+ length = keyNameObj->length;
buffer = ckalloc(length + 1);
strcpy(buffer, keyName);
@@ -1255,7 +1249,8 @@ SetValue(
Tcl_Obj *typeObj, /* Type of data to be written. */
REGSAM mode) /* Mode flags to pass. */
{
- int type, length;
+ int type;
+ size_t length;
DWORD result;
HKEY key;
const char *valueName;
@@ -1275,7 +1270,8 @@ SetValue(
return TCL_ERROR;
}
- valueName = Tcl_GetStringFromObj(valueNameObj, &length);
+ valueName = Tcl_GetString(valueNameObj);
+ length = valueNameObj->length;
valueName = (char *) Tcl_WinUtfToTChar(valueName, length, &nameBuf);
if (type == REG_DWORD || type == REG_DWORD_BIG_ENDIAN) {
@@ -1309,8 +1305,9 @@ SetValue(
Tcl_DStringInit(&data);
for (i = 0; i < objc; i++) {
- const char *bytes = Tcl_GetStringFromObj(objv[i], &length);
+ const char *bytes = Tcl_GetString(objv[i]);
+ length = objv[i]->length;
Tcl_DStringAppend(&data, bytes, length);
/*
@@ -1329,12 +1326,13 @@ SetValue(
Tcl_DStringFree(&buf);
} else if (type == REG_SZ || type == REG_EXPAND_SZ) {
Tcl_DString buf;
- const char *data = Tcl_GetStringFromObj(dataObj, &length);
+ const char *data = Tcl_GetString(dataObj);
+ length = dataObj->length;
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);
@@ -1345,14 +1343,15 @@ SetValue(
Tcl_DStringFree(&buf);
} else {
BYTE *data;
+ int bytelength;
/*
* Store binary data in the registry.
*/
- data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &length);
+ data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
result = RegSetValueEx(key, (TCHAR *) valueName, 0,
- (DWORD) type, data, (DWORD) length);
+ (DWORD) type, data, (DWORD) bytelength);
}
Tcl_DStringFree(&nameBuf);
@@ -1392,37 +1391,42 @@ BroadcastValue(
{
LRESULT result;
DWORD_PTR sendResult;
- UINT timeout = 3000;
- int len;
+ int timeout = 3000;
+ size_t len;
const char *str;
Tcl_Obj *objPtr;
+ WCHAR *wstr;
+ Tcl_DString ds;
if (objc == 3) {
- str = Tcl_GetStringFromObj(objv[1], &len);
- if ((len < 2) || (*str != '-')
- || strncmp(str, "-timeout", (size_t) len)) {
+ str = Tcl_GetString(objv[1]);
+ len = objv[1]->length;
+ if ((len < 2) || (*str != '-') || strncmp(str, "-timeout", len)) {
return TCL_BREAK;
}
- if (Tcl_GetIntFromObj(interp, objv[2], (int *) &timeout) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &timeout) != TCL_OK) {
return TCL_ERROR;
}
}
- str = Tcl_GetStringFromObj(objv[0], &len);
- if (len == 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;
}
/*
* Use the ignore the result.
*/
- result = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE,
- (WPARAM) 0, (LPARAM) str, SMTO_ABORTIFHUNG, timeout, &sendResult);
+ result = SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE,
+ (WPARAM) 0, (LPARAM) wstr, SMTO_ABORTIFHUNG, (UINT) timeout, &sendResult);
+ Tcl_DStringFree(&ds);
objPtr = Tcl_NewObj();
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) result));
- Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewLongObj((long) sendResult));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) result));
+ Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewWideIntObj((Tcl_WideInt) sendResult));
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
generated by cgit v0.12 at 2024-11-24 00:20:16 (GMT)