head	1.41;
access;
symbols
	core-8-5-9:1.35.2.1
	core-8-5-8:1.35.2.1
	macosx-cocoa-merge:1.38
	macosx-cocoa-premerge:1.38
	macosx-carbon-freeze:1.38
	core-8-5-7:1.35
	core-8-5-6:1.35
	core-8-6-b1:1.38
	core-8-6-a3:1.37
	core-8-5-5:1.35
	core-8-6-a2:1.37
	core-8-5-4:1.35
	core-8-5-3:1.35
	core-8-6-a1:1.37
	core-8-4-19:1.18.2.6
	core-8-5-branch:1.35.0.2
	core-8-5-2:1.35
	core-8-4-18:1.18.2.6
	core-8-5-1:1.35
	core-8-4-17:1.18.2.6
	core-8-5-0:1.35
	core-8-5-b3:1.34
	core-8-5-b2:1.34
	core-8-4-16:1.18.2.6
	core-8-5-b1:1.34
	core-stablilizer-merge:1.31
	core-stabilizer-branch:1.31.0.2
	core-stabilizer-merge:1.35
	core-8-4-15:1.18.2.6
	core-8-5-a6:1.31
	core-8-5-a5:1.31
	core-8-4-14:1.18.2.6
	core-8-5-a4:1.29
	core-8-4-13:1.18.2.2
	core-8-4-12:1.18.2.2
	core-8-4-11:1.18.2.2
	core-8-5-a3:1.22
	core-8-4-10:1.18
	core-8-4-9-branch:1.18.0.4
	core-8-5-a2:1.21
	core-8-4-9:1.18
	core-8-4-8:1.18
	core-8-4-7:1.18
	core-8-5-a1:1.19
	core-8-4-6:1.18
	core-8-4-5:1.18
	mistachkin-dev-branch:1.19.0.2
	core-8-4-4:1.18
	core-8-4-3:1.18
	core-8-4-branch:1.18.0.2
	core-8-4-2:1.18
	core-8-4-1:1.18
	core-8-3-5:1.11.2.3
	core-8-4-0:1.18
	macosx-8-4-merge-2002-08-31-trunk:1.18
	macosx-8-4-premerge-2002-08-31-branch:1.13.2.3
	macosx-8-4-premerge-2002-08-31-trunk:1.18
	macosx-8-4-merge-2002-08-30-branch:1.13.2.3
	macosx-8-4-merge-2002-08-30-trunk:1.18
	macosx-8-4-merge-2002-08-20-branch:1.13.2.3
	macosx-8-4-merge-2002-08-20-trunk:1.18
	core-8-4-b2:1.18
	core-8-4-b1:1.17
	macosx-premerge-6-9-02:1.13.2.1
	core-8-4-a4:1.16
	core-8-3-4:1.11.2.3
	macosx-8-4-branch:1.13.0.2
	macosx-8-4-branchpoint:1.13
	core-8-4-a3:1.13
	core-8-3-3:1.11.2.1
	dgp-privates-into-namespace:1.12.0.4
	tclpro-1-5-0:1.11
	core-8-4-win-speedup:1.12.0.2
	core-8-4-a2:1.12
	tclpro-1-4-1:1.11
	tclpro-1-4-0:1.11
	core-8-3-2:1.11
	ajuba-ajuba2-2-1-base:1.11
	ajuba-ajuba2-2-0:1.11
	core-8-4-a1:1.11
	core-8-3-1-branch:1.11.0.2
	core-8-3-1:1.11
	scriptics-sc-2-0-b5:1.11
	scriptics-sc-2-0-fixed:1.11
	scriptics-sc-2-0-b2:1.11
	scriptics-sc-2-0-b1:1.11
	core-8-3-0:1.11
	core-8-3-b2:1.11
	core-8-3-b1:1.11
	scriptics-sc-1-1:1.10
	scriptics-sc-1-1-b1:1.10
	core-8-2-3:1.10
	scriptics-sc-1-1-branch:1.10.0.8
	scriptics-sc-1-1-base:1.10
	scriptics-sc-1-0:1.10
	scriptics-sc-1-0-branch:1.10.0.6
	scriptics-sc-1-0-base:1.10
	core-8-2-2:1.10
	core-8-2-1:1.10
	scriptics-bc-1-0-b1:1.10
	core-8-2-1-branch:1.10.0.4
	scriptics-tclpro-1-3-0:1.10
	core-8-2-0:1.10
	core-8-2-b3-branch:1.10.0.2
	core-8-2-b3-base:1.10
	scriptics-tclpro-1-3-b4:1.10
	core-8-2-b2:1.10
	scriptics-tclpro-1-3-b3:1.9
	core-8-2-b1:1.9
	scriptics-tclpro-1-3-b2:1.6
	merge-to-mainline-5/21/99:1.6
	scriptics-tclpro-1-3-b2-branch:1.6.0.2
	core-8-1-1:1.6
	scriptics-tclpro-1-3-b1:1.6
	core-8-1-1-base:1.6
	core-8-1-0:1.5
	merge-to-mainline-4-29-99:1.5
	merge-to-mainline-4-23-99:1.5
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.4.0.2
	core-8-0-6-base:1.4
	core-8-0-5:1.3
	core-8-1-b3:1.1.4.7
	core-8-1-b2:1.1.4.6
	dev-8-1-stubs-branch:1.1.4.5.0.2
	dev-stubs-branch:1.3.0.4
	scriptics-tclpro-1-2:1.3
	scriptics-tclpro-1-2-b2:1.3
	core-8-1-merge-2/10/99:1.3
	core-8-0-5-branch:1.3.0.2
	core-8-0-5-base:1.3
	scriptics-tclpro-1-2-b1:1.2
	scriptics-tclpro-1-2-a1:1.2
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.2
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.2;
locks; strict;
comment	@ * @;


1.41
date	2010.01.13.23.08.09;	author nijtmans;	state Exp;
branches;
next	1.40;

1.40
date	2010.01.02.22.52.38;	author dkf;	state Exp;
branches;
next	1.39;

1.39
date	2009.09.07.07.29.03;	author das;	state Exp;
branches;
next	1.38;

1.38
date	2008.10.17.23.18.37;	author nijtmans;	state Exp;
branches;
next	1.37;

1.37
date	2008.04.27.22.38.56;	author dkf;	state Exp;
branches;
next	1.36;

1.36
date	2008.04.01.16.30.52;	author dgp;	state Exp;
branches;
next	1.35;

1.35
date	2007.12.13.15.24.14;	author dgp;	state Exp;
branches
	1.35.2.1;
next	1.34;

1.34
date	2007.09.17.14.58.04;	author dgp;	state Exp;
branches;
next	1.33;

1.33
date	2007.09.11.17.46.41;	author dgp;	state Exp;
branches;
next	1.32;

1.32
date	2007.09.10.13.35.42;	author dgp;	state Exp;
branches;
next	1.31;

1.31
date	2006.09.22.19.02.07;	author andreas_kupries;	state Exp;
branches
	1.31.2.1;
next	1.30;

1.30
date	2006.06.01.17.19.30;	author dgp;	state Exp;
branches;
next	1.29;

1.29
date	2006.03.21.03.01.27;	author dgp;	state Exp;
branches;
next	1.28;

1.28
date	2006.03.20.22.58.46;	author dgp;	state Exp;
branches;
next	1.27;

1.27
date	2006.03.16.22.51.15;	author dgp;	state Exp;
branches;
next	1.26;

1.26
date	2006.03.16.22.47.52;	author dgp;	state Exp;
branches;
next	1.25;

1.25
date	2006.03.16.17.32.27;	author dgp;	state Exp;
branches;
next	1.24;

1.24
date	2005.11.11.23.51.27;	author dkf;	state Exp;
branches;
next	1.23;

1.23
date	2005.06.23.22.07.46;	author das;	state Exp;
branches;
next	1.22;

1.22
date	2005.03.19.08.02.57;	author dkf;	state Exp;
branches;
next	1.21;

1.21
date	2004.06.26.09.04.15;	author mistachkin;	state Exp;
branches;
next	1.20;

1.20
date	2004.03.17.18.15.43;	author das;	state Exp;
branches;
next	1.19;

1.19
date	2003.09.20.03.43.29;	author chengyemao;	state Exp;
branches;
next	1.18;

1.18
date	2002.08.05.04.30.38;	author dgp;	state Exp;
branches
	1.18.2.1;
next	1.17;

1.17
date	2002.04.12.06.51.50;	author hobbs;	state Exp;
branches;
next	1.16;

1.16
date	2002.01.15.20.48.29;	author dgp;	state Exp;
branches;
next	1.15;

1.15
date	2002.01.15.18.19.14;	author dgp;	state Exp;
branches;
next	1.14;

1.14
date	2001.11.23.02.04.44;	author das;	state Exp;
branches;
next	1.13;

1.13
date	2001.08.06.18.29.41;	author dgp;	state Exp;
branches
	1.13.2.1;
next	1.12;

1.12
date	2000.07.18.02.31.06;	author davidg;	state Exp;
branches
	1.12.2.1;
next	1.11;

1.11
date	99.11.19.22.00.03;	author hobbs;	state Exp;
branches
	1.11.2.1;
next	1.10;

1.10
date	99.07.30.02.09.25;	author redman;	state Exp;
branches;
next	1.9;

1.9
date	99.06.17.01.03.28;	author wart;	state Exp;
branches;
next	1.8;

1.8
date	99.06.17.00.39.18;	author wart;	state Exp;
branches;
next	1.7;

1.7
date	99.05.25.01.31.05;	author stanton;	state Exp;
branches;
next	1.6;

1.6
date	99.04.28.18.18.06;	author redman;	state Exp;
branches;
next	1.5;

1.5
date	99.04.16.01.51.13;	author stanton;	state Exp;
branches;
next	1.4;

1.4
date	99.03.10.07.04.39;	author stanton;	state Exp;
branches;
next	1.3;

1.3
date	99.02.04.20.51.36;	author stanton;	state Exp;
branches
	1.3.4.1;
next	1.2;

1.2
date	98.09.14.18.23.08;	author stanton;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.51.54;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.16;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.16.52;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	98.12.13.08.16.03;	author lfb;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.02.11.04.13.45;	author stanton;	state Exp;
branches;
next	1.1.4.5;

1.1.4.5
date	99.02.26.02.26.05;	author redman;	state Exp;
branches
	1.1.4.5.2.1;
next	1.1.4.6;

1.1.4.6
date	99.03.10.07.13.38;	author stanton;	state Exp;
branches;
next	1.1.4.7;

1.1.4.7
date	99.03.27.02.14.19;	author redman;	state Exp;
branches;
next	;

1.1.4.5.2.1
date	99.03.09.17.50.33;	author redman;	state Exp;
branches;
next	;

1.3.4.1
date	99.03.06.23.18.05;	author stanton;	state Exp;
branches;
next	1.3.4.2;

1.3.4.2
date	99.03.07.00.15.43;	author redman;	state Exp;
branches;
next	;

1.11.2.1
date	2001.04.04.07.57.16;	author hobbs;	state Exp;
branches;
next	1.11.2.2;

1.11.2.2
date	2001.10.17.19.29.51;	author das;	state Exp;
branches;
next	1.11.2.3;

1.11.2.3
date	2001.10.19.19.40.17;	author das;	state Exp;
branches;
next	;

1.12.2.1
date	2002.04.02.21.00.48;	author hobbs;	state Exp;
branches;
next	;

1.13.2.1
date	2002.02.05.02.25.14;	author wolfsuit;	state Exp;
branches;
next	1.13.2.2;

1.13.2.2
date	2002.06.10.05.38.23;	author wolfsuit;	state Exp;
branches;
next	1.13.2.3;

1.13.2.3
date	2002.08.20.20.27.03;	author das;	state Exp;
branches;
next	;

1.18.2.1
date	2005.06.03.15.25.01;	author dkf;	state Exp;
branches;
next	1.18.2.2;

1.18.2.2
date	2005.06.23.22.07.13;	author das;	state Exp;
branches;
next	1.18.2.3;

1.18.2.3
date	2006.06.01.18.21.41;	author dgp;	state Exp;
branches;
next	1.18.2.4;

1.18.2.4
date	2006.06.05.18.06.47;	author dgp;	state Exp;
branches;
next	1.18.2.5;

1.18.2.5
date	2006.09.22.19.01.50;	author andreas_kupries;	state Exp;
branches;
next	1.18.2.6;

1.18.2.6
date	2006.09.25.17.28.20;	author andreas_kupries;	state Exp;
branches;
next	;

1.31.2.1
date	2007.09.11.18.32.35;	author dgp;	state Exp;
branches;
next	1.31.2.2;

1.31.2.2
date	2007.09.17.15.22.00;	author dgp;	state Exp;
branches;
next	;

1.35.2.1
date	2009.10.15.17.48.50;	author dgp;	state Exp;
branches;
next	;


desc
@@


1.41
log
@Eliminate tkpMenubuttonClass
make tkpButtonProcs CONST
fix gcc warnings: missing initializer
@
text
@/*
 * tkConsole.c --
 *
 *	This file implements a Tcl console for systems that may not otherwise
 *	have access to a console. It uses the Text widget and provides special
 *	access via a console command.
 *
 * Copyright (c) 1995-1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @@(#) $Id: tkConsole.c,v 1.40 2010/01/02 22:52:38 dkf Exp $
 */

