os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixInit.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclUnixInit.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,1220 @@
1.4 +/*
1.5 + * tclUnixInit.c --
1.6 + *
1.7 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.8 + *
1.9 + * Contains the Unix-specific interpreter initialization functions.
1.10 + *
1.11 + * Copyright (c) 1995-1997 Sun Microsystems, Inc.
1.12 + * Copyright (c) 1999 by Scriptics Corporation.
1.13 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.14 + * All rights reserved.
1.15 + *
1.16 + * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.15 2007/04/29 02:19:51 das Exp $
1.17 + */
1.18 +
1.19 +#if defined(HAVE_COREFOUNDATION)
1.20 +#include <CoreFoundation/CoreFoundation.h>
1.21 +#endif
1.22 +#include "tclInt.h"
1.23 +#include "tclPort.h"
1.24 +#include <locale.h>
1.25 +#ifdef HAVE_LANGINFO
1.26 +# include <langinfo.h>
1.27 +# ifdef __APPLE__
1.28 +# if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
1.29 + /* Support for weakly importing nl_langinfo on Darwin. */
1.30 +# define WEAK_IMPORT_NL_LANGINFO
1.31 + extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
1.32 +# endif
1.33 +# endif
1.34 +#endif
1.35 +#if defined(__FreeBSD__) && defined(__GNUC__)
1.36 +# include <floatingpoint.h>
1.37 +#endif
1.38 +#if defined(__bsdi__)
1.39 +# include <sys/param.h>
1.40 +# if _BSDI_VERSION > 199501
1.41 +# include <dlfcn.h>
1.42 +# endif
1.43 +#endif
1.44 +
1.45 +#if defined(__SYMBIAN32__)
1.46 +#include "tclSymbianGlobals.h"
1.47 +#include "convertPathSlashes.h"
1.48 +#endif
1.49 +
1.50 +/*
1.51 + * The Init script (common to Windows and Unix platforms) is
1.52 + * defined in tkInitScript.h
1.53 + */
1.54 +#include "tclInitScript.h"
1.55 +
1.56 +/* Used to store the encoding used for binary files */
1.57 +static Tcl_Encoding binaryEncoding = NULL;
1.58 +/* Has the basic library path encoding issue been fixed */
1.59 +static int libraryPathEncodingFixed = 0;
1.60 +
1.61 +/*
1.62 + * Tcl tries to use standard and homebrew methods to guess the right
1.63 + * encoding on the platform. However, there is always a final fallback,
1.64 + * and this value is it. Make sure it is a real Tcl encoding.
1.65 + */
1.66 +
1.67 +#ifndef TCL_DEFAULT_ENCODING
1.68 +#define TCL_DEFAULT_ENCODING "iso8859-1"
1.69 +#endif
1.70 +
1.71 +/*
1.72 + * Default directory in which to look for Tcl library scripts. The
1.73 + * symbol is defined by Makefile.
1.74 + */
1.75 +#ifdef __SYMBIAN32__
1.76 +// building one *.exe, giving substitute values to tclUnixInt.c (l#65) to bypass compiler errors for 'normal' install.
1.77 +// IMPORTANT NOTE: tcl uses unix-style slashes _inside_ tcl.
1.78 +#ifndef TCL_LIBRARY
1.79 +#define TCL_LIBRARY "C:/private/00000000/library/"
1.80 +#endif
1.81 +#endif
1.82 +
1.83 +static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;
1.84 +
1.85 +/*
1.86 + * Directory in which to look for packages (each package is typically
1.87 + * installed as a subdirectory of this directory). The symbol is
1.88 + * defined by Makefile.
1.89 + */
1.90 +#ifdef __SYMBIAN32__
1.91 +// building one *.exe, giving substitute values to tclUnixInt.c (l#65) to bypass compiler errors for 'normal' install.
1.92 +// IMPORTANT NOTE: tcl uses unix-style slashes _insode_ tcl.
1.93 +#ifndef TCL_PACKAGE_PATH
1.94 +#define TCL_PACKAGE_PATH "C:/private/00000000/"
1.95 +#endif
1.96 +#endif
1.97 +
1.98 +static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
1.99 +
1.100 +/*
1.101 + * The following table is used to map from Unix locale strings to
1.102 + * encoding files. If HAVE_LANGINFO is defined, then this is a fallback
1.103 + * table when the result from nl_langinfo isn't a recognized encoding.
1.104 + * Otherwise this is the first list checked for a mapping from env
1.105 + * encoding to Tcl encoding name.
1.106 + */
1.107 +
1.108 +typedef struct LocaleTable {
1.109 + CONST char *lang;
1.110 + CONST char *encoding;
1.111 +} LocaleTable;
1.112 +
1.113 +static CONST LocaleTable localeTable[] = {
1.114 +#ifdef HAVE_LANGINFO
1.115 + {"gb2312-1980", "gb2312"},
1.116 + {"ansi-1251", "cp1251"}, /* Solaris gets this wrong. */
1.117 +#ifdef __hpux
1.118 + {"SJIS", "shiftjis"},
1.119 + {"eucjp", "euc-jp"},
1.120 + {"euckr", "euc-kr"},
1.121 + {"euctw", "euc-cn"},
1.122 + {"greek8", "cp869"},
1.123 + {"iso88591", "iso8859-1"},
1.124 + {"iso88592", "iso8859-2"},
1.125 + {"iso88595", "iso8859-5"},
1.126 + {"iso88596", "iso8859-6"},
1.127 + {"iso88597", "iso8859-7"},
1.128 + {"iso88598", "iso8859-8"},
1.129 + {"iso88599", "iso8859-9"},
1.130 + {"iso885915", "iso8859-15"},
1.131 + {"roman8", "iso8859-1"},
1.132 + {"tis620", "tis-620"},
1.133 + {"turkish8", "cp857"},
1.134 + {"utf8", "utf-8"},
1.135 +#endif /* __hpux */
1.136 +#endif /* HAVE_LANGINFO */
1.137 +
1.138 + {"ja_JP.SJIS", "shiftjis"},
1.139 + {"ja_JP.EUC", "euc-jp"},
1.140 + {"ja_JP.eucJP", "euc-jp"},
1.141 + {"ja_JP.JIS", "iso2022-jp"},
1.142 + {"ja_JP.mscode", "shiftjis"},
1.143 + {"ja_JP.ujis", "euc-jp"},
1.144 + {"ja_JP", "euc-jp"},
1.145 + {"Ja_JP", "shiftjis"},
1.146 + {"Jp_JP", "shiftjis"},
1.147 + {"japan", "euc-jp"},
1.148 +#ifdef hpux
1.149 + {"japanese", "shiftjis"},
1.150 + {"ja", "shiftjis"},
1.151 +#else
1.152 + {"japanese", "euc-jp"},
1.153 + {"ja", "euc-jp"},
1.154 +#endif
1.155 + {"japanese.sjis", "shiftjis"},
1.156 + {"japanese.euc", "euc-jp"},
1.157 + {"japanese-sjis", "shiftjis"},
1.158 + {"japanese-ujis", "euc-jp"},
1.159 +
1.160 + {"ko", "euc-kr"},
1.161 + {"ko_KR", "euc-kr"},
1.162 + {"ko_KR.EUC", "euc-kr"},
1.163 + {"ko_KR.euc", "euc-kr"},
1.164 + {"ko_KR.eucKR", "euc-kr"},
1.165 + {"korean", "euc-kr"},
1.166 +
1.167 + {"ru", "iso8859-5"},
1.168 + {"ru_RU", "iso8859-5"},
1.169 + {"ru_SU", "iso8859-5"},
1.170 +
1.171 + {"zh", "cp936"},
1.172 + {"zh_CN.gb2312", "euc-cn"},
1.173 + {"zh_CN.GB2312", "euc-cn"},
1.174 + {"zh_CN.GBK", "euc-cn"},
1.175 + {"zh_TW.Big5", "big5"},
1.176 + {"zh_TW", "euc-tw"},
1.177 +
1.178 + {NULL, NULL}
1.179 +};
1.180 +
1.181 +#ifdef HAVE_COREFOUNDATION
1.182 +static int MacOSXGetLibraryPath _ANSI_ARGS_((
1.183 + Tcl_Interp *interp, int maxPathLen,
1.184 + char *tclLibPath));
1.185 +#endif /* HAVE_COREFOUNDATION */
1.186 +#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
1.187 + defined(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
1.188 + MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( \
1.189 + defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
1.190 + MAC_OS_X_VERSION_MIN_REQUIRED < 1050))
1.191 +/*
1.192 + * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
1.193 + * initialize release global at startup from uname().
1.194 + */
1.195 +#define GET_DARWIN_RELEASE 1
1.196 +long tclMacOSXDarwinRelease = 0;
1.197 +#endif
1.198 +
1.199 +
1.200 +/*
1.201 + *---------------------------------------------------------------------------
1.202 + *
1.203 + * TclpInitPlatform --
1.204 + *
1.205 + * Initialize all the platform-dependant things like signals and
1.206 + * floating-point error handling.
1.207 + *
1.208 + * Called at process initialization time.
1.209 + *
1.210 + * Results:
1.211 + * None.
1.212 + *
1.213 + * Side effects:
1.214 + * None.
1.215 + *
1.216 + *---------------------------------------------------------------------------
1.217 + */
1.218 +
1.219 +void
1.220 +TclpInitPlatform()
1.221 +{
1.222 +#if defined(__SYMBIAN32__)
1.223 + // we need to use Windows file and path name convention with unix code.
1.224 + tclPlatform = TCL_PLATFORM_WINDOWS;
1.225 +#else
1.226 + tclPlatform = TCL_PLATFORM_UNIX;
1.227 +#endif
1.228 +
1.229 + /*
1.230 + * Make sure, that the standard FDs exist. [Bug 772288]
1.231 + */
1.232 + if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
1.233 + open("/dev/null", O_RDONLY);
1.234 + }
1.235 + if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
1.236 + open("/dev/null", O_WRONLY);
1.237 + }
1.238 + if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
1.239 + open("/dev/null", O_WRONLY);
1.240 + }
1.241 +
1.242 + /*
1.243 + * The code below causes SIGPIPE (broken pipe) errors to
1.244 + * be ignored. This is needed so that Tcl processes don't
1.245 + * die if they create child processes (e.g. using "exec" or
1.246 + * "open") that terminate prematurely. The signal handler
1.247 + * is only set up when the first interpreter is created;
1.248 + * after this the application can override the handler with
1.249 + * a different one of its own, if it wants.
1.250 + */
1.251 +
1.252 +#ifdef SIGPIPE
1.253 + (void) signal(SIGPIPE, SIG_IGN);
1.254 +#endif /* SIGPIPE */
1.255 +
1.256 +#if defined(__FreeBSD__) && defined(__GNUC__)
1.257 + /*
1.258 + * Adjust the rounding mode to be more conventional. Note that FreeBSD
1.259 + * only provides the __fpsetreg() used by the following two for the GNU
1.260 + * Compiler. When using, say, Intel's icc they break. (Partially based on
1.261 + * patch in BSD ports system from root@celsius.bychok.com)
1.262 + */
1.263 +
1.264 + fpsetround(FP_RN);
1.265 + fpsetmask(0L);
1.266 +#endif
1.267 +
1.268 +#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
1.269 + /*
1.270 + * Find local symbols. Don't report an error if we fail.
1.271 + */
1.272 + (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */
1.273 +#endif
1.274 +
1.275 +#ifdef GET_DARWIN_RELEASE
1.276 + {
1.277 + struct utsname name;
1.278 + if (!uname(&name)) {
1.279 + tclMacOSXDarwinRelease = strtol(name.release, NULL, 10);
1.280 + }
1.281 + }
1.282 +#endif
1.283 +}
1.284 +
1.285 +/*
1.286 + *---------------------------------------------------------------------------
1.287 + *
1.288 + * TclpInitLibraryPath --
1.289 + *
1.290 + * Initialize the library path at startup. We have a minor
1.291 + * metacircular problem that we don't know the encoding of the
1.292 + * operating system but we may need to talk to operating system
1.293 + * to find the library directories so that we know how to talk to
1.294 + * the operating system.
1.295 + *
1.296 + * We do not know the encoding of the operating system.
1.297 + * We do know that the encoding is some multibyte encoding.
1.298 + * In that multibyte encoding, the characters 0..127 are equivalent
1.299 + * to ascii.
1.300 + *
1.301 + * So although we don't know the encoding, it's safe:
1.302 + * to look for the last slash character in a path in the encoding.
1.303 + * to append an ascii string to a path.
1.304 + * to pass those strings back to the operating system.
1.305 + *
1.306 + * But any strings that we remembered before we knew the encoding of
1.307 + * the operating system must be translated to UTF-8 once we know the
1.308 + * encoding so that the rest of Tcl can use those strings.
1.309 + *
1.310 + * This call sets the library path to strings in the unknown native
1.311 + * encoding. TclpSetInitialEncodings() will translate the library
1.312 + * path from the native encoding to UTF-8 as soon as it determines
1.313 + * what the native encoding actually is.
1.314 + *
1.315 + * Called at process initialization time.
1.316 + *
1.317 + * Results:
1.318 + * Return 1, indicating that the UTF may be dirty and require "cleanup"
1.319 + * after encodings are initialized.
1.320 + *
1.321 + * Side effects:
1.322 + * None.
1.323 + *
1.324 + *---------------------------------------------------------------------------
1.325 + */
1.326 +
1.327 +int
1.328 +TclpInitLibraryPath(path)
1.329 +CONST char *path; /* Path to the executable in native
1.330 + * multi-byte encoding. */
1.331 +{
1.332 +#define LIBRARY_SIZE 32
1.333 + Tcl_Obj *pathPtr, *objPtr;
1.334 + CONST char *str;
1.335 + Tcl_DString buffer, ds;
1.336 + int pathc;
1.337 + CONST char **pathv;
1.338 + char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
1.339 +#ifdef __SYMBIAN32__
1.340 + int retEnv;
1.341 + char homeEnvVariableBuf[LIBRARY_SIZE];
1.342 + char *homeEnvVariableStr;
1.343 +#endif
1.344 +
1.345 + Tcl_DStringInit(&ds);
1.346 + pathPtr = Tcl_NewObj();
1.347 +
1.348 + /*
1.349 + * Initialize the substrings used when locating an executable. The
1.350 + * installLib variable computes the path as though the executable
1.351 + * is installed. The developLib computes the path as though the
1.352 + * executable is run from a develpment directory.
1.353 + */
1.354 +
1.355 + sprintf(installLib, "lib/tcl%s", TCL_VERSION);
1.356 + sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
1.357 +
1.358 + /*
1.359 + * Look for the library relative to default encoding dir.
1.360 + */
1.361 +
1.362 + str = Tcl_GetDefaultEncodingDir();
1.363 + if ((str != NULL) && (str[0] != '\0')) {
1.364 + objPtr = Tcl_NewStringObj(str, -1);
1.365 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.366 + }
1.367 +
1.368 + /*
1.369 + * Look for the library relative to the TCL_LIBRARY env variable.
1.370 + * If the last dirname in the TCL_LIBRARY path does not match the
1.371 + * last dirname in the installLib variable, use the last dir name
1.372 + * of installLib in addition to the orginal TCL_LIBRARY path.
1.373 + */
1.374 +
1.375 +#ifdef __SYMBIAN32__
1.376 + // add setenv so that tcl has access to the TCL_LIBRARY "system" environment var. (It can also be accessed from *.tcl scripts.)
1.377 + if (!getenv("HOME")) {
1.378 + homeEnvVariableStr = getcwd(homeEnvVariableBuf, LIBRARY_SIZE);
1.379 + if (!homeEnvVariableStr) {
1.380 + fprintf(stderr, "Error getting cwd, defaulting to SYMB_TCL_DEFAULT_HOME_DIR.\r\n");
1.381 + }
1.382 + /* TODO - the line bellow is a temporary patch. The defect number is: DEF116621. */
1.383 + homeEnvVariableBuf[0] = 'c';
1.384 + tclCopySymbianPathSlashConversion(TO_TCL, homeEnvVariableStr, homeEnvVariableStr);
1.385 + retEnv = setenv("HOME", homeEnvVariableStr, 1);
1.386 + if (retEnv == -1)
1.387 + {
1.388 + fprintf(stderr, "Error setting env(HOME)\r\n");
1.389 + }
1.390 + }
1.391 + // add setenv so that tcl has access to the TCL_LIBRARY "system" environment var. (It can also be accessed from *.tcl scripts.)
1.392 + retEnv = setenv("TCL_LIBRARY", TCL_LIBRARY, 1);
1.393 + if (retEnv == -1)
1.394 + {
1.395 + fprintf(stderr, "Error setting env(TCL_LIBRARY)\r\n");
1.396 + }
1.397 + // 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.)
1.398 + retEnv = setenv("TCLLIBPATH", TCL_LIBRARY, 1);
1.399 + if (retEnv == -1)
1.400 + {
1.401 + fprintf(stderr, "Error setting env(TCLLIBPATH)\r\n");
1.402 + }
1.403 +#endif
1.404 + str = getenv("TCL_LIBRARY"); /* INTL: Native. */
1.405 + Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
1.406 + str = Tcl_DStringValue(&buffer);
1.407 +
1.408 + if ((str != NULL) && (str[0] != '\0')) {
1.409 + /*
1.410 + * If TCL_LIBRARY is set, search there.
1.411 + */
1.412 +
1.413 + objPtr = Tcl_NewStringObj(str, -1);
1.414 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.415 +
1.416 + Tcl_SplitPath(str, &pathc, &pathv);
1.417 + if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
1.418 + /*
1.419 + * If TCL_LIBRARY is set but refers to a different tcl
1.420 + * installation than the current version, try fiddling with the
1.421 + * specified directory to make it refer to this installation by
1.422 + * removing the old "tclX.Y" and substituting the current
1.423 + * version string.
1.424 + */
1.425 +
1.426 + pathv[pathc - 1] = installLib + 4;
1.427 + str = Tcl_JoinPath(pathc, pathv, &ds);
1.428 + objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
1.429 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.430 + Tcl_DStringFree(&ds);
1.431 + }
1.432 + ckfree((char *) pathv);
1.433 + }
1.434 +
1.435 + /*
1.436 + * Look for the library relative to the executable. This algorithm
1.437 + * should be the same as the one in the tcl_findLibrary procedure.
1.438 + *
1.439 + * This code looks in the following directories:
1.440 + *
1.441 + * <bindir>/../<installLib>
1.442 + * (e.g. /usr/local/bin/../lib/tcl8.4)
1.443 + * <bindir>/../../<installLib>
1.444 + * (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
1.445 + * <bindir>/../library
1.446 + * (e.g. /usr/src/tcl8.4.0/unix/../library)
1.447 + * <bindir>/../../library
1.448 + * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
1.449 + * <bindir>/../../<developLib>
1.450 + * (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
1.451 + * <bindir>/../../../<developLib>
1.452 + * (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
1.453 + */
1.454 +
1.455 +
1.456 + /*
1.457 + * The variable path holds an absolute path. Take care not to
1.458 + * overwrite pathv[0] since that might produce a relative path.
1.459 + */
1.460 +#ifndef __SYMBIAN32__
1.461 + if (path != NULL) {
1.462 + int i, origc;
1.463 + CONST char **origv;
1.464 +
1.465 + Tcl_SplitPath(path, &origc, &origv);
1.466 + pathc = 0;
1.467 + pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
1.468 + for (i=0; i< origc; i++) {
1.469 + if (origv[i][0] == '.') {
1.470 + if (strcmp(origv[i], ".") == 0) {
1.471 + // do nothing //
1.472 + } else if (strcmp(origv[i], "..") == 0) {
1.473 + pathc--;
1.474 + } else {
1.475 + pathv[pathc++] = origv[i];
1.476 + }
1.477 + } else {
1.478 + pathv[pathc++] = origv[i];
1.479 + }
1.480 + }
1.481 + if (pathc > 2) {
1.482 + str = pathv[pathc - 2];
1.483 + pathv[pathc - 2] = installLib;
1.484 + path = Tcl_JoinPath(pathc - 1, pathv, &ds);
1.485 + pathv[pathc - 2] = str;
1.486 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.487 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.488 + Tcl_DStringFree(&ds);
1.489 + }
1.490 + if (pathc > 3) {
1.491 + str = pathv[pathc - 3];
1.492 + pathv[pathc - 3] = installLib;
1.493 + path = Tcl_JoinPath(pathc - 2, pathv, &ds);
1.494 + pathv[pathc - 3] = str;
1.495 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.496 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.497 + Tcl_DStringFree(&ds);
1.498 + }
1.499 + if (pathc > 2) {
1.500 + str = pathv[pathc - 2];
1.501 + pathv[pathc - 2] = "library";
1.502 + path = Tcl_JoinPath(pathc - 1, pathv, &ds);
1.503 + pathv[pathc - 2] = str;
1.504 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.505 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.506 + Tcl_DStringFree(&ds);
1.507 + }
1.508 + if (pathc > 3) {
1.509 + str = pathv[pathc - 3];
1.510 + pathv[pathc - 3] = "library";
1.511 + path = Tcl_JoinPath(pathc - 2, pathv, &ds);
1.512 + pathv[pathc - 3] = str;
1.513 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.514 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.515 + Tcl_DStringFree(&ds);
1.516 + }
1.517 + if (pathc > 3) {
1.518 + str = pathv[pathc - 3];
1.519 + pathv[pathc - 3] = developLib;
1.520 + path = Tcl_JoinPath(pathc - 2, pathv, &ds);
1.521 + pathv[pathc - 3] = str;
1.522 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.523 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.524 + Tcl_DStringFree(&ds);
1.525 + }
1.526 + if (pathc > 4) {
1.527 + str = pathv[pathc - 4];
1.528 + pathv[pathc - 4] = developLib;
1.529 + path = Tcl_JoinPath(pathc - 3, pathv, &ds);
1.530 + pathv[pathc - 4] = str;
1.531 + objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
1.532 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.533 + Tcl_DStringFree(&ds);
1.534 + }
1.535 + ckfree((char *) origv);
1.536 + ckfree((char *) pathv);
1.537 + }
1.538 +#endif
1.539 +
1.540 + /*
1.541 + * Finally, look for the library relative to the compiled-in path.
1.542 + * This is needed when users install Tcl with an exec-prefix that
1.543 + * is different from the prtefix.
1.544 + */
1.545 +
1.546 + {
1.547 +#ifdef HAVE_COREFOUNDATION
1.548 + char tclLibPath[MAXPATHLEN + 1];
1.549 +
1.550 + if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
1.551 + str = tclLibPath;
1.552 + } else
1.553 +#endif /* HAVE_COREFOUNDATION */
1.554 + {
1.555 + str = defaultLibraryDir;
1.556 + }
1.557 + if (str[0] != '\0') {
1.558 + objPtr = Tcl_NewStringObj(str, -1);
1.559 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.560 + }
1.561 + }
1.562 +
1.563 + TclSetLibraryPath(pathPtr);
1.564 + Tcl_DStringFree(&buffer);
1.565 +
1.566 + return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
1.567 +}
1.568 +
1.569 +/*
1.570 + *---------------------------------------------------------------------------
1.571 + *
1.572 + * TclpSetInitialEncodings --
1.573 + *
1.574 + * Based on the locale, determine the encoding of the operating
1.575 + * system and the default encoding for newly opened files.
1.576 + *
1.577 + * Called at process initialization time, and part way through
1.578 + * startup, we verify that the initial encodings were correctly
1.579 + * setup. Depending on Tcl's environment, there may not have been
1.580 + * enough information first time through (above).
1.581 + *
1.582 + * Results:
1.583 + * None.
1.584 + *
1.585 + * Side effects:
1.586 + * The Tcl library path is converted from native encoding to UTF-8,
1.587 + * on the first call, and the encodings may be changed on first or
1.588 + * second call.
1.589 + *
1.590 + *---------------------------------------------------------------------------
1.591 + */
1.592 +
1.593 +void
1.594 +TclpSetInitialEncodings()
1.595 +{
1.596 + CONST char *encoding = NULL;
1.597 + int i, setSysEncCode = TCL_ERROR;
1.598 + Tcl_Obj *pathPtr;
1.599 +
1.600 + /*
1.601 + * Determine the current encoding from the LC_* or LANG environment
1.602 + * variables. We previously used setlocale() to determine the locale,
1.603 + * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
1.604 + */
1.605 +#ifdef HAVE_LANGINFO
1.606 + if (
1.607 +#ifdef WEAK_IMPORT_NL_LANGINFO
1.608 + nl_langinfo != NULL &&
1.609 +#endif
1.610 + setlocale(LC_CTYPE, "") != NULL) {
1.611 + Tcl_DString ds;
1.612 +
1.613 + /*
1.614 + * Use a DString so we can overwrite it in name compatability
1.615 + * checks below.
1.616 + */
1.617 +
1.618 + Tcl_DStringInit(&ds);
1.619 + encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
1.620 +
1.621 + Tcl_UtfToLower(Tcl_DStringValue(&ds));
1.622 +#ifdef HAVE_LANGINFO_DEBUG
1.623 + fprintf(stderr, "encoding '%s'\r\n", encoding);
1.624 +#endif
1.625 + if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o'
1.626 + && encoding[3] == '-') {
1.627 + char *p, *q;
1.628 + /* need to strip '-' from iso-* encoding */
1.629 + for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4;
1.630 + *p; *p++ = *q++);
1.631 + } else if (encoding[0] == 'i' && encoding[1] == 'b'
1.632 + && encoding[2] == 'm' && encoding[3] >= '0'
1.633 + && encoding[3] <= '9') {
1.634 + char *p, *q;
1.635 + /* if langinfo reports "ibm*" we should use "cp*" */
1.636 + p = Tcl_DStringValue(&ds);
1.637 + *p++ = 'c'; *p++ = 'p';
1.638 + for(q = p+1; *p ; *p++ = *q++);
1.639 + } else if ((*encoding == '\0')
1.640 + || !strcmp(encoding, "ansi_x3.4-1968")) {
1.641 + /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */
1.642 + encoding = "iso8859-1";
1.643 + }
1.644 +#ifdef HAVE_LANGINFO_DEBUG
1.645 + fprintf(stderr, " ?%s?\r\n", encoding);
1.646 +#endif
1.647 + setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
1.648 + if (setSysEncCode != TCL_OK) {
1.649 + /*
1.650 + * If this doesn't return TCL_OK, the encoding returned by
1.651 + * nl_langinfo or as we translated it wasn't accepted. Do
1.652 + * this fallback check. If this fails, we will enter the
1.653 + * old fallback below.
1.654 + */
1.655 +
1.656 + for (i = 0; localeTable[i].lang != NULL; i++) {
1.657 + if (strcmp(localeTable[i].lang, encoding) == 0) {
1.658 + setSysEncCode = Tcl_SetSystemEncoding(NULL,
1.659 + localeTable[i].encoding);
1.660 + break;
1.661 + }
1.662 + }
1.663 + }
1.664 +#ifdef HAVE_LANGINFO_DEBUG
1.665 + fprintf(stderr, " => '%s'\n", encoding);
1.666 +#endif
1.667 + Tcl_DStringFree(&ds);
1.668 + }
1.669 +#ifdef HAVE_LANGINFO_DEBUG
1.670 + else {
1.671 + fprintf(stderr, "setlocale returned NULL\n");
1.672 + }
1.673 +#endif
1.674 +#endif /* HAVE_LANGINFO */
1.675 +
1.676 + if (setSysEncCode != TCL_OK) {
1.677 + /*
1.678 + * Classic fallback check. This tries a homebrew algorithm to
1.679 + * determine what encoding should be used based on env vars.
1.680 + */
1.681 + char *langEnv = getenv("LC_ALL");
1.682 + encoding = NULL;
1.683 +
1.684 + if (langEnv == NULL || langEnv[0] == '\0') {
1.685 + langEnv = getenv("LC_CTYPE");
1.686 + }
1.687 + if (langEnv == NULL || langEnv[0] == '\0') {
1.688 + langEnv = getenv("LANG");
1.689 + }
1.690 + if (langEnv == NULL || langEnv[0] == '\0') {
1.691 + langEnv = NULL;
1.692 + }
1.693 +
1.694 + if (langEnv != NULL) {
1.695 + for (i = 0; localeTable[i].lang != NULL; i++) {
1.696 + if (strcmp(localeTable[i].lang, langEnv) == 0) {
1.697 + encoding = localeTable[i].encoding;
1.698 + break;
1.699 + }
1.700 + }
1.701 + /*
1.702 + * There was no mapping in the locale table. If there is an
1.703 + * encoding subfield, we can try to guess from that.
1.704 + */
1.705 +
1.706 + if (encoding == NULL) {
1.707 + char *p;
1.708 + for (p = langEnv; *p != '\0'; p++) {
1.709 + if (*p == '.') {
1.710 + p++;
1.711 + break;
1.712 + }
1.713 + }
1.714 + if (*p != '\0') {
1.715 + Tcl_DString ds;
1.716 + Tcl_DStringInit(&ds);
1.717 + encoding = Tcl_DStringAppend(&ds, p, -1);
1.718 +
1.719 + Tcl_UtfToLower(Tcl_DStringValue(&ds));
1.720 + setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
1.721 + if (setSysEncCode != TCL_OK) {
1.722 + encoding = NULL;
1.723 + }
1.724 + Tcl_DStringFree(&ds);
1.725 + }
1.726 + }
1.727 +#ifdef HAVE_LANGINFO_DEBUG
1.728 + fprintf(stderr, "encoding fallback check '%s' => '%s'\n",
1.729 + langEnv, encoding);
1.730 +#endif
1.731 + }
1.732 + if (setSysEncCode != TCL_OK) {
1.733 + if (encoding == NULL) {
1.734 + encoding = TCL_DEFAULT_ENCODING;
1.735 + }
1.736 +
1.737 + Tcl_SetSystemEncoding(NULL, encoding);
1.738 + }
1.739 +
1.740 + /*
1.741 + * Initialize the C library's locale subsystem. This is required
1.742 + * for input methods to work properly on X11. We only do this for
1.743 + * LC_CTYPE because that's the necessary one, and we don't want to
1.744 + * affect LC_TIME here. The side effect of setting the default
1.745 + * locale should be to load any locale specific modules that are
1.746 + * needed by X. [BUG: 5422 3345 4236 2522 2521].
1.747 + * In HAVE_LANGINFO, this call is already done above.
1.748 + */
1.749 +#ifndef HAVE_LANGINFO
1.750 + setlocale(LC_CTYPE, "");
1.751 +#endif
1.752 + }
1.753 +
1.754 + /*
1.755 + * In case the initial locale is not "C", ensure that the numeric
1.756 + * processing is done in "C" locale regardless. This is needed because
1.757 + * Tcl relies on routines like strtod, but should not have locale
1.758 + * dependent behavior.
1.759 + */
1.760 +
1.761 + setlocale(LC_NUMERIC, "C");
1.762 +
1.763 + if ((libraryPathEncodingFixed == 0) && strcmp("identity",
1.764 + Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) {
1.765 + /*
1.766 + * Until the system encoding was actually set, the library path was
1.767 + * actually in the native multi-byte encoding, and not really UTF-8
1.768 + * as advertised. We cheated as follows:
1.769 + *
1.770 + * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
1.771 + * append the ASCII chars that make up the encoding's filename to
1.772 + * the names (in the native encoding) of directories in the library
1.773 + * path, since all Unix multi-byte encodings have ASCII in the
1.774 + * beginning.
1.775 + *
1.776 + * 2. To open the encoding file, the native bytes in the file name
1.777 + * were passed to the OS, without translating from UTF-8 to native,
1.778 + * because the name was already in the native encoding.
1.779 + *
1.780 + * Now that the system encoding was actually successfully set,
1.781 + * translate all the names in the library path to UTF-8. That way,
1.782 + * next time we search the library path, we'll translate the names
1.783 + * from UTF-8 to the system encoding which will be the native
1.784 + * encoding.
1.785 + */
1.786 +
1.787 + pathPtr = TclGetLibraryPath();
1.788 + if (pathPtr != NULL) {
1.789 + int objc;
1.790 + Tcl_Obj **objv;
1.791 +
1.792 + objc = 0;
1.793 + Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
1.794 + for (i = 0; i < objc; i++) {
1.795 + int length;
1.796 + char *string;
1.797 + Tcl_DString ds;
1.798 +
1.799 + string = Tcl_GetStringFromObj(objv[i], &length);
1.800 + Tcl_ExternalToUtfDString(NULL, string, length, &ds);
1.801 + Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
1.802 + Tcl_DStringLength(&ds));
1.803 + Tcl_DStringFree(&ds);
1.804 + }
1.805 + }
1.806 +
1.807 + libraryPathEncodingFixed = 1;
1.808 + }
1.809 +
1.810 + /* This is only ever called from the startup thread */
1.811 + if (binaryEncoding == NULL) {
1.812 + /*
1.813 + * Keep the iso8859-1 encoding preloaded. The IO package uses
1.814 + * it for gets on a binary channel.
1.815 + */
1.816 + binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
1.817 + }
1.818 +}
1.819 +
1.820 +/*
1.821 + *---------------------------------------------------------------------------
1.822 + *
1.823 + * TclpSetVariables --
1.824 + *
1.825 + * Performs platform-specific interpreter initialization related to
1.826 + * the tcl_library and tcl_platform variables, and other platform-
1.827 + * specific things.
1.828 + *
1.829 + * Results:
1.830 + * None.
1.831 + *
1.832 + * Side effects:
1.833 + * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl
1.834 + * variables.
1.835 + *
1.836 + *----------------------------------------------------------------------
1.837 + */
1.838 +
1.839 +void
1.840 +TclpSetVariables(interp)
1.841 + Tcl_Interp *interp;
1.842 +{
1.843 +#ifndef NO_UNAME
1.844 + struct utsname name;
1.845 +#endif
1.846 + int unameOK;
1.847 + CONST char *user;
1.848 + Tcl_DString ds;
1.849 +
1.850 +#ifdef HAVE_COREFOUNDATION
1.851 + char tclLibPath[MAXPATHLEN + 1];
1.852 +
1.853 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
1.854 + /*
1.855 + * Set msgcat fallback locale to current CFLocale identifier.
1.856 + */
1.857 + CFLocaleRef localeRef;
1.858 +
1.859 + if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL &&
1.860 + (localeRef = CFLocaleCopyCurrent())) {
1.861 + CFStringRef locale = CFLocaleGetIdentifier(localeRef);
1.862 +
1.863 + if (locale) {
1.864 + char loc[256];
1.865 +
1.866 + if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
1.867 + if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
1.868 + Tcl_ResetResult(interp);
1.869 + }
1.870 + Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
1.871 + }
1.872 + }
1.873 + CFRelease(localeRef);
1.874 + }
1.875 +#endif
1.876 +
1.877 + if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
1.878 + CONST char *str;
1.879 + Tcl_DString ds;
1.880 + CFBundleRef bundleRef;
1.881 +
1.882 + Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath,
1.883 + TCL_GLOBAL_ONLY);
1.884 + Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
1.885 + TCL_GLOBAL_ONLY);
1.886 + Tcl_SetVar(interp, "tcl_pkgPath", " ",
1.887 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.888 + str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
1.889 + if ((str != NULL) && (str[0] != '\0')) {
1.890 + char *p = Tcl_DStringValue(&ds);
1.891 + /* convert DYLD_FRAMEWORK_PATH from colon to space separated */
1.892 + do {
1.893 + if(*p == ':') *p = ' ';
1.894 + } while (*p++);
1.895 + Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
1.896 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.897 + Tcl_SetVar(interp, "tcl_pkgPath", " ",
1.898 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.899 + Tcl_DStringFree(&ds);
1.900 + }
1.901 + if ((bundleRef = CFBundleGetMainBundle())) {
1.902 + CFURLRef frameworksURL;
1.903 + Tcl_StatBuf statBuf;
1.904 + if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) {
1.905 + if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
1.906 + (unsigned char*) tclLibPath, MAXPATHLEN) &&
1.907 + ! TclOSstat(tclLibPath, &statBuf) &&
1.908 + S_ISDIR(statBuf.st_mode)) {
1.909 + Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
1.910 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.911 + Tcl_SetVar(interp, "tcl_pkgPath", " ",
1.912 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.913 + }
1.914 + CFRelease(frameworksURL);
1.915 + }
1.916 + if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) {
1.917 + if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
1.918 + (unsigned char*) tclLibPath, MAXPATHLEN) &&
1.919 + ! TclOSstat(tclLibPath, &statBuf) &&
1.920 + S_ISDIR(statBuf.st_mode)) {
1.921 + Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
1.922 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.923 + Tcl_SetVar(interp, "tcl_pkgPath", " ",
1.924 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.925 + }
1.926 + CFRelease(frameworksURL);
1.927 + }
1.928 + }
1.929 + Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
1.930 + TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
1.931 + } else
1.932 +#endif /* HAVE_COREFOUNDATION */
1.933 + {
1.934 + Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir,
1.935 + TCL_GLOBAL_ONLY);
1.936 + Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
1.937 + }
1.938 +
1.939 +#ifdef DJGPP
1.940 + Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
1.941 +#else
1.942 + Tcl_SetVar2(interp, "tcl_platform", "platform", "symbian", TCL_GLOBAL_ONLY);
1.943 +#endif
1.944 + unameOK = 0;
1.945 +#ifndef NO_UNAME
1.946 + if (uname(&name) >= 0) {
1.947 + CONST char *native;
1.948 +
1.949 + unameOK = 1;
1.950 +
1.951 + native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
1.952 + Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
1.953 + Tcl_DStringFree(&ds);
1.954 +
1.955 + /*
1.956 + * The following code is a special hack to handle differences in
1.957 + * the way version information is returned by uname. On most
1.958 + * systems the full version number is available in name.release.
1.959 + * However, under AIX the major version number is in
1.960 + * name.version and the minor version number is in name.release.
1.961 + */
1.962 +
1.963 + if ((strchr(name.release, '.') != NULL)
1.964 + || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */
1.965 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
1.966 + TCL_GLOBAL_ONLY);
1.967 + } else {
1.968 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
1.969 + TCL_GLOBAL_ONLY);
1.970 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
1.971 + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
1.972 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
1.973 + TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
1.974 + }
1.975 + Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
1.976 + TCL_GLOBAL_ONLY);
1.977 + }
1.978 +#ifdef __SYMBIAN32__
1.979 + // Symbian P.I.P.S. is a "flavour of" unix in that it's an emulation layer.
1.980 + Tcl_SetVar2(interp, "tcl_platform", "osSystemName", name.sysname, TCL_GLOBAL_ONLY);
1.981 +#endif
1.982 +#endif
1.983 + if (!unameOK) {
1.984 + Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
1.985 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
1.986 + Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
1.987 + }
1.988 +
1.989 + /*
1.990 + * Copy USER or LOGNAME environment variable into tcl_platform(user)
1.991 + */
1.992 +
1.993 + Tcl_DStringInit(&ds);
1.994 + user = TclGetEnv("USER", &ds);
1.995 + if (user == NULL) {
1.996 + user = TclGetEnv("LOGNAME", &ds);
1.997 + if (user == NULL) {
1.998 + user = "";
1.999 + }
1.1000 + }
1.1001 + Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
1.1002 + Tcl_DStringFree(&ds);
1.1003 +
1.1004 +}
1.1005 +
1.1006 +/*
1.1007 + *----------------------------------------------------------------------
1.1008 + *
1.1009 + * TclpFindVariable --
1.1010 + *
1.1011 + * Locate the entry in environ for a given name. On Unix this
1.1012 + * routine is case sensetive, on Windows this matches mixed case.
1.1013 + *
1.1014 + * Results:
1.1015 + * The return value is the index in environ of an entry with the
1.1016 + * name "name", or -1 if there is no such entry. The integer at
1.1017 + * *lengthPtr is filled in with the length of name (if a matching
1.1018 + * entry is found) or the length of the environ array (if no matching
1.1019 + * entry is found).
1.1020 + *
1.1021 + * Side effects:
1.1022 + * None.
1.1023 + *
1.1024 + *----------------------------------------------------------------------
1.1025 + */
1.1026 +
1.1027 +int
1.1028 +TclpFindVariable(name, lengthPtr)
1.1029 + CONST char *name; /* Name of desired environment variable
1.1030 + * (native). */
1.1031 + int *lengthPtr; /* Used to return length of name (for
1.1032 + * successful searches) or number of non-NULL
1.1033 + * entries in environ (for unsuccessful
1.1034 + * searches). */
1.1035 +{
1.1036 + int i, result = -1;
1.1037 + register CONST char *env, *p1, *p2;
1.1038 + Tcl_DString envString;
1.1039 +
1.1040 + Tcl_DStringInit(&envString);
1.1041 + for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
1.1042 + p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
1.1043 + p2 = name;
1.1044 +
1.1045 + for (; *p2 == *p1; p1++, p2++) {
1.1046 + /* NULL loop body. */
1.1047 + }
1.1048 + if ((*p1 == '=') && (*p2 == '\0')) {
1.1049 + *lengthPtr = p2 - name;
1.1050 + result = i;
1.1051 + goto done;
1.1052 + }
1.1053 +
1.1054 + Tcl_DStringFree(&envString);
1.1055 + }
1.1056 +
1.1057 + *lengthPtr = i;
1.1058 +
1.1059 + done:
1.1060 + Tcl_DStringFree(&envString);
1.1061 + return result;
1.1062 +}
1.1063 +
1.1064 +/*
1.1065 + *----------------------------------------------------------------------
1.1066 + *
1.1067 + * Tcl_Init --
1.1068 + *
1.1069 + * This procedure is typically invoked by Tcl_AppInit procedures
1.1070 + * to find and source the "init.tcl" script, which should exist
1.1071 + * somewhere on the Tcl library path.
1.1072 + *
1.1073 + * Results:
1.1074 + * Returns a standard Tcl completion code and sets the interp's
1.1075 + * result if there is an error.
1.1076 + *
1.1077 + * Side effects:
1.1078 + * Depends on what's in the init.tcl script.
1.1079 + *
1.1080 + *----------------------------------------------------------------------
1.1081 + */
1.1082 +
1.1083 +EXPORT_C int
1.1084 +Tcl_Init(interp)
1.1085 + Tcl_Interp *interp; /* Interpreter to initialize. */
1.1086 +{
1.1087 + Tcl_Obj *pathPtr;
1.1088 +
1.1089 + if (tclPreInitScript != NULL) {
1.1090 + if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
1.1091 + return (TCL_ERROR);
1.1092 + };
1.1093 + }
1.1094 +
1.1095 + pathPtr = TclGetLibraryPath();
1.1096 + if (pathPtr == NULL) {
1.1097 + pathPtr = Tcl_NewObj();
1.1098 + }
1.1099 + Tcl_IncrRefCount(pathPtr);
1.1100 + Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
1.1101 + Tcl_DecrRefCount(pathPtr);
1.1102 + return Tcl_Eval(interp, initScript);
1.1103 +}
1.1104 +
1.1105 +/*
1.1106 + *----------------------------------------------------------------------
1.1107 + *
1.1108 + * Tcl_SourceRCFile --
1.1109 + *
1.1110 + * This procedure is typically invoked by Tcl_Main of Tk_Main
1.1111 + * procedure to source an application specific rc file into the
1.1112 + * interpreter at startup time.
1.1113 + *
1.1114 + * Results:
1.1115 + * None.
1.1116 + *
1.1117 + * Side effects:
1.1118 + * Depends on what's in the rc script.
1.1119 + *
1.1120 + *----------------------------------------------------------------------
1.1121 + */
1.1122 +
1.1123 +EXPORT_C void
1.1124 +Tcl_SourceRCFile(interp)
1.1125 + Tcl_Interp *interp; /* Interpreter to source rc file into. */
1.1126 +{
1.1127 + Tcl_DString temp;
1.1128 + CONST char *fileName;
1.1129 + Tcl_Channel errChannel;
1.1130 +
1.1131 + fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
1.1132 +
1.1133 + if (fileName != NULL) {
1.1134 + Tcl_Channel c;
1.1135 + CONST char *fullName;
1.1136 +
1.1137 + Tcl_DStringInit(&temp);
1.1138 + fullName = Tcl_TranslateFileName(interp, fileName, &temp);
1.1139 + if (fullName == NULL) {
1.1140 + /*
1.1141 + * Couldn't translate the file name (e.g. it referred to a
1.1142 + * bogus user or there was no HOME environment variable).
1.1143 + * Just do nothing.
1.1144 + */
1.1145 + } else {
1.1146 +
1.1147 + /*
1.1148 + * Test for the existence of the rc file before trying to read it.
1.1149 + */
1.1150 +
1.1151 + c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
1.1152 + if (c != (Tcl_Channel) NULL) {
1.1153 + Tcl_Close(NULL, c);
1.1154 + if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
1.1155 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.1156 + if (errChannel) {
1.1157 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.1158 + Tcl_WriteChars(errChannel, "\n", 1);
1.1159 + }
1.1160 + }
1.1161 + }
1.1162 + }
1.1163 + Tcl_DStringFree(&temp);
1.1164 + }
1.1165 +}
1.1166 +
1.1167 +/*
1.1168 + *----------------------------------------------------------------------
1.1169 + *
1.1170 + * TclpCheckStackSpace --
1.1171 + *
1.1172 + * Detect if we are about to blow the stack. Called before an
1.1173 + * evaluation can happen when nesting depth is checked.
1.1174 + *
1.1175 + * Results:
1.1176 + * 1 if there is enough stack space to continue; 0 if not.
1.1177 + *
1.1178 + * Side effects:
1.1179 + * None.
1.1180 + *
1.1181 + *----------------------------------------------------------------------
1.1182 + */
1.1183 +
1.1184 +int
1.1185 +TclpCheckStackSpace()
1.1186 +{
1.1187 + /*
1.1188 + * This function is unimplemented on Unix platforms.
1.1189 + */
1.1190 +
1.1191 + return 1;
1.1192 +}
1.1193 +
1.1194 +/*
1.1195 + *----------------------------------------------------------------------
1.1196 + *
1.1197 + * MacOSXGetLibraryPath --
1.1198 + *
1.1199 + * If we have a bundle structure for the Tcl installation,
1.1200 + * then check there first to see if we can find the libraries
1.1201 + * there.
1.1202 + *
1.1203 + * Results:
1.1204 + * TCL_OK if we have found the tcl library; TCL_ERROR otherwise.
1.1205 + *
1.1206 + * Side effects:
1.1207 + * Same as for Tcl_MacOSXOpenVersionedBundleResources.
1.1208 + *
1.1209 + *----------------------------------------------------------------------
1.1210 + */
1.1211 +
1.1212 +#ifdef HAVE_COREFOUNDATION
1.1213 +static int
1.1214 +MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath)
1.1215 +{
1.1216 + int foundInFramework = TCL_ERROR;
1.1217 +#ifdef TCL_FRAMEWORK
1.1218 + foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
1.1219 + "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath);
1.1220 +#endif
1.1221 + return foundInFramework;
1.1222 +}
1.1223 +#endif /* HAVE_COREFOUNDATION */