home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2s.zip / tk4.2 / os2 / tkMain.c < prev    next >
C/C++ Source or Header  |  1998-01-28  |  11KB  |  402 lines
  1. /* 
  2.  * tkMain.c --
  3.  *
  4.  *    This file contains a generic main program for Tk-based applications.
  5.  *    It can be used as-is for many applications, just by supplying a
  6.  *    different appInitProc procedure for each specific application.
  7.  *    Or, it can be used as a template for creating new main programs
  8.  *    for Tk applications.
  9.  *
  10.  * Copyright (c) 1990-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * SCCS: @(#) tkMain.c 1.150 96/09/05 18:42:25
  17.  */
  18.  
  19. #include <ctype.h>
  20. #include <stdio.h>
  21. #include <string.h>
  22. #include <tcl.h>
  23. #include <tk.h>
  24. #ifdef NO_STDLIB_H
  25. #   include "../compat/stdlib.h"
  26. #else
  27. #   include <stdlib.h>
  28. #endif
  29.  
  30. /*
  31.  * Declarations for various library procedures and variables (don't want
  32.  * to include tkInt.h or tkPort.h here, because people might copy this
  33.  * file out of the Tk source directory to make their own modified versions).
  34.  * Note: don't declare "exit" here even though a declaration is really
  35.  * needed, because it will conflict with a declaration elsewhere on
  36.  * some systems.
  37.  */
  38.  
  39. extern int        isatty _ANSI_ARGS_((int fd));
  40. extern int        read _ANSI_ARGS_((int fd, char *buf, size_t size));
  41. extern char *        strrchr _ANSI_ARGS_((CONST char *string, int c));
  42.  
  43. /*
  44.  * Global variables used by the main program:
  45.  */
  46.  
  47. static Tcl_Interp *interp;    /* Interpreter for this application. */
  48. static Tcl_DString command;    /* Used to assemble lines of terminal input
  49.                  * into Tcl commands. */
  50. static Tcl_DString line;    /* Used to read the next line from the
  51.                                  * terminal input. */
  52. static int tty;            /* Non-zero means standard input is a
  53.                  * terminal-like device.  Zero means it's
  54.                  * a file. */
  55.  
  56. /*
  57.  * Forward declarations for procedures defined later in this file.
  58.  */
  59.  
  60. static void        Prompt _ANSI_ARGS_((Tcl_Interp *interp, int partial));
  61. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  62.                 int mask));
  63.  
  64. /*
  65.  *----------------------------------------------------------------------
  66.  *
  67.  * Tk_Main --
  68.  *
  69.  *    Main program for Wish and most other Tk-based applications.
  70.  *
  71.  * Results:
  72.  *    None. This procedure never returns (it exits the process when
  73.  *    it's done.
  74.  *
  75.  * Side effects:
  76.  *    This procedure initializes the Tk world and then starts
  77.  *    interpreting commands;  almost anything could happen, depending
  78.  *    on the script being interpreted.
  79.  *
  80.  *----------------------------------------------------------------------
  81.  */
  82.  
  83. void
  84. Tk_Main(argc, argv, appInitProc)
  85.     int argc;                /* Number of arguments. */
  86.     char **argv;            /* Array of argument strings. */
  87.     Tcl_AppInitProc *appInitProc;    /* Application-specific initialization
  88.                      * procedure to call after most
  89.                      * initialization but before starting
  90.                      * to execute commands. */
  91. {
  92.     char *args, *fileName;
  93.     char buf[20];
  94.     int code;
  95.     size_t length;
  96.     Tcl_Channel inChannel, outChannel, errChannel;
  97.  
  98.     Tcl_FindExecutable(argv[0]);
  99.     interp = Tcl_CreateInterp();
  100. #ifdef TCL_MEM_DEBUG
  101.     Tcl_InitMemory(interp);
  102. #endif
  103.  
  104.     /*
  105.      * Parse command-line arguments.  A leading "-file" argument is
  106.      * ignored (a historical relic from the distant past).  If the
  107.      * next argument doesn't start with a "-" then strip it off and
  108.      * use it as the name of a script file to process.
  109.      */
  110.  
  111.     fileName = NULL;
  112.     if (argc > 1) {
  113.     length = strlen(argv[1]);
  114.     if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
  115.         argc--;
  116.         argv++;
  117.     }
  118.     }
  119.     if ((argc > 1) && (argv[1][0] != '-')) {
  120.     fileName = argv[1];
  121.     argc--;
  122.     argv++;
  123.     }
  124.  
  125.     /*
  126.      * Make command-line arguments available in the Tcl variables "argc"
  127.      * and "argv".
  128.      */
  129.  
  130.     args = Tcl_Merge(argc-1, argv+1);
  131.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  132.     ckfree(args);
  133.     sprintf(buf, "%d", argc-1);
  134.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  135.     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
  136.         TCL_GLOBAL_ONLY);
  137.  
  138.     /*
  139.      * Set the "tcl_interactive" variable.
  140.      */
  141.  
  142.     /*
  143.      * For now, under Windows, we assume we are not running as a console mode
  144.      * app, so we need to use the GUI console.  In order to enable this, we
  145.      * always claim to be running on a tty.  This probably isn't the right
  146.      * way to do it.
  147.      */
  148.  
  149. #if (defined (__WIN32__) || defined(__EMX__))
  150.     tty = 1;
  151. #else
  152.     tty = isatty(0);
  153. #endif
  154.     Tcl_SetVar(interp, "tcl_interactive",
  155.         ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
  156.  
  157.     /*
  158.      * Invoke application-specific initialization.
  159.      */
  160.  
  161.     if ((*appInitProc)(interp) != TCL_OK) {
  162.     errChannel = Tcl_GetStdChannel(TCL_STDERR);
  163.     if (errChannel) {
  164.             Tcl_Write(errChannel,
  165.             "application-specific initialization failed: ", -1);
  166.             Tcl_Write(errChannel, interp->result, -1);
  167.             Tcl_Write(errChannel, "\n", 1);
  168.         }
  169.     }
  170.  
  171.     /*
  172.      * Invoke the script specified on the command line, if any.
  173.      */
  174.  
  175.     if (fileName != NULL) {
  176.     code = Tcl_EvalFile(interp, fileName);
  177.     if (code != TCL_OK) {
  178.         goto error;
  179.     }
  180.     tty = 0;
  181.     } else {
  182.  
  183.     /*
  184.      * Evaluate the .rc file, if one has been specified.
  185.      */
  186.  
  187.     Tcl_SourceRCFile(interp);
  188.  
  189.     /*
  190.      * Establish a channel handler for stdin.
  191.      */
  192.  
  193.     inChannel = Tcl_GetStdChannel(TCL_STDIN);
  194.     if (inChannel) {
  195.         Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
  196.             (ClientData) inChannel);
  197.     }
  198.     if (tty) {
  199.         Prompt(interp, 0);
  200.     }
  201.     }
  202.  
  203.     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
  204.     if (outChannel) {
  205.     Tcl_Flush(outChannel);
  206.     }
  207.     Tcl_DStringInit(&command);
  208.     Tcl_DStringInit(&line);
  209.     Tcl_ResetResult(interp);
  210.  
  211.     /*
  212.      * Loop infinitely, waiting for commands to execute.  When there
  213.      * are no windows left, Tk_MainLoop returns and we exit.
  214.      */
  215.  
  216.     Tk_MainLoop();
  217.     Tcl_DeleteInterp(interp);
  218.     Tcl_Exit(0);
  219.  
  220. error:
  221.     /*
  222.      * The following statement guarantees that the errorInfo
  223.      * variable is set properly.
  224.      */
  225.  
  226.     Tcl_AddErrorInfo(interp, "");
  227.     errChannel = Tcl_GetStdChannel(TCL_STDERR);
  228.     if (errChannel) {
  229.         Tcl_Write(errChannel, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
  230.         -1);
  231.         Tcl_Write(errChannel, "\n", 1);
  232.     }
  233.     Tcl_DeleteInterp(interp);
  234.     Tcl_Exit(1);
  235. }
  236.  
  237. /*
  238.  *----------------------------------------------------------------------
  239.  *
  240.  * StdinProc --
  241.  *
  242.  *    This procedure is invoked by the event dispatcher whenever
  243.  *    standard input becomes readable.  It grabs the next line of
  244.  *    input characters, adds them to a command being assembled, and
  245.  *    executes the command if it's complete.
  246.  *
  247.  * Results:
  248.  *    None.
  249.  *
  250.  * Side effects:
  251.  *    Could be almost arbitrary, depending on the command that's
  252.  *    typed.
  253.  *
  254.  *----------------------------------------------------------------------
  255.  */
  256.  
  257.     /* ARGSUSED */
  258. static void
  259. StdinProc(clientData, mask)
  260.     ClientData clientData;        /* Not used. */
  261.     int mask;                /* Not used. */
  262. {
  263.     static int gotPartial = 0;
  264.     char *cmd;
  265.     int code, count;
  266.     Tcl_Channel chan = (Tcl_Channel) clientData;
  267.  
  268.     count = Tcl_Gets(chan, &line);
  269.  
  270.     if (count < 0) {
  271.     if (!gotPartial) {
  272.         if (tty) {
  273.         Tcl_Exit(0);
  274.         } else {
  275.         Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
  276.         }
  277.         return;
  278.     } else {
  279.         count = 0;
  280.     }
  281.     }
  282.  
  283.     (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
  284.     cmd = Tcl_DStringAppend(&command, "\n", -1);
  285.     Tcl_DStringFree(&line);
  286.     
  287.     if (!Tcl_CommandComplete(cmd)) {
  288.         gotPartial = 1;
  289.         goto prompt;
  290.     }
  291.     gotPartial = 0;
  292.  
  293.     /*
  294.      * Disable the stdin channel handler while evaluating the command;
  295.      * otherwise if the command re-enters the event loop we might
  296.      * process commands from stdin before the current command is
  297.      * finished.  Among other things, this will trash the text of the
  298.      * command being evaluated.
  299.      */
  300.  
  301.     Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
  302.     code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
  303.     Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
  304.         (ClientData) chan);
  305.     Tcl_DStringFree(&command);
  306.     if (*interp->result != 0) {
  307.     if ((code != TCL_OK) || (tty)) {
  308.         /*
  309.          * The statement below used to call "printf", but that resulted
  310.          * in core dumps under Solaris 2.3 if the result was very long.
  311.              *
  312.              * NOTE: This probably will not work under Windows either.
  313.          */
  314.  
  315.         puts(interp->result);
  316.     }
  317.     }
  318.  
  319.     /*
  320.      * Output a prompt.
  321.      */
  322.  
  323.     prompt:
  324.     if (tty) {
  325.     Prompt(interp, gotPartial);
  326.     }
  327.     Tcl_ResetResult(interp);
  328. }
  329.  
  330. /*
  331.  *----------------------------------------------------------------------
  332.  *
  333.  * Prompt --
  334.  *
  335.  *    Issue a prompt on standard output, or invoke a script
  336.  *    to issue the prompt.
  337.  *
  338.  * Results:
  339.  *    None.
  340.  *
  341.  * Side effects:
  342.  *    A prompt gets output, and a Tcl script may be evaluated
  343.  *    in interp.
  344.  *
  345.  *----------------------------------------------------------------------
  346.  */
  347.  
  348. static void
  349. Prompt(interp, partial)
  350.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  351.     int partial;            /* Non-zero means there already
  352.                      * exists a partial command, so use
  353.                      * the secondary prompt. */
  354. {
  355.     char *promptCmd;
  356.     int code;
  357.     Tcl_Channel outChannel, errChannel;
  358.  
  359.     errChannel = Tcl_GetChannel(interp, "stderr", NULL);
  360.  
  361.     promptCmd = Tcl_GetVar(interp,
  362.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  363.     if (promptCmd == NULL) {
  364. defaultPrompt:
  365.     if (!partial) {
  366.  
  367.             /*
  368.              * We must check that outChannel is a real channel - it
  369.              * is possible that someone has transferred stdout out of
  370.              * this interpreter with "interp transfer".
  371.              */
  372.  
  373.         outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  374.             if (outChannel != (Tcl_Channel) NULL) {
  375.                 Tcl_Write(outChannel, "% ", 2);
  376.             }
  377.     }
  378.     } else {
  379.     code = Tcl_Eval(interp, promptCmd);
  380.     if (code != TCL_OK) {
  381.         Tcl_AddErrorInfo(interp,
  382.             "\n    (script that generates prompt)");
  383.             /*
  384.              * We must check that errChannel is a real channel - it
  385.              * is possible that someone has transferred stderr out of
  386.              * this interpreter with "interp transfer".
  387.              */
  388.             
  389.         errChannel = Tcl_GetChannel(interp, "stderr", NULL);
  390.             if (errChannel != (Tcl_Channel) NULL) {
  391.                 Tcl_Write(errChannel, interp->result, -1);
  392.                 Tcl_Write(errChannel, "\n", 1);
  393.             }
  394.         goto defaultPrompt;
  395.     }
  396.     }
  397.     outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  398.     if (outChannel != (Tcl_Channel) NULL) {
  399.         Tcl_Flush(outChannel);
  400.     }
  401. }
  402.