#include "tkInt.h"

/*
 * Each console is associated with an instance of the ConsoleInfo struct.
 * It keeps track of what interp holds the Tk application that displays
 * the console, and what interp is controlled by the interactions in that
 * console.  A refCount permits the struct to be shared as instance data
 * by commands and by channels.
 */

typedef struct ConsoleInfo {
    Tcl_Interp *consoleInterp;	/* Interpreter displaying the console. */
    Tcl_Interp *interp;		/* Interpreter controlled by console. */
    int refCount;
} ConsoleInfo;

/*
 * Each console channel holds an instance of the ChannelData struct as
 * its instance data.  It contains ConsoleInfo, so the channel can work
 * with the appropriate console window, and a type value to distinguish
 * the stdout channel from the stderr channel.
 */

typedef struct ChannelData {
    ConsoleInfo *info;
    int type;			/* TCL_STDOUT or TCL_STDERR */
} ChannelData;

/*
 * Prototypes for local procedures defined in this file:
 */

static int	ConsoleClose(ClientData instanceData, Tcl_Interp *interp);
static void	ConsoleDeleteProc(ClientData clientData);
static void	ConsoleEventProc(ClientData clientData, XEvent *eventPtr);
static int	ConsoleHandle(ClientData instanceData, int direction,
		    ClientData *handlePtr);
static int	ConsoleInput(ClientData instanceData, char *buf, int toRead,
		    int *errorCode);
static int	ConsoleObjCmd(ClientData clientData, Tcl_Interp *interp,
		    int objc, Tcl_Obj *const objv[]);
static int	ConsoleOutput(ClientData instanceData, const char *buf,
		    int toWrite, int *errorCode);
static void	ConsoleWatch(ClientData instanceData, int mask);
static void	DeleteConsoleInterp(ClientData clientData);
static void	InterpDeleteProc(ClientData clientData, Tcl_Interp *interp);
static int	InterpreterObjCmd(ClientData clientData, Tcl_Interp *interp,
		    int objc, Tcl_Obj *const objv[]);

/*
 * This structure describes the channel type structure for file based IO:
 */

static const Tcl_ChannelType consoleChannelType = {
    "console",			/* Type name. */
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
    ConsoleClose,		/* Close proc. */
    ConsoleInput,		/* Input proc. */
    ConsoleOutput,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    ConsoleWatch,		/* Watch for events on console. */
    ConsoleHandle,		/* Get a handle from the device. */
    NULL,			/* close2proc. */
    NULL,			/* Always non-blocking.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc */
    NULL,			/* thread action proc */
    NULL
};

#ifdef __WIN32__
#include <windows.h>

/*
 *----------------------------------------------------------------------
 *
 * ShouldUseConsoleChannel
 *
 *	Check to see if console window should be used for a given standard
 *	channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates the console channel and installs it as the standard channels.
 *
 *----------------------------------------------------------------------
 */

static int
ShouldUseConsoleChannel(
    int type)
{
    DWORD handleId;		/* Standard handle to retrieve. */
    DCB dcb;
    DWORD consoleParams;
    DWORD fileType;
    int mode;
    const char *bufMode;
    HANDLE handle;

    switch (type) {
    case TCL_STDIN:
	handleId = STD_INPUT_HANDLE;
	mode = TCL_READABLE;
	bufMode = "line";
	break;
    case TCL_STDOUT:
	handleId = STD_OUTPUT_HANDLE;
	mode = TCL_WRITABLE;
	bufMode = "line";
	break;
    case TCL_STDERR:
	handleId = STD_ERROR_HANDLE;
	mode = TCL_WRITABLE;
	bufMode = "none";
	break;
    default:
	return 0;
	break;
    }

    handle = GetStdHandle(handleId);

    /*
     * Note that we need to check for 0 because Windows will return 0 if this
     * is not a console mode application, even though this is not a valid
     * handle.
     */

    if ((handle == INVALID_HANDLE_VALUE) || (handle == 0)) {
	return 1;
    }

    /*
     * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears to
     * be a valid handle. See TclpGetDefaultStdChannel() for this change
     * implemented. We didn't change it here because GetFileType() [below]
     * will catch this with FILE_TYPE_UNKNOWN and appropriately return a value
     * of 1, anyways.
     *
     *    char dummyBuff[1];
     *    DWORD dummyWritten;
     *
     *    if ((type == TCL_STDOUT)
     *		&& !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
     *	     return 1;
     *    }
     */

    fileType = GetFileType(handle);

    /*
     * If the file is a character device, we need to try to figure out whether
     * it is a serial port, a console, or something else. We test for the
     * console case first because this is more common.
     */

    if (fileType == FILE_TYPE_CHAR) {
	dcb.DCBlength = sizeof(DCB);
	if (!GetConsoleMode(handle, &consoleParams) &&
		!GetCommState(handle, &dcb)) {
	    /*
	     * Don't use a CHAR type channel for stdio, otherwise Tk runs into
	     * trouble with the MS DevStudio debugger.
	     */

	    return 1;
	}
    } else if (fileType == FILE_TYPE_UNKNOWN) {
	return 1;
    } else if (Tcl_GetStdChannel(type) == NULL) {
	return 1;
    }

    return 0;
}
#else
/*
 * Mac should always use a console channel, Unix should if it's trying to
 */

#define ShouldUseConsoleChannel(chan) (1)
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tk_InitConsoleChannels --
 *
 * 	Create the console channels and install them as the standard channels.
 * 	All I/O will be discarded until Tk_CreateConsoleWindow is called to
 * 	attach the console to a text widget.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates the console channel and installs it as the standard channels.
 *
 *----------------------------------------------------------------------
 */

void
Tk_InitConsoleChannels(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey consoleInitKey;
    int *consoleInitPtr, doIn, doOut, doErr;
    ConsoleInfo *info;
    Tcl_Channel consoleChannel;

    /*
     * Ensure that we are getting a compatible version of Tcl. This is really
     * only an issue when Tk is loaded dynamically.
     */

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
        return;
    }

    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int) sizeof(int));
    if (*consoleInitPtr) {
	/*
	 * We've already initialized console channels in this thread.
	 */

	return;
    }
    *consoleInitPtr = 1;

    doIn = ShouldUseConsoleChannel(TCL_STDIN);
    doOut = ShouldUseConsoleChannel(TCL_STDOUT);
    doErr = ShouldUseConsoleChannel(TCL_STDERR);

    if (!(doIn || doOut || doErr)) {
	/*
	 * No std channels should be tied to the console; thus, no need to
	 * create the console.
	 */

	return;
    }

    /*
     * At least one std channel wants to be tied to the console, so create the
     * interp for it to live in.
     */

    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
    info->consoleInterp = NULL;
    info->interp = NULL;
    info->refCount = 0;

    if (doIn) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));

	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDIN;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
		data, TCL_READABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
	Tcl_RegisterChannel(NULL, consoleChannel);
    }

    if (doOut) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));

	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDOUT;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
		data, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
	Tcl_RegisterChannel(NULL, consoleChannel);
    }

    if (doErr) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));

	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDERR;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
		data, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
	Tcl_RegisterChannel(NULL, consoleChannel);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tk_CreateConsoleWindow --
 *
 *	Initialize the console. This code actually creates a new application
 *	and associated interpreter. This effectivly hides the implementation
 *	from the main application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A new console it created.
 *
 *----------------------------------------------------------------------
 */

