home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tksrc / tkXshell.c < prev   
Encoding:
C/C++ Source or Header  |  1993-12-03  |  11.1 KB  |  409 lines

  1. /*
  2.  * tkXshell.c
  3.  *
  4.  * Version of Tk main that is modified to build a wish shell with the Extended
  5.  * Tcl command set and libraries.  This makes it easier to use a different
  6.  * main.
  7.  *-----------------------------------------------------------------------------
  8.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  9.  *
  10.  * Permission to use, copy, modify, and distribute this software and its
  11.  * documentation for any purpose and without fee is hereby granted, provided
  12.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  13.  * Mark Diekhans make no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without express or
  15.  * implied warranty.
  16.  *-----------------------------------------------------------------------------
  17.  * $Id: tkXshell.c,v 3.3 1993/12/03 10:25:23 markd Exp $
  18.  *-----------------------------------------------------------------------------
  19.  */
  20.  
  21. /* 
  22.  * main.c --
  23.  *
  24.  *    This file contains the main program for "wish", a windowing
  25.  *    shell based on Tk and Tcl.  It also provides a template that
  26.  *    can be used as the basis for main programs for other Tk
  27.  *    applications.
  28.  *
  29.  * Copyright (c) 1990-1993 The Regents of the University of California.
  30.  * All rights reserved.
  31.  *
  32.  * Permission is hereby granted, without written agreement and without
  33.  * license or royalty fees, to use, copy, modify, and distribute this
  34.  * software and its documentation for any purpose, provided that the
  35.  * above copyright notice and the following two paragraphs appear in
  36.  * all copies of this software.
  37.  * 
  38.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  39.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  40.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  41.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  42.  *
  43.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  44.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  45.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  46.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  47.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  48.  */
  49.  
  50. #ifdef __cplusplus
  51. #    include "tcl++.h"
  52. #    include <unistd.h>
  53. #else
  54. #    include "tclExtend.h"
  55. #endif
  56.  
  57. #include "tk.h"
  58.  
  59. /*
  60.  * Declarations for various library procedures and variables (don't want
  61.  * to include tkInt.h or tkConfig.h here, because people might copy this
  62.  * file out of the Tk source directory to make their own modified versions).
  63.  */
  64.  
  65. extern void        exit _ANSI_ARGS_((int status));
  66. extern int        isatty _ANSI_ARGS_((int fd));
  67. extern int        read _ANSI_ARGS_((int fd, char *buf, size_t size));
  68. extern char *        strrchr _ANSI_ARGS_((CONST char *string, int c));
  69.  
  70. /*
  71.  * Global variables used by the main program:
  72.  */
  73.  
  74. static Tk_Window mainWindow;    /* The main window for the application.  If
  75.                  * NULL then the application no longer
  76.                  * exists. */
  77. static Tcl_Interp *interp;    /* Interpreter for this application. */
  78. static Tcl_DString command;    /* Used to assemble lines of terminal input
  79.                  * into Tcl commands. */
  80. static int gotPartial = 0;      /* Partial command in buffer. */
  81. static int tty;            /* Non-zero means standard input is a
  82.                  * terminal-like device.  Zero means it's
  83.                  * a file. */
  84. static char exitCmd[] = "exit";
  85. static char errorExitCmd[] = "exit 1";
  86.  
  87. /*
  88.  * Command-line options:
  89.  */
  90.  
  91. static int synchronize = 0;
  92. static char *fileName = NULL;
  93. static char *name = NULL;
  94. static char *display = NULL;
  95. static char *geometry = NULL;
  96.  
  97. static Tk_ArgvInfo argTable[] = {
  98.     {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
  99.     "File from which to read commands"},
  100.     {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
  101.     "Initial geometry for window"},
  102.     {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
  103.     "Display to use"},
  104.     {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
  105.     "Name to use for application"},
  106.     {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
  107.     "Use synchronous mode for display server"},
  108.     {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
  109.     (char *) NULL}
  110. };
  111.  
  112. /*
  113.  * Forward declarations for procedures defined later in this file:
  114.  */
  115.  
  116. static void        StdinProc _ANSI_ARGS_((ClientData clientData,
  117.                 int mask));
  118. static void        SignalProc _ANSI_ARGS_((int signalNum));
  119.  
  120. /*
  121.  *----------------------------------------------------------------------
  122.  *
  123.  * TkX_Wish --
  124.  *
  125.  *    Main program for Wish.
  126.  *
  127.  * Results:
  128.  *    None. This procedure never returns (it exits the process when
  129.  *    it's done
  130.  *
  131.  * Side effects:
  132.  *    This procedure initializes the wish world and then starts
  133.  *    interpreting commands;  almost anything could happen, depending
  134.  *    on the script being interpreted.
  135.  *
  136.  *----------------------------------------------------------------------
  137.  */
  138.  
  139. void
  140. TkX_Wish (argc, argv)
  141.     int argc;                /* Number of arguments. */
  142.     char **argv;            /* Array of argument strings. */
  143. {
  144.     char *args, *p, *msg;
  145.     char buf[20];
  146.     int code;
  147.  
  148.     interp = Tcl_CreateInterp();
  149. #ifdef TCL_MEM_DEBUG
  150.     Tcl_InitMemory(interp);
  151. #endif
  152.  
  153.     /*
  154.      * Parse command-line arguments.
  155.      */
  156.  
  157.     if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
  158.         != TCL_OK) {
  159.     fprintf(stderr, "%s\n", interp->result);
  160.     exit(1);
  161.     }
  162.     if (name == NULL) {
  163.     if (fileName != NULL) {
  164.         p = fileName;
  165.     } else {
  166.         p = argv[0];
  167.     }
  168.     name = strrchr(p, '/');
  169.     if (name != NULL) {
  170.         name++;
  171.     } else {
  172.         name = p;
  173.     }
  174.     }
  175.  
  176.     /*
  177.      * If a display was specified, put it into the DISPLAY
  178.      * environment variable so that it will be available for
  179.      * any sub-processes created by us.
  180.      */
  181.  
  182.     if (display != NULL) {
  183.     Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
  184.     }
  185.  
  186.     /*
  187.      * Set the "tcl_interactive" variable.
  188.      */
  189.     tty = isatty(0);
  190.     Tcl_SetVar(interp, "tcl_interactive",
  191.          ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
  192.  
  193.     tty = isatty(0);
  194.  
  195.     /*
  196.      * Initialize the Tk application.
  197.      */
  198.  
  199.     mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
  200.     if (mainWindow == NULL) {
  201.     fprintf(stderr, "%s\n", interp->result);
  202.     exit(1);
  203.     }
  204.     Tk_SetClass(mainWindow, "Tk");
  205.     if (synchronize) {
  206.     XSynchronize(Tk_Display(mainWindow), True);
  207.     }
  208.     Tk_GeometryRequest(mainWindow, 200, 200);
  209.  
  210.     /*
  211.      * Make command-line arguments available in the Tcl variables "argc"
  212.      * and "argv".  Also set the "geometry" variable from the geometry
  213.      * specified on the command line.
  214.      */
  215.  
  216.     args = Tcl_Merge(argc-1, argv+1);
  217.     Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
  218.     ckfree(args);
  219.     sprintf(buf, "%d", argc-1);
  220.     Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
  221.     Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
  222.         TCL_GLOBAL_ONLY);
  223.     if (geometry != NULL) {
  224.     Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
  225.     }
  226.  
  227.     /*
  228.      * Invoke application-specific initialization.
  229.      */
  230.  
  231.     if (Tcl_AppInit(interp) != TCL_OK) {
  232.     TclX_ErrorExit (interp, 255);
  233.     }
  234.  
  235.     /*
  236.      * Set the geometry of the main window, if requested.
  237.      */
  238.  
  239.     if (geometry != NULL) {
  240.     code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
  241.     if (code != TCL_OK) {
  242.         fprintf(stderr, "%s\n", interp->result);
  243.     }
  244.     }
  245.  
  246.     /*
  247.      * Invoke the script specified on the command line, if any.
  248.      */
  249.  
  250.     if (fileName != NULL) {
  251.     code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
  252.     if (code != TCL_OK) {
  253.         goto error;
  254.     }
  255.     tty = 0;
  256.     } else {
  257.         TclX_EvalRCFile (interp);
  258.  
  259.     /*
  260.      * Commands will come from standard input.  Set up a handler
  261.      * to receive those characters and print a prompt if the input
  262.      * device is a terminal.
  263.      */
  264.         tclErrorSignalProc = SignalProc;
  265.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  266.     if (tty) {
  267.         TclX_OutputPrompt (interp, 1);
  268.     }
  269.     }
  270.     tclSignalBackgroundError = Tk_BackgroundError;
  271.  
  272.     fflush(stdout);
  273.     Tcl_DStringInit(&command);
  274.  
  275.     /*
  276.      * Loop infinitely, waiting for commands to execute.  When there
  277.      * are no windows left, Tk_MainLoop returns and we exit.
  278.      */
  279.  
  280.     Tk_MainLoop();
  281.  
  282.     /*
  283.      * Don't exit directly, but rather invoke the Tcl "exit" command.
  284.      * This gives the application the opportunity to redefine "exit"
  285.      * to do additional cleanup.
  286.      */
  287.  
  288.     if (!tclDeleteInterpAtEnd) {
  289.         Tcl_GlobalEval(interp, exitCmd);
  290.     } else {
  291.         Tcl_DeleteInterp (interp);
  292.     }
  293.     exit(1);
  294.  
  295. error:
  296.     msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
  297.     if (msg == NULL) {
  298.     msg = interp->result;
  299.     }
  300.     fprintf(stderr, "%s\n", msg);
  301.  
  302.     if (!tclDeleteInterpAtEnd) {
  303.         Tcl_GlobalEval(interp, errorExitCmd);
  304.     } else {
  305.         Tcl_DeleteInterp (interp);
  306.     }
  307.     exit (1);
  308. }
  309.  
  310. /*
  311.  *----------------------------------------------------------------------
  312.  *
  313.  * SignalProc --
  314.  *
  315.  *    Function called on a signal generating an error to clear the stdin
  316.  *       buffer.
  317.  *----------------------------------------------------------------------
  318.  */
  319.  
  320. static void
  321. SignalProc (signalNum)
  322.     int  signalNum;
  323. {
  324.     tclGotErrorSignal = 0;
  325.     Tcl_DStringFree (&command);
  326.     gotPartial = 0;
  327.     if (tty) {
  328.         fputc ('\n', stdout);
  329.         TclX_OutputPrompt (interp, !gotPartial);
  330.     }
  331. }
  332.  
  333. /*
  334.  *----------------------------------------------------------------------
  335.  *
  336.  * StdinProc --
  337.  *
  338.  *    This procedure is invoked by the event dispatcher whenever
  339.  *    standard input becomes readable.  It grabs the next line of
  340.  *    input characters, adds them to a command being assembled, and
  341.  *    executes the command if it's complete.
  342.  *
  343.  * Results:
  344.  *    None.
  345.  *
  346.  * Side effects:
  347.  *    Could be almost arbitrary, depending on the command that's
  348.  *    typed.
  349.  *
  350.  *----------------------------------------------------------------------
  351.  */
  352.  
  353. static void
  354. StdinProc(clientData, mask)
  355.     ClientData clientData;        /* Not used. */
  356.     int mask;                /* Not used. */
  357. {
  358. #define BUFFER_SIZE 4000
  359.     char input[BUFFER_SIZE+1];
  360.     char *cmd;
  361.     int code, count;
  362.  
  363.     count = read(fileno(stdin), input, BUFFER_SIZE);
  364.     if (count <= 0) {
  365.     if (!gotPartial) {
  366.         if (tty) {
  367.         Tcl_VarEval(interp, "exit", (char *) NULL);
  368.         exit(1);
  369.         } else {
  370.         Tk_DeleteFileHandler(0);
  371.         }
  372.         return;
  373.     } else {
  374.         count = 0;
  375.     }
  376.     }
  377.     cmd = Tcl_DStringAppend(&command, input, count);
  378.     if (count != 0) {
  379.     if ((input[count-1] != '\n') && (input[count-1] != ';')) {
  380.         gotPartial = 1;
  381.         goto exitPoint;
  382.     }
  383.     if (!Tcl_CommandComplete(cmd)) {
  384.         gotPartial = 1;
  385.         goto exitPoint;
  386.     }
  387.     }
  388.     gotPartial = 0;
  389.  
  390.     /*
  391.      * Disable the stdin file handler;  otherwise if the command
  392.      * re-enters the event loop we might process commands from
  393.      * stdin before the current command is finished.  Among other
  394.      * things, this will trash the text of the command being evaluated.
  395.      */
  396.  
  397.     Tk_CreateFileHandler(0, 0, StdinProc, (ClientData) 0);
  398.     code = Tcl_RecordAndEval(interp, cmd, 0);
  399.     Tk_CreateFileHandler(0, TK_READABLE, StdinProc, (ClientData) 0);
  400.     if (tty)
  401.         TclX_PrintResult (interp, code, cmd);
  402.     Tcl_DStringFree(&command);
  403.  
  404.   exitPoint:
  405.     if (tty) {
  406.         TclX_OutputPrompt (interp, !gotPartial);
  407.     }
  408. }
  409.