Initial revision

FossilOrigin-Name: cacdd0f329872d67973970d74c6978730bc24baa

1 files changed, 284 insertions, 0 deletions

diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c
new file mode 100644
index 0000000..9dc6bd0
--- /dev/null
+++ b/mac/tclMacInit.c
@@ -0,0 +1,284 @@
+/*
+ * tclMacInit.c --
+ *
+ *	Contains the Mac-specific interpreter initialization functions.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacInit.c 1.39 97/09/23 13:17:30
+ */
+
+#include <Files.h>
+#include <Gestalt.h>
+#include <TextUtils.h>
+#include <Resources.h>
+#include <Strings.h>
+#include "tclInt.h"
+#include "tclMacInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPlatformInit --
+ *
+ *	Performs Mac-specific interpreter initialization related to the
+ *      tcl_platform and tcl_library variables.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Sets "tcl_library" & "tcl_platfrom" Tcl variable
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPlatformInit(
+    Tcl_Interp *interp)		/* Tcl interpreter to initialize. */
+{
+    char *libDir;
+    Tcl_DString path, libPath;
+    long int gestaltResult;
+    int minor, major;
+    char versStr[10];
+
+    /*
+     * Set runtime C variable that tells cross platform C functions
+     * what platform they are running on.  This can change at
+     * runtime for testing purposes.
+     */
+    tclPlatform = TCL_PLATFORM_MAC;
+    
+    /*
+     * Define the tcl_platfrom variable.
+     */
+    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
+
+    /*
+     * The tcl_library path can be found in one of two places.  As an element
+     * in the env array.  Or the default which is to a folder in side the
+     * Extensions folder of your system.
+     */
+     
+    Tcl_DStringInit(&path);
+    libDir = Tcl_GetVar2(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY);
+    if (libDir != NULL) {
+	Tcl_SetVar(interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
+    } else {
+	libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
+	if (libDir != NULL) {
+	    Tcl_JoinPath(1, &libDir, &path);
+	    
+	    Tcl_DStringInit(&libPath);
+	    Tcl_DStringAppend(&libPath, ":Tool Command Language:tcl", -1);
+	    Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
+	    Tcl_JoinPath(1, &libPath.string, &path);
+	    Tcl_DStringFree(&libPath);
+	    Tcl_SetVar(interp, "tcl_library", path.string, TCL_GLOBAL_ONLY);
+	} else {
+	    Tcl_SetVar(interp, "tcl_library", "no library", TCL_GLOBAL_ONLY);
+	}
+    }
+    
+    /*
+     * Now create the tcl_pkgPath variable.
+     */
+    Tcl_DStringSetLength(&path, 0);
+    libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
+    if (libDir != NULL) {
+	Tcl_JoinPath(1, &libDir, &path);
+	libDir = ":Tool Command Language:";
+	Tcl_JoinPath(1, &libDir, &path);
+	Tcl_SetVar(interp, "tcl_pkgPath", path.string,
+		TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
+    } else {
+	Tcl_SetVar(interp, "tcl_pkgPath", "no extension folder",
+		TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
+    }
+    Tcl_DStringFree(&path);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 interp->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. */
+{
+    static char initCmd[] =
+	"if {[catch {source -rsrc Init}] != 0} {\n\
+	if [file exists [info library]:init.tcl] {\n\
+	    source [info library]:init.tcl\n\
+	} else {\n\
+	    set msg \"can't find Init resource or [info library]:init.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}\n\
+        if {[catch {source -rsrc History}] != 0} {\n\
+	if [file exists [info library]:history.tcl] {\n\
+	    source [info library]:history.tcl\n\
+	} else {\n\
+	    set msg \"can't find History resource or [info library]:history.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}\n\
+        if {[catch {source -rsrc Word}] != 0} {\n\
+	if [file exists [info library]:word.tcl] {\n\
+	    source [info library]:word.tcl\n\
+	} else {\n\
+	    set msg \"can't find Word resource or [info library]:word.tcl;\"\n\
+	    append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
+	    append msg \"TCL_LIBRARY environment variable?\"\n\
+	    error $msg\n\
+	}\n}";
+
+    /*
+     * 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.
+     */
+    
+    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;
+    char *fileName;
+    Tcl_Channel errChannel;
+    Handle h;
+
+    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
+
+    if (fileName != NULL) {
+        Tcl_Channel c;
+	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_Write(errChannel, interp->result, -1);
+			Tcl_Write(errChannel, "\n", 1);
+		    }
+		}
+	    }
+	}
+        Tcl_DStringFree(&temp);
+    }
+
+    fileName = Tcl_GetVar(interp, "tcl_rcRsrcName", TCL_GLOBAL_ONLY);
+
+    if (fileName != NULL) {
+	c2pstr(fileName);
+	h = GetNamedResource('TEXT', (StringPtr) fileName);
+	p2cstr((StringPtr) fileName);
+	if (h != NULL) {
+	    if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
+		errChannel = Tcl_GetStdChannel(TCL_STDERR);
+		if (errChannel) {
+		    Tcl_Write(errChannel, interp->result, -1);
+		    Tcl_Write(errChannel, "\n", 1);
+		}
+	    }
+	    Tcl_ResetResult(interp);
+	    ReleaseResource(h);
+	}
+    }
+}