int
Tk_CreateConsoleWindow(
    Tcl_Interp *interp)		/* Interpreter to use for prompting. */
{
    Tcl_Channel chan;
    ConsoleInfo *info;
    Tk_Window mainWindow;
    Tcl_Command token;
    int result = TCL_OK;
    int haveConsoleChannel = 1;

    /* Init an interp with Tcl and Tk */
    Tcl_Interp *consoleInterp = Tcl_CreateInterp();
    if (Tcl_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
	goto error;
    }

    /*
     * Fetch the instance data from whatever std channel is a
     * console channel.  If none, create fresh instance data.
     */

    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
	    == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
	    == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
	    == &consoleChannelType) {
    } else {
	haveConsoleChannel = 0;
    }

    if (haveConsoleChannel) {
	ChannelData *data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
	info = data->info;
	if (info->consoleInterp) {
	    /* New ConsoleInfo for a new console window */
	    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	    info->refCount = 0;

	    /* Update any console channels to make use of the new console */
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
		    == &consoleChannelType) {
		data = (ChannelData *) Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	}
    } else {
	info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	info->refCount = 0;
    }

    info->consoleInterp = consoleInterp;
    info->interp = interp;

    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, info);
    info->refCount++;
    Tcl_CreateThreadExitHandler(DeleteConsoleInterp, consoleInterp);

    /*
     * Add console commands to the interp
     */

    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd, info,
	    ConsoleDeleteProc);
    info->refCount++;

    /*
     * We don't have to count the ref held by the [consoleinterp] command
     * in the consoleInterp.  The ref held by the consoleInterp delete
     * handler takes care of us.
     */
    Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
	    info, NULL);

    mainWindow = Tk_MainWindow(interp);
    if (mainWindow) {
	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
		ConsoleEventProc, info);
	info->refCount++;
    }

    Tcl_Preserve(consoleInterp);
    result = Tcl_GlobalEval(consoleInterp, "source $tk_library/console.tcl");
    if (result == TCL_ERROR) {
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(consoleInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
    }
    Tcl_Release(consoleInterp);
    if (result == TCL_ERROR) {
	Tcl_DeleteCommandFromToken(interp, token);
	mainWindow = Tk_MainWindow(interp);
	if (mainWindow) {
	    Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
		    ConsoleEventProc, info);
	    if (--info->refCount <= 0) {
		ckfree((char *) info);
	    }
	}
	goto error;
    }
    return TCL_OK;

  error:
    Tcl_AddErrorInfo(interp, "\n    (creating console window)");
    if (!Tcl_InterpDeleted(consoleInterp)) {
	Tcl_DeleteInterp(consoleInterp);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleOutput--
 *
 *	Writes the given output on the IO channel. Returns count of how many
 *	characters were actually written, and an error indication.
 *
 * Results:
 *	A count of how many characters were written is returned and an error
 *	indication is returned in an output argument.
 *
 * Side effects:
 *	Writes output on the actual channel.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleOutput(
    ClientData instanceData,	/* Indicates which device to use. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ChannelData *data = instanceData;
    ConsoleInfo *info = data->info;

    *errorCode = 0;
    Tcl_SetErrno(0);

    if (info) {
	Tcl_Interp *consoleInterp = info->consoleInterp;

	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	    Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);

	    if (data->type == TCL_STDERR) {
		Tcl_ListObjAppendElement(NULL, cmd,
			Tcl_NewStringObj("stderr", -1));
	    } else {
		Tcl_ListObjAppendElement(NULL, cmd,
			Tcl_NewStringObj("stdout", -1));
	    }
	    Tcl_ListObjAppendElement(NULL, cmd,
		    Tcl_NewStringObj(buf, toWrite));
	    Tcl_IncrRefCount(cmd);
	    Tcl_GlobalEvalObj(consoleInterp, cmd);
	    Tcl_DecrRefCount(cmd);
	}
    }
    return toWrite;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleInput --
 *
 *	Read input from the console. Not currently implemented.
 *
 * Results:
 *	Always returns EOF.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ConsoleInput(
    ClientData instanceData,	/* Unused. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    return 0;			/* Always return EOF. */
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleClose --
 *
 *	Closes the IO channel.
 *
 * Results:
 *	Always returns 0 (success).
 *
 * Side effects:
 *	Frees the dummy file associated with the channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ConsoleClose(
    ClientData instanceData,	/* Unused. */
    Tcl_Interp *interp)		/* Unused. */
{
    ChannelData *data = instanceData;
    ConsoleInfo *info = data->info;

    if (info) {
	if (--info->refCount <= 0) {
	    /*
	     * Assuming the Tcl_Interp * fields must already be NULL.
	     */

	    ckfree((char *) info);
	}
    }
    ckfree((char *) data);
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleWatch --
 *
 *	Called by the notifier to set up the console device so that events
 *	will be noticed. Since there are no events on the console, this
 *	routine just returns without doing anything.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
ConsoleWatch(
    ClientData instanceData,	/* Device ID for the channel. */
    int mask)			/* OR-ed combination of TCL_READABLE,
				 * TCL_WRITABLE and TCL_EXCEPTION, for the
				 * events we are interested in. */
{
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleHandle --
 *
 *	Invoked by the generic IO layer to get a handle from a channel.
 *	Because console channels are not devices, this function always fails.
 *
 * Results:
 *	Always returns TCL_ERROR.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ConsoleHandle(
    ClientData instanceData,	/* Device ID for the channel. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE to indicate
				 * which direction of the channel is being
				 * requested. */
    ClientData *handlePtr)	/* Where to store handle */
{
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleObjCmd --
 *
 *	The console command implements a Tcl interface to the various console
 *	options.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleObjCmd(
    ClientData clientData,	/* Access to the console interp */
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int index, result;
    static const char *const options[] = {
	"eval", "hide", "show", "title", NULL};
    enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE};
    Tcl_Obj *cmd = NULL;
    ConsoleInfo *info = clientData;
    Tcl_Interp *consoleInterp = info->consoleInterp;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum option) index) {
    case CON_EVAL:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script");
	    return TCL_ERROR;
	}
	cmd = objv[2];
	break;
    case CON_HIDE:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm withdraw .", -1);
	break;
    case CON_SHOW:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm deiconify .", -1);
	break;
    case CON_TITLE:
	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?title?");
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm title .", -1);
	if (objc == 3) {
	    Tcl_ListObjAppendElement(NULL, cmd, objv[2]);
	}
	break;
    default:
	CLANG_ASSERT(0);
    }

    Tcl_IncrRefCount(cmd);
    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	Tcl_Preserve(consoleInterp);
	result = Tcl_GlobalEvalObj(consoleInterp, cmd);
	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(consoleInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
	Tcl_Release(consoleInterp);
    } else {
	Tcl_AppendResult(interp, "no active console interp", NULL);
	result = TCL_ERROR;
    }
    Tcl_DecrRefCount(cmd);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * InterpreterObjCmd --
 *
 *	This command allows the console interp to communicate with the main
 *	interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

static int
InterpreterObjCmd(
    ClientData clientData,	/* */
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    int index, result = TCL_OK;
    static const char *const options[] = {"eval", "record", NULL};
    enum option {OTHER_EVAL, OTHER_RECORD};
    ConsoleInfo *info = clientData;
    Tcl_Interp *otherInterp = info->interp;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "script");
	return TCL_ERROR;
    }

    if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) {
	Tcl_AppendResult(interp, "no active master interp", NULL);
	return TCL_ERROR;
    }

    Tcl_Preserve(otherInterp);
    switch ((enum option) index) {
    case OTHER_EVAL:
   	result = Tcl_GlobalEvalObj(otherInterp, objv[2]);

	/*
	 * TODO: Should exceptions be filtered here?
	 */

	Tcl_SetReturnOptions(interp,
		Tcl_GetReturnOptions(otherInterp, result));
	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
	break;
    case OTHER_RECORD:
   	Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL);

	/*
	 * By not setting result, we discard any exceptions or errors here and
	 * always return TCL_OK. All the caller wants is the interp result to
	 * display, whether that's result or error message.
	 */

	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
	break;
    }
    Tcl_Release(otherInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteConsoleInterp --
 *
 *	Thread exit handler to destroy a console interp when the thread it
 *	lives in gets torn down.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteConsoleInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = clientData;

    Tcl_DeleteInterp(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * InterpDeleteProc --
 *
 *	React when the interp in which the console is displayed is deleted for
 *	any reason.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A new console it created.
 *
 *----------------------------------------------------------------------
 */

static void
InterpDeleteProc(
    ClientData clientData,
    Tcl_Interp *interp)
{
    ConsoleInfo *info = clientData;

    if (info->consoleInterp == interp) {
	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp, info->consoleInterp);
	info->consoleInterp = NULL;
    }
    if (--info->refCount <= 0) {
	ckfree((char *) info);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleDeleteProc --
 *
 *	If the console command is deleted we destroy the console window and
 *	all associated data structures.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A new console it created.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleDeleteProc(
    ClientData clientData)
{
    ConsoleInfo *info = clientData;

    if (info->consoleInterp) {
	Tcl_DeleteInterp(info->consoleInterp);
    }
    if (--info->refCount <= 0) {
	ckfree((char *) info);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleEventProc --
 *
 *	This event function is registered on the main window of the slave
 *	interpreter. If the user or a running script causes the main window to
 *	be destroyed, then we need to inform the console interpreter by
 *	invoking "::tk::ConsoleExit".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invokes the "::tk::ConsoleExit" command in the console interp.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleEventProc(
    ClientData clientData,
    XEvent *eventPtr)
{
    if (eventPtr->type == DestroyNotify) {
	ConsoleInfo *info = clientData;
	Tcl_Interp *consoleInterp = info->consoleInterp;

	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	    Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
	}

	if (--info->refCount <= 0) {
	    ckfree((char *) info);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
@


1.40
log
@SMALL FIX: Remove useless explicit casts now that we require C89 or later.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.39 2009/09/07 07:29:03 das Exp $
d69 1
a69 1
static Tcl_ChannelType consoleChannelType = {
d86 1
@


1.39
log
@	* generic/tkFocus.c:	fix potential null dereference flagged by clang
	* generic/tkMenu.c:	static analyzer.
	* generic/tkTextBTree.c:
	* generic/tkTextDisp.c:
	* generic/tkTextIndex.c:

	* generic/tkConsole.c:	silence false positives from clang static
	* generic/tkTest.c:	analyzer about potential null dereference.
	* generic/tkText.c:
	* generic/tkTextBTree.c:
	* generic/tkTextTag.c:
	* generic/tkVisual.c:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.38 2008/10/17 23:18:37 nijtmans Exp $
d676 2
a677 1
    static const char *const options[] = {"eval", "hide", "show", "title", NULL};
d680 1
a680 1
    ConsoleInfo *info = (ConsoleInfo *) clientData;
@


1.38
log
@Add "const" to many internal
const tables, so those will be
put by the C-compiler in the
TEXT segment in stead of the
DATA segment. This makes those
table sharable in shared libraries.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.37 2008/04/27 22:38:56 dkf Exp $
d16 1
a16 1
#include "tk.h"
d723 2
@


1.37
log
@Get rid of pre-C89-isms (esp. CONST vs const).
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.36 2008/04/01 16:30:52 dgp Exp $
d117 1
a117 1
    char *bufMode;
d676 1
a676 1
    static const char *options[] = {"eval", "hide", "show", "title", NULL};
d763 1
a763 1
    static const char *options[] = {"eval", "record", NULL};
@


1.36
log
@        * README:               Bump version number to 8.6a0
        * generic/tk.h:
        * library/tk.tcl:
        * macosx/Wish-Common.xcconfig:
        * unix/configure.in:
        * unix/tk.spec:
        * win/README:
        * win/configure.in:
        * win/tcl.m4:

        * unix/configure:       autoconf-2.59
        * win/configure:

        * generic/tkConsole.c:  Relax Tcl_InitStubs() calls so that a Tk 8.6
        * generic/tkMain.c:     might [load] into a Tcl 8.5 interp.
        * generic/tkWindow.c:

        * generic/tkStubLib.c:  Update to compatibility with a libtcl.so
        that contains no "tclStubsPtr" [Tcl Bug 1819422].

        * generic/tkDecls.h:            make genstubs
        * generic/tkIntDecls.h:
        * generic/tkIntPlatDecls.h:
        * generic/tkIntXlibDecls.h:
        * generic/tkPlatDecls.h:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.35 2007/12/13 15:24:14 dgp Exp $
d51 4
a54 4
static int	ConsoleHandle(ClientData instanceData,
		    int direction, ClientData *handlePtr);
static int	ConsoleInput(ClientData instanceData,
		    char *buf, int toRead, int *errorCode);
d56 3
a58 3
		    int objc, Tcl_Obj *CONST objv[]);
static int	ConsoleOutput(ClientData instanceData,
		    CONST char *buf, int toWrite, int *errorCode);
d63 1
a63 1
		    int objc, Tcl_Obj *CONST objv[]);
d178 1
a178 1
	dcb.DCBlength = sizeof( DCB ) ;
d240 1
a240 1
    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
d242 4
a245 1
	/* We've already initialized console channels in this thread. */
d256 2
a257 2
	 * No std channels should be tied to the console;
	 * Thus, no need to create the console
d259 1
d264 2
a265 2
     * At least one std channel wants to be tied to the console,
     * so create the interp for it to live in.
d275 1
d280 1
a280 1
		(ClientData) data, TCL_READABLE);
d282 3
a284 6
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
d292 1
d297 1
a297 1
		(ClientData) data, TCL_WRITABLE);
d299 3
a301 6
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
d309 1
d314 1
a314 1
		(ClientData) data, TCL_WRITABLE);
d316 3
a318 6
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
d379 1
a379 1
	ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
d389 1
a389 1
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
d396 1
a396 1
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
d403 1
a403 1
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
d417 1
a417 1
    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info);
d419 1
a419 2
    Tcl_CreateThreadExitHandler(DeleteConsoleInterp,
	    (ClientData) consoleInterp);
d425 2
a426 2
    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd,
	    (ClientData) info, ConsoleDeleteProc);
d435 1
a435 1
	    (ClientData) info, NULL);
d440 1
a440 1
		ConsoleEventProc, (ClientData) info);
d444 1
a444 1
    Tcl_Preserve((ClientData) consoleInterp);
d451 1
a451 1
    Tcl_Release((ClientData) consoleInterp);
d457 1
a457 1
		    ConsoleEventProc, (ClientData) info);
d466 1
a466 1
    error:
d495 1
a495 1
    CONST char *buf,		/* The data buffer. */
d499 1
a499 1
    ChannelData *data = (ChannelData *)instanceData;
d510 1
d518 2
a519 1
	    Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite));
d578 1
a578 1
    ChannelData *data = (ChannelData *)instanceData;
d583 4
a586 1
	    /* Assuming the Tcl_Interp * fields must already be NULL */
d673 1
a673 1
    Tcl_Obj *CONST objv[])	/* Argument objects */
d676 1
a676 1
    static CONST char *options[] = {"eval", "hide", "show", "title", NULL};
d727 1
a727 1
	Tcl_Preserve((ClientData) consoleInterp);
d732 1
a732 1
	Tcl_Release((ClientData) consoleInterp);
d760 1
a760 1
    Tcl_Obj *CONST objv[])	/* Argument objects */
d763 1
a763 1
    static CONST char *options[] = {"eval", "record", NULL};
d765 1
a765 1
    ConsoleInfo *info = (ConsoleInfo *) clientData;
d787 1
a787 1
    Tcl_Preserve((ClientData) otherInterp);
d791 1
d795 1
d802 1
d804 3
a806 3
	 * By not setting result, we discard any exceptions or errors here
	 * and always return TCL_OK.  All the caller wants is the
	 * interp result to display, whether that's result or error message.
d808 1
d812 1
a812 1
    Tcl_Release((ClientData) otherInterp);
d821 2
a822 2
 *	Thread exit handler to destroy a console interp when the
 *	thread it lives in gets torn down.
d831 2
a832 1
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
d841 2
a842 2
 *	React when the interp in which the console is displayed is deleted
 *	for any reason.
d858 1
a858 1
    ConsoleInfo *info = (ConsoleInfo *) clientData;
d861 1
a861 2
	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
		(ClientData) info->consoleInterp);
d890 1
a890 1
    ConsoleInfo *info = (ConsoleInfo *) clientData;
d925 1
a925 1
	ConsoleInfo *info = (ConsoleInfo *) clientData;
@


1.35
log
@merge stable branch onto HEAD
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.31.2.2 2007/09/17 15:22:00 dgp Exp $
d232 1
a232 1
     * Ensure that we are getting the matching version of Tcl. This is really
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
@


1.35.2.1
log
@        * generic/tkConsole.c:  Relax the runtime version requirements on Tcl
        * generic/tkMain.c:     so that Tk 8.5.8 can [load] into Tcl 8.6 (and
        * generic/tkWindow.c:   later 8.*) interps.
        * library/tk.tcl
        * unix/Makefile.in:
        * win/Makefile.in:
        * win/makefile.vc:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.35 2007/12/13 15:24:14 dgp Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
@


1.34
log
@        * generic/tkConsole.c:  Revised callers of Tcl_InitStubs() to account
        * generic/tkMain.c:     for restored compatible support for the call
        * generic/tkWindow.c:   Tcl_InitStubs(interp, TCL_VERSION, 1).  Also
        revised Tcl_PkgRequire() call for Tcl so that, for example, a Tk
        library built against Tcl 8.5.1 headers will not refuse to [load]
        into a Tcl 8.5.0 interpreter.  [Tcl Bug 1578344].

        * generic/tk.h:         Revised Tk_InitStubs() to restore Tk 8.4
        * generic/tkStubLib.c:  source compatibility with callers of
        * generic/tkWindow.c:   Tk_InitStubs(interp, TK_VERSION, 1).
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.33 2007/09/11 17:46:41 dgp Exp $
@


1.33
log
@        * generic/tkConsole.c:  Revised calls to Tcl_InitStubs() and
        * generic/tkMain.c:     [package require Tcl] so that Tk Says What
        * generic/tkWindow.c:   It Means using the new facilties of [package]
        * library/tk.tcl:       in Tcl 8.5 about what version(s) of Tcl it
        * unix/Makefile.in:     is willing to work with.  [Bug 1578344].
        * win/Makefile.in:
        * win/makefile.vc:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.32 2007/09/10 13:35:42 dgp Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
@


1.32
log
@        * generic/tkConsole.c:  Revise all Tcl_InitStubs() calls to restore
        * generic/tkMain.c:     the traditional practice that a Tk shared
        * generic/tkWindow.c:   library may [load] into a Tcl 8.5 interp at
        any patchlevel.  This practice also matches the compile time checks
        of TCL_MAJOR_VERSION and TCL_MINOR_VERSION in tk.h.  [Bug 1723622]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.31 2006/09/22 19:02:07 andreas_kupries Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
