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