#include <AppleEvents.h>
#include <AEDataModel.h>
#include <AEObjects.h>
#include <AEPackObject.h>
#include <AERegistry.h>
#include <Files.h>
#include <Folders.h>
#include <Gestalt.h>
#include <TextUtils.h>
#include <Resources.h>
#include <Strings.h>
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclPort.h"
#include "tclInitScript.h"
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";
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);
static Tcl_Encoding binaryEncoding = NULL;
static int libraryPathEncodingFixed = 0;
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);
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;
}
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;
}
void
TclpInitPlatform()
{
tclPlatform = TCL_PLATFORM_MAC;
}
void
TclpInitLibraryPath(argv0)
CONST char *argv0;
{
Tcl_Obj *objPtr, *pathPtr;
CONST char *str;
Tcl_DString ds;
TclMacCreateEnv();
pathPtr = Tcl_NewObj();
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')) {
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);
}
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);
}
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) {
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;
}
if (binaryEncoding == NULL) {
binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
}
}
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
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);
}
int
TclpCheckStackSpace()
{
return StackSpace() > TCL_MAC_STACK_THRESHOLD;
}
int
TclpFindVariable(name, lengthPtr)
CONST char *name;
int *lengthPtr;
{
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++) {
}
if ((*p1 == '=') && (*p2 == '\0')) {
*lengthPtr = p2 - name;
result = i;
goto done;
}
Tcl_DStringFree(&envString);
}
*lengthPtr = i;
done:
Tcl_DStringFree(&envString);
return result;
}
int
Tcl_Init(
Tcl_Interp *interp)
{
Tcl_Obj *pathPtr;
if (tclPreInitScript != NULL) {
if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
return (TCL_ERROR);
};
}
pathPtr = TclGetLibraryPath();
if (pathPtr == NULL) {
pathPtr = Tcl_NewObj();
}
Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
return Tcl_Eval(interp, initCmd);
}
void
Tcl_SourceRCFile(
Tcl_Interp *interp)
{
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) {
} else {
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);
}
}
}