sl@0: /* 
sl@0:  * tclWinInit.c --
sl@0:  *
sl@0:  *	Contains the Windows-specific interpreter initialization functions.
sl@0:  *
sl@0:  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0:  * Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0:  * All rights reserved.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclWinInit.c,v 1.40.2.6 2005/10/23 22:01:31 msofer Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclWinInt.h"
sl@0: #include <winnt.h>
sl@0: #include <winbase.h>
sl@0: #include <lmcons.h>
sl@0: 
sl@0: /*
sl@0:  * The following declaration is a workaround for some Microsoft brain damage.
sl@0:  * The SYSTEM_INFO structure is different in various releases, even though the
sl@0:  * layout is the same.  So we overlay our own structure on top of it so we
sl@0:  * can access the interesting slots in a uniform way.
sl@0:  */
sl@0: 
sl@0: typedef struct {
sl@0:     WORD wProcessorArchitecture;
sl@0:     WORD wReserved;
sl@0: } OemId;
sl@0: 
sl@0: /*
sl@0:  * The following macros are missing from some versions of winnt.h.
sl@0:  */
sl@0: 
sl@0: #ifndef PROCESSOR_ARCHITECTURE_INTEL
sl@0: #define PROCESSOR_ARCHITECTURE_INTEL 0
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_MIPS
sl@0: #define PROCESSOR_ARCHITECTURE_MIPS  1
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_ALPHA
sl@0: #define PROCESSOR_ARCHITECTURE_ALPHA 2
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_PPC
sl@0: #define PROCESSOR_ARCHITECTURE_PPC   3
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_SHX  
sl@0: #define PROCESSOR_ARCHITECTURE_SHX   4
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_ARM
sl@0: #define PROCESSOR_ARCHITECTURE_ARM   5
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_IA64
sl@0: #define PROCESSOR_ARCHITECTURE_IA64  6
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_ALPHA64
sl@0: #define PROCESSOR_ARCHITECTURE_ALPHA64 7
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_MSIL
sl@0: #define PROCESSOR_ARCHITECTURE_MSIL  8
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_AMD64
sl@0: #define PROCESSOR_ARCHITECTURE_AMD64 9
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
sl@0: #define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64 10
sl@0: #endif
sl@0: #ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
sl@0: #define PROCESSOR_ARCHITECTURE_UNKNOWN 0xFFFF
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * The following arrays contain the human readable strings for the Windows
sl@0:  * platform and processor values.
sl@0:  */
sl@0: 
sl@0: 
sl@0: #define NUMPLATFORMS 4
sl@0: static char* platforms[NUMPLATFORMS] = {
sl@0:     "Win32s", "Windows 95", "Windows NT", "Windows CE"
sl@0: };
sl@0: 
sl@0: #define NUMPROCESSORS 11
sl@0: static char* processors[NUMPROCESSORS] = {
sl@0:     "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
sl@0:     "amd64", "ia32_on_win64"
sl@0: };
sl@0: 
sl@0: /* Used to store the encoding used for binary files */
sl@0: static Tcl_Encoding binaryEncoding = NULL;
sl@0: /* Has the basic library path encoding issue been fixed */
sl@0: static int libraryPathEncodingFixed = 0;
sl@0: 
sl@0: /*
sl@0:  * The Init script (common to Windows and Unix platforms) is
sl@0:  * defined in tkInitScript.h
sl@0:  */
sl@0: 
sl@0: #include "tclInitScript.h"
sl@0: 
sl@0: static void		AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
sl@0: static void		AppendDllPath(Tcl_Obj *listPtr, HMODULE hModule,
sl@0: 			    CONST char *lib);
sl@0: static int		ToUtf(CONST WCHAR *wSrc, char *dst);
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpInitPlatform --
sl@0:  *
sl@0:  *	Initialize all the platform-dependant things like signals and
sl@0:  *	floating-point error handling.
sl@0:  *
sl@0:  *	Called at process initialization time.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpInitPlatform()
sl@0: {
sl@0:     tclPlatform = TCL_PLATFORM_WINDOWS;
sl@0: 
sl@0:     /*
sl@0:      * The following code stops Windows 3.X and Windows NT 3.51 from 
sl@0:      * automatically putting up Sharing Violation dialogs, e.g, when 
sl@0:      * someone tries to access a file that is locked or a drive with no 
sl@0:      * disk in it.  Tcl already returns the appropriate error to the 
sl@0:      * caller, and they can decide to put up their own dialog in response 
sl@0:      * to that failure.  
sl@0:      *
sl@0:      * Under 95 and NT 4.0, this is a NOOP because the system doesn't 
sl@0:      * automatically put up dialogs when the above operations fail.
sl@0:      */
sl@0: 
sl@0:     SetErrorMode(SetErrorMode(0) | SEM_FAILCRITICALERRORS);
sl@0: 
sl@0: #ifdef STATIC_BUILD
sl@0:     /*
sl@0:      * If we are in a statically linked executable, then we need to
sl@0:      * explicitly initialize the Windows function tables here since
sl@0:      * DllMain() will not be invoked.
sl@0:      */
sl@0: 
sl@0:     TclWinInit(GetModuleHandle(NULL));
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpInitLibraryPath --
sl@0:  *
sl@0:  *	Initialize the library path at startup.  
sl@0:  *
sl@0:  *	This call sets the library path to strings in UTF-8. Any 
sl@0:  *	pre-existing library path information is assumed to have been 
sl@0:  *	in the native multibyte encoding.
sl@0:  *
sl@0:  *	Called at process initialization time.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Return 0, indicating that the UTF is clean.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclpInitLibraryPath(path)
sl@0:     CONST char *path;		/* Potentially dirty UTF string that is */
sl@0: 				/* the path to the executable name.     */
sl@0: {
sl@0: #define LIBRARY_SIZE	    32
sl@0:     Tcl_Obj *pathPtr, *objPtr;
sl@0:     CONST char *str;
sl@0:     Tcl_DString ds;
sl@0:     int pathc;
sl@0:     CONST char **pathv;
sl@0:     char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
sl@0: 
sl@0:     Tcl_DStringInit(&ds);
sl@0:     pathPtr = Tcl_NewObj();
sl@0: 
sl@0:     /*
sl@0:      * Initialize the substrings used when locating an executable.  The
sl@0:      * installLib variable computes the path as though the executable
sl@0:      * is installed.  The developLib computes the path as though the
sl@0:      * executable is run from a develpment directory.
sl@0:      */
sl@0: 
sl@0:     sprintf(installLib, "lib/tcl%s", TCL_VERSION);
sl@0:     sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
sl@0: 
sl@0:     /*
sl@0:      * Look for the library relative to default encoding dir.
sl@0:      */
sl@0: 
sl@0:     str = Tcl_GetDefaultEncodingDir();
sl@0:     if ((str != NULL) && (str[0] != '\0')) {
sl@0: 	objPtr = Tcl_NewStringObj(str, -1);
sl@0: 	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Look for the library relative to the TCL_LIBRARY env variable.
sl@0:      * If the last dirname in the TCL_LIBRARY path does not match the
sl@0:      * last dirname in the installLib variable, use the last dir name
sl@0:      * of installLib in addition to the orginal TCL_LIBRARY path.
sl@0:      */
sl@0: 
sl@0:     AppendEnvironment(pathPtr, installLib);
sl@0: 
sl@0:     /*
sl@0:      * Look for the library relative to the DLL.  Only use the installLib
sl@0:      * because in practice, the DLL is always installed.
sl@0:      */
sl@0: 
sl@0:     AppendDllPath(pathPtr, TclWinGetTclInstance(), installLib);
sl@0:     
sl@0: 
sl@0:     /*
sl@0:      * Look for the library relative to the executable.  This algorithm
sl@0:      * should be the same as the one in the tcl_findLibrary procedure.
sl@0:      *
sl@0:      * This code looks in the following directories:
sl@0:      *
sl@0:      *	<bindir>/../<installLib>
sl@0:      *	  (e.g. /usr/local/bin/../lib/tcl8.4)
sl@0:      *	<bindir>/../../<installLib>
sl@0:      * 	  (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
sl@0:      *	<bindir>/../library
sl@0:      * 	  (e.g. /usr/src/tcl8.4.0/unix/../library)
sl@0:      *	<bindir>/../../library
sl@0:      *	  (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
sl@0:      *	<bindir>/../../<developLib>
sl@0:      *	  (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
sl@0:      *	<bindir>/../../../<developLib>
sl@0:      *	   (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
sl@0:      */
sl@0:      
sl@0:     /*
sl@0:      * The variable path holds an absolute path.  Take care not to
sl@0:      * overwrite pathv[0] since that might produce a relative path.
sl@0:      */
sl@0: 
sl@0:     if (path != NULL) {
sl@0: 	int i, origc;
sl@0: 	CONST char **origv;
sl@0: 
sl@0: 	Tcl_SplitPath(path, &origc, &origv);
sl@0: 	pathc = 0;
sl@0: 	pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
sl@0: 	for (i=0; i< origc; i++) {
sl@0: 	    if (origv[i][0] == '.') {
sl@0: 		if (strcmp(origv[i], ".") == 0) {
sl@0: 		    /* do nothing */
sl@0: 		} else if (strcmp(origv[i], "..") == 0) {
sl@0: 		    pathc--;
sl@0: 		} else {
sl@0: 		    pathv[pathc++] = origv[i];
sl@0: 		}
sl@0: 	    } else {
sl@0: 		pathv[pathc++] = origv[i];
sl@0: 	    }
sl@0: 	}
sl@0: 	if (pathc > 2) {
sl@0: 	    str = pathv[pathc - 2];
sl@0: 	    pathv[pathc - 2] = installLib;
sl@0: 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
sl@0: 	    pathv[pathc - 2] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	if (pathc > 3) {
sl@0: 	    str = pathv[pathc - 3];
sl@0: 	    pathv[pathc - 3] = installLib;
sl@0: 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
sl@0: 	    pathv[pathc - 3] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	if (pathc > 2) {
sl@0: 	    str = pathv[pathc - 2];
sl@0: 	    pathv[pathc - 2] = "library";
sl@0: 	    path = Tcl_JoinPath(pathc - 1, pathv, &ds);
sl@0: 	    pathv[pathc - 2] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	if (pathc > 3) {
sl@0: 	    str = pathv[pathc - 3];
sl@0: 	    pathv[pathc - 3] = "library";
sl@0: 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
sl@0: 	    pathv[pathc - 3] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	if (pathc > 3) {
sl@0: 	    str = pathv[pathc - 3];
sl@0: 	    pathv[pathc - 3] = developLib;
sl@0: 	    path = Tcl_JoinPath(pathc - 2, pathv, &ds);
sl@0: 	    pathv[pathc - 3] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	if (pathc > 4) {
sl@0: 	    str = pathv[pathc - 4];
sl@0: 	    pathv[pathc - 4] = developLib;
sl@0: 	    path = Tcl_JoinPath(pathc - 3, pathv, &ds);
sl@0: 	    pathv[pathc - 4] = str;
sl@0: 	    objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	}
sl@0: 	ckfree((char *) origv);
sl@0: 	ckfree((char *) pathv);
sl@0:     }
sl@0: 
sl@0:     TclSetLibraryPath(pathPtr);
sl@0: 
sl@0:     return 0; /* 0 indicates that pathPtr is clean (true) utf */
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * AppendEnvironment --
sl@0:  *
sl@0:  *	Append the value of the TCL_LIBRARY environment variable onto the
sl@0:  *	path pointer.  If the env variable points to another version of
sl@0:  *	tcl (e.g. "tcl7.6") also append the path to this version (e.g.,
sl@0:  *	"tcl7.6/../tcl8.2")
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: AppendEnvironment(
sl@0:     Tcl_Obj *pathPtr,
sl@0:     CONST char *lib)
sl@0: {
sl@0:     int pathc;
sl@0:     WCHAR wBuf[MAX_PATH];
sl@0:     char buf[MAX_PATH * TCL_UTF_MAX];
sl@0:     Tcl_Obj *objPtr;
sl@0:     Tcl_DString ds;
sl@0:     CONST char **pathv;
sl@0:     char *shortlib;
sl@0: 
sl@0:     /*
sl@0:      * The shortlib value needs to be the tail component of the
sl@0:      * lib path. For example, "lib/tcl8.4" -> "tcl8.4" while
sl@0:      * "usr/share/tcl8.5" -> "tcl8.5".
sl@0:      */
sl@0:     for (shortlib = (char *) (lib + strlen(lib) - 1); shortlib > lib ; shortlib--) {
sl@0:         if (*shortlib == '/') { 
sl@0:             if (shortlib == (lib + strlen(lib) - 1)) {
sl@0:                 Tcl_Panic("last character in lib cannot be '/'");
sl@0:             }
sl@0:             shortlib++;
sl@0:             break;
sl@0:         }
sl@0:     }
sl@0:     if (shortlib == lib) {
sl@0:         Tcl_Panic("no '/' character found in lib");
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * The "L" preceeding the TCL_LIBRARY string is used to tell VC++
sl@0:      * that this is a unicode string.
sl@0:      */
sl@0:     
sl@0:     if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
sl@0:         buf[0] = '\0';
sl@0: 	GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
sl@0:     } else {
sl@0: 	ToUtf(wBuf, buf);
sl@0:     }
sl@0: 
sl@0:     if (buf[0] != '\0') {
sl@0: 	objPtr = Tcl_NewStringObj(buf, -1);
sl@0: 	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 
sl@0: 	TclWinNoBackslash(buf);
sl@0: 	Tcl_SplitPath(buf, &pathc, &pathv);
sl@0: 
sl@0: 	/* 
sl@0: 	 * The lstrcmpi() will work even if pathv[pathc - 1] is random
sl@0: 	 * UTF-8 chars because I know shortlib is ascii.
sl@0: 	 */
sl@0: 
sl@0: 	if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
sl@0: 	    CONST char *str;
sl@0: 	    /*
sl@0: 	     * TCL_LIBRARY is set but refers to a different tcl
sl@0: 	     * installation than the current version.  Try fiddling with the
sl@0: 	     * specified directory to make it refer to this installation by
sl@0: 	     * removing the old "tclX.Y" and substituting the current
sl@0: 	     * version string.
sl@0: 	     */
sl@0: 	    
sl@0: 	    pathv[pathc - 1] = shortlib;
sl@0: 	    Tcl_DStringInit(&ds);
sl@0: 	    str = Tcl_JoinPath(pathc, pathv, &ds);
sl@0: 	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
sl@0: 	    Tcl_DStringFree(&ds);
sl@0: 	} else {
sl@0: 	    objPtr = Tcl_NewStringObj(buf, -1);
sl@0: 	}
sl@0: 	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0: 	ckfree((char *) pathv);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * AppendDllPath --
sl@0:  *
sl@0:  *	Append a path onto the path pointer that tries to locate the Tcl
sl@0:  *	library relative to the location of the Tcl DLL.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void 
sl@0: AppendDllPath(
sl@0:     Tcl_Obj *pathPtr, 
sl@0:     HMODULE hModule,
sl@0:     CONST char *lib)
sl@0: {
sl@0:     WCHAR wName[MAX_PATH + LIBRARY_SIZE];
sl@0:     char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
sl@0: 
sl@0:     if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
sl@0: 	GetModuleFileNameA(hModule, name, MAX_PATH);
sl@0:     } else {
sl@0: 	ToUtf(wName, name);
sl@0:     }
sl@0:     if (lib != NULL) {
sl@0: 	char *end, *p;
sl@0: 
sl@0: 	end = strrchr(name, '\\');
sl@0: 	*end = '\0';
sl@0: 	p = strrchr(name, '\\');
sl@0: 	if (p != NULL) {
sl@0: 	    end = p;
sl@0: 	}
sl@0: 	*end = '\\';
sl@0: 	strcpy(end + 1, lib);
sl@0:     }
sl@0:     TclWinNoBackslash(name);
sl@0:     Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(name, -1));
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * ToUtf --
sl@0:  *
sl@0:  *	Convert a char string to a UTF string.  
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: ToUtf(
sl@0:     CONST WCHAR *wSrc,
sl@0:     char *dst)
sl@0: {
sl@0:     char *start;
sl@0: 
sl@0:     start = dst;
sl@0:     while (*wSrc != '\0') {
sl@0: 	dst += Tcl_UniCharToUtf(*wSrc, dst);
sl@0: 	wSrc++;
sl@0:     }
sl@0:     *dst = '\0';
sl@0:     return (int) (dst - start);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclWinEncodingsCleanup --
sl@0:  *
sl@0:  *	Reset information to its original state in finalization to
sl@0:  *	allow for reinitialization to be possible.  This must not
sl@0:  *	be called until after the filesystem has been finalised, or
sl@0:  *	exit crashes may occur when using virtual filesystems.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Static information reset to startup state.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclWinEncodingsCleanup()
sl@0: {
sl@0:     TclWinResetInterfaceEncodings();
sl@0:     libraryPathEncodingFixed = 0;
sl@0:     if (binaryEncoding != NULL) {
sl@0: 	Tcl_FreeEncoding(binaryEncoding);
sl@0: 	binaryEncoding = NULL;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpSetInitialEncodings --
sl@0:  *
sl@0:  *	Based on the locale, determine the encoding of the operating
sl@0:  *	system and the default encoding for newly opened files.
sl@0:  *
sl@0:  *	Called at process initialization time, and part way through
sl@0:  *	startup, we verify that the initial encodings were correctly
sl@0:  *	setup.  Depending on Tcl's environment, there may not have been
sl@0:  *	enough information first time through (above).
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The Tcl library path is converted from native encoding to UTF-8,
sl@0:  *	on the first call, and the encodings may be changed on first or
sl@0:  *	second call.
sl@0:  *
sl@0:  *---------------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpSetInitialEncodings()
sl@0: {
sl@0:     CONST char *encoding;
sl@0:     char buf[4 + TCL_INTEGER_SPACE];
sl@0: 
sl@0:     if (libraryPathEncodingFixed == 0) {
sl@0: 	int platformId, useWide;
sl@0: 
sl@0: 	platformId = TclWinGetPlatformId();
sl@0: 	useWide = ((platformId == VER_PLATFORM_WIN32_NT)
sl@0: 		|| (platformId == VER_PLATFORM_WIN32_CE));
sl@0: 	TclWinSetInterfaces(useWide);
sl@0: 
sl@0: 	wsprintfA(buf, "cp%d", GetACP());
sl@0: 	Tcl_SetSystemEncoding(NULL, buf);
sl@0: 
sl@0: 	if (!useWide) {
sl@0: 	    Tcl_Obj *pathPtr = TclGetLibraryPath();
sl@0: 	    if (pathPtr != NULL) {
sl@0: 		int i, objc;
sl@0: 		Tcl_Obj **objv;
sl@0: 		
sl@0: 		objc = 0;
sl@0: 		Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
sl@0: 		for (i = 0; i < objc; i++) {
sl@0: 		    int length;
sl@0: 		    char *string;
sl@0: 		    Tcl_DString ds;
sl@0: 
sl@0: 		    string = Tcl_GetStringFromObj(objv[i], &length);
sl@0: 		    Tcl_ExternalToUtfDString(NULL, string, length, &ds);
sl@0: 		    Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
sl@0: 			    Tcl_DStringLength(&ds));
sl@0: 		    Tcl_DStringFree(&ds);
sl@0: 		}
sl@0: 	    }
sl@0: 	}
sl@0: 	
sl@0: 	libraryPathEncodingFixed = 1;
sl@0:     } else {
sl@0: 	wsprintfA(buf, "cp%d", GetACP());
sl@0: 	Tcl_SetSystemEncoding(NULL, buf);
sl@0:     }
sl@0: 
sl@0:     /* This is only ever called from the startup thread */
sl@0:     if (binaryEncoding == NULL) {
sl@0: 	/*
sl@0: 	 * Keep this encoding preloaded.  The IO package uses it for
sl@0: 	 * gets on a binary channel.
sl@0: 	 */
sl@0: 	encoding = "iso8859-1";
sl@0: 	binaryEncoding = Tcl_GetEncoding(NULL, encoding);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *---------------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpSetVariables --
sl@0:  *
sl@0:  *	Performs platform-specific interpreter initialization related to
sl@0:  *	the tcl_platform and env variables, and other platform-specific
sl@0:  *	things.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Sets "tcl_platform", and "env(HOME)" Tcl variables.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpSetVariables(interp)
sl@0:     Tcl_Interp *interp;		/* Interp to initialize. */	
sl@0: {	    
sl@0:     CONST char *ptr;
sl@0:     char buffer[TCL_INTEGER_SPACE * 2];
sl@0:     SYSTEM_INFO sysInfo;
sl@0:     OemId *oemId;
sl@0:     OSVERSIONINFOA osInfo;
sl@0:     Tcl_DString ds;
sl@0:     TCHAR szUserName[ UNLEN+1 ];
sl@0:     DWORD dwUserNameLen = sizeof(szUserName);
sl@0: 
sl@0:     osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
sl@0:     GetVersionExA(&osInfo);
sl@0: 
sl@0:     oemId = (OemId *) &sysInfo;
sl@0:     GetSystemInfo(&sysInfo);
sl@0: 
sl@0:     /*
sl@0:      * Define the tcl_platform array.
sl@0:      */
sl@0: 
sl@0:     Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
sl@0: 	    TCL_GLOBAL_ONLY);
sl@0:     if (osInfo.dwPlatformId < NUMPLATFORMS) {
sl@0: 	Tcl_SetVar2(interp, "tcl_platform", "os",
sl@0: 		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
sl@0:     }
sl@0:     wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
sl@0:     Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
sl@0:     if (oemId->wProcessorArchitecture < NUMPROCESSORS) {
sl@0: 	Tcl_SetVar2(interp, "tcl_platform", "machine",
sl@0: 		processors[oemId->wProcessorArchitecture],
sl@0: 		TCL_GLOBAL_ONLY);
sl@0:     }
sl@0: 
sl@0: #ifdef _DEBUG
sl@0:     /*
sl@0:      * The existence of the "debug" element of the tcl_platform array indicates
sl@0:      * that this particular Tcl shell has been compiled with debug information.
sl@0:      * Using "info exists tcl_platform(debug)" a Tcl script can direct the 
sl@0:      * interpreter to load debug versions of DLLs with the load command.
sl@0:      */
sl@0: 
sl@0:     Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
sl@0: 	    TCL_GLOBAL_ONLY);
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
sl@0:      * environment variables, if necessary.
sl@0:      */
sl@0: 
sl@0:     Tcl_DStringInit(&ds);
sl@0:     ptr = Tcl_GetVar2(interp, "env", "HOME", TCL_GLOBAL_ONLY);
sl@0:     if (ptr == NULL) {
sl@0: 	ptr = Tcl_GetVar2(interp, "env", "HOMEDRIVE", TCL_GLOBAL_ONLY);
sl@0: 	if (ptr != NULL) {
sl@0: 	    Tcl_DStringAppend(&ds, ptr, -1);
sl@0: 	}
sl@0: 	ptr = Tcl_GetVar2(interp, "env", "HOMEPATH", TCL_GLOBAL_ONLY);
sl@0: 	if (ptr != NULL) {
sl@0: 	    Tcl_DStringAppend(&ds, ptr, -1);
sl@0: 	}
sl@0: 	if (Tcl_DStringLength(&ds) > 0) {
sl@0: 	    Tcl_SetVar2(interp, "env", "HOME", Tcl_DStringValue(&ds),
sl@0: 		    TCL_GLOBAL_ONLY);
sl@0: 	} else {
sl@0: 	    Tcl_SetVar2(interp, "env", "HOME", "c:\\", TCL_GLOBAL_ONLY);
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Initialize the user name from the environment first, since this is much
sl@0:      * faster than asking the system.
sl@0:      */
sl@0: 
sl@0:     Tcl_DStringInit( &ds );
sl@0:     if (TclGetEnv("USERNAME", &ds) == NULL) {
sl@0: 
sl@0: 	if ( GetUserName( szUserName, &dwUserNameLen ) != 0 ) {
sl@0: 	    Tcl_WinTCharToUtf( szUserName, dwUserNameLen, &ds );
sl@0: 	}	
sl@0:     }
sl@0:     Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
sl@0: 	    TCL_GLOBAL_ONLY);
sl@0:     Tcl_DStringFree(&ds);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFindVariable --
sl@0:  *
sl@0:  *	Locate the entry in environ for a given name.  On Unix this 
sl@0:  *	routine is case sensetive, on Windows this matches mioxed case.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is the index in environ of an entry with the
sl@0:  *	name "name", or -1 if there is no such entry.   The integer at
sl@0:  *	*lengthPtr is filled in with the length of name (if a matching
sl@0:  *	entry is found) or the length of the environ array (if no matching
sl@0:  *	entry is found).
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclpFindVariable(name, lengthPtr)
sl@0:     CONST char *name;		/* Name of desired environment variable
sl@0: 				 * (UTF-8). */
sl@0:     int *lengthPtr;		/* Used to return length of name (for
sl@0: 				 * successful searches) or number of non-NULL
sl@0: 				 * entries in environ (for unsuccessful
sl@0: 				 * searches). */
sl@0: {
sl@0:     int i, length, result = -1;
sl@0:     register CONST char *env, *p1, *p2;
sl@0:     char *envUpper, *nameUpper;
sl@0:     Tcl_DString envString;
sl@0: 
sl@0:     /*
sl@0:      * Convert the name to all upper case for the case insensitive
sl@0:      * comparison.
sl@0:      */
sl@0: 
sl@0:     length = strlen(name);
sl@0:     nameUpper = (char *) ckalloc((unsigned) length+1);
sl@0:     memcpy((VOID *) nameUpper, (VOID *) name, (size_t) length+1);
sl@0:     Tcl_UtfToUpper(nameUpper);
sl@0:     
sl@0:     Tcl_DStringInit(&envString);
sl@0:     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
sl@0: 	/*
sl@0: 	 * Chop the env string off after the equal sign, then Convert
sl@0: 	 * the name to all upper case, so we do not have to convert
sl@0: 	 * all the characters after the equal sign.
sl@0: 	 */
sl@0: 	
sl@0: 	envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
sl@0: 	p1 = strchr(envUpper, '=');
sl@0: 	if (p1 == NULL) {
sl@0: 	    continue;
sl@0: 	}
sl@0: 	length = (int) (p1 - envUpper);
sl@0: 	Tcl_DStringSetLength(&envString, length+1);
sl@0: 	Tcl_UtfToUpper(envUpper);
sl@0: 
sl@0: 	p1 = envUpper;
sl@0: 	p2 = nameUpper;
sl@0: 	for (; *p2 == *p1; p1++, p2++) {
sl@0: 	    /* NULL loop body. */
sl@0: 	}
sl@0: 	if ((*p1 == '=') && (*p2 == '\0')) {
sl@0: 	    *lengthPtr = length;
sl@0: 	    result = i;
sl@0: 	    goto done;
sl@0: 	}
sl@0: 	
sl@0: 	Tcl_DStringFree(&envString);
sl@0:     }
sl@0:     
sl@0:     *lengthPtr = i;
sl@0: 
sl@0:     done:
sl@0:     Tcl_DStringFree(&envString);
sl@0:     ckfree(nameUpper);
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_Init --
sl@0:  *
sl@0:  *	This procedure is typically invoked by Tcl_AppInit procedures
sl@0:  *	to perform additional initialization for a Tcl interpreter,
sl@0:  *	such as sourcing the "init.tcl" script.
sl@0:  *
sl@0:  * Results:
sl@0:  *	Returns a standard Tcl completion code and sets the interp's
sl@0:  *	result if there is an error.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Depends on what's in the init.tcl script.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: Tcl_Init(interp)
sl@0:     Tcl_Interp *interp;		/* Interpreter to initialize. */
sl@0: {
sl@0:     Tcl_Obj *pathPtr;
sl@0: 
sl@0:     if (tclPreInitScript != NULL) {
sl@0: 	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
sl@0: 	    return (TCL_ERROR);
sl@0: 	};
sl@0:     }
sl@0: 
sl@0:     pathPtr = TclGetLibraryPath();
sl@0:     if (pathPtr == NULL) {
sl@0: 	pathPtr = Tcl_NewObj();
sl@0:     }
sl@0:     Tcl_IncrRefCount(pathPtr);    
sl@0:     Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
sl@0:     Tcl_DecrRefCount(pathPtr);    
sl@0:     return Tcl_Eval(interp, initScript);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_SourceRCFile --
sl@0:  *
sl@0:  *	This procedure is typically invoked by Tcl_Main of Tk_Main
sl@0:  *	procedure to source an application specific rc file into the
sl@0:  *	interpreter at startup time.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Depends on what's in the rc script.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_SourceRCFile(interp)
sl@0:     Tcl_Interp *interp;		/* Interpreter to source rc file into. */
sl@0: {
sl@0:     Tcl_DString temp;
sl@0:     CONST char *fileName;
sl@0:     Tcl_Channel errChannel;
sl@0: 
sl@0:     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
sl@0: 
sl@0:     if (fileName != NULL) {
sl@0:         Tcl_Channel c;
sl@0: 	CONST char *fullName;
sl@0: 
sl@0:         Tcl_DStringInit(&temp);
sl@0: 	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
sl@0: 	if (fullName == NULL) {
sl@0: 	    /*
sl@0: 	     * Couldn't translate the file name (e.g. it referred to a
sl@0: 	     * bogus user or there was no HOME environment variable).
sl@0: 	     * Just do nothing.
sl@0: 	     */
sl@0: 	} else {
sl@0: 
sl@0: 	    /*
sl@0: 	     * Test for the existence of the rc file before trying to read it.
sl@0: 	     */
sl@0: 
sl@0:             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
sl@0:             if (c != (Tcl_Channel) NULL) {
sl@0:                 Tcl_Close(NULL, c);
sl@0: 		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
sl@0: 		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0: 		    if (errChannel) {
sl@0: 			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0: 			Tcl_WriteChars(errChannel, "\n", 1);
sl@0: 		    }
sl@0: 		}
sl@0: 	    }
sl@0: 	}
sl@0:         Tcl_DStringFree(&temp);
sl@0:     }
sl@0: }