os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/mac/tclMacBOAAppInit.c
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
sl@0
     1
/* 
sl@0
     2
 * tclMacBOAAppInit.c --
sl@0
     3
 *
sl@0
     4
 *	Provides a version of the Tcl_AppInit procedure for a 
sl@0
     5
 *      Macintosh Background Only Application.
sl@0
     6
 *
sl@0
     7
 * Copyright (c) 1997 Sun Microsystems, Inc.
sl@0
     8
 *
sl@0
     9
 * See the file "license.terms" for information on usage and redistribution
sl@0
    10
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    11
 *
sl@0
    12
 * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.5 2001/06/14 00:48:51 dgp Exp $
sl@0
    13
 */
sl@0
    14
sl@0
    15
#include "tcl.h"
sl@0
    16
#include "tclInt.h"
sl@0
    17
#include "tclPort.h"
sl@0
    18
#include "tclMac.h"
sl@0
    19
#include "tclMacInt.h"
sl@0
    20
#include <Fonts.h>
sl@0
    21
#include <Windows.h>
sl@0
    22
#include <Dialogs.h>
sl@0
    23
#include <Menus.h>
sl@0
    24
#include <Aliases.h>
sl@0
    25
#include <LowMem.h>
sl@0
    26
sl@0
    27
#include <AppleEvents.h>
sl@0
    28
#include <SegLoad.h>
sl@0
    29
#include <ToolUtils.h>
sl@0
    30
sl@0
    31
#if defined(THINK_C)
sl@0
    32
#   include <console.h>
sl@0
    33
#elif defined(__MWERKS__)
sl@0
    34
#   include <SIOUX.h>
sl@0
    35
short InstallConsole _ANSI_ARGS_((short fd));
sl@0
    36
#endif
sl@0
    37
sl@0
    38
void TkMacInitAppleEvents(Tcl_Interp *interp);
sl@0
    39
int HandleHighLevelEvents(EventRecord *eventPtr);	
sl@0
    40
sl@0
    41
#ifdef TCL_TEST
sl@0
    42
EXTERN int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    43
EXTERN int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    44
#endif /* TCL_TEST */
sl@0
    45
sl@0
    46
/*
sl@0
    47
 * Forward declarations for procedures defined later in this file:
sl@0
    48
 */
sl@0
    49
sl@0
    50
static int		MacintoshInit _ANSI_ARGS_((void));
sl@0
    51

sl@0
    52
/*
sl@0
    53
 *----------------------------------------------------------------------
sl@0
    54
 *
sl@0
    55
 * main --
sl@0
    56
 *
sl@0
    57
 *	Main program for tclsh.  This file can be used as a prototype
sl@0
    58
 *	for other applications using the Tcl library.
sl@0
    59
 *
sl@0
    60
 * Results:
sl@0
    61
 *	None. This procedure never returns (it exits the process when
sl@0
    62
 *	it's done.
sl@0
    63
 *
sl@0
    64
 * Side effects:
sl@0
    65
 *	This procedure initializes the Macintosh world and then 
sl@0
    66
 *	calls Tcl_Main.  Tcl_Main will never return except to exit.
sl@0
    67
 *
sl@0
    68
 *----------------------------------------------------------------------
sl@0
    69
 */
sl@0
    70
sl@0
    71
void
sl@0
    72
main(
sl@0
    73
    int argc,				/* Number of arguments. */
sl@0
    74
    char **argv)			/* Array of argument strings. */
sl@0
    75
{
sl@0
    76
    char *newArgv[3];
sl@0
    77
    
sl@0
    78
    if (MacintoshInit()  != TCL_OK) {
sl@0
    79
	Tcl_Exit(1);
sl@0
    80
    }
sl@0
    81
sl@0
    82
    argc = 2;
sl@0
    83
    newArgv[0] = "tclsh";
sl@0
    84
    newArgv[1] = "bgScript.tcl";
sl@0
    85
    newArgv[2] = NULL;
sl@0
    86
    Tcl_Main(argc, newArgv, Tcl_AppInit);
sl@0
    87
}
sl@0
    88

