tclMacInit.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:22k
源码类别:

通讯编程

开发平台:

Visual C++

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