os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacInit.c
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
sl@0
     1
/*
sl@0
     2
 * tclMacInit.c --
sl@0
     3
 *
sl@0
     4
 *	Contains the Mac-specific interpreter initialization functions.
sl@0
     5
 *
sl@0
     6
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
sl@0
     7
 *
sl@0
     8
 * See the file "license.terms" for information on usage and redistribution
sl@0
     9
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    10
 *
sl@0
    11
 * RCS: @(#) $Id: tclMacInit.c,v 1.9.2.2 2005/10/23 22:01:31 msofer Exp $
sl@0
    12
 */
sl@0
    13
sl@0
    14
#include <AppleEvents.h>
sl@0
    15
#include <AEDataModel.h>
sl@0
    16
#include <AEObjects.h>
sl@0
    17
#include <AEPackObject.h>
sl@0
    18
#include <AERegistry.h>
sl@0
    19
#include <Files.h>
sl@0
    20
#include <Folders.h>
sl@0
    21
#include <Gestalt.h>
sl@0
    22
#include <TextUtils.h>
sl@0
    23
#include <Resources.h>
sl@0
    24
#include <Strings.h>
sl@0
    25
#include "tclInt.h"
sl@0
    26
#include "tclMacInt.h"
sl@0
    27
#include "tclPort.h"
sl@0
    28
#include "tclInitScript.h"
sl@0
    29
sl@0
    30
/*
sl@0
    31
 * The following string is the startup script executed in new
sl@0
    32
 * interpreters.  It looks on the library path and in the resource fork for
sl@0
    33
 * a script "init.tcl" that is compatible with this version of Tcl.  The
sl@0
    34
 * init.tcl script does all of the real work of initialization.
sl@0
    35
 */
sl@0
    36
 
sl@0
    37
static char initCmd[] = "if {[info proc tclInit]==\"\"} {\n\
sl@0
    38
proc tclInit {} {\n\
sl@0
    39
global tcl_pkgPath env\n\
sl@0
    40
proc sourcePath {file} {\n\
sl@0
    41
  foreach i $::auto_path {\n\
sl@0
    42
    set init [file join $i $file.tcl]\n\
sl@0
    43
    if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
sl@0
    44
      return\n\
sl@0
    45
    }\n\
sl@0
    46
  }\n\
sl@0
    47
  if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
sl@0
    48
    return\n\
sl@0
    49
  }\n\
sl@0
    50
  rename sourcePath {}\n\
sl@0
    51
  set msg \"Can't find $file resource or a usable $file.tcl file\"\n\
sl@0
    52
  append msg \" in the following directories:\"\n\
sl@0
    53
  append msg \" $::auto_path\"\n\
sl@0
    54
  append msg \" perhaps you need to install Tcl or set your\"\n\
sl@0
    55
  append msg \" TCL_LIBRARY environment variable?\"\n\
sl@0
    56
  error $msg\n\
sl@0
    57
}\n\
sl@0
    58
if {[info exists env(EXT_FOLDER)]} {\n\
sl@0
    59
  lappend tcl_pkgPath [file join $env(EXT_FOLDER) {Tool Command Language}]\n\
sl@0
    60
}\n\
sl@0
    61
if {[info exists tcl_pkgPath] == 0} {\n\
sl@0
    62
  set tcl_pkgPath {no extension folder}\n\
sl@0
    63
}\n\
sl@0
    64
sourcePath init\n\
sl@0
    65
sourcePath auto\n\
sl@0
    66
sourcePath package\n\
sl@0
    67
sourcePath history\n\
sl@0
    68
sourcePath word\n\
sl@0
    69
sourcePath parray\n\
sl@0
    70
rename sourcePath {}\n\
sl@0
    71
} }\n\
sl@0
    72
tclInit";
sl@0
    73
sl@0
    74
/*
sl@0
    75
 * The following structures are used to map the script/language codes of a 
sl@0
    76
 * font to the name that should be passed to Tcl_GetEncoding() to obtain
sl@0
    77
 * the encoding for that font.  The set of numeric constants is fixed and 
sl@0
    78
 * defined by Apple.
sl@0
    79
 */
sl@0
    80
 
sl@0
    81
typedef struct Map {
sl@0
    82
    int numKey;
sl@0
    83
    char *strKey;
sl@0
    84
} Map;
sl@0
    85
 
sl@0
    86
