/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkconsole.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkconsole.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 69 - (show annotations) (download)
Sat Nov 5 10:54:17 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 22451 byte(s)
License and property (keyword) changes.
1 /* $Header$ */
2
3 /*
4 * tkConsole.c --
5 *
6 * This file implements a Tcl console for systems that may not
7 * otherwise have access to a console. It uses the Text widget
8 * and provides special access via a console command.
9 *
10 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
11 *
12 * See the file "license.terms" for information on usage and redistribution
13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tkconsole.c,v 1.1.1.1 2001/06/13 04:58:57 dtashley Exp $
16 */
17
18 #include "tk.h"
19 #include <string.h>
20
21 #include "tkInt.h"
22
23 /*
24 * A data structure of the following type holds information for each console
25 * which a handler (i.e. a Tcl command) has been defined for a particular
26 * top-level window.
27 */
28
29 typedef struct ConsoleInfo {
30 Tcl_Interp *consoleInterp; /* Interpreter for the console. */
31 Tcl_Interp *interp; /* Interpreter to send console commands. */
32 } ConsoleInfo;
33
34 typedef struct ThreadSpecificData {
35 Tcl_Interp *gStdoutInterp;
36 } ThreadSpecificData;
37 static Tcl_ThreadDataKey dataKey;
38 static int consoleInitialized = 0;
39
40 /*
41 * The Mutex below is used to lock access to the consoleIntialized flag
42 */
43
44 TCL_DECLARE_MUTEX(consoleMutex)
45
46 /*
47 * Forward declarations for procedures defined later in this file:
48 *
49 * The first three will be used in the tk app shells...
50 */
51
52 void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
53 int devId, char *buffer, long size));
54
55 static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
56 Tcl_Interp *interp, int argc, char **argv));
57 static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
58 static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
59 XEvent *eventPtr));
60 static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
61 Tcl_Interp *interp, int argc, char **argv));
62
63 static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
64 char *buf, int toRead, int *errorCode));
65 static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
66 char *buf, int toWrite, int *errorCode));
67 static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
68 Tcl_Interp *interp));
69 static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
70 int mask));
71 static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
72 int direction, ClientData *handlePtr));
73
74 /*
75 * This structure describes the channel type structure for file based IO:
76 */
77
78 static Tcl_ChannelType consoleChannelType = {
79 "console", /* Type name. */
80 NULL, /* Always non-blocking.*/
81 ConsoleClose, /* Close proc. */
82 ConsoleInput, /* Input proc. */
83 ConsoleOutput, /* Output proc. */
84 NULL, /* Seek proc. */
85 NULL, /* Set option proc. */
86 NULL, /* Get option proc. */
87 ConsoleWatch, /* Watch for events on console. */
88 ConsoleHandle, /* Get a handle from the device. */
89 };
90
91
92 #ifdef __WIN32__
93
94 #include <windows.h>
95
96 /*
97 *----------------------------------------------------------------------
98 *
99 * ShouldUseConsoleChannel
100 *
101 * Check to see if console window should be used for a given
102 * standard channel
103 *
104 * Results:
105 * None.
106 *
107 * Side effects:
108 * Creates the console channel and installs it as the standard
109 * channels.
110 *
111 *----------------------------------------------------------------------
112 */
113 static int ShouldUseConsoleChannel(type)
114 int type;
115 {
116 DWORD handleId; /* Standard handle to retrieve. */
117 DCB dcb;
118 DWORD consoleParams;
119 DWORD fileType;
120 int mode;
121 char *bufMode;
122 HANDLE handle;
123
124 switch (type) {
125 case TCL_STDIN:
126 handleId = STD_INPUT_HANDLE;
127 mode = TCL_READABLE;
128 bufMode = "line";
129 break;
130 case TCL_STDOUT:
131 handleId = STD_OUTPUT_HANDLE;
132 mode = TCL_WRITABLE;
133 bufMode = "line";
134 break;
135 case TCL_STDERR:
136 handleId = STD_ERROR_HANDLE;
137 mode = TCL_WRITABLE;
138 bufMode = "none";
139 break;
140 default:
141 return 0;
142 break;
143 }
144
145 handle = GetStdHandle(handleId);
146
147 /*
148 * Note that we need to check for 0 because Windows will return 0 if this
149 * is not a console mode application, even though this is not a valid
150 * handle.
151 */
152
153 if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
154 return 1;
155 }
156 fileType = GetFileType(handle);
157
158 /*
159 * If the file is a character device, we need to try to figure out
160 * whether it is a serial port, a console, or something else. We
161 * test for the console case first because this is more common.
162 */
163
164 if (fileType == FILE_TYPE_CHAR) {
165 dcb.DCBlength = sizeof( DCB ) ;
166 if (!GetConsoleMode(handle, &consoleParams) &&
167 !GetCommState(handle, &dcb)) {
168 /*
169 * Don't use a CHAR type channel for stdio, otherwise Tk
170 * runs into trouble with the MS DevStudio debugger.
171 */
172
173 return 1;
174 }
175 } else if (fileType == FILE_TYPE_UNKNOWN) {
176 return 1;
177 } else if (Tcl_GetStdChannel(type) == NULL) {
178 return 1;
179 }
180
181 return 0;
182 }
183 #else
184 /*
185 * Mac should always use a console channel, Unix should if it's trying to
186 */
187
188 #define ShouldUseConsoleChannel(chan) (1)
189 #endif
190
191 /*
192 *----------------------------------------------------------------------
193 *
194 * Tk_InitConsoleChannels --
195 *
196 * Create the console channels and install them as the standard
197 * channels. All I/O will be discarded until TkConsoleInit is
198 * called to attach the console to a text widget.
199 *
200 * Results:
201 * None.
202 *
203 * Side effects:
204 * Creates the console channel and installs it as the standard
205 * channels.
206 *
207 *----------------------------------------------------------------------
208 */
209
210 void
211 Tk_InitConsoleChannels(interp)
212 Tcl_Interp *interp;
213 {
214 Tcl_Channel consoleChannel;
215
216 /*
217 * Ensure that we are getting the matching version of Tcl. This is
218 * really only an issue when Tk is loaded dynamically.
219 */
220
221 if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
222 return;
223 }
224
225 Tcl_MutexLock(&consoleMutex);
226 if (!consoleInitialized) {
227
228 consoleInitialized = 1;
229
230 /*
231 * check for STDIN, otherwise create it
232 *
233 * Don't do this check on the Mac, because it is hard to prevent
234 * callbacks from the SIOUX layer from opening stdout & stdin, but
235 * we don't want to use the SIOUX console. Since the console is not
236 * actually created till something is written to the channel, it is
237 * okay to just ignore it here.
238 *
239 * This is still a bit of a hack, however, and should be cleaned up
240 * when we have a better abstraction for the console.
241 */
242
243 if (ShouldUseConsoleChannel(TCL_STDIN)) {
244 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
245 (ClientData) TCL_STDIN, TCL_READABLE);
246 if (consoleChannel != NULL) {
247 Tcl_SetChannelOption(NULL, consoleChannel,
248 "-translation", "lf");
249 Tcl_SetChannelOption(NULL, consoleChannel,
250 "-buffering", "none");
251 Tcl_SetChannelOption(NULL, consoleChannel,
252 "-encoding", "utf-8");
253 }
254 Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
255 }
256
257 /*
258 * check for STDOUT, otherwise create it
259 */
260
261 if (ShouldUseConsoleChannel(TCL_STDOUT)) {
262 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
263 (ClientData) TCL_STDOUT, TCL_WRITABLE);
264 if (consoleChannel != NULL) {
265 Tcl_SetChannelOption(NULL, consoleChannel,
266 "-translation", "lf");
267 Tcl_SetChannelOption(NULL, consoleChannel,
268 "-buffering", "none");
269 Tcl_SetChannelOption(NULL, consoleChannel,
270 "-encoding", "utf-8");
271 }
272 Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
273 }
274
275 /*
276 * check for STDERR, otherwise create it
277 */
278
279 if (ShouldUseConsoleChannel(TCL_STDERR)) {
280 consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
281 (ClientData) TCL_STDERR, TCL_WRITABLE);
282 if (consoleChannel != NULL) {
283 Tcl_SetChannelOption(NULL, consoleChannel,
284 "-translation", "lf");
285 Tcl_SetChannelOption(NULL, consoleChannel,
286 "-buffering", "none");
287 Tcl_SetChannelOption(NULL, consoleChannel,
288 "-encoding", "utf-8");
289 }
290 Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
291 }
292 }
293 Tcl_MutexUnlock(&consoleMutex);
294 }
295
296 /*
297 *----------------------------------------------------------------------
298 *
299 * Tk_CreateConsoleWindow --
300 *
301 * Initialize the console. This code actually creates a new
302 * application and associated interpreter. This effectivly hides
303 * the implementation from the main application.
304 *
305 * Results:
306 * None.
307 *
308 * Side effects:
309 * A new console it created.
310 *
311 *----------------------------------------------------------------------
312 */
313
314 int
315 Tk_CreateConsoleWindow(interp)
316 Tcl_Interp *interp; /* Interpreter to use for prompting. */
317 {
318 Tcl_Interp *consoleInterp;
319 ConsoleInfo *info;
320 Tk_Window mainWindow = Tk_MainWindow(interp);
321 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
322 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
323 #ifdef MAC_TCL
324 static char initCmd[] = "source -rsrc {Console}";
325 #else
326 static char initCmd[] = "source $tk_library/console.tcl";
327 #endif
328
329 consoleInterp = Tcl_CreateInterp();
330 if (consoleInterp == NULL) {
331 goto error;
332 }
333
334 /*
335 * Initialized Tcl and Tk.
336 */
337
338 if (Tcl_Init(consoleInterp) != TCL_OK) {
339 goto error;
340 }
341 if (Tk_Init(consoleInterp) != TCL_OK) {
342 goto error;
343 }
344 tsdPtr->gStdoutInterp = interp;
345
346 /*
347 * Add console commands to the interp
348 */
349 info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
350 info->interp = interp;
351 info->consoleInterp = consoleInterp;
352 Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
353 (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
354 Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
355 (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
356
357 Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
358 (ClientData) info);
359
360 Tcl_Preserve((ClientData) consoleInterp);
361 if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
362 /* goto error; -- no problem for now... */
363 printf("Eval error: %s", consoleInterp->result);
364 }
365 Tcl_Release((ClientData) consoleInterp);
366 return TCL_OK;
367
368 error:
369 if (consoleInterp != NULL) {
370 Tcl_DeleteInterp(consoleInterp);
371 }
372 return TCL_ERROR;
373 }
374
375 /*
376 *----------------------------------------------------------------------
377 *
378 * ConsoleOutput--
379 *
380 * Writes the given output on the IO channel. Returns count of how
381 * many characters were actually written, and an error indication.
382 *
383 * Results:
384 * A count of how many characters were written is returned and an
385 * error indication is returned in an output argument.
386 *
387 * Side effects:
388 * Writes output on the actual channel.
389 *
390 *----------------------------------------------------------------------
391 */
392
393 static int
394 ConsoleOutput(instanceData, buf, toWrite, errorCode)
395 ClientData instanceData; /* Indicates which device to use. */
396 char *buf; /* The data buffer. */
397 int toWrite; /* How many bytes to write? */
398 int *errorCode; /* Where to store error code. */
399 {
400 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
401 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
402
403 *errorCode = 0;
404 Tcl_SetErrno(0);
405
406 if (tsdPtr->gStdoutInterp != NULL) {
407 TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
408 toWrite);
409 }
410
411 return toWrite;
412 }
413
414 /*
415 *----------------------------------------------------------------------
416 *
417 * ConsoleInput --
418 *
419 * Read input from the console. Not currently implemented.
420 *
421 * Results:
422 * Always returns EOF.
423 *
424 * Side effects:
425 * None.
426 *
427 *----------------------------------------------------------------------
428 */
429
430 /* ARGSUSED */
431 static int
432 ConsoleInput(instanceData, buf, bufSize, errorCode)
433 ClientData instanceData; /* Unused. */
434 char *buf; /* Where to store data read. */
435 int bufSize; /* How much space is available
436 * in the buffer? */
437 int *errorCode; /* Where to store error code. */
438 {
439 return 0; /* Always return EOF. */
440 }
441
442 /*
443 *----------------------------------------------------------------------
444 *
445 * ConsoleClose --
446 *
447 * Closes the IO channel.
448 *
449 * Results:
450 * Always returns 0 (success).
451 *
452 * Side effects:
453 * Frees the dummy file associated with the channel.
454 *
455 *----------------------------------------------------------------------
456 */
457
458 /* ARGSUSED */
459 static int
460 ConsoleClose(instanceData, interp)
461 ClientData instanceData; /* Unused. */
462 Tcl_Interp *interp; /* Unused. */
463 {
464 return 0;
465 }
466
467 /*
468 *----------------------------------------------------------------------
469 *
470 * ConsoleWatch --
471 *
472 * Called by the notifier to set up the console device so that
473 * events will be noticed. Since there are no events on the
474 * console, this routine just returns without doing anything.
475 *
476 * Results:
477 * None.
478 *
479 * Side effects:
480 * None.
481 *
482 *----------------------------------------------------------------------
483 */
484
485 /* ARGSUSED */
486 static void
487 ConsoleWatch(instanceData, mask)
488 ClientData instanceData; /* Device ID for the channel. */
489 int mask; /* OR-ed combination of
490 * TCL_READABLE, TCL_WRITABLE and
491 * TCL_EXCEPTION, for the events
492 * we are interested in. */
493 {
494 }
495
496 /*
497 *----------------------------------------------------------------------
498 *
499 * ConsoleHandle --
500 *
501 * Invoked by the generic IO layer to get a handle from a channel.
502 * Because console channels are not devices, this function always
503 * fails.
504 *
505 * Results:
506 * Always returns TCL_ERROR.
507 *
508 * Side effects:
509 * None.
510 *
511 *----------------------------------------------------------------------
512 */
513
514 /* ARGSUSED */
515 static int
516 ConsoleHandle(instanceData, direction, handlePtr)
517 ClientData instanceData; /* Device ID for the channel. */
518 int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
519 * which direction of the channel is being
520 * requested. */
521 ClientData *handlePtr; /* Where to store handle */
522 {
523 return TCL_ERROR;
524 }
525
526 /*
527 *----------------------------------------------------------------------
528 *
529 * ConsoleCmd --
530 *
531 * The console command implements a Tcl interface to the various console
532 * options.
533 *
534 * Results:
535 * None.
536 *
537 * Side effects:
538 * None.
539 *
540 *----------------------------------------------------------------------
541 */
542
543 static int
544 ConsoleCmd(clientData, interp, argc, argv)
545 ClientData clientData; /* Not used. */
546 Tcl_Interp *interp; /* Current interpreter. */
547 int argc; /* Number of arguments. */
548 char **argv; /* Argument strings. */
549 {
550 ConsoleInfo *info = (ConsoleInfo *) clientData;
551 char c;
552 size_t length;
553 int result;
554 Tcl_Interp *consoleInterp;
555 Tcl_DString dString;
556
557 if (argc < 2) {
558 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
559 " option ?arg arg ...?\"", (char *) NULL);
560 return TCL_ERROR;
561 }
562
563 c = argv[1][0];
564 length = strlen(argv[1]);
565 result = TCL_OK;
566 consoleInterp = info->consoleInterp;
567 Tcl_Preserve((ClientData) consoleInterp);
568 Tcl_DStringInit(&dString);
569
570 if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
571 Tcl_DStringAppend(&dString, "wm title . ", -1);
572 if (argc == 3) {
573 Tcl_DStringAppendElement(&dString, argv[2]);
574 }
575 Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
576 } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
577 Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
578 Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
579 } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
580 Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
581 Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
582 } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
583 if (argc == 3) {
584 result = Tcl_Eval(consoleInterp, argv[2]);
585 Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
586 (char *) NULL);
587 } else {
588 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
589 " eval command\"", (char *) NULL);
590 return TCL_ERROR;
591 }
592 } else {
593 Tcl_AppendResult(interp, "bad option \"", argv[1],
594 "\": should be hide, show, or title",
595 (char *) NULL);
596 result = TCL_ERROR;
597 }
598 Tcl_DStringFree(&dString);
599 Tcl_Release((ClientData) consoleInterp);
600 return result;
601 }
602
603 /*
604 *----------------------------------------------------------------------
605 *
606 * InterpreterCmd --
607 *
608 * This command allows the console interp to communicate with the
609 * main interpreter.
610 *
611 * Results:
612 * None.
613 *
614 * Side effects:
615 * None.
616 *
617 *----------------------------------------------------------------------
618 */
619
620 static int
621 InterpreterCmd(clientData, interp, argc, argv)
622 ClientData clientData; /* Not used. */
623 Tcl_Interp *interp; /* Current interpreter. */
624 int argc; /* Number of arguments. */
625 char **argv; /* Argument strings. */
626 {
627 ConsoleInfo *info = (ConsoleInfo *) clientData;
628 char c;
629 size_t length;
630 int result;
631 Tcl_Interp *otherInterp;
632
633 if (argc < 2) {
634 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
635 " option ?arg arg ...?\"", (char *) NULL);
636 return TCL_ERROR;
637 }
638
639 c = argv[1][0];
640 length = strlen(argv[1]);
641 otherInterp = info->interp;
642 Tcl_Preserve((ClientData) otherInterp);
643 if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
644 result = Tcl_GlobalEval(otherInterp, argv[2]);
645 Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
646 } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
647 Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
648 result = TCL_OK;
649 Tcl_ResetResult(interp);
650 Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
651 } else {
652 Tcl_AppendResult(interp, "bad option \"", argv[1],
653 "\": should be eval or record",
654 (char *) NULL);
655 result = TCL_ERROR;
656 }
657 Tcl_Release((ClientData) otherInterp);
658 return result;
659 }
660
661 /*
662 *----------------------------------------------------------------------
663 *
664 * ConsoleDeleteProc --
665 *
666 * If the console command is deleted we destroy the console window
667 * and all associated data structures.
668 *
669 * Results:
670 * None.
671 *
672 * Side effects:
673 * A new console it created.
674 *
675 *----------------------------------------------------------------------
676 */
677
678 static void
679 ConsoleDeleteProc(clientData)
680 ClientData clientData;
681 {
682 ConsoleInfo *info = (ConsoleInfo *) clientData;
683
684 Tcl_DeleteInterp(info->consoleInterp);
685 info->consoleInterp = NULL;
686 }
687
688 /*
689 *----------------------------------------------------------------------
690 *
691 * ConsoleEventProc --
692 *
693 * This event procedure is registered on the main window of the
694 * slave interpreter. If the user or a running script causes the
695 * main window to be destroyed, then we need to inform the console
696 * interpreter by invoking "tkConsoleExit".
697 *
698 * Results:
699 * None.
700 *
701 * Side effects:
702 * Invokes the "tkConsoleExit" procedure in the console interp.
703 *
704 *----------------------------------------------------------------------
705 */
706
707 static void
708 ConsoleEventProc(clientData, eventPtr)
709 ClientData clientData;
710 XEvent *eventPtr;
711 {
712 ConsoleInfo *info = (ConsoleInfo *) clientData;
713 Tcl_Interp *consoleInterp;
714 Tcl_DString dString;
715
716 if (eventPtr->type == DestroyNotify) {
717
718 Tcl_DStringInit(&dString);
719
720 consoleInterp = info->consoleInterp;
721
722 /*
723 * It is possible that the console interpreter itself has
724 * already been deleted. In that case the consoleInterp
725 * field will be set to NULL. If the interpreter is already
726 * gone, we do not have to do any work here.
727 */
728
729 if (consoleInterp == (Tcl_Interp *) NULL) {
730 return;
731 }
732 Tcl_Preserve((ClientData) consoleInterp);
733 Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
734 Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
735 Tcl_DStringFree(&dString);
736 Tcl_Release((ClientData) consoleInterp);
737 }
738 }
739
740 /*
741 *----------------------------------------------------------------------
742 *
743 * TkConsolePrint --
744 *
745 * Prints to the give text to the console. Given the main interp
746 * this functions find the appropiate console interp and forwards
747 * the text to be added to that console.
748 *
749 * Results:
750 * None.
751 *
752 * Side effects:
753 * None.
754 *
755 *----------------------------------------------------------------------
756 */
757
758 void
759 TkConsolePrint(interp, devId, buffer, size)
760 Tcl_Interp *interp; /* Main interpreter. */
761 int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
762 * stderr. */
763 char *buffer; /* Text buffer. */
764 long size; /* Size of text buffer. */
765 {
766 Tcl_DString command, output;
767 Tcl_CmdInfo cmdInfo;
768 char *cmd;
769 ConsoleInfo *info;
770 Tcl_Interp *consoleInterp;
771 int result;
772
773 if (interp == NULL) {
774 return;
775 }
776
777 if (devId == TCL_STDERR) {
778 cmd = "tkConsoleOutput stderr ";
779 } else {
780 cmd = "tkConsoleOutput stdout ";
781 }
782
783 result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
784 if (result == 0) {
785 return;
786 }
787 info = (ConsoleInfo *) cmdInfo.clientData;
788
789 Tcl_DStringInit(&output);
790 Tcl_DStringAppend(&output, buffer, size);
791
792 Tcl_DStringInit(&command);
793 Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
794 Tcl_DStringAppendElement(&command, output.string);
795
796 consoleInterp = info->consoleInterp;
797 Tcl_Preserve((ClientData) consoleInterp);
798 Tcl_Eval(consoleInterp, command.string);
799 Tcl_Release((ClientData) consoleInterp);
800
801 Tcl_DStringFree(&command);
802 Tcl_DStringFree(&output);
803 }
804
805 /* End of tkconsole.c */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25