Initial revision

1 files changed, 257 insertions, 0 deletions

diff --git a/mac/tclMacBOAAppInit.c b/mac/tclMacBOAAppInit.c
new file mode 100644
index 0000000..db9890b
--- /dev/null
+++ b/mac/tclMacBOAAppInit.c
@@ -0,0 +1,257 @@
+/* 
+ * tclMacBOAAppInit.c --
+ *
+ *	Provides a version of the Tcl_AppInit procedure for a 
+ *      Macintosh Background Only Application.
+ *
+ * Copyright (c) 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: @(#) tclMacBOAAppInit.c 1.1 97/11/03 17:06:21
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+#include <Fonts.h>
+#include <Windows.h>
+#include <Dialogs.h>
+#include <Menus.h>
+#include <Aliases.h>
+#include <LowMem.h>
+
+#include <AppleEvents.h>
+#include <SegLoad.h>
+#include <ToolUtils.h>
+
+#if defined(THINK_C)
+#   include <console.h>
+#elif defined(__MWERKS__)
+#   include <SIOUX.h>
+short InstallConsole _ANSI_ARGS_((short fd));
+#endif
+
+void TkMacInitAppleEvents(Tcl_Interp *interp);
+int HandleHighLevelEvents(EventRecord *eventPtr);	
+
+#ifdef TCL_TEST
+EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int		MacintoshInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ *	Main program for tclsh.  This file can be used as a prototype
+ *	for other applications using the Tcl library.
+ *
+ * Results:
+ *	None. This procedure never returns (it exits the process when
+ *	it's done.
+ *
+ * Side effects:
+ *	This procedure initializes the Macintosh world and then 
+ *	calls Tcl_Main.  Tcl_Main will never return except to exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+    int argc,				/* Number of arguments. */
+    char **argv)			/* Array of argument strings. */
+{
+    char *newArgv[3];
+    
+    if (MacintoshInit()  != TCL_OK) {
+	Tcl_Exit(1);
+    }
+
+    argc = 2;
+    newArgv[0] = "tclsh";
+    newArgv[1] = "bgScript.tcl";
+    newArgv[2] = NULL;
+    Tcl_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AppInit --
+ *
+ *	This procedure performs application-specific initialization.
+ *	Most applications, especially those that incorporate additional
+ *	packages, will have their own version of this procedure.
+ *
+ * Results:
+ *	Returns a standard Tcl completion code, and leaves an error
+ *	message in interp->result if an error occurs.
+ *
+ * Side effects:
+ *	Depends on the startup script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(
+    Tcl_Interp *interp)		/* Interpreter for application. */
+{
+    Tcl_Channel tempChan;
+    
+    if (Tcl_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+
+#ifdef TCL_TEST
+    if (Tcltest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
+            (Tcl_PackageInitProc *) NULL);
+    if (TclObjTest_Init(interp) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+#endif /* TCL_TEST */
+
+    /*
+     * Call the init procedures for included packages.  Each call should
+     * look like this:
+     *
+     * if (Mod_Init(interp) == TCL_ERROR) {
+     *     return TCL_ERROR;
+     * }
+     *
+     * where "Mod" is the name of the module.
+     */
+
+    /*
+     * Call Tcl_CreateCommand for application-specific commands, if
+     * they weren't already created by the init procedures called above.
+     * Each call would loo like this:
+     *
+     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+     */
+
+    /*
+     * Specify a user-specific startup script to invoke if the application
+     * is run interactively.  On the Mac we can specifiy either a TEXT resource
+     * which contains the script or the more UNIX like file location
+     * may also used.  (I highly recommend using the resource method.)
+     */
+
+    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
+
+    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
+
+    /*
+     * We have to support at least the quit Apple Event. 
+     */
+    
+    TkMacInitAppleEvents(interp);
+    
+    /* 
+     * Open a file channel to put stderr, stdin, stdout... 
+     */
+    
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDIN);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
+
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDOUT);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
+
+    tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
+    Tcl_SetStdChannel(tempChan,TCL_STDERR);
+    Tcl_RegisterChannel(interp, tempChan);
+    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
+    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
+   
+    
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ *	This procedure calls initalization routines to set up a simple
+ *	console on a Macintosh.  This is necessary as the Mac doesn't
+ *	have a stdout & stderr by default.
+ *
+ * Results:
+ *	Returns TCL_OK if everything went fine.  If it didn't the 
+ *	application should probably fail.
+ *
+ * Side effects:
+ *	Inits the appropiate console package.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+    THz theZone = GetZone();
+    SysEnvRec   sys;
+
+    
+    /*
+     * There is a bug in systems earlier that 7.5.5, where a second BOA will
+     * get a corrupted heap.  This is the fix from TechNote 1070
+     */
+     
+    SysEnvirons(1, &sys);
+
+    if (sys.systemVersion < 0x0755)
+    {
+        if ( LMGetHeapEnd() != theZone->bkLim) {
+            LMSetHeapEnd(theZone->bkLim);
+        }
+    }
+    
+#if GENERATING68K && !GENERATINGCFM
+    SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
+#endif
+    MaxApplZone();
+
+    InitGraf((Ptr)&qd.thePort);
+    		    
+    /* No problems with initialization */
+    Tcl_MacSetEventProc(HandleHighLevelEvents);
+
+    return TCL_OK;
+}
+
+int
+HandleHighLevelEvents(
+    EventRecord *eventPtr)
+{
+    int eventFound = false;
+    
+    if (eventPtr->what == kHighLevelEvent) {
+	AEProcessAppleEvent(eventPtr);
+        eventFound = true;
+    } else if (eventPtr->what == nullEvent) {
+        eventFound = true;
+    }
+    return eventFound;    
+}