sl@0: /* sl@0: * tclMacInit.c -- sl@0: * sl@0: * Contains the Mac-specific interpreter initialization functions. sl@0: * sl@0: * Copyright (c) 1995-1998 Sun Microsystems, Inc. sl@0: * sl@0: * See the file "license.terms" for information on usage and redistribution sl@0: * of this file, and for a DISCLAIMER OF ALL WARRANTIES. sl@0: * sl@0: * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $ sl@0: */ sl@0: sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include sl@0: #include "tclInt.h" sl@0: #include "tclMacInt.h" sl@0: #include "tclPort.h" sl@0: #include "tclInitScript.h" sl@0: sl@0: /* sl@0: * The following string is the startup script executed in new sl@0: * interpreters. It looks on the library path and in the resource fork for sl@0: * a script "init.tcl" that is compatible with this version of Tcl. The sl@0: * init.tcl script does all of the real work of initialization. sl@0: */ sl@0: sl@0: static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\ sl@0: proc tclInit {} {\n\ sl@0: global tcl_pkgPath env\n\ sl@0: proc sourcePath {file} {\n\ sl@0: foreach i $::auto_path {\n\ sl@0: set init [file join $i $file.tcl]\n\ sl@0: if {[catch {uplevel #0 [list source $init]}] == 0} {\n\ sl@0: return\n\ sl@0: }\n\ sl@0: }\n\ sl@0: if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\ sl@0: return\n\ sl@0: }\n\ sl@0: rename sourcePath {}\n\ sl@0: set msg \"Can't find $file resource or a usable $file.tcl file\"\n\ sl@0: append msg \" in the following directories:\"\n\ sl@0: append msg \" $::auto_path\"\n\ sl@0: append msg \" perhaps you need to install Tcl or set your\"\n\ sl@0: append msg \" TCL_LIBRARY environment variable?\"\n\ sl@0: error $msg\n\ sl@0: }\n\ sl@0: if {[info exists env(EXT_FOLDER)]} {\n\ sl@0: lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\ sl@0: }\n\ sl@0: if {[info exists tcl_pkgPath] == 0} {\n\ sl@0: set tcl_pkgPath {no extension folder}\n\ sl@0: }\n\ sl@0: sourcePath init\n\ sl@0: sourcePath auto\n\ sl@0: sourcePath package\n\ sl@0: sourcePath history\n\ sl@0: sourcePath word\n\ sl@0: sourcePath parray\n\ sl@0: rename sourcePath {}\n\ sl@0: } }\n\ sl@0: tclInit"; sl@0: sl@0: /* sl@0: * The following structures are used to map the script/language codes of a sl@0: * font to the name that should be passed to Tcl_GetEncoding() to obtain sl@0: * the encoding for that font. The set of numeric constants is fixed and sl@0: * defined by Apple. sl@0: */ sl@0: sl@0: typedef struct Map { sl@0: int numKey; sl@0: char *strKey; sl@0: } Map; sl@0: sl@0: static Map scriptMap[] = { sl@0: {smRoman, "macRoman"}, sl@0: {smJapanese, "macJapan"}, sl@0: {smTradChinese, "macChinese"}, sl@0: {smKorean, "macKorean"}, sl@0: {smArabic, "macArabic"}, sl@0: {smHebrew, "macHebrew"}, sl@0: {smGreek, "macGreek"}, sl@0: {smCyrillic, "macCyrillic"}, sl@0: {smRSymbol, "macRSymbol"}, sl@0: {smDevanagari, "macDevanagari"}, sl@0: {smGurmukhi, "macGurmukhi"}, sl@0: {smGujarati, "macGujarati"}, sl@0: {smOriya, "macOriya"}, sl@0: {smBengali, "macBengali"}, sl@0: {smTamil, "macTamil"}, sl@0: {smTelugu, "macTelugu"}, sl@0: {smKannada, "macKannada"}, sl@0: {smMalayalam, "macMalayalam"}, sl@0: {smSinhalese, "macSinhalese"}, sl@0: {smBurmese, "macBurmese"}, sl@0: {smKhmer, "macKhmer"}, sl@0: {smThai, "macThailand"}, sl@0: {smLaotian, "macLaos"}, sl@0: {smGeorgian, "macGeorgia"}, sl@0: {smArmenian, "macArmenia"}, sl@0: {smSimpChinese, "macSimpChinese"}, sl@0: {smTibetan, "macTIbet"}, sl@0: {smMongolian, "macMongolia"}, sl@0: {smGeez, "macEthiopia"}, sl@0: {smEastEurRoman, "macCentEuro"}, sl@0: {smVietnamese, "macVietnam"}, sl@0: {smExtArabic, "macSindhi"}, sl@0: {NULL, NULL} sl@0: }; sl@0: sl@0: static Map romanMap[] = { sl@0: {langCroatian, "macCroatian"}, sl@0: {langSlovenian, "macCroatian"}, sl@0: {langIcelandic, "macIceland"}, sl@0: {langRomanian, "macRomania"}, sl@0: {langTurkish, "macTurkish"}, sl@0: {langGreek, "macGreek"}, sl@0: {NULL, NULL} sl@0: }; sl@0: sl@0: static Map cyrillicMap[] = { sl@0: {langUkrainian, "macUkraine"}, sl@0: {langBulgarian, "macBulgaria"}, sl@0: {NULL, NULL} sl@0: }; sl@0: sl@0: static int GetFinderFont(int *finderID); 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: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * GetFinderFont -- sl@0: * sl@0: * Gets the "views" font of the Macintosh Finder sl@0: * sl@0: * Results: sl@0: * Standard Tcl result, and sets finderID to the font family sl@0: * id for the current finder font. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: static int sl@0: GetFinderFont(int *finderID) sl@0: { sl@0: OSErr err = noErr; sl@0: OSType finderPrefs, viewFont = 'vfnt'; sl@0: DescType returnType; sl@0: Size returnSize; sl@0: long result, sys8Mask = 0x0800; sl@0: static AppleEvent outgoingAevt = {typeNull, NULL}; sl@0: AppleEvent returnAevt; sl@0: AEAddressDesc fndrAddress; sl@0: AEDesc nullContainer = {typeNull, NULL}, sl@0: tempDesc = {typeNull, NULL}, sl@0: tempDesc2 = {typeNull, NULL}, sl@0: finalDesc = {typeNull, NULL}; sl@0: const OSType finderSignature = 'MACS'; sl@0: sl@0: sl@0: if (outgoingAevt.descriptorType == typeNull) { sl@0: if ((Gestalt(gestaltSystemVersion, &result) != noErr) sl@0: || (result >= sys8Mask)) { sl@0: finderPrefs = 'pfrp'; sl@0: } else { sl@0: finderPrefs = 'pvwp'; sl@0: } sl@0: sl@0: AECreateDesc(typeApplSignature, &finderSignature, sl@0: sizeof(finderSignature), &fndrAddress); sl@0: sl@0: err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress, sl@0: kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt); sl@0: sl@0: AEDisposeDesc(&fndrAddress); sl@0: sl@0: /* sl@0: * The structure is: sl@0: * the property view font ('vfnt') sl@0: * of the property view preferences ('pvwp') sl@0: * of the Null Container (i.e. the Finder itself). sl@0: */ sl@0: sl@0: AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc); sl@0: err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID, sl@0: &tempDesc, true, &tempDesc2); sl@0: AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc); sl@0: err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID, sl@0: &tempDesc, true, &finalDesc); sl@0: sl@0: AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc); sl@0: AEDisposeDesc(&finalDesc); sl@0: } sl@0: sl@0: err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority, sl@0: kAEDefaultTimeout, NULL, NULL); sl@0: if (err == noErr) { sl@0: err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger, sl@0: &returnType, (void *) finderID, sizeof(int), &returnSize); sl@0: if (err == noErr) { sl@0: return TCL_OK; sl@0: } sl@0: } sl@0: return TCL_ERROR; sl@0: } sl@0: sl@0: /* sl@0: *--------------------------------------------------------------------------- sl@0: * sl@0: * TclMacGetFontEncoding -- sl@0: * sl@0: * Determine the encoding of the specified font. The encoding sl@0: * can be used to convert bytes from UTF-8 into the encoding of sl@0: * that font. sl@0: * sl@0: * Results: sl@0: * The return value is a string that specifies the font's encoding sl@0: * and that can be passed to Tcl_GetEncoding() to construct the sl@0: * encoding. If the font's encoding could not be identified, NULL sl@0: * is returned. sl@0: * sl@0: * Side effects: sl@0: * None. sl@0: * sl@0: *--------------------------------------------------------------------------- sl@0: */ sl@0: sl@0: char * sl@0: TclMacGetFontEncoding( sl@0: int fontId) sl@0: { sl@0: int script, lang; sl@0: char *name; sl@0: Map *mapPtr; sl@0: sl@0: script = FontToScript(fontId); sl@0: lang = GetScriptVariable(script, smScriptLang); sl@0: name = NULL; sl@0: if (script == smRoman) { sl@0: for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) { sl@0: if (mapPtr->numKey == lang) { sl@0: name = mapPtr->strKey; sl@0: break; sl@0: } sl@0: } sl@0: } else if (script == smCyrillic) { sl@0: for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) { sl@0: if (mapPtr->numKey == lang) { sl@0: name = mapPtr->strKey; sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: if (name == NULL) { sl@0: for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) { sl@0: if (mapPtr->numKey == script) { sl@0: name = mapPtr->strKey; sl@0: break; sl@0: } sl@0: } sl@0: } sl@0: return name; 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: tclPlatform = TCL_PLATFORM_MAC; 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 colon 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(argv0) sl@0: CONST char *argv0; /* Name of executable from argv[0] to main(). sl@0: * Not used because we can determine the name sl@0: * by querying the module handle. */ sl@0: { sl@0: Tcl_Obj *objPtr, *pathPtr; sl@0: CONST char *str; sl@0: Tcl_DString ds; sl@0: sl@0: TclMacCreateEnv(); sl@0: sl@0: pathPtr = Tcl_NewObj(); 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: str = TclGetEnv("TCL_LIBRARY", &ds); 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, Tcl_DStringLength(&ds)); sl@0: Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: sl@0: objPtr = TclGetLibraryPath(); sl@0: if (objPtr != NULL) { sl@0: Tcl_ListObjAppendList(NULL, pathPtr, objPtr); sl@0: } sl@0: sl@0: /* sl@0: * lappend path [file join $env(EXT_FOLDER) \ sl@0: * "Tool Command Language" "tcl[info version]" sl@0: */ sl@0: sl@0: str = TclGetEnv("EXT_FOLDER", &ds); sl@0: if ((str != NULL) && (str[0] != '\0')) { sl@0: Tcl_DString libPath, path; sl@0: CONST char *argv[3]; sl@0: sl@0: argv[0] = str; sl@0: argv[1] = "Tool Command Language"; sl@0: Tcl_DStringInit(&libPath); sl@0: Tcl_DStringAppend(&libPath, "tcl", -1); sl@0: argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1); sl@0: Tcl_DStringInit(&path); sl@0: str = Tcl_JoinPath(3, argv, &path); sl@0: objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path)); sl@0: Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); sl@0: Tcl_DStringFree(&ds); sl@0: Tcl_DStringFree(&libPath); sl@0: Tcl_DStringFree(&path); sl@0: } sl@0: TclSetLibraryPath(pathPtr); 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; sl@0: Tcl_Obj *pathPtr; sl@0: int fontId, err; sl@0: sl@0: fontId = 0; sl@0: GetFinderFont(&fontId); sl@0: encoding = TclMacGetFontEncoding(fontId); sl@0: if (encoding == NULL) { sl@0: encoding = "macRoman"; sl@0: } sl@0: sl@0: err = Tcl_SetSystemEncoding(NULL, encoding); sl@0: sl@0: if (err == TCL_OK && libraryPathEncodingFixed == 0) { sl@0: 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 i, objc; sl@0: Tcl_Obj **objv; sl@0: sl@0: objc = 0; sl@0: Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); sl@0: for (i = 0; i < objc; i++) { sl@0: int length; sl@0: char *string; sl@0: Tcl_DString ds; sl@0: sl@0: string = Tcl_GetStringFromObj(objv[i], &length); sl@0: Tcl_ExternalToUtfDString(NULL, string, length, &ds); sl@0: Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), sl@0: Tcl_DStringLength(&ds)); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: Tcl_InvalidateStringRep(pathPtr); 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 "tcl_library" and "tcl_platform" Tcl 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: long int gestaltResult; sl@0: int minor, major, objc; sl@0: Tcl_Obj **objv; sl@0: char versStr[2 * TCL_INTEGER_SPACE]; sl@0: CONST char *str; sl@0: Tcl_Obj *pathPtr; sl@0: Tcl_DString ds; sl@0: sl@0: str = "no library"; sl@0: pathPtr = TclGetLibraryPath(); sl@0: if (pathPtr != NULL) { sl@0: objc = 0; sl@0: Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); sl@0: if (objc > 0) { sl@0: str = Tcl_GetStringFromObj(objv[0], NULL); sl@0: } sl@0: } sl@0: Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY); sl@0: sl@0: if (pathPtr != NULL) { sl@0: Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY); sl@0: } sl@0: sl@0: Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh", sl@0: TCL_GLOBAL_ONLY); sl@0: Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY); sl@0: Gestalt(gestaltSystemVersion, &gestaltResult); sl@0: major = (gestaltResult & 0x0000FF00) >> 8; sl@0: minor = (gestaltResult & 0x000000F0) >> 4; sl@0: sprintf(versStr, "%d.%d", major, minor); sl@0: Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY); sl@0: #if GENERATINGPOWERPC sl@0: Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY); sl@0: #else sl@0: Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY); sl@0: #endif sl@0: sl@0: /* sl@0: * Copy USER or LOGIN environment variable into tcl_platform(user) sl@0: * These are set by SystemVariables in tclMacEnv.c sl@0: */ sl@0: sl@0: Tcl_DStringInit(&ds); sl@0: str = TclGetEnv("USER", &ds); sl@0: if (str == NULL) { sl@0: str = TclGetEnv("LOGIN", &ds); sl@0: if (str == NULL) { sl@0: str = ""; sl@0: } sl@0: } sl@0: Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY); sl@0: Tcl_DStringFree(&ds); sl@0: } sl@0: sl@0: /* sl@0: *---------------------------------------------------------------------- sl@0: * sl@0: * TclpCheckStackSpace -- sl@0: * sl@0: * On a 68K Mac, we can detect if we are about to blow the stack. sl@0: * Called before an evaluation can happen when nesting depth is sl@0: * 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: return StackSpace() > TCL_MAC_STACK_THRESHOLD; 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 and Macthis sl@0: * routine is case sensitive, 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 perform additional initialization for a Tcl interpreter, sl@0: * such as sourcing the "init.tcl" script. sl@0: * sl@0: * Results: sl@0: * Returns a standard Tcl completion code and sets the interp's result sl@0: * if there is an error. sl@0: * sl@0: * Side effects: sl@0: * Depends on what's in the init.tcl script. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: int sl@0: Tcl_Init( 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: /* sl@0: * For Macintosh applications the Init function may be contained in sl@0: * the application resources. If it exists we use it - otherwise we sl@0: * look in the tcl_library directory. Ditto for the history command. 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, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY); sl@0: Tcl_DecrRefCount(pathPtr); sl@0: return Tcl_Eval(interp, initCmd); 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 or Tk_Main sl@0: * procedure to source an application specific rc file into the sl@0: * interpreter at startup time. This will either source a file sl@0: * in the "tcl_rcFileName" variable or a TEXT resource in the sl@0: * "tcl_rcRsrcName" variable. sl@0: * sl@0: * Results: sl@0: * None. sl@0: * sl@0: * Side effects: sl@0: * Depends on what's in the rc script. sl@0: * sl@0: *---------------------------------------------------------------------- sl@0: */ sl@0: sl@0: void sl@0: Tcl_SourceRCFile( 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: Handle h; 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: fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY); sl@0: sl@0: if (fileName != NULL) { sl@0: Str255 rezName; sl@0: Tcl_DString ds; sl@0: Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); sl@0: strcpy((char *) rezName + 1, Tcl_DStringValue(&ds)); sl@0: rezName[0] = (unsigned) Tcl_DStringLength(&ds); sl@0: h = GetNamedResource('TEXT', rezName); sl@0: Tcl_DStringFree(&ds); sl@0: if (h != NULL) { sl@0: if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != 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: Tcl_ResetResult(interp); sl@0: ReleaseResource(h); sl@0: } sl@0: } sl@0: }