home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / mac / tkMacAppInit.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  8.7 KB  |  375 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tkMacAppInit.c --
  3.  *
  4.  *    Provides a version of the Tcl_AppInit procedure for the example shell.
  5.  *
  6.  * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
  7.  * Copyright (c) 1995-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.  * SCCS: @(#) tkMacAppInit.c 1.35 97/07/28 11:18:55
  13.  */
  14.  
  15. #include <Gestalt.h>
  16. #include <ToolUtils.h>
  17. #include <Fonts.h>
  18. #include <Dialogs.h>
  19. #include <SegLoad.h>
  20. #include <Traps.h>
  21.  
  22. #include "tk.h"
  23. #include "tkInt.h"
  24. #include "tkMacInt.h"
  25. #include "tclMac.h"
  26.  
  27. #ifdef TK_TEST
  28. EXTERN int        Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  29. #endif /* TK_TEST */
  30.  
  31. #ifdef TCL_TEST
  32. EXTERN int        TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  33. EXTERN int        Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
  34. #endif /* TCL_TEST */
  35.  
  36. Tcl_Interp *gStdoutInterp = NULL;
  37.  
  38. int     TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr));
  39.  
  40. /*
  41.  * Prototypes for functions the ANSI library needs to link against.
  42.  */
  43. short            InstallConsole _ANSI_ARGS_((short fd));
  44. void            RemoveConsole _ANSI_ARGS_((void));
  45. long            WriteCharsToConsole _ANSI_ARGS_((char *buff, long n));
  46. long            ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n));
  47. extern char *        __ttyname _ANSI_ARGS_((long fildes));
  48. short            SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
  49.  
  50. /*
  51.  * Prototypes for functions from the tkConsole.c file.
  52.  */
  53.  
  54. EXTERN void        TkConsoleCreate _ANSI_ARGS_((void));
  55. EXTERN int        TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
  56. EXTERN void        TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
  57.                 int devId, char *buffer, long size));
  58. /*
  59.  * Forward declarations for procedures defined later in this file:
  60.  */
  61.  
  62. static int        MacintoshInit _ANSI_ARGS_((void));
  63. static int        SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
  64.  
  65. /*
  66.  *----------------------------------------------------------------------
  67.  *
  68.  * main --
  69.  *
  70.  *    Main program for Wish.
  71.  *
  72.  * Results:
  73.  *    None. This procedure never returns (it exits the process when
  74.  *    it's done
  75.  *
  76.  * Side effects:
  77.  *    This procedure initializes the wish world and then 
  78.  *    calls Tk_Main.
  79.  *
  80.  *----------------------------------------------------------------------
  81.  */
  82.  
  83. void
  84. main(
  85.     int argc,                /* Number of arguments. */
  86.     char **argv)            /* Array of argument strings. */
  87. {
  88.     char *newArgv[2];
  89.  
  90.     if (MacintoshInit()  != TCL_OK) {
  91.     Tcl_Exit(1);
  92.     }
  93.  
  94.     argc = 1;
  95.     newArgv[0] = "Wish";
  96.     newArgv[1] = NULL;
  97.     Tk_Main(argc, newArgv, Tcl_AppInit);
  98. }
  99.  
  100. /*
  101.  *----------------------------------------------------------------------
  102.  *
  103.  * Tcl_AppInit --
  104.  *
  105.  *    This procedure performs application-specific initialization.
  106.  *    Most applications, especially those that incorporate additional
  107.  *    packages, will have their own version of this procedure.
  108.  *
  109.  * Results:
  110.  *    Returns a standard Tcl completion code, and leaves an error
  111.  *    message in interp->result if an error occurs.
  112.  *
  113.  * Side effects:
  114.  *    Depends on the startup script.
  115.  *
  116.  *----------------------------------------------------------------------
  117.  */
  118.  
  119. int
  120. Tcl_AppInit(
  121.     Tcl_Interp *interp)        /* Interpreter for application. */
  122. {
  123.     if (Tcl_Init(interp) == TCL_ERROR) {
  124.     return TCL_ERROR;
  125.     }
  126.     if (Tk_Init(interp) == TCL_ERROR) {
  127.     return TCL_ERROR;
  128.     }
  129.     Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
  130.     
  131.     /*
  132.      * Call the init procedures for included packages.  Each call should
  133.      * look like this:
  134.      *
  135.      * if (Mod_Init(interp) == TCL_ERROR) {
  136.      *     return TCL_ERROR;
  137.      * }
  138.      *
  139.      * where "Mod" is the name of the module.
  140.      */
  141.  
  142. #ifdef TCL_TEST
  143.     if (Tcltest_Init(interp) == TCL_ERROR) {
  144.     return TCL_ERROR;
  145.     }
  146.     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
  147.             (Tcl_PackageInitProc *) NULL);
  148.     if (TclObjTest_Init(interp) == TCL_ERROR) {
  149.     return TCL_ERROR;
  150.     }
  151. #endif /* TCL_TEST */
  152.  
  153. #ifdef TK_TEST
  154.     if (Tktest_Init(interp) == TCL_ERROR) {
  155.     return TCL_ERROR;
  156.     }
  157.     Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
  158.             (Tcl_PackageInitProc *) NULL);
  159. #endif /* TK_TEST */
  160.  
  161.     /*
  162.      * Call Tcl_CreateCommand for application-specific commands, if
  163.      * they weren't already created by the init procedures called above.
  164.      * Each call would look like this:
  165.      *
  166.      * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
  167.      */
  168.  
  169.     SetupMainInterp(interp);
  170.  
  171.     /*
  172.      * Specify a user-specific startup script to invoke if the application
  173.      * is run interactively.  On the Mac we can specifiy either a TEXT resource
  174.      * which contains the script or the more UNIX like file location
  175.      * may also used.  (I highly recommend using the resource method.)
  176.      */
  177.  
  178.     Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
  179.     /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
  180.  
  181.     return TCL_OK;
  182. }
  183.  
  184. /*
  185.  *----------------------------------------------------------------------
  186.  *
  187.  * MacintoshInit --
  188.  *
  189.  *    This procedure calls Mac specific initilization calls.  Most of
  190.  *    these calls must be made as soon as possible in the startup
  191.  *    process.
  192.  *
  193.  * Results:
  194.  *    Returns TCL_OK if everything went fine.  If it didn't the 
  195.  *    application should probably fail.
  196.  *
  197.  * Side effects:
  198.  *    Inits the application.
  199.  *
  200.  *----------------------------------------------------------------------
  201.  */
  202.  
  203. static int
  204. MacintoshInit()
  205. {
  206.     int i;
  207.     long result, mask = 0x0700;         /* mask = system 7.x */
  208.  
  209. #if GENERATING68K && !GENERATINGCFM
  210.     SetApplLimit(GetApplLimit() - (TK_MAC_68K_STACK_GROWTH));
  211. #endif
  212.     MaxApplZone();
  213.     for (i = 0; i < 4; i++) {
  214.     (void) MoreMasters();
  215.     }
  216.  
  217.     /*
  218.      * Tk needs us to set the qd pointer it uses.  This is needed
  219.      * so Tk doesn't have to assume the availablity of the qd global
  220.      * variable.  Which in turn allows Tk to be used in code resources.
  221.      */
  222.     tcl_macQdPtr = &qd;
  223.  
  224.     InitGraf(&tcl_macQdPtr->thePort);
  225.     InitFonts();
  226.     InitWindows();
  227.     InitMenus();
  228.     InitDialogs((long) NULL);        
  229.     InitCursor();
  230.  
  231.     /*
  232.      * Make sure we are running on system 7 or higher
  233.      */
  234.      
  235.     if ((NGetTrapAddress(_Gestalt, ToolTrap) == 
  236.             NGetTrapAddress(_Unimplemented, ToolTrap))
  237.             || (((Gestalt(gestaltSystemVersion, &result) != noErr)
  238.         || (result < mask)))) {
  239.     panic("Tcl/Tk requires System 7 or higher.");
  240.     }
  241.  
  242.     /*
  243.      * Make sure we have color quick draw 
  244.      * (this means we can't run on 68000 macs)
  245.      */
  246.      
  247.     if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr)
  248.         || (result < gestalt32BitQD13))) {
  249.     panic("Tk requires Color QuickDraw.");
  250.     }
  251.  
  252.     
  253.     FlushEvents(everyEvent, 0);
  254.     SetEventMask(everyEvent);
  255.  
  256.  
  257.     Tcl_MacSetEventProc(TkMacConvertEvent);
  258.     TkConsoleCreate();
  259.  
  260.     return TCL_OK;
  261. }
  262.  
  263. /*
  264.  *----------------------------------------------------------------------
  265.  *
  266.  * SetupMainInterp --
  267.  *
  268.  *    This procedure calls initalization routines require a Tcl 
  269.  *    interp as an argument.  This call effectively makes the passed
  270.  *    iterpreter the "main" interpreter for the application.
  271.  *
  272.  * Results:
  273.  *    Returns TCL_OK if everything went fine.  If it didn't the 
  274.  *    application should probably fail.
  275.  *
  276.  * Side effects:
  277.  *    More initilization.
  278.  *
  279.  *----------------------------------------------------------------------
  280.  */
  281.  
  282. static int
  283. SetupMainInterp(
  284.     Tcl_Interp *interp)
  285. {
  286.     /*
  287.      * Initialize the console only if we are running as an interactive
  288.      * application.
  289.      */
  290.  
  291.     TkMacInitAppleEvents(interp);
  292.     TkMacInitMenus(interp);
  293.  
  294.     if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
  295.         == 0) {
  296.     if (TkConsoleInit(interp) == TCL_ERROR) {
  297.         goto error;
  298.     }
  299.     }
  300.  
  301.     /*
  302.      * Attach the global interpreter to tk's expected global console
  303.      */
  304.  
  305.     gStdoutInterp = interp;
  306.  
  307.     return TCL_OK;
  308.  
  309. error:
  310.     panic(interp->result);
  311.     return TCL_ERROR;
  312. }
  313.  
  314. /*
  315.  *----------------------------------------------------------------------
  316.  *
  317.  * InstallConsole, RemoveConsole, etc. --
  318.  *
  319.  *    The following functions provide the UI for the console package.
  320.  *    Users wishing to replace SIOUX with their own console package 
  321.  *    need only provide the four functions below in a library.
  322.  *
  323.  * Results:
  324.  *    See SIOUX documentation for details.
  325.  *
  326.  * Side effects:
  327.  *    See SIOUX documentation for details.
  328.  *
  329.  *----------------------------------------------------------------------
  330.  */
  331.  
  332. short 
  333. InstallConsole(short fd)
  334. {
  335. #pragma unused (fd)
  336.  
  337.     return 0;
  338. }
  339.  
  340. void 
  341. RemoveConsole(void)
  342. {
  343. }
  344.  
  345. long 
  346. WriteCharsToConsole(char *buffer, long n)
  347. {
  348.     TkConsolePrint(gStdoutInterp, TCL_STDOUT, buffer, n);
  349.     return n;
  350. }
  351.  
  352. long 
  353. ReadCharsFromConsole(char *buffer, long n)
  354. {
  355.     return 0;
  356. }
  357.  
  358. extern char *
  359. __ttyname(long fildes)
  360. {
  361.     static char *__devicename = "null device";
  362.  
  363.     if (fildes >= 0 && fildes <= 2) {
  364.     return (__devicename);
  365.     }
  366.     
  367.     return (0L);
  368. }
  369.  
  370. short
  371. SIOUXHandleOneEvent(EventRecord *event)
  372. {
  373.     return 0;
  374. }
  375.