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 "license.terms" for information on usage and redistribution
11 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id: tkConsole.c,v 1.18.2.6 2006/09/25 17:28:20 andreas_kupries Exp $
14 *
15 */
16
17#include "tk.h"
18
19/*
20 * Each console is associated with an instance of the ConsoleInfo struct.
21 * It keeps track of what interp holds the Tk application that displays
22 * the console, and what interp is controlled by the interactions in that
23 * console.  A refCount permits the struct to be shared as instance data
24 * by commands and by channels.
25 */
26
27typedef struct ConsoleInfo {
28    Tcl_Interp *consoleInterp;        /* Interpreter displaying the console. */
29    Tcl_Interp *interp;               /* Interpreter controlled by console. */
30    int refCount;
31} ConsoleInfo;
32
33/*
34 * Each console channel holds an instance of the ChannelData struct as
35 * its instance data.  It contains ConsoleInfo, so the channel can work
36 * with the appropriate console window, and a type value to distinguish
37 * the stdout channel from the stderr channel.
38 */
39
40typedef struct ChannelData {
41    ConsoleInfo *info;
42    int type;			/* TCL_STDOUT or TCL_STDERR */
43} ChannelData;
44
45/*
46 * Prototypes for local procedures defined in this file:
47 */
48
49static int	ConsoleClose _ANSI_ARGS_((ClientData instanceData,
50		    Tcl_Interp *interp));
51static void	ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
52static void	ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
53		    XEvent *eventPtr));
54static int	ConsoleHandle _ANSI_ARGS_((ClientData instandeData,
55		    int direction, ClientData *handlePtr));
56static int	ConsoleInput _ANSI_ARGS_((ClientData instanceData,
57		    char *buf, int toRead, int *errorCode));
58static int	ConsoleObjCmd _ANSI_ARGS_((ClientData clientData,
59		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
60static int	ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
61		    CONST char *buf, int toWrite, int *errorCode));
62static void	ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
63		    int mask));
64static void	DeleteConsoleInterp _ANSI_ARGS_((ClientData clientData));
65static void	InterpDeleteProc _ANSI_ARGS_((ClientData clientData,
66		    Tcl_Interp *interp));
67static int	InterpreterObjCmd _ANSI_ARGS_((ClientData clientData,
68		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
69
70/*
71 * This structure describes the channel type structure for file based IO:
72 */
73
74static Tcl_ChannelType consoleChannelType = {
75    "console",			/* Type name. */
76    TCL_CHANNEL_VERSION_4,	/* v4 channel */
77    ConsoleClose,		/* Close proc. */
78    ConsoleInput,		/* Input proc. */
79    ConsoleOutput,		/* Output proc. */
80    NULL,			/* Seek proc. */
81    NULL,			/* Set option proc. */
82    NULL,			/* Get option proc. */
83    ConsoleWatch,		/* Watch for events on console. */
84    ConsoleHandle,		/* Get a handle from the device. */
85    NULL,			/* close2proc. */
86    NULL,			/* Always non-blocking.*/
87    NULL,			/* flush proc. */
88    NULL,			/* handler proc. */
89    NULL,                       /* wide seek proc */
90    NULL,                       /* thread action proc */
91};
92
93
94#ifdef __WIN32__
95
96#include <windows.h>
97
98/*
99 *----------------------------------------------------------------------
100 *
101 * ShouldUseConsoleChannel
102 *
103 * 	Check to see if console window should be used for a given
104 *      standard channel
105 *
106 * Results:
107 *	None.
108 *
109 * Side effects:
110 *	Creates the console channel and installs it as the standard
111 *	channels.
112 *
113 *----------------------------------------------------------------------
114 */
115static int ShouldUseConsoleChannel(type)
116    int type;
117{
118    DWORD handleId;		/* Standard handle to retrieve. */
119    DCB dcb;
120    DWORD consoleParams;
121    DWORD fileType;
122    int mode;
123    char *bufMode;
124    HANDLE handle;
125
126    switch (type) {
127	case TCL_STDIN:
128	    handleId = STD_INPUT_HANDLE;
129	    mode = TCL_READABLE;
130	    bufMode = "line";
131	    break;
132	case TCL_STDOUT:
133	    handleId = STD_OUTPUT_HANDLE;
134	    mode = TCL_WRITABLE;
135	    bufMode = "line";
136	    break;
137	case TCL_STDERR:
138	    handleId = STD_ERROR_HANDLE;
139	    mode = TCL_WRITABLE;
140	    bufMode = "none";
141	    break;
142	default:
143	    return 0;
144	    break;
145    }
146
147    handle = GetStdHandle(handleId);
148
149    /*
150     * Note that we need to check for 0 because Windows will return 0 if this
151     * is not a console mode application, even though this is not a valid
152     * handle.
153     */
154
155    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
156	return 1;
157    }
158
159    /*
160     * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
161     * to be a valid handle.  See TclpGetDefaultStdChannel() for this change
162     * implemented.  We didn't change it here because GetFileType() [below]
163     * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
164     * value of 1, anyways.
165     *
166     *    char dummyBuff[1];
167     *    DWORD dummyWritten;
168     *
169     *    if ((type == TCL_STDOUT)
170     *	    && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
171     *	return 1;
172     *    }
173     */
174
175    fileType = GetFileType(handle);
176
177    /*
178     * If the file is a character device, we need to try to figure out
179     * whether it is a serial port, a console, or something else.  We
180     * test for the console case first because this is more common.
181     */
182
183    if (fileType == FILE_TYPE_CHAR) {
184	dcb.DCBlength = sizeof( DCB ) ;
185	if (!GetConsoleMode(handle, &consoleParams) &&
186		!GetCommState(handle, &dcb)) {
187	    /*
188	     * Don't use a CHAR type channel for stdio, otherwise Tk
189	     * runs into trouble with the MS DevStudio debugger.
190	     */
191
192	    return 1;
193	}
194    } else if (fileType == FILE_TYPE_UNKNOWN) {
195	return 1;
196    } else if (Tcl_GetStdChannel(type) == NULL) {
197	return 1;
198    }
199
200    return 0;
201}
202#else
203/*
204 * Mac should always use a console channel, Unix should if it's trying to
205 */
206
207#define ShouldUseConsoleChannel(chan) (1)
208#endif
209
210/*
211 *----------------------------------------------------------------------
212 *
213 * Tk_InitConsoleChannels --
214 *
215 * 	Create the console channels and install them as the standard
216 * 	channels.  All I/O will be discarded until Tk_CreateConsoleWindow
217 *	is called to attach the console to a text widget.
218 *
219 * Results:
220 *	None.
221 *
222 * Side effects:
223 *	Creates the console channel and installs it as the standard
224 *	channels.
225 *
226 *----------------------------------------------------------------------
227 */
228
229void
230Tk_InitConsoleChannels(interp)
231    Tcl_Interp *interp;
232{
233    static Tcl_ThreadDataKey consoleInitKey;
234    int *consoleInitPtr, doIn, doOut, doErr;
235    ConsoleInfo *info;
236    Tcl_Channel consoleChannel;
237
238    /*
239     * Ensure that we are getting the matching version of Tcl.  This is
240     * really only an issue when Tk is loaded dynamically.
241     */
242
243    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
244        return;
245    }
246
247    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
248    if (*consoleInitPtr) {
249	/* We've already initialized console channels in this thread. */
250	return;
251    }
252    *consoleInitPtr = 1;
253
254    doIn = ShouldUseConsoleChannel(TCL_STDIN);
255    doOut = ShouldUseConsoleChannel(TCL_STDOUT);
256    doErr = ShouldUseConsoleChannel(TCL_STDERR);
257
258    if (!(doIn || doOut || doErr)) {
259	/*
260	 * No std channels should be tied to the console;
261	 * Thus, no need to create the console
262	 */
263	return;
264    }
265
266    /*
267     * At least one std channel wants to be tied to the console,
268     * so create the interp for it to live in.
269     */
270
271    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
272    info->consoleInterp = NULL;
273    info->interp = NULL;
274    info->refCount = 0;
275
276    if (doIn) {
277	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
278	data->info = info;
279	data->info->refCount++;
280	data->type = TCL_STDIN;
281	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
282		(ClientData) data, TCL_READABLE);
283	if (consoleChannel != NULL) {
284	    Tcl_SetChannelOption(NULL, consoleChannel,
285		    "-translation", "lf");
286	    Tcl_SetChannelOption(NULL, consoleChannel,
287		    "-buffering", "none");
288	    Tcl_SetChannelOption(NULL, consoleChannel,
289		    "-encoding", "utf-8");
290	}
291	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
292	Tcl_RegisterChannel(NULL, consoleChannel);
293    }
294
295    if (doOut) {
296	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
297	data->info = info;
298	data->info->refCount++;
299	data->type = TCL_STDOUT;
300	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
301		(ClientData) data, TCL_WRITABLE);
302	if (consoleChannel != NULL) {
303	    Tcl_SetChannelOption(NULL, consoleChannel,
304		    "-translation", "lf");
305	    Tcl_SetChannelOption(NULL, consoleChannel,
306		    "-buffering", "none");
307	    Tcl_SetChannelOption(NULL, consoleChannel,
308		    "-encoding", "utf-8");
309	}
310	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
311	Tcl_RegisterChannel(NULL, consoleChannel);
312    }
313
314    if (doErr) {
315	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
316	data->info = info;
317	data->info->refCount++;
318	data->type = TCL_STDERR;
319	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
320		(ClientData) data, TCL_WRITABLE);
321	if (consoleChannel != NULL) {
322	    Tcl_SetChannelOption(NULL, consoleChannel,
323		    "-translation", "lf");
324	    Tcl_SetChannelOption(NULL, consoleChannel,
325		    "-buffering", "none");
326	    Tcl_SetChannelOption(NULL, consoleChannel,
327		    "-encoding", "utf-8");
328	}
329	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
330	Tcl_RegisterChannel(NULL, consoleChannel);
331    }
332}
333
334/*
335 *----------------------------------------------------------------------
336 *
337 * Tk_CreateConsoleWindow --
338 *
339 *	Initialize the console.  This code actually creates a new
340 *	application and associated interpreter.  This effectivly hides
341 *	the implementation from the main application.
342 *
343 * Results:
344 *	None.
345 *
346 * Side effects:
347 *	A new console it created.
348 *
349 *----------------------------------------------------------------------
350 */
351
352int
353Tk_CreateConsoleWindow(interp)
354    Tcl_Interp *interp;			/* Interpreter to use for prompting. */
355{
356    Tcl_Channel chan;
357    ConsoleInfo *info;
358    Tk_Window mainWindow;
359    Tcl_Command token;
360    int result = TCL_OK;
361    int haveConsoleChannel = 1;
362
363#ifdef MAC_TCL
364    static const char *initCmd = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
365#else
366    static const char *initCmd = "source $tk_library/console.tcl";
367#endif
368
369    /* Init an interp with Tcl and Tk */
370    Tcl_Interp *consoleInterp = Tcl_CreateInterp();
371    if (Tcl_Init(consoleInterp) != TCL_OK) {
372      goto error;
373    }
374    if (Tk_Init(consoleInterp) != TCL_OK) {
375	goto error;
376    }
377
378    /*
379     * Fetch the instance data from whatever std channel is a
380     * console channel.  If none, create fresh instance data.
381     */
382
383    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
384          == &consoleChannelType) {
385    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
386          == &consoleChannelType) {
387    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
388          == &consoleChannelType) {
389    } else {
390	haveConsoleChannel = 0;
391    }
392
393    if (haveConsoleChannel) {
394	ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
395	info = data->info;
396	if (info->consoleInterp) {
397	    /* New ConsoleInfo for a new console window */
398	    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
399	    info->refCount = 0;
400
401	    /* Update any console channels to make use of the new console */
402	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
403		    == &consoleChannelType) {
404		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
405		data->info->refCount--;
406		data->info = info;
407		data->info->refCount++;
408	    }
409	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
410		    == &consoleChannelType) {
411		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
412		data->info->refCount--;
413		data->info = info;
414		data->info->refCount++;
415	    }
416	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
417		    == &consoleChannelType) {
418		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
419		data->info->refCount--;
420		data->info = info;
421		data->info->refCount++;
422	    }
423	}
424    } else {
425	info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
426	info->refCount = 0;
427    }
428
429    info->consoleInterp = consoleInterp;
430    info->interp = interp;
431
432    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info);
433    info->refCount++;
434    Tcl_CreateThreadExitHandler(DeleteConsoleInterp,
435	(ClientData) consoleInterp);
436
437    /*
438     * Add console commands to the interp
439     */
440
441    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd,
442          (ClientData) info, ConsoleDeleteProc);
443    info->refCount++;
444
445    /*
446     * We don't have to count the ref held by the [consoleinterp] command
447     * in the consoleInterp.  The ref held by the consoleInterp delete
448     * handler takes care of us.
449     */
450    Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
451	    (ClientData) info, NULL);
452
453    mainWindow = Tk_MainWindow(interp);
454    if (mainWindow) {
455	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
456		ConsoleEventProc, (ClientData) info);
457	info->refCount++;
458    }
459
460    Tcl_Preserve((ClientData) consoleInterp);
461    result = Tcl_GlobalEval(consoleInterp, initCmd);
462    if (result == TCL_ERROR) {
463	Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", NULL,
464		TCL_GLOBAL_ONLY);
465	Tcl_ResetResult(interp);
466	if (objPtr) {
467	    Tcl_SetObjErrorCode(interp, objPtr);
468	}
469
470	objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", NULL,
471		TCL_GLOBAL_ONLY);
472	if (objPtr) {
473	    int numBytes;
474	    CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
475	    Tcl_AddObjErrorInfo(interp, message, numBytes);
476	}
477	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
478    }
479    Tcl_Release((ClientData) consoleInterp);
480    if (result == TCL_ERROR) {
481	Tcl_DeleteCommandFromToken(interp, token);
482	mainWindow = Tk_MainWindow(interp);
483	if (mainWindow) {
484	    Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
485		    ConsoleEventProc, (ClientData) info);
486	    if (--info->refCount <= 0) {
487		ckfree((char *) info);
488	    }
489	}
490	goto error;
491    }
492    return TCL_OK;
493
494    error:
495    Tcl_AddErrorInfo(interp, "\n    (creating console window)");
496    if (!Tcl_InterpDeleted(consoleInterp)) {
497	Tcl_DeleteInterp(consoleInterp);
498    }
499    return TCL_ERROR;
500}
501
502/*
503 *----------------------------------------------------------------------
504 *
505 * ConsoleOutput--
506 *
507 *	Writes the given output on the IO channel. Returns count of how
508 *	many characters were actually written, and an error indication.
509 *
510 * Results:
511 *	A count of how many characters were written is returned and an
512 *	error indication is returned in an output argument.
513 *
514 * Side effects:
515 *	Writes output on the actual channel.
516 *
517 *----------------------------------------------------------------------
518 */
519
520static int
521ConsoleOutput(instanceData, buf, toWrite, errorCode)
522    ClientData instanceData;		/* Indicates which device to use. */
523    CONST char *buf;			/* The data buffer. */
524    int toWrite;			/* How many bytes to write? */
525    int *errorCode;			/* Where to store error code. */
526{
527    ChannelData *data = (ChannelData *)instanceData;
528    ConsoleInfo *info = data->info;
529
530    *errorCode = 0;
531    Tcl_SetErrno(0);
532
533    if (info) {
534	Tcl_Interp *consoleInterp = info->consoleInterp;
535
536	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
537	    Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
538	    if (data->type == TCL_STDERR) {
539		Tcl_ListObjAppendElement(NULL, cmd,
540			Tcl_NewStringObj("stderr", -1));
541	    } else {
542		Tcl_ListObjAppendElement(NULL, cmd,
543			Tcl_NewStringObj("stdout", -1));
544	    }
545	    Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite));
546	    Tcl_IncrRefCount(cmd);
547	    Tcl_GlobalEvalObj(consoleInterp, cmd);
548	    Tcl_DecrRefCount(cmd);
549	}
550    }
551    return toWrite;
552}
553
554/*
555 *----------------------------------------------------------------------
556 *
557 * ConsoleInput --
558 *
559 *	Read input from the console.  Not currently implemented.
560 *
561 * Results:
562 *	Always returns EOF.
563 *
564 * Side effects:
565 *	None.
566 *
567 *----------------------------------------------------------------------
568 */
569
570	/* ARGSUSED */
571static int
572ConsoleInput(instanceData, buf, bufSize, errorCode)
573    ClientData instanceData;		/* Unused. */
574    char *buf;				/* Where to store data read. */
575    int bufSize;			/* How much space is available
576                                         * in the buffer? */
577    int *errorCode;			/* Where to store error code. */
578{
579    return 0;			/* Always return EOF. */
580}
581
582/*
583 *----------------------------------------------------------------------
584 *
585 * ConsoleClose --
586 *
587 *	Closes the IO channel.
588 *
589 * Results:
590 *	Always returns 0 (success).
591 *
592 * Side effects:
593 *	Frees the dummy file associated with the channel.
594 *
595 *----------------------------------------------------------------------
596 */
597
598	/* ARGSUSED */
599static int
600ConsoleClose(instanceData, interp)
601    ClientData instanceData;	/* Unused. */
602    Tcl_Interp *interp;		/* Unused. */
603{
604    ChannelData *data = (ChannelData *)instanceData;
605    ConsoleInfo *info = data->info;
606
607    if (info) {
608	if (--info->refCount <= 0) {
609	    /* Assuming the Tcl_Interp * fields must already be NULL */
610	    ckfree((char *) info);
611	}
612    }
613    ckfree((char *) data);
614    return 0;
615}
616
617/*
618 *----------------------------------------------------------------------
619 *
620 * ConsoleWatch --
621 *
622 *	Called by the notifier to set up the console device so that
623 *	events will be noticed. Since there are no events on the
624 *	console, this routine just returns without doing anything.
625 *
626 * Results:
627 *	None.
628 *
629 * Side effects:
630 *	None.
631 *
632 *----------------------------------------------------------------------
633 */
634
635	/* ARGSUSED */
636static void
637ConsoleWatch(instanceData, mask)
638    ClientData instanceData;		/* Device ID for the channel. */
639    int mask;				/* OR-ed combination of
640                                         * TCL_READABLE, TCL_WRITABLE and
641                                         * TCL_EXCEPTION, for the events
642                                         * we are interested in. */
643{
644}
645
646/*
647 *----------------------------------------------------------------------
648 *
649 * ConsoleHandle --
650 *
651 *	Invoked by the generic IO layer to get a handle from a channel.
652 *	Because console channels are not devices, this function always
653 *	fails.
654 *
655 * Results:
656 *	Always returns TCL_ERROR.
657 *
658 * Side effects:
659 *	None.
660 *
661 *----------------------------------------------------------------------
662 */
663
664	/* ARGSUSED */
665static int
666ConsoleHandle(instanceData, direction, handlePtr)
667    ClientData instanceData;	/* Device ID for the channel. */
668    int direction;		/* TCL_READABLE or TCL_WRITABLE to indicate
669				 * which direction of the channel is being
670				 * requested. */
671    ClientData *handlePtr;	/* Where to store handle */
672{
673    return TCL_ERROR;
674}
675
676/*
677 *----------------------------------------------------------------------
678 *
679 * ConsoleObjCmd --
680 *
681 *	The console command implements a Tcl interface to the various console
682 *	options.
683 *
684 * Results:
685 *	A standard Tcl result.
686 *
687 * Side effects:
688 *	See the user documentation.
689 *
690 *----------------------------------------------------------------------
691 */
692
693static int
694ConsoleObjCmd(clientData, interp, objc, objv)
695    ClientData clientData;		/* Access to the console interp */
696    Tcl_Interp *interp;			/* Current interpreter */
697    int objc;				/* Number of arguments */
698    Tcl_Obj *CONST objv[];		/* Argument objects */
699{
700    int index, result;
701    static CONST char *options[] = {"eval", "hide", "show", "title", NULL};
702    enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE};
703    Tcl_Obj *cmd = NULL;
704    ConsoleInfo *info = (ConsoleInfo *) clientData;
705    Tcl_Interp *consoleInterp = info->consoleInterp;
706
707    if (objc < 2) {
708	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
709	return TCL_ERROR;
710    }
711    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
712	    != TCL_OK) {
713	return TCL_ERROR;
714    }
715
716    switch ((enum option) index) {
717    case CON_EVAL:
718	if (objc != 3) {
719	    Tcl_WrongNumArgs(interp, 2, objv, "script");
720	    return TCL_ERROR;
721	}
722	cmd = objv[2];
723	break;
724    case CON_HIDE:
725	if (objc != 2) {
726	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
727	    return TCL_ERROR;
728	}
729	cmd = Tcl_NewStringObj("wm withdraw .", -1);
730	break;
731    case CON_SHOW:
732	if (objc != 2) {
733	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
734	    return TCL_ERROR;
735	}
736	cmd = Tcl_NewStringObj("wm deiconify .", -1);
737	break;
738    case CON_TITLE:
739	if (objc > 3) {
740	    Tcl_WrongNumArgs(interp, 2, objv, "?title?");
741	    return TCL_ERROR;
742	}
743	cmd = Tcl_NewStringObj("wm title .", -1);
744	if (objc == 3) {
745	    Tcl_ListObjAppendElement(NULL, cmd, objv[2]);
746	}
747	break;
748    }
749
750    Tcl_IncrRefCount(cmd);
751    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
752	Tcl_Preserve((ClientData) consoleInterp);
753	result = Tcl_GlobalEvalObj(consoleInterp, cmd);
754	if (result == TCL_ERROR) {
755	    Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode",
756		    NULL, TCL_GLOBAL_ONLY);
757	    Tcl_ResetResult(interp);
758	    if (objPtr) {
759		Tcl_SetObjErrorCode(interp, objPtr);
760	    }
761
762	    objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo",
763		    NULL, TCL_GLOBAL_ONLY);
764	    if (objPtr) {
765		int numBytes;
766		CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
767		Tcl_AddObjErrorInfo(interp, message, numBytes);
768	    }
769	}
770	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
771	Tcl_Release((ClientData) consoleInterp);
772    } else {
773	Tcl_AppendResult(interp, "no active console interp", NULL);
774	result = TCL_ERROR;
775    }
776    Tcl_DecrRefCount(cmd);
777    return result;
778}
779
780/*
781 *----------------------------------------------------------------------
782 *
783 * InterpreterObjCmd --
784 *
785 *	This command allows the console interp to communicate with the
786 *	main interpreter.
787 *
788 * Results:
789 *	A standard Tcl result.
790 *
791 *----------------------------------------------------------------------
792 */
793
794static int
795InterpreterObjCmd(clientData, interp, objc, objv)
796    ClientData clientData;		/* Not used */
797    Tcl_Interp *interp;			/* Current interpreter */
798    int objc;				/* Number of arguments */
799    Tcl_Obj *CONST objv[];		/* Argument objects */
800{
801    int index, result = TCL_OK;
802    static CONST char *options[] = {"eval", "record", NULL};
803    enum option {OTHER_EVAL, OTHER_RECORD};
804    ConsoleInfo *info = (ConsoleInfo *) clientData;
805    Tcl_Interp *otherInterp = info->interp;
806
807    if (objc < 2) {
808	Tcl_WrongNumArgs(interp, 1, objv, "option arg");
809	return TCL_ERROR;
810    }
811    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
812	!= TCL_OK) {
813	return TCL_ERROR;
814    }
815
816    if (objc != 3) {
817	Tcl_WrongNumArgs(interp, 2, objv, "script");
818	return TCL_ERROR;
819    }
820
821    if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) {
822	Tcl_AppendResult(interp, "no active master interp", NULL);
823	return TCL_ERROR;
824    }
825
826    Tcl_Preserve((ClientData) otherInterp);
827    switch ((enum option) index) {
828    case OTHER_EVAL:
829	result = Tcl_GlobalEvalObj(otherInterp, objv[2]);
830	/*
831	 * TODO: Should exceptions be filtered here?
832	 */
833	if (result == TCL_ERROR) {
834	    Tcl_Obj *objPtr = Tcl_GetVar2Ex(otherInterp, "errorCode",
835		    NULL, TCL_GLOBAL_ONLY);
836	    Tcl_ResetResult(interp);
837	    if (objPtr) {
838		Tcl_SetObjErrorCode(interp, objPtr);
839	    }
840
841	    objPtr = Tcl_GetVar2Ex(otherInterp, "errorInfo",
842		    NULL, TCL_GLOBAL_ONLY);
843	    if (objPtr) {
844		int numBytes;
845		CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
846		Tcl_AddObjErrorInfo(interp, message, numBytes);
847	    }
848	}
849	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
850	break;
851    case OTHER_RECORD:
852	Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL);
853	/*
854	 * By not setting result, we discard any exceptions or errors here
855	 * and always return TCL_OK.  All the caller wants is the
856	 * interp result to display, whether that's result or error message.
857	 */
858	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
859	break;
860    }
861    Tcl_Release((ClientData) otherInterp);
862    return result;
863}
864
865/*
866 *----------------------------------------------------------------------
867 *
868 * DeleteConsoleInterp --
869 *
870 *	Thread exit handler to destroy a console interp when the
871 *	thread it lives in gets torn down.
872 *
873 *----------------------------------------------------------------------
874 */
875
876static void
877DeleteConsoleInterp(clientData)
878    ClientData clientData;
879{
880    Tcl_Interp *interp = (Tcl_Interp *)clientData;
881    Tcl_DeleteInterp(interp);
882}
883
884/*
885 *----------------------------------------------------------------------
886 *
887 * InterpDeleteProc --
888 *
889 *    React when the interp in which the console is displayed is deleted
890 *    for any reason.
891 *
892 * Results:
893 *	None.
894 */
895
896static void
897InterpDeleteProc(clientData, interp)
898    ClientData clientData;
899    Tcl_Interp *interp;
900{
901    ConsoleInfo *info = (ConsoleInfo *) clientData;
902
903    if(info->consoleInterp == interp) {
904	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
905		(ClientData) info-> consoleInterp);
906	info->consoleInterp = NULL;
907    }
908    if (--info->refCount <= 0) {
909	ckfree((char *) info);
910    }
911}
912
913/*
914 *----------------------------------------------------------------------
915 *
916 * ConsoleDeleteProc --
917 *
918 *	If the console command is deleted we destroy the console window and
919 * 	all associated data structures.
920
921 * Results:
922 *	None.
923 *
924 * Side effects:
925 *	A new console is created.
926 *
927 *----------------------------------------------------------------------
928 */
929
930static void
931ConsoleDeleteProc(clientData)
932    ClientData clientData;
933{
934    ConsoleInfo *info = (ConsoleInfo *) clientData;
935
936    if (info->consoleInterp) {
937	Tcl_DeleteInterp(info->consoleInterp);
938    }
939    if (--info->refCount <= 0) {
940	ckfree((char *) info);
941    }
942}
943
944/*
945 *----------------------------------------------------------------------
946 *
947 * ConsoleEventProc --
948 *
949 * 	This event function is registered on the main window of the slave
950 *	interpreter.  If the user or a running script causes the main window to
951 * 	be destroyed, then we need to inform the console interpreter by
952 *	invoking "::tk::ConsoleExit".
953 * Results:
954 *	None.
955 *
956 * Side effects:
957 *	Invokes the "::tk::ConsoleExit" command in the console interp.
958 *
959 *----------------------------------------------------------------------
960 */
961
962static void
963ConsoleEventProc(clientData, eventPtr)
964    ClientData clientData;
965    XEvent *eventPtr;
966{
967    if (eventPtr->type == DestroyNotify) {
968	ConsoleInfo *info = (ConsoleInfo *) clientData;
969	Tcl_Interp *consoleInterp = info->consoleInterp;
970
971	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
972	    Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
973	}
974
975	if (--info->refCount <= 0) {
976	    ckfree((char *) info);
977	}
978    }
979}
980