tclmacinit.c

tcl是工具命令语言

	    Tcl_DStringAppend(&libPath, "tcl", -1);
	    argv[2] = Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
	    Tcl_DStringInit(&path);
	    str = Tcl_JoinPath(3, argv, &path);
        objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&path));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&libPath);
	    Tcl_DStringFree(&path);
    }    
    TclSetLibraryPath(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
 *
 *	Based on the locale, determine the encoding of the operating
 *	system and the default encoding for newly opened files.
 *
 *	Called at process initialization time, and part way through
 *	startup, we verify that the initial encodings were correctly
 *	setup.  Depending on Tcl's environment, there may not have been
 *	enough information first time through (above).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl library path is converted from native encoding to UTF-8,
 *	on the first call, and the encodings may be changed on first or
 *	second call.
 *
 *---------------------------------------------------------------------------
 */

void
TclpSetInitialEncodings()
{
    CONST char *encoding;
    Tcl_Obj *pathPtr;
    int fontId, err;
    
    fontId = 0;
    GetFinderFont(&fontId);
    encoding = TclMacGetFontEncoding(fontId);
    if (encoding == NULL) {
        encoding = "macRoman";
    }
    
    err = Tcl_SetSystemEncoding(NULL, encoding);

    if (err == TCL_OK && libraryPathEncodingFixed == 0) {
	
    /*
     * Until the system encoding was actually set, the library path was
     * actually in the native multi-byte encoding, and not really UTF-8
     * as advertised.  We cheated as follows:
     *
     * 1. It was safe to allow the Tcl_SetSystemEncoding() call to 
     * append the ASCII chars that make up the encoding's filename to 
     * the names (in the native encoding) of directories in the library 
     * path, since all Unix multi-byte encodings have ASCII in the
     * beginning.
     *
     * 2. To open the encoding file, the native bytes in the file name
     * were passed to the OS, without translating from UTF-8 to native,
     * because the name was already in the native encoding.
     *
     * Now that the system encoding was actually successfully set,
     * translate all the names in the library path to UTF-8.  That way,
     * next time we search the library path, we'll translate the names 
     * from UTF-8 to the system encoding which will be the native 
     * encoding.
     */

    pathPtr = TclGetLibraryPath();
    if (pathPtr != NULL) {
    	int i, objc;
	Tcl_Obj **objv;
	
	objc = 0;
	Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
	for (i = 0; i < objc; i++) {
	    int length;
	    char *string;
	    Tcl_DString ds;

	    string = Tcl_GetStringFromObj(objv[i], &length);
	    Tcl_ExternalToUtfDString(NULL, string, length, &ds);
	    Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds), 
		    Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	}
	Tcl_InvalidateStringRep(pathPtr);
    }
	libraryPathEncodingFixed = 1;
    }
    
    /* This is only ever called from the startup thread */
    if (binaryEncoding == NULL) {
	/*
	 * Keep the iso8859-1 encoding preloaded.  The IO package uses
	 * it for gets on a binary channel.
	 */
	binaryEncoding = Tcl_GetEncoding(NULL, "iso8859-1");
    }
}   

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to
 *	the tcl_library and tcl_platform variables, and other platform-
 *	specific things.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets "tcl_library" and "tcl_platform" Tcl variables.
 *
 *----------------------------------------------------------------------
 */