static Map scriptMap[] = {
sl@0
    87
    {smRoman,		"macRoman"},
sl@0
    88
    {smJapanese,	"macJapan"},
sl@0
    89
    {smTradChinese,	"macChinese"},
sl@0
    90
    {smKorean,		"macKorean"},
sl@0
    91
    {smArabic,		"macArabic"},
sl@0
    92
    {smHebrew,		"macHebrew"},
sl@0
    93
    {smGreek,		"macGreek"},
sl@0
    94
    {smCyrillic,	"macCyrillic"},
sl@0
    95
    {smRSymbol,		"macRSymbol"},
sl@0
    96
    {smDevanagari,	"macDevanagari"},
sl@0
    97
    {smGurmukhi,	"macGurmukhi"},
sl@0
    98
    {smGujarati,	"macGujarati"},
sl@0
    99
    {smOriya,		"macOriya"},
sl@0
   100
    {smBengali,		"macBengali"},
sl@0
   101
    {smTamil,		"macTamil"},
sl@0
   102
    {smTelugu,		"macTelugu"},
sl@0
   103
    {smKannada,		"macKannada"},
sl@0
   104
    {smMalayalam,	"macMalayalam"},
sl@0
   105
    {smSinhalese,	"macSinhalese"},
sl@0
   106
    {smBurmese,		"macBurmese"},
sl@0
   107
    {smKhmer,		"macKhmer"},
sl@0
   108
    {smThai,		"macThailand"},
sl@0
   109
    {smLaotian,		"macLaos"},
sl@0
   110
    {smGeorgian,	"macGeorgia"},
sl@0
   111
    {smArmenian,	"macArmenia"},
sl@0
   112
    {smSimpChinese,	"macSimpChinese"},
sl@0
   113
    {smTibetan,		"macTIbet"},
sl@0
   114
    {smMongolian,	"macMongolia"},
sl@0
   115
    {smGeez,		"macEthiopia"},
sl@0
   116
    {smEastEurRoman,	"macCentEuro"},
sl@0
   117
    {smVietnamese,	"macVietnam"},
sl@0
   118
    {smExtArabic,	"macSindhi"},
sl@0
   119
    {NULL,		NULL}
sl@0
   120
};    
sl@0
   121
sl@0
   122
static Map romanMap[] = {
sl@0
   123
    {langCroatian,	"macCroatian"},
sl@0
   124
    {langSlovenian,	"macCroatian"},
sl@0
   125
    {langIcelandic,	"macIceland"},
sl@0
   126
    {langRomanian,	"macRomania"},
sl@0
   127
    {langTurkish,	"macTurkish"},
sl@0
   128
    {langGreek,		"macGreek"},
sl@0
   129
    {NULL,		NULL}
sl@0
   130
};
sl@0
   131
sl@0
   132
static Map cyrillicMap[] = {
sl@0
   133
    {langUkrainian,	"macUkraine"},
sl@0
   134
    {langBulgarian,	"macBulgaria"},
sl@0
   135
    {NULL,		NULL}
sl@0
   136
};
sl@0
   137
sl@0
   138
static int		GetFinderFont(int *finderID);
sl@0
   139
sl@0
   140
/* Used to store the encoding used for binary files */
sl@0
   141
static Tcl_Encoding binaryEncoding = NULL;
sl@0
   142
/* Has the basic library path encoding issue been fixed */
sl@0
   143
static int libraryPathEncodingFixed = 0;
sl@0
   144
sl@0
   145

sl@0
   146
/*
sl@0
   147
 *----------------------------------------------------------------------
sl@0
   148
 *
sl@0
   149
 * GetFinderFont --
sl@0
   150
 *
sl@0
   151
 *	Gets the "views" font of the Macintosh Finder
sl@0
   152
 *
sl@0
   153
 * Results:
sl@0
   154
 *	Standard Tcl result, and sets finderID to the font family
sl@0
   155
 *      id for the current finder font.
sl@0
   156
 *
sl@0
   157
 * Side effects:
sl@0
   158
 *	None.
sl@0
   159
 *
sl@0
   160
 *----------------------------------------------------------------------
sl@0
   161
 */
sl@0
   162
static int
sl@0
   163
