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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (hide annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (7 years, 5 months ago) by dashley
File MIME type: text/plain
File size: 22775 byte(s)
Rename for reorganization.
1 dashley 25 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkconsole.c,v 1.1.1.1 2001/06/13 04:58:57 dtashley Exp $ */
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    
806     /* $History: tkConsole.c $
807     *
808     * ***************** Version 1 *****************
809     * User: Dtashley Date: 1/02/01 Time: 2:40a
810     * Created in $/IjuScripter, IjuConsole/Source/Tk Base
811     * Initial check-in.
812     */
813    
814     /* End of TKCONSOLE.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25