@


1.31
log
@
	* generic/tkConsole.c: TIP #268 update regarding registered package
	* generic/tkMain.c:    version, now using full patchlevel instead of
	* generic/tkWindow.c:  major.minor
	* library/tk.tcl:
	* unix/configure:
	* unix/Makefile.in:
	* unix/tcl.m4:
	* win/configure:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/rules.vc:
	* win/tcl.m4:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.30 2006/06/01 17:19:30 dgp Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 1) == NULL) {
@


1.31.2.1
log
@merge updates from HEAD
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.31 2006/09/22 19:02:07 andreas_kupries Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == NULL) {
@


1.31.2.2
log
@merge updates from HEAD
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.31.2.1 2007/09/11 18:32:35 dgp Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
@


1.30
log
@        * generic/tkConsole.c:  Added Tcl_RegisterChannel() calls to bump
        the refcount of channels passed to Tcl_SetStdChannel().  This prevents
        early free-ing of the channels that leads to crashes.  [Bug 912571].
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.29 2006/03/21 03:01:27 dgp Exp $
d236 1
a236 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
@


1.29
log
@        * generic/tkConsole.c:  Added exit handler to clean up the interp
        where the console window lives.  Also added code to handle
        multiple calls to Tk_CreateConsoleWindow so that the console
        channels connect to the last console window opened, in compatibility
        with the previous implementation.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.28 2006/03/20 22:58:46 dgp Exp $
d71 1
a71 1
    NULL,			/* Always non-blocking.*/
d80 6
d285 1
d304 1
d323 1
@


1.28
log
@        * generic/tkConsole.c:  Added exit handler to clean up the interp
        where the console window lives.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.27 2006/03/16 22:51:15 dgp Exp $
d375 26
a400 7
	    /*
	     * TODO: The console channels are already connected to a console
	     * window.  Move channels to this new one, but leave the old one
	     * functioning.
	     */


@


1.27
log
@corrected silly cut/paste/forget to modify error in the name of the
stderr console channel.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.26 2006/03/16 22:47:52 dgp Exp $
d60 1
d204 2
a205 2
 * 	All I/O will be discarded until TkConsoleInit is called to attach the
 * 	console to a text widget.
a390 2
    /* TODO: establish exit handler for cleanup */

d393 2
d785 19
d826 2
@


1.26
log
@Revisions to Tk_CreateConsoleWindow to tolerate case when no console channels
have been created.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.25 2006/03/16 17:32:27 dgp Exp $
d303 1
a303 1
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
@


1.25
log
@        * generic/tkConsole.c:  Substantial rewrite of [console] support.
        * generic/tkInt.h:      Included Obj-ification of the [console] and
        [consoleinterp] commands, and reworking of all the supporting data
        structures for cleaner sharing and lifetime management especially
        in multi-threaded configurations.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.24 2005/11/11 23:51:27 dkf Exp $
a339 1
    ChannelData *data;
a340 1
    Tcl_Interp *consoleInterp = NULL;
d344 10
d357 1
a357 1
     * console channel.  If none is, we're here by mistake!
d367 1
a367 3
	/* TODO: consider creating window anyway */
	Tcl_SetObjResult(interp, Tcl_NewStringObj("no console channels", -1));
	goto error;
d370 9
a378 18
    data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
    info = data->info;

    /*
     * Initialized Tcl and Tk.
     */

    consoleInterp = Tcl_CreateInterp();
    if (Tcl_Init(consoleInterp) != TCL_OK) {
	goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
	goto error;
    }

    if (info->consoleInterp) {
	/* The console channels are already connected to a console window.
	 * Move channels to this new one, but leave the old one functioning. */
d381 4
d442 1
a442 1
    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
@


1.24
log
@More bits of ANSIfying
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.23 2005/06/23 22:07:46 das Exp $
a16 3
#include <string.h>

#include "tkInt.h"
d19 5
a23 3
 * A data structure of the following type holds information for each console
 * which a handler (i.e. a Tcl command) has been defined for a particular
 * top-level window.
d27 3
a29 2
    Tcl_Interp *consoleInterp;	/* Interpreter for the console. */
    Tcl_Interp *interp;		/* Interpreter to send console commands. */
d33 4
a36 4
 * Each interpreter with a console attached stores a reference to the
 * interpreter's ConsoleInfo in the interpreter's AssocData store. The
 * alternative is to look the values up by examining the "console" command and
 * that is fragile. [Bug 1016385]
d39 4
a42 7
#define TK_CONSOLE_INFO_KEY	"tk::ConsoleInfo"

typedef struct ThreadSpecificData {
    Tcl_Interp *gStdoutInterp;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
static int consoleInitialized = 0;
d45 1
a45 1
 * The Mutex below is used to lock access to the consoleIntialized flag
d48 1
a48 10
TCL_DECLARE_MUTEX(consoleMutex)

/*
 * Forward declarations for functions defined later in this file:
 *
 * The first three will be used in the tk app shells...
 */

static int	ConsoleCmd(ClientData clientData,
		    Tcl_Interp *interp, int argc, CONST char **argv);
d51 2
a52 3
static int	InterpreterCmd(ClientData clientData,
		    Tcl_Interp *interp, int argc, CONST char **argv);

d55 2
a58 1
static int	ConsoleClose(ClientData instanceData, Tcl_Interp *interp);
d60 3
a62 2
static int	ConsoleHandle(ClientData instanceData,
		    int direction, ClientData *handlePtr);
d219 3
d233 6
a238 2
    Tcl_MutexLock(&consoleMutex);
    if (!consoleInitialized) {
d240 3
a242 1
	consoleInitialized = 1;
d244 1
d246 2
a247 10
	 * check for STDIN, otherwise create it
	 *
	 * Don't do this check on the Mac, because it is hard to prevent
	 * callbacks from the SIOUX layer from opening stdout & stdin, but we
	 * don't want to use the SIOUX console. Since the console is not
	 * actually created till something is written to the channel, it is
	 * okay to just ignore it here.
	 *
	 * This is still a bit of a hack, however, and should be cleaned up
	 * when we have a better abstraction for the console.
d249 2
d252 4
a255 13
	if (ShouldUseConsoleChannel(TCL_STDIN)) {
	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
		    (ClientData) TCL_STDIN, TCL_READABLE);
	    if (consoleChannel != NULL) {
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-translation", "lf");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-buffering", "none");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-encoding", "utf-8");
	    }
	    Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
	}
d257 4
a260 3
	/*
	 * check for STDOUT, otherwise create it
	 */
d262 14
a275 12
	if (ShouldUseConsoleChannel(TCL_STDOUT)) {
	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
		    (ClientData) TCL_STDOUT, TCL_WRITABLE);
	    if (consoleChannel != NULL) {
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-translation", "lf");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-buffering", "none");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-encoding", "utf-8");
	    }
	    Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
d277 2
d280 17
a296 3
	/*
	 * check for STDERR, otherwise create it
	 */
d298 14
a311 12
	if (ShouldUseConsoleChannel(TCL_STDERR)) {
	    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
		    (ClientData) TCL_STDERR, TCL_WRITABLE);
	    if (consoleChannel != NULL) {
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-translation", "lf");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-buffering", "none");
		Tcl_SetChannelOption(NULL, consoleChannel,
			"-encoding", "utf-8");
	    }
	    Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
d313 1
a314 1
    Tcl_MutexUnlock(&consoleMutex);
d339 2
a340 1
    Tcl_Interp *consoleInterp;
d342 9
a350 4
    Tk_Window mainWindow = Tk_MainWindow(interp);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    static const char *initCmd = "source $tk_library/console.tcl";
d352 9
a360 2
    consoleInterp = Tcl_CreateInterp();
    if (consoleInterp == NULL) {
d364 3
d371 1
d378 15
a392 1
    tsdPtr->gStdoutInterp = interp;
d398 10
a407 6
    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
    info->interp = interp;
    info->consoleInterp = consoleInterp;
    Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
	    (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
    Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
a408 1
    Tcl_SetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL, (ClientData) info);
d410 6
a415 2
    Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
	    (ClientData) info);
d418 5
a422 5
    if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
	/*
	 * goto error; -- no problem for now...
	 */
	printf("Eval error: %s", consoleInterp->result);
d425 12
d439 4
a442 3
  error:
    if (consoleInterp != NULL) {
    	Tcl_DeleteInterp(consoleInterp);
d472 2
a473 2
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
d478 17
a494 3
    if (tsdPtr->gStdoutInterp != NULL) {
	TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf,
                toWrite);
a495 1

d549 10
a558 3
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    tsdPtr->gStdoutInterp = NULL;
d622 1
a622 1
 * ConsoleCmd --
d628 1
a628 1
 *	None.
d631 1
a631 1
 *	None.
d637 10
a646 6
ConsoleCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
d648 8
a655 8
    char c;
    size_t length;
    int result;
    Tcl_Interp *consoleInterp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", NULL);
d659 33
a691 5
    c = argv[1][0];
    length = strlen(argv[1]);
    result = TCL_OK;
    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);
d693 8
a700 24
    if ((c == 't') && (strncmp(argv[1], "title", length)) == 0) {
	Tcl_DString dString;

	Tcl_DStringInit(&dString);
	Tcl_DStringAppend(&dString, "wm title . ", -1);
	if (argc == 3) {
	    Tcl_DStringAppendElement(&dString, argv[2]);
	}
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	Tcl_DStringFree(&dString);
    } else if ((c == 'h') && (strncmp(argv[1], "hide", length)) == 0) {
	Tcl_Eval(consoleInterp, "wm withdraw .");
    } else if ((c == 's') && (strncmp(argv[1], "show", length)) == 0) {
	Tcl_Eval(consoleInterp, "wm deiconify .");
    } else if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
	if (argc == 3) {
	    result = Tcl_Eval(consoleInterp, argv[2]);
	    Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
		    NULL);
	} else {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " eval command\"", NULL);
	    result = TCL_ERROR;
	}
d702 2
a703 3
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be hide, show, or title", NULL);
        result = TCL_ERROR;
d705 1
a705 1
    Tcl_Release((ClientData) consoleInterp);
d712 1
a712 1
 * InterpreterCmd --
d718 1
a718 4
 *	None.
 *
 * Side effects:
 *	None.
d724 9
a732 6
InterpreterCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
d734 18
a751 9
    char c;
    size_t length;
    int result;
    Tcl_Interp *consoleInterp;
    Tcl_Interp *otherInterp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg arg ...?\"", NULL);
a754 5
    c = argv[1][0];
    length = strlen(argv[1]);
    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);
    otherInterp = info->interp;
d756 19
a774 12
    if ((c == 'e') && (strncmp(argv[1], "eval", length)) == 0) {
   	result = Tcl_GlobalEval(otherInterp, argv[2]);
    	Tcl_AppendResult(interp, otherInterp->result, NULL);
    } else if ((c == 'r') && (strncmp(argv[1], "record", length)) == 0) {
   	Tcl_RecordAndEval(otherInterp, argv[2], TCL_EVAL_GLOBAL);
	result = TCL_OK;
	Tcl_ResetResult(interp);
    	Tcl_AppendResult(interp, otherInterp->result, NULL);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": should be eval or record", NULL);
	result = TCL_ERROR;
a776 1
    Tcl_Release((ClientData) consoleInterp);
d783 1
a783 1
 * ConsoleDeleteProc --
d785 2
a786 2
 *	If the console command is deleted we destroy the console window and
 *	all associated data structures.
d798 3
a800 2
ConsoleDeleteProc(
    ClientData clientData)
a802 2
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
d804 5
a808 8
    /*
     * Also need to null this out to prevent any further use.
     *
     * Fix [Bug #756840]
     */

    if (tsdPtr != NULL) {
        tsdPtr->gStdoutInterp = NULL;
a809 3

    Tcl_DeleteInterp(info->consoleInterp);
    info->consoleInterp = NULL;
d815 1
a815 1
 * ConsoleEventProc --
d817 2
a818 4
 *	This event function is registered on the main window of the slave
 *	interpreter. If the user or a running script causes the main window to
 *	be destroyed, then we need to inform the console interpreter by
 *	invoking "::tk::ConsoleExit".
d824 1
a824 1
 *	Invokes the "::tk::ConsoleExit" command in the console interp.
d830 2
a831 3
ConsoleEventProc(
    ClientData clientData,
    XEvent *eventPtr)
a833 1
    Tcl_Interp *consoleInterp;
d835 5
a839 17
    if (eventPtr->type == DestroyNotify) {
 	consoleInterp = info->consoleInterp;

        /*
         * It is possible that the console interpreter itself has already been
         * deleted. In that case the consoleInterp field will be set to
         * NULL. If the interpreter is already gone, we do not have to do any
         * work here.
         */

        if (consoleInterp == NULL) {
            return;
        }

	Tcl_Preserve((ClientData) consoleInterp);
	Tcl_Eval(consoleInterp, "::tk::ConsoleExit");
	Tcl_Release((ClientData) consoleInterp);
d846 1
a846 1
 * TkConsolePrint --
d848 4
a851 3
 *	Prints to the give text to the console. Given the main interp this
 *	functions find the appropiate console interp and forwards the text to
 *	be added to that console.
d857 1
a857 1
 *	None.
d862 4
a865 7
void
TkConsolePrint(
    Tcl_Interp *interp,		/* Main interpreter. */
    int devId,			/* TCL_STDOUT for stdout, TCL_STDERR for
                                 * stderr. */
    CONST char *buffer,		/* Text buffer. */
    long size)			/* Size of text buffer. */
d867 3
a869 3
    Tcl_DString command, output;
    ConsoleInfo *info;
    Tcl_Interp *consoleInterp;
d871 3
a873 3
    if (interp == NULL) {
	return;
    }
d875 3
a877 10
    info = (ConsoleInfo *) Tcl_GetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL);
    if (info == NULL || info->consoleInterp == NULL) {
	return;
    }

    Tcl_DStringInit(&command);
    if (devId == TCL_STDERR) {
	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stderr ", -1);
    } else {
	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stdout ", -1);
a878 12

    Tcl_DStringInit(&output);
    Tcl_DStringAppend(&output, buffer, size);
    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&output));
    Tcl_DStringFree(&output);

    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);
    Tcl_Eval(consoleInterp, Tcl_DStringValue(&command));
    Tcl_Release((ClientData) consoleInterp);

    Tcl_DStringFree(&command);
