This is tkXshell.c in view mode; [Download] [Up]
/*
* 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: tkXshell.c,v 3.1 1993/11/19 08:21:29 markd Exp $
*-----------------------------------------------------------------------------
*/
/*
* 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 <unistd.h>
#else
# include "tclExtend.h"
#endif
#include "tk.h"
/*-------------------------------------------------------------------*/
#include <unistd.h>
#include <sys/types.h>
#include <signal.h>
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);
}
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.