os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacInit.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacInit.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,807 @@
1.4 +/*
1.5 + * tclMacInit.c --
1.6 + *
1.7 + * Contains the Mac-specific interpreter initialization functions.
1.8 + *
1.9 + * Copyright (c) 1995-1998 Sun Microsystems, Inc.
1.10 + *
1.11 + * See the file "license.terms" for information on usage and redistribution
1.12 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.13 + *
1.14 + * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $
1.15 + */
1.16 +
1.17 +#include <AppleEvents.h>
1.18 +#include <AEDataModel.h>
1.19 +#include <AEObjects.h>
1.20 +#include <AEPackObject.h>
1.21 +#include <AERegistry.h>
1.22 +#include <Files.h>
1.23 +#include <Folders.h>
1.24 +#include <Gestalt.h>
1.25 +#include <TextUtils.h>
1.26 +#include <Resources.h>
1.27 +#include <Strings.h>
1.28 +#include "tclInt.h"
1.29 +#include "tclMacInt.h"
1.30 +#include "tclPort.h"
1.31 +#include "tclInitScript.h"
1.32 +
1.33 +/*
1.34 + * The following string is the startup script executed in new
1.35 + * interpreters. It looks on the library path and in the resource fork for
1.36 + * a script "init.tcl" that is compatible with this version of Tcl. The
1.37 + * init.tcl script does all of the real work of initialization.
1.38 + */
1.39 +
1.40 +static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\
1.41 +proc tclInit {} {\n\
1.42 +global tcl_pkgPath env\n\
1.43 +proc sourcePath {file} {\n\
1.44 + foreach i $::auto_path {\n\
1.45 + set init [file join $i $file.tcl]\n\
1.46 + if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
1.47 + return\n\
1.48 + }\n\
1.49 + }\n\
1.50 + if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
1.51 + return\n\
1.52 + }\n\
1.53 + rename sourcePath {}\n\
1.54 + set msg \"Can't find $file resource or a usable $file.tcl file\"\n\
1.55 + append msg \" in the following directories:\"\n\
1.56 + append msg \" $::auto_path\"\n\
1.57 + append msg \" perhaps you need to install Tcl or set your\"\n\
1.58 + append msg \" TCL_LIBRARY environment variable?\"\n\
1.59 + error $msg\n\
1.60 +}\n\
1.61 +if {[info exists env(EXT_FOLDER)]} {\n\
1.62 + lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\
1.63 +}\n\
1.64 +if {[info exists tcl_pkgPath] == 0} {\n\
1.65 + set tcl_pkgPath {no extension folder}\n\
1.66 +}\n\
1.67 +sourcePath init\n\
1.68 +sourcePath auto\n\
1.69 +sourcePath package\n\
1.70 +sourcePath history\n\
1.71 +sourcePath word\n\
1.72 +sourcePath parray\n\
1.73 +rename sourcePath {}\n\
1.74 +} }\n\
1.75 +tclInit";
1.76 +
1.77 +/*
1.78 + * The following structures are used to map the script/language codes of a
1.79 + * font to the name that should be passed to Tcl_GetEncoding() to obtain
1.80 + * the encoding for that font. The set of numeric constants is fixed and
1.81 + * defined by Apple.
1.82 + */
1.83 +
1.84 +typedef struct Map {
1.85 + int numKey;
1.86 + char *strKey;
1.87 +} Map;
1.88 +
1.89 +static Map scriptMap[] = {
1.90 + {smRoman, "macRoman"},
1.91 + {smJapanese, "macJapan"},
1.92 + {smTradChinese, "macChinese"},
1.93 + {smKorean, "macKorean"},
1.94 + {smArabic, "macArabic"},
1.95 + {smHebrew, "macHebrew"},
1.96 + {smGreek, "macGreek"},
1.97 + {smCyrillic, "macCyrillic"},
1.98 + {smRSymbol, "macRSymbol"},
1.99 + {smDevanagari, "macDevanagari"},
1.100 + {smGurmukhi, "macGurmukhi"},
1.101 + {smGujarati, "macGujarati"},
1.102 + {smOriya, "macOriya"},
1.103 + {smBengali, "macBengali"},
1.104 + {smTamil, "macTamil"},
1.105 + {smTelugu, "macTelugu"},
1.106 + {smKannada, "macKannada"},
1.107 + {smMalayalam, "macMalayalam"},
1.108 + {smSinhalese, "macSinhalese"},
1.109 + {smBurmese, "macBurmese"},
1.110 + {smKhmer, "macKhmer"},
1.111 + {smThai, "macThailand"},
1.112 + {smLaotian, "macLaos"},
1.113 + {smGeorgian, "macGeorgia"},
1.114 + {smArmenian, "macArmenia"},
1.115 + {smSimpChinese, "macSimpChinese"},
1.116 + {smTibetan, "macTIbet"},
1.117 + {smMongolian, "macMongolia"},
1.118 + {smGeez, "macEthiopia"},
1.119 + {smEastEurRoman, "macCentEuro"},
1.120 + {smVietnamese, "macVietnam"},
1.121 + {smExtArabic, "macSindhi"},
1.122 + {NULL, NULL}
1.123 +};
1.124 +
1.125 +static Map romanMap[] = {
1.126 + {langCroatian, "macCroatian"},
1.127 + {langSlovenian, "macCroatian"},
1.128 + {langIcelandic, "macIceland"},
1.129 + {langRomanian, "macRomania"},
1.130 + {langTurkish, "macTurkish"},
1.131 + {langGreek, "macGreek"},
1.132 + {NULL, NULL}
1.133 +};
1.134 +
1.135 +static Map cyrillicMap[] = {
1.136 + {langUkrainian, "macUkraine"},
1.137 + {langBulgarian, "macBulgaria"},
1.138 + {NULL, NULL}
1.139 +};
1.140 +
1.141 +static int GetFinderFont(int *finderID);
1.142 +
1.143 +/* Used to store the encoding used for binary files */
1.144 +static Tcl_Encoding binaryEncoding = NULL;
1.145 +/* Has the basic library path encoding issue been fixed */
1.146 +static int libraryPathEncodingFixed = 0;
1.147 +
1.148 +
1.149 +/*
1.150 + *----------------------------------------------------------------------
1.151 + *
1.152 + * GetFinderFont --
1.153 + *
1.154 + * Gets the "views" font of the Macintosh Finder
1.155 + *
1.156 + * Results:
1.157 + * Standard Tcl result, and sets finderID to the font family
1.158 + * id for the current finder font.
1.159 + *
1.160 + * Side effects:
1.161 + * None.
1.162 + *
1.163 + *----------------------------------------------------------------------
1.164 + */
1.165 +static int
1.166 +GetFinderFont(int *finderID)
1.167 +{
1.168 + OSErr err = noErr;
1.169 + OSType finderPrefs, viewFont = 'vfnt';
1.170 + DescType returnType;
1.171 + Size returnSize;
1.172 + long result, sys8Mask = 0x0800;
1.173 + static AppleEvent outgoingAevt = {typeNull, NULL};
1.174 + AppleEvent returnAevt;
1.175 + AEAddressDesc fndrAddress;
1.176 + AEDesc nullContainer = {typeNull, NULL},
1.177 + tempDesc = {typeNull, NULL},
1.178 + tempDesc2 = {typeNull, NULL},
1.179 + finalDesc = {typeNull, NULL};
1.180 + const OSType finderSignature = 'MACS';
1.181 +
1.182 +
1.183 + if (outgoingAevt.descriptorType == typeNull) {
1.184 + if ((Gestalt(gestaltSystemVersion, &result) != noErr)
1.185 + || (result >= sys8Mask)) {
1.186 + finderPrefs = 'pfrp';
1.187 + } else {
1.188 + finderPrefs = 'pvwp';
1.189 + }
1.190 +
1.191 + AECreateDesc(typeApplSignature, &finderSignature,
1.192 + sizeof(finderSignature), &fndrAddress);
1.193 +
1.194 + err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress,
1.195 + kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
1.196 +
1.197 + AEDisposeDesc(&fndrAddress);
1.198 +
1.199 + /*
1.200 + * The structure is:
1.201 + * the property view font ('vfnt')
1.202 + * of the property view preferences ('pvwp')
1.203 + * of the Null Container (i.e. the Finder itself).
1.204 + */
1.205 +
1.206 + AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
1.207 + err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
1.208 + &tempDesc, true, &tempDesc2);
1.209 + AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
1.210 + err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
1.211 + &tempDesc, true, &finalDesc);
1.212 +
1.213 + AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
1.214 + AEDisposeDesc(&finalDesc);
1.215 + }
1.216 +
1.217 + err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
1.218 + kAEDefaultTimeout, NULL, NULL);
1.219 + if (err == noErr) {
1.220 + err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger,
1.221 + &returnType, (void *) finderID, sizeof(int), &returnSize);
1.222 + if (err == noErr) {
1.223 + return TCL_OK;
1.224 + }
1.225 + }
1.226 + return TCL_ERROR;
1.227 +}
1.228 +
1.229 +/*
1.230 + *---------------------------------------------------------------------------
1.231 + *
1.232 + * TclMacGetFontEncoding --
1.233 + *
1.234 + * Determine the encoding of the specified font. The encoding
1.235 + * can be used to convert bytes from UTF-8 into the encoding of
1.236 + * that font.
1.237 + *
1.238 + * Results:
1.239 + * The return value is a string that specifies the font's encoding
1.240 + * and that can be passed to Tcl_GetEncoding() to construct the
1.241 + * encoding. If the font's encoding could not be identified, NULL
1.242 + * is returned.
1.243 + *
1.244 + * Side effects:
1.245 + * None.
1.246 + *
1.247 + *---------------------------------------------------------------------------
1.248 + */
1.249 +
1.250 +char *
1.251 +TclMacGetFontEncoding(
1.252 + int fontId)
1.253 +{
1.254 + int script, lang;
1.255 + char *name;
1.256 + Map *mapPtr;
1.257 +
1.258 + script = FontToScript(fontId);
1.259 + lang = GetScriptVariable(script, smScriptLang);
1.260 + name = NULL;
1.261 + if (script == smRoman) {
1.262 + for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
1.263 + if (mapPtr->numKey == lang) {
1.264 + name = mapPtr->strKey;
1.265 + break;
1.266 + }
1.267 + }
1.268 + } else if (script == smCyrillic) {
1.269 + for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
1.270 + if (mapPtr->numKey == lang) {
1.271 + name = mapPtr->strKey;
1.272 + break;
1.273 + }
1.274 + }
1.275 + }
1.276 + if (name == NULL) {
1.277 + for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
1.278 + if (mapPtr->numKey == script) {
1.279 + name = mapPtr->strKey;
1.280 + break;
1.281 + }
1.282 + }
1.283 + }
1.284 + return name;
1.285 +}
1.286 +
1.287 +/*
1.288 + *---------------------------------------------------------------------------
1.289 + *
1.290 + * TclpInitPlatform --
1.291 + *
1.292 + * Initialize all the platform-dependant things like signals and
1.293 + * floating-point error handling.
1.294 + *
1.295 + * Called at process initialization time.
1.296 + *
1.297 + * Results:
1.298 + * None.
1.299 + *
1.300 + * Side effects:
1.301 + * None.
1.302 + *
1.303 + *---------------------------------------------------------------------------
1.304 + */
1.305 +
1.306 +void
1.307 +TclpInitPlatform()
1.308 +{
1.309 + tclPlatform = TCL_PLATFORM_MAC;
1.310 +}
1.311 +
1.312 +/*
1.313 + *---------------------------------------------------------------------------
1.314 + *
1.315 + * TclpInitLibraryPath --
1.316 + *
1.317 + * Initialize the library path at startup. We have a minor
1.318 + * metacircular problem that we don't know the encoding of the
1.319 + * operating system but we may need to talk to operating system
1.320 + * to find the library directories so that we know how to talk to
1.321 + * the operating system.
1.322 + *
1.323 + * We do not know the encoding of the operating system.
1.324 + * We do know that the encoding is some multibyte encoding.
1.325 + * In that multibyte encoding, the characters 0..127 are equivalent
1.326 + * to ascii.
1.327 + *
1.328 + * So although we don't know the encoding, it's safe:
1.329 + * to look for the last colon character in a path in the encoding.
1.330 + * to append an ascii string to a path.
1.331 + * to pass those strings back to the operating system.
1.332 + *
1.333 + * But any strings that we remembered before we knew the encoding of
1.334 + * the operating system must be translated to UTF-8 once we know the
1.335 + * encoding so that the rest of Tcl can use those strings.
1.336 + *
1.337 + * This call sets the library path to strings in the unknown native
1.338 + * encoding. TclpSetInitialEncodings() will translate the library
1.339 + * path from the native encoding to UTF-8 as soon as it determines
1.340 + * what the native encoding actually is.
1.341 + *
1.342 + * Called at process initialization time.
1.343 + *
1.344 + * Results:
1.345 + * Return 1, indicating that the UTF may be dirty and require "cleanup"
1.346 + * after encodings are initialized.
1.347 + *
1.348 + * Side effects:
1.349 + * None.
1.350 + *
1.351 + *---------------------------------------------------------------------------
1.352 + */
1.353 +
1.354 +int
1.355 +TclpInitLibraryPath(argv0)
1.356 + CONST char *argv0; /* Name of executable from argv[0] to main().
1.357 + * Not used because we can determine the name
1.358 + * by querying the module handle. */
1.359 +{
1.360 + Tcl_Obj *objPtr, *pathPtr;
1.361 + CONST char *str;
1.362 + Tcl_DString ds;
1.363 +
1.364 + TclMacCreateEnv();
1.365 +
1.366 + pathPtr = Tcl_NewObj();
1.367 +
1.368 + /*
1.369 + * Look for the library relative to default encoding dir.
1.370 + */
1.371 +
1.372 + str = Tcl_GetDefaultEncodingDir();
1.373 + if ((str != NULL) && (str[0] != '\0')) {
1.374 + objPtr = Tcl_NewStringObj(str, -1);
1.375 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.376 + }
1.377 +
1.378 + str = TclGetEnv("TCL_LIBRARY", &ds);
1.379 + if ((str != NULL) && (str[0] != '\0')) {
1.380 + /*
1.381 + * If TCL_LIBRARY is set, search there.
1.382 + */
1.383 +
1.384 + objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
1.385 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.386 + Tcl_DStringFree(&ds);
1.387 + }
1.388 +
1.389 + objPtr = TclGetLibraryPath();
1.390 + if (objPtr != NULL) {
1.391 + Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
1.392 + }
1.393 +
1.394 + /*
1.395 + * lappend path [file join $env(EXT_FOLDER) \
1.396 + * "Tool Command Language" "tcl[info version]"
1.397 + */
1.398 +
1.399 + str = TclGetEnv("EXT_FOLDER", &ds);
1.400 + if ((str != NULL) && (str[0] != '\0')) {
1.401 + Tcl_DString libPath, path;
1.402 + CONST char *argv[3];
1.403 +
1.404 + argv[0] = str;
1.405 + argv[1] = "Tool Command Language";
1.406 + Tcl_DStringInit(&libPath);
1.407 + Tcl_DStringAppend(&libPath, "tcl", -1);
1.408 + argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
1.409 + Tcl_DStringInit(&path);
1.410 + str = Tcl_JoinPath(3, argv, &path);
1.411 + objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
1.412 + Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
1.413 + Tcl_DStringFree(&ds);
1.414 + Tcl_DStringFree(&libPath);
1.415 + Tcl_DStringFree(&path);
1.416 + }
1.417 + TclSetLibraryPath(pathPtr);
1.418 +
1.419 + return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
1.420 +}
1.421 +
1.422 +/*
1.423 + *---------------------------------------------------------------------------
1.424 + *
1.425 + * TclpSetInitialEncodings --
1.426 + *
1.427 + * Based on the locale, determine the encoding of the operating
1.428 + * system and the default encoding for newly opened files.
1.429 + *
1.430 + * Called at process initialization time, and part way through
1.431 + * startup, we verify that the initial encodings were correctly
1.432 + * setup. Depending on Tcl's environment, there may not have been
1.433 + * enough information first time through (above).
1.434 + *
1.435 + * Results:
1.436 + * None.
1.437 + *
1.438 + * Side effects:
1.439 + * The Tcl library path is converted from native encoding to UTF-8,
1.440 + * on the first call, and the encodings may be changed on first or
1.441 + * second call.
1.442 + *
1.443 + *---------------------------------------------------------------------------
1.444 + */
1.445 +
1.446 +void
1.447 +TclpSetInitialEncodings()
1.448 +{
1.449 + CONST char *encoding;
1.450 + Tcl_Obj *pathPtr;
1.451 + int fontId, err;
1.452 +
1.453 + fontId = 0;
1.454 + GetFinderFont(&fontId);
1.455 + encoding = TclMacGetFontEncoding(fontId);
1.456 + if (encoding == NULL) {
1.457 + encoding = "macRoman";
1.458 + }
1.459 +
1.460 + err = Tcl_SetSystemEncoding(NULL, encoding);
1.461 +
1.462 + if (err == TCL_OK && libraryPathEncodingFixed == 0) {
1.463 +
1.464 + /*
1.465 + * Until the system encoding was actually set, the library path was
1.466 + * actually in the native multi-byte encoding, and not really UTF-8
1.467 + * as advertised. We cheated as follows:
1.468 + *
1.469 + * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
1.470 + * append the ASCII chars that make up the encoding's filename to
1.471 + * the names (in the native encoding) of directories in the library
1.472 + * path, since all Unix multi-byte encodings have ASCII in the
1.473 + * beginning.
1.474 + *
1.475 + * 2. To open the encoding file, the native bytes in the file name
1.476 + * were passed to the OS, without translating from UTF-8 to native,
1.477 + * because the name was already in the native encoding.
1.478 + *
1.479 + * Now that the system encoding was actually successfully set,
1.480 + * translate all the names in the library path to UTF-8. That way,
1.481 + * next time we search the library path, we'll translate the names
1.482 + * from UTF-8 to the system encoding which will be the native
1.483 + * encoding.
1.484 + */
1.485 +
1.486 + pathPtr = TclGetLibraryPath();
1.487 + if (pathPtr != NULL) {
1.488 + int i, objc;
1.489 + Tcl_Obj **objv;
1.490 +
1.491 + objc = 0;
1.492 + Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
1.493 + for (i = 0; i < objc; i++) {
1.494 + int length;
1.495 + char *string;
1.496 + Tcl_DString ds;
1.497 +
1.498 + string = Tcl_GetStringFromObj(objv[i], &length);
1.499 + Tcl_ExternalToUtfDString(NULL, string, length, &ds);
1.500 + Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
1.501 + Tcl_DStringLength(&ds));
1.502 + Tcl_DStringFree(&ds);
1.503 + }
1.504 + Tcl_InvalidateStringRep(pathPtr);
1.505 + }
1.506 + libraryPathEncodingFixed = 1;
1.507 + }
1.508 +
1.509 + /* This is only ever called from the startup thread */
1.510 + if (binaryEncoding == NULL) {
1.511 + /*
1.512 + * Keep the iso8859-1 encoding preloaded. The IO package uses
1.513 + * it for gets on a binary channel.
1.514 + */
1.515 + binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
1.516 + }
1.517 +}
1.518 +
1.519 +/*
1.520 + *---------------------------------------------------------------------------
1.521 + *
1.522 + * TclpSetVariables --
1.523 + *
1.524 + * Performs platform-specific interpreter initialization related to
1.525 + * the tcl_library and tcl_platform variables, and other platform-
1.526 + * specific things.
1.527 + *
1.528 + * Results:
1.529 + * None.
1.530 + *
1.531 + * Side effects:
1.532 + * Sets "tcl_library" and "tcl_platform" Tcl variables.
1.533 + *
1.534 + *----------------------------------------------------------------------
1.535 + */
1.536 +
1.537 +void
1.538 +TclpSetVariables(interp)
1.539 + Tcl_Interp *interp;
1.540 +{
1.541 + long int gestaltResult;
1.542 + int minor, major, objc;
1.543 + Tcl_Obj **objv;
1.544 + char versStr[2 * TCL_INTEGER_SPACE];
1.545 + CONST char *str;
1.546 + Tcl_Obj *pathPtr;
1.547 + Tcl_DString ds;
1.548 +
1.549 + str = "no library";
1.550 + pathPtr = TclGetLibraryPath();
1.551 + if (pathPtr != NULL) {
1.552 + objc = 0;
1.553 + Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
1.554 + if (objc > 0) {
1.555 + str = Tcl_GetStringFromObj(objv[0], NULL);
1.556 + }
1.557 + }
1.558 + Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
1.559 +
1.560 + if (pathPtr != NULL) {
1.561 + Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
1.562 + }
1.563 +
1.564 + Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
1.565 + TCL_GLOBAL_ONLY);
1.566 + Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
1.567 + Gestalt(gestaltSystemVersion, &gestaltResult);
1.568 + major = (gestaltResult & 0x0000FF00) >> 8;
1.569 + minor = (gestaltResult & 0x000000F0) >> 4;
1.570 + sprintf(versStr, "%d.%d", major, minor);
1.571 + Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
1.572 +#if GENERATINGPOWERPC
1.573 + Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
1.574 +#else
1.575 + Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
1.576 +#endif
1.577 +
1.578 + /*
1.579 + * Copy USER or LOGIN environment variable into tcl_platform(user)
1.580 + * These are set by SystemVariables in tclMacEnv.c
1.581 + */
1.582 +
1.583 + Tcl_DStringInit(&ds);
1.584 + str = TclGetEnv("USER", &ds);
1.585 + if (str == NULL) {
1.586 + str = TclGetEnv("LOGIN", &ds);
1.587 + if (str == NULL) {
1.588 + str = "";
1.589 + }
1.590 + }
1.591 + Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
1.592 + Tcl_DStringFree(&ds);
1.593 +}
1.594 +
1.595 +/*
1.596 + *----------------------------------------------------------------------
1.597 + *
1.598 + * TclpCheckStackSpace --
1.599 + *
1.600 + * On a 68K Mac, we can detect if we are about to blow the stack.
1.601 + * Called before an evaluation can happen when nesting depth is
1.602 + * checked.
1.603 + *
1.604 + * Results:
1.605 + * 1 if there is enough stack space to continue; 0 if not.
1.606 + *
1.607 + * Side effects:
1.608 + * None.
1.609 + *
1.610 + *----------------------------------------------------------------------
1.611 + */
1.612 +
1.613 +int
1.614 +TclpCheckStackSpace()
1.615 +{
1.616 + return StackSpace() > TCL_MAC_STACK_THRESHOLD;
1.617 +}
1.618 +
1.619 +/*
1.620 + *----------------------------------------------------------------------
1.621 + *
1.622 + * TclpFindVariable --
1.623 + *
1.624 + * Locate the entry in environ for a given name. On Unix and Macthis
1.625 + * routine is case sensitive, on Windows this matches mixed case.
1.626 + *
1.627 + * Results:
1.628 + * The return value is the index in environ of an entry with the
1.629 + * name "name", or -1 if there is no such entry. The integer at
1.630 + * *lengthPtr is filled in with the length of name (if a matching
1.631 + * entry is found) or the length of the environ array (if no matching
1.632 + * entry is found).
1.633 + *
1.634 + * Side effects:
1.635 + * None.
1.636 + *
1.637 + *----------------------------------------------------------------------
1.638 + */
1.639 +
1.640 +int
1.641 +TclpFindVariable(name, lengthPtr)
1.642 + CONST char *name; /* Name of desired environment variable
1.643 + * (native). */
1.644 + int *lengthPtr; /* Used to return length of name (for
1.645 + * successful searches) or number of non-NULL
1.646 + * entries in environ (for unsuccessful
1.647 + * searches). */
1.648 +{
1.649 + int i, result = -1;
1.650 + register CONST char *env, *p1, *p2;
1.651 + Tcl_DString envString;
1.652 +
1.653 + Tcl_DStringInit(&envString);
1.654 + for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
1.655 + p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
1.656 + p2 = name;
1.657 +
1.658 + for (; *p2 == *p1; p1++, p2++) {
1.659 + /* NULL loop body. */
1.660 + }
1.661 + if ((*p1 == '=') && (*p2 == '\0')) {
1.662 + *lengthPtr = p2 - name;
1.663 + result = i;
1.664 + goto done;
1.665 + }
1.666 +
1.667 + Tcl_DStringFree(&envString);
1.668 + }
1.669 +
1.670 + *lengthPtr = i;
1.671 +
1.672 + done:
1.673 + Tcl_DStringFree(&envString);
1.674 + return result;
1.675 +}
1.676 +
1.677 +/*
1.678 + *----------------------------------------------------------------------
1.679 + *
1.680 + * Tcl_Init --
1.681 + *
1.682 + * This procedure is typically invoked by Tcl_AppInit procedures
1.683 + * to perform additional initialization for a Tcl interpreter,
1.684 + * such as sourcing the "init.tcl" script.
1.685 + *
1.686 + * Results:
1.687 + * Returns a standard Tcl completion code and sets the interp's result
1.688 + * if there is an error.
1.689 + *
1.690 + * Side effects:
1.691 + * Depends on what's in the init.tcl script.
1.692 + *
1.693 + *----------------------------------------------------------------------
1.694 + */
1.695 +
1.696 +int
1.697 +Tcl_Init(
1.698 + Tcl_Interp *interp) /* Interpreter to initialize. */
1.699 +{
1.700 + Tcl_Obj *pathPtr;
1.701 +
1.702 + if (tclPreInitScript != NULL) {
1.703 + if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
1.704 + return (TCL_ERROR);
1.705 + };
1.706 + }
1.707 +
1.708 + /*
1.709 + * For Macintosh applications the Init function may be contained in
1.710 + * the application resources. If it exists we use it - otherwise we
1.711 + * look in the tcl_library directory. Ditto for the history command.
1.712 + */
1.713 +
1.714 + pathPtr = TclGetLibraryPath();
1.715 + if (pathPtr == NULL) {
1.716 + pathPtr = Tcl_NewObj();
1.717 + }
1.718 + Tcl_IncrRefCount(pathPtr);
1.719 + Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
1.720 + Tcl_DecrRefCount(pathPtr);
1.721 + return Tcl_Eval(interp, initCmd);
1.722 +}
1.723 +
1.724 +/*
1.725 + *----------------------------------------------------------------------
1.726 + *
1.727 + * Tcl_SourceRCFile --
1.728 + *
1.729 + * This procedure is typically invoked by Tcl_Main or Tk_Main
1.730 + * procedure to source an application specific rc file into the
1.731 + * interpreter at startup time. This will either source a file
1.732 + * in the "tcl_rcFileName" variable or a TEXT resource in the
1.733 + * "tcl_rcRsrcName" variable.
1.734 + *
1.735 + * Results:
1.736 + * None.
1.737 + *
1.738 + * Side effects:
1.739 + * Depends on what's in the rc script.
1.740 + *
1.741 + *----------------------------------------------------------------------
1.742 + */
1.743 +
1.744 +void
1.745 +Tcl_SourceRCFile(
1.746 + Tcl_Interp *interp) /* Interpreter to source rc file into. */
1.747 +{
1.748 + Tcl_DString temp;
1.749 + CONST char *fileName;
1.750 + Tcl_Channel errChannel;
1.751 + Handle h;
1.752 +
1.753 + fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
1.754 +
1.755 + if (fileName != NULL) {
1.756 + Tcl_Channel c;
1.757 + CONST char *fullName;
1.758 +
1.759 + Tcl_DStringInit(&temp);
1.760 + fullName = Tcl_TranslateFileName(interp, fileName, &temp);
1.761 + if (fullName == NULL) {
1.762 + /*
1.763 + * Couldn't translate the file name (e.g. it referred to a
1.764 + * bogus user or there was no HOME environment variable).
1.765 + * Just do nothing.
1.766 + */
1.767 + } else {
1.768 +
1.769 + /*
1.770 + * Test for the existence of the rc file before trying to read it.
1.771 + */
1.772 +
1.773 + c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
1.774 + if (c != (Tcl_Channel) NULL) {
1.775 + Tcl_Close(NULL, c);
1.776 + if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
1.777 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.778 + if (errChannel) {
1.779 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.780 + Tcl_WriteChars(errChannel, "\n", 1);
1.781 + }
1.782 + }
1.783 + }
1.784 + }
1.785 + Tcl_DStringFree(&temp);
1.786 + }
1.787 +
1.788 + fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
1.789 +
1.790 + if (fileName != NULL) {
1.791 + Str255 rezName;
1.792 + Tcl_DString ds;
1.793 + Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
1.794 + strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
1.795 + rezName[0] = (unsigned) Tcl_DStringLength(&ds);
1.796 + h = GetNamedResource('TEXT', rezName);
1.797 + Tcl_DStringFree(&ds);
1.798 + if (h != NULL) {
1.799 + if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
1.800 + errChannel = Tcl_GetStdChannel(TCL_STDERR);
1.801 + if (errChannel) {
1.802 + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
1.803 + Tcl_WriteChars(errChannel, "\n", 1);
1.804 + }
1.805 + }
1.806 + Tcl_ResetResult(interp);
1.807 + ReleaseResource(h);
1.808 + }
1.809 + }
1.810 +}