home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tk / os2 / tkMain.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  13KB  |  438 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.148 96/03/25 18:08:43
  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, chan;
  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(__OS2__) || 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.      * Commands will come from standard input, so set up an event
  185.      * handler for standard input.  Evaluate the .rc file, if one
  186.      * has been specified, set up an event handler for standard
  187.      * input, and print a prompt if the input device is a terminal.
  188.      */
  189.  
  190.     fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
  191.  
  192.     if (fileName != NULL) {
  193.         Tcl_DString buffer;
  194.         char *fullName;
  195.     
  196.         fullName = Tcl_TranslateFileName(interp, fileName, &buffer);
  197.         if (fullName == NULL) {
  198.         errChannel = Tcl_GetStdChannel(TCL_STDERR);
  199.         if (errChannel) {
  200.                     Tcl_Write(errChannel, interp->result, -1);
  201.                     Tcl_Write(errChannel, "\n", 1);
  202.                 }
  203.         } else {
  204.  
  205.                 /*
  206.                  * NOTE: The following relies on O_RDONLY==0.
  207.                  */
  208.                 
  209.                 chan = Tcl_OpenFileChannel(interp, fullName, "r", 0);
  210.                 if (chan != (Tcl_Channel) NULL) {
  211.                     Tcl_Close(NULL, chan);
  212.                     if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
  213.             errChannel = Tcl_GetStdChannel(TCL_STDERR);
  214.             if (errChannel) {
  215.                             Tcl_Write(errChannel, interp->result, -1);
  216.                             Tcl_Write(errChannel, "\n", 1);
  217.                         }
  218.                     }
  219.                 }
  220.             }
  221.             
  222.         Tcl_DStringFree(&buffer);
  223.     }
  224.  
  225.     /*
  226.      * Establish a channel handler for stdin.
  227.      */
  228.  
  229.     inChannel = Tcl_GetStdChannel(TCL_STDIN);
  230.     if (inChannel) {
  231.         Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
  232.             (ClientData) inChannel);
  233.     }
  234.     if (tty) {
  235.         Prompt(interp, 0);
  236.     }
  237.     }
  238.  
  239.     outChannel = Tcl_GetStdChannel(TCL_STDOUT);
  240.     if (outChannel) {
  241.     Tcl_Flush(outChannel);
  242.     }
  243.     Tcl_DStringInit(&command);
  244.     Tcl_DStringInit(&line);
  245.     Tcl_ResetResult(interp);
  246.  
  247.     /*
  248.      * Loop infinitely, waiting for commands to execute.  When there
  249.      * are no windows left, Tk_MainLoop returns and we exit.
  250.      */
  251.  
  252.     Tk_MainLoop();
  253.     Tcl_DeleteInterp(interp);
  254.     Tcl_Exit(0);
  255.  
  256. error:
  257.     /*
  258.      * The following statement guarantees that the errorInfo
  259.      * variable is set properly.
  260.      */
  261.  
  262.     Tcl_AddErrorInfo(interp, "");
  263.     errChannel = Tcl_GetStdChannel(TCL_STDERR);
  264.     if (errChannel) {
  265.         Tcl_Write(errChannel, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
  266.         -1);
  267.         Tcl_Write(errChannel, "\n", 1);
  268.     }
  269.     Tcl_DeleteInterp(interp);
  270.     Tcl_Exit(1);
  271. }
  272.  
  273. /*
  274.  *----------------------------------------------------------------------
  275.  *
  276.  * StdinProc --
  277.  *
  278.  *    This procedure is invoked by the event dispatcher whenever
  279.  *    standard input becomes readable.  It grabs the next line of
  280.  *    input characters, adds them to a command being assembled, and
  281.  *    executes the command if it's complete.
  282.  *
  283.  * Results:
  284.  *    None.
  285.  *
  286.  * Side effects:
  287.  *    Could be almost arbitrary, depending on the command that's
  288.  *    typed.
  289.  *
  290.  *----------------------------------------------------------------------
  291.  */
  292.  
  293.     /* ARGSUSED */
  294. static void
  295. StdinProc(clientData, mask)
  296.     ClientData clientData;        /* Not used. */
  297.     int mask;                /* Not used. */
  298. {
  299.     static int gotPartial = 0;
  300.     char *cmd;
  301.     int code, count;
  302.     Tcl_Channel chan = (Tcl_Channel) clientData;
  303.  
  304.     count = Tcl_Gets(chan, &line);
  305.  
  306.     if (count < 0) {
  307.     if (!gotPartial) {
  308.         if (tty) {
  309.         Tcl_Exit(0);
  310.         } else {
  311.         Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
  312.         }
  313.         return;
  314.     } else {
  315.         count = 0;
  316.     }
  317.     }
  318.  
  319.     (void) Tcl_DStringAppend(&command, Tcl_DStringValue(&line), -1);
  320.     cmd = Tcl_DStringAppend(&command, "\n", -1);
  321.     Tcl_DStringFree(&line);
  322.     
  323.     if (!Tcl_CommandComplete(cmd)) {
  324.         gotPartial = 1;
  325.         goto prompt;
  326.     }
  327.     gotPartial = 0;
  328.  
  329.     /*
  330.      * Disable the stdin channel handler while evaluating the command;
  331.      * otherwise if the command re-enters the event loop we might
  332.      * process commands from stdin before the current command is
  333.      * finished.  Among other things, this will trash the text of the
  334.      * command being evaluated.
  335.      */
  336.  
  337.     Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
  338.     code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
  339.     Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
  340.         (ClientData) chan);
  341.     Tcl_DStringFree(&command);
  342.     if (*interp->result != 0) {
  343.     if ((code != TCL_OK) || (tty)) {
  344.         /*
  345.          * The statement below used to call "printf", but that resulted
  346.          * in core dumps under Solaris 2.3 if the result was very long.
  347.              *
  348.              * NOTE: This probably will not work under Windows either.
  349.          */
  350.  
  351.         puts(interp->result);
  352.     }
  353.     }
  354.  
  355.     /*
  356.      * Output a prompt.
  357.      */
  358.  
  359.     prompt:
  360.     if (tty) {
  361.     Prompt(interp, gotPartial);
  362.     }
  363.     Tcl_ResetResult(interp);
  364. }
  365.  
  366. /*
  367.  *----------------------------------------------------------------------
  368.  *
  369.  * Prompt --
  370.  *
  371.  *    Issue a prompt on standard output, or invoke a script
  372.  *    to issue the prompt.
  373.  *
  374.  * Results:
  375.  *    None.
  376.  *
  377.  * Side effects:
  378.  *    A prompt gets output, and a Tcl script may be evaluated
  379.  *    in interp.
  380.  *
  381.  *----------------------------------------------------------------------
  382.  */
  383.  
  384. static void
  385. Prompt(interp, partial)
  386.     Tcl_Interp *interp;            /* Interpreter to use for prompting. */
  387.     int partial;            /* Non-zero means there already
  388.                      * exists a partial command, so use
  389.                      * the secondary prompt. */
  390. {
  391.     char *promptCmd;
  392.     int code;
  393.     Tcl_Channel outChannel, errChannel;
  394.  
  395.     errChannel = Tcl_GetChannel(interp, "stderr", NULL);
  396.  
  397.     promptCmd = Tcl_GetVar(interp,
  398.     partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
  399.     if (promptCmd == NULL) {
  400. defaultPrompt:
  401.     if (!partial) {
  402.  
  403.             /*
  404.              * We must check that outChannel is a real channel - it
  405.              * is possible that someone has transferred stdout out of
  406.              * this interpreter with "interp transfer".
  407.              */
  408.  
  409.         outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  410.             if (outChannel != (Tcl_Channel) NULL) {
  411.                 Tcl_Write(outChannel, "% ", 2);
  412.             }
  413.     }
  414.     } else {
  415.     code = Tcl_Eval(interp, promptCmd);
  416.     if (code != TCL_OK) {
  417.         Tcl_AddErrorInfo(interp,
  418.             "\n    (script that generates prompt)");
  419.             /*
  420.              * We must check that errChannel is a real channel - it
  421.              * is possible that someone has transferred stderr out of
  422.              * this interpreter with "interp transfer".
  423.              */
  424.             
  425.         errChannel = Tcl_GetChannel(interp, "stderr", NULL);
  426.             if (errChannel != (Tcl_Channel) NULL) {
  427.                 Tcl_Write(errChannel, interp->result, -1);
  428.                 Tcl_Write(errChannel, "\n", 1);
  429.             }
  430.         goto defaultPrompt;
  431.     }
  432.     }
  433.     outChannel = Tcl_GetChannel(interp, "stdout", NULL);
  434.     if (outChannel != (Tcl_Channel) NULL) {
  435.         Tcl_Flush(outChannel);
  436.     }
  437. }
  438.