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
7
*-----------------------------------------------------------------------------
8
* Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
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
16
*-----------------------------------------------------------------------------
17
* $Id: tkXshell.c,v 3.1 1993/11/19 08:21:29 markd Exp $
18
*-----------------------------------------------------------------------------
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
29
* Copyright (c) 1990-1993 The Regents of the University of California.
30
* All rights reserved.
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.
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.
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.
54
# include "tclExtend.h"
59
/*-------------------------------------------------------------------*/
61
#include <sys/types.h>
64
int sock_write( int connection, const char *text, int length );
65
int sock_read( int connection, char *buffer, int max_len );
69
/*-------------------------------------------------------------------*/
72
* Declarations for various library procedures and variables (don't want
73
* to include tkInt.h or tkConfig.h here, because people might copy this
74
* file out of the Tk source directory to make their own modified versions).
77
extern void exit _ANSI_ARGS_((int status));
78
extern int isatty _ANSI_ARGS_((int fd));
80
extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
82
extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
85
* Global variables used by the main program:
88
static Tk_Window mainWindow; /* The main window for the application. If
89
* NULL then the application no longer
91
static Tcl_Interp *interp; /* Interpreter for this application. */
92
char *tcl_RcFileName ; /* Name of a user-specific startup script
93
* to source if the application is being run
94
* interactively (e.g. "~/.wishrc"). Set
95
* by Tcl_AppInit. NULL means don't source
97
static Tcl_DString command; /* Used to assemble lines of terminal input
98
* into Tcl commands. */
99
static int gotPartial = 0; /* Partial command in buffer. */
100
static int tty; /* Non-zero means standard input is a
101
* terminal-like device. Zero means it's
103
static char exitCmd[] = "exit";
104
static char errorExitCmd[] = "exit 1";
107
* Command-line options:
110
static int synchronize = 0;
111
static char *fileName = NULL;
112
static char *name = NULL;
113
static char *display = NULL;
114
static char *geometry = NULL;
116
static Tk_ArgvInfo argTable[] = {
117
{"-file", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
118
"File from which to read commands"},
119
{"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
120
"Initial geometry for window"},
121
{"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
123
{"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
124
"Name to use for application"},
125
{"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
126
"Use synchronous mode for display server"},
127
{(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
132
* Forward declarations for procedures defined later in this file:
135
static void StdinProc _ANSI_ARGS_((ClientData clientData,
137
static void SignalProc _ANSI_ARGS_((int signalNum));
140
*----------------------------------------------------------------------
144
* Main program for Wish.
147
* None. This procedure never returns (it exits the process when
151
* This procedure initializes the wish world and then starts
152
* interpreting commands; almost anything could happen, depending
153
* on the script being interpreted.
155
*----------------------------------------------------------------------
159
TkX_Wish (argc, argv)
160
int argc; /* Number of arguments. */
161
char **argv; /* Array of argument strings. */
163
char *args, *p, *msg;
167
interp = Tcl_CreateInterp();
169
Tcl_InitMemory(interp);
173
* Parse command-line arguments.
176
if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv, argTable, 0)
178
fprintf(stderr, "%s\n", interp->result);
182
if (fileName != NULL) {
187
name = strrchr(p, '/');
196
* If a display was specified, put it into the DISPLAY
197
* environment variable so that it will be available for
198
* any sub-processes created by us.
201
if (display != NULL) {
202
Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
206
* Set the "tcl_interactive" variable.
209
Tcl_SetVar(interp, "tcl_interactive",
210
((fileName == NULL) && tty) ? "1" : "0", TCL_GLOBAL_ONLY);
215
* Initialize the Tk application.
218
mainWindow = Tk_CreateMainWindow(interp, display, name, "Tk");
219
if (mainWindow == NULL) {
220
fprintf(stderr, "%s\n", interp->result);
223
Tk_SetClass(mainWindow, "Tk");
225
XSynchronize(Tk_Display(mainWindow), True);
227
Tk_GeometryRequest(mainWindow, 200, 200);
230
* Make command-line arguments available in the Tcl variables "argc"
231
* and "argv". Also set the "geometry" variable from the geometry
232
* specified on the command line.
235
args = Tcl_Merge(argc-1, argv+1);
236
Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
238
sprintf(buf, "%d", argc-1);
239
Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
240
Tcl_SetVar(interp, "argv0", (fileName != NULL) ? fileName : argv[0],
242
if (geometry != NULL) {
243
Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
247
* Invoke application-specific initialization.
250
if (Tcl_AppInit(interp) != TCL_OK) {
251
TclX_ErrorExit (interp, 255);
255
* Set the geometry of the main window, if requested.
258
if (geometry != NULL) {
259
code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
260
if (code != TCL_OK) {
261
fprintf(stderr, "%s\n", interp->result);
266
* Invoke the script specified on the command line, if any.
269
if (fileName != NULL) {
270
code = Tcl_VarEval(interp, "source ", fileName, (char *) NULL);
271
if (code != TCL_OK) {
276
TclX_EvalRCFile (interp);
279
* Commands will come from standard input. Set up a handler
280
* to receive those characters and print a prompt if the input
281
* device is a terminal.
283
tclErrorSignalProc = SignalProc;
284
Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0);
286
TclX_OutputPrompt (interp, 1);
289
tclSignalBackgroundError = Tk_BackgroundError;
292
Tcl_DStringInit(&command);
295
* Loop infinitely, waiting for commands to execute. When there
296
* are no windows left, Tk_MainLoop returns and we exit.
302
* Don't exit directly, but rather invoke the Tcl "exit" command.
303
* This gives the application the opportunity to redefine "exit"
304
* to do additional cleanup.
307
Tcl_GlobalEval(interp, exitCmd);
311
msg = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
313
msg = interp->result;
315
fprintf(stderr, "%s\n", msg);
316
Tcl_GlobalEval(interp, errorExitCmd);
321
*----------------------------------------------------------------------
325
* Function called on a signal generating an error to clear the stdin
327
*----------------------------------------------------------------------
331
SignalProc (signalNum)
334
tclGotErrorSignal = 0;
335
Tcl_DStringFree (&command);
338
fputc ('\n', stdout);
339
TclX_OutputPrompt (interp, !gotPartial);
344
*----------------------------------------------------------------------
348
* This procedure is invoked by the event dispatcher whenever
349
* standard input becomes readable. It grabs the next line of
350
* input characters, adds them to a command being assembled, and
351
* executes the command if it's complete.
357
* Could be almost arbitrary, depending on the command that's
360
*----------------------------------------------------------------------
363
#define BUFFER_SIZE 4000
366
StdinProc(clientData, mask)
367
ClientData clientData; /* Not used. */
368
int mask; /* Not used. */
370
char input[BUFFER_SIZE+1];
374
count = read(hdl, input, BUFFER_SIZE);
381
Tcl_VarEval(interp, "exit", (char *) NULL);
386
Tk_DeleteFileHandler(hdl);
395
cmd = Tcl_DStringAppend(&command, input, count);
397
fprintf(stderr, "TK command : %s\n", cmd);
402
if ((input[count-1] != '\n') && (input[count-1] != ';'))
407
if (!Tcl_CommandComplete(cmd))
409
fprintf(stderr, "Partial command\n", cmd);
419
* Disable the stdin file handler; otherwise if the command
420
* re-enters the event loop we might process commands from
421
* stdin before the current command is finished. Among other
422
* things, this will trash the text of the command being evaluated.
425
Tk_CreateFileHandler(hdl, 0, StdinProc, (ClientData) 0);
426
code = Tcl_RecordAndEval(interp, cmd, 0);
427
Tk_CreateFileHandler(hdl, TK_READABLE, StdinProc, (ClientData) 0);
429
TclX_PrintResult (interp, code, cmd);
433
sprintf(buf, "%d %s", code, interp->result);
434
sock_write(hdl, buf, strlen(buf));
435
kill(parent, SIGUSR1);
437
Tcl_DStringFree(&command);
442
TclX_OutputPrompt (interp, !gotPartial);
added
removed
gcl-tk/tkXshell.c