GetFinderFont(int *finderID)
sl@0
   164
{
sl@0
   165
    OSErr err = noErr;
sl@0
   166
    OSType finderPrefs, viewFont = 'vfnt';
sl@0
   167
    DescType returnType;
sl@0
   168
    Size returnSize;
sl@0
   169
    long result, sys8Mask = 0x0800;
sl@0
   170
    static AppleEvent outgoingAevt = {typeNull, NULL};
sl@0
   171
    AppleEvent returnAevt;
sl@0
   172
    AEAddressDesc fndrAddress;
sl@0
   173
    AEDesc nullContainer = {typeNull, NULL}, 
sl@0
   174
           tempDesc = {typeNull, NULL}, 
sl@0
   175
           tempDesc2 = {typeNull, NULL}, 
sl@0
   176
           finalDesc = {typeNull, NULL};
sl@0
   177
    const OSType finderSignature = 'MACS';
sl@0
   178
    
sl@0
   179
    
sl@0
   180
    if (outgoingAevt.descriptorType == typeNull) {
sl@0
   181
        if ((Gestalt(gestaltSystemVersion, &result) != noErr)
sl@0
   182
	        || (result >= sys8Mask)) {
sl@0
   183
            finderPrefs = 'pfrp';
sl@0
   184
        } else {
sl@0
   185
	    finderPrefs = 'pvwp';
sl@0
   186
        }
sl@0
   187
        
sl@0
   188
        AECreateDesc(typeApplSignature, &finderSignature,
sl@0
   189
		sizeof(finderSignature), &fndrAddress);
sl@0
   190
            
sl@0
   191
        err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress, 
sl@0
   192
                kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
sl@0
   193
                
sl@0
   194
        AEDisposeDesc(&fndrAddress);
sl@0
   195
    
sl@0
   196
        /*
sl@0
   197
         * The structure is:
sl@0
   198
         * the property view font ('vfnt')
sl@0
   199
         *    of the property view preferences ('pvwp')
sl@0
   200
         *        of the Null Container (i.e. the Finder itself). 
sl@0
   201
         */
sl@0
   202
         
sl@0
   203
        AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
sl@0
   204
        err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
sl@0
   205
		&tempDesc, true, &tempDesc2);
sl@0
   206
        AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
sl@0
   207
        err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
sl@0
   208
		&tempDesc, true, &finalDesc);
sl@0
   209
    
sl@0
   210
        AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
sl@0
   211
        AEDisposeDesc(&finalDesc);
sl@0
   212
    }
sl@0
   213
             
sl@0
   214
    err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
sl@0
   215
	    kAEDefaultTimeout, NULL, NULL);
sl@0
   216
    if (err == noErr) {
sl@0
   217
        err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger, 
sl@0
   218
                &returnType, (void *) finderID, sizeof(int), &returnSize);
sl@0
   219
        if (err == noErr) {
sl@0
   220
            return TCL_OK;
sl@0
   221
        }
sl@0
   222
    }
sl@0
   223
    return TCL_ERROR;
sl@0
   224
}
sl@0
   225

sl@0
   226
/*
sl@0
   227
 *---------------------------------------------------------------------------
sl@0
   228
 *
sl@0
   229
 * TclMacGetFontEncoding --
sl@0
   230
 *
sl@0
   231
 *	Determine the encoding of the specified font.  The encoding
sl@0
   232
 *	can be used to convert bytes from UTF-8 into the encoding of
sl@0
   233
 *	that font.
sl@0
   234
 *
sl@0
   235
 * Results:
sl@0
   236
 *	The return value is a string that specifies the font's encoding
sl@0
   237
 *	and that can be passed to Tcl_GetEncoding() to construct the
sl@0
   238
 *	encoding.  If the font's encoding could not be identified, NULL
sl@0
   239
 *	is returned.
sl@0
   240
 *
sl@0
   241
 * Side effects:
sl@0
   242
 *	None.
sl@0
   243
 *
sl@0
   244
 *---------------------------------------------------------------------------
sl@0
   245
 */
sl@0
   246
 
sl@0
   247
char *
sl@0
   248
TclMacGetFontEncoding(
sl@0
   249
    int fontId)
sl@0
   250
{
sl@0
   251
    int script, lang;
sl@0
   252
    char *name;
sl@0
   253
    Map *mapPtr;
sl@0
   254
    
sl@0
   255
    script = FontToScript(fontId);    
sl@0
   256
    lang = GetScriptVariable(script, smScriptLang);
sl@0
   257
    name = NULL;
sl@0
   258
    if (script == smRoman) {
sl@0
   259
        for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
sl@0
   260
            if (mapPtr->numKey == lang) {
sl@0
   261
                name = mapPtr->strKey;
sl@0
   262
                break;
sl@0
   263
            }
sl@0
   264
        }
sl@0
   265
    } else if (script == smCyrillic) {
sl@0
   266
        for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
sl@0
   267
            if (mapPtr->numKey == lang) {
sl@0
   268
                name = mapPtr->strKey;
sl@0
   269
                break;
sl@0
   270
            }
sl@0
   271
        }
sl@0
   272
    }
sl@0
   273
    if (name == NULL) {
sl@0
   274
        for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
sl@0
   275
            if (mapPtr->numKey == script) {
sl@0
   276
                name = mapPtr->strKey;
sl@0
   277
                break;
sl@0
   278
            }
sl@0
   279
        }
sl@0
   280
    }
sl@0
   281
    return name;
sl@0
   282
}
sl@0
   283

sl@0
   284