@


1.23
log
@	* generic/tkConsole.c (TkConsolePrint): prevent potential NULL deref.
@
text
@d1 1
a1 1
/* 
d4 3
a6 3
 *	This file implements a Tcl console for systems that may not
 *	otherwise have access to a console.  It uses the Text widget
 *	and provides special access via a console command.
d10 2
a11 2
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.22 2005/03/19 08:02:57 dkf Exp $
d35 2
a36 2
 * alternative is to look the values up by examining the "console"
 * command and that is fragile. [Bug 1016385]
d47 1
a47 1
/* 
d54 1
a54 1
 * Forward declarations for procedures defined later in this file:
d58 16
a73 19
 
static int	ConsoleCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int argc, CONST char **argv));
static void	ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
static void	ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
		    XEvent *eventPtr));
static int	InterpreterCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int argc, CONST char **argv));

static int	ConsoleInput _ANSI_ARGS_((ClientData instanceData,
		    char *buf, int toRead, int *errorCode));
static int	ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
		    CONST char *buf, int toWrite, int *errorCode));
static int	ConsoleClose _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp));
static void	ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
		    int mask));
static int	ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
		    int direction, ClientData *handlePtr));
a90 1

a92 1

d100 2
a101 2
 * 	Check to see if console window should be used for a given
 *      standard channel
d107 1
a107 2
 *	Creates the console channel and installs it as the standard
 *	channels.
d111 4
a114 2
static int ShouldUseConsoleChannel(type)
    int type;
d125 18
a142 18
	case TCL_STDIN:
	    handleId = STD_INPUT_HANDLE;
	    mode = TCL_READABLE;
	    bufMode = "line";
	    break;
	case TCL_STDOUT:
	    handleId = STD_OUTPUT_HANDLE;
	    mode = TCL_WRITABLE;
	    bufMode = "line";
	    break;
	case TCL_STDERR:
	    handleId = STD_ERROR_HANDLE;
	    mode = TCL_WRITABLE;
	    bufMode = "none";
	    break;
	default:
	    return 0;
	    break;
d150 1
a150 1
     * handle. 
d158 5
a162 5
     * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
     * to be a valid handle.  See TclpGetDefaultStdChannel() for this change
     * implemented.  We didn't change it here because GetFileType() [below]
     * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
     * value of 1, anyways.
d168 2
a169 2
     *	    && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
     *	return 1;
d176 3
a178 3
     * If the file is a character device, we need to try to figure out
     * whether it is a serial port, a console, or something else.  We
     * test for the console case first because this is more common.
d186 2
a187 2
	     * Don't use a CHAR type channel for stdio, otherwise Tk
	     * runs into trouble with the MS DevStudio debugger.
d189 1
a189 1
	    
d213 3
a215 3
 * 	Create the console channels and install them as the standard
 * 	channels.  All I/O will be discarded until TkConsoleInit is
 * 	called to attach the console to a text widget.
d221 1
a221 2
 *	Creates the console channel and installs it as the standard
 *	channels.
d227 2
a228 2
Tk_InitConsoleChannels(interp)
    Tcl_Interp *interp;
d233 2
a234 2
     * Ensure that we are getting the matching version of Tcl.  This is
     * really only an issue when Tk is loaded dynamically.
d245 1
a245 1
	
d250 2
a251 2
	 * callbacks from the SIOUX layer from opening stdout & stdin, but
	 * we don't want to use the SIOUX console.  Since the console is not
d276 1
a276 1
	
d290 1
a290 1
	
d294 1
a294 1
	
d317 3
a319 3
 *	Initialize the console.  This code actually creates a new
 *	application and associated interpreter.  This effectivly hides
 *	the implementation from the main application.
d330 3
a332 3
int 
Tk_CreateConsoleWindow(interp)
    Tcl_Interp *interp;			/* Interpreter to use for prompting. */
d337 1
a337 1
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
d345 1
a345 1
    
d357 3
a359 3
    
    /* 
     * Add console commands to the interp 
d361 1
d368 1
a368 1
	    (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
d376 3
a378 1
	/* goto error; -- no problem for now... */
d383 2
a384 2
    
    error:
d396 2
a397 2
 *	Writes the given output on the IO channel. Returns count of how
 *	many characters were actually written, and an error indication.
d400 2
a401 2
 *	A count of how many characters were written is returned and an
 *	error indication is returned in an output argument.
d410 5
a414 5
ConsoleOutput(instanceData, buf, toWrite, errorCode)
    ClientData instanceData;		/* Indicates which device to use. */
    CONST char *buf;			/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCode;			/* Where to store error code. */
d416 1
a416 1
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
d423 1
a423 1
	TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, 
d426 1
a426 1
    
d435 1
a435 1
 *	Read input from the console.  Not currently implemented.
d448 6
a453 6
ConsoleInput(instanceData, buf, bufSize, errorCode)
    ClientData instanceData;		/* Unused. */
    char *buf;				/* Where to store data read. */
    int bufSize;			/* How much space is available
                                         * in the buffer? */
    int *errorCode;			/* Where to store error code. */
d476 3
a478 3
ConsoleClose(instanceData, interp)
    ClientData instanceData;	/* Unused. */
    Tcl_Interp *interp;		/* Unused. */
d480 1
a480 1
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
d491 3
a493 3
 *	Called by the notifier to set up the console device so that
 *	events will be noticed. Since there are no events on the
 *	console, this routine just returns without doing anything.
d506 5
a510 6
ConsoleWatch(instanceData, mask)
    ClientData instanceData;		/* Device ID for the channel. */
    int mask;				/* OR-ed combination of
                                         * TCL_READABLE, TCL_WRITABLE and
                                         * TCL_EXCEPTION, for the events
                                         * we are interested in. */
d520 1
a520 2
 *	Because console channels are not devices, this function always
 *	fails.
d533 3
a535 3
ConsoleHandle(instanceData, direction, handlePtr)
    ClientData instanceData;	/* Device ID for the channel. */
    int direction;		/* TCL_READABLE or TCL_WRITABLE to indicate
d538 1
a538 1
    ClientData *handlePtr;	/* Where to store handle */
d561 5
a565 5
ConsoleCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    CONST char **argv;			/* Argument strings. */
d575 1
a575 1
		" option ?arg arg ...?\"", (char *) NULL);
d578 1
a578 1
    
d603 1
a603 1
		    (char *) NULL);
d606 1
a606 1
		    " eval command\"", (char *) NULL);
d611 1
a611 2
		"\": should be hide, show, or title",
		(char *) NULL);
d623 2
a624 2
 *	This command allows the console interp to communicate with the
 *	main interpreter.
d636 5
a640 5
InterpreterCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Not used. */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    CONST char **argv;			/* Argument strings. */
d651 1
a651 1
		" option ?arg arg ...?\"", (char *) NULL);
d654 1
a654 1
    
d663 1
a663 1
    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
d668 1
a668 1
    	Tcl_AppendResult(interp, otherInterp->result, (char *) NULL);
d671 1
a671 2
		"\": should be eval or record",
		(char *) NULL);
d684 2
a685 2
 *	If the console command is deleted we destroy the console window
 *	and all associated data structures.
d697 2
a698 2
ConsoleDeleteProc(clientData) 
    ClientData clientData;
d709 1
d723 4
a726 4
 *	This event procedure is registered on the main window of the
 *	slave interpreter.  If the user or a running script causes the
 *	main window to be destroyed, then we need to inform the console
 *	interpreter by invoking "::tk::ConsoleExit".
d732 1
a732 1
 *	Invokes the "::tk::ConsoleExit" procedure in the console interp.
d738 3
a740 3
ConsoleEventProc(clientData, eventPtr)
    ClientData clientData;
    XEvent *eventPtr;
d744 1
a744 1
    
a745 1

d749 4
a752 4
         * It is possible that the console interpreter itself has
         * already been deleted. In that case the consoleInterp
         * field will be set to NULL. If the interpreter is already
         * gone, we do not have to do any work here.
d754 2
a755 2
        
        if (consoleInterp == (Tcl_Interp *) NULL) {
d757 5
a761 5
        } else {
	    Tcl_Preserve((ClientData) consoleInterp);
	    Tcl_Eval(consoleInterp, "::tk::ConsoleExit");
	    Tcl_Release((ClientData) consoleInterp);
	}
d770 3
a772 3
 *	Prints to the give text to the console.  Given the main interp
 *	this functions find the appropiate console interp and forwards
 *	the text to be added to that console.
d784 3
a786 3
TkConsolePrint(interp, devId, buffer, size)
    Tcl_Interp *interp;		/* Main interpreter. */
    int devId;			/* TCL_STDOUT for stdout, TCL_STDERR for
d788 2
a789 2
    CONST char *buffer;		/* Text buffer. */
    long size;			/* Size of text buffer. */
d823 8
@


1.22
log
@Use Tcl_Set/GetAssocData to remove use of fragile Tcl_GetCommandInfo
from TkConsolePrint. [Bug 1016385]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.21 2004/06/26 09:04:15 mistachkin Exp $
d806 1
a806 1
    if (info->consoleInterp == NULL) {
@


1.21
log
@Fix for [Bug 756840]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.20 2004/03/17 18:15:43 das Exp $
d32 9
d344 2
a345 2
    static char initCmd[] = "source $tk_library/console.tcl";
    
d373 1
a575 1
    Tcl_DString dString;
a587 1
    Tcl_DStringInit(&dString);
d590 3
d598 1
d600 1
a600 2
	Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
d602 1
a602 2
	Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
a618 1
    Tcl_DStringFree(&dString);
a763 2
	    Tcl_DString dString;
	    Tcl_DStringInit(&dString);
d765 1
a765 3
	    Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
	    Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	    Tcl_DStringFree(&dString);
a797 2
    Tcl_CmdInfo cmdInfo;
    char *cmd;
a799 1
    int result;
d804 7
a810 1
    
d812 1
a812 1
	cmd = "::tk::ConsoleOutput stderr ";
d814 1
a814 1
	cmd = "::tk::ConsoleOutput stdout ";
d816 1
a816 7
    
    result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
    if (result == 0) {
	return;
    }
    info = (ConsoleInfo *) cmdInfo.clientData;
    
d819 2
a820 4

    Tcl_DStringInit(&command);
    Tcl_DStringAppend(&command, cmd, (int) strlen(cmd));
    Tcl_DStringAppendElement(&command, output.string);
d824 1
a824 1
    Tcl_Eval(consoleInterp, command.string);
d826 1
a826 1
    
a827 1
    Tcl_DStringFree(&output);
@


1.20
log
@Removed support for Mac OS Classic platform [Patch 918139]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.19 2003/09/20 03:43:29 chengyemao Exp $
d642 1
d653 2
d672 1
d698 11
@


1.19
log
@Fixed memory leak (bug 802435)
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18 2002/08/05 04:30:38 dgp Exp $
a334 3
#ifdef MAC_TCL
    static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
#else
a335 1
#endif
@


1.18
log
@Applied companion patch for Tcl Patch 585105,
updating Tk to use Tcl 8.4's fully CONST-ified
interface, and fully CONSTifying Tk at the
same time.

This patch includes purging Tk of its last
direct access to interp->result.  [Bug 589853]

The substantial changes include copying
event sequence strings into Tcl_DStrings
in tkBind.c, and copying [text] indices into
Tcl_DStrings because parsing them involved
overwriting them.  If this causes performance
trouble, that can be resolved by further
converting them to Tcl_Obj's.

The #defines USE_NON_CONST and USE_COMPAT_CONST
have the same effect for Tk as they do for Tcl.
(They actually change tcl.h)
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.17 2002/04/12 06:51:50 hobbs Exp $
a728 1
    Tcl_DString dString;
d732 1
a732 3
	Tcl_DStringInit(&dString);
  
	consoleInterp = info->consoleInterp;
d743 9
a751 6
        }
        Tcl_Preserve((ClientData) consoleInterp);
	Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	Tcl_DStringFree(&dString);
        Tcl_Release((ClientData) consoleInterp);
