|
/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclwininit.c,v 1.1.1.1 2001/06/13 04:49:17 dtashley Exp $ */ |
|
|
|
|
|
/* |
|
|
* tclWinInit.c -- |
|
|
* |
|
|
* Contains the Windows-specific interpreter initialization functions. |
|
|
* |
|
|
* Copyright (c) 1994-1997 Sun Microsystems, Inc. |
|
|
* Copyright (c) 1998-1999 by Scriptics Corporation. |
|
|
* All rights reserved. |
|
|
* |
|
|
* RCS: @(#) $Id: tclwininit.c,v 1.1.1.1 2001/06/13 04:49:17 dtashley Exp $ |
|
|
*/ |
|
|
|
|
|
#include "tclWinInt.h" |
|
|
#include <winreg.h> |
|
|
#include <winnt.h> |
|
|
#include <winbase.h> |
|
|
|
|
|
/* |
|
|
* The following macro can be defined at compile time to specify |
|
|
* the root of the Tcl registry keys. |
|
|
*/ |
|
|
|
|
|
#ifndef TCL_REGISTRY_KEY |
|
|
#define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION |
|
|
#endif |
|
|
|
|
|
/* |
|
|
* The following declaration is a workaround for some Microsoft brain damage. |
|
|
* The SYSTEM_INFO structure is different in various releases, even though the |
|
|
* layout is the same. So we overlay our own structure on top of it so we |
|
|
* can access the interesting slots in a uniform way. |
|
|
*/ |
|
|
|
|
|
typedef struct { |
|
|
WORD wProcessorArchitecture; |
|
|
WORD wReserved; |
|
|
} OemId; |
|
|
|
|
|
/* |
|
|
* The following macros are missing from some versions of winnt.h. |
|
|
*/ |
|
|
|
|
|
#ifndef PROCESSOR_ARCHITECTURE_INTEL |
|
|
#define PROCESSOR_ARCHITECTURE_INTEL 0 |
|
|
#endif |
|
|
#ifndef PROCESSOR_ARCHITECTURE_MIPS |
|
|
#define PROCESSOR_ARCHITECTURE_MIPS 1 |
|
|
#endif |
|
|
#ifndef PROCESSOR_ARCHITECTURE_ALPHA |
|
|
#define PROCESSOR_ARCHITECTURE_ALPHA 2 |
|
|
#endif |
|
|
#ifndef PROCESSOR_ARCHITECTURE_PPC |
|
|
#define PROCESSOR_ARCHITECTURE_PPC 3 |
|
|
#endif |
|
|
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN |
|
|
#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF |
|
|
#endif |
|
|
|
|
|
/* |
|
|
* The following arrays contain the human readable strings for the Windows |
|
|
* platform and processor values. |
|
|
*/ |
|
|
|
|
|
|
|
|
#define NUMPLATFORMS 3 |
|
|
static char* platforms[NUMPLATFORMS] = { |
|
|
"Win32s", "Windows 95", "Windows NT" |
|
|
}; |
|
|
|
|
|
#define NUMPROCESSORS 4 |
|
|
static char* processors[NUMPROCESSORS] = { |
|
|
"intel", "mips", "alpha", "ppc" |
|
|
}; |
|
|
|
|
|
/* |
|
|
* Thread id used for asynchronous notification from signal handlers. |
|
|
*/ |
|
|
|
|
|
static DWORD mainThreadId; |
|
|
|
|
|
/* |
|
|
* The Init script (common to Windows and Unix platforms) is |
|
|
* defined in tkInitScript.h |
|
|
*/ |
|
|
|
|
|
#include "tclInitScript.h" |
|
|
|
|
|
static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); |
|
|
static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule, |
|
|
CONST char *lib); |
|
|
static void AppendRegistry(Tcl_Obj *listPtr, CONST char *lib); |
|
|
static int ToUtf(CONST WCHAR *wSrc, char *dst); |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpInitPlatform -- |
|
|
* |
|
|
* Initialize all the platform-dependant things like signals and |
|
|
* floating-point error handling. |
|
|
* |
|
|
* Called at process initialization time. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclpInitPlatform() |
|
|
{ |
|
|
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. |
|
|
*/ |
|
|
|
|
|
SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS); |
|
|
|
|
|
/* |
|
|
* Save the id of the first thread to intialize the Tcl library. This |
|
|
* thread will be used to handle notifications from async event |
|
|
* procedures. This is not strictly correct. A better solution involves |
|
|
* using a designated "main" notifier that is kept up to date as threads |
|
|
* come and go. |
|
|
*/ |
|
|
|
|
|
mainThreadId = GetCurrentThreadId(); |
|
|
|
|
|
#ifdef STATIC_BUILD |
|
|
/* |
|
|
* If we are in a statically linked executable, then we need to |
|
|
* explicitly initialize the Windows function tables here since |
|
|
* DllMain() will not be invoked. |
|
|
*/ |
|
|
|
|
|
TclWinInit(GetModuleHandle(NULL)); |
|
|
#endif |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpInitLibraryPath -- |
|
|
* |
|
|
* Initialize the library path at startup. |
|
|
* |
|
|
* This call sets the library path to strings in UTF-8. Any |
|
|
* pre-existing library path information is assumed to have been |
|
|
* in the native multibyte encoding. |
|
|
* |
|
|
* Called at process initialization time. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclpInitLibraryPath(path) |
|
|
CONST char *path; /* Potentially dirty UTF string that is */ |
|
|
/* the path to the executable name. */ |
|
|
{ |
|
|
#define LIBRARY_SIZE 32 |
|
|
Tcl_Obj *pathPtr, *objPtr; |
|
|
char *str; |
|
|
Tcl_DString ds; |
|
|
int pathc; |
|
|
char **pathv; |
|
|
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE]; |
|
|
|
|
|
Tcl_DStringInit(&ds); |
|
|
pathPtr = Tcl_NewObj(); |
|
|
|
|
|
/* |
|
|
* Initialize the substrings used when locating an executable. The |
|
|
* installLib variable computes the path as though the executable |
|
|
* is installed. The developLib computes the path as though the |
|
|
* executable is run from a develpment directory. |
|
|
*/ |
|
|
|
|
|
sprintf(installLib, "lib/tcl%s", TCL_VERSION); |
|
|
sprintf(developLib, "../tcl%s/library", |
|
|
((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION)); |
|
|
|
|
|
/* |
|
|
* Look for the library relative to default encoding dir. |
|
|
*/ |
|
|
|
|
|
str = Tcl_GetDefaultEncodingDir(); |
|
|
if ((str != NULL) && (str[0] != '\0')) { |
|
|
objPtr = Tcl_NewStringObj(str, -1); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
} |
|
|
|
|
|
/* |
|
|
* Look for the library relative to the TCL_LIBRARY env variable. |
|
|
* If the last dirname in the TCL_LIBRARY path does not match the |
|
|
* last dirname in the installLib variable, use the last dir name |
|
|
* of installLib in addition to the orginal TCL_LIBRARY path. |
|
|
*/ |
|
|
|
|
|
AppendEnvironment(pathPtr, installLib); |
|
|
|
|
|
/* |
|
|
* Look for the library relative to the DLL. Only use the installLib |
|
|
* because in practice, the DLL is always installed. |
|
|
*/ |
|
|
|
|
|
AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib); |
|
|
|
|
|
|
|
|
/* |
|
|
* Look for the library relative to the executable. This algorithm |
|
|
* should be the same as the one in the tcl_findLibrary procedure. |
|
|
* |
|
|
* This code looks in the following directories: |
|
|
* |
|
|
* <bindir>/../<installLib> |
|
|
* (e.g. /usr/local/bin/../lib/tcl8.2) |
|
|
* <bindir>/../../<installLib> |
|
|
* (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2) |
|
|
* <bindir>/../library |
|
|
* (e.g. /usr/src/tcl8.2/unix/../library) |
|
|
* <bindir>/../../library |
|
|
* (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library) |
|
|
* <bindir>/../../<developLib> |
|
|
* (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library) |
|
|
* <bindir>/../../../<devlopLib> |
|
|
* (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library) |
|
|
*/ |
|
|
|
|
|
if (path != NULL) { |
|
|
Tcl_SplitPath(path, &pathc, &pathv); |
|
|
if (pathc > 1) { |
|
|
pathv[pathc - 2] = installLib; |
|
|
path = Tcl_JoinPath(pathc - 1, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
if (pathc > 2) { |
|
|
pathv[pathc - 3] = installLib; |
|
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
if (pathc > 1) { |
|
|
pathv[pathc - 2] = "library"; |
|
|
path = Tcl_JoinPath(pathc - 1, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
if (pathc > 2) { |
|
|
pathv[pathc - 3] = "library"; |
|
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
if (pathc > 1) { |
|
|
pathv[pathc - 3] = developLib; |
|
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
if (pathc > 3) { |
|
|
pathv[pathc - 4] = developLib; |
|
|
path = Tcl_JoinPath(pathc - 3, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
ckfree((char *) pathv); |
|
|
} |
|
|
|
|
|
TclSetLibraryPath(pathPtr); |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* AppendEnvironment -- |
|
|
* |
|
|
* Append the value of the TCL_LIBRARY environment variable onto the |
|
|
* path pointer. If the env variable points to another version of |
|
|
* tcl (e.g. "tcl7.6") also append the path to this version (e.g., |
|
|
* "tcl7.6/../tcl8.2") |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static void |
|
|
AppendEnvironment( |
|
|
Tcl_Obj *pathPtr, |
|
|
CONST char *lib) |
|
|
{ |
|
|
int pathc; |
|
|
WCHAR wBuf[MAX_PATH]; |
|
|
char buf[MAX_PATH * TCL_UTF_MAX]; |
|
|
Tcl_Obj *objPtr; |
|
|
char *str; |
|
|
Tcl_DString ds; |
|
|
char **pathv; |
|
|
|
|
|
/* |
|
|
* The "L" preceeding the TCL_LIBRARY string is used to tell VC++ |
|
|
* that this is a unicode string. |
|
|
*/ |
|
|
|
|
|
if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) { |
|
|
buf[0] = '\0'; |
|
|
GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH); |
|
|
} else { |
|
|
ToUtf(wBuf, buf); |
|
|
} |
|
|
|
|
|
if (buf[0] != '\0') { |
|
|
objPtr = Tcl_NewStringObj(buf, -1); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
|
|
|
TclWinNoBackslash(buf); |
|
|
Tcl_SplitPath(buf, &pathc, &pathv); |
|
|
|
|
|
/* |
|
|
* The lstrcmpi() will work even if pathv[pathc - 1] is random |
|
|
* UTF-8 chars because I know lib is ascii. |
|
|
*/ |
|
|
|
|
|
if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) { |
|
|
/* |
|
|
* TCL_LIBRARY is set but refers to a different tcl |
|
|
* installation than the current version. Try fiddling with the |
|
|
* specified directory to make it refer to this installation by |
|
|
* removing the old "tclX.Y" and substituting the current |
|
|
* version string. |
|
|
*/ |
|
|
|
|
|
pathv[pathc - 1] = (char *) (lib + 4); |
|
|
Tcl_DStringInit(&ds); |
|
|
str = Tcl_JoinPath(pathc, pathv, &ds); |
|
|
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); |
|
|
Tcl_DStringFree(&ds); |
|
|
} else { |
|
|
objPtr = Tcl_NewStringObj(buf, -1); |
|
|
} |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
|
|
ckfree((char *) pathv); |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* AppendDllPath -- |
|
|
* |
|
|
* Append a path onto the path pointer that tries to locate the Tcl |
|
|
* library relative to the location of the Tcl DLL. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static void |
|
|
AppendDllPath( |
|
|
Tcl_Obj *pathPtr, |
|
|
HMODULE hModule, |
|
|
CONST char *lib) |
|
|
{ |
|
|
WCHAR wName[MAX_PATH + LIBRARY_SIZE]; |
|
|
char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; |
|
|
|
|
|
if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { |
|
|
GetModuleFileNameA(hModule, name, MAX_PATH); |
|
|
} else { |
|
|
ToUtf(wName, name); |
|
|
} |
|
|
if (lib != NULL) { |
|
|
char *end, *p; |
|
|
|
|
|
end = strrchr(name, '\\'); |
|
|
*end = '\0'; |
|
|
p = strrchr(name, '\\'); |
|
|
if (p != NULL) { |
|
|
end = p; |
|
|
} |
|
|
*end = '\\'; |
|
|
strcpy(end + 1, lib); |
|
|
} |
|
|
TclWinNoBackslash(name); |
|
|
Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1)); |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* ToUtf -- |
|
|
* |
|
|
* Convert a char string to a UTF string. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
static int |
|
|
ToUtf( |
|
|
CONST WCHAR *wSrc, |
|
|
char *dst) |
|
|
{ |
|
|
char *start; |
|
|
|
|
|
start = dst; |
|
|
while (*wSrc != '\0') { |
|
|
dst += Tcl_UniCharToUtf(*wSrc, dst); |
|
|
wSrc++; |
|
|
} |
|
|
*dst = '\0'; |
|
|
return dst - start; |
|
|
} |
|
|
|
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpSetInitialEncodings -- |
|
|
* |
|
|
* Based on the locale, determine the encoding of the operating |
|
|
* system and the default encoding for newly opened files. |
|
|
* |
|
|
* Called at process initialization time. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* The Tcl library path is converted from native encoding to UTF-8. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclpSetInitialEncodings() |
|
|
{ |
|
|
CONST char *encoding; |
|
|
char buf[4 + TCL_INTEGER_SPACE]; |
|
|
int platformId; |
|
|
Tcl_Obj *pathPtr; |
|
|
|
|
|
platformId = TclWinGetPlatformId(); |
|
|
|
|
|
TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT); |
|
|
|
|
|
wsprintfA(buf, "cp%d", GetACP()); |
|
|
Tcl_SetSystemEncoding(NULL, buf); |
|
|
|
|
|
if (platformId != VER_PLATFORM_WIN32_NT) { |
|
|
pathPtr = TclGetLibraryPath(); |
|
|
if (pathPtr != NULL) { |
|
|
int i, objc; |
|
|
Tcl_Obj **objv; |
|
|
|
|
|
objc = 0; |
|
|
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); |
|
|
for (i = 0; i < objc; i++) { |
|
|
int length; |
|
|
char *string; |
|
|
Tcl_DString ds; |
|
|
|
|
|
string = Tcl_GetStringFromObj(objv[i], &length); |
|
|
Tcl_ExternalToUtfDString(NULL, string, length, &ds); |
|
|
Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), |
|
|
Tcl_DStringLength(&ds)); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Keep this encoding preloaded. The IO package uses it for gets on a |
|
|
* binary channel. |
|
|
*/ |
|
|
|
|
|
encoding = "iso8859-1"; |
|
|
Tcl_GetEncoding(NULL, encoding); |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpSetVariables -- |
|
|
* |
|
|
* Performs platform-specific interpreter initialization related to |
|
|
* the tcl_platform and env variables, and other platform-specific |
|
|
* things. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl |
|
|
* variables. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclpSetVariables(interp) |
|
|
Tcl_Interp *interp; /* Interp to initialize. */ |
|
|
{ |
|
|
char *ptr; |
|
|
char buffer[TCL_INTEGER_SPACE * 2]; |
|
|
SYSTEM_INFO sysInfo; |
|
|
OemId *oemId; |
|
|
OSVERSIONINFOA osInfo; |
|
|
Tcl_DString ds; |
|
|
|
|
|
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); |
|
|
GetVersionExA(&osInfo); |
|
|
|
|
|
oemId = (OemId *) &sysInfo; |
|
|
GetSystemInfo(&sysInfo); |
|
|
|
|
|
/* |
|
|
* Initialize the tclDefaultLibrary variable from the registry. |
|
|
*/ |
|
|
|
|
|
Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY); |
|
|
|
|
|
/* |
|
|
* Define the tcl_platform array. |
|
|
*/ |
|
|
|
|
|
Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", |
|
|
TCL_GLOBAL_ONLY); |
|
|
if (osInfo.dwPlatformId < NUMPLATFORMS) { |
|
|
Tcl_SetVar2(interp, "tcl_platform", "os", |
|
|
platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); |
|
|
} |
|
|
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); |
|
|
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); |
|
|
if (oemId->wProcessorArchitecture < NUMPROCESSORS) { |
|
|
Tcl_SetVar2(interp, "tcl_platform", "machine", |
|
|
processors[oemId->wProcessorArchitecture], |
|
|
TCL_GLOBAL_ONLY); |
|
|
} |
|
|
|
|
|
#ifdef _DEBUG |
|
|
/* |
|
|
* The existence of the "debug" element of the tcl_platform array indicates |
|
|
* that this particular Tcl shell has been compiled with debug information. |
|
|
* Using "info exists tcl_platform(debug)" a Tcl script can direct the |
|
|
* interpreter to load debug versions of DLLs with the load command. |
|
|
*/ |
|
|
|
|
|
Tcl_SetVar2(interp, "tcl_platform", "debug", "1", |
|
|
TCL_GLOBAL_ONLY); |
|
|
#endif |
|
|
|
|
|
/* |
|
|
* Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH |
|
|
* environment variables, if necessary. |
|
|
*/ |
|
|
|
|
|
Tcl_DStringInit(&ds); |
|
|
ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY); |
|
|
if (ptr == NULL) { |
|
|
ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); |
|
|
if (ptr != NULL) { |
|
|
Tcl_DStringAppend(&ds, ptr, -1); |
|
|
} |
|
|
ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); |
|
|
if (ptr != NULL) { |
|
|
Tcl_DStringAppend(&ds, ptr, -1); |
|
|
} |
|
|
if (Tcl_DStringLength(&ds) > 0) { |
|
|
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), |
|
|
TCL_GLOBAL_ONLY); |
|
|
} else { |
|
|
Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
* Initialize the user name from the environment first, since this is much |
|
|
* faster than asking the system. |
|
|
*/ |
|
|
|
|
|
Tcl_DStringSetLength(&ds, 100); |
|
|
if (TclGetEnv("USERNAME", &ds) == NULL) { |
|
|
if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) { |
|
|
Tcl_DStringSetLength(&ds, 0); |
|
|
} |
|
|
} |
|
|
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), |
|
|
TCL_GLOBAL_ONLY); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpFindVariable -- |
|
|
* |
|
|
* Locate the entry in environ for a given name. On Unix this |
|
|
* routine is case sensetive, on Windows this matches mioxed case. |
|
|
* |
|
|
* Results: |
|
|
* The return value is the index in environ of an entry with the |
|
|
* name "name", or -1 if there is no such entry. The integer at |
|
|
* *lengthPtr is filled in with the length of name (if a matching |
|
|
* entry is found) or the length of the environ array (if no matching |
|
|
* entry is found). |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclpFindVariable(name, lengthPtr) |
|
|
CONST char *name; /* Name of desired environment variable |
|
|
* (UTF-8). */ |
|
|
int *lengthPtr; /* Used to return length of name (for |
|
|
* successful searches) or number of non-NULL |
|
|
* entries in environ (for unsuccessful |
|
|
* searches). */ |
|
|
{ |
|
|
int i, length, result = -1; |
|
|
register CONST char *env, *p1, *p2; |
|
|
char *envUpper, *nameUpper; |
|
|
Tcl_DString envString; |
|
|
|
|
|
/* |
|
|
* Convert the name to all upper case for the case insensitive |
|
|
* comparison. |
|
|
*/ |
|
|
|
|
|
length = strlen(name); |
|
|
nameUpper = (char *) ckalloc((unsigned) length+1); |
|
|
memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1); |
|
|
Tcl_UtfToUpper(nameUpper); |
|
|
|
|
|
Tcl_DStringInit(&envString); |
|
|
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { |
|
|
/* |
|
|
* Chop the env string off after the equal sign, then Convert |
|
|
* the name to all upper case, so we do not have to convert |
|
|
* all the characters after the equal sign. |
|
|
*/ |
|
|
|
|
|
envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); |
|
|
p1 = strchr(envUpper, '='); |
|
|
if (p1 == NULL) { |
|
|
continue; |
|
|
} |
|
|
length = p1 - envUpper; |
|
|
Tcl_DStringSetLength(&envString, length+1); |
|
|
Tcl_UtfToUpper(envUpper); |
|
|
|
|
|
p1 = envUpper; |
|
|
p2 = nameUpper; |
|
|
for (; *p2 == *p1; p1++, p2++) { |
|
|
/* NULL loop body. */ |
|
|
} |
|
|
if ((*p1 == '=') && (*p2 == '\0')) { |
|
|
*lengthPtr = length; |
|
|
result = i; |
|
|
goto done; |
|
|
} |
|
|
|
|
|
Tcl_DStringFree(&envString); |
|
|
} |
|
|
|
|
|
*lengthPtr = i; |
|
|
|
|
|
done: |
|
|
Tcl_DStringFree(&envString); |
|
|
ckfree(nameUpper); |
|
|
return result; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_Init -- |
|
|
* |
|
|
* This procedure is typically invoked by Tcl_AppInit procedures |
|
|
* to perform additional initialization for a Tcl interpreter, |
|
|
* such as sourcing the "init.tcl" script. |
|
|
* |
|
|
* Results: |
|
|
* Returns a standard Tcl completion code and sets the interp's |
|
|
* result if there is an error. |
|
|
* |
|
|
* Side effects: |
|
|
* Depends on what's in the init.tcl script. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
Tcl_Init(interp) |
|
|
Tcl_Interp *interp; /* Interpreter to initialize. */ |
|
|
{ |
|
|
Tcl_Obj *pathPtr; |
|
|
|
|
|
if (tclPreInitScript != NULL) { |
|
|
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { |
|
|
return (TCL_ERROR); |
|
|
}; |
|
|
} |
|
|
|
|
|
pathPtr = TclGetLibraryPath(); |
|
|
if (pathPtr == NULL) { |
|
|
pathPtr = Tcl_NewObj(); |
|
|
} |
|
|
Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); |
|
|
return Tcl_Eval(interp, initScript); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* Tcl_SourceRCFile -- |
|
|
* |
|
|
* This procedure is typically invoked by Tcl_Main of Tk_Main |
|
|
* procedure to source an application specific rc file into the |
|
|
* interpreter at startup time. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* Depends on what's in the rc script. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
Tcl_SourceRCFile(interp) |
|
|
Tcl_Interp *interp; /* Interpreter to source rc file into. */ |
|
|
{ |
|
|
Tcl_DString temp; |
|
|
char *fileName; |
|
|
Tcl_Channel errChannel; |
|
|
|
|
|
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); |
|
|
|
|
|
if (fileName != NULL) { |
|
|
Tcl_Channel c; |
|
|
char *fullName; |
|
|
|
|
|
Tcl_DStringInit(&temp); |
|
|
fullName = Tcl_TranslateFileName(interp, fileName, &temp); |
|
|
if (fullName == NULL) { |
|
|
/* |
|
|
* Couldn't translate the file name (e.g. it referred to a |
|
|
* bogus user or there was no HOME environment variable). |
|
|
* Just do nothing. |
|
|
*/ |
|
|
} else { |
|
|
|
|
|
/* |
|
|
* Test for the existence of the rc file before trying to read it. |
|
|
*/ |
|
|
|
|
|
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); |
|
|
if (c != (Tcl_Channel) NULL) { |
|
|
Tcl_Close(NULL, c); |
|
|
if (Tcl_EvalFile(interp, fullName) != TCL_OK) { |
|
|
errChannel = Tcl_GetStdChannel(TCL_STDERR); |
|
|
if (errChannel) { |
|
|
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
|
|
Tcl_WriteChars(errChannel, "\n", 1); |
|
|
} |
|
|
} |
|
|
} |
|
|
} |
|
|
Tcl_DStringFree(&temp); |
|
|
} |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpAsyncMark -- |
|
|
* |
|
|
* Wake up the main thread from a signal handler. |
|
|
* |
|
|
* Results: |
|
|
* None. |
|
|
* |
|
|
* Side effects: |
|
|
* Sends a message to the main thread. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
void |
|
|
TclpAsyncMark(async) |
|
|
Tcl_AsyncHandler async; /* Token for handler. */ |
|
|
{ |
|
|
/* |
|
|
* Need a way to kick the Windows event loop and tell it to go look at |
|
|
* asynchronous events. |
|
|
*/ |
|
|
|
|
|
PostThreadMessage(mainThreadId, WM_USER, 0, 0); |
|
|
} |
|
|
|
|
|
/* $History: tclwininit.c $ |
|
|
* |
|
|
* ***************** Version 1 ***************** |
|
|
* User: Dtashley Date: 1/02/01 Time: 12:39a |
|
|
* Created in $/IjuScripter, IjuConsole/Source/Tcl Base |
|
|
* Initial check-in. |
|
|
*/ |
|
|
|
|
|
/* End of TCLWININIT.C */ |
|
1 |
|
/* $Header$ */ |
2 |
|
/* |
3 |
|
* tclWinInit.c -- |
4 |
|
* |
5 |
|
* Contains the Windows-specific interpreter initialization functions. |
6 |
|
* |
7 |
|
* Copyright (c) 1994-1997 Sun Microsystems, Inc. |
8 |
|
* Copyright (c) 1998-1999 by Scriptics Corporation. |
9 |
|
* All rights reserved. |
10 |
|
* |
11 |
|
* RCS: @(#) $Id: tclwininit.c,v 1.1.1.1 2001/06/13 04:49:17 dtashley Exp $ |
12 |
|
*/ |
13 |
|
|
14 |
|
#include "tclWinInt.h" |
15 |
|
#include <winreg.h> |
16 |
|
#include <winnt.h> |
17 |
|
#include <winbase.h> |
18 |
|
|
19 |
|
/* |
20 |
|
* The following macro can be defined at compile time to specify |
21 |
|
* the root of the Tcl registry keys. |
22 |
|
*/ |
23 |
|
|
24 |
|
#ifndef TCL_REGISTRY_KEY |
25 |
|
#define TCL_REGISTRY_KEY "Software\\Scriptics\\Tcl\\" TCL_VERSION |
26 |
|
#endif |
27 |
|
|
28 |
|
/* |
29 |
|
* The following declaration is a workaround for some Microsoft brain damage. |
30 |
|
* The SYSTEM_INFO structure is different in various releases, even though the |
31 |
|
* layout is the same. So we overlay our own structure on top of it so we |
32 |
|
* can access the interesting slots in a uniform way. |
33 |
|
*/ |
34 |
|
|
35 |
|
typedef struct { |
36 |
|
WORD wProcessorArchitecture; |
37 |
|
WORD wReserved; |
38 |
|
} OemId; |
39 |
|
|
40 |
|
/* |
41 |
|
* The following macros are missing from some versions of winnt.h. |
42 |
|
*/ |
43 |
|
|
44 |
|
#ifndef PROCESSOR_ARCHITECTURE_INTEL |
45 |
|
#define PROCESSOR_ARCHITECTURE_INTEL 0 |
46 |
|
#endif |
47 |
|
#ifndef PROCESSOR_ARCHITECTURE_MIPS |
48 |
|
#define PROCESSOR_ARCHITECTURE_MIPS 1 |
49 |
|
#endif |
50 |
|
#ifndef PROCESSOR_ARCHITECTURE_ALPHA |
51 |
|
#define PROCESSOR_ARCHITECTURE_ALPHA 2 |
52 |
|
#endif |
53 |
|
#ifndef PROCESSOR_ARCHITECTURE_PPC |
54 |
|
#define PROCESSOR_ARCHITECTURE_PPC 3 |
55 |
|
#endif |
56 |
|
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN |
57 |
|
#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF |
58 |
|
#endif |
59 |
|
|
60 |
|
/* |
61 |
|
* The following arrays contain the human readable strings for the Windows |
62 |
|
* platform and processor values. |
63 |
|
*/ |
64 |
|
|
65 |
|
|
66 |
|
#define NUMPLATFORMS 3 |
67 |
|
static char* platforms[NUMPLATFORMS] = { |
68 |
|
"Win32s", "Windows 95", "Windows NT" |
69 |
|
}; |
70 |
|
|
71 |
|
#define NUMPROCESSORS 4 |
72 |
|
static char* processors[NUMPROCESSORS] = { |
73 |
|
"intel", "mips", "alpha", "ppc" |
74 |
|
}; |
75 |
|
|
76 |
|
/* |
77 |
|
* Thread id used for asynchronous notification from signal handlers. |
78 |
|
*/ |
79 |
|
|
80 |
|
static DWORD mainThreadId; |
81 |
|
|
82 |
|
/* |
83 |
|
* The Init script (common to Windows and Unix platforms) is |
84 |
|
* defined in tkInitScript.h |
85 |
|
*/ |
86 |
|
|
87 |
|
#include "tclInitScript.h" |
88 |
|
|
89 |
|
static void AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib); |
90 |
|
static void AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule, |
91 |
|
CONST char *lib); |
92 |
|
static void AppendRegistry(Tcl_Obj *listPtr, CONST char *lib); |
93 |
|
static int ToUtf(CONST WCHAR *wSrc, char *dst); |
94 |
|
|
95 |
|
/* |
96 |
|
*--------------------------------------------------------------------------- |
97 |
|
* |
98 |
|
* TclpInitPlatform -- |
99 |
|
* |
100 |
|
* Initialize all the platform-dependant things like signals and |
101 |
|
* floating-point error handling. |
102 |
|
* |
103 |
|
* Called at process initialization time. |
104 |
|
* |
105 |
|
* Results: |
106 |
|
* None. |
107 |
|
* |
108 |
|
* Side effects: |
109 |
|
* None. |
110 |
|
* |
111 |
|
*--------------------------------------------------------------------------- |
112 |
|
*/ |
113 |
|
|
114 |
|
void |
115 |
|
TclpInitPlatform() |
116 |
|
{ |
117 |
|
tclPlatform = TCL_PLATFORM_WINDOWS; |
118 |
|
|
119 |
|
/* |
120 |
|
* The following code stops Windows 3.X and Windows NT 3.51 from |
121 |
|
* automatically putting up Sharing Violation dialogs, e.g, when |
122 |
|
* someone tries to access a file that is locked or a drive with no |
123 |
|
* disk in it. Tcl already returns the appropriate error to the |
124 |
|
* caller, and they can decide to put up their own dialog in response |
125 |
|
* to that failure. |
126 |
|
* |
127 |
|
* Under 95 and NT 4.0, this is a NOOP because the system doesn't |
128 |
|
* automatically put up dialogs when the above operations fail. |
129 |
|
*/ |
130 |
|
|
131 |
|
SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS); |
132 |
|
|
133 |
|
/* |
134 |
|
* Save the id of the first thread to intialize the Tcl library. This |
135 |
|
* thread will be used to handle notifications from async event |
136 |
|
* procedures. This is not strictly correct. A better solution involves |
137 |
|
* using a designated "main" notifier that is kept up to date as threads |
138 |
|
* come and go. |
139 |
|
*/ |
140 |
|
|
141 |
|
mainThreadId = GetCurrentThreadId(); |
142 |
|
|
143 |
|
#ifdef STATIC_BUILD |
144 |
|
/* |
145 |
|
* If we are in a statically linked executable, then we need to |
146 |
|
* explicitly initialize the Windows function tables here since |
147 |
|
* DllMain() will not be invoked. |
148 |
|
*/ |
149 |
|
|
150 |
|
TclWinInit(GetModuleHandle(NULL)); |
151 |
|
#endif |
152 |
|
} |
153 |
|
|
154 |
|
/* |
155 |
|
*--------------------------------------------------------------------------- |
156 |
|
* |
157 |
|
* TclpInitLibraryPath -- |
158 |
|
* |
159 |
|
* Initialize the library path at startup. |
160 |
|
* |
161 |
|
* This call sets the library path to strings in UTF-8. Any |
162 |
|
* pre-existing library path information is assumed to have been |
163 |
|
* in the native multibyte encoding. |
164 |
|
* |
165 |
|
* Called at process initialization time. |
166 |
|
* |
167 |
|
* Results: |
168 |
|
* None. |
169 |
|
* |
170 |
|
* Side effects: |
171 |
|
* None. |
172 |
|
* |
173 |
|
*--------------------------------------------------------------------------- |
174 |
|
*/ |
175 |
|
|
176 |
|
void |
177 |
|
TclpInitLibraryPath(path) |
178 |
|
CONST char *path; /* Potentially dirty UTF string that is */ |
179 |
|
/* the path to the executable name. */ |
180 |
|
{ |
181 |
|
#define LIBRARY_SIZE 32 |
182 |
|
Tcl_Obj *pathPtr, *objPtr; |
183 |
|
char *str; |
184 |
|
Tcl_DString ds; |
185 |
|
int pathc; |
186 |
|
char **pathv; |
187 |
|
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE]; |
188 |
|
|
189 |
|
Tcl_DStringInit(&ds); |
190 |
|
pathPtr = Tcl_NewObj(); |
191 |
|
|
192 |
|
/* |
193 |
|
* Initialize the substrings used when locating an executable. The |
194 |
|
* installLib variable computes the path as though the executable |
195 |
|
* is installed. The developLib computes the path as though the |
196 |
|
* executable is run from a develpment directory. |
197 |
|
*/ |
198 |
|
|
199 |
|
sprintf(installLib, "lib/tcl%s", TCL_VERSION); |
200 |
|
sprintf(developLib, "../tcl%s/library", |
201 |
|
((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION)); |
202 |
|
|
203 |
|
/* |
204 |
|
* Look for the library relative to default encoding dir. |
205 |
|
*/ |
206 |
|
|
207 |
|
str = Tcl_GetDefaultEncodingDir(); |
208 |
|
if ((str != NULL) && (str[0] != '\0')) { |
209 |
|
objPtr = Tcl_NewStringObj(str, -1); |
210 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
211 |
|
} |
212 |
|
|
213 |
|
/* |
214 |
|
* Look for the library relative to the TCL_LIBRARY env variable. |
215 |
|
* If the last dirname in the TCL_LIBRARY path does not match the |
216 |
|
* last dirname in the installLib variable, use the last dir name |
217 |
|
* of installLib in addition to the orginal TCL_LIBRARY path. |
218 |
|
*/ |
219 |
|
|
220 |
|
AppendEnvironment(pathPtr, installLib); |
221 |
|
|
222 |
|
/* |
223 |
|
* Look for the library relative to the DLL. Only use the installLib |
224 |
|
* because in practice, the DLL is always installed. |
225 |
|
*/ |
226 |
|
|
227 |
|
AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib); |
228 |
|
|
229 |
|
|
230 |
|
/* |
231 |
|
* Look for the library relative to the executable. This algorithm |
232 |
|
* should be the same as the one in the tcl_findLibrary procedure. |
233 |
|
* |
234 |
|
* This code looks in the following directories: |
235 |
|
* |
236 |
|
* <bindir>/../<installLib> |
237 |
|
* (e.g. /usr/local/bin/../lib/tcl8.2) |
238 |
|
* <bindir>/../../<installLib> |
239 |
|
* (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2) |
240 |
|
* <bindir>/../library |
241 |
|
* (e.g. /usr/src/tcl8.2/unix/../library) |
242 |
|
* <bindir>/../../library |
243 |
|
* (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library) |
244 |
|
* <bindir>/../../<developLib> |
245 |
|
* (e.g. /usr/src/tcl8.2/unix/../../tcl8.2/library) |
246 |
|
* <bindir>/../../../<devlopLib> |
247 |
|
* (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library) |
248 |
|
*/ |
249 |
|
|
250 |
|
if (path != NULL) { |
251 |
|
Tcl_SplitPath(path, &pathc, &pathv); |
252 |
|
if (pathc > 1) { |
253 |
|
pathv[pathc - 2] = installLib; |
254 |
|
path = Tcl_JoinPath(pathc - 1, pathv, &ds); |
255 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
256 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
257 |
|
Tcl_DStringFree(&ds); |
258 |
|
} |
259 |
|
if (pathc > 2) { |
260 |
|
pathv[pathc - 3] = installLib; |
261 |
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
262 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
263 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
264 |
|
Tcl_DStringFree(&ds); |
265 |
|
} |
266 |
|
if (pathc > 1) { |
267 |
|
pathv[pathc - 2] = "library"; |
268 |
|
path = Tcl_JoinPath(pathc - 1, pathv, &ds); |
269 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
270 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
271 |
|
Tcl_DStringFree(&ds); |
272 |
|
} |
273 |
|
if (pathc > 2) { |
274 |
|
pathv[pathc - 3] = "library"; |
275 |
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
276 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
277 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
278 |
|
Tcl_DStringFree(&ds); |
279 |
|
} |
280 |
|
if (pathc > 1) { |
281 |
|
pathv[pathc - 3] = developLib; |
282 |
|
path = Tcl_JoinPath(pathc - 2, pathv, &ds); |
283 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
284 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
285 |
|
Tcl_DStringFree(&ds); |
286 |
|
} |
287 |
|
if (pathc > 3) { |
288 |
|
pathv[pathc - 4] = developLib; |
289 |
|
path = Tcl_JoinPath(pathc - 3, pathv, &ds); |
290 |
|
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |
291 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
292 |
|
Tcl_DStringFree(&ds); |
293 |
|
} |
294 |
|
ckfree((char *) pathv); |
295 |
|
} |
296 |
|
|
297 |
|
TclSetLibraryPath(pathPtr); |
298 |
|
} |
299 |
|
|
300 |
|
/* |
301 |
|
*--------------------------------------------------------------------------- |
302 |
|
* |
303 |
|
* AppendEnvironment -- |
304 |
|
* |
305 |
|
* Append the value of the TCL_LIBRARY environment variable onto the |
306 |
|
* path pointer. If the env variable points to another version of |
307 |
|
* tcl (e.g. "tcl7.6") also append the path to this version (e.g., |
308 |
|
* "tcl7.6/../tcl8.2") |
309 |
|
* |
310 |
|
* Results: |
311 |
|
* None. |
312 |
|
* |
313 |
|
* Side effects: |
314 |
|
* None. |
315 |
|
* |
316 |
|
*--------------------------------------------------------------------------- |
317 |
|
*/ |
318 |
|
|
319 |
|
static void |
320 |
|
AppendEnvironment( |
321 |
|
Tcl_Obj *pathPtr, |
322 |
|
CONST char *lib) |
323 |
|
{ |
324 |
|
int pathc; |
325 |
|
WCHAR wBuf[MAX_PATH]; |
326 |
|
char buf[MAX_PATH * TCL_UTF_MAX]; |
327 |
|
Tcl_Obj *objPtr; |
328 |
|
char *str; |
329 |
|
Tcl_DString ds; |
330 |
|
char **pathv; |
331 |
|
|
332 |
|
/* |
333 |
|
* The "L" preceeding the TCL_LIBRARY string is used to tell VC++ |
334 |
|
* that this is a unicode string. |
335 |
|
*/ |
336 |
|
|
337 |
|
if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) { |
338 |
|
buf[0] = '\0'; |
339 |
|
GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH); |
340 |
|
} else { |
341 |
|
ToUtf(wBuf, buf); |
342 |
|
} |
343 |
|
|
344 |
|
if (buf[0] != '\0') { |
345 |
|
objPtr = Tcl_NewStringObj(buf, -1); |
346 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
347 |
|
|
348 |
|
TclWinNoBackslash(buf); |
349 |
|
Tcl_SplitPath(buf, &pathc, &pathv); |
350 |
|
|
351 |
|
/* |
352 |
|
* The lstrcmpi() will work even if pathv[pathc - 1] is random |
353 |
|
* UTF-8 chars because I know lib is ascii. |
354 |
|
*/ |
355 |
|
|
356 |
|
if ((pathc > 0) && (lstrcmpiA(lib + 4, pathv[pathc - 1]) != 0)) { |
357 |
|
/* |
358 |
|
* TCL_LIBRARY is set but refers to a different tcl |
359 |
|
* installation than the current version. Try fiddling with the |
360 |
|
* specified directory to make it refer to this installation by |
361 |
|
* removing the old "tclX.Y" and substituting the current |
362 |
|
* version string. |
363 |
|
*/ |
364 |
|
|
365 |
|
pathv[pathc - 1] = (char *) (lib + 4); |
366 |
|
Tcl_DStringInit(&ds); |
367 |
|
str = Tcl_JoinPath(pathc, pathv, &ds); |
368 |
|
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); |
369 |
|
Tcl_DStringFree(&ds); |
370 |
|
} else { |
371 |
|
objPtr = Tcl_NewStringObj(buf, -1); |
372 |
|
} |
373 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); |
374 |
|
ckfree((char *) pathv); |
375 |
|
} |
376 |
|
} |
377 |
|
|
378 |
|
/* |
379 |
|
*--------------------------------------------------------------------------- |
380 |
|
* |
381 |
|
* AppendDllPath -- |
382 |
|
* |
383 |
|
* Append a path onto the path pointer that tries to locate the Tcl |
384 |
|
* library relative to the location of the Tcl DLL. |
385 |
|
* |
386 |
|
* Results: |
387 |
|
* None. |
388 |
|
* |
389 |
|
* Side effects: |
390 |
|
* None. |
391 |
|
* |
392 |
|
*--------------------------------------------------------------------------- |
393 |
|
*/ |
394 |
|
|
395 |
|
static void |
396 |
|
AppendDllPath( |
397 |
|
Tcl_Obj *pathPtr, |
398 |
|
HMODULE hModule, |
399 |
|
CONST char *lib) |
400 |
|
{ |
401 |
|
WCHAR wName[MAX_PATH + LIBRARY_SIZE]; |
402 |
|
char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX]; |
403 |
|
|
404 |
|
if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) { |
405 |
|
GetModuleFileNameA(hModule, name, MAX_PATH); |
406 |
|
} else { |
407 |
|
ToUtf(wName, name); |
408 |
|
} |
409 |
|
if (lib != NULL) { |
410 |
|
char *end, *p; |
411 |
|
|
412 |
|
end = strrchr(name, '\\'); |
413 |
|
*end = '\0'; |
414 |
|
p = strrchr(name, '\\'); |
415 |
|
if (p != NULL) { |
416 |
|
end = p; |
417 |
|
} |
418 |
|
*end = '\\'; |
419 |
|
strcpy(end + 1, lib); |
420 |
|
} |
421 |
|
TclWinNoBackslash(name); |
422 |
|
Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1)); |
423 |
|
} |
424 |
|
|
425 |
|
/* |
426 |
|
*--------------------------------------------------------------------------- |
427 |
|
* |
428 |
|
* ToUtf -- |
429 |
|
* |
430 |
|
* Convert a char string to a UTF string. |
431 |
|
* |
432 |
|
* Results: |
433 |
|
* None. |
434 |
|
* |
435 |
|
* Side effects: |
436 |
|
* None. |
437 |
|
* |
438 |
|
*--------------------------------------------------------------------------- |
439 |
|
*/ |
440 |
|
|
441 |
|
static int |
442 |
|
ToUtf( |
443 |
|
CONST WCHAR *wSrc, |
444 |
|
char *dst) |
445 |
|
{ |
446 |
|
char *start; |
447 |
|
|
448 |
|
start = dst; |
449 |
|
while (*wSrc != '\0') { |
450 |
|
dst += Tcl_UniCharToUtf(*wSrc, dst); |
451 |
|
wSrc++; |
452 |
|
} |
453 |
|
*dst = '\0'; |
454 |
|
return dst - start; |
455 |
|
} |
456 |
|
|
457 |
|
|
458 |
|
/* |
459 |
|
*--------------------------------------------------------------------------- |
460 |
|
* |
461 |
|
* TclpSetInitialEncodings -- |
462 |
|
* |
463 |
|
* Based on the locale, determine the encoding of the operating |
464 |
|
* system and the default encoding for newly opened files. |
465 |
|
* |
466 |
|
* Called at process initialization time. |
467 |
|
* |
468 |
|
* Results: |
469 |
|
* None. |
470 |
|
* |
471 |
|
* Side effects: |
472 |
|
* The Tcl library path is converted from native encoding to UTF-8. |
473 |
|
* |
474 |
|
*--------------------------------------------------------------------------- |
475 |
|
*/ |
476 |
|
|
477 |
|
void |
478 |
|
TclpSetInitialEncodings() |
479 |
|
{ |
480 |
|
CONST char *encoding; |
481 |
|
char buf[4 + TCL_INTEGER_SPACE]; |
482 |
|
int platformId; |
483 |
|
Tcl_Obj *pathPtr; |
484 |
|
|
485 |
|
platformId = TclWinGetPlatformId(); |
486 |
|
|
487 |
|
TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT); |
488 |
|
|
489 |
|
wsprintfA(buf, "cp%d", GetACP()); |
490 |
|
Tcl_SetSystemEncoding(NULL, buf); |
491 |
|
|
492 |
|
if (platformId != VER_PLATFORM_WIN32_NT) { |
493 |
|
pathPtr = TclGetLibraryPath(); |
494 |
|
if (pathPtr != NULL) { |
495 |
|
int i, objc; |
496 |
|
Tcl_Obj **objv; |
497 |
|
|
498 |
|
objc = 0; |
499 |
|
Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); |
500 |
|
for (i = 0; i < objc; i++) { |
501 |
|
int length; |
502 |
|
char *string; |
503 |
|
Tcl_DString ds; |
504 |
|
|
505 |
|
string = Tcl_GetStringFromObj(objv[i], &length); |
506 |
|
Tcl_ExternalToUtfDString(NULL, string, length, &ds); |
507 |
|
Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), |
508 |
|
Tcl_DStringLength(&ds)); |
509 |
|
Tcl_DStringFree(&ds); |
510 |
|
} |
511 |
|
} |
512 |
|
} |
513 |
|
|
514 |
|
/* |
515 |
|
* Keep this encoding preloaded. The IO package uses it for gets on a |
516 |
|
* binary channel. |
517 |
|
*/ |
518 |
|
|
519 |
|
encoding = "iso8859-1"; |
520 |
|
Tcl_GetEncoding(NULL, encoding); |
521 |
|
} |
522 |
|
|
523 |
|
/* |
524 |
|
*--------------------------------------------------------------------------- |
525 |
|
* |
526 |
|
* TclpSetVariables -- |
527 |
|
* |
528 |
|
* Performs platform-specific interpreter initialization related to |
529 |
|
* the tcl_platform and env variables, and other platform-specific |
530 |
|
* things. |
531 |
|
* |
532 |
|
* Results: |
533 |
|
* None. |
534 |
|
* |
535 |
|
* Side effects: |
536 |
|
* Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl |
537 |
|
* variables. |
538 |
|
* |
539 |
|
*---------------------------------------------------------------------- |
540 |
|
*/ |
541 |
|
|
542 |
|
void |
543 |
|
TclpSetVariables(interp) |
544 |
|
Tcl_Interp *interp; /* Interp to initialize. */ |
545 |
|
{ |
546 |
|
char *ptr; |
547 |
|
char buffer[TCL_INTEGER_SPACE * 2]; |
548 |
|
SYSTEM_INFO sysInfo; |
549 |
|
OemId *oemId; |
550 |
|
OSVERSIONINFOA osInfo; |
551 |
|
Tcl_DString ds; |
552 |
|
|
553 |
|
osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); |
554 |
|
GetVersionExA(&osInfo); |
555 |
|
|
556 |
|
oemId = (OemId *) &sysInfo; |
557 |
|
GetSystemInfo(&sysInfo); |
558 |
|
|
559 |
|
/* |
560 |
|
* Initialize the tclDefaultLibrary variable from the registry. |
561 |
|
*/ |
562 |
|
|
563 |
|
Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY); |
564 |
|
|
565 |
|
/* |
566 |
|
* Define the tcl_platform array. |
567 |
|
*/ |
568 |
|
|
569 |
|
Tcl_SetVar2(interp, "tcl_platform", "platform", "windows", |
570 |
|
TCL_GLOBAL_ONLY); |
571 |
|
if (osInfo.dwPlatformId < NUMPLATFORMS) { |
572 |
|
Tcl_SetVar2(interp, "tcl_platform", "os", |
573 |
|
platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY); |
574 |
|
} |
575 |
|
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion); |
576 |
|
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY); |
577 |
|
if (oemId->wProcessorArchitecture < NUMPROCESSORS) { |
578 |
|
Tcl_SetVar2(interp, "tcl_platform", "machine", |
579 |
|
processors[oemId->wProcessorArchitecture], |
580 |
|
TCL_GLOBAL_ONLY); |
581 |
|
} |
582 |
|
|
583 |
|
#ifdef _DEBUG |
584 |
|
/* |
585 |
|
* The existence of the "debug" element of the tcl_platform array indicates |
586 |
|
* that this particular Tcl shell has been compiled with debug information. |
587 |
|
* Using "info exists tcl_platform(debug)" a Tcl script can direct the |
588 |
|
* interpreter to load debug versions of DLLs with the load command. |
589 |
|
*/ |
590 |
|
|
591 |
|
Tcl_SetVar2(interp, "tcl_platform", "debug", "1", |
592 |
|
TCL_GLOBAL_ONLY); |
593 |
|
#endif |
594 |
|
|
595 |
|
/* |
596 |
|
* Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH |
597 |
|
* environment variables, if necessary. |
598 |
|
*/ |
599 |
|
|
600 |
|
Tcl_DStringInit(&ds); |
601 |
|
ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY); |
602 |
|
if (ptr == NULL) { |
603 |
|
ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY); |
604 |
|
if (ptr != NULL) { |
605 |
|
Tcl_DStringAppend(&ds, ptr, -1); |
606 |
|
} |
607 |
|
ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY); |
608 |
|
if (ptr != NULL) { |
609 |
|
Tcl_DStringAppend(&ds, ptr, -1); |
610 |
|
} |
611 |
|
if (Tcl_DStringLength(&ds) > 0) { |
612 |
|
Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds), |
613 |
|
TCL_GLOBAL_ONLY); |
614 |
|
} else { |
615 |
|
Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY); |
616 |
|
} |
617 |
|
} |
618 |
|
|
619 |
|
/* |
620 |
|
* Initialize the user name from the environment first, since this is much |
621 |
|
* faster than asking the system. |
622 |
|
*/ |
623 |
|
|
624 |
|
Tcl_DStringSetLength(&ds, 100); |
625 |
|
if (TclGetEnv("USERNAME", &ds) == NULL) { |
626 |
|
if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) { |
627 |
|
Tcl_DStringSetLength(&ds, 0); |
628 |
|
} |
629 |
|
} |
630 |
|
Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds), |
631 |
|
TCL_GLOBAL_ONLY); |
632 |
|
Tcl_DStringFree(&ds); |
633 |
|
} |
634 |
|
|
635 |
|
/* |
636 |
|
*---------------------------------------------------------------------- |
637 |
|
* |
638 |
|
* TclpFindVariable -- |
639 |
|
* |
640 |
|
* Locate the entry in environ for a given name. On Unix this |
641 |
|
* routine is case sensetive, on Windows this matches mioxed case. |
642 |
|
* |
643 |
|
* Results: |
644 |
|
* The return value is the index in environ of an entry with the |
645 |
|
* name "name", or -1 if there is no such entry. The integer at |
646 |
|
* *lengthPtr is filled in with the length of name (if a matching |
647 |
|
* entry is found) or the length of the environ array (if no matching |
648 |
|
* entry is found). |
649 |
|
* |
650 |
|
* Side effects: |
651 |
|
* None. |
652 |
|
* |
653 |
|
*---------------------------------------------------------------------- |
654 |
|
*/ |
655 |
|
|
656 |
|
int |
657 |
|
TclpFindVariable(name, lengthPtr) |
658 |
|
CONST char *name; /* Name of desired environment variable |
659 |
|
* (UTF-8). */ |
660 |
|
int *lengthPtr; /* Used to return length of name (for |
661 |
|
* successful searches) or number of non-NULL |
662 |
|
* entries in environ (for unsuccessful |
663 |
|
* searches). */ |
664 |
|
{ |
665 |
|
int i, length, result = -1; |
666 |
|
register CONST char *env, *p1, *p2; |
667 |
|
char *envUpper, *nameUpper; |
668 |
|
Tcl_DString envString; |
669 |
|
|
670 |
|
/* |
671 |
|
* Convert the name to all upper case for the case insensitive |
672 |
|
* comparison. |
673 |
|
*/ |
674 |
|
|
675 |
|
length = strlen(name); |
676 |
|
nameUpper = (char *) ckalloc((unsigned) length+1); |
677 |
|
memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1); |
678 |
|
Tcl_UtfToUpper(nameUpper); |
679 |
|
|
680 |
|
Tcl_DStringInit(&envString); |
681 |
|
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { |
682 |
|
/* |
683 |
|
* Chop the env string off after the equal sign, then Convert |
684 |
|
* the name to all upper case, so we do not have to convert |
685 |
|
* all the characters after the equal sign. |
686 |
|
*/ |
687 |
|
|
688 |
|
envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); |
689 |
|
p1 = strchr(envUpper, '='); |
690 |
|
if (p1 == NULL) { |
691 |
|
continue; |
692 |
|
} |
693 |
|
length = p1 - envUpper; |
694 |
|
Tcl_DStringSetLength(&envString, length+1); |
695 |
|
Tcl_UtfToUpper(envUpper); |
696 |
|
|
697 |
|
p1 = envUpper; |
698 |
|
p2 = nameUpper; |
699 |
|
for (; *p2 == *p1; p1++, p2++) { |
700 |
|
/* NULL loop body. */ |
701 |
|
} |
702 |
|
if ((*p1 == '=') && (*p2 == '\0')) { |
703 |
|
*lengthPtr = length; |
704 |
|
result = i; |
705 |
|
goto done; |
706 |
|
} |
707 |
|
|
708 |
|
Tcl_DStringFree(&envString); |
709 |
|
} |
710 |
|
|
711 |
|
*lengthPtr = i; |
712 |
|
|
713 |
|
done: |
714 |
|
Tcl_DStringFree(&envString); |
715 |
|
ckfree(nameUpper); |
716 |
|
return result; |
717 |
|
} |
718 |
|
|
719 |
|
/* |
720 |
|
*---------------------------------------------------------------------- |
721 |
|
* |
722 |
|
* Tcl_Init -- |
723 |
|
* |
724 |
|
* This procedure is typically invoked by Tcl_AppInit procedures |
725 |
|
* to perform additional initialization for a Tcl interpreter, |
726 |
|
* such as sourcing the "init.tcl" script. |
727 |
|
* |
728 |
|
* Results: |
729 |
|
* Returns a standard Tcl completion code and sets the interp's |
730 |
|
* result if there is an error. |
731 |
|
* |
732 |
|
* Side effects: |
733 |
|
* Depends on what's in the init.tcl script. |
734 |
|
* |
735 |
|
*---------------------------------------------------------------------- |
736 |
|
*/ |
737 |
|
|
738 |
|
int |
739 |
|
Tcl_Init(interp) |
740 |
|
Tcl_Interp *interp; /* Interpreter to initialize. */ |
741 |
|
{ |
742 |
|
Tcl_Obj *pathPtr; |
743 |
|
|
744 |
|
if (tclPreInitScript != NULL) { |
745 |
|
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { |
746 |
|
return (TCL_ERROR); |
747 |
|
}; |
748 |
|
} |
749 |
|
|
750 |
|
pathPtr = TclGetLibraryPath(); |
751 |
|
if (pathPtr == NULL) { |
752 |
|
pathPtr = Tcl_NewObj(); |
753 |
|
} |
754 |
|
Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY); |
755 |
|
return Tcl_Eval(interp, initScript); |
756 |
|
} |
757 |
|
|
758 |
|
/* |
759 |
|
*---------------------------------------------------------------------- |
760 |
|
* |
761 |
|
* Tcl_SourceRCFile -- |
762 |
|
* |
763 |
|
* This procedure is typically invoked by Tcl_Main of Tk_Main |
764 |
|
* procedure to source an application specific rc file into the |
765 |
|
* interpreter at startup time. |
766 |
|
* |
767 |
|
* Results: |
768 |
|
* None. |
769 |
|
* |
770 |
|
* Side effects: |
771 |
|
* Depends on what's in the rc script. |
772 |
|
* |
773 |
|
*---------------------------------------------------------------------- |
774 |
|
*/ |
775 |
|
|
776 |
|
void |
777 |
|
Tcl_SourceRCFile(interp) |
778 |
|
Tcl_Interp *interp; /* Interpreter to source rc file into. */ |
779 |
|
{ |
780 |
|
Tcl_DString temp; |
781 |
|
char *fileName; |
782 |
|
Tcl_Channel errChannel; |
783 |
|
|
784 |
|
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); |
785 |
|
|
786 |
|
if (fileName != NULL) { |
787 |
|
Tcl_Channel c; |
788 |
|
char *fullName; |
789 |
|
|
790 |
|
Tcl_DStringInit(&temp); |
791 |
|
fullName = Tcl_TranslateFileName(interp, fileName, &temp); |
792 |
|
if (fullName == NULL) { |
793 |
|
/* |
794 |
|
* Couldn't translate the file name (e.g. it referred to a |
795 |
|
* bogus user or there was no HOME environment variable). |
796 |
|
* Just do nothing. |
797 |
|
*/ |
798 |
|
} else { |
799 |
|
|
800 |
|
/* |
801 |
|
* Test for the existence of the rc file before trying to read it. |
802 |
|
*/ |
803 |
|
|
804 |
|
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); |
805 |
|
if (c != (Tcl_Channel) NULL) { |
806 |
|
Tcl_Close(NULL, c); |
807 |
|
if (Tcl_EvalFile(interp, fullName) != TCL_OK) { |
808 |
|
errChannel = Tcl_GetStdChannel(TCL_STDERR); |
809 |
|
if (errChannel) { |
810 |
|
Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); |
811 |
|
Tcl_WriteChars(errChannel, "\n", 1); |
812 |
|
} |
813 |
|
} |
814 |
|
} |
815 |
|
} |
816 |
|
Tcl_DStringFree(&temp); |
817 |
|
} |
818 |
|
} |
819 |
|
|
820 |
|
/* |
821 |
|
*---------------------------------------------------------------------- |
822 |
|
* |
823 |
|
* TclpAsyncMark -- |
824 |
|
* |
825 |
|
* Wake up the main thread from a signal handler. |
826 |
|
* |
827 |
|
* Results: |
828 |
|
* None. |
829 |
|
* |
830 |
|
* Side effects: |
831 |
|
* Sends a message to the main thread. |
832 |
|
* |
833 |
|
*---------------------------------------------------------------------- |
834 |
|
*/ |
835 |
|
|
836 |
|
void |
837 |
|
TclpAsyncMark(async) |
838 |
|
Tcl_AsyncHandler async; /* Token for handler. */ |
839 |
|
{ |
840 |
|
/* |
841 |
|
* Need a way to kick the Windows event loop and tell it to go look at |
842 |
|
* asynchronous events. |
843 |
|
*/ |
844 |
|
|
845 |
|
PostThreadMessage(mainThreadId, WM_USER, 0, 0); |
846 |
|
} |
847 |
|
|
848 |
|
/* End of tclwininit.c */ |