sl@0
    89
/*
sl@0
    90
 *----------------------------------------------------------------------
sl@0
    91
 *
sl@0
    92
 * Tcl_AppInit --
sl@0
    93
 *
sl@0
    94
 *	This procedure performs application-specific initialization.
sl@0
    95
 *	Most applications, especially those that incorporate additional
sl@0
    96
 *	packages, will have their own version of this procedure.
sl@0
    97
 *
sl@0
    98
 * Results:
sl@0
    99
 *	Returns a standard Tcl completion code, and leaves an error
sl@0
   100
 *	message in the interp's result if an error occurs.
sl@0
   101
 *
sl@0
   102
 * Side effects:
sl@0
   103
 *	Depends on the startup script.
sl@0
   104
 *
sl@0
   105
 *----------------------------------------------------------------------
sl@0
   106
 */
sl@0
   107
sl@0
   108
int
sl@0
   109
Tcl_AppInit(
sl@0
   110
    Tcl_Interp *interp)		/* Interpreter for application. */
sl@0
   111
{
sl@0
   112
    Tcl_Channel tempChan;
sl@0
   113
    
sl@0
   114
    if (Tcl_Init(interp) == TCL_ERROR) {
sl@0
   115
	return TCL_ERROR;
sl@0
   116
    }
sl@0
   117
sl@0
   118
#ifdef TCL_TEST
sl@0
   119
    if (Tcltest_Init(interp) == TCL_ERROR) {
sl@0
   120
	return TCL_ERROR;
sl@0
   121
    }
sl@0
   122
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
sl@0
   123
            (Tcl_PackageInitProc *) NULL);
sl@0
   124
    if (TclObjTest_Init(interp) == TCL_ERROR) {
sl@0
   125
	return TCL_ERROR;
sl@0
   126
    }
sl@0
   127
#endif /* TCL_TEST */
sl@0
   128
sl@0
   129
    /*
sl@0
   130
     * Call the init procedures for included packages.  Each call should
sl@0
   131
     * look like this:
sl@0
   132
     *
sl@0
   133
     * if (Mod_Init(interp) == TCL_ERROR) {
sl@0
   134
     *     return TCL_ERROR;
sl@0
   135
     * }
sl@0
   136
     *
sl@0
   137
     * where "Mod" is the name of the module.
sl@0
   138
     */
sl@0
   139
sl@0
   140
    /*
sl@0
   141
     * Call Tcl_CreateCommand for application-specific commands, if
sl@0
   142
     * they weren't already created by the init procedures called above.
sl@0
   143
     * Each call would loo like this:
sl@0
   144
     *
sl@0
   145
     * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
sl@0
   146
     */
sl@0
   147
sl@0
   148
    /*
sl@0
   149
     * Specify a user-specific startup script to invoke if the application
sl@0
   150
     * is run interactively.  On the Mac we can specifiy either a TEXT resource
sl@0
   151
     * which contains the script or the more UNIX like file location
sl@0
   152
     * may also used.  (I highly recommend using the resource method.)
sl@0
   153
     */
sl@0
   154
sl@0
   155
    Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
sl@0
   156
sl@0
   157
    /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
sl@0
   158
sl@0
   159
    /*
sl@0
   160
     * We have to support at least the quit Apple Event. 
sl@0
   161
     */
sl@0
   162
    
sl@0
   163
    TkMacInitAppleEvents(interp);
sl@0
   164
    
sl@0
   165
    /* 
sl@0
   166
     * Open a file channel to put stderr, stdin, stdout... 
sl@0
   167
     */
sl@0
   168
    
sl@0
   169
    tempChan = Tcl_OpenFileChannel(interp, ":temp.in", "a+", 0);
sl@0
   170
    Tcl_SetStdChannel(tempChan,TCL_STDIN);
sl@0
   171
    Tcl_RegisterChannel(interp, tempChan);
sl@0
   172
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
sl@0
   173
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
sl@0
   174