@


1.18.2.1
log
@Backported [console] rename fix. [Bug 1016385]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18 2002/08/05 04:30:38 dgp Exp $
a31 9
/*
 * Each interpreter with a console attached stores a reference to the
 * interpreter's ConsoleInfo in the interpreter's AssocData store. The
 * alternative is to look the values up by examining the "console"
 * command and that is fragile. [Bug 1016385]
 */

#define TK_CONSOLE_INFO_KEY   "tk::ConsoleInfo"

d336 1
a336 1
    static const char *initCmd = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
d338 1
a338 1
    static const char *initCmd = "source $tk_library/console.tcl";
a367 1
    Tcl_SetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL, (ClientData) info);
d570 1
d583 1
a585 3
	Tcl_DString dString;

	Tcl_DStringInit(&dString);
a590 1
	Tcl_DStringFree(&dString);
d592 2
a593 1
	Tcl_Eval(consoleInterp, "wm withdraw . ");
d595 2
a596 1
	Tcl_Eval(consoleInterp, "wm deiconify . ");
d613 1
d729 1
d732 3
d744 8
a751 5
        if (consoleInterp != (Tcl_Interp *) NULL) {
	    Tcl_Preserve((ClientData) consoleInterp);
	    Tcl_Eval(consoleInterp, "::tk::ConsoleExit");
	    Tcl_Release((ClientData) consoleInterp);
	}
d782 2
d786 1
d791 1
a791 7

    info = (ConsoleInfo *) Tcl_GetAssocData(interp, TK_CONSOLE_INFO_KEY, NULL);
    if (info->consoleInterp == NULL) {
	return;
    }

    Tcl_DStringInit(&command);
d793 1
a793 1
	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stderr ", -1);
d795 6
a800 1
	Tcl_DStringAppend(&command, "::tk::ConsoleOutput stdout ", -1);
d802 2
a803 1

d806 4
a809 2
    Tcl_DStringAppendElement(&command, Tcl_DStringValue(&output));
    Tcl_DStringFree(&output);
d813 1
a813 1
    Tcl_Eval(consoleInterp, Tcl_DStringValue(&command));
d815 1
a815 1

d817 1
@


1.18.2.2
log
@	* generic/tkConsole.c: backport fix for bug 756840 & sync whitespace
	changes from HEAD.

	* generic/tkConsole.c (TkConsolePrint): prevent potential NULL deref.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18.2.1 2005/06/03 15:25:01 dkf Exp $
d39 1
a39 1
#define TK_CONSOLE_INFO_KEY	"tk::ConsoleInfo"
d349 1
a349 1

d604 1
a604 1
	Tcl_Eval(consoleInterp, "wm withdraw .");
d606 1
a606 1
	Tcl_Eval(consoleInterp, "wm deiconify .");
a654 1
    Tcl_Interp *consoleInterp;
a664 2
    consoleInterp = info->consoleInterp;
    Tcl_Preserve((ClientData) consoleInterp);
a681 1
    Tcl_Release((ClientData) consoleInterp);
a706 11
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    /*
     * Also need to null this out to prevent any further use.
     *
     * Fix [Bug #756840]
     */
    if (tsdPtr != NULL) {
        tsdPtr->gStdoutInterp = NULL;
    }
d740 1
a740 2

 	consoleInterp = info->consoleInterp;
d749 1
a749 3
        if (consoleInterp == (Tcl_Interp *) NULL) {
            return;
        } else {
d792 1
a792 1
    if (info == NULL || info->consoleInterp == NULL) {
@


1.18.2.3
log
@        * generic/tkConsole.c:  Added Tcl_RegisterChannel() calls to bump
        the refcount of channels passed to Tcl_SetStdChannel().  This prevents
        early free-ing of the channels that leads to crashes.  [Bug 912571].
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18.2.2 2005/06/23 22:07:13 das Exp $
d84 1
a84 1
    TCL_CHANNEL_VERSION_4,	/* v4 channel */
a92 6
    NULL,			/* close2proc. */
    NULL,			/* Always non-blocking.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,                       /* wide seek proc */
    NULL,                       /* thread action proc */
a275 1
	    Tcl_RegisterChannel(NULL, consoleChannel);
a293 1
	    Tcl_RegisterChannel(NULL, consoleChannel);
a311 1
	    Tcl_RegisterChannel(NULL, consoleChannel);
@


1.18.2.4
log
@        * generic/tkInt.h:      Thread safety for the data structures of
        * generic/tkConsole.c:  the wish [console].  [Bug 1188340].
@
text
@d13 1
a13 2
 * RCS: @@(#) $Id$
 *    
d17 3
d22 3
a24 5
 * Each console is associated with an instance of the ConsoleInfo struct.
 * It keeps track of what interp holds the Tk application that displays
 * the console, and what interp is controlled by the interactions in that
 * console.  A refCount permits the struct to be shared as instance data
 * by commands and by channels.
d28 2
a29 3
    Tcl_Interp *consoleInterp;        /* Interpreter displaying the console. */
    Tcl_Interp *interp;               /* Interpreter controlled by console. */
    int refCount;
d33 4
a36 4
 * Each console channel holds an instance of the ChannelData struct as
 * its instance data.  It contains ConsoleInfo, so the channel can work
 * with the appropriate console window, and a type value to distinguish
 * the stdout channel from the stderr channel.
d39 7
a45 4
typedef struct ChannelData {
    ConsoleInfo *info;
    int type;			/* TCL_STDOUT or TCL_STDERR */
} ChannelData;
d48 1
a48 1
 * Prototypes for local procedures defined in this file:
d51 10
a60 2
static int	ConsoleClose _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp));
d64 3
a66 2
static int	ConsoleHandle _ANSI_ARGS_((ClientData instandeData,
		    int direction, ClientData *handlePtr));
a68 2
static int	ConsoleObjCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
d71 2
d75 2
a76 5
static void	DeleteConsoleInterp _ANSI_ARGS_((ClientData clientData));
static void	InterpDeleteProc _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp));
static int	InterpreterObjCmd _ANSI_ARGS_((ClientData clientData,
		    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
d224 2
a225 2
 * 	channels.  All I/O will be discarded until Tk_CreateConsoleWindow
 *	is called to attach the console to a text widget.
a240 3
    static Tcl_ThreadDataKey consoleInitKey;
    int *consoleInitPtr, doIn, doOut, doErr;
    ConsoleInfo *info;
d252 2
a253 10
    consoleInitPtr = Tcl_GetThreadData(&consoleInitKey, (int)sizeof(int));
    if (*consoleInitPtr) {
	/* We've already initialized console channels in this thread. */
	return;
    }
    *consoleInitPtr = 1;

    doIn = ShouldUseConsoleChannel(TCL_STDIN);
    doOut = ShouldUseConsoleChannel(TCL_STDOUT);
    doErr = ShouldUseConsoleChannel(TCL_STDERR);
d255 2
a256 1
    if (!(doIn || doOut || doErr)) {
d258 10
a267 2
	 * No std channels should be tied to the console;
	 * Thus, no need to create the console
a268 2
	return;
    }
d270 13
a282 24
    /*
     * At least one std channel wants to be tied to the console,
     * so create the interp for it to live in.
     */

    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
    info->consoleInterp = NULL;
    info->interp = NULL;
    info->refCount = 0;

    if (doIn) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDIN;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
		(ClientData) data, TCL_READABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
a283 3
	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
	Tcl_RegisterChannel(NULL, consoleChannel);
    }
d285 17
a301 14
    if (doOut) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDOUT;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
		(ClientData) data, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
d303 18
a320 18
	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
	Tcl_RegisterChannel(NULL, consoleChannel);
    }

    if (doErr) {
	ChannelData *data = (ChannelData *) ckalloc(sizeof(ChannelData));
	data->info = info;
	data->info->refCount++;
	data->type = TCL_STDERR;
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
		(ClientData) data, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel,
		    "-encoding", "utf-8");
a321 2
	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
	Tcl_RegisterChannel(NULL, consoleChannel);
d323 1
d348 1
a348 1
    Tcl_Channel chan;
d350 3
a352 5
    Tk_Window mainWindow;
    Tcl_Command token;
    int result = TCL_OK;
    int haveConsoleChannel = 1;

d359 2
a360 6
    /* Init an interp with Tcl and Tk */
    Tcl_Interp *consoleInterp = Tcl_CreateInterp();
    if (Tcl_Init(consoleInterp) != TCL_OK) {
      goto error;
    }
    if (Tk_Init(consoleInterp) != TCL_OK) {
d365 1
a365 2
     * Fetch the instance data from whatever std channel is a
     * console channel.  If none, create fresh instance data.
d368 2
a369 8
    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
          == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
          == &consoleChannelType) {
    } else if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
          == &consoleChannelType) {
    } else {
	haveConsoleChannel = 0;
d371 2
a372 35

    if (haveConsoleChannel) {
	ChannelData *data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
	info = data->info;
	if (info->consoleInterp) {
	    /* New ConsoleInfo for a new console window */
	    info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	    info->refCount = 0;

	    /* Update any console channels to make use of the new console */
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDIN))
		    == &consoleChannelType) {
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDOUT))
		    == &consoleChannelType) {
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	    if (Tcl_GetChannelType(chan = Tcl_GetStdChannel(TCL_STDERR))
		    == &consoleChannelType) {
		data = (ChannelData *)Tcl_GetChannelInstanceData(chan);
		data->info->refCount--;
		data->info = info;
		data->info->refCount++;
	    }
	}
    } else {
	info = (ConsoleInfo *) ckalloc(sizeof(ConsoleInfo));
	info->refCount = 0;
d374 1
a374 8

    info->consoleInterp = consoleInterp;
    info->interp = interp;

    Tcl_CallWhenDeleted(consoleInterp, InterpDeleteProc, (ClientData) info);
    info->refCount++;
    Tcl_CreateThreadExitHandler(DeleteConsoleInterp,
	(ClientData) consoleInterp);
d379 8
d388 2
a389 18
    token = Tcl_CreateObjCommand(interp, "console", ConsoleObjCmd,
          (ClientData) info, ConsoleDeleteProc);
    info->refCount++;

    /*
     * We don't have to count the ref held by the [consoleinterp] command
     * in the consoleInterp.  The ref held by the consoleInterp delete
     * handler takes care of us.
     */
    Tcl_CreateObjCommand(consoleInterp, "consoleinterp", InterpreterObjCmd,
	    (ClientData) info, NULL);

    mainWindow = Tk_MainWindow(interp);
    if (mainWindow) {
	Tk_CreateEventHandler(mainWindow, StructureNotifyMask,
		ConsoleEventProc, (ClientData) info);
	info->refCount++;
    }
d392 3
a394 17
    result = Tcl_GlobalEval(consoleInterp, initCmd);
    if (result == TCL_ERROR) {
	Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode", NULL,
		TCL_GLOBAL_ONLY);
	Tcl_ResetResult(interp);
	if (objPtr) {
	    Tcl_SetObjErrorCode(interp, objPtr);
	}

	objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo", NULL,
		TCL_GLOBAL_ONLY);
	if (objPtr) {
	    int numBytes;
	    CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
	    Tcl_AddObjErrorInfo(interp, message, numBytes);
	}
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
a396 12
    if (result == TCL_ERROR) {
	Tcl_DeleteCommandFromToken(interp, token);
	mainWindow = Tk_MainWindow(interp);
	if (mainWindow) {
	    Tk_DeleteEventHandler(mainWindow, StructureNotifyMask,
		    ConsoleEventProc, (ClientData) info);
	    if (--info->refCount <= 0) {
		ckfree((char *) info);
	    }
	}
	goto error;
    }
d400 2
a401 3
    Tcl_AddErrorInfo(interp, "\n    (creating console window)");
    if (!Tcl_InterpDeleted(consoleInterp)) {
	Tcl_DeleteInterp(consoleInterp);
d431 2
a432 2
    ChannelData *data = (ChannelData *)instanceData;
    ConsoleInfo *info = data->info;
d437 3
a439 17
    if (info) {
	Tcl_Interp *consoleInterp = info->consoleInterp;

	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	    Tcl_Obj *cmd = Tcl_NewStringObj("tk::ConsoleOutput", -1);
	    if (data->type == TCL_STDERR) {
		Tcl_ListObjAppendElement(NULL, cmd,
			Tcl_NewStringObj("stderr", -1));
	    } else {
		Tcl_ListObjAppendElement(NULL, cmd,
			Tcl_NewStringObj("stdout", -1));
	    }
	    Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewStringObj(buf, toWrite));
	    Tcl_IncrRefCount(cmd);
	    Tcl_GlobalEvalObj(consoleInterp, cmd);
	    Tcl_DecrRefCount(cmd);
	}
d441 1
d495 3
a497 10
    ChannelData *data = (ChannelData *)instanceData;
    ConsoleInfo *info = data->info;

    if (info) {
	if (--info->refCount <= 0) {
	    /* Assuming the Tcl_Interp * fields must already be NULL */
	    ckfree((char *) info);
	}
    }
    ckfree((char *) data);
d563 1
a563 1
 * ConsoleObjCmd --
d569 1
a569 1
 *	A standard Tcl result.
