*/
#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
#ifndef PROCESSOR_ARCHITECTURE_PPC
#define PROCESSOR_ARCHITECTURE_PPC 3
#endif
+#ifndef PROCESSOR_ARCHITECTURE_SHX
+#define PROCESSOR_ARCHITECTURE_SHX 4
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_ARM
+#define PROCESSOR_ARCHITECTURE_ARM 5
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_IA64
+#define PROCESSOR_ARCHITECTURE_IA64 6
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_ALPHA64
+#define PROCESSOR_ARCHITECTURE_ALPHA64 7
+#endif
+#ifndef PROCESSOR_ARCHITECTURE_MSIL
+#define PROCESSOR_ARCHITECTURE_MSIL 8
+#endif
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
#define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
#endif
"Win32s", "Windows 95", "Windows NT"
};
-#define NUMPROCESSORS 4
+#define NUMPROCESSORS 9
static char* processors[NUMPROCESSORS] = {
- "intel", "mips", "alpha", "ppc"
+ "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil"
};
-/*
- * Thread id used for asynchronous notification from signal handlers.
- */
-
-static DWORD mainThreadId;
+/* Used to store the encoding used for binary files */
+static Tcl_Encoding binaryEncoding = NULL;
+/* Has the basic library path encoding issue been fixed */
+static int libraryPathEncodingFixed = 0;
/*
* The Init script (common to Windows and Unix platforms) is
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);
\f
/*
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
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
- char *str;
+ CONST char *str;
Tcl_DString ds;
int pathc;
- char **pathv;
+ CONST char **pathv;
char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
-
+#ifdef __CYGWIN__
+ char installLib2[LIBRARY_SIZE];
+#endif
Tcl_DStringInit(&ds);
pathPtr = Tcl_NewObj();
* executable is run from a develpment directory.
*/
- /* CYGNUS LOCAL */
+ /* REDHAT LOCAL */
/* Due to cygwin standard practice, the tcl binary will be
installed in /bin rather than /usr/bin. This means that, without
this change, tcl will search in x:\share rather than x:\usr\share. */
-#ifdef __CYGWIN__
- sprintf(installLib, "usr/share/tcl%s", TCL_VERSION);
-#else
+
+ /* sprintf(installLib, "lib/tcl%s", TCL_VERSION); */
sprintf(installLib, "share/tcl%s", TCL_VERSION);
+#ifdef __CYGWIN__
+ sprintf(installLib2, "usr/share/tcl%s", TCL_VERSION);
#endif
- /* END CYGNUS LOCAL */
- sprintf(developLib, "../tcl%s/library",
- ((TCL_RELEASE_LEVEL < 2) ? TCL_PATCH_LEVEL : TCL_VERSION));
+ /* END REDHAT LOCAL */
+
+ sprintf(developLib, "../tcl%s/library", TCL_PATCH_LEVEL);
/*
* Look for the library relative to default encoding dir.
* This code looks in the following directories:
*
* <bindir>/../<installLib>
- * (e.g. /usr/local/bin/../lib/tcl8.2)
+ * (e.g. /usr/local/bin/../lib/tcl8.4)
* <bindir>/../../<installLib>
- * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.2)
+ * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
* <bindir>/../library
- * (e.g. /usr/src/tcl8.2/unix/../library)
+ * (e.g. /usr/src/tcl8.4.0/unix/../library)
* <bindir>/../../library
- * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../library)
+ * (e.g. /usr/src/tcl8.4.0/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)
+ * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
+ * <bindir>/../../../<developLib>
+ * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
*/
+ /*
+ * The variable path holds an absolute path. Take care not to
+ * overwrite pathv[0] since that might produce a relative path.
+ */
+
if (path != NULL) {
Tcl_SplitPath(path, &pathc, &pathv);
- if (pathc > 1) {
+
+
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = installLib;
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
+ /* REDHAT LOCAL */
+#ifdef __CYGWIN__
+ pathv[pathc - 2] = installLib2;
+ path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
+ objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+#endif
+ /* END REDHAT LOCAL */
+
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = installLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 2) {
+ str = pathv[pathc - 2];
pathv[pathc - 2] = "library";
path = Tcl_JoinPath(pathc - 1, pathv, &ds);
+ pathv[pathc - 2] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 2) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = "library";
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 1) {
+ if (pathc > 3) {
+ str = pathv[pathc - 3];
pathv[pathc - 3] = developLib;
path = Tcl_JoinPath(pathc - 2, pathv, &ds);
+ pathv[pathc - 3] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
}
- if (pathc > 3) {
+ if (pathc > 4) {
+ str = pathv[pathc - 4];
pathv[pathc - 4] = developLib;
path = Tcl_JoinPath(pathc - 3, pathv, &ds);
+ pathv[pathc - 4] = str;
objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
Tcl_DStringFree(&ds);
WCHAR wBuf[MAX_PATH];
char buf[MAX_PATH * TCL_UTF_MAX];
Tcl_Obj *objPtr;
- char *str;
Tcl_DString ds;
- char **pathv;
+ CONST char **pathv;
/*
* The "L" preceeding the TCL_LIBRARY string is used to tell VC++
*/
if ((pathc > 0) && (lstrcmpiA(lib + 4, 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
* version string.
*/
- pathv[pathc - 1] = (char *) (lib + 4);
+ pathv[pathc - 1] = (lib + 4);
Tcl_DStringInit(&ds);
str = Tcl_JoinPath(pathc, pathv, &ds);
objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
wSrc++;
}
*dst = '\0';
- return dst - start;
+ return (int) (dst - start);
}
\f
* Based on the locale, determine the encoding of the operating
* system and the default encoding for newly opened files.
*
- * Called at process initialization time.
+ * Called at process initialization time, and part way through
+ * startup, we verify that the initial encodings were correctly
+ * setup. Depending on Tcl's environment, there may not have been
+ * enough information first time through (above).
*
* Results:
* None.
*
* Side effects:
- * The Tcl library path is converted from native encoding to UTF-8.
+ * The Tcl library path is converted from native encoding to UTF-8,
+ * on the first call, and the encodings may be changed on first or
+ * second call.
*
*---------------------------------------------------------------------------
*/
{
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);
+ if (libraryPathEncodingFixed == 0) {
+ int platformId;
+ platformId = TclWinGetPlatformId();
+ TclWinSetInterfaces(platformId == VER_PLATFORM_WIN32_NT);
+
+ wsprintfA(buf, "cp%d", GetACP());
+ Tcl_SetSystemEncoding(NULL, buf);
+
+ if (platformId != VER_PLATFORM_WIN32_NT) {
+ Tcl_Obj *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);
+ }
}
}
+
+ libraryPathEncodingFixed = 1;
+ } else {
+ wsprintfA(buf, "cp%d", GetACP());
+ Tcl_SetSystemEncoding(NULL, buf);
}
- /*
- * Keep this encoding preloaded. The IO package uses it for gets on a
- * binary channel.
- */
-
- encoding = "iso8859-1";
- Tcl_GetEncoding(NULL, encoding);
+ /* This is only ever called from the startup thread */
+ if (binaryEncoding == NULL) {
+ /*
+ * Keep this encoding preloaded. The IO package uses it for
+ * gets on a binary channel.
+ */
+ encoding = "iso8859-1";
+ binaryEncoding = Tcl_GetEncoding(NULL, encoding);
+ }
}
\f
/*
* None.
*
* Side effects:
- * Sets "tclDefaultLibrary", "tcl_platform", and "env(HOME)" Tcl
- * variables.
+ * Sets "tcl_platform", and "env(HOME)" Tcl variables.
*
*----------------------------------------------------------------------
*/
TclpSetVariables(interp)
Tcl_Interp *interp; /* Interp to initialize. */
{
- char *ptr;
+ CONST char *ptr;
char buffer[TCL_INTEGER_SPACE * 2];
SYSTEM_INFO sysInfo;
OemId *oemId;
GetSystemInfo(&sysInfo);
/*
- * Initialize the tclDefaultLibrary variable from the registry.
- */
-
- Tcl_SetVar(interp, "tclDefaultLibrary", "", TCL_GLOBAL_ONLY);
-
- /*
* Define the tcl_platform array.
*/
Tcl_DStringSetLength(&ds, 100);
if (TclGetEnv("USERNAME", &ds) == NULL) {
- if (GetUserName(Tcl_DStringValue(&ds), &Tcl_DStringLength(&ds)) == 0) {
+ if (GetUserName(Tcl_DStringValue(&ds), (LPDWORD) &Tcl_DStringLength(&ds)) == 0) {
Tcl_DStringSetLength(&ds, 0);
}
}
if (p1 == NULL) {
continue;
}
- length = p1 - envUpper;
+ length = (int) (p1 - envUpper);
Tcl_DStringSetLength(&envString, length+1);
Tcl_UtfToUpper(envUpper);
Tcl_Interp *interp; /* Interpreter to source rc file into. */
{
Tcl_DString temp;
- char *fileName;
+ CONST char *fileName;
Tcl_Channel errChannel;
fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
if (fileName != NULL) {
Tcl_Channel c;
- char *fullName;
+ CONST char *fullName;
Tcl_DStringInit(&temp);
fullName = Tcl_TranslateFileName(interp, fileName, &temp);
Tcl_DStringFree(&temp);
}
}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * 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);
-}
-
-
-
OSDN Git Service
