1 /*
2 * tkConsole.cc --
3 *
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.
7 *
8 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * SCCS: @(#) tkConsole.c 1.53 97/07/22 16:36:55
14 * MASH: @(#) $Header
15 *
16 * MASH NOTE:
17 * file originally from Tk, we changed it so that we can load a static
18 * module defined in C++
19 */
20
21 #include "tclcl.h"
22 #include "tk.h"
23 #include "mash-init.h"
24
25 /*
26 * A data structure of the following type holds information for each console
27 * which a handler (i.e. a Tcl command) has been defined for a particular
28 * top-level window.
29 */
30
31 typedef struct ConsoleInfo {
32 Tcl_Interp *consoleInterp; /* Interpreter for the console. */
33 Tcl_Interp *interp; /* Interpreter to send console commands. */
34 } ConsoleInfo;
35
36 static Tcl_Interp *gStdoutInterp = NULL;
37
38 /*
39 * Forward declarations for procedures defined later in this file:
40 *
41 * The first three will be used in the tk app shells...
42 */
43 extern "C" {
44 void TkConsoleCreate _ANSI_ARGS_((void));
45 int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
46 };
47 void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
48 int devId, char *buffer, long size));
49
50 static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
51 Tcl_Interp *interp, int argc, char **argv));
52 static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
53 static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
54 XEvent *eventPtr));
55 static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
56 Tcl_Interp *interp, int argc, char **argv));
57
58 static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
59 char *buf, int toRead, int *errorCode));
60 static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
61 char *buf, int toWrite, int *errorCode));
62 static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
63 Tcl_Interp *interp));
64 static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
65 int mask));
66 #if TK_MAJOR_VERSION < 8
67 static int ConsoleReady _ANSI_ARGS_((ClientData instanceData,
68 int mask));
69 static Tcl_File ConsoleFile _ANSI_ARGS_((ClientData instanceData,
70 int direction));
71 #else /* TK_MAJOR_VERSION >= 8 */
72 static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
73 int direction, ClientData *handlePtr));
74 #endif /* TK_MAJOR_VERSION >= 8 */
75
76
77 /*
78 * This structure describes the channel type structure for file based IO:
79 */
80
81 static Tcl_ChannelType consoleChannelType = {
82 "console", /* Type name. */
83 NULL, /* Always non-blocking.*/
84 ConsoleClose, /* Close proc. */
85 ConsoleInput, /* Input proc. */
86 ConsoleOutput, /* Output proc. */
87 NULL, /* Seek proc. */
88 NULL, /* Set option proc. */
89 NULL, /* Get option proc. */
90 ConsoleWatch, /* Watch for events on console. */
91 #if TK_MAJOR_VERSION < 8
92 ConsoleReady, /* Are events present? */
93 ConsoleFile, /* Get a Tcl_File from the device. */
94 #else /* TK_MAJOR_VERSION >= 8 */
95 ConsoleHandle /* Get a handle from the device. */
96 #endif /* TK_MAJOR_VERSION >= 8 */
97
98 };
99
100 /*
101 *----------------------------------------------------------------------
102 *
103 * TkConsoleCreate --
104 *
105 * Create the console channels and install them as the standard
106 * channels. All I/O will be discarded until TkConsoleInit is
107 * called to attach the console to a text widget.
108 *
109 * Results:
110 * None.
111 *
112 * Side effects:
113 * Creates the console channel and installs it as the standard
114 * channels.
115 *
116 *----------------------------------------------------------------------
117 */
118
119 void
120 TkConsoleCreate()
121 {
122 Tcl_Channel consoleChannel;
123
124 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
125 (ClientData) TCL_STDIN, TCL_READABLE);
126 if (consoleChannel != NULL) {
127 Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
128 Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
129 }
130 Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
131 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
132 (ClientData) TCL_STDOUT, TCL_WRITABLE);
133 if (consoleChannel != NULL) {
134 Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
135 Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
136 }
137 Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
138 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
139 (ClientData) TCL_STDERR, TCL_WRITABLE);
140 if (consoleChannel != NULL) {
141 Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
142 Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
143 }
144 Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
145 }
146
147 /*
148 *----------------------------------------------------------------------
149 *
150 * TkConsoleInit --
151 *
152 * Initialize the console. This code actually creates a new
153 * application and associated interpreter. This effectivly hides
154 * the implementation from the main application.
155 *
156 * Results:
157 * None.
158 *
159 * Side effects:
160 * A new console it created.
161 *
162 *----------------------------------------------------------------------
163 */
164
165 int
166 TkConsoleInit(Tcl_Interp *interp)
167 {
168 Tcl_Interp *consoleInterp;
169 ConsoleInfo *info;
170 Tk_Window mainWindow = Tk_MainWindow(interp);
171 #ifdef MAC_TCL
172 static char initCmd[] = "source -rsrc {Console}";
173 #endif
174
175 consoleInterp = Tcl_CreateInterp();
176 if (consoleInterp == NULL) {
177 goto error;
178 }
179
180 /*
181 * Initialized Tcl and Tk.
182 */
183 #if 0 /* don't need this */
184 if (Tcl_Init(consoleInterp) != TCL_OK) {
185 goto error;
186 }
187 #endif
188 Tcl_SetVar(consoleInterp, "tcl_library", ".", TCL_GLOBAL_ONLY);
189 Tcl_SetVar(consoleInterp, "tk_library", ".", TCL_GLOBAL_ONLY);
190
191 if (Tk_Init(consoleInterp) != TCL_OK) {
192 goto error;
193 }
194 gStdoutInterp = interp;
195
196 /*
197 * Add console commands to the interp
198 */
199 info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
200 info->interp = interp;
201 info->consoleInterp = consoleInterp;
202 Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
203 (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
204
205 #if TK_MAJOR_VERSION < 8
206 # define CON_INTERP_CMD "interp"
207 #else /* TK_MAJOR_VERSION >= 8 */
208 # define CON_INTERP_CMD "consoleinterp"
209 #endif /* TK_MAJOR_VERSION >= 8 */
210
211 Tcl_CreateCommand(consoleInterp, CON_INTERP_CMD, InterpreterCmd,
212 (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
213
214 Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
215 (ClientData) info);
216
217 extern EmbeddedTcl et_console;
218 extern EmbeddedTcl et_tk;
219
220 if (TCL_OK != et_tk.load(consoleInterp)) {
221 WIN32_OutputErr(consoleInterp, "loading (embedded) tk.tcl failed!");
222 goto error;
223 }
224 if (TCL_OK != et_console.load(consoleInterp)) {
225 WIN32_OutputErr(consoleInterp, "loading (embedded) console.tcl failed!");
226 goto error;
227 }
228 return TCL_OK;
229
230 error:
231 if (consoleInterp != NULL) {
232 Tcl_DeleteInterp(consoleInterp);
233 }
234 return TCL_ERROR;
235 }
236
237 /*
238 *----------------------------------------------------------------------
239 *
240 * ConsoleOutput--
241 *
242 * Writes the given output on the IO channel. Returns count of how
243 * many characters were actually written, and an error indication.
244 *
245 * Results:
246 * A count of how many characters were written is returned and an
247 * error indication is returned in an output argument.
248 *
249 * Side effects:
250 * Writes output on the actual channel.
251 *
252 *----------------------------------------------------------------------
253 */
254
255 static int
256 ConsoleOutput(ClientData instanceData, char* buf, int toWrite, int *errorCode)
257 {
258 *errorCode = 0;
259 Tcl_SetErrno(0);
260
261 if (gStdoutInterp != NULL) {
262 TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
263 }
264
265 return toWrite;
266 }
267
268 /*
269 *----------------------------------------------------------------------
270 *
271 * ConsoleInput --
272 *
273 * Read input from the console. Not currently implemented.
274 *
275 * Results:
276 * Always returns EOF.
277 *
278 * Side effects:
279 * None.
280 *
281 *----------------------------------------------------------------------
282 */
283
284 /* ARGSUSED */
285 static int
286 ConsoleInput(ClientData instanceData, char* buf, int bufSize, int* errorCode)
287 {
288 return 0; /* Always return EOF. */
289 }
290
291 /*
292 *----------------------------------------------------------------------
293 *
294 * ConsoleClose --
295 *
296 * Closes the IO channel.
297 *
298 * Results:
299 * Always returns 0 (success).
300 *
301 * Side effects:
302 * Frees the dummy file associated with the channel.
303 *
304 *----------------------------------------------------------------------
305 */
306
307 /* ARGSUSED */
308 static int
309 ConsoleClose(ClientData instanceData, Tcl_Interp *interp)
310 {
311 return 0;
312 }
313
314 /*
315 *----------------------------------------------------------------------
316 *
317 * ConsoleWatch --
318 *
319 * Called by the notifier to set up the console device so that
320 * events will be noticed. Since there are no events on the
321 * console, this routine just returns without doing anything.
322 *
323 * Results:
324 * None.
325 *
326 * Side effects:
327 * None.
328 *
329 *----------------------------------------------------------------------
330 */
331
332 /* ARGSUSED */
333 static void
334 ConsoleWatch(ClientData instanceData, int mask)
335 {
336 }
337
338 #if TK_MAJOR_VERSION < 8
339 /*
340 *----------------------------------------------------------------------
341 *
342 * ConsoleReady --
343 *
344 * Invoked by the notifier to notice whether any events are present
345 * on the console. Since there are no events on the console, this
346 * routine always returns zero.
347 *
348 * Results:
349 * Always 0.
350 *
351 * Side effects:
352 * None.
353 *
354 *----------------------------------------------------------------------
355 */
356
357 /* ARGSUSED */
358 static int
359 ConsoleReady(ClientData instanceData, int mask)
360 {
361 return 0;
362 }
363
364 /*
365 *----------------------------------------------------------------------
366 *
367 * ConsoleFile --
368 *
369 * Invoked by the generic IO layer to get a Tcl_File from a channel.
370 * Because console channels do not use Tcl_Files, this function always
371 * returns NULL.
372 *
373 * Results:
374 * Always NULL.
375 *
376 * Side effects:
377 * None.
378 *
379 *----------------------------------------------------------------------
380 */
381
382 /* ARGSUSED */
383 static Tcl_File
384 ConsoleFile(ClientData instanceData, int direction)
385 {
386 return (Tcl_File) NULL;
387 }
388 #else /* TK_MAJOR_VERSION >= 8 */
389 /*
390 *----------------------------------------------------------------------
391 *
392 * ConsoleHandle --
393 *
394 * Invoked by the generic IO layer to get a handle from a channel.
395 * Because console channels are not devices, this function always
396 * fails.
397 *
398 * Results:
399 * Always returns TCL_ERROR.
400 *
401 * Side effects:
402 * None.
403 *
404 *----------------------------------------------------------------------
405 */
406
407 /* ARGSUSED */
408 static int
409 ConsoleHandle(ClientData instanceData, /* Device ID for the channel. */
410 int direction, /* TCL_READABLE or TCL_WRITABLE to indicate
411 * which direction of the channel is being
412 * requested. */
413 ClientData *handlePtr) /* Where to store handle */
414 {
415 return TCL_ERROR;
416 }
417 #endif /* TK_MAJOR_VERSION >= 8 */
418
419 /*
420 *----------------------------------------------------------------------
421 *
422 * ConsoleCmd --
423 *
424 * The console command implements a Tcl interface to the various console
425 * options.
426 *
427 * Results:
428 * None.
429 *
430 * Side effects:
431 * None.
432 *
433 *----------------------------------------------------------------------
434 */
435
436 static int
437 ConsoleCmd(ClientData clientData, Tcl_Interp* interp, int argc, char** argv)
438 {
439 ConsoleInfo *info = (ConsoleInfo *) clientData;
440 char c;
441 int length;
442 int result;
443 Tcl_Interp *consoleInterp;
444
445 if (argc < 2) {
446 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
447 " option ?arg arg ...?\"", (char *) NULL);
448 return TCL_ERROR;
449 }
450
451 c = argv[1][0];
452 length = strlen(argv[1]);
453 result = TCL_OK;
454 consoleInterp = info->consoleInterp;
455 Tcl_Preserve((ClientData) consoleInterp);
456 if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
457 Tcl_DString dString;
458
459 Tcl_DStringInit(&dString);
460 Tcl_DStringAppend(&dString, "wm title . ", -1);
461 if (argc == 3) {
462 Tcl_DStringAppendElement(&dString, argv[2]);
463 }
464 Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
465 Tcl_DStringFree(&dString);
466 } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
467 Tcl_Eval(info->consoleInterp, "wm withdraw .");
468 } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
469 Tcl_Eval(info->consoleInterp, "wm deiconify .");
470 } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
471 if (argc == 3) {
472 Tcl_Eval(info->consoleInterp, argv[2]);
473 } else {
474 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
475 " eval command\"", (char *) NULL);
476 return TCL_ERROR;
477 }
478 } else {
479 Tcl_AppendResult(interp, "bad option \"", argv[1],
480 "\": should be hide, show, or title",
481 (char *) NULL);
482 result = TCL_ERROR;
483 }
484 Tcl_Release((ClientData) consoleInterp);
485 return result;
486 }
487
488 /*
489 *----------------------------------------------------------------------
490 *
491 * InterpreterCmd --
492 *
493 * This command allows the console interp to communicate with the
494 * main interpreter.
495 *
496 * Results:
497 * None.
498 *
499 * Side effects:
500 * None.
501 *
502 *----------------------------------------------------------------------
503 */
504
505 static int
506 InterpreterCmd(ClientData clientData, Tcl_Interp *interp, int argc,
507 char** argv)
508 {
509 ConsoleInfo *info = (ConsoleInfo *) clientData;
510 char c;
511 int length;
512 int result;
513 Tcl_Interp *otherInterp;
514
515 if (argc < 2) {
516 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
517 " option ?arg arg ...?\"", (char *) NULL);
518 return TCL_ERROR;
519 }
520
521 c = argv[1][0];
522 length = strlen(argv[1]);
523 otherInterp = info->interp;
524 Tcl_Preserve((ClientData) otherInterp);
525 if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
526 result = Tcl_GlobalEval(otherInterp, argv[2]);
527 Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
528 } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
529 Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
530 result = TCL_OK;
531 Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
532 } else {
533 Tcl_AppendResult(interp, "bad option \"", argv[1],
534 "\": should be eval or record",
535 (char *) NULL);
536 result = TCL_ERROR;
537 }
538 Tcl_Release((ClientData) otherInterp);
539 return result;
540 }
541
542 /*
543 *----------------------------------------------------------------------
544 *
545 * ConsoleDeleteProc --
546 *
547 * If the console command is deleted we destroy the console window
548 * and all associated data structures.
549 *
550 * Results:
551 * None.
552 *
553 * Side effects:
554 * A new console it created.
555 *
556 *----------------------------------------------------------------------
557 */
558
559 void
560 ConsoleDeleteProc(ClientData clientData)
561 {
562 ConsoleInfo *info = (ConsoleInfo *) clientData;
563
564 Tcl_DeleteInterp(info->consoleInterp);
565 info->consoleInterp = NULL;
566 }
567
568 /*
569 *----------------------------------------------------------------------
570 *
571 * ConsoleEventProc --
572 *
573 * This event procedure is registered on the main window of the
574 * slave interpreter. If the user or a running script causes the
575 * main window to be destroyed, then we need to inform the console
576 * interpreter by invoking "tkConsoleExit".
577 *
578 * Results:
579 * None.
580 *
581 * Side effects:
582 * Invokes the "tkConsoleExit" procedure in the console interp.
583 *
584 *----------------------------------------------------------------------
585 */
586
587 static void
588 ConsoleEventProc(ClientData clientData, XEvent * eventPtr)
589 {
590 ConsoleInfo *info = (ConsoleInfo *) clientData;
591 Tcl_Interp *consoleInterp;
592
593 if (eventPtr->type == DestroyNotify) {
594 consoleInterp = info->consoleInterp;
595
596 /*
597 * It is possible that the console interpreter itself has
598 * already been deleted. In that case the consoleInterp
599 * field will be set to NULL. If the interpreter is already
600 * gone, we do not have to do any work here.
601 */
602
603 if (consoleInterp == (Tcl_Interp *) NULL) {
604 return;
605 }
606 Tcl_Preserve((ClientData) consoleInterp);
607 Tcl_Eval(consoleInterp, "tkConsoleExit");
608 Tcl_Release((ClientData) consoleInterp);
609 }
610 }
611
612 /*
613 *----------------------------------------------------------------------
614 *
615 * TkConsolePrint --
616 *
617 * Prints to the give text to the console. Given the main interp
618 * this functions find the appropiate console interp and forwards
619 * the text to be added to that console.
620 *
621 * Results:
622 * None.
623 *
624 * Side effects:
625 * None.
626 *
627 *----------------------------------------------------------------------
628 */
629
630 void
631 TkConsolePrint(Tcl_Interp *interp, int devId, char* buffer, long size)
632 {
633 Tcl_DString command, output;
634 Tcl_CmdInfo cmdInfo;
635 char *cmd;
636 ConsoleInfo *info;
637 Tcl_Interp *consoleInterp;
638 int result;
639
640 if (interp == NULL) {
641 return;
642 }
643
644 if (devId == TCL_STDERR) {
645 cmd = "tkConsoleOutput stderr ";
646 } else {
647 cmd = "tkConsoleOutput stdout ";
648 }
649
650 result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
651 if (result == 0) {
652 return;
653 }
654 info = (ConsoleInfo *) cmdInfo.clientData;
655
656 Tcl_DStringInit(&output);
657 Tcl_DStringAppend(&output, buffer, size);
658
659 Tcl_DStringInit(&command);
660 Tcl_DStringAppend(&command, cmd, strlen(cmd));
661 Tcl_DStringAppendElement(&command, output.string);
662
663 consoleInterp = info->consoleInterp;
664 Tcl_Preserve((ClientData) consoleInterp);
665 Tcl_Eval(consoleInterp, command.string);
666 Tcl_Release((ClientData) consoleInterp);
667
668 Tcl_DStringFree(&command);
669 Tcl_DStringFree(&output);
670 }
671
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.