d572 1
a572 1
 *	See the user documentation.
d578 6
a583 10
ConsoleObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Access to the console interp */
    Tcl_Interp *interp;			/* Current interpreter */
    int objc;				/* Number of arguments */
    Tcl_Obj *CONST objv[];		/* Argument objects */
{
    int index, result;
    static CONST char *options[] = {"eval", "hide", "show", "title", NULL};
    enum option {CON_EVAL, CON_HIDE, CON_SHOW, CON_TITLE};
    Tcl_Obj *cmd = NULL;
d585 8
a592 4
    Tcl_Interp *consoleInterp = info->consoleInterp;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
d595 6
a600 38
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
	    != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum option) index) {
    case CON_EVAL:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script");
	    return TCL_ERROR;
	}
	cmd = objv[2];
	break;
    case CON_HIDE:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm withdraw .", -1);
	break;
    case CON_SHOW:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm deiconify .", -1);
	break;
    case CON_TITLE:
	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?title?");
	    return TCL_ERROR;
	}
	cmd = Tcl_NewStringObj("wm title .", -1);
	if (objc == 3) {
	    Tcl_ListObjAppendElement(NULL, cmd, objv[2]);
	}
	break;
    }
d602 2
a603 11
    Tcl_IncrRefCount(cmd);
    if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	Tcl_Preserve((ClientData) consoleInterp);
	result = Tcl_GlobalEvalObj(consoleInterp, cmd);
	if (result == TCL_ERROR) {
	    Tcl_Obj *objPtr = Tcl_GetVar2Ex(consoleInterp, "errorCode",
		    NULL, TCL_GLOBAL_ONLY);
	    Tcl_ResetResult(interp);
	    if (objPtr) {
		Tcl_SetObjErrorCode(interp, objPtr);
	    }
d605 20
a624 7
	    objPtr = Tcl_GetVar2Ex(consoleInterp, "errorInfo",
		    NULL, TCL_GLOBAL_ONLY);
	    if (objPtr) {
		int numBytes;
		CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
		Tcl_AddObjErrorInfo(interp, message, numBytes);
	    }
a625 2
	Tcl_SetObjResult(interp, Tcl_GetObjResult(consoleInterp));
	Tcl_Release((ClientData) consoleInterp);
d627 4
a630 2
	Tcl_AppendResult(interp, "no active console interp", NULL);
	result = TCL_ERROR;
d632 1
a632 1
    Tcl_DecrRefCount(cmd);
d639 1
a639 1
 * InterpreterObjCmd --
d645 4
a648 1
 *	A standard Tcl result.
d654 6
a659 9
InterpreterObjCmd(clientData, interp, objc, objv)
    ClientData clientData;		/* Not used */
    Tcl_Interp *interp;			/* Current interpreter */
    int objc;				/* Number of arguments */
    Tcl_Obj *CONST objv[];		/* Argument objects */
{
    int index, result = TCL_OK;
    static CONST char *options[] = {"eval", "record", NULL};
    enum option {OTHER_EVAL, OTHER_RECORD};
d661 9
a669 4
    Tcl_Interp *otherInterp = info->interp;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg");
d672 6
a677 15
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index)
	!= TCL_OK) {
	return TCL_ERROR;
    }

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "script");
	return TCL_ERROR;
    }

    if ((otherInterp == NULL) || Tcl_InterpDeleted(otherInterp)) {
	Tcl_AppendResult(interp, "no active master interp", NULL);
	return TCL_ERROR;
    }

d679 13
a691 33
    switch ((enum option) index) {
    case OTHER_EVAL:
	result = Tcl_GlobalEvalObj(otherInterp, objv[2]);
	/*
	 * TODO: Should exceptions be filtered here?
	 */
	if (result == TCL_ERROR) {
	    Tcl_Obj *objPtr = Tcl_GetVar2Ex(otherInterp, "errorCode",
		    NULL, TCL_GLOBAL_ONLY);
	    Tcl_ResetResult(interp);
	    if (objPtr) {
		Tcl_SetObjErrorCode(interp, objPtr);
	    }

	    objPtr = Tcl_GetVar2Ex(otherInterp, "errorInfo",
		    NULL, TCL_GLOBAL_ONLY);
	    if (objPtr) {
		int numBytes;
		CONST char *message = Tcl_GetStringFromObj(objPtr, &numBytes);
		Tcl_AddObjErrorInfo(interp, message, numBytes);
	    }
	}
	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
	break;
    case OTHER_RECORD:
	Tcl_RecordAndEvalObj(otherInterp, objv[2], TCL_EVAL_GLOBAL);
	/*
	 * By not setting result, we discard any exceptions or errors here
	 * and always return TCL_OK.  All the caller wants is the
	 * interp result to display, whether that's result or error message.
	 */
	Tcl_SetObjResult(interp, Tcl_GetObjResult(otherInterp));
	break;
d694 1
d701 1
a701 1
 * DeleteConsoleInterp --
d703 2
a704 2
 *	Thread exit handler to destroy a console interp when the
 *	thread it lives in gets torn down.
d706 2
a707 13
 *----------------------------------------------------------------------
 */

static void
DeleteConsoleInterp(clientData)
    ClientData clientData;
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Tcl_DeleteInterp(interp);
}

/*
 *----------------------------------------------------------------------
d709 2
a710 1
 * InterpDeleteProc --
d712 1
a712 5
 *    React when the interp in which the console is displayed is deleted
 *    for any reason.
 *
 * Results:
 *	None.
d716 1
a716 1
InterpDeleteProc(clientData, interp)
a717 1
    Tcl_Interp *interp;
d720 2
d723 7
a729 7
    if(info->consoleInterp == interp) {
	Tcl_DeleteThreadExitHandler(DeleteConsoleInterp,
		(ClientData) info-> consoleInterp);
	info->consoleInterp = NULL;
    }
    if (--info->refCount <= 0) {
	ckfree((char *) info);
d731 3
d739 6
a744 1
 * ConsoleDeleteProc --
a745 3
 *	If the console command is deleted we destroy the console window and
 * 	all associated data structures.

d750 1
a750 1
 *	A new console is created.
d756 1
a756 1
ConsoleDeleteProc(clientData)
d758 1
d761 5
d767 14
a780 5
    if (info->consoleInterp) {
	Tcl_DeleteInterp(info->consoleInterp);
    }
    if (--info->refCount <= 0) {
	ckfree((char *) info);
d787 5
a791 1
 * ConsoleEventProc --
a792 4
 * 	This event function is registered on the main window of the slave
 *	interpreter.  If the user or a running script causes the main window to
 * 	be destroyed, then we need to inform the console interpreter by
 *	invoking "::tk::ConsoleExit".
d797 1
a797 1
 *	Invokes the "::tk::ConsoleExit" command in the console interp.
d802 7
a808 4
static void
ConsoleEventProc(clientData, eventPtr)
    ClientData clientData;
    XEvent *eventPtr;
d810 7
a816 3
    if (eventPtr->type == DestroyNotify) {
	ConsoleInfo *info = (ConsoleInfo *) clientData;
	Tcl_Interp *consoleInterp = info->consoleInterp;
d818 4
a821 3
	if (consoleInterp && !Tcl_InterpDeleted(consoleInterp)) {
	    Tcl_GlobalEval(consoleInterp, "tk::ConsoleExit");
	}
d823 5
a827 3
	if (--info->refCount <= 0) {
	    ckfree((char *) info);
	}
d829 12
@


1.18.2.5
log
@
	* generic/tkConsole.c: TIP #268 update regarding registered package
	* generic/tkMain.c:    version, now using full patchlevel instead of
	* generic/tkWindow.c:  major.minor
	* library/tk.tcl:
	* unix/configure:
	* unix/Makefile.in:
	* unix/tcl.m4:
	* win/configure:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/rules.vc:
	* win/tcl.m4:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18.2.4 2006/06/05 18:06:47 dgp Exp $
d243 1
a243 1
    if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 1) == NULL) {
@


1.18.2.6
log
@
	* generic/tkConsole.c: Complete reversal of the changes of Sep 22.
	* generic/tkMain.c:    For compat reason the Tcl core will not change
	* generic/tkWindow.c:  the registered version to include the patchlevel,
	* library/tk.tcl:      making the changes to Tk unnecessary.
	* unix/configure:
	* unix/Makefile.in:
	* unix/tcl.m4:
	* win/configure:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/rules.vc:
	* win/tcl.m4:
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.18.2.5 2006/09/22 19:01:50 andreas_kupries Exp $
d243 1
a243 1
    if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
@


1.17
log
@	* generic/tkConsole.c (ConsoleCmd): correct return that should
	have just set result code.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.16 2002/01/15 20:48:29 dgp Exp $
d51 1
a51 1
		    Tcl_Interp *interp, int argc, char **argv));
d56 1
a56 1
		    Tcl_Interp *interp, int argc, char **argv));
d563 1
a563 1
    char **argv;			/* Argument strings. */
d640 1
a640 1
    char **argv;			/* Argument strings. */
@


1.16
log
@	* Updated Tk's console to CONSTified channel driver interface.
	[Tcl Patch 503565, Tk Patch 503983]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.15 2002/01/15 18:19:14 dgp Exp $
d605 1
a605 1
	    return TCL_ERROR;
@


1.15
log
@	* Updated Tk's console to CONSTified channel driver interface.
	  [Tcl Patch 503565, Tk Patch 503983]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.14 2001/11/23 02:04:44 das Exp $
a49 3
void	TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
			    int devId, char *buffer, long size));

@


1.14
log
@	**  upport to 8.4 of mac code changes for 8.3.3 & various new
	**  changes for 8.4, some already backported to 8.3.4 (patch #435660)

	see ChangeLog for details
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.13 2001/08/06 18:29:41 dgp Exp $
d64 1
a64 1
		    char *buf, int toWrite, int *errorCode));
d411 1
a411 1
    char *buf;				/* The data buffer. */
d781 1
a781 1
    char *buffer;		/* Text buffer. */
@


1.13
log
@	* TIP 44 changes specific to the Mac and
	Windows platforms that were overlooked before: tkOpenDocument,
	tkConsoleExit, tkConsoleOutput, unsupported1 out of namespace :: .
	Thanks to Vince Darley for prompting another look.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.12 2000/07/18 02:31:06 davidg Exp $
d339 1
a339 1
    static char initCmd[] = "source -rsrc {Console}";
d479 3
@


1.13.2.1
log
@Merge with current TOT
Added support for the wm stackorder command
Fixed crash when selecting Menu items in the Application menu that we didn't
put there.
Added first bits of the use of CG for low-level drawing.  The line-drawing works,
the rest doesn't yet.  You have to set the file static useCGDrawing to 1 and
rebuild to activate this code.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.13 2001/08/06 18:29:41 dgp Exp $
d50 3
d64 1
a64 1
		    CONST char *buf, int toWrite, int *errorCode));
d339 1
a339 1
    static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
d411 1
a411 1
    CONST char *buf;			/* The data buffer. */
a478 3
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    tsdPtr->gStdoutInterp = NULL;
d778 1
a778 1
    CONST char *buffer;		/* Text buffer. */
@


1.13.2.2
log
@Merging with TOT as of 06/09/2002.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id$
d605 1
a605 1
	    result = TCL_ERROR;
@


1.13.2.3
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d51 1
a51 1
		    Tcl_Interp *interp, int argc, CONST char **argv));
d56 1
a56 1
		    Tcl_Interp *interp, int argc, CONST char **argv));
d563 1
a563 1
    CONST char **argv;			/* Argument strings. */
d640 1
a640 1
    CONST char **argv;			/* Argument strings. */
@


1.12
log
@Just added comments about a Win2K OS bug with GetStdHandle(STD_OUTPUT_HANDLE).
No change was made to the code.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.11 1999/11/19 22:00:03 hobbs Exp $
d711 1
a711 1
 *	interpreter by invoking "tkConsoleExit".
d717 1
a717 1
 *	Invokes the "tkConsoleExit" procedure in the console interp.
d748 1
a748 1
	Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
d793 1
a793 1
	cmd = "tkConsoleOutput stderr ";
d795 1
a795 1
	cmd = "tkConsoleOutput stdout ";
@


1.12.2.1
log
@sync with head
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.16 2002/01/15 20:48:29 dgp Exp $
d50 3
d64 1
a64 1
		    CONST char *buf, int toWrite, int *errorCode));
d339 1
a339 1
    static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
d411 1
a411 1
    CONST char *buf;			/* The data buffer. */
a478 3
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    tsdPtr->gStdoutInterp = NULL;
d711 1
a711 1
 *	interpreter by invoking "::tk::ConsoleExit".
d717 1
a717 1
 *	Invokes the "::tk::ConsoleExit" procedure in the console interp.
d748 1
a748 1
	Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
d778 1
a778 1
    CONST char *buffer;		/* Text buffer. */
d793 1
a793 1
	cmd = "::tk::ConsoleOutput stderr ";
d795 1
a795 1
	cmd = "::tk::ConsoleOutput stdout ";
@


1.11
log
@	* generic/tkColor.c:
	* generic/tkColor.h: fixed Tk_NameOfColor to work correctly,
	with minor change to TkColor struct.

	* generic/tkConsole.c: added static declaration to
	ConsoleDeleteProc function (proto already had it)
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.10 1999/07/30 02:09:25 redman Exp $
d154 17
@


