/* * tclMacInit.c -- * * Contains the Mac-specific interpreter initialization functions. * * Copyright (c) 1995-1998 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclMacInit.c,v 1.1.1.1 2007/07/10 15:04:23 duncan Exp $ */ #include #include #include #include #include #include #include #include #include #include #include #include "tclInt.h" #include "tclMacInt.h" #include "tclPort.h" #include "tclInitScript.h" /* * The following string is the startup script executed in new * interpreters. It looks on the library path and in the resource fork for * a script "init.tcl" that is compatible with this version of Tcl. The * init.tcl script does all of the real work of initialization. */ static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\ proc tclInit {} {\n\ global tcl_pkgPath env\n\ proc sourcePath {file} {\n\ foreach i $::auto_path {\n\ set init [file join $i $file.tcl]\n\ if {[catch {uplevel #0 [list source $init]}] == 0} {\n\ return\n\ }\n\ }\n\ if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\ return\n\ }\n\ rename sourcePath {}\n\ set msg \"Can't find $file resource or a usable $file.tcl file\"\n\ append msg \" in the following directories:\"\n\ append msg \" $::auto_path\"\n\ append msg \" perhaps you need to install Tcl or set your\"\n\ append msg \" TCL_LIBRARY environment variable?\"\n\ error $msg\n\ }\n\ if {[info exists env(EXT_FOLDER)]} {\n\ lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\ }\n\ if {[info exists tcl_pkgPath] == 0} {\n\ set tcl_pkgPath {no extension folder}\n\ }\n\ sourcePath init\n\ sourcePath auto\n\ sourcePath package\n\ sourcePath history\n\ sourcePath word\n\ sourcePath parray\n\ rename sourcePath {}\n\ } }\n\ tclInit"; /* * The following structures are used to map the script/language codes of a * font to the name that should be passed to Tcl_GetEncoding() to obtain * the encoding for that font. The set of numeric constants is fixed and * defined by Apple. */ typedef struct Map { int numKey; char *strKey; } Map; static Map scriptMap[] = { {smRoman, "macRoman"}, {smJapanese, "macJapan"}, {smTradChinese, "macChinese"}, {smKorean, "macKorean"}, {smArabic, "macArabic"}, {smHebrew, "macHebrew"}, {smGreek, "macGreek"}, {smCyrillic, "macCyrillic"}, {smRSymbol, "macRSymbol"}, {smDevanagari, "macDevanagari"}, {smGurmukhi, "macGurmukhi"}, {smGujarati, "macGujarati"}, {smOriya, "macOriya"}, {smBengali, "macBengali"}, {smTamil, "macTamil"}, {smTelugu, "macTelugu"}, {smKannada, "macKannada"}, {smMalayalam, "macMalayalam"}, {smSinhalese, "macSinhalese"}, {smBurmese, "macBurmese"}, {smKhmer, "macKhmer"}, {smThai, "macThailand"}, {smLaotian, "macLaos"}, {smGeorgian, "macGeorgia"}, {smArmenian, "macArmenia"}, {smSimpChinese, "macSimpChinese"}, {smTibetan, "macTIbet"}, {smMongolian, "macMongolia"}, {smGeez, "macEthiopia"}, {smEastEurRoman, "macCentEuro"}, {smVietnamese, "macVietnam"}, {smExtArabic, "macSindhi"}, {NULL, NULL} }; static Map romanMap[] = { {langCroatian, "macCroatian"}, {langSlovenian, "macCroatian"}, {langIcelandic, "macIceland"}, {langRomanian, "macRomania"}, {langTurkish, "macTurkish"}, {langGreek, "macGreek"}, {NULL, NULL} }; static Map cyrillicMap[] = { {langUkrainian, "macUkraine"}, {langBulgarian, "macBulgaria"}, {NULL, NULL} }; static int GetFinderFont(int *finderID); /* Used to store the encoding used for binary files */ static Tcl_Encoding binaryEncoding = NULL; /* Has the basic library path encoding issue been fixed */ static int libraryPathEncodingFixed = 0; /* *---------------------------------------------------------------------- * * GetFinderFont -- * * Gets the "views" font of the Macintosh Finder * * Results: * Standard Tcl result, and sets finderID to the font family * id for the current finder font. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int GetFinderFont(int *finderID) { OSErr err = noErr; OSType finderPrefs, viewFont = 'vfnt'; DescType returnType; Size returnSize; long result, sys8Mask = 0x0800; static AppleEvent outgoingAevt = {typeNull, NULL}; AppleEvent returnAevt; AEAddressDesc fndrAddress; AEDesc nullContainer = {typeNull, NULL}, tempDesc = {typeNull, NULL}, tempDesc2 = {typeNull, NULL}, finalDesc = {typeNull, NULL}; const OSType finderSignature = 'MACS'; if (outgoingAevt.descriptorType == typeNull) { if ((Gestalt(gestaltSystemVersion, &result) != noErr) || (result >= sys8Mask)) { finderPrefs = 'pfrp'; } else { finderPrefs = 'pvwp'; } AECreateDesc(typeApplSignature, &finderSignature, sizeof(finderSignature), &fndrAddress); err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress, kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt); AEDisposeDesc(&fndrAddress); /* * The structure is: * the property view font ('vfnt') * of the property view preferences ('pvwp') * of the Null Container (i.e. the Finder itself). */ AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc); err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID, &tempDesc, true, &tempDesc2); AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc); err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID, &tempDesc, true, &finalDesc); AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc); AEDisposeDesc(&finalDesc); } err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority, kAEDefaultTimeout, NULL, NULL); if (err == noErr) { err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger, &returnType, (void *) finderID, sizeof(int), &returnSize); if (err == noErr) { return TCL_OK; } } return TCL_ERROR; } /* *--------------------------------------------------------------------------- * * TclMacGetFontEncoding -- * * Determine the encoding of the specified font. The encoding * can be used to convert bytes from UTF-8 into the encoding of * that font. * * Results: * The return value is a string that specifies the font's encoding * and that can be passed to Tcl_GetEncoding() to construct the * encoding. If the font's encoding could not be identified, NULL * is returned. * * Side effects: * None. * *--------------------------------------------------------------------------- */ char * TclMacGetFontEncoding( int fontId) { int script, lang; char *name; Map *mapPtr; script = FontToScript(fontId); lang = GetScriptVariable(script, smScriptLang); name = NULL; if (script == smRoman) { for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) { if (mapPtr->numKey == lang) { name = mapPtr->strKey; break; } } } else if (script == smCyrillic) { for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) { if (mapPtr->numKey == lang) { name = mapPtr->strKey; break; } } } if (name == NULL) { for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) { if (mapPtr->numKey == script) { name = mapPtr->strKey; break; } } } return name; } /* *--------------------------------------------------------------------------- * * TclpInitPlatform -- * * Initialize all the platform-dependant things like signals and * floating-point error handling. * * Called at process initialization time. * * Results: * None. * * Side effects: * None. * *--------------------------------------------------------------------------- */ void TclpInitPlatform() { tclPlatform = TCL_PLATFORM_MAC; } /* *--------------------------------------------------------------------------- * * TclpInitLibraryPath -- * * Initialize the library path at startup. We have a minor * metacircular problem that we don't know the encoding of the * operating system but we may need to talk to operating system * to find the library directories so that we know how to talk to * the operating system. * * We do not know the encoding of the operating system. * We do know that the encoding is some multibyte encoding. * In that multibyte encoding, the characters 0..127 are equivalent * to ascii. * * So although we don't know the encoding, it's safe: * to look for the last colon character in a path in the encoding. * to append an ascii string to a path. * to pass those strings back to the operating system. * * But any strings that we remembered before we knew the encoding of * the operating system must be translated to UTF-8 once we know the * encoding so that the rest of Tcl can use those strings. * * This call sets the library path to strings in the unknown native * encoding. TclpSetInitialEncodings() will translate the library * path from the native encoding to UTF-8 as soon as it determines * what the native encoding actually is. * * Called at process initialization time. * * Results: * Return 1, indicating that the UTF may be dirty and require "cleanup" * after encodings are initialized. * * Side effects: * None. * *--------------------------------------------------------------------------- */ int TclpInitLibraryPath(argv0) CONST char *argv0; /* Name of executable from argv[0] to main(). * Not used because we can determine the name * by querying the module handle. */ { Tcl_Obj *objPtr, *pathPtr; CONST char *str; Tcl_DString ds; TclMacCreateEnv(); pathPtr = Tcl_NewObj(); /* * Look for the library relative to default encoding dir. */ str = Tcl_GetDefaultEncodingDir(); if ((str != NULL) && (str[0] != '\0')) { objPtr = Tcl_NewStringObj(str, -1); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); } str = TclGetEnv("TCL_LIBRARY", &ds); if ((str != NULL) && (str[0] != '\0')) { /* * If TCL_LIBRARY is set, search there. */ objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } objPtr = TclGetLibraryPath(); if (objPtr != NULL) { Tcl_ListObjAppendList(NULL, pathPtr, objPtr); } /* * lappend path [file join $env(EXT_FOLDER) \ * "Tool Command Language" "tcl[info version]" */ str = TclGetEnv("EXT_FOLDER", &ds); if ((str != NULL) && (str[0] != '\0')) { Tcl_DString libPath, path; CONST char *argv[3]; argv[0] = str; argv[1] = "Tool Command Language"; Tcl_DStringInit(&libPath); Tcl_DStringAppend(&libPath, "tcl", -1); argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1); Tcl_DStringInit(&path); str = Tcl_JoinPath(3, argv, &path); objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); Tcl_DStringFree(&libPath); Tcl_DStringFree(&path); } TclSetLibraryPath(pathPtr); return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */ } /* *--------------------------------------------------------------------------- * * TclpSetInitialEncodings -- * * Based on the locale, determine the encoding of the operating * system and the default encoding for newly opened files. * * Called at process initialization time, and part way through * startup, we verify that the initial encodings were correctly * setup. Depending on Tcl's environment, there may not have been * enough information first time through (above). * * Results: * None. * * Side effects: * The Tcl library path is converted from native encoding to UTF-8, * on the first call, and the encodings may be changed on first or * second call. * *--------------------------------------------------------------------------- */ void TclpSetInitialEncodings() { CONST char *encoding; Tcl_Obj *pathPtr; int fontId, err; fontId = 0; GetFinderFont(&fontId); encoding = TclMacGetFontEncoding(fontId); if (encoding == NULL) { encoding = "macRoman"; } err = Tcl_SetSystemEncoding(NULL, encoding); if (err == TCL_OK && libraryPathEncodingFixed == 0) { /* * Until the system encoding was actually set, the library path was * actually in the native multi-byte encoding, and not really UTF-8 * as advertised. We cheated as follows: * * 1. It was safe to allow the Tcl_SetSystemEncoding() call to * append the ASCII chars that make up the encoding's filename to * the names (in the native encoding) of directories in the library * path, since all Unix multi-byte encodings have ASCII in the * beginning. * * 2. To open the encoding file, the native bytes in the file name * were passed to the OS, without translating from UTF-8 to native, * because the name was already in the native encoding. * * Now that the system encoding was actually successfully set, * translate all the names in the library path to UTF-8. That way, * next time we search the library path, we'll translate the names * from UTF-8 to the system encoding which will be the native * encoding. */ pathPtr = TclGetLibraryPath(); if (pathPtr != NULL) { int i, objc; Tcl_Obj **objv; objc = 0; Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); for (i = 0; i < objc; i++) { int length; char *string; Tcl_DString ds; string = Tcl_GetStringFromObj(objv[i], &length); Tcl_ExternalToUtfDString(NULL, string, length, &ds); Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } Tcl_InvalidateStringRep(pathPtr); } libraryPathEncodingFixed = 1; } /* This is only ever called from the startup thread */ if (binaryEncoding == NULL) { /* * Keep the iso8859-1 encoding preloaded. The IO package uses * it for gets on a binary channel. */ binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1"); } } /* *--------------------------------------------------------------------------- * * TclpSetVariables -- * * Performs platform-specific interpreter initialization related to * the tcl_library and tcl_platform variables, and other platform- * specific things. * * Results: * None. * * Side effects: * Sets "tcl_library" and "tcl_platform" Tcl variables. * *---------------------------------------------------------------------- */ void TclpSetVariables(interp) Tcl_Interp *interp; { long int gestaltResult; int minor, major, objc; Tcl_Obj **objv; char versStr[2 * TCL_INTEGER_SPACE]; CONST char *str; Tcl_Obj *pathPtr; Tcl_DString ds; str = "no library"; pathPtr = TclGetLibraryPath(); if (pathPtr != NULL) { objc = 0; Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv); if (objc > 0) { str = Tcl_GetStringFromObj(objv[0], NULL); } } Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY); if (pathPtr != NULL) { Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY); } Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh", TCL_GLOBAL_ONLY); Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY); Gestalt(gestaltSystemVersion, &gestaltResult); major = (gestaltResult & 0x0000FF00) >> 8; minor = (gestaltResult & 0x000000F0) >> 4; sprintf(versStr, "%d.%d", major, minor); Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY); #if GENERATINGPOWERPC Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY); #else Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY); #endif /* * Copy USER or LOGIN environment variable into tcl_platform(user) * These are set by SystemVariables in tclMacEnv.c */ Tcl_DStringInit(&ds); str = TclGetEnv("USER", &ds); if (str == NULL) { str = TclGetEnv("LOGIN", &ds); if (str == NULL) { str = ""; } } Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY); Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * * TclpCheckStackSpace -- * * On a 68K Mac, we can detect if we are about to blow the stack. * Called before an evaluation can happen when nesting depth is * checked. * * Results: * 1 if there is enough stack space to continue; 0 if not. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpCheckStackSpace() { return StackSpace() > TCL_MAC_STACK_THRESHOLD; } /* *---------------------------------------------------------------------- * * TclpFindVariable -- * * Locate the entry in environ for a given name. On Unix and Macthis * routine is case sensitive, on Windows this matches mixed case. * * Results: * The return value is the index in environ of an entry with the * name "name", or -1 if there is no such entry. The integer at * *lengthPtr is filled in with the length of name (if a matching * entry is found) or the length of the environ array (if no matching * entry is found). * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclpFindVariable(name, lengthPtr) CONST char *name; /* Name of desired environment variable * (native). */ int *lengthPtr; /* Used to return length of name (for * successful searches) or number of non-NULL * entries in environ (for unsuccessful * searches). */ { int i, result = -1; register CONST char *env, *p1, *p2; Tcl_DString envString; Tcl_DStringInit(&envString); for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) { p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString); p2 = name; for (; *p2 == *p1; p1++, p2++) { /* NULL loop body. */ } if ((*p1 == '=') && (*p2 == '\0')) { *lengthPtr = p2 - name; result = i; goto done; } Tcl_DStringFree(&envString); } *lengthPtr = i; done: Tcl_DStringFree(&envString); return result; } /* *---------------------------------------------------------------------- * * Tcl_Init -- * * This procedure is typically invoked by Tcl_AppInit procedures * to perform additional initialization for a Tcl interpreter, * such as sourcing the "init.tcl" script. * * Results: * Returns a standard Tcl completion code and sets the interp's result * if there is an error. * * Side effects: * Depends on what's in the init.tcl script. * *---------------------------------------------------------------------- */ int Tcl_Init( Tcl_Interp *interp) /* Interpreter to initialize. */ { Tcl_Obj *pathPtr; if (tclPreInitScript != NULL) { if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) { return (TCL_ERROR); }; } /* * For Macintosh applications the Init function may be contained in * the application resources. If it exists we use it - otherwise we * look in the tcl_library directory. Ditto for the history command. */ pathPtr = TclGetLibraryPath(); if (pathPtr == NULL) { pathPtr = Tcl_NewObj(); } Tcl_IncrRefCount(pathPtr); Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY); Tcl_DecrRefCount(pathPtr); return Tcl_Eval(interp, initCmd); } /* *---------------------------------------------------------------------- * * Tcl_SourceRCFile -- * * This procedure is typically invoked by Tcl_Main or Tk_Main * procedure to source an application specific rc file into the * interpreter at startup time. This will either source a file * in the "tcl_rcFileName" variable or a TEXT resource in the * "tcl_rcRsrcName" variable. * * Results: * None. * * Side effects: * Depends on what's in the rc script. * *---------------------------------------------------------------------- */ void Tcl_SourceRCFile( Tcl_Interp *interp) /* Interpreter to source rc file into. */ { Tcl_DString temp; CONST char *fileName; Tcl_Channel errChannel; Handle h; fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; CONST char *fullName; Tcl_DStringInit(&temp); fullName = Tcl_TranslateFileName(interp, fileName, &temp); if (fullName == NULL) { /* * Couldn't translate the file name (e.g. it referred to a * bogus user or there was no HOME environment variable). * Just do nothing. */ } else { /* * Test for the existence of the rc file before trying to read it. */ c = Tcl_OpenFileChannel(NULL, fullName, "r", 0); if (c != (Tcl_Channel) NULL) { Tcl_Close(NULL, c); if (Tcl_EvalFile(interp, fullName) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } } } Tcl_DStringFree(&temp); } fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY); if (fileName != NULL) { Str255 rezName; Tcl_DString ds; Tcl_UtfToExternalDString(NULL, fileName, -1, &ds); strcpy((char *) rezName + 1, Tcl_DStringValue(&ds)); rezName[0] = (unsigned) Tcl_DStringLength(&ds); h = GetNamedResource('TEXT', rezName); Tcl_DStringFree(&ds); if (h != NULL) { if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) { errChannel = Tcl_GetStdChannel(TCL_STDERR); if (errChannel) { Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); Tcl_WriteChars(errChannel, "\n", 1); } } Tcl_ResetResult(interp); ReleaseResource(h); } } }