void
TclpSetVariables(interp)
    Tcl_Interp *interp;
{
    long int gestaltResult;
    int minor, major, objc;
    Tcl_Obj **objv;
    char versStr[2 * TCL_INTEGER_SPACE];
    CONST char *str;
    Tcl_Obj *pathPtr;
    Tcl_DString ds;

    str = "no library";
    pathPtr = TclGetLibraryPath();
    if (pathPtr != NULL) {
        objc = 0;
        Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
        if (objc > 0) {
            str = Tcl_GetStringFromObj(objv[0], NULL);
        }
    }
    Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
    
    if (pathPtr != NULL) {
        Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
    }
    
    Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
	    TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
    Gestalt(gestaltSystemVersion, &gestaltResult);
    major = (gestaltResult & 0x0000FF00) >> 8;
    minor = (gestaltResult & 0x000000F0) >> 4;
    sprintf(versStr, "%d.%d", major, minor);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", versStr, TCL_GLOBAL_ONLY);
#if GENERATINGPOWERPC
    Tcl_SetVar2(interp, "tcl_platform", "machine", "ppc", TCL_GLOBAL_ONLY);
#else
    Tcl_SetVar2(interp, "tcl_platform", "machine", "68k", TCL_GLOBAL_ONLY);
#endif

    /*
     * Copy USER or LOGIN environment variable into tcl_platform(user)
     * These are set by SystemVariables in tclMacEnv.c
     */

    Tcl_DStringInit(&ds);
    str = TclGetEnv("USER", &ds);
    if (str == NULL) {
	str = TclGetEnv("LOGIN", &ds);
	if (str == NULL) {
	    str = "";
	}
    }
    Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCheckStackSpace --
 *
 *	On a 68K Mac, we can detect if we are about to blow the stack.
 *	Called before an evaluation can happen when nesting depth is
 *	checked.
 *
 * Results:
 *	1 if there is enough stack space to continue; 0 if not.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpCheckStackSpace()
{
    return StackSpace() > TCL_MAC_STACK_THRESHOLD;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name.  On Unix and Macthis 
 *	routine is case sensitive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the
 *	name "name", or -1 if there is no such entry.   The integer at
 *	*lengthPtr is filled in with the length of name (if a matching
 *	entry is found) or the length of the environ array (if no matching
 *	entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpFindVariable(name, lengthPtr)
    CONST char *name;		/* Name of desired environment variable
				 * (native). */
    int *lengthPtr;		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    int i, result = -1;
    register CONST char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p2 = name;

	for (; *p2 == *p1; p1++, p2++) {
	    /* NULL loop body. */
	}
	if ((*p1 == '=') && (*p2 == '\0')) {
	    *lengthPtr = p2 - name;
	    result = i;
	    goto done;
	}
	
	Tcl_DStringFree(&envString);
    }
    
    *lengthPtr = i;

    done:
    Tcl_DStringFree(&envString);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Init --
 *
 *	This procedure is typically invoked by Tcl_AppInit procedures
 *	to perform additional initialization for a Tcl interpreter,
 *	such as sourcing the "init.tcl" script.
 *
 * Results:
 *	Returns a standard Tcl completion code and sets the interp's result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on what's in the init.tcl script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Init(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    Tcl_Obj *pathPtr;

    if (tclPreInitScript != NULL) {
    if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
        return (TCL_ERROR);
    };
    }

    /*
     * For Macintosh applications the Init function may be contained in
     * the application resources.  If it exists we use it - otherwise we
     * look in the tcl_library directory.  Ditto for the history command.
     */

    pathPtr = TclGetLibraryPath();
    if (pathPtr == NULL) {
	pathPtr = Tcl_NewObj();
    }
    Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
    return Tcl_Eval(interp, initCmd);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SourceRCFile --
 *
 *	This procedure is typically invoked by Tcl_Main or Tk_Main
 *	procedure to source an application specific rc file into the
 *	interpreter at startup time.  This will either source a file
 *	in the "tcl_rcFileName" variable or a TEXT resource in the
 *	"tcl_rcRsrcName" variable.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Depends on what's in the rc script.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SourceRCFile(
    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
{
    Tcl_DString temp;
    CONST char *fileName;
    Tcl_Channel errChannel;
    Handle h;

    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);

    if (fileName != NULL) {
        Tcl_Channel c;
	CONST char *fullName;

        Tcl_DStringInit(&temp);
	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
	if (fullName == NULL) {
	    /*
	     * Couldn't translate the file name (e.g. it referred to a
	     * bogus user or there was no HOME environment variable).
	     * Just do nothing.
	     */
	} else {

	    /*
	     * Test for the existence of the rc file before trying to read it.
	     */

            c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
            if (c != (Tcl_Channel) NULL) {
                Tcl_Close(NULL, c);
		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
		    if (errChannel) {
			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
			Tcl_WriteChars(errChannel, "\n", 1);
		    }
		}
	    }
	}
        Tcl_DStringFree(&temp);
    }

    fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);

    if (fileName != NULL) {
	Str255 rezName;
	Tcl_DString ds;
	Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	strcpy((char *) rezName + 1, Tcl_DStringValue(&ds));
	rezName[0] = (unsigned) Tcl_DStringLength(&ds);
	h = GetNamedResource('TEXT', rezName);
	Tcl_DStringFree(&ds);
	if (h != NULL) {
	    if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
		errChannel = Tcl_GetStdChannel(TCL_STDERR);
		if (errChannel) {
		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(errChannel, "\n", 1);
		}
	    }
	    Tcl_ResetResult(interp);
	    ReleaseResource(h);
	}
    }
}