sl@0: /* sl@0: * tclUnixInit.c -- sl@0: * sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * sl@0: * Contains the Unix-specific interpreter initialization functions. sl@0: * sl@0: * Copyright (c) 1995-1997 Sun Microsystems, Inc. sl@0: * Copyright (c) 1999 by Scriptics Corporation. sl@0: * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved. sl@0: * All rights reserved. sl@0: * sl@0: * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.15 2007/04/29 02:19:51 das Exp $ sl@0: */ sl@0: sl@0: #if defined(HAVE_COREFOUNDATION) sl@0: #include sl@0: #endif sl@0: #include "tclInt.h" sl@0: #include "tclPort.h" sl@0: #include sl@0: #ifdef HAVE_LANGINFO sl@0: # include sl@0: # ifdef __APPLE__ sl@0: # if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030 sl@0: /* Support for weakly importing nl_langinfo on Darwin. */ sl@0: # define WEAK_IMPORT_NL_LANGINFO sl@0: extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE; sl@0: # endif sl@0: # endif sl@0: #endif sl@0: #if defined(__FreeBSD__) && defined(__GNUC__) sl@0: # include sl@0: #endif sl@0: #if defined(__bsdi__) sl@0: # include sl@0: # if _BSDI_VERSION > 199501 sl@0: # include sl@0: # endif sl@0: #endif sl@0: sl@0: #if defined(__SYMBIAN32__) sl@0: #include "tclSymbianGlobals.h" sl@0: #include "convertPathSlashes.h" sl@0: #endif 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: #include "tclInitScript.h" 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: * Tcl tries to use standard and homebrew methods to guess the right sl@0: * encoding on the platform. However, there is always a final fallback, sl@0: * and this value is it. Make sure it is a real Tcl encoding. sl@0: */ sl@0: sl@0: #ifndef TCL_DEFAULT_ENCODING sl@0: #define TCL_DEFAULT_ENCODING "iso8859-1" sl@0: #endif sl@0: sl@0: /* sl@0: * Default directory in which to look for Tcl library scripts. The sl@0: * symbol is defined by Makefile. sl@0: */ sl@0: #ifdef __SYMBIAN32__ sl@0: // building one *.exe, giving substitute values to tclUnixInt.c (l#65) to bypass compiler errors for 'normal' install. sl@0: // IMPORTANT NOTE: tcl uses unix-style slashes _inside_ tcl. sl@0: #ifndef TCL_LIBRARY sl@0: #define TCL_LIBRARY "C:/private/00000000/library/" sl@0: #endif sl@0: #endif sl@0: sl@0: static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY; sl@0: sl@0: /* sl@0: * Directory in which to look for packages (each package is typically sl@0: * installed as a subdirectory of this directory). The symbol is sl@0: * defined by Makefile. sl@0: */ sl@0: #ifdef __SYMBIAN32__ sl@0: // building one *.exe, giving substitute values to tclUnixInt.c (l#65) to bypass compiler errors for 'normal' install. sl@0: // IMPORTANT NOTE: tcl uses unix-style slashes _insode_ tcl. sl@0: #ifndef TCL_PACKAGE_PATH sl@0: #define TCL_PACKAGE_PATH "C:/private/00000000/" sl@0: #endif sl@0: #endif sl@0: sl@0: static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH; sl@0: sl@0: /* sl@0: * The following table is used to map from Unix locale strings to sl@0: * encoding files. If HAVE_LANGINFO is defined, then this is a fallback sl@0: * table when the result from nl_langinfo isn't a recognized encoding. sl@0: * Otherwise this is the first list checked for a mapping from env sl@0: * encoding to Tcl encoding name. sl@0: */ sl@0: sl@0: typedef struct LocaleTable { sl@0: CONST char *lang; sl@0: CONST char *encoding; sl@0: } LocaleTable; sl@0: sl@0: static CONST LocaleTable localeTable[] = { sl@0: #ifdef HAVE_LANGINFO sl@0: {"gb2312-1980", "gb2312"}, sl@0: {"ansi-1251", "cp1251"}, /* Solaris gets this wrong. */ sl@0: #ifdef __hpux sl@0: {"SJIS", "shiftjis"}, sl@0: {"eucjp", "euc-jp"}, sl@0: {"euckr", "euc-kr"}, sl@0: {"euctw", "euc-cn"}, sl@0: {"greek8", "cp869"}, sl@0: {"iso88591", "iso8859-1"}, sl@0: {"iso88592", "iso8859-2"}, sl@0: {"iso88595", "iso8859-5"}, sl@0: {"iso88596", "iso8859-6"}, sl@0: {"iso88597", "iso8859-7"}, sl@0: {"iso88598", "iso8859-8"}, sl@0: {"iso88599", "iso8859-9"}, sl@0: {"iso885915", "iso8859-15"}, sl@0: {"roman8", "iso8859-1"}, sl@0: {"tis620", "tis-620"}, sl@0: {"turkish8", "cp857"}, sl@0: {"utf8", "utf-8"}, sl@0: #endif /* __hpux */ sl@0: #endif /* HAVE_LANGINFO */ sl@0: sl@0: {"ja_JP.SJIS", "shiftjis"}, sl@0: {"ja_JP.EUC", "euc-jp"}, sl@0: {"ja_JP.eucJP", "euc-jp"}, sl@0: {"ja_JP.JIS", "iso2022-jp"}, sl@0: {"ja_JP.mscode", "shiftjis"}, sl@0: {"ja_JP.ujis", "euc-jp"}, sl@0: {"ja_JP", "euc-jp"}, sl@0: {"Ja_JP", "shiftjis"}, sl@0: {"Jp_JP", "shiftjis"}, sl@0: {"japan", "euc-jp"}, sl@0: #ifdef hpux sl@0: {"japanese", "shiftjis"}, sl@0: {"ja", "shiftjis"}, sl@0: #else sl@0: {"japanese", "euc-jp"}, sl@0: {"ja", "euc-jp"}, sl@0: #endif sl@0: {"japanese.sjis", "shiftjis"}, sl@0: {"japanese.euc", "euc-jp"}, sl@0: {"japanese-sjis", "shiftjis"}, sl@0: {"japanese-ujis", "euc-jp"}, sl@0: sl@0: {"ko", "euc-kr"}, sl@0: {"ko_KR", "euc-kr"}, sl@0: {"ko_KR.EUC", "euc-kr"}, sl@0: {"ko_KR.euc", "euc-kr"}, sl@0: {"ko_KR.eucKR", "euc-kr"}, sl@0: {"korean", "euc-kr"}, sl@0: sl@0: {"ru", "iso8859-5"}, sl@0: {"ru_RU", "iso8859-5"}, sl@0: {"ru_SU", "iso8859-5"}, sl@0: sl@0: {"zh", "cp936"}, sl@0: {"zh_CN.gb2312", "euc-cn"}, sl@0: {"zh_CN.GB2312", "euc-cn"}, sl@0: {"zh_CN.GBK", "euc-cn"}, sl@0: {"zh_TW.Big5", "big5"}, sl@0: {"zh_TW", "euc-tw"}, sl@0: sl@0: {NULL, NULL} sl@0: }; sl@0: sl@0: #ifdef HAVE_COREFOUNDATION sl@0: static int MacOSXGetLibraryPath _ANSI_ARGS_(( sl@0: Tcl_Interp *interp, int maxPathLen, sl@0: char *tclLibPath)); sl@0: #endif /* HAVE_COREFOUNDATION */ sl@0: #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \ sl@0: defined(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ sl@0: MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( \ sl@0: defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ sl@0: MAC_OS_X_VERSION_MIN_REQUIRED < 1050)) sl@0: /* sl@0: * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c: sl@0: * initialize release global at startup from uname(). sl@0: */ sl@0: #define GET_DARWIN_RELEASE 1 sl@0: long tclMacOSXDarwinRelease = 0; sl@0: #endif sl@0: 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: #if defined(__SYMBIAN32__) sl@0: // we need to use Windows file and path name convention with unix code. sl@0: tclPlatform = TCL_PLATFORM_WINDOWS; sl@0: #else sl@0: tclPlatform = TCL_PLATFORM_UNIX; sl@0: #endif sl@0: sl@0: /* sl@0: * Make sure, that the standard FDs exist. [Bug 772288] sl@0: */ sl@0: if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { sl@0: open("/dev/null", O_RDONLY); sl@0: } sl@0: if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { sl@0: open("/dev/null", O_WRONLY); sl@0: } sl@0: if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) { sl@0: open("/dev/null", O_WRONLY); sl@0: } sl@0: sl@0: /* sl@0: * The code below causes SIGPIPE (broken pipe) errors to sl@0: * be ignored. This is needed so that Tcl processes don't sl@0: * die if they create child processes (e.g. using "exec" or sl@0: * "open") that terminate prematurely. The signal handler sl@0: * is only set up when the first interpreter is created; sl@0: * after this the application can override the handler with sl@0: * a different one of its own, if it wants. sl@0: */ sl@0: sl@0: #ifdef SIGPIPE sl@0: (void) signal(SIGPIPE, SIG_IGN); sl@0: #endif /* SIGPIPE */ sl@0: sl@0: #if defined(__FreeBSD__) && defined(__GNUC__) sl@0: /* sl@0: * Adjust the rounding mode to be more conventional. Note that FreeBSD sl@0: * only provides the __fpsetreg() used by the following two for the GNU sl@0: * Compiler. When using, say, Intel's icc they break. (Partially based on sl@0: * patch in BSD ports system from root@celsius.bychok.com) sl@0: */ sl@0: sl@0: fpsetround(FP_RN); sl@0: fpsetmask(0L); sl@0: #endif sl@0: sl@0: #if defined(__bsdi__) && (_BSDI_VERSION > 199501) sl@0: /* sl@0: * Find local symbols. Don't report an error if we fail. sl@0: */ sl@0: (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */ sl@0: #endif sl@0: sl@0: #ifdef GET_DARWIN_RELEASE sl@0: { sl@0: struct utsname name; sl@0: if (!uname(&name)) { sl@0: tclMacOSXDarwinRelease = strtol(name.release, NULL, 10); sl@0: } sl@0: } 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. We have a minor sl@0: * metacircular problem that we don't know the encoding of the sl@0: * operating system but we may need to talk to operating system sl@0: * to find the library directories so that we know how to talk to sl@0: * the operating system. sl@0: * sl@0: * We do not know the encoding of the operating system. sl@0: * We do know that the encoding is some multibyte encoding. sl@0: * In that multibyte encoding, the characters 0..127 are equivalent sl@0: * to ascii. sl@0: * sl@0: * So although we don't know the encoding, it's safe: sl@0: * to look for the last slash character in a path in the encoding. sl@0: * to append an ascii string to a path. sl@0: * to pass those strings back to the operating system. sl@0: * sl@0: * But any strings that we remembered before we knew the encoding of sl@0: * the operating system must be translated to UTF-8 once we know the sl@0: * encoding so that the rest of Tcl can use those strings. sl@0: * sl@0: * This call sets the library path to strings in the unknown native sl@0: * encoding. TclpSetInitialEncodings() will translate the library sl@0: * path from the native encoding to UTF-8 as soon as it determines sl@0: * what the native encoding actually is. sl@0: * sl@0: * Called at process initialization time. sl@0: * sl@0: * Results: sl@0: * Return 1, indicating that the UTF may be dirty and require "cleanup" sl@0: * after encodings are initialized. 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; /* Path to the executable in native sl@0: * multi-byte encoding. */ sl@0: { sl@0: #define LIBRARY_SIZE 32 sl@0: Tcl_Obj *pathPtr, *objPtr; sl@0: CONST char *str; sl@0: Tcl_DString buffer, ds; sl@0: int pathc; sl@0: CONST char **pathv; sl@0: char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE]; sl@0: #ifdef __SYMBIAN32__ sl@0: int retEnv; sl@0: char homeEnvVariableBuf[LIBRARY_SIZE]; sl@0: char *homeEnvVariableStr; sl@0: #endif 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: #ifdef __SYMBIAN32__ sl@0: // add setenv so that tcl has access to the TCL_LIBRARY "system" environment var. (It can also be accessed from *.tcl scripts.) sl@0: if (!getenv("HOME")) { sl@0: homeEnvVariableStr = getcwd(homeEnvVariableBuf, LIBRARY_SIZE); sl@0: if (!homeEnvVariableStr) { sl@0: fprintf(stderr, "Error getting cwd, defaulting to SYMB_TCL_DEFAULT_HOME_DIR.\r\n"); sl@0: } sl@0: /* TODO - the line bellow is a temporary patch. The defect number is: DEF116621. */ sl@0: homeEnvVariableBuf[0] = 'c'; sl@0: tclCopySymbianPathSlashConversion(TO_TCL, homeEnvVariableStr, homeEnvVariableStr); sl@0: retEnv = setenv("HOME", homeEnvVariableStr, 1); sl@0: if (retEnv == -1) sl@0: { sl@0: fprintf(stderr, "Error setting env(HOME)\r\n"); sl@0: } sl@0: } sl@0: // add setenv so that tcl has access to the TCL_LIBRARY "system" environment var. (It can also be accessed from *.tcl scripts.) sl@0: retEnv = setenv("TCL_LIBRARY", TCL_LIBRARY, 1); sl@0: if (retEnv == -1) sl@0: { sl@0: fprintf(stderr, "Error setting env(TCL_LIBRARY)\r\n"); sl@0: } sl@0: // add setenv so that tcl has access to the TCL_LIBRARY "system" environment var 'tcllibpath' in init.tcl. (It can also be accessed from *.tcl scripts.) sl@0: retEnv = setenv("TCLLIBPATH", TCL_LIBRARY, 1); sl@0: if (retEnv == -1) sl@0: { sl@0: fprintf(stderr, "Error setting env(TCLLIBPATH)\r\n"); sl@0: } sl@0: #endif sl@0: str = getenv("TCL_LIBRARY"); /* INTL: Native. */ sl@0: Tcl_ExternalToUtfDString(NULL, str, -1, &buffer); sl@0: str = Tcl_DStringValue(&buffer); sl@0: sl@0: if ((str != NULL) && (str[0] != '\0')) { sl@0: /* sl@0: * If TCL_LIBRARY is set, search there. sl@0: */ sl@0: sl@0: objPtr = Tcl_NewStringObj(str, -1); sl@0: Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); sl@0: sl@0: Tcl_SplitPath(str, &pathc, &pathv); sl@0: if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) { sl@0: /* sl@0: * If 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] = installLib + 4; sl@0: str = Tcl_JoinPath(pathc, pathv, &ds); sl@0: objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); sl@0: Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: ckfree((char *) pathv); 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: * /../ sl@0: * (e.g. /usr/local/bin/../lib/tcl8.4) sl@0: * /../../ sl@0: * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4) sl@0: * /../library sl@0: * (e.g. /usr/src/tcl8.4.0/unix/../library) sl@0: * /../../library sl@0: * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library) sl@0: * /../../ sl@0: * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library) sl@0: * /../../../ sl@0: * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library) sl@0: */ 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: #ifndef __SYMBIAN32__ 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: #endif sl@0: sl@0: /* sl@0: * Finally, look for the library relative to the compiled-in path. sl@0: * This is needed when users install Tcl with an exec-prefix that sl@0: * is different from the prtefix. sl@0: */ sl@0: sl@0: { sl@0: #ifdef HAVE_COREFOUNDATION sl@0: char tclLibPath[MAXPATHLEN + 1]; sl@0: sl@0: if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) { sl@0: str = tclLibPath; sl@0: } else sl@0: #endif /* HAVE_COREFOUNDATION */ sl@0: { sl@0: str = defaultLibraryDir; sl@0: } sl@0: if (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: TclSetLibraryPath(pathPtr); sl@0: Tcl_DStringFree(&buffer); sl@0: sl@0: return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */ 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 = NULL; sl@0: int i, setSysEncCode = TCL_ERROR; sl@0: Tcl_Obj *pathPtr; sl@0: sl@0: /* sl@0: * Determine the current encoding from the LC_* or LANG environment sl@0: * variables. We previously used setlocale() to determine the locale, sl@0: * but this does not work on some systems (e.g. Linux/i386 RH 5.0). sl@0: */ sl@0: #ifdef HAVE_LANGINFO sl@0: if ( sl@0: #ifdef WEAK_IMPORT_NL_LANGINFO sl@0: nl_langinfo != NULL && sl@0: #endif sl@0: setlocale(LC_CTYPE, "") != NULL) { sl@0: Tcl_DString ds; sl@0: sl@0: /* sl@0: * Use a DString so we can overwrite it in name compatability sl@0: * checks below. sl@0: */ sl@0: sl@0: Tcl_DStringInit(&ds); sl@0: encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1); sl@0: sl@0: Tcl_UtfToLower(Tcl_DStringValue(&ds)); sl@0: #ifdef HAVE_LANGINFO_DEBUG sl@0: fprintf(stderr, "encoding '%s'\r\n", encoding); sl@0: #endif sl@0: if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o' sl@0: && encoding[3] == '-') { sl@0: char *p, *q; sl@0: /* need to strip '-' from iso-* encoding */ sl@0: for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4; sl@0: *p; *p++ = *q++); sl@0: } else if (encoding[0] == 'i' && encoding[1] == 'b' sl@0: && encoding[2] == 'm' && encoding[3] >= '0' sl@0: && encoding[3] <= '9') { sl@0: char *p, *q; sl@0: /* if langinfo reports "ibm*" we should use "cp*" */ sl@0: p = Tcl_DStringValue(&ds); sl@0: *p++ = 'c'; *p++ = 'p'; sl@0: for(q = p+1; *p ; *p++ = *q++); sl@0: } else if ((*encoding == '\0') sl@0: || !strcmp(encoding, "ansi_x3.4-1968")) { sl@0: /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */ sl@0: encoding = "iso8859-1"; sl@0: } sl@0: #ifdef HAVE_LANGINFO_DEBUG sl@0: fprintf(stderr, " ?%s?\r\n", encoding); sl@0: #endif sl@0: setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding); sl@0: if (setSysEncCode != TCL_OK) { sl@0: /* sl@0: * If this doesn't return TCL_OK, the encoding returned by sl@0: * nl_langinfo or as we translated it wasn't accepted. Do sl@0: * this fallback check. If this fails, we will enter the sl@0: * old fallback below. sl@0: */ sl@0: sl@0: for (i = 0; localeTable[i].lang != NULL; i++) { sl@0: if (strcmp(localeTable[i].lang, encoding) == 0) { sl@0: setSysEncCode = Tcl_SetSystemEncoding(NULL, sl@0: localeTable[i].encoding); sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: #ifdef HAVE_LANGINFO_DEBUG sl@0: fprintf(stderr, " => '%s'\n", encoding); sl@0: #endif sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: #ifdef HAVE_LANGINFO_DEBUG sl@0: else { sl@0: fprintf(stderr, "setlocale returned NULL\n"); sl@0: } sl@0: #endif sl@0: #endif /* HAVE_LANGINFO */ sl@0: sl@0: if (setSysEncCode != TCL_OK) { sl@0: /* sl@0: * Classic fallback check. This tries a homebrew algorithm to sl@0: * determine what encoding should be used based on env vars. sl@0: */ sl@0: char *langEnv = getenv("LC_ALL"); sl@0: encoding = NULL; sl@0: sl@0: if (langEnv == NULL || langEnv[0] == '\0') { sl@0: langEnv = getenv("LC_CTYPE"); sl@0: } sl@0: if (langEnv == NULL || langEnv[0] == '\0') { sl@0: langEnv = getenv("LANG"); sl@0: } sl@0: if (langEnv == NULL || langEnv[0] == '\0') { sl@0: langEnv = NULL; sl@0: } sl@0: sl@0: if (langEnv != NULL) { sl@0: for (i = 0; localeTable[i].lang != NULL; i++) { sl@0: if (strcmp(localeTable[i].lang, langEnv) == 0) { sl@0: encoding = localeTable[i].encoding; sl@0: break; sl@0: } sl@0: } sl@0: /* sl@0: * There was no mapping in the locale table. If there is an sl@0: * encoding subfield, we can try to guess from that. sl@0: */ sl@0: sl@0: if (encoding == NULL) { sl@0: char *p; sl@0: for (p = langEnv; *p != '\0'; p++) { sl@0: if (*p == '.') { sl@0: p++; sl@0: break; sl@0: } sl@0: } sl@0: if (*p != '\0') { sl@0: Tcl_DString ds; sl@0: Tcl_DStringInit(&ds); sl@0: encoding = Tcl_DStringAppend(&ds, p, -1); sl@0: sl@0: Tcl_UtfToLower(Tcl_DStringValue(&ds)); sl@0: setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding); sl@0: if (setSysEncCode != TCL_OK) { sl@0: encoding = NULL; sl@0: } sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: } sl@0: #ifdef HAVE_LANGINFO_DEBUG sl@0: fprintf(stderr, "encoding fallback check '%s' => '%s'\n", sl@0: langEnv, encoding); sl@0: #endif sl@0: } sl@0: if (setSysEncCode != TCL_OK) { sl@0: if (encoding == NULL) { sl@0: encoding = TCL_DEFAULT_ENCODING; sl@0: } sl@0: sl@0: Tcl_SetSystemEncoding(NULL, encoding); sl@0: } sl@0: sl@0: /* sl@0: * Initialize the C library's locale subsystem. This is required sl@0: * for input methods to work properly on X11. We only do this for sl@0: * LC_CTYPE because that's the necessary one, and we don't want to sl@0: * affect LC_TIME here. The side effect of setting the default sl@0: * locale should be to load any locale specific modules that are sl@0: * needed by X. [BUG: 5422 3345 4236 2522 2521]. sl@0: * In HAVE_LANGINFO, this call is already done above. sl@0: */ sl@0: #ifndef HAVE_LANGINFO sl@0: setlocale(LC_CTYPE, ""); sl@0: #endif sl@0: } sl@0: sl@0: /* sl@0: * In case the initial locale is not "C", ensure that the numeric sl@0: * processing is done in "C" locale regardless. This is needed because sl@0: * Tcl relies on routines like strtod, but should not have locale sl@0: * dependent behavior. sl@0: */ sl@0: sl@0: setlocale(LC_NUMERIC, "C"); sl@0: sl@0: if ((libraryPathEncodingFixed == 0) && strcmp("identity", sl@0: Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) { sl@0: /* sl@0: * Until the system encoding was actually set, the library path was sl@0: * actually in the native multi-byte encoding, and not really UTF-8 sl@0: * as advertised. We cheated as follows: sl@0: * sl@0: * 1. It was safe to allow the Tcl_SetSystemEncoding() call to sl@0: * append the ASCII chars that make up the encoding's filename to sl@0: * the names (in the native encoding) of directories in the library sl@0: * path, since all Unix multi-byte encodings have ASCII in the sl@0: * beginning. sl@0: * sl@0: * 2. To open the encoding file, the native bytes in the file name sl@0: * were passed to the OS, without translating from UTF-8 to native, sl@0: * because the name was already in the native encoding. sl@0: * sl@0: * Now that the system encoding was actually successfully set, sl@0: * translate all the names in the library path to UTF-8. That way, sl@0: * next time we search the library path, we'll translate the names sl@0: * from UTF-8 to the system encoding which will be the native sl@0: * encoding. sl@0: */ sl@0: sl@0: pathPtr = TclGetLibraryPath(); sl@0: if (pathPtr != NULL) { sl@0: int 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: libraryPathEncodingFixed = 1; 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 the iso8859-1 encoding preloaded. The IO package uses sl@0: * it for gets on a binary channel. sl@0: */ sl@0: binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); 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_library and tcl_platform variables, and other platform- sl@0: * specific things. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl sl@0: * variables. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: TclpSetVariables(interp) sl@0: Tcl_Interp *interp; sl@0: { sl@0: #ifndef NO_UNAME sl@0: struct utsname name; sl@0: #endif sl@0: int unameOK; sl@0: CONST char *user; sl@0: Tcl_DString ds; sl@0: sl@0: #ifdef HAVE_COREFOUNDATION sl@0: char tclLibPath[MAXPATHLEN + 1]; sl@0: sl@0: #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020 sl@0: /* sl@0: * Set msgcat fallback locale to current CFLocale identifier. sl@0: */ sl@0: CFLocaleRef localeRef; sl@0: sl@0: if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL && sl@0: (localeRef = CFLocaleCopyCurrent())) { sl@0: CFStringRef locale = CFLocaleGetIdentifier(localeRef); sl@0: sl@0: if (locale) { sl@0: char loc[256]; sl@0: sl@0: if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) { sl@0: if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) { sl@0: Tcl_ResetResult(interp); sl@0: } sl@0: Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY); sl@0: } sl@0: } sl@0: CFRelease(localeRef); sl@0: } sl@0: #endif sl@0: sl@0: if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) { sl@0: CONST char *str; sl@0: Tcl_DString ds; sl@0: CFBundleRef bundleRef; sl@0: sl@0: Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, sl@0: TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, sl@0: TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", " ", sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds); sl@0: if ((str != NULL) && (str[0] != '\0')) { sl@0: char *p = Tcl_DStringValue(&ds); sl@0: /* convert DYLD_FRAMEWORK_PATH from colon to space separated */ sl@0: do { sl@0: if(*p == ':') *p = ' '; sl@0: } while (*p++); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds), sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", " ", sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: if ((bundleRef = CFBundleGetMainBundle())) { sl@0: CFURLRef frameworksURL; sl@0: Tcl_StatBuf statBuf; sl@0: if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) { sl@0: if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, sl@0: (unsigned char*) tclLibPath, MAXPATHLEN) && sl@0: ! TclOSstat(tclLibPath, &statBuf) && sl@0: S_ISDIR(statBuf.st_mode)) { sl@0: Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", " ", sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: } sl@0: CFRelease(frameworksURL); sl@0: } sl@0: if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) { sl@0: if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE, sl@0: (unsigned char*) tclLibPath, MAXPATHLEN) && sl@0: ! TclOSstat(tclLibPath, &statBuf) && sl@0: S_ISDIR(statBuf.st_mode)) { sl@0: Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", " ", sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: } sl@0: CFRelease(frameworksURL); sl@0: } sl@0: } sl@0: Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, sl@0: TCL_GLOBAL_ONLY | TCL_APPEND_VALUE); sl@0: } else sl@0: #endif /* HAVE_COREFOUNDATION */ sl@0: { sl@0: Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, sl@0: TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY); sl@0: } sl@0: sl@0: #ifdef DJGPP sl@0: Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY); sl@0: #else sl@0: Tcl_SetVar2(interp, "tcl_platform", "platform", "symbian", TCL_GLOBAL_ONLY); sl@0: #endif sl@0: unameOK = 0; sl@0: #ifndef NO_UNAME sl@0: if (uname(&name) >= 0) { sl@0: CONST char *native; sl@0: sl@0: unameOK = 1; sl@0: sl@0: native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds); sl@0: Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY); sl@0: Tcl_DStringFree(&ds); sl@0: sl@0: /* sl@0: * The following code is a special hack to handle differences in sl@0: * the way version information is returned by uname. On most sl@0: * systems the full version number is available in name.release. sl@0: * However, under AIX the major version number is in sl@0: * name.version and the minor version number is in name.release. sl@0: */ sl@0: sl@0: if ((strchr(name.release, '.') != NULL) sl@0: || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */ sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, sl@0: TCL_GLOBAL_ONLY); sl@0: } else { sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version, sl@0: TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".", sl@0: TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release, sl@0: TCL_GLOBAL_ONLY|TCL_APPEND_VALUE); sl@0: } sl@0: Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine, sl@0: TCL_GLOBAL_ONLY); sl@0: } sl@0: #ifdef __SYMBIAN32__ sl@0: // Symbian P.I.P.S. is a "flavour of" unix in that it's an emulation layer. sl@0: Tcl_SetVar2(interp, "tcl_platform", "osSystemName", name.sysname, TCL_GLOBAL_ONLY); sl@0: #endif sl@0: #endif sl@0: if (!unameOK) { sl@0: Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY); sl@0: } sl@0: sl@0: /* sl@0: * Copy USER or LOGNAME environment variable into tcl_platform(user) sl@0: */ sl@0: sl@0: Tcl_DStringInit(&ds); sl@0: user = TclGetEnv("USER", &ds); sl@0: if (user == NULL) { sl@0: user = TclGetEnv("LOGNAME", &ds); sl@0: if (user == NULL) { sl@0: user = ""; sl@0: } sl@0: } sl@0: Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY); sl@0: Tcl_DStringFree(&ds); sl@0: 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 mixed 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: * (native). */ 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, result = -1; sl@0: register CONST char *env, *p1, *p2; sl@0: Tcl_DString envString; sl@0: sl@0: Tcl_DStringInit(&envString); sl@0: for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { sl@0: p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); sl@0: p2 = name; sl@0: sl@0: for (; *p2 == *p1; p1++, p2++) { sl@0: /* NULL loop body. */ sl@0: } sl@0: if ((*p1 == '=') && (*p2 == '\0')) { sl@0: *lengthPtr = p2 - name; 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: 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 find and source the "init.tcl" script, which should exist sl@0: * somewhere on the Tcl library path. 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: EXPORT_C 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: EXPORT_C 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: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpCheckStackSpace -- sl@0: * sl@0: * Detect if we are about to blow the stack. Called before an sl@0: * evaluation can happen when nesting depth is checked. sl@0: * sl@0: * Results: sl@0: * 1 if there is enough stack space to continue; 0 if not. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: TclpCheckStackSpace() sl@0: { sl@0: /* sl@0: * This function is unimplemented on Unix platforms. sl@0: */ sl@0: sl@0: return 1; sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * MacOSXGetLibraryPath -- sl@0: * sl@0: * If we have a bundle structure for the Tcl installation, sl@0: * then check there first to see if we can find the libraries sl@0: * there. sl@0: * sl@0: * Results: sl@0: * TCL_OK if we have found the tcl library; TCL_ERROR otherwise. sl@0: * sl@0: * Side effects: sl@0: * Same as for Tcl_MacOSXOpenVersionedBundleResources. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: #ifdef HAVE_COREFOUNDATION sl@0: static int sl@0: MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath) sl@0: { sl@0: int foundInFramework = TCL_ERROR; sl@0: #ifdef TCL_FRAMEWORK sl@0: foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, sl@0: "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath); sl@0: #endif sl@0: return foundInFramework; sl@0: } sl@0: #endif /* HAVE_COREFOUNDATION */