tclMacBOAAppInit.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:7k
源码类别:

通讯编程

开发平台:

Visual C++

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