diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacInit.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacInit.c Fri Jun 15 03:10:57 2012 +0200 @@ -0,0 +1,807 @@ +/* + * 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.9.2.2 2005/10/23 22:01:31 msofer 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); + } + } +}