/*
sl@0
   285
 *---------------------------------------------------------------------------
sl@0
   286
 *
sl@0
   287
 * TclpInitPlatform --
sl@0
   288
 *
sl@0
   289
 *	Initialize all the platform-dependant things like signals and
sl@0
   290
 *	floating-point error handling.
sl@0
   291
 *
sl@0
   292
 *	Called at process initialization time.
sl@0
   293
 *
sl@0
   294
 * Results:
sl@0
   295
 *	None.
sl@0
   296
 *
sl@0
   297
 * Side effects:
sl@0
   298
 *	None.
sl@0
   299
 *
sl@0
   300
 *---------------------------------------------------------------------------
sl@0
   301
 */
sl@0
   302
sl@0
   303
void
sl@0
   304
TclpInitPlatform()
sl@0
   305
{
sl@0
   306
    tclPlatform = TCL_PLATFORM_MAC;
sl@0
   307
}
sl@0
   308

sl@0
   309
/*
sl@0
   310
 *---------------------------------------------------------------------------
sl@0
   311
 *
sl@0
   312
 * TclpInitLibraryPath --
sl@0
   313
 *
sl@0
   314
 *	Initialize the library path at startup.  We have a minor
sl@0
   315
 *	metacircular problem that we don't know the encoding of the
sl@0
   316
 *	operating system but we may need to talk to operating system
sl@0
   317
 *	to find the library directories so that we know how to talk to
sl@0
   318
 *	the operating system.
sl@0
   319
 *
sl@0
   320
 *	We do not know the encoding of the operating system.
sl@0
   321
 *	We do know that the encoding is some multibyte encoding.
sl@0
   322
 *	In that multibyte encoding, the characters 0..127 are equivalent
sl@0
   323
 *	    to ascii.
sl@0
   324
 *
sl@0
   325
 *	So although we don't know the encoding, it's safe:
sl@0
   326
 *	    to look for the last colon character in a path in the encoding.
sl@0
   327
 *	    to append an ascii string to a path.
sl@0
   328
 *	    to pass those strings back to the operating system.
sl@0
   329
 *
sl@0
   330
 *	But any strings that we remembered before we knew the encoding of
sl@0
   331
 *	the operating system must be translated to UTF-8 once we know the
sl@0
   332
 *	encoding so that the rest of Tcl can use those strings.
sl@0
   333
 *
sl@0
   334
 *	This call sets the library path to strings in the unknown native
sl@0
   335
 *	encoding.  TclpSetInitialEncodings() will translate the library
sl@0
   336
 *	path from the native encoding to UTF-8 as soon as it determines
sl@0
   337
 *	what the native encoding actually is.
sl@0
   338
 *
sl@0
   339
 *	Called at process initialization time.
sl@0
   340
 *
sl@0
   341
 * Results:
sl@0
   342
 *	Return 1, indicating that the UTF may be dirty and require "cleanup"
sl@0
   343
 *	after encodings are initialized.
sl@0
   344
 *
sl@0
   345
 * Side effects:
sl@0
   346
 *	None.
sl@0
   347
 *
sl@0
   348
 *---------------------------------------------------------------------------
sl@0
   349
 */
sl@0
   350
sl@0
   351
int
sl@0
   352
TclpInitLibraryPath(argv0)
sl@0
   353
    CONST char *argv0;		/* Name of executable from argv[0] to main().
sl@0
   354
				 * Not used because we can determine the name
sl@0
   355
				 * by querying the module handle. */
sl@0
   356
{
sl@0
   357
    Tcl_Obj *objPtr, *pathPtr;
sl@0
   358
    CONST char *str;
sl@0
   359
    Tcl_DString ds;
sl@0
   360
    
sl@0
   361
    TclMacCreateEnv();
sl@0
   362
sl@0
   363
    pathPtr = Tcl_NewObj();
sl@0
   364
    
sl@0
   365
    /*
sl@0
   366
     * Look for the library relative to default encoding dir.
sl@0
   367
     */
sl@0
   368
sl@0
   369
    str = Tcl_GetDefaultEncodingDir();
sl@0
   370
    if ((str != NULL) && (str[0] != '\0')) {
sl@0
   371
	objPtr = Tcl_NewStringObj(str, -1);
sl@0
   372
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0
   373
    }
sl@0
   374
sl@0
   375
    str = TclGetEnv("TCL_LIBRARY", &ds);
sl@0
   376
    if ((str != NULL) && (str[0] != '\0')) {
sl@0
   377
	/*
sl@0
   378
	 * If TCL_LIBRARY is set, search there.
sl@0
   379
	 */
sl@0
   380
	 
sl@0
   381
	objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
sl@0
   382
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0
   383
	Tcl_DStringFree(&ds);
sl@0
   384
    }
sl@0
   385
    
sl@0
   386
    objPtr = TclGetLibraryPath();
sl@0
   387
    if (objPtr != NULL) {
sl@0
   388
        Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
sl@0
   389
    }
sl@0
   390
    
sl@0
   391
    /*
sl@0
   392
     * lappend path [file join $env(EXT_FOLDER) \
sl@0
   393
     *      "Tool Command Language" "tcl[info version]"
sl@0
   394
     */
sl@0
   395
sl@0
   396
    str = TclGetEnv("EXT_FOLDER", &ds);
sl@0
   397
    if ((str != NULL) && (str[0] != '\0')) {
sl@0
   398
	    Tcl_DString libPath, path;
sl@0
   399
	    CONST char *argv[3];
sl@0
   400
	    
sl@0
   401
	    argv[0] = str;
sl@0
   402
	    argv[1] = "Tool Command Language";	    
sl@0
   403
	    Tcl_DStringInit(&libPath);
sl@0
   404
	    Tcl_DStringAppend(&libPath, "tcl", -1);
sl@0
   405
	    argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
sl@0
   406
	    Tcl_DStringInit(&path);
sl@0
   407
	    str = Tcl_JoinPath(3, argv, &path);
sl@0
   408
        objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
sl@0
   409
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
sl@0
   410
	    Tcl_DStringFree(&ds);
sl@0
   411
	    Tcl_DStringFree(&libPath);
sl@0
   412
	    Tcl_DStringFree(&path);
sl@0
   413
    }    
sl@0
   414
    TclSetLibraryPath(pathPtr);
sl@0
   415
sl@0
   416
    return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
sl@0
   417
}
sl@0
   418

