4
* This file implements a Tcl console for systems that may not
5
* otherwise have access to a console. It uses the Text widget
6
* and provides special access via a console command.
8
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
10
* See the file "license.terms" for information on usage and redistribution
11
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
* RCS: @(#) $Id: tkConsole.c,v 1.3 1999/02/04 20:51:36 stanton Exp $
20
* A data structure of the following type holds information for each console
21
* which a handler (i.e. a Tcl command) has been defined for a particular
25
typedef struct ConsoleInfo {
26
Tcl_Interp *consoleInterp; /* Interpreter for the console. */
27
Tcl_Interp *interp; /* Interpreter to send console commands. */
30
static Tcl_Interp *gStdoutInterp = NULL;
33
* Forward declarations for procedures defined later in this file:
35
* The first three will be used in the tk app shells...
38
void TkConsoleCreate _ANSI_ARGS_((void));
39
int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
40
void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
41
int devId, char *buffer, long size));
43
static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
44
Tcl_Interp *interp, int argc, char **argv));
45
static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
46
static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
48
static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
49
Tcl_Interp *interp, int argc, char **argv));
51
static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
52
char *buf, int toRead, int *errorCode));
53
static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
54
char *buf, int toWrite, int *errorCode));
55
static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
57
static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
59
static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
60
int direction, ClientData *handlePtr));
63
* This structure describes the channel type structure for file based IO:
66
static Tcl_ChannelType consoleChannelType = {
67
"console", /* Type name. */
68
NULL, /* Always non-blocking.*/
69
ConsoleClose, /* Close proc. */
70
ConsoleInput, /* Input proc. */
71
ConsoleOutput, /* Output proc. */
72
NULL, /* Seek proc. */
73
NULL, /* Set option proc. */
74
NULL, /* Get option proc. */
75
ConsoleWatch, /* Watch for events on console. */
76
ConsoleHandle, /* Get a handle from the device. */
80
*----------------------------------------------------------------------
84
* Create the console channels and install them as the standard
85
* channels. All I/O will be discarded until TkConsoleInit is
86
* called to attach the console to a text widget.
92
* Creates the console channel and installs it as the standard
95
*----------------------------------------------------------------------
101
Tcl_Channel consoleChannel;
103
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
104
(ClientData) TCL_STDIN, TCL_READABLE);
105
if (consoleChannel != NULL) {
106
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
107
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
109
Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
110
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
111
(ClientData) TCL_STDOUT, TCL_WRITABLE);
112
if (consoleChannel != NULL) {
113
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
114
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
116
Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
117
consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
118
(ClientData) TCL_STDERR, TCL_WRITABLE);
119
if (consoleChannel != NULL) {
120
Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
121
Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
123
Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
127
*----------------------------------------------------------------------
131
* Initialize the console. This code actually creates a new
132
* application and associated interpreter. This effectivly hides
133
* the implementation from the main application.
139
* A new console it created.
141
*----------------------------------------------------------------------
145
TkConsoleInit(interp)
146
Tcl_Interp *interp; /* Interpreter to use for prompting. */
148
Tcl_Interp *consoleInterp;
150
Tk_Window mainWindow = Tk_MainWindow(interp);
152
static char initCmd[] = "source -rsrc {Console}";
154
static char initCmd[] = "source $tk_library/console.tcl";
157
consoleInterp = Tcl_CreateInterp();
158
if (consoleInterp == NULL) {
163
* Initialized Tcl and Tk.
166
if (Tcl_Init(consoleInterp) != TCL_OK) {
169
if (Tk_Init(consoleInterp) != TCL_OK) {
172
gStdoutInterp = interp;
175
* Add console commands to the interp
177
info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
178
info->interp = interp;
179
info->consoleInterp = consoleInterp;
180
Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
181
(Tcl_CmdDeleteProc *) ConsoleDeleteProc);
182
Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
183
(ClientData) info, (Tcl_CmdDeleteProc *) NULL);
185
Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
188
Tcl_Preserve((ClientData) consoleInterp);
189
if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
190
/* goto error; -- no problem for now... */
191
printf("Eval error: %s", consoleInterp->result);
193
Tcl_Release((ClientData) consoleInterp);
197
if (consoleInterp != NULL) {
198
Tcl_DeleteInterp(consoleInterp);
204
*----------------------------------------------------------------------
208
* Writes the given output on the IO channel. Returns count of how
209
* many characters were actually written, and an error indication.
212
* A count of how many characters were written is returned and an
213
* error indication is returned in an output argument.
216
* Writes output on the actual channel.
218
*----------------------------------------------------------------------
222
ConsoleOutput(instanceData, buf, toWrite, errorCode)
223
ClientData instanceData; /* Indicates which device to use. */
224
char *buf; /* The data buffer. */
225
int toWrite; /* How many bytes to write? */
226
int *errorCode; /* Where to store error code. */
231
if (gStdoutInterp != NULL) {
232
TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
239
*----------------------------------------------------------------------
243
* Read input from the console. Not currently implemented.
246
* Always returns EOF.
251
*----------------------------------------------------------------------
256
ConsoleInput(instanceData, buf, bufSize, errorCode)
257
ClientData instanceData; /* Unused. */
258
char *buf; /* Where to store data read. */
259
int bufSize; /* How much space is available
261
int *errorCode; /* Where to store error code. */
263
return 0; /* Always return EOF. */
267
*----------------------------------------------------------------------
271
* Closes the IO channel.
274
* Always returns 0 (success).
277
* Frees the dummy file associated with the channel.
279
*----------------------------------------------------------------------
284
ConsoleClose(instanceData, interp)
285
ClientData instanceData; /* Unused. */
286
Tcl_Interp *interp; /* Unused. */
292
*----------------------------------------------------------------------
296
* Called by the notifier to set up the console device so that
297
* events will be noticed. Since there are no events on the
298
* console, this routine just returns without doing anything.
306
*----------------------------------------------------------------------
311
ConsoleWatch(instanceData, mask)
312
ClientData instanceData; /* Device ID for the channel. */
313
int mask; /* OR-ed combination of
314
* TCL_READABLE, TCL_WRITABLE and
315
* TCL_EXCEPTION, for the events
316
* we are interested in. */
321
*----------------------------------------------------------------------
325
* Invoked by the generic IO layer to get a handle from a channel.
326
* Because console channels are not devices, this function always
330
* Always returns TCL_ERROR.
335
*----------------------------------------------------------------------
340
ConsoleHandle(instanceData, direction, handlePtr)
341
ClientData instanceData; /* Device ID for the channel. */
342
int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
343
* which direction of the channel is being
345
ClientData *handlePtr; /* Where to store handle */
351
*----------------------------------------------------------------------
355
* The console command implements a Tcl interface to the various console
364
*----------------------------------------------------------------------
368
ConsoleCmd(clientData, interp, argc, argv)
369
ClientData clientData; /* Not used. */
370
Tcl_Interp *interp; /* Current interpreter. */
371
int argc; /* Number of arguments. */
372
char **argv; /* Argument strings. */
374
ConsoleInfo *info = (ConsoleInfo *) clientData;
378
Tcl_Interp *consoleInterp;
381
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
382
" option ?arg arg ...?\"", (char *) NULL);
387
length = strlen(argv[1]);
389
consoleInterp = info->consoleInterp;
390
Tcl_Preserve((ClientData) consoleInterp);
391
if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
394
Tcl_DStringInit(&dString);
395
Tcl_DStringAppend(&dString, "wm title . ", -1);
397
Tcl_DStringAppendElement(&dString, argv[2]);
399
Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
400
Tcl_DStringFree(&dString);
401
} else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
402
Tcl_Eval(consoleInterp, "wm withdraw .");
403
} else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
404
Tcl_Eval(consoleInterp, "wm deiconify .");
405
} else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
407
result = Tcl_Eval(consoleInterp, argv[2]);
408
Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
411
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
412
" eval command\"", (char *) NULL);
416
Tcl_AppendResult(interp, "bad option \"", argv[1],
417
"\": should be hide, show, or title",
421
Tcl_Release((ClientData) consoleInterp);
426
*----------------------------------------------------------------------
430
* This command allows the console interp to communicate with the
439
*----------------------------------------------------------------------
443
InterpreterCmd(clientData, interp, argc, argv)
444
ClientData clientData; /* Not used. */
445
Tcl_Interp *interp; /* Current interpreter. */
446
int argc; /* Number of arguments. */
447
char **argv; /* Argument strings. */
449
ConsoleInfo *info = (ConsoleInfo *) clientData;
453
Tcl_Interp *otherInterp;
456
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
457
" option ?arg arg ...?\"", (char *) NULL);
462
length = strlen(argv[1]);
463
otherInterp = info->interp;
464
Tcl_Preserve((ClientData) otherInterp);
465
if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
466
result = Tcl_GlobalEval(otherInterp, argv[2]);
467
Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
468
} else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
469
Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
471
Tcl_ResetResult(interp);
472
Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
474
Tcl_AppendResult(interp, "bad option \"", argv[1],
475
"\": should be eval or record",
479
Tcl_Release((ClientData) otherInterp);
484
*----------------------------------------------------------------------
486
* ConsoleDeleteProc --
488
* If the console command is deleted we destroy the console window
489
* and all associated data structures.
495
* A new console it created.
497
*----------------------------------------------------------------------
501
ConsoleDeleteProc(clientData)
502
ClientData clientData;
504
ConsoleInfo *info = (ConsoleInfo *) clientData;
506
Tcl_DeleteInterp(info->consoleInterp);
507
info->consoleInterp = NULL;
511
*----------------------------------------------------------------------
513
* ConsoleEventProc --
515
* This event procedure is registered on the main window of the
516
* slave interpreter. If the user or a running script causes the
517
* main window to be destroyed, then we need to inform the console
518
* interpreter by invoking "tkConsoleExit".
524
* Invokes the "tkConsoleExit" procedure in the console interp.
526
*----------------------------------------------------------------------
530
ConsoleEventProc(clientData, eventPtr)
531
ClientData clientData;
534
ConsoleInfo *info = (ConsoleInfo *) clientData;
535
Tcl_Interp *consoleInterp;
537
if (eventPtr->type == DestroyNotify) {
538
consoleInterp = info->consoleInterp;
541
* It is possible that the console interpreter itself has
542
* already been deleted. In that case the consoleInterp
543
* field will be set to NULL. If the interpreter is already
544
* gone, we do not have to do any work here.
547
if (consoleInterp == (Tcl_Interp *) NULL) {
550
Tcl_Preserve((ClientData) consoleInterp);
551
Tcl_Eval(consoleInterp, "tkConsoleExit");
552
Tcl_Release((ClientData) consoleInterp);
557
*----------------------------------------------------------------------
561
* Prints to the give text to the console. Given the main interp
562
* this functions find the appropiate console interp and forwards
563
* the text to be added to that console.
571
*----------------------------------------------------------------------
575
TkConsolePrint(interp, devId, buffer, size)
576
Tcl_Interp *interp; /* Main interpreter. */
577
int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
579
char *buffer; /* Text buffer. */
580
long size; /* Size of text buffer. */
582
Tcl_DString command, output;
586
Tcl_Interp *consoleInterp;
589
if (interp == NULL) {
593
if (devId == TCL_STDERR) {
594
cmd = "tkConsoleOutput stderr ";
596
cmd = "tkConsoleOutput stdout ";
599
result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
603
info = (ConsoleInfo *) cmdInfo.clientData;
605
Tcl_DStringInit(&output);
606
Tcl_DStringAppend(&output, buffer, size);
608
Tcl_DStringInit(&command);
609
Tcl_DStringAppend(&command, cmd, strlen(cmd));
610
Tcl_DStringAppendElement(&command, output.string);
612
consoleInterp = info->consoleInterp;
613
Tcl_Preserve((ClientData) consoleInterp);
614
Tcl_Eval(consoleInterp, command.string);
615
Tcl_Release((ClientData) consoleInterp);
617
Tcl_DStringFree(&command);
618
Tcl_DStringFree(&output);
added
removed
generic/tkConsole.c
