diff options
Diffstat (limited to 'win/tclWinInit.c')
| -rw-r--r-- | win/tclWinInit.c | 119 |
1 files changed, 91 insertions, 28 deletions
diff --git a/win/tclWinInit.c b/win/tclWinInit.c index fb53685..8b600f6 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -101,6 +101,10 @@ static TclInitProcessGlobalValueProc InitializeDefaultLibraryDir; static ProcessGlobalValue defaultLibraryDir = {0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL}; +static TclInitProcessGlobalValueProc InitializeSourceLibraryDir; +static ProcessGlobalValue sourceLibraryDir = + {0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL}; + static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib); static int ToUtf(const WCHAR *wSrc, char *dst); @@ -109,8 +113,8 @@ static int ToUtf(const WCHAR *wSrc, char *dst); * * TclpInitPlatform -- * - * Initialize all the platform-dependant things like signals and - * floating-point error handling. + * Initialize all the platform-dependant things like signals, + * floating-point error handling and sockets. * * Called at process initialization time. * @@ -126,20 +130,16 @@ static int ToUtf(const WCHAR *wSrc, char *dst); void TclpInitPlatform(void) { + WSADATA wsaData; + WORD wVersionRequested = MAKEWORD(2, 2); + tclPlatform = TCL_PLATFORM_WINDOWS; /* - * The following code stops Windows 3.X and Windows NT 3.51 from - * automatically putting up Sharing Violation dialogs, e.g, when someone - * tries to access a file that is locked or a drive with no disk in it. - * Tcl already returns the appropriate error to the caller, and they can - * decide to put up their own dialog in response to that failure. - * - * Under 95 and NT 4.0, this is a NOOP because the system doesn't - * automatically put up dialogs when the above operations fail. + * Initialize the winsock library. On Windows XP and higher this + * can never fail. */ - - SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS); + WSAStartup(wVersionRequested, &wsaData); #ifdef STATIC_BUILD /* @@ -175,7 +175,7 @@ TclpInitLibraryPath( int *lengthPtr, Tcl_Encoding *encodingPtr) { -#define LIBRARY_SIZE 32 +#define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; const char *bytes; @@ -206,6 +206,13 @@ TclpInitLibraryPath( Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&defaultLibraryDir)); + /* + * Look for the library in its source checkout location. + */ + + Tcl_ListObjAppendElement(NULL, pathPtr, + TclGetProcessGlobalValue(&sourceLibraryDir)); + *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = ckalloc((*lengthPtr) + 1); @@ -288,8 +295,6 @@ AppendEnvironment( */ if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) { - const char *str; - /* * TCL_LIBRARY is set but refers to a different tcl installation * than the current version. Try fiddling with the specified @@ -299,9 +304,8 @@ AppendEnvironment( pathv[pathc - 1] = shortlib; Tcl_DStringInit(&ds); - str = Tcl_JoinPath(pathc, pathv, &ds); - objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); - Tcl_DStringFree(&ds); + (void) Tcl_JoinPath(pathc, pathv, &ds); + objPtr = TclDStringToObj(&ds); } else { objPtr = Tcl_NewStringObj(buf, -1); } @@ -363,6 +367,57 @@ InitializeDefaultLibraryDir( /* *--------------------------------------------------------------------------- * + * InitializeSourceLibraryDir -- + * + * Locate the Tcl script library default location relative to the + * location of the Tcl DLL as it exists in the build output directory + * associated with the source checkout. + * + * Results: + * None. + * + * Side effects: + * None. + * + *--------------------------------------------------------------------------- + */ + +static void +InitializeSourceLibraryDir( + char **valuePtr, + int *lengthPtr, + Tcl_Encoding *encodingPtr) +{ + HMODULE hModule = TclWinGetTclInstance(); + WCHAR wName[MAX_PATH + LIBRARY_SIZE]; + char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; + char *end, *p; + + if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { + GetModuleFileNameA(hModule, name, MAX_PATH); + } else { + ToUtf(wName, name); + } + + end = strrchr(name, '\\'); + *end = '\0'; + p = strrchr(name, '\\'); + if (p != NULL) { + end = p; + } + *end = '\\'; + + TclWinNoBackslash(name); + sprintf(end + 1, "../library"); + *lengthPtr = strlen(name); + *valuePtr = ckalloc(*lengthPtr + 1); + *encodingPtr = NULL; + memcpy(*valuePtr, name, (size_t) *lengthPtr + 1); +} + +/* + *--------------------------------------------------------------------------- + * * ToUtf -- * * Convert a char string to a UTF string. @@ -427,13 +482,10 @@ TclpSetInitialEncodings(void) Tcl_DStringFree(&encodingName); } -void -TclpSetInterfaces(void) +void TclWinSetInterfaces( + int dummy) /* Not used. */ { - int useWide; - - useWide = (TclWinGetPlatformId() != VER_PLATFORM_WIN32_WINDOWS); - TclWinSetInterfaces(useWide); + TclpSetInterfaces(); } const char * @@ -474,7 +526,8 @@ TclpSetVariables( SYSTEM_INFO info; OemId oemId; } sys; - OSVERSIONINFOA osInfo; + static OSVERSIONINFOW osInfo; + static int osInfoInitialized = 0; Tcl_DString ds; TCHAR szUserName[UNLEN+1]; DWORD cchUserNameLen = UNLEN; @@ -482,9 +535,19 @@ TclpSetVariables( Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL, TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY); - osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); - GetVersionExA(&osInfo); - + if (!osInfoInitialized) { + HANDLE handle = LoadLibraryW(L"NTDLL"); + int(__stdcall *getversion)(void *) = + (int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion"); + osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + if (!getversion || getversion(&osInfo)) { + GetVersionExW(&osInfo); + } + if (handle) { + FreeLibrary(handle); + } + osInfoInitialized = 1; + } GetSystemInfo(&sys.info); /* |