sl@0
   419
/*
sl@0
   420
 *---------------------------------------------------------------------------
sl@0
   421
 *
sl@0
   422
 * TclpSetInitialEncodings --
sl@0
   423
 *
sl@0
   424
 *	Based on the locale, determine the encoding of the operating
sl@0
   425
 *	system and the default encoding for newly opened files.
sl@0
   426
 *
sl@0
   427
 *	Called at process initialization time, and part way through
sl@0
   428
 *	startup, we verify that the initial encodings were correctly
sl@0
   429
 *	setup.  Depending on Tcl's environment, there may not have been
sl@0
   430
 *	enough information first time through (above).
sl@0
   431
 *
sl@0
   432
 * Results:
sl@0
   433
 *	None.
sl@0
   434
 *
sl@0
   435
 * Side effects:
sl@0
   436
 *	The Tcl library path is converted from native encoding to UTF-8,
sl@0
   437
 *	on the first call, and the encodings may be changed on first or
sl@0
   438
 *	second call.
sl@0
   439
 *
sl@0
   440
 *---------------------------------------------------------------------------
sl@0
   441
 */
sl@0
   442
sl@0
   443
void
sl@0
   444
TclpSetInitialEncodings()
sl@0
   445
{
sl@0
   446
    CONST char *encoding;
sl@0
   447
    Tcl_Obj *pathPtr;
sl@0
   448
    int fontId, err;
sl@0
   449
    
sl@0
   450
    fontId = 0;
sl@0
   451
    GetFinderFont(&fontId);
sl@0
   452
    encoding = TclMacGetFontEncoding(fontId);
sl@0
   453
    if (encoding == NULL) {
sl@0
   454
        encoding = "macRoman";
sl@0
   455
    }
sl@0
   456
    
sl@0
   457
    err = Tcl_SetSystemEncoding(NULL, encoding);
sl@0
   458
sl@0
   459
    if (err == TCL_OK && libraryPathEncodingFixed == 0) {
sl@0
   460
	
sl@0
   461
    /*
sl@0
   462
     * Until the system encoding was actually set, the library path was
sl@0
   463
     * actually in the native multi-byte encoding, and not really UTF-8
sl@0
   464
     * as advertised.  We cheated as follows:
sl@0
   465
     *
sl@0
   466
     * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 
sl@0
   467
     * append the ASCII chars that make up the encoding's filename to 
sl@0
   468
     * the names (in the native encoding) of directories in the library 
sl@0
   469
     * path, since all Unix multi-byte encodings have ASCII in the
sl@0
   470
     * beginning.
sl@0
   471
     *
sl@0
   472
     * 2. To open the encoding file, the native bytes in the file name
sl@0
   473
     * were passed to the OS, without translating from UTF-8 to native,
sl@0
   474
     * because the name was already in the native encoding.
sl@0
   475
     *
sl@0
   476
     * Now that the system encoding was actually successfully set,
sl@0
   477
     * translate all the names in the library path to UTF-8.  That way,
sl@0
   478
     * next time we search the library path, we'll translate the names 
sl@0
   479
     * from UTF-8 to the system encoding which will be the native 
sl@0
   480
     * encoding.
sl@0
   481
     */
sl@0
   482
sl@0
   483
    pathPtr = TclGetLibraryPath();
sl@0
   484
    if (pathPtr != NULL) {
sl@0
   485
    	int i, objc;
sl@0
   486
	Tcl_Obj **objv;
sl@0
   487
	
sl@0
   488
	objc = 0;
sl@0
   489
	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
sl@0
   490
	for (i = 0; i < objc; i++) {
sl@0
   491
	    int length;
sl@0
   492
	    char *string;
sl@0
   493
	    Tcl_DString ds;
sl@0
   494
sl@0
   495
	    string = Tcl_GetStringFromObj(objv[i], &length);
sl@0
   496
	    Tcl_ExternalToUtfDString(NULL, string, length, &ds);
sl@0
   497
	    Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
sl@0
   498
		    Tcl_DStringLength(&ds));
sl@0
   499
	    Tcl_DStringFree(&ds);
sl@0
   500
	}
sl@0
   501
	Tcl_InvalidateStringRep(pathPtr);
sl@0
   502
    }
sl@0
   503
	libraryPathEncodingFixed = 1;
sl@0
   504
    }
