开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tclUnixInit.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：33k
源码类别：

通讯编程

开发平台：

Visual C++

tclUnixInit.c：源码内容
  1. /* 
  2.  * tclUnixInit.c --
  3.  *
  4.  * Contains the Unix-specific interpreter initialization functions.
  5.  *
  6.  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  7.  * Copyright (c) 1999 by Scriptics Corporation.
  8.  * All rights reserved.
  9.  *
  10.  * RCS: @(#) $Id: tclUnixInit.c,v 1.34.2.15 2007/04/29 02:19:51 das Exp $
  11.  */
  13. #if defined(HAVE_COREFOUNDATION)
  14. #include <CoreFoundation/CoreFoundation.h>
  15. #endif
  16. #include "tclInt.h"
  17. #include "tclPort.h"
  18. #include <locale.h>
  19. #ifdef HAVE_LANGINFO
  20. #   include <langinfo.h>
  21. #   ifdef __APPLE__
  22. #       if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
  23.     /* Support for weakly importing nl_langinfo on Darwin. */
  24. #           define WEAK_IMPORT_NL_LANGINFO
  25.     extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
  26. #       endif
  27. #    endif
  28. #endif
  29. #if defined(__FreeBSD__) && defined(__GNUC__)
  30. #   include <floatingpoint.h>
  31. #endif
  32. #if defined(__bsdi__)
  33. #   include <sys/param.h>
  34. #   if _BSDI_VERSION > 199501
  35. # include <dlfcn.h>
  36. #   endif
  37. #endif
  39. /*
  40.  * The Init script (common to Windows and Unix platforms) is
  41.  * defined in tkInitScript.h
  42.  */
  43. #include "tclInitScript.h"
  45. /* Used to store the encoding used for binary files */
  46. static Tcl_Encoding binaryEncoding = NULL;
  47. /* Has the basic library path encoding issue been fixed */
  48. static int libraryPathEncodingFixed = 0;
  50. /*
  51.  * Tcl tries to use standard and homebrew methods to guess the right
  52.  * encoding on the platform.  However, there is always a final fallback,
  53.  * and this value is it.  Make sure it is a real Tcl encoding.
  54.  */
  56. #ifndef TCL_DEFAULT_ENCODING
  57. #define TCL_DEFAULT_ENCODING "iso8859-1"
  58. #endif
  60. /*
  61.  * Default directory in which to look for Tcl library scripts.  The
  62.  * symbol is defined by Makefile.
  63.  */
  65. static char defaultLibraryDir[sizeof(TCL_LIBRARY)+200] = TCL_LIBRARY;
  67. /*
  68.  * Directory in which to look for packages (each package is typically
  69.  * installed as a subdirectory of this directory).  The symbol is
  70.  * defined by Makefile.
  71.  */
  73. static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
  75. /*
  76.  * The following table is used to map from Unix locale strings to
  77.  * encoding files.  If HAVE_LANGINFO is defined, then this is a fallback
  78.  * table when the result from nl_langinfo isn't a recognized encoding.
  79.  * Otherwise this is the first list checked for a mapping from env
  80.  * encoding to Tcl encoding name.
  81.  */
  83. typedef struct LocaleTable {
  84.     CONST char *lang;
  85.     CONST char *encoding;
  86. } LocaleTable;
  88. static CONST LocaleTable localeTable[] = {
  89. #ifdef HAVE_LANGINFO
  90.     {"gb2312-1980", "gb2312"},
  91.     {"ansi-1251", "cp1251"}, /* Solaris gets this wrong. */
  92. #ifdef __hpux
  93.     {"SJIS", "shiftjis"},
  94.     {"eucjp", "euc-jp"},
  95.     {"euckr", "euc-kr"},
  96.     {"euctw", "euc-cn"},
  97.     {"greek8", "cp869"},
  98.     {"iso88591", "iso8859-1"},
  99.     {"iso88592", "iso8859-2"},
  100.     {"iso88595", "iso8859-5"},
  101.     {"iso88596", "iso8859-6"},
  102.     {"iso88597", "iso8859-7"},
  103.     {"iso88598", "iso8859-8"},
  104.     {"iso88599", "iso8859-9"},
  105.     {"iso885915", "iso8859-15"},
  106.     {"roman8", "iso8859-1"},
  107.     {"tis620", "tis-620"},
  108.     {"turkish8", "cp857"},
  109.     {"utf8", "utf-8"},
  110. #endif /* __hpux */
  111. #endif /* HAVE_LANGINFO */
  113.     {"ja_JP.SJIS", "shiftjis"},
  114.     {"ja_JP.EUC", "euc-jp"},
  115.     {"ja_JP.eucJP",     "euc-jp"},
  116.     {"ja_JP.JIS", "iso2022-jp"},
  117.     {"ja_JP.mscode", "shiftjis"},
  118.     {"ja_JP.ujis", "euc-jp"},
  119.     {"ja_JP", "euc-jp"},
  120.     {"Ja_JP", "shiftjis"},
  121.     {"Jp_JP", "shiftjis"},
  122.     {"japan", "euc-jp"},
  123. #ifdef hpux
  124.     {"japanese", "shiftjis"},
  125.     {"ja", "shiftjis"},
  126. #else
  127.     {"japanese", "euc-jp"},
  128.     {"ja", "euc-jp"},
  129. #endif
  130.     {"japanese.sjis", "shiftjis"},
  131.     {"japanese.euc", "euc-jp"},
  132.     {"japanese-sjis", "shiftjis"},
  133.     {"japanese-ujis", "euc-jp"},
  135.     {"ko",              "euc-kr"},
  136.     {"ko_KR",           "euc-kr"},
  137.     {"ko_KR.EUC",       "euc-kr"},
  138.     {"ko_KR.euc",       "euc-kr"},
  139.     {"ko_KR.eucKR",     "euc-kr"},
  140.     {"korean",          "euc-kr"},
  142.     {"ru", "iso8859-5"},
  143.     {"ru_RU", "iso8859-5"},
  144.     {"ru_SU", "iso8859-5"},
  146.     {"zh", "cp936"},
  147.     {"zh_CN.gb2312", "euc-cn"},
  148.     {"zh_CN.GB2312", "euc-cn"},
  149.     {"zh_CN.GBK", "euc-cn"},
  150.     {"zh_TW.Big5", "big5"},
  151.     {"zh_TW", "euc-tw"},
  153.     {NULL, NULL}
  154. };
  156. #ifdef HAVE_COREFOUNDATION
  157. static int MacOSXGetLibraryPath _ANSI_ARGS_((
  158.     Tcl_Interp *interp, int maxPathLen,
  159.     char *tclLibPath));
  160. #endif /* HAVE_COREFOUNDATION */
  161. #if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( 
  162. defined(TCL_THREADS) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && 
  163. MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || ( 
  164. defined(__LP64__) && defined(MAC_OS_X_VERSION_MIN_REQUIRED) && 
  165. MAC_OS_X_VERSION_MIN_REQUIRED < 1050))
  166. /*
  167.  * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
  168.  * initialize release global at startup from uname().
  169.  */
  170. #define GET_DARWIN_RELEASE 1
  171. long tclMacOSXDarwinRelease = 0;
  172. #endif
  175. /*
  176.  *---------------------------------------------------------------------------
  177.  *
  178.  * TclpInitPlatform --
  179.  *
  180.  * Initialize all the platform-dependant things like signals and
  181.  * floating-point error handling.
  182.  *
  183.  * Called at process initialization time.
  184.  *
  185.  * Results:
  186.  * None.
  187.  *
  188.  * Side effects:
  189.  * None.
  190.  *
  191.  *---------------------------------------------------------------------------
  192.  */
  194. void
  195. TclpInitPlatform()
  196. {
  197.     tclPlatform = TCL_PLATFORM_UNIX;
  199.     /*
  200.      * Make sure, that the standard FDs exist. [Bug 772288]
  201.      */
  202.     if (TclOSseek(0, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
  203. open("/dev/null", O_RDONLY);
  204.     }
  205.     if (TclOSseek(1, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
  206. open("/dev/null", O_WRONLY);
  207.     }
  208.     if (TclOSseek(2, (Tcl_SeekOffset) 0, SEEK_CUR) == -1 && errno == EBADF) {
  209. open("/dev/null", O_WRONLY);
  210.     }
  212.     /*
  213.      * The code below causes SIGPIPE (broken pipe) errors to
  214.      * be ignored.  This is needed so that Tcl processes don't
  215.      * die if they create child processes (e.g. using "exec" or
  216.      * "open") that terminate prematurely.  The signal handler
  217.      * is only set up when the first interpreter is created;
  218.      * after this the application can override the handler with
  219.      * a different one of its own, if it wants.
  220.      */
  222. #ifdef SIGPIPE
  223.     (void) signal(SIGPIPE, SIG_IGN);
  224. #endif /* SIGPIPE */
  226. #if defined(__FreeBSD__) && defined(__GNUC__)
  227.     /*
  228.      * Adjust the rounding mode to be more conventional. Note that FreeBSD
  229.      * only provides the __fpsetreg() used by the following two for the GNU
  230.      * Compiler. When using, say, Intel's icc they break. (Partially based on
  231.      * patch in BSD ports system from root@celsius.bychok.com)
  232.      */
  234.     fpsetround(FP_RN);
  235.     fpsetmask(0L);
  236. #endif
  238. #if defined(__bsdi__) && (_BSDI_VERSION > 199501)
  239.     /*
  240.      * Find local symbols. Don't report an error if we fail.
  241.      */
  242.     (void) dlopen (NULL, RTLD_NOW); /* INTL: Native. */
  243. #endif
  245. #ifdef GET_DARWIN_RELEASE
  246.     {
  247. struct utsname name;
  248. if (!uname(&name)) {
  249.     tclMacOSXDarwinRelease = strtol(name.release, NULL, 10);
  250. }
  251.     }
  252. #endif
  253. }
  255. /*
  256.  *---------------------------------------------------------------------------
  257.  *
  258.  * TclpInitLibraryPath --
  259.  *
  260.  * Initialize the library path at startup.  We have a minor
  261.  * metacircular problem that we don't know the encoding of the
  262.  * operating system but we may need to talk to operating system
  263.  * to find the library directories so that we know how to talk to
  264.  * the operating system.
  265.  *
  266.  * We do not know the encoding of the operating system.
  267.  * We do know that the encoding is some multibyte encoding.
  268.  * In that multibyte encoding, the characters 0..127 are equivalent
  269.  *     to ascii.
  270.  *
  271.  * So although we don't know the encoding, it's safe:
  272.  *     to look for the last slash character in a path in the encoding.
  273.  *     to append an ascii string to a path.
  274.  *     to pass those strings back to the operating system.
  275.  *
  276.  * But any strings that we remembered before we knew the encoding of
  277.  * the operating system must be translated to UTF-8 once we know the
  278.  * encoding so that the rest of Tcl can use those strings.
  279.  *
  280.  * This call sets the library path to strings in the unknown native
  281.  * encoding.  TclpSetInitialEncodings() will translate the library
  282.  * path from the native encoding to UTF-8 as soon as it determines
  283.  * what the native encoding actually is.
  284.  *
  285.  * Called at process initialization time.
  286.  *
  287.  * Results:
  288.  * Return 1, indicating that the UTF may be dirty and require "cleanup"
  289.  * after encodings are initialized.
  290.  *
  291.  * Side effects:
  292.  * None.
  293.  *
  294.  *---------------------------------------------------------------------------
  295.  */
  297. int
  298. TclpInitLibraryPath(path)
  299. CONST char *path; /* Path to the executable in native 
  300.  * multi-byte encoding. */
  301. {
  302. #define LIBRARY_SIZE     32
  303.     Tcl_Obj *pathPtr, *objPtr;
  304.     CONST char *str;
  305.     Tcl_DString buffer, ds;
  306.     int pathc;
  307.     CONST char **pathv;
  308.     char installLib[LIBRARY_SIZE], developLib[LIBRARY_SIZE];
  310.     Tcl_DStringInit(&ds);
  311.     pathPtr = Tcl_NewObj();
  313.     /*
  314.      * Initialize the substrings used when locating an executable.  The
  315.      * installLib variable computes the path as though the executable
  316.      * is installed.  The developLib computes the path as though the
  317.      * executable is run from a develpment directory.
  318.      */
  319.      
  320.     sprintf(installLib, "lib/tcl%s", TCL_VERSION);
  321.     sprintf(developLib, "tcl%s/library", TCL_PATCH_LEVEL);
  323.     /*
  324.      * Look for the library relative to default encoding dir.
  325.      */
  327.     str = Tcl_GetDefaultEncodingDir();
  328.     if ((str != NULL) && (str[0] != '')) {
  329. objPtr = Tcl_NewStringObj(str, -1);
  330. Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  331.     }
  333.     /*
  334.      * Look for the library relative to the TCL_LIBRARY env variable.
  335.      * If the last dirname in the TCL_LIBRARY path does not match the
  336.      * last dirname in the installLib variable, use the last dir name
  337.      * of installLib in addition to the orginal TCL_LIBRARY path.
  338.      */
  340.     str = getenv("TCL_LIBRARY"); /* INTL: Native. */
  341.     Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
  342.     str = Tcl_DStringValue(&buffer);
  344.     if ((str != NULL) && (str[0] != '')) {
  345. /*
  346.  * If TCL_LIBRARY is set, search there.
  347.  */
  348.  
  349. objPtr = Tcl_NewStringObj(str, -1);
  350. Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  352. Tcl_SplitPath(str, &pathc, &pathv);
  353. if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
  354.     /*
  355.      * If TCL_LIBRARY is set but refers to a different tcl
  356.      * installation than the current version, try fiddling with the
  357.      * specified directory to make it refer to this installation by
  358.      * removing the old "tclX.Y" and substituting the current
  359.      * version string.
  360.      */
  361.     
  362.     pathv[pathc - 1] = installLib + 4;
  363.     str = Tcl_JoinPath(pathc, pathv, &ds);
  364.     objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
  365.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  366.     Tcl_DStringFree(&ds);
  367. }
  368. ckfree((char *) pathv);
  369.     }
  371.     /*
  372.      * Look for the library relative to the executable.  This algorithm
  373.      * should be the same as the one in the tcl_findLibrary procedure.
  374.      *
  375.      * This code looks in the following directories:
  376.      *
  377.      * <bindir>/../<installLib>
  378.      *   (e.g. /usr/local/bin/../lib/tcl8.4)
  379.      * <bindir>/../../<installLib>
  380.      *   (e.g. /usr/local/TclPro/solaris-sparc/bin/../../lib/tcl8.4)
  381.      * <bindir>/../library
  382.      *   (e.g. /usr/src/tcl8.4.0/unix/../library)
  383.      * <bindir>/../../library
  384.      *   (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../library)
  385.      * <bindir>/../../<developLib>
  386.      *   (e.g. /usr/src/tcl8.4.0/unix/../../tcl8.4.0/library)
  387.      * <bindir>/../../../<developLib>
  388.      *   (e.g. /usr/src/tcl8.4.0/unix/solaris-sparc/../../../tcl8.4.0/library)
  389.      */
  390.      
  392.      /*
  393.       * The variable path holds an absolute path.  Take care not to
  394.       * overwrite pathv[0] since that might produce a relative path.
  395.       */
  397.     if (path != NULL) {
  398. int i, origc;
  399. CONST char **origv;
  401. Tcl_SplitPath(path, &origc, &origv);
  402. pathc = 0;
  403. pathv = (CONST char **) ckalloc((unsigned int)(origc * sizeof(char *)));
  404. for (i=0; i< origc; i++) {
  405.     if (origv[i][0] == '.') {
  406. if (strcmp(origv[i], ".") == 0) {
  407.     /* do nothing */
  408. } else if (strcmp(origv[i], "..") == 0) {
  409.     pathc--;
  410. } else {
  411.     pathv[pathc++] = origv[i];
  412. }
  413.     } else {
  414. pathv[pathc++] = origv[i];
  415.     }
  416. }
  417. if (pathc > 2) {
  418.     str = pathv[pathc - 2];
  419.     pathv[pathc - 2] = installLib;
  420.     path = Tcl_JoinPath(pathc - 1, pathv, &ds);
  421.     pathv[pathc - 2] = str;
  422.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  423.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  424.     Tcl_DStringFree(&ds);
  425. }
  426. if (pathc > 3) {
  427.     str = pathv[pathc - 3];
  428.     pathv[pathc - 3] = installLib;
  429.     path = Tcl_JoinPath(pathc - 2, pathv, &ds);
  430.     pathv[pathc - 3] = str;
  431.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  432.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  433.     Tcl_DStringFree(&ds);
  434. }
  435. if (pathc > 2) {
  436.     str = pathv[pathc - 2];
  437.     pathv[pathc - 2] = "library";
  438.     path = Tcl_JoinPath(pathc - 1, pathv, &ds);
  439.     pathv[pathc - 2] = str;
  440.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  441.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  442.     Tcl_DStringFree(&ds);
  443. }
  444. if (pathc > 3) {
  445.     str = pathv[pathc - 3];
  446.     pathv[pathc - 3] = "library";
  447.     path = Tcl_JoinPath(pathc - 2, pathv, &ds);
  448.     pathv[pathc - 3] = str;
  449.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  450.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  451.     Tcl_DStringFree(&ds);
  452. }
  453. if (pathc > 3) {
  454.     str = pathv[pathc - 3];
  455.     pathv[pathc - 3] = developLib;
  456.     path = Tcl_JoinPath(pathc - 2, pathv, &ds);
  457.     pathv[pathc - 3] = str;
  458.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  459.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  460.     Tcl_DStringFree(&ds);
  461. }
  462. if (pathc > 4) {
  463.     str = pathv[pathc - 4];
  464.     pathv[pathc - 4] = developLib;
  465.     path = Tcl_JoinPath(pathc - 3, pathv, &ds);
  466.     pathv[pathc - 4] = str;
  467.     objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds));
  468.     Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  469.     Tcl_DStringFree(&ds);
  470. }
  471. ckfree((char *) origv);
  472. ckfree((char *) pathv);
  473.     }
  475.     /*
  476.      * Finally, look for the library relative to the compiled-in path.
  477.      * This is needed when users install Tcl with an exec-prefix that
  478.      * is different from the prtefix.
  479.      */
  481.     {
  482. #ifdef HAVE_COREFOUNDATION
  483.     char tclLibPath[MAXPATHLEN + 1];
  485.     if (MacOSXGetLibraryPath(NULL, MAXPATHLEN, tclLibPath) == TCL_OK) {
  486.         str = tclLibPath;
  487.     } else
  488. #endif /* HAVE_COREFOUNDATION */
  489.     {
  490.         str = defaultLibraryDir;
  491.     }
  492.     if (str[0] != '') {
  493.         objPtr = Tcl_NewStringObj(str, -1);
  494.         Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
  495.     }
  496.     }
  498.     TclSetLibraryPath(pathPtr);    
  499.     Tcl_DStringFree(&buffer);
  501.     return 1; /* 1 indicates that pathPtr may be dirty utf (needs cleaning) */
  502. }
  504. /*
  505.  *---------------------------------------------------------------------------
  506.  *
  507.  * TclpSetInitialEncodings --
  508.  *
  509.  * Based on the locale, determine the encoding of the operating
  510.  * system and the default encoding for newly opened files.
  511.  *
  512.  * Called at process initialization time, and part way through
  513.  * startup, we verify that the initial encodings were correctly
  514.  * setup.  Depending on Tcl's environment, there may not have been
  515.  * enough information first time through (above).
  516.  *
  517.  * Results:
  518.  * None.
  519.  *
  520.  * Side effects:
  521.  * The Tcl library path is converted from native encoding to UTF-8,
  522.  * on the first call, and the encodings may be changed on first or
  523.  * second call.
  524.  *
  525.  *---------------------------------------------------------------------------
  526.  */
  528. void
  529. TclpSetInitialEncodings()
  530. {
  531. CONST char *encoding = NULL;
  532. int i, setSysEncCode = TCL_ERROR;
  533. Tcl_Obj *pathPtr;
  535. /*
  536.  * Determine the current encoding from the LC_* or LANG environment
  537.  * variables.  We previously used setlocale() to determine the locale,
  538.  * but this does not work on some systems (e.g. Linux/i386 RH 5.0).
  539.  */
  540. #ifdef HAVE_LANGINFO
  541. if (
  542. #ifdef WEAK_IMPORT_NL_LANGINFO
  543. nl_langinfo != NULL &&
  544. #endif
  545. setlocale(LC_CTYPE, "") != NULL) {
  546.     Tcl_DString ds;
  548.     /*
  549.      * Use a DString so we can overwrite it in name compatability
  550.      * checks below.
  551.      */
  553.     Tcl_DStringInit(&ds);
  554.     encoding = Tcl_DStringAppend(&ds, nl_langinfo(CODESET), -1);
  556.     Tcl_UtfToLower(Tcl_DStringValue(&ds));
  557. #ifdef HAVE_LANGINFO_DEBUG
  558.     fprintf(stderr, "encoding '%s'", encoding);
  559. #endif
  560.     if (encoding[0] == 'i' && encoding[1] == 's' && encoding[2] == 'o'
  561.     && encoding[3] == '-') {
  562. char *p, *q;
  563. /* need to strip '-' from iso-* encoding */
  564. for(p = Tcl_DStringValue(&ds)+3, q = Tcl_DStringValue(&ds)+4;
  565.     *p; *p++ = *q++);
  566.     } else if (encoding[0] == 'i' && encoding[1] == 'b'
  567.     && encoding[2] == 'm' && encoding[3] >= '0'
  568.     && encoding[3] <= '9') {
  569. char *p, *q;
  570. /* if langinfo reports "ibm*" we should use "cp*" */
  571. p = Tcl_DStringValue(&ds);
  572. *p++ = 'c'; *p++ = 'p';
  573. for(q = p+1; *p ; *p++ = *q++);
  574.     } else if ((*encoding == '')
  575.     || !strcmp(encoding, "ansi_x3.4-1968")) {
  576. /* Use iso8859-1 for empty or 'ansi_x3.4-1968' encoding */
  577. encoding = "iso8859-1";
  578.     }
  579. #ifdef HAVE_LANGINFO_DEBUG
  580.     fprintf(stderr, " ?%s?", encoding);
  581. #endif
  582.     setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
  583.     if (setSysEncCode != TCL_OK) {
  584. /*
  585.  * If this doesn't return TCL_OK, the encoding returned by
  586.  * nl_langinfo or as we translated it wasn't accepted.  Do
  587.  * this fallback check.  If this fails, we will enter the
  588.  * old fallback below.
  589.  */
  591. for (i = 0; localeTable[i].lang != NULL; i++) {
  592.     if (strcmp(localeTable[i].lang, encoding) == 0) {
  593. setSysEncCode = Tcl_SetSystemEncoding(NULL,
  594. localeTable[i].encoding);
  595. break;
  596.     }
  597. }
  598.     }
  599. #ifdef HAVE_LANGINFO_DEBUG
  600.     fprintf(stderr, " => '%s'n", encoding);
  601. #endif
  602.     Tcl_DStringFree(&ds);
  603. }
  604. #ifdef HAVE_LANGINFO_DEBUG
  605. else {
  606.     fprintf(stderr, "setlocale returned NULLn");
  607. }
  608. #endif
  609. #endif /* HAVE_LANGINFO */
  611. if (setSysEncCode != TCL_OK) {
  612.     /*
  613.      * Classic fallback check.  This tries a homebrew algorithm to
  614.      * determine what encoding should be used based on env vars.
  615.      */
  616.     char *langEnv = getenv("LC_ALL");
  617.     encoding = NULL;
  619.     if (langEnv == NULL || langEnv[0] == '') {
  620. langEnv = getenv("LC_CTYPE");
  621.     }
  622.     if (langEnv == NULL || langEnv[0] == '') {
  623. langEnv = getenv("LANG");
  624.     }
  625.     if (langEnv == NULL || langEnv[0] == '') {
  626. langEnv = NULL;
  627.     }
  629.     if (langEnv != NULL) {
  630. for (i = 0; localeTable[i].lang != NULL; i++) {
  631.     if (strcmp(localeTable[i].lang, langEnv) == 0) {
  632. encoding = localeTable[i].encoding;
  633. break;
  634.     }
  635. }
  636. /*
  637.  * There was no mapping in the locale table.  If there is an
  638.  * encoding subfield, we can try to guess from that.
  639.  */
  641. if (encoding == NULL) {
  642.     char *p;
  643.     for (p = langEnv; *p != ''; p++) {
  644. if (*p == '.') {
  645.     p++;
  646.     break;
  647. }
  648.     }
  649.     if (*p != '') {
  650. Tcl_DString ds;
  651. Tcl_DStringInit(&ds);
  652. encoding = Tcl_DStringAppend(&ds, p, -1);
  654. Tcl_UtfToLower(Tcl_DStringValue(&ds));
  655. setSysEncCode = Tcl_SetSystemEncoding(NULL, encoding);
  656. if (setSysEncCode != TCL_OK) {
  657.     encoding = NULL;
  658. }
  659. Tcl_DStringFree(&ds);
  660.     }
  661. }
  662. #ifdef HAVE_LANGINFO_DEBUG
  663. fprintf(stderr, "encoding fallback check '%s' => '%s'n",
  664. langEnv, encoding);
  665. #endif
  666.     }
  667.     if (setSysEncCode != TCL_OK) {
  668. if (encoding == NULL) {
  669.     encoding = TCL_DEFAULT_ENCODING;
  670. }
  672. Tcl_SetSystemEncoding(NULL, encoding);
  673.     }
  675.     /*
  676.      * Initialize the C library's locale subsystem.  This is required
  677.      * for input methods to work properly on X11.  We only do this for
  678.      * LC_CTYPE because that's the necessary one, and we don't want to
  679.      * affect LC_TIME here.  The side effect of setting the default
  680.      * locale should be to load any locale specific modules that are
  681.      * needed by X.  [BUG: 5422 3345 4236 2522 2521].
  682.      * In HAVE_LANGINFO, this call is already done above.
  683.      */
  684. #ifndef HAVE_LANGINFO
  685.     setlocale(LC_CTYPE, "");
  686. #endif
  687. }
  689. /*
  690.  * In case the initial locale is not "C", ensure that the numeric
  691.  * processing is done in "C" locale regardless.  This is needed because
  692.  * Tcl relies on routines like strtod, but should not have locale
  693.  * dependent behavior.
  694.  */
  696. setlocale(LC_NUMERIC, "C");
  698.     if ((libraryPathEncodingFixed == 0) && strcmp("identity",
  699.     Tcl_GetEncodingName(Tcl_GetEncoding(NULL, NULL))) ) {
  700. /*
  701.  * Until the system encoding was actually set, the library path was
  702.  * actually in the native multi-byte encoding, and not really UTF-8
  703.  * as advertised.  We cheated as follows:
  704.  *
  705.  * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 
  706.  * append the ASCII chars that make up the encoding's filename to 
  707.  * the names (in the native encoding) of directories in the library 
  708.  * path, since all Unix multi-byte encodings have ASCII in the
  709.  * beginning.
  710.  *
  711.  * 2. To open the encoding file, the native bytes in the file name
  712.  * were passed to the OS, without translating from UTF-8 to native,
  713.  * because the name was already in the native encoding.
  714.  *
  715.  * Now that the system encoding was actually successfully set,
  716.  * translate all the names in the library path to UTF-8.  That way,
  717.  * next time we search the library path, we'll translate the names 
  718.  * from UTF-8 to the system encoding which will be the native 
  719.  * encoding.
  720.  */
  722. pathPtr = TclGetLibraryPath();
  723. if (pathPtr != NULL) {
  724.     int objc;
  725.     Tcl_Obj **objv;
  726.     
  727.     objc = 0;
  728.     Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
  729.     for (i = 0; i < objc; i++) {
  730. int length;
  731. char *string;
  732. Tcl_DString ds;
  734. string = Tcl_GetStringFromObj(objv[i], &length);
  735. Tcl_ExternalToUtfDString(NULL, string, length, &ds);
  736. Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
  737. Tcl_DStringLength(&ds));
  738. Tcl_DStringFree(&ds);
  739.     }
  740. }
  742. libraryPathEncodingFixed = 1;
  743.     }
  744.     
  745.     /* This is only ever called from the startup thread */
  746.     if (binaryEncoding == NULL) {
  747. /*
  748.  * Keep the iso8859-1 encoding preloaded.  The IO package uses
  749.  * it for gets on a binary channel.
  750.  */
  751. binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
  752.     }
  753. }
  755. /*
  756.  *---------------------------------------------------------------------------
  757.  *
  758.  * TclpSetVariables --
  759.  *
  760.  * Performs platform-specific interpreter initialization related to
  761.  * the tcl_library and tcl_platform variables, and other platform-
  762.  * specific things.
  763.  *
  764.  * Results:
  765.  * None.
  766.  *
  767.  * Side effects:
  768.  * Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl
  769.  * variables.
  770.  *
  771.  *----------------------------------------------------------------------
  772.  */
  774. void
  775. TclpSetVariables(interp)
  776.     Tcl_Interp *interp;
  777. {
  778. #ifndef NO_UNAME
  779.     struct utsname name;
  780. #endif
  781.     int unameOK;
  782.     CONST char *user;
  783.     Tcl_DString ds;
  785. #ifdef HAVE_COREFOUNDATION
  786.     char tclLibPath[MAXPATHLEN + 1];
  788. #if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
  789.     /*
  790.      * Set msgcat fallback locale to current CFLocale identifier.
  791.      */
  792.     CFLocaleRef localeRef;
  793.     
  794.     if (CFLocaleCopyCurrent != NULL && CFLocaleGetIdentifier != NULL &&
  795.     (localeRef = CFLocaleCopyCurrent())) {
  796. CFStringRef locale = CFLocaleGetIdentifier(localeRef);
  798. if (locale) {
  799.     char loc[256];
  801.     if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
  802. if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
  803.     Tcl_ResetResult(interp);
  804. }
  805. Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
  806.     }
  807. }
  808. CFRelease(localeRef);
  809.     }
  810. #endif
  812.     if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
  813.         CONST char *str;
  814.         Tcl_DString ds;
  815.         CFBundleRef bundleRef;
  817.         Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, 
  818.                 TCL_GLOBAL_ONLY);
  819.         Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
  820.                 TCL_GLOBAL_ONLY);
  821.         Tcl_SetVar(interp, "tcl_pkgPath", " ",
  822.                 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  823.         str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
  824.         if ((str != NULL) && (str[0] != '')) {
  825.             char *p = Tcl_DStringValue(&ds);
  826.             /* convert DYLD_FRAMEWORK_PATH from colon to space separated */
  827.             do {
  828.                 if(*p == ':') *p = ' ';
  829.             } while (*p++);
  830.             Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
  831.                     TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  832.             Tcl_SetVar(interp, "tcl_pkgPath", " ",
  833.                     TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  834.             Tcl_DStringFree(&ds);
  835.         }
  836.         if ((bundleRef = CFBundleGetMainBundle())) {
  837.             CFURLRef frameworksURL;
  838.             Tcl_StatBuf statBuf;
  839.             if((frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef))) {
  840.                 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
  841.                             (unsigned char*) tclLibPath, MAXPATHLEN) &&
  842.                         ! TclOSstat(tclLibPath, &statBuf) &&
  843.                         S_ISDIR(statBuf.st_mode)) {
  844.                     Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
  845.                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  846.                     Tcl_SetVar(interp, "tcl_pkgPath", " ",
  847.                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  848.                 }
  849.                 CFRelease(frameworksURL);
  850.             }
  851.             if((frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef))) {
  852.                 if(CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
  853.                             (unsigned char*) tclLibPath, MAXPATHLEN) &&
  854.                         ! TclOSstat(tclLibPath, &statBuf) &&
  855.                         S_ISDIR(statBuf.st_mode)) {
  856.                     Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
  857.                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  858.                     Tcl_SetVar(interp, "tcl_pkgPath", " ",
  859.                             TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  860.                 }
  861.                 CFRelease(frameworksURL);
  862.             }
  863.         }
  864.         Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
  865.                 TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
  866.     } else
  867. #endif /* HAVE_COREFOUNDATION */
  868.     {
  869.         Tcl_SetVar(interp, "tclDefaultLibrary", defaultLibraryDir, 
  870.                 TCL_GLOBAL_ONLY);
  871.         Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
  872.     }
  874. #ifdef DJGPP
  875.     Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
  876. #else
  877.     Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
  878. #endif
  879.     unameOK = 0;
  880. #ifndef NO_UNAME
  881.     if (uname(&name) >= 0) {
  882. CONST char *native;
  884. unameOK = 1;
  886. native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
  887. Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
  888. Tcl_DStringFree(&ds);
  890. /*
  891.  * The following code is a special hack to handle differences in
  892.  * the way version information is returned by uname.  On most
  893.  * systems the full version number is available in name.release.
  894.  * However, under AIX the major version number is in
  895.  * name.version and the minor version number is in name.release.
  896.  */
  898. if ((strchr(name.release, '.') != NULL)
  899. || !isdigit(UCHAR(name.version[0]))) { /* INTL: digit */
  900.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
  901.     TCL_GLOBAL_ONLY);
  902. } else {
  903.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.version,
  904.     TCL_GLOBAL_ONLY);
  905.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", ".",
  906.     TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  907.     Tcl_SetVar2(interp, "tcl_platform", "osVersion", name.release,
  908.     TCL_GLOBAL_ONLY|TCL_APPEND_VALUE);
  909. }
  910. Tcl_SetVar2(interp, "tcl_platform", "machine", name.machine,
  911. TCL_GLOBAL_ONLY);
  912.     }
  913. #endif
  914.     if (!unameOK) {
  915. Tcl_SetVar2(interp, "tcl_platform", "os", "", TCL_GLOBAL_ONLY);
  916. Tcl_SetVar2(interp, "tcl_platform", "osVersion", "", TCL_GLOBAL_ONLY);
  917. Tcl_SetVar2(interp, "tcl_platform", "machine", "", TCL_GLOBAL_ONLY);
  918.     }
  920.     /*
  921.      * Copy USER or LOGNAME environment variable into tcl_platform(user)
  922.      */
  924.     Tcl_DStringInit(&ds);
  925.     user = TclGetEnv("USER", &ds);
  926.     if (user == NULL) {
  927. user = TclGetEnv("LOGNAME", &ds);
  928. if (user == NULL) {
  929.     user = "";
  930. }
  931.     }
  932.     Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
  933.     Tcl_DStringFree(&ds);
  935. }
  937. /*
  938.  *----------------------------------------------------------------------
  939.  *
  940.  * TclpFindVariable --
  941.  *
  942.  * Locate the entry in environ for a given name.  On Unix this 
  943.  * routine is case sensetive, on Windows this matches mixed case.
  944.  *
  945.  * Results:
  946.  * The return value is the index in environ of an entry with the
  947.  * name "name", or -1 if there is no such entry.   The integer at
  948.  * *lengthPtr is filled in with the length of name (if a matching
  949.  * entry is found) or the length of the environ array (if no matching
  950.  * entry is found).
  951.  *
  952.  * Side effects:
  953.  * None.
  954.  *
  955.  *----------------------------------------------------------------------
  956.  */
  958. int
  959. TclpFindVariable(name, lengthPtr)
  960.     CONST char *name; /* Name of desired environment variable
  961.  * (native). */
  962.     int *lengthPtr; /* Used to return length of name (for
  963.  * successful searches) or number of non-NULL
  964.  * entries in environ (for unsuccessful
  965.  * searches). */
  966. {
  967.     int i, result = -1;
  968.     register CONST char *env, *p1, *p2;
  969.     Tcl_DString envString;
  971.     Tcl_DStringInit(&envString);
  972.     for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
  973. p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
  974. p2 = name;
  976. for (; *p2 == *p1; p1++, p2++) {
  977.     /* NULL loop body. */
  978. }
  979. if ((*p1 == '=') && (*p2 == '')) {
  980.     *lengthPtr = p2 - name;
  981.     result = i;
  982.     goto done;
  983. }
  985. Tcl_DStringFree(&envString);
  986.     }
  987.     
  988.     *lengthPtr = i;
  990.     done:
  991.     Tcl_DStringFree(&envString);
  992.     return result;
  993. }
  995. /*
  996.  *----------------------------------------------------------------------
  997.  *
  998.  * Tcl_Init --
  999.  *
  1000.  * This procedure is typically invoked by Tcl_AppInit procedures
  1001.  * to find and source the "init.tcl" script, which should exist
  1002.  * somewhere on the Tcl library path.
  1003.  *
  1004.  * Results:
  1005.  * Returns a standard Tcl completion code and sets the interp's
  1006.  * result if there is an error.
  1007.  *
  1008.  * Side effects:
  1009.  * Depends on what's in the init.tcl script.
  1010.  *
  1011.  *----------------------------------------------------------------------
  1012.  */
  1014. int
  1015. Tcl_Init(interp)
  1016.     Tcl_Interp *interp; /* Interpreter to initialize. */
  1017. {
  1018.     Tcl_Obj *pathPtr;
  1020.     if (tclPreInitScript != NULL) {
  1021. if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
  1022.     return (TCL_ERROR);
  1023. };
  1024.     }
  1025.     
  1026.     pathPtr = TclGetLibraryPath();
  1027.     if (pathPtr == NULL) {
  1028. pathPtr = Tcl_NewObj();
  1029.     }
  1030.     Tcl_IncrRefCount(pathPtr);
  1031.     Tcl_SetVar2Ex(interp, "tcl_libPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
  1032.     Tcl_DecrRefCount(pathPtr);
  1033.     return Tcl_Eval(interp, initScript);
  1034. }
  1036. /*
  1037.  *----------------------------------------------------------------------
  1038.  *
  1039.  * Tcl_SourceRCFile --
  1040.  *
  1041.  * This procedure is typically invoked by Tcl_Main of Tk_Main
  1042.  * procedure to source an application specific rc file into the
  1043.  * interpreter at startup time.
  1044.  *
  1045.  * Results:
  1046.  * None.
  1047.  *
  1048.  * Side effects:
  1049.  * Depends on what's in the rc script.
  1050.  *
  1051.  *----------------------------------------------------------------------
  1052.  */
  1054. void
  1055. Tcl_SourceRCFile(interp)
  1056.     Tcl_Interp *interp; /* Interpreter to source rc file into. */
  1057. {
  1058.     Tcl_DString temp;
  1059.     CONST char *fileName;
  1060.     Tcl_Channel errChannel;
  1062.     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
  1064.     if (fileName != NULL) {
  1065.         Tcl_Channel c;
  1066. CONST char *fullName;
  1068.         Tcl_DStringInit(&temp);
  1069. fullName = Tcl_TranslateFileName(interp, fileName, &temp);
  1070. if (fullName == NULL) {
  1071.     /*
  1072.      * Couldn't translate the file name (e.g. it referred to a
  1073.      * bogus user or there was no HOME environment variable).
  1074.      * Just do nothing.
  1075.      */
  1076. } else {
  1078.     /*
  1079.      * Test for the existence of the rc file before trying to read it.
  1080.      */
  1082.             c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
  1083.             if (c != (Tcl_Channel) NULL) {
  1084.                 Tcl_Close(NULL, c);
  1085. if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
  1086.     errChannel = Tcl_GetStdChannel(TCL_STDERR);
  1087.     if (errChannel) {
  1088. Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
  1089. Tcl_WriteChars(errChannel, "n", 1);
  1090.     }
  1091. }
  1092.     }
  1093. }
  1094.         Tcl_DStringFree(&temp);
  1095.     }
  1096. }
  1098. /*
  1099.  *----------------------------------------------------------------------
  1100.  *
  1101.  * TclpCheckStackSpace --
  1102.  *
  1103.  * Detect if we are about to blow the stack.  Called before an 
  1104.  * evaluation can happen when nesting depth is checked.
  1105.  *
  1106.  * Results:
  1107.  * 1 if there is enough stack space to continue; 0 if not.
  1108.  *
  1109.  * Side effects:
  1110.  * None.
  1111.  *
  1112.  *----------------------------------------------------------------------
  1113.  */
  1115. int
  1116. TclpCheckStackSpace()
  1117. {
  1118.     /*
  1119.      * This function is unimplemented on Unix platforms.
  1120.      */
  1122.     return 1;
  1123. }
  1125. /*
  1126.  *----------------------------------------------------------------------
  1127.  *
  1128.  * MacOSXGetLibraryPath --
  1129.  *
  1130.  * If we have a bundle structure for the Tcl installation,
  1131.  * then check there first to see if we can find the libraries
  1132.  * there.
  1133.  *
  1134.  * Results:
  1135.  * TCL_OK if we have found the tcl library; TCL_ERROR otherwise.
  1136.  *
  1137.  * Side effects:
  1138.  * Same as for Tcl_MacOSXOpenVersionedBundleResources.
  1139.  *
  1140.  *----------------------------------------------------------------------
  1141.  */
  1143. #ifdef HAVE_COREFOUNDATION
  1144. static int
  1145. MacOSXGetLibraryPath(Tcl_Interp *interp, int maxPathLen, char *tclLibPath)
  1146. {
  1147.     int foundInFramework = TCL_ERROR;
  1148. #ifdef TCL_FRAMEWORK
  1149.     foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp, 
  1150. "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen, tclLibPath);
  1151. #endif
  1152.     return foundInFramework;
  1153. }
  1154. #endif /* HAVE_COREFOUNDATION */