/[ascend]/trunk/tcltk98/generic/interface/tkConsole.c
ViewVC logotype

Annotation of /trunk/tcltk98/generic/interface/tkConsole.c

Parent Directory Parent Directory | Revision Log Revision Log


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

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22