sl@0
   505
    
sl@0
   506
    /* This is only ever called from the startup thread */
sl@0
   507
    if (binaryEncoding == NULL) {
sl@0
   508
	/*
sl@0
   509
	 * Keep the iso8859-1 encoding preloaded.  The IO package uses
sl@0
   510
	 * it for gets on a binary channel.
sl@0
   511
	 */
sl@0
   512
	binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
sl@0
   513
    }
sl@0
   514
}   
sl@0
   515

sl@0
   516
/*
sl@0
   517
 *---------------------------------------------------------------------------
sl@0
   518
 *
sl@0
   519
 * TclpSetVariables --
sl@0
   520
 *
sl@0
   521
 *	Performs platform-specific interpreter initialization related to
sl@0
   522
 *	the tcl_library and tcl_platform variables, and other platform-
sl@0
   523
 *	specific things.
sl@0
   524
 *
sl@0
   525
 * Results:
sl@0
   526
 *	None.
sl@0
   527
 *
sl@0
   528
 * Side effects:
sl@0
   529
 *	Sets "tcl_library" and "tcl_platform" Tcl variables.
sl@0
   530
 *
sl@0
   531
 *----------------------------------------------------------------------
sl@0
   532
 */
sl@0
   533
sl@0
   534
void
sl@0
   535
TclpSetVariables(interp)
sl@0
   536
    Tcl_Interp *interp;
sl@0
   537
{
sl@0
   538
    long int gestaltResult;
sl@0
   539
    int minor, major, objc;
sl@0
   540
    Tcl_Obj **objv;
sl@0
   541
    char versStr[2 * TCL_INTEGER_SPACE];
sl@0
   542
    CONST char *str;
sl@0
   543
    Tcl_Obj *pathPtr;
sl@0
   544
    Tcl_DString ds;
sl@0
   545
sl@0
   546
    str = "no library";
sl@0
   547
    pathPtr = TclGetLibraryPath();
sl@0
   548
    if (pathPtr != NULL) {
sl@0
   549
        objc = 0;
sl@0
   550
        Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
sl@0
   551
        if (objc > 0) {
sl@0
   552
            str = Tcl_GetStringFromObj(objv[0], NULL);
sl@0
   553
        }
sl@0
   554
    }
sl@0
   555
    Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
sl@0
   556
    
sl@0
   557
    if (pathPtr != NULL) {
sl@0
   558
        Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
sl@0
   559
    }
sl@0
   560
    
sl@0
   561
    Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
sl@0
   562
	    TCL_GLOBAL_ONLY);
sl@0
   563
    Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
sl@0
   564
    Gestalt(gestaltSystemVersion, &gestaltResult);
sl@0
   565
    major = (gestaltResult & 0x0000FF00) >> 8;
sl@0
   566
    minor = (gestaltResult & 0x000000F0) >> 4;
sl@0
   567
    sprintf(versStr, "%d.%d", major, minor);
sl@0
   568
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
sl@0
   569
#if GENERATINGPOWERPC
sl@0
   570
    Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
sl@0
   571
#else
sl@0
   572
    Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
sl@0
   573
#endif
sl@0
   574
sl@0
   575
    /*
sl@0
   576
     * Copy USER or LOGIN environment variable into tcl_platform(user)
sl@0
   577
     * These are set by SystemVariables in tclMacEnv.c
sl@0
   578
     */
sl@0
   579
sl@0
   580
    Tcl_DStringInit(&ds);
sl@0
   581
    str = TclGetEnv("USER", &ds);
sl@0
   582
    if (str == NULL) {
sl@0
   583
	str = TclGetEnv("LOGIN", &ds);
sl@0
   584
	if (str == NULL) {
sl@0
   585
	    str = "";
sl@0
   586
	}
sl@0
   587
    }
sl@0
   588
    Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
sl@0
   589
    Tcl_DStringFree(&ds);
sl@0
   590
}
sl@0
   591

sl@0
   592
