summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--win/tclWinInit.c113
1 files changed, 75 insertions, 38 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index a86108f..1efc416 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -19,7 +19,7 @@
/*
* The following macro can be defined at compile time to specify
- * an alternate registry key for the default Tcl library path.
+ * the root of the Tcl registry keys.
*/
#ifndef TCL_REGISTRY_KEY
@@ -105,7 +105,7 @@ void
TclPlatformInit(interp)
Tcl_Interp *interp;
{
- char *ptr;
+ char *p;
char buffer[13];
Tcl_DString ds;
OSVERSIONINFO osInfo;
@@ -113,7 +113,7 @@ TclPlatformInit(interp)
int isWin32s; /* True if we are running under Win32s. */
OemId *oemId;
HKEY key;
- DWORD size;
+ DWORD size, result, type;
tclPlatform = TCL_PLATFORM_WINDOWS;
@@ -143,39 +143,76 @@ TclPlatformInit(interp)
* Initialize the tcl_library variable from the registry.
*/
+ Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
if (!isWin32s) {
- if ((RegOpenKeyEx(HKEY_LOCAL_MACHINE, TCL_REGISTRY_KEY, 0,
- KEY_READ, &key) == ERROR_SUCCESS)
- && (RegQueryValueEx(key, "", NULL, NULL, NULL, &size)
- == ERROR_SUCCESS)) {
- Tcl_DStringSetLength(&ds, size);
- RegQueryValueEx(key, "", NULL, NULL,
- (LPBYTE)Tcl_DStringValue(&ds), &size);
- }
+ result = RegOpenKeyEx(HKEY_LOCAL_MACHINE, TCL_REGISTRY_KEY, 0,
+ KEY_READ, &key);
} else {
- if ((RegOpenKeyEx(HKEY_CLASSES_ROOT, TCL_REGISTRY_KEY, 0,
- KEY_READ, &key) == ERROR_SUCCESS)
- && (RegQueryValueEx(key, "", NULL, NULL, NULL, &size)
- == ERROR_SUCCESS)) {
+ result = RegOpenKeyEx(HKEY_CLASSES_ROOT, TCL_REGISTRY_KEY, 0,
+ KEY_READ, &key);
+ }
+ if (result == ERROR_SUCCESS) {
+ if (RegQueryValueEx(key, "", NULL, NULL, NULL, &size)
+ == ERROR_SUCCESS) {
+ char *argv[3];
Tcl_DStringSetLength(&ds, size);
RegQueryValueEx(key, "", NULL, NULL,
(LPBYTE) Tcl_DStringValue(&ds), &size);
+ Tcl_SetVar(interp, "tclDefaultLibrary", Tcl_DStringValue(&ds),
+ TCL_GLOBAL_ONLY);
+ argv[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
+ argv[1] = "lib/tcl" TCL_VERSION;
+ argv[2] = NULL;
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_SetVar(interp, "tclDefaultLibrary",
+ Tcl_JoinPath(2, argv, &ds), TCL_GLOBAL_ONLY);
+ }
+ if ((RegQueryValueEx(key, "PkgPath", NULL, &type, NULL, &size)
+ == ERROR_SUCCESS) && (type == REG_MULTI_SZ)) {
+ char **argv;
+ int argc;
+
+ /*
+ * PkgPath is stored as an array of null terminated strings
+ * terminated by two null characters. First count the number
+ * of strings, then allocate an argv array so we can construct
+ * a valid list.
+ */
+
+ Tcl_DStringSetLength(&ds, size);
+ RegQueryValueEx(key, "PkgPath", NULL, NULL,
+ (LPBYTE)Tcl_DStringValue(&ds), &size);
+ argc = 0;
+ for (p = Tcl_DStringValue(&ds); *p || *(p+1);
+ p += strlen(p) + 1) {
+ argc++;
+ }
+
+ argv = (char **) ckalloc((sizeof(char *) * argc) + 1);
+ argc = 0;
+ for (p = Tcl_DStringValue(&ds); *p || *(p+1); p++) {
+ argv[argc++] = p;
+ while (*p) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ p++;
+ }
+ }
+
+ p = Tcl_Merge(argc, argv);
+ Tcl_SetVar(interp, "tcl_pkgPath", p, TCL_GLOBAL_ONLY);
+ ckfree(p);
+ ckfree((char*) argv);
+ } else {
+ char *argv[3];
+ argv[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
+ argv[1] = "..";
+ argv[2] = NULL;
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_SetVar(interp, "tcl_pkgPath", Tcl_JoinPath(2, argv, &ds),
+ TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
}
- }
- Tcl_SetVar(interp, "tclDefaultLibrary", Tcl_DStringValue(&ds),
- TCL_GLOBAL_ONLY);
- if (Tcl_DStringLength(&ds) > 0) {
- char *argv[3];
- argv[0] = Tcl_GetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
- argv[1] = "lib";
- argv[2] = NULL;
- Tcl_DStringSetLength(&ds, 0);
- Tcl_SetVar(interp, "tcl_pkgPath", Tcl_JoinPath(2, argv, &ds),
- TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
- argv[1] = "lib/tcl" TCL_VERSION;
- Tcl_DStringSetLength(&ds, 0);
- Tcl_SetVar(interp, "tclDefaultLibrary", Tcl_JoinPath(2, argv, &ds),
- TCL_GLOBAL_ONLY);
}
/*
@@ -201,16 +238,16 @@ TclPlatformInit(interp)
* environment variables, if necessary.
*/
- ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
- if (ptr == NULL) {
+ p = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
+ if (p == NULL) {
Tcl_DStringSetLength(&ds, 0);
- ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
- if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, -1);
+ p = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
+ if (p != NULL) {
+ Tcl_DStringAppend(&ds, p, -1);
}
- ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
- if (ptr != NULL) {
- Tcl_DStringAppend(&ds, ptr, -1);
+ p = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
+ if (p != NULL) {
+ Tcl_DStringAppend(&ds, p, -1);
}
if (Tcl_DStringLength(&ds) > 0) {
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),