os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAAppInit.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAAppInit.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,257 @@
1.4 +/*
1.5 + * tclMacBOAAppInit.c --
1.6 + *
1.7 + * Provides a version of the Tcl_AppInit procedure for a
1.8 + * Macintosh Background Only Application.
1.9 + *
1.10 + * Copyright (c) 1997 Sun Microsystems, Inc.
1.11 + *
1.12 + * See the file "license.terms" for information on usage and redistribution
1.13 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.14 + *
1.15 + * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.5 2001/06/14 00:48:51 dgp Exp $
1.16 + */
1.17 +
1.18 +#include "tcl.h"
1.19 +#include "tclInt.h"
1.20 +#include "tclPort.h"
1.21 +#include "tclMac.h"
1.22 +#include "tclMacInt.h"
1.23 +#include <Fonts.h>
1.24 +#include <Windows.h>
1.25 +#include <Dialogs.h>
1.26 +#include <Menus.h>
1.27 +#include <Aliases.h>
1.28 +#include <LowMem.h>
1.29 +
1.30 +#include <AppleEvents.h>
1.31 +#include <SegLoad.h>
1.32 +#include <ToolUtils.h>
1.33 +
1.34 +#if defined(THINK_C)
1.35 +# include <console.h>
1.36 +#elif defined(__MWERKS__)
1.37 +# include <SIOUX.h>
1.38 +short InstallConsole _ANSI_ARGS_((short fd));
1.39 +#endif
1.40 +
1.41 +void TkMacInitAppleEvents(Tcl_Interp *interp);
1.42 +int HandleHighLevelEvents(EventRecord *eventPtr);
1.43 +
1.44 +#ifdef TCL_TEST
1.45 +EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.46 +EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.47 +#endif /* TCL_TEST */
1.48 +
1.49 +/*
1.50 + * Forward declarations for procedures defined later in this file:
1.51 + */
1.52 +
1.53 +static int MacintoshInit _ANSI_ARGS_((void));
1.54 +
1.55 +/*
1.56 + *----------------------------------------------------------------------
1.57 + *
1.58 + * main --
1.59 + *
1.60 + * Main program for tclsh. This file can be used as a prototype
1.61 + * for other applications using the Tcl library.
1.62 + *
1.63 + * Results:
1.64 + * None. This procedure never returns (it exits the process when
1.65 + * it's done.
1.66 + *
1.67 + * Side effects:
1.68 + * This procedure initializes the Macintosh world and then
1.69 + * calls Tcl_Main. Tcl_Main will never return except to exit.
1.70 + *
1.71 + *----------------------------------------------------------------------
1.72 + */
1.73 +
1.74 +void
1.75 +main(
1.76 + int argc, /* Number of arguments. */
1.77 + char **argv) /* Array of argument strings. */
1.78 +{
1.79 + char *newArgv[3];
1.80 +
1.81 + if (MacintoshInit() != TCL_OK) {
1.82 + Tcl_Exit(1);
1.83 + }
1.84 +
1.85 + argc = 2;
1.86 + newArgv[0] = "tclsh";
1.87 + newArgv[1] = "bgScript.tcl";
1.88 + newArgv[2] = NULL;
1.89 + Tcl_Main(argc, newArgv, Tcl_AppInit);
1.90 +}
1.91 +
1.92 +/*
1.93 + *----------------------------------------------------------------------
1.94 + *
1.95 + * Tcl_AppInit --
1.96 + *
1.97 + * This procedure performs application-specific initialization.
1.98 + * Most applications, especially those that incorporate additional
1.99 + * packages, will have their own version of this procedure.
1.100 + *
1.101 + * Results:
1.102 + * Returns a standard Tcl completion code, and leaves an error
1.103 + * message in the interp's result if an error occurs.
1.104 + *
1.105 + * Side effects:
1.106 + * Depends on the startup script.
1.107 + *
1.108 + *----------------------------------------------------------------------
1.109 + */
1.110 +
1.111 +int
1.112 +Tcl_AppInit(
1.113 + Tcl_Interp *interp) /* Interpreter for application. */
1.114 +{
1.115 + Tcl_Channel tempChan;
1.116 +
1.117 + if (Tcl_Init(interp) == TCL_ERROR) {
1.118 + return TCL_ERROR;
1.119 + }
1.120 +
1.121 +#ifdef TCL_TEST
1.122 + if (Tcltest_Init(interp) == TCL_ERROR) {
1.123 + return TCL_ERROR;
1.124 + }
1.125 + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
1.126 + (Tcl_PackageInitProc *) NULL);
1.127 + if (TclObjTest_Init(interp) == TCL_ERROR) {
1.128 + return TCL_ERROR;
1.129 + }
1.130 +#endif /* TCL_TEST */
1.131 +
1.132 + /*
1.133 + * Call the init procedures for included packages. Each call should
1.134 + * look like this:
1.135 + *
1.136 + * if (Mod_Init(interp) == TCL_ERROR) {
1.137 + * return TCL_ERROR;
1.138 + * }
1.139 + *
1.140 + * where "Mod" is the name of the module.
1.141 + */
1.142 +
1.143 + /*
1.144 + * Call Tcl_CreateCommand for application-specific commands, if
1.145 + * they weren't already created by the init procedures called above.
1.146 + * Each call would loo like this:
1.147 + *
1.148 + * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
1.149 + */
1.150 +
1.151 + /*
1.152 + * Specify a user-specific startup script to invoke if the application
1.153 + * is run interactively. On the Mac we can specifiy either a TEXT resource
1.154 + * which contains the script or the more UNIX like file location
1.155 + * may also used. (I highly recommend using the resource method.)
1.156 + */
1.157 +
1.158 + Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
1.159 +
1.160 + /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
1.161 +
1.162 + /*
1.163 + * We have to support at least the quit Apple Event.
1.164 + */
1.165 +
1.166 + TkMacInitAppleEvents(interp);
1.167 +
1.168 + /*
1.169 + * Open a file channel to put stderr, stdin, stdout...
1.170 + */
1.171 +
1.172 + tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
1.173 + Tcl_SetStdChannel(tempChan,TCL_STDIN);
1.174 + Tcl_RegisterChannel(interp, tempChan);
1.175 + Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
1.176 + Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
1.177 +
1.178 + tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
1.179 + Tcl_SetStdChannel(tempChan,TCL_STDOUT);
1.180 + Tcl_RegisterChannel(interp, tempChan);
1.181 + Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
1.182 + Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
1.183 +
1.184 + tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
1.185 + Tcl_SetStdChannel(tempChan,TCL_STDERR);
1.186 + Tcl_RegisterChannel(interp, tempChan);
1.187 + Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
1.188 + Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
1.189 +
1.190 +
1.191 + return TCL_OK;
1.192 +}
1.193 +
1.194 +/*
1.195 + *----------------------------------------------------------------------
1.196 + *
1.197 + * MacintoshInit --
1.198 + *
1.199 + * This procedure calls initalization routines to set up a simple
1.200 + * console on a Macintosh. This is necessary as the Mac doesn't
1.201 + * have a stdout & stderr by default.
1.202 + *
1.203 + * Results:
1.204 + * Returns TCL_OK if everything went fine. If it didn't the
1.205 + * application should probably fail.
1.206 + *
1.207 + * Side effects:
1.208 + * Inits the appropiate console package.
1.209 + *
1.210 + *----------------------------------------------------------------------
1.211 + */
1.212 +
1.213 +static int
1.214 +MacintoshInit()
1.215 +{
1.216 + THz theZone = GetZone();
1.217 + SysEnvRec sys;
1.218 +
1.219 +
1.220 + /*
1.221 + * There is a bug in systems earlier that 7.5.5, where a second BOA will
1.222 + * get a corrupted heap. This is the fix from TechNote 1070
1.223 + */
1.224 +
1.225 + SysEnvirons(1, &sys);
1.226 +
1.227 + if (sys.systemVersion < 0x0755)
1.228 + {
1.229 + if ( LMGetHeapEnd() != theZone->bkLim) {
1.230 + LMSetHeapEnd(theZone->bkLim);
1.231 + }
1.232 + }
1.233 +
1.234 +#if GENERATING68K && !GENERATINGCFM
1.235 + SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
1.236 +#endif
1.237 + MaxApplZone();
1.238 +
1.239 + InitGraf((Ptr)&qd.thePort);
1.240 +
1.241 + /* No problems with initialization */
1.242 + Tcl_MacSetEventProc(HandleHighLevelEvents);
1.243 +
1.244 + return TCL_OK;
1.245 +}
1.246 +
1.247 +int
1.248 +HandleHighLevelEvents(
1.249 + EventRecord *eventPtr)
1.250 +{
1.251 + int eventFound = false;
1.252 +
1.253 + if (eventPtr->what == kHighLevelEvent) {
1.254 + AEProcessAppleEvent(eventPtr);
1.255 + eventFound = true;
1.256 + } else if (eventPtr->what == nullEvent) {
1.257 + eventFound = true;
1.258 + }
1.259 + return eventFound;
1.260 +}