tclmacinit.c

tcl是工具命令语言

/*
 * 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 2002/02/08 02:52:54 dgp Exp $
 */

#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"

/*
 * 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:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
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);