1.11.2.1
log
@see ChangeLog for specific file details
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.12 2000/07/18 02:31:06 davidg Exp $
a153 17

    /*
     * Win2K BUG: GetStdHandle(STD_OUTPUT_HANDLE) can return what appears
     * to be a valid handle.  See TclpGetDefaultStdChannel() for this change
     * implemented.  We didn't change it here because GetFileType() [below]
     * will catch this with FILE_TYPE_UNKNOWN and appropriately return a
     * value of 1, anyways.
     *
     *    char dummyBuff[1];
     *    DWORD dummyWritten;
     *
     *    if ((type == TCL_STDOUT)
     *	    && !WriteFile(handle, dummyBuff, 0, &dummyWritten, NULL)) {
     *	return 1;
     *    }
     */

@


1.11.2.2
log
@Backport of some mac specific changes added to 8.4 since 8.3.3
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.11.2.1 2001/04/04 07:57:16 hobbs Exp $
a478 3
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    tsdPtr->gStdoutInterp = NULL;
@


1.11.2.3
log
@        * generic/tkConsole.c:
        * library/console.tcl:
        * mac/tkMacInit.c:
        * mac/tkMacResource.r: corrected how mac deals with tcl library
        files present both in resources and in $tk_library directory.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.11.2.2 2001/10/17 19:29:51 das Exp $
d339 1
a339 1
    static char initCmd[] = "if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}";
@


1.10
log
@* generic/tkConsole.c: Allow tcl to open CON and NUL, even for std
channels.  Checking for bad/unusable std channels was moved to Tk
since its only purpose was to check whether to use the Tk Console
Window for the std channels.  [Bug: 2393 2392 2209 2458]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.9 1999/06/17 01:03:28 wart Exp $
d676 1
a676 1
void 
@


1.9
log
@Cast third argument of Tcl_DStringAppend to (int) value in case the
strlen() function returned a different type.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.8 1999/06/17 00:39:18 wart Exp $
d88 100
d241 1
a241 3
#ifndef MAC_TCL
	if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
#endif
a252 1
#ifndef MAC_TCL
a253 1
#endif
d259 1
a259 3
#ifndef MAC_TCL
	if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
#endif
a270 1
#ifndef MAC_TCL
a271 1
#endif
d277 1
a277 3
#ifndef MAC_TCL
	if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
#endif
a288 1
#ifndef MAC_TCL
a289 1
#endif
@


1.8
log
@Updated aclocal.m4 to reflect recent changes in tcl.m4

Changed type of strncmp() parameter from int to size_t in tkConsole.c to
remove compiler warnings about bad types.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.7 1999/05/25 01:31:05 stanton Exp $
d703 1
a703 1
    Tcl_DStringAppend(&command, cmd, strlen(cmd));
@


1.7
log
@* generic/tkStubLib.c:
* generic/tkStubInit.c:
* generic/tkIntXlibDecls.h:
* generic/tkIntPlatDecls.h:
* generic/tkIntDecls.h:
* generic/tkInt.decls:
* generic/tkConsole.c: Various changes to try to get the Mac
builds working.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id$
d462 1
a462 1
    int length;
d539 1
a539 1
    int length;
@


1.6
log
@Rename TkConsoleCreate_() to Tk_InitConsoleChannels() and make the
function public.  Add an interp argument and init the Tcl stubs.
Rename TkConsoleInit() to Tk_CreateConsoleWindow()
Remove TkConsoleCreate() (no underbar)
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.5 1999/04/16 01:51:13 stanton Exp $
d130 9
d141 1
d143 1
d155 1
d157 1
d163 1
d165 1
d177 1
d179 1
d185 1
d187 1
d199 1
d201 1
@


1.5
log
@* Merged 8.1 branch into the main trunk
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id$
d36 7
a49 2
void	TkConsoleCreate_ _ANSI_ARGS_((void));
int	TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
d92 1
a92 1
 * TkConsoleCreate, TkConsoleCreate_ --
d109 2
a110 12
TkConsoleCreate()
{
    /*
     * This function is being diabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_MainEx(). The real
     * function is now tkCreateConsole_ and is only called from Tk_MainEx.
     * All of this is an ugly hack.
     */
}

void
TkConsoleCreate_()
d115 2
a116 1
     * check for STDIN, otherwise create it
d119 2
a120 9
    if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
	        (ClientData) TCL_STDIN, TCL_READABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
d123 2
a124 3
    /*
     * check for STDOUT, otherwise create it
     */
d126 18
a143 7
    if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
	        (ClientData) TCL_STDOUT, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
a144 2
	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
    }
d146 34
a179 11
    /*
     * check for STDERR, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
	        (ClientData) TCL_STDERR, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
a180 1
	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
d182 1
d188 1
a188 1
 * TkConsoleInit --
d204 1
a204 1
TkConsoleInit(interp)
@


1.4
log
@integrated stubs into 8.0 main branch
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.3.4.2 1999/03/07 00:15:43 redman Exp $
d17 2
a19 1
#include <string.h>
d32 4
a35 1
static Tcl_Interp *gStdoutInterp = NULL;
a42 1
void	TkConsoleCreate _ANSI_ARGS_((void));
d107 4
a110 4
     * This function is being disabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_Main().  The real
     * function is now TkConsoleCreate_ and is only called from Tk_Main.
     * All of is an ugly hack.
d119 43
a161 19
    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
	    (ClientData) TCL_STDIN, TCL_READABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
    }
    Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
	    (ClientData) TCL_STDOUT, TCL_WRITABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
    }
    Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
    consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
	    (ClientData) TCL_STDERR, TCL_WRITABLE);
    if (consoleChannel != NULL) {
	Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
a162 1
    Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
d190 2
a198 1
    
d213 1
a213 1
    gStdoutInterp = interp;
d269 3
d275 3
a277 2
    if (gStdoutInterp != NULL) {
	TkConsolePrint(gStdoutInterp, (int) instanceData, buf, toWrite);
d424 1
d437 2
a439 3
	Tcl_DString dString;
	
	Tcl_DStringInit(&dString);
a444 1
	Tcl_DStringFree(&dString);
d446 2
a447 1
	Tcl_Eval(consoleInterp, "wm withdraw .");
d449 2
a450 1
	Tcl_Eval(consoleInterp, "wm deiconify .");
d467 1
d583 1
d586 4
a589 1
        consoleInterp = info->consoleInterp;
d602 3
a604 1
	Tcl_Eval(consoleInterp, "tkConsoleExit");
@


1.3
log
@* generic/tkConsole.c: Fixed so errors in console eval are
reported properly.  Eliminated duplicate result messages. [Bug: 973]
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.2 1998/09/14 18:23:08 stanton Exp $
d17 1
d40 1
d84 1
a84 1
 * TkConsoleCreate --
d103 11
d171 1
@


1.3.4.1
log
@stubbed out TkConsoleCreate and added a call to TkConsoleCreate_
in Tk_Main() so that Tk can be dynamically loaded
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.3 1999/02/04 20:51:36 stanton Exp $
a38 1
void	TkConsoleCreate_ _ANSI_ARGS_((void));
d82 1
a82 1
 * TkConsoleCreate, TkConsoleCreate_ --
a99 11
{
    /*
     * This function is being disabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_Main().  The real
     * function is now TkConsoleCreate_ and is only called from Tk_Main.
     * All of is an ugly hack.
     */
}

void
TkConsoleCreate_()
@


1.3.4.2
log
@Stubs changes, now wish works on Windows.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.3.4.1 1999/03/06 23:18:05 stanton Exp $
a16 1
#include "tkInt.h"
a169 1
    
@


1.2
log
@Replaced SCCS strings, fixed binary files
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id$
d402 1
a402 1
	Tcl_Eval(info->consoleInterp, "wm withdraw .");
d404 1
a404 1
	Tcl_Eval(info->consoleInterp, "wm deiconify .");
d407 3
a409 1
	    Tcl_Eval(info->consoleInterp, argv[2]);
d471 1
@


1.1
log
@Initial revision
@
text
@d13 1
a13 1
 * SCCS: @@(#) tkConsole.c 1.54 97/10/17 10:46:08
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d13 1
a13 1
 * SCCS: @@(#) tkConsole.c 1.55 98/01/02 17:40:37
a31 2
EXTERN void		TclInitSubsystems _ANSI_ARGS_((CONST char *argv0));

a102 2
    TclInitSubsystems(NULL);

a107 1
	Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
a114 1
	Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
a121 1
	Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.2 1998/09/14 18:23:08 stanton Exp $
@


1.1.4.3
log
@
Tk 8.1 Muti-threading changes.

Moved static and global data elements into thread-local storage,
or introduced locks where not possible, as first stage of adding
thread safety to Tk.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.2 1998/09/30 02:16:52 stanton Exp $
d30 2
a33 5
typedef struct ThreadSpecificData {
    Tcl_Interp *gStdoutInterp;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

a157 2
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
d179 1
a179 1
    tsdPtr->gStdoutInterp = interp;
a234 3
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

d238 2
a239 3
    if (tsdPtr->gStdoutInterp != NULL) {
	TkConsolePrint(tsdPtr->gStdoutInterp, (int) instanceData, buf, 
                toWrite);
@


1.1.4.4
log
@* Various cleanup related to the Tcl_Eval and Tcl_ObjSetVar
changes in Tcl.

* Integrated patches from 8.0.5b2
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.3 1998/12/13 08:16:03 lfb Exp $
d418 1
a418 1
	Tcl_Eval(consoleInterp, "wm withdraw .");
d420 1
a420 1
	Tcl_Eval(consoleInterp, "wm deiconify .");
d423 1
a423 3
	    result = Tcl_Eval(consoleInterp, argv[2]);
	    Tcl_AppendResult(interp, Tcl_GetStringResult(consoleInterp),
		    (char *) NULL);
a484 1
	Tcl_ResetResult(interp);
@


1.1.4.5
log
@Add code to hook up stdin/stdout/stderr if connected.  This can happen if they
are files or pipes (anything except consoles).
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.4 1999/02/11 04:13:45 stanton Exp $
d110 6
a115 13
    /*
     * check for STDIN, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDIN) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
	        (ClientData) TCL_STDIN, TCL_READABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDIN);
d117 7
a123 14

    /*
     * check for STDOUT, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDOUT) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console1",
	        (ClientData) TCL_STDOUT, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDOUT);
d125 7
a131 14

    /*
     * check for STDERR, otherwise create it
     */

    if (Tcl_GetStdChannel(TCL_STDERR) == NULL) {
	consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console2",
	        (ClientData) TCL_STDERR, TCL_WRITABLE);
	if (consoleChannel != NULL) {
	    Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
	    Tcl_SetChannelOption(NULL, consoleChannel, "-encoding", "utf-8");
	}
	Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
d133 1
@


1.1.4.6
log
@integrated stubs from development branch
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.5 1999/02/26 02:26:05 redman Exp $
a18 2
#include "tkInt.h"

d30 2
d43 1
a43 1
void	TkConsoleCreate_ _ANSI_ARGS_((void));
d87 1
a87 1
 * TkConsoleCreate, TkConsoleCreate_ --
d106 1
a106 7
    /*
     * This function is being diabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_MainEx(). The real
     * function is now tkCreateConsole_ and is only called from Tk_MainEx.
     * All of this is an ugly hack.
     */
}
d108 1
a108 4
void
TkConsoleCreate_()
{
    Tcl_Channel consoleChannel;
@


1.1.4.7
log
@Don't pass static strings to Tcl_Eval in case the compiler
puts them in read-only memory.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.6 1999/03/10 07:13:38 stanton Exp $
a423 1
    Tcl_DString dString;
a435 2
    Tcl_DStringInit(&dString);

d437 3
d445 1
d447 1
a447 2
	Tcl_DStringAppend(&dString, "wm withdraw . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
d449 1
a449 2
	Tcl_DStringAppend(&dString, "wm deiconify . ", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
a465 1
    Tcl_DStringFree(&dString);
a580 1
    Tcl_DString dString;
d583 1
a583 4

	Tcl_DStringInit(&dString);
  
	consoleInterp = info->consoleInterp;
d596 1
a596 3
	Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
	Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
	Tcl_DStringFree(&dString);
@


1.1.4.5.2.1
log
@Changes to support stubs in 8.1. Merged from 8.0.6 code base.
@
text
@d13 1
a13 1
 * RCS: @@(#) $Id: tkConsole.c,v 1.1.4.5 1999/02/26 02:26:05 redman Exp $
a18 2
#include "tkInt.h"

d30 2
d43 1
a43 1
void	TkConsoleCreate_ _ANSI_ARGS_((void));
d87 1
a87 1
 * TkConsoleCreate, TkConsoleCreate_ --
d106 1
a106 7
    /*
     * This function is being diabled so we don't end up calling it
     * twice.  Once from WinMain() and once from Tk_MainEx(). The real
     * function is now tkCreateConsole_ and is only called from Tk_MainEx.
     * All of this is an ugly hack.
     */
}
d108 1
a108 4
void
TkConsoleCreate_()
{
    Tcl_Channel consoleChannel;
@