sl@0
   175
    tempChan = Tcl_OpenFileChannel(interp, ":temp.out", "a+", 0);
sl@0
   176
    Tcl_SetStdChannel(tempChan,TCL_STDOUT);
sl@0
   177
    Tcl_RegisterChannel(interp, tempChan);
sl@0
   178
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
sl@0
   179
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "line");
sl@0
   180
sl@0
   181
    tempChan = Tcl_OpenFileChannel(interp, ":temp.err", "a+", 0);
sl@0
   182
    Tcl_SetStdChannel(tempChan,TCL_STDERR);
sl@0
   183
    Tcl_RegisterChannel(interp, tempChan);
sl@0
   184
    Tcl_SetChannelOption(NULL, tempChan, "-translation", "cr");
sl@0
   185
    Tcl_SetChannelOption(NULL, tempChan, "-buffering", "none");
sl@0
   186
   
sl@0
   187
    
sl@0
   188
    return TCL_OK;
sl@0
   189
}
sl@0
   190

sl@0
   191
/*
sl@0
   192
 *----------------------------------------------------------------------
sl@0
   193
 *
sl@0
   194
 * MacintoshInit --
sl@0
   195
 *
sl@0
   196
 *	This procedure calls initalization routines to set up a simple
sl@0
   197
 *	console on a Macintosh.  This is necessary as the Mac doesn't
sl@0
   198
 *	have a stdout & stderr by default.
sl@0
   199
 *
sl@0
   200
 * Results:
sl@0
   201
 *	Returns TCL_OK if everything went fine.  If it didn't the 
sl@0
   202
 *	application should probably fail.
sl@0
   203
 *
sl@0
   204
 * Side effects:
sl@0
   205
 *	Inits the appropiate console package.
sl@0
   206
 *
sl@0
   207
 *----------------------------------------------------------------------
sl@0
   208
 */
sl@0
   209
sl@0
   210
static int
sl@0
   211
MacintoshInit()
sl@0
   212
{
sl@0
   213
    THz theZone = GetZone();
sl@0
   214
    SysEnvRec   sys;
sl@0
   215
sl@0
   216
    
sl@0
   217
    /*
sl@0
   218
     * There is a bug in systems earlier that 7.5.5, where a second BOA will
sl@0
   219
     * get a corrupted heap.  This is the fix from TechNote 1070
sl@0
   220
     */
sl@0
   221
     
sl@0
   222
    SysEnvirons(1, &sys);
sl@0
   223
sl@0
   224
    if (sys.systemVersion < 0x0755)
sl@0
   225
    {
sl@0
   226
        if ( LMGetHeapEnd() != theZone->bkLim) {
sl@0
   227
            LMSetHeapEnd(theZone->bkLim);
sl@0
   228
        }
sl@0
   229
    }
sl@0
   230
    
sl@0
   231
#if GENERATING68K && !GENERATINGCFM
sl@0
   232
    SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
sl@0
   233
#endif
sl@0
   234
    MaxApplZone();
sl@0
   235
sl@0
   236
    InitGraf((Ptr)&qd.thePort);
sl@0
   237
    		    
sl@0
   238
    /* No problems with initialization */
sl@0
   239
    Tcl_MacSetEventProc(HandleHighLevelEvents);
sl@0
   240
sl@0
   241
    return TCL_OK;
sl@0
   242
}
sl@0
   243
sl@0
   244
int
sl@0
   245
HandleHighLevelEvents(
sl@0
   246
    EventRecord *eventPtr)
sl@0
   247
{
sl@0
   248
    int eventFound = false;
sl@0
   249
    
sl@0
   250
    if (eventPtr->what == kHighLevelEvent) {
sl@0
   251
	AEProcessAppleEvent(eventPtr);
sl@0
   252
        eventFound = true;
sl@0
   253
    } else if (eventPtr->what == nullEvent) {
sl@0
   254
        eventFound = true;
sl@0
   255
    }
sl@0
   256
    return eventFound;    
sl@0
   257
}