/*
sl@0
   593
 *----------------------------------------------------------------------
sl@0
   594
 *
sl@0
   595
 * TclpCheckStackSpace --
sl@0
   596
 *
sl@0
   597
 *	On a 68K Mac, we can detect if we are about to blow the stack.
sl@0
   598
 *	Called before an evaluation can happen when nesting depth is
sl@0
   599
 *	checked.
sl@0
   600
 *
sl@0
   601
 * Results:
sl@0
   602
 *	1 if there is enough stack space to continue; 0 if not.
sl@0
   603
 *
sl@0
   604
 * Side effects:
sl@0
   605
 *	None.
sl@0
   606
 *
sl@0
   607
 *----------------------------------------------------------------------
sl@0
   608
 */
sl@0
   609
sl@0
   610
int
sl@0
   611
TclpCheckStackSpace()
sl@0
   612
{
sl@0
   613
    return StackSpace() > TCL_MAC_STACK_THRESHOLD;
sl@0
   614
}
sl@0
   615

sl@0
   616
/*
sl@0
   617
 *----------------------------------------------------------------------
sl@0
   618
 *
sl@0
   619
 * TclpFindVariable --
sl@0
   620
 *
sl@0
   621
 *	Locate the entry in environ for a given name.  On Unix and Macthis 
sl@0
   622
 *	routine is case sensitive, on Windows this matches mixed case.
sl@0
   623
 *
sl@0
   624
 * Results:
sl@0
   625
 *	The return value is the index in environ of an entry with the
sl@0
   626
 *	name "name", or -1 if there is no such entry.   The integer at
sl@0
   627
 *	*lengthPtr is filled in with the length of name (if a matching
sl@0
   628
 *	entry is found) or the length of the environ array (if no matching
sl@0
   629
 *	entry is found).
sl@0
   630
 *
sl@0
   631
 * Side effects:
sl@0
   632
 *	None.
sl@0
   633
 *
sl@0
   634
 *----------------------------------------------------------------------
sl@0
   635
 */
sl@0
   636
sl@0
   637
int
sl@0
   638
TclpFindVariable(name, lengthPtr)
sl@0
   639
    CONST char *name;		/* Name of desired environment variable
sl@0
   640
				 * (native). */
sl@0
   641
    int *lengthPtr;		/* Used to return length of name (for
sl@0
   642
				 * successful searches) or number of non-NULL
sl@0
   643
				 * entries in environ (for unsuccessful
sl@0
   644
				 * searches). */
sl@0
   645
{
sl@0
   646
    int i, result = -1;
sl@0
   647
    register CONST char *env, *p1, *p2;
sl@0
   648
    Tcl_DString envString;
sl@0
   649
sl@0
   650
    Tcl_DStringInit(&envString);
sl@0
   651
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
sl@0
   652
	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
sl@0
   653
	p2 = name;
sl@0
   654
sl@0
   655
	for (; *p2 == *p1; p1++, p2++) {
sl@0
   656
	    /* NULL loop body. */
sl@0
   657
	}
sl@0
   658
	if ((*p1 == '=') && (*p2 == '\0')) {
sl@0
   659
	    *lengthPtr = p2 - name;
sl@0
   660
	    result = i;
sl@0
   661
	    goto done;
sl@0
   662
	}
sl@0
   663
	
sl@0
   664
	Tcl_DStringFree(&envString);
sl@0
   665
    }
sl@0
   666
    
sl@0
   667
    *lengthPtr = i;
sl@0
   668
sl@0
   669
    done:
sl@0
   670
    Tcl_DStringFree(&envString);
sl@0
   671
    return result;
sl@0
   672
}
sl@0
   673

sl@0
   674
/*
sl@0
   675
 *----------------------------------------------------------------------
sl@0
   676
 *
sl@0
   677
 * Tcl_Init --
sl@0
   678
 *
sl@0
   679
 *	This procedure is typically invoked by Tcl_AppInit procedures
sl@0
   680
 *	to perform additional initialization for a Tcl interpreter,
sl@0
   681
 *	such as sourcing the "init.tcl" script.
sl@0
   682
 *
sl@0
   683
 * Results:
sl@0
   684
 *	Returns a standard Tcl completion code and sets the interp's result
sl@0
   685
 *	if there is an error.
sl@0
   686
 *
sl@0
   687
 * Side effects:
sl@0
   688
 *	Depends on what's in the init.tcl script.
sl@0
   689
 *
sl@0
   690
 *----------------------------------------------------------------------
sl@0
   691
 */
sl@0
   692
sl@0
   693
int
sl@0
   694
Tcl_Init(
sl@0
   695
    Tcl_Interp *interp)		/* Interpreter to initialize. */
sl@0
   696
{
sl@0
   697
    Tcl_Obj *pathPtr;
sl@0
   698
sl@0
   699
    if (tclPreInitScript != NULL) {
sl@0
   700
    if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
sl@0
   701
        return (TCL_ERROR);
sl@0
   702
    };
sl@0
   703
    }
sl@0
   704
sl@0
   705
    /*
sl@0
   706
     * For Macintosh applications the Init function may be contained in
sl@0
   707
     * the application resources.  If it exists we use it - otherwise we
sl@0
   708
     * look in the tcl_library directory.  Ditto for the history command.
sl@0
   709
     */
sl@0
   710
sl@0
   711
    pathPtr = TclGetLibraryPath();
sl@0
   712
    if (pathPtr == NULL) {
sl@0
   713
	pathPtr = Tcl_NewObj();
sl@0
   714
    }
sl@0
   715
    Tcl_IncrRefCount(pathPtr);
sl@0
   716
    Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
sl@0
   717
    Tcl_DecrRefCount(pathPtr);
sl@0
   718
    return Tcl_Eval(interp, initCmd);
sl@0
   719
}
sl@0
   720

sl@0
   721
/*
sl@0
   722
 *----------------------------------------------------------------------
sl@0
   723
 *
sl@0
   724
 * Tcl_SourceRCFile --
sl@0
   725
 *
sl@0
   726
 *	This procedure is typically invoked by Tcl_Main or Tk_Main
sl@0
   727
 *	procedure to source an application specific rc file into the
sl@0
   728
 *	interpreter at startup time.  This will either source a file
sl@0
   729
 *	in the "tcl_rcFileName" variable or a TEXT resource in the
sl@0
   730
 *	"tcl_rcRsrcName" variable.
sl@0
   731
 *
sl@0
   732
 * Results:
sl@0
   733
 *	None.
sl@0
   734
 *
sl@0
   735
 * Side effects:
sl@0
   736
 *	Depends on what's in the rc script.
sl@0
   737
 *
sl@0
   738
 *----------------------------------------------------------------------
sl@0
   739
 */
sl@0
   740
sl@0
   741
void
sl@0
   742
Tcl_SourceRCFile(
sl@0
   743
    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
sl@0
   744
{
sl@0
   745
    Tcl_DString temp;
sl@0
   746
    CONST char *fileName;
sl@0
   747
    Tcl_Channel errChannel;
sl@0
   748
    Handle h;
sl@0
   749
sl@0
   750
    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
sl@0
   751
sl@0
   752
    if (fileName != NULL) {
sl@0
   753
        Tcl_Channel c;
sl@0
   754
	CONST char *fullName;
sl@0
   755
sl@0
   756
        Tcl_DStringInit(&temp);
sl@0
   757
	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
sl@0
   758
	if (fullName == NULL) {
sl@0
   759
	    /*
sl@0
   760
	     * Couldn't translate the file name (e.g. it referred to a
sl@0
   761
	     * bogus user or there was no HOME environment variable).
sl@0
   762
	     * Just do nothing.
sl@0
   763
	     */
sl@0
   764
	} else {
sl@0
   765
sl@0
   766
	    /*
sl@0
   767
	     * Test for the existence of the rc file before trying to read it.
sl@0
   768
	     */
sl@0
   769
sl@0
   770
            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
sl@0
   771
            if (c != (Tcl_Channel) NULL) {
sl@0
   772
                Tcl_Close(NULL, c);
sl@0
   773
		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
sl@0
   774
		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0
   775
		    if (errChannel) {
sl@0
   776
			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0
   777
			Tcl_WriteChars(errChannel, "\n", 1);
sl@0
   778
		    }
sl@0
   779
		}
sl@0
   780
	    }
sl@0
   781
	}
sl@0
   782
        Tcl_DStringFree(&temp);
sl@0
   783
    }
sl@0
   784
sl@0
   785
    fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
sl@0
   786
sl@0
   787
    if (fileName != NULL) {
sl@0
   788
	Str255 rezName;
sl@0
   789
	Tcl_DString ds;
sl@0
   790
	Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
sl@0
   791
	strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
sl@0
   792
	rezName[0] = (unsigned) Tcl_DStringLength(&ds);
sl@0
   793
	h = GetNamedResource('TEXT', rezName);
sl@0
   794
	Tcl_DStringFree(&ds);
sl@0
   795
	if (h != NULL) {
sl@0
   796
	    if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
sl@0
   797
		errChannel = Tcl_GetStdChannel(TCL_STDERR);
sl@0
   798
		if (errChannel) {
sl@0
   799
		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
sl@0
   800
		    Tcl_WriteChars(errChannel, "\n", 1);
sl@0
   801
		}
sl@0
   802
	    }
sl@0
   803
	    Tcl_ResetResult(interp);
sl@0
   804
	    ReleaseResource(h);
sl@0
   805
	}
sl@0
   806
    }
sl@0
   807
}