/* * tkXshell.c * * Version of Tk main that is modified to build a wish shell with the Extended * Tcl command set and libraries. This makes it easier to use a different * main. *----------------------------------------------------------------------------- * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans. * * Permission to use, copy, modify, and distribute this software and its * documentation for any purpose and without fee is hereby granted, provided * that the above copyright notice appear in all copies. Karl Lehenbauer and * Mark Diekhans make no representations about the suitability of this * software for any purpose. It is provided "as is" without express or * implied warranty. *----------------------------------------------------------------------------- * $Id$ *----------------------------------------------------------------------------- */ /* * main.c -- * * This file contains the main program for "wish", a windowing * shell based on Tk and Tcl. It also provides a template that * can be used as the basis for main programs for other Tk * applications. * * Copyright (c) 1990-1993 The Regents of the University of California. * All rights reserved. * * Permission is hereby granted, without written agreement and without * license or royalty fees, to use, copy, modify, and distribute this * software and its documentation for any purpose, provided that the * above copyright notice and the following two paragraphs appear in * all copies of this software. * * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. * * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. */ #ifdef __cplusplus # include "tcl++.h" # include #else # include "tclExtend.h" #endif #include "tk.h" /*-------------------------------------------------------------------*/ #include #include #include int sock_write( int connection, const char *text, int length ); int sock_read( int connection, char *buffer, int max_len ); extern int hdl; extern pid_t parent; /*-------------------------------------------------------------------*/ /* * Declarations for various library procedures and variables (don't want * to include tkInt.h or tkConfig.h here, because people might copy this * file out of the Tk source directory to make their own modified versions). */ extern void exit _ANSI_ARGS_((int status)); extern int isatty _ANSI_ARGS_((int fd)); /* extern int read _ANSI_ARGS_((int fd, char *buf, size_t size)); */ extern char * strrchr _ANSI_ARGS_((CONST char *string, int c)); /* * Global variables used by the main program: */ static Tk_Window mainWindow; /* The main window for the application. If * NULL then the application no longer * exists. */ static Tcl_Interp *interp; /* Interpreter for this application. */ char *tcl_RcFileName ; /* Name of a user-specific startup script * to source if the application is being run * interactively (e.g. "~/.wishrc"). Set * by Tcl_AppInit. NULL means don't source * anything ever. */ static Tcl_DString command; /* Used to assemble lines of terminal input * into Tcl commands. */ static int gotPartial = 0; /* Partial command in buffer. */ static int tty; /* Non-zero means standard input is a * terminal-like device. Zero means it's * a file. */ static char exitCmd[] = "exit"; static char errorExitCmd[] = "exit 1"; /* * Command-line options: */ static int synchronize = 0; static char *fileName = NULL; static char *name = NULL; static char *display = NULL; static char *geometry = NULL; static Tk_ArgvInfo argTable[] = { {"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName, "File from which to read commands"}, {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry, "Initial geometry for window"}, {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display, "Display to use"}, {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name, "Name to use for application"}, {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize, "Use synchronous mode for display server"}, {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL, (char *) NULL} }; /* * Forward declarations for procedures defined later in this file: */ static void StdinProc _ANSI_ARGS_((ClientData clientData, int mask)); static void SignalProc _ANSI_ARGS_((int signalNum)); /* *---------------------------------------------------------------------- * * TkX_Wish -- * * Main program for Wish. * * Results: * None. This procedure never returns (it exits the process when * it's done * * Side effects: * This procedure initializes the wish world and then starts * interpreting commands; almost anything could happen, depending * on the script being interpreted. * *---------------------------------------------------------------------- */ void TkX_Wish (argc, argv) int argc; /* Number of arguments. */ char **argv; /* Array of argument strings. */ { char *args, *p, *msg; char buf[20]; int code; interp = Tcl_CreateInterp(); #ifdef TCL_MEM_DEBUG Tcl_InitMemory(interp); #endif /* * Parse command-line arguments. */ if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0) != TCL_OK) { fprintf(stderr, "%s\n", interp->result); exit(1); } if (name == NULL) { if (fileName != NULL) { p = fileName; } else { p = argv[0]; } name = strrchr(p, '/'); if (name != NULL) { name++; } else { name = p; } } /* * If a display was specified, put it into the DISPLAY * environment variable so that it will be available for * any sub-processes created by us. */ if (display != NULL) { Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY); } /* * Set the "tcl_interactive" variable. */ tty = isatty(hdl); Tcl_SetVar(interp, "tcl_interactive", ((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY); tty = isatty(hdl); /* * Initialize the Tk application. */ mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk"); if (mainWindow == NULL) { fprintf(stderr, "%s\n", interp->result); exit(1); } Tk_SetClass(mainWindow, "Tk"); if (synchronize) { XSynchronize(Tk_Display(mainWindow), True); } Tk_GeometryRequest(mainWindow, 200, 200); /* * Make command-line arguments available in the Tcl variables "argc" * and "argv". Also set the "geometry" variable from the geometry * specified on the command line. */ args = Tcl_Merge(argc-1, argv+1); Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY); ckfree(args); sprintf(buf, "%d", argc-1); Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY); Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0], TCL_GLOBAL_ONLY); if (geometry != NULL) { Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY); } /* * Invoke application-specific initialization. */ if (Tcl_AppInit(interp) != TCL_OK) { TclX_ErrorExit (interp, 255); } /* * Set the geometry of the main window, if requested. */ if (geometry != NULL) { code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL); if (code != TCL_OK) { fprintf(stderr, "%s\n", interp->result); } } /* * Invoke the script specified on the command line, if any. */ if (fileName != NULL) { code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL); if (code != TCL_OK) { goto error; } tty = 0; } else { TclX_EvalRCFile (interp); /* * Commands will come from standard input. Set up a handler * to receive those characters and print a prompt if the input * device is a terminal. */ tclErrorSignalProc = SignalProc; Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0); if (tty) { TclX_OutputPrompt (interp, 1); } } tclSignalBackgroundError = Tk_BackgroundError; fflush(stdout); Tcl_DStringInit(&command); /* * Loop infinitely, waiting for commands to execute. When there * are no windows left, Tk_MainLoop returns and we exit. */ Tk_MainLoop(); /* * Don't exit directly, but rather invoke the Tcl "exit" command. * This gives the application the opportunity to redefine "exit" * to do additional cleanup. */ Tcl_GlobalEval(interp, exitCmd); exit(1); error: msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (msg == NULL) { msg = interp->result; } fprintf(stderr, "%s\n", msg); Tcl_GlobalEval(interp, errorExitCmd); exit (1); } /* *---------------------------------------------------------------------- * * SignalProc -- * * Function called on a signal generating an error to clear the stdin * buffer. *---------------------------------------------------------------------- */ static void SignalProc (signalNum) int signalNum; { tclGotErrorSignal = 0; Tcl_DStringFree (&command); gotPartial = 0; if (tty) { fputc ('\n', stdout); TclX_OutputPrompt (interp, !gotPartial); } } /* *---------------------------------------------------------------------- * * StdinProc -- * * This procedure is invoked by the event dispatcher whenever * standard input becomes readable. It grabs the next line of * input characters, adds them to a command being assembled, and * executes the command if it's complete. * * Results: * None. * * Side effects: * Could be almost arbitrary, depending on the command that's * typed. * *---------------------------------------------------------------------- */ #define BUFFER_SIZE 4000 static void StdinProc(clientData, mask) ClientData clientData; /* Not used. */ int mask; /* Not used. */ { char input[BUFFER_SIZE+1]; char *cmd; int code, count; count = read(hdl, input, BUFFER_SIZE); if (count <= 0) { if (!gotPartial) { if (tty) { Tcl_VarEval(interp, "exit", (char *) NULL); exit(1); } else { Tk_DeleteFileHandler(hdl); } return; } else { count = 0; } } cmd = Tcl_DStringAppend(&command, input, count); fprintf(stderr, "TK command : %s\n", cmd); fflush(stderr); if (count != 0) { if ((input[count-1] != '\n') && (input[count-1] != ';')) { gotPartial = 1; goto exitPoint; } if (!Tcl_CommandComplete(cmd)) { fprintf(stderr, "Partial command\n", cmd); fflush(stderr); gotPartial = 1; goto exitPoint; } } gotPartial = 0; /* * Disable the stdin file handler; otherwise if the command * re-enters the event loop we might process commands from * stdin before the current command is finished. Among other * things, this will trash the text of the command being evaluated. */ Tk_CreateFileHandler(hdl, 0, StdinProc, (ClientData) 0); code = Tcl_RecordAndEval(interp, cmd, 0); Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0); if (tty) TclX_PrintResult (interp, code, cmd); else { char buf[1024]; sprintf(buf, "%d %s", code, interp->result); sock_write(hdl, buf, strlen(buf)); kill(parent, SIGUSR1); } Tcl_DStringFree(&command); exitPoint: if (tty) { TclX_OutputPrompt (interp, !gotPartial); } }