doc/DoWhenIdle.3


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87

'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\" 
.so man.macros
.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
.sp
\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
.SH ARGUMENTS
.AS Tcl_IdleProc clientData
.AP Tcl_IdleProc *proc in
Procedure to invoke.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
when the application becomes idle.  The application is
considered to be idle when \fBTcl_DoOneEvent\fR has been
called, could not find any events to handle, and is about
to go to sleep waiting for an event to occur.  At this
point all pending \fBTcl_DoWhenIdle\fR handlers are
invoked.  For each call to \fBTcl_DoWhenIdle\fR there will
be a single call to \fIproc\fR;  after \fIproc\fR is
invoked the handler is automatically removed.
\fBTcl_DoWhenIdle\fR is only usable in programs that
use \fBTcl_DoOneEvent\fR to dispatch events.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_IdleProc\fR:
.PP
.CS
typedef void \fBTcl_IdleProc\fR(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
argument given to \fBTcl_DoWhenIdle\fR.  Typically, \fIclientData\fR
points to a data structure containing application-specific information about
what \fIproc\fR should do.
.PP
\fBTcl_CancelIdleCall\fR
may be used to cancel one or more previous
calls to \fBTcl_DoWhenIdle\fR:  if there is a \fBTcl_DoWhenIdle\fR
handler registered for \fIproc\fR and \fIclientData\fR, then it
is removed without invoking it.  If there is more than one
handler on the idle list that refers to \fIproc\fR and \fIclientData\fR,
all of the handlers are removed.  If no existing handlers match
\fIproc\fR and \fIclientData\fR then nothing happens.
.PP
\fBTcl_DoWhenIdle\fR is most useful in situations where
(a) a piece of work will have to be done but (b) it is
possible that something will happen in the near future
that will change what has to be done or require something
different to be done.  \fBTcl_DoWhenIdle\fR allows the
actual work to be deferred until all pending events have
been processed.  At this point the exact work to be done
will presumably be known and it can be done exactly once.
.PP
For example, \fBTcl_DoWhenIdle\fR might be used by an editor
to defer display updates until all pending commands have
been processed.  Without this feature, redundant redisplays
might occur in some situations, such as the processing of
a command file.
.SH BUGS
.PP
At present it is not safe for an idle callback to reschedule itself
continuously.  This will interact badly with certain features of Tk
that attempt to wait for all idle callbacks to complete.  If you would
like for an idle callback to reschedule itself continuously, it is
better to use a timer handler with a zero timeout period.
.SH "SEE ALSO"
after(n), Tcl_CreateFileHandler(3), Tcl_CreateTimerHandler(3)
.SH KEYWORDS
callback, defer, idle callback
/* 
 * tkUnixSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright (c) 1989-1994 The Regents of the University of California.
 * Copyright (c) 1994-1996 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tkUnixSend.c,v 1.11 2002/08/13 16:20:49 rmax Exp $
 */

#include "tkPort.h"
#include "tkInt.h"
#include "tkUnixInt.h"

/* 
 * The following structure is used to keep track of the interpreters
 * registered by this process.
 */

typedef struct RegisteredInterp {
    char *name;			/* Interpreter's name (malloc-ed). */
    Tcl_Interp *interp;		/* Interpreter associated with name.  NULL
				 * means that the application was unregistered
				 * or deleted while a send was in progress
				 * to it. */
    TkDisplay *dispPtr;		/* Display for the application.  Needed
				 * because we may need to unregister the
				 * interpreter after its main window has
				 * been deleted. */
    struct RegisteredInterp *nextPtr;
				/* Next in list of names associated
				 * with interps in this process.
				 * NULL means end of list. */
} RegisteredInterp;

/*
 * A registry of all interpreters for a display is kept in a
 * property "InterpRegistry" on the root window of the display.
 * It is organized as a series of zero or more concatenated strings
 * (in no particular order), each of the form
 * 	window space name '\0'
 * where "window" is the hex id of the comm. window to use to talk
 * to an interpreter named "name".
 *
 * When the registry is being manipulated by an application (e.g. to
 * add or remove an entry), it is loaded into memory using a structure
 * of the following type:
 */

typedef struct NameRegistry {
    TkDisplay *dispPtr;		/* Display from which the registry was
				 * read. */
    int locked;			/* Non-zero means that the display was
				 * locked when the property was read in. */
    int modified;		/* Non-zero means that the property has
				 * been modified, so it needs to be written
				 * out when the NameRegistry is closed. */
    unsigned long propLength;	/* Length of the property, in bytes. */
    char *property;		/* The contents of the property, or NULL
				 * if none.  See format description above;
				 * this is *not* terminated by the first
				 * null character.  Dynamically allocated. */
    int allocedByX;		/* Non-zero means must free property with
				 * XFree;  zero means use ckfree. */
} NameRegistry;

/*
 * When a result is being awaited from a sent command, one of
 * the following structures is present on a list of all outstanding
 * sent commands.  The information in the structure is used to
 * process the result when it arrives.  You're probably wondering
 * how there could ever be multiple outstanding sent commands.
 * This could happen if interpreters invoke each other recursively.
 * It's unlikely, but possible.
 */

typedef struct PendingCommand {
    int serial;			/* Serial number expected in
				 * result. */
    TkDisplay *dispPtr;		/* Display being used for communication. */
    CONST char *target;		/* Name of interpreter command is
				 * being sent to. */
    Window commWindow;		/* Target's communication window. */
    Tcl_Interp *interp;		/* Interpreter from which the send
				 * was invoked. */
    int code;			/* Tcl return code for command
				 * will be stored here. */
    char *result;		/* String result for command (malloc'ed),
				 * or NULL. */
    char *errorInfo;		/* Information for "errorInfo" variable,
				 * or NULL (malloc'ed). */
    char *errorCode;		/* Information for "errorCode" variable,
				 * or NULL (malloc'ed). */
    int gotResponse;		/* 1 means a response has been received,
				 * 0 means the command is still outstanding. */
    struct PendingCommand *nextPtr;
				/* Next in list of all outstanding
				 * commands.  NULL means end of
				 * list. */
} PendingCommand;

typedef struct ThreadSpecificData {
    PendingCommand *pendingCommands;				
                                /* List of all commands currently
				 * being waited for. */
    RegisteredInterp *interpListPtr;
                                /* List of all interpreters registered
				 * in the current process. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * The information below is used for communication between processes
 * during "send" commands.  Each process keeps a private window, never
 * even mapped, with one property, "Comm".  When a command is sent to
 * an interpreter, the command is appended to the comm property of the
 * communication window associated with the interp's process.  Similarly,
 * when a result is returned from a sent command, it is also appended
 * to the comm property.
 *
 * Each command and each result takes the form of ASCII text.  For a
 * command, the text consists of a zero character followed by several
 * null-terminated ASCII strings.  The first string consists of the
 * single letter "c".  Subsequent strings have the form "option value"
 * where the following options are supported:
 *
 * -r commWindow serial
 *
 *	This option means that a response should be sent to the window
 *	whose X identifier is "commWindow" (in hex), and the response should
 *	be identified with the serial number given by "serial" (in decimal).
 *	If this option isn't specified then the send is asynchronous and
 *	no response is sent.
 *
 * -n name
 *	"Name" gives the name of the application for which the command is
 *	intended.  This option must be present.
 *
 * -s script
 *
 *	"Script" is the script to be executed.  This option must be present.
 *
 * The options may appear in any order.  The -n and -s options must be
 * present, but -r may be omitted for asynchronous RPCs.  For compatibility
 * with future releases that may add new features, there may be additional
 * options present;  as long as they start with a "-" character, they will
 * be ignored.
 *
 * A result also consists of a zero character followed by several null-
 * terminated ASCII strings.  The first string consists of the single
 * letter "r".  Subsequent strings have the form "option value" where
 * the following options are supported:
 *
 * -s serial
 *
 *	Identifies the command for which this is the result.  It is the
 *	same as the "serial" field from the -s option in the command.  This
 *	option must be present.
 *
 * -c code
 *
 *	"Code" is the completion code for the script, in decimal.  If the
 *	code is omitted it defaults to TCL_OK.
 *
 * -r result
 *
 *	"Result" is the result string for the script, which may be either
 *	a result or an error message.  If this field is omitted then it
 *	defaults to an empty string.
 *
 * -i errorInfo
 *
 *	"ErrorInfo" gives a string with which to initialize the errorInfo
 *	variable.  This option may be omitted;  it is ignored unless the
 *	completion code is TCL_ERROR.
 *
 * -e errorCode
 *
 *	"ErrorCode" gives a string with with to initialize the errorCode
 *	variable.  This option may be omitted;  it is ignored  unless the
 *	completion code is TCL_ERROR.
 *
 * Options may appear in any order, and only the -s option must be
 * present.  As with commands, there may be additional options besides
 * these;  unknown options are ignored.
 */

/*
 * The following variable is the serial number that was used in the
 * last "send" command.  It is exported only for testing purposes.
 */

int tkSendSerial = 0;

/*
 * Maximum size property that can be read at one time by
 * this module:
 */

#define MAX_PROP_WORDS 100000

/*
 * The following variable can be set while debugging to do things like
 * skip locking the server.
 */

static int sendDebug = 0;

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AppendErrorProc _ANSI_ARGS_((ClientData clientData,
				XErrorEvent *errorPtr));
static void		AppendPropCarefully _ANSI_ARGS_((Display *display,
			    Window window, Atom property, char *value,
			    int length, PendingCommand *pendingPtr));
static void		DeleteProc _ANSI_ARGS_((ClientData clientData));
static void		RegAddName _ANSI_ARGS_((NameRegistry *regPtr,
			    CONST char *name, Window commWindow));
static void		RegClose _ANSI_ARGS_((NameRegistry *regPtr));
static void		RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
			    CONST char *name));
static Window		RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
			    CONST char *name));
static NameRegistry *	RegOpen _ANSI_ARGS_((Tcl_Interp *interp,
			    TkDisplay *dispPtr, int lock));
static void		SendEventProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static int		SendInit _ANSI_ARGS_((Tcl_Interp *interp,
			    TkDisplay *dispPtr));
static Tk_RestrictAction SendRestrictProc _ANSI_ARGS_((ClientData clientData,
			    XEvent *eventPtr));
static int		ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
static void		UpdateCommWindow _ANSI_ARGS_((TkDisplay *dispPtr));
static int		ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
			    CONST char *name, Window commWindow, int oldOK));

/*
 *----------------------------------------------------------------------
 *
 * RegOpen --
 *
 *	This procedure loads the name registry for a display into
 *	memory so that it can be manipulated.
 *
 * Results:
 *	The return value is a pointer to the loaded registry.
 *
 * Side effects:
 *	If "lock" is set then the server will be locked.  It is the
 *	caller's responsibility to call RegClose when finished with
 *	the registry, so that we can write back the registry if
 *	needed, unlock the server if needed, and free memory.
 *
 *----------------------------------------------------------------------
 */

static NameRegistry *
RegOpen(interp, dispPtr, lock)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
				 * (errors cause a panic so in fact no
				 * error is ever returned, but the interpreter
				 * is needed anyway). */
    TkDisplay *dispPtr;		/* Display whose name registry is to be
				 * opened. */
    int lock;			/* Non-zero means lock the window server
				 * when opening the registry, so no-one
				 * else can use the registry until we
				 * close it. */
{
    NameRegistry *regPtr;
    int result, actualFormat;
    unsigned long bytesAfter;
    Atom actualType;

    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, dispPtr);
    }

    regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry));
    regPtr->dispPtr = dispPtr;
    regPtr->locked = 0;
    regPtr->modified = 0;
    regPtr->allocedByX = 1;

    if (lock && !sendDebug) {
	XGrabServer(dispPtr->display);
	regPtr->locked = 1;
    }

    /*
     * Read the registry property.
     */

    result = XGetWindowProperty(dispPtr->display,
	    RootWindow(dispPtr->display, 0),
	    dispPtr->registryProperty, 0, MAX_PROP_WORDS,
	    False, XA_STRING, &actualType, &actualFormat,
	    &regPtr->propLength, &bytesAfter,
	    (unsigned char **) &regPtr->property);

    if (actualType == None) {
	regPtr->propLength = 0;
	regPtr->property = NULL;
    } else if ((result != Success) || (actualFormat != 8)
	    || (actualType != XA_STRING)) {
	/*
	 * The property is improperly formed;  delete it.
	 */

	if (regPtr->property != NULL) {
	    XFree(regPtr->property);
	    regPtr->propLength = 0;
	    regPtr->property = NULL;
	}
	XDeleteProperty(dispPtr->display,
		RootWindow(dispPtr->display, 0),
		dispPtr->registryProperty);
    }

    /*
     * Xlib placed an extra null byte after the end of the property, just
     * to make sure that it is always NULL-terminated.  Be sure to include
     * this byte in our count if it's needed to ensure null termination
     * (note: as of 8/95 I'm no longer sure why this code is needed;  seems
     * like it shouldn't be).
     */

    if ((regPtr->propLength > 0)
	    && (regPtr->property[regPtr->propLength-1] != 0)) {
	regPtr->propLength++;
    }
    return regPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * RegFindName --
 *
 *	Given an open name registry, this procedure finds an entry
 *	with a given name, if there is one, and returns information
 *	about that entry.
 *
 * Results:
 *	The return value is the X identifier for the comm window for
 *	the application named "name", or None if there is no such
 *	entry in the registry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Window
RegFindName(regPtr, name)
    NameRegistry *regPtr;	/* Pointer to a registry opened with a
				 * previous call to RegOpen. */
    CONST char *name;		/* Name of an application. */
{
    char *p, *entry;
    unsigned int id;

    for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
	entry = p;
	while ((*p != 0) && (!isspace(UCHAR(*p)))) {
	    p++;
	}
	if ((*p != 0) && (strcmp(name, p+1) == 0)) {
	    if (sscanf(entry, "%x", &id) == 1) {
		/*
		 * Must cast from an unsigned int to a Window in case we
		 * are on a 64-bit architecture.
		 */

		return (Window) id;
	    }
	}
	while (*p != 0) {
	    p++;
	}
	p++;
    }
    return None;
}

/*
 *----------------------------------------------------------------------
 *
 * RegDeleteName --
 *
 *	This procedure deletes the entry for a given name from
 *	an open registry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there used to be an entry named "name" in the registry,
 *	then it is deleted and the registry is marked as modified
 *	so it will be written back when closed.
 *
 *----------------------------------------------------------------------
 */

static void
RegDeleteName(regPtr, name)
    NameRegistry *regPtr;	/* Pointer to a registry opened with a
				 * previous call to RegOpen. */
    CONST char *name;		/* Name of an application. */
{
    char *p, *entry, *entryName;
    int count;

    for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
	entry = p;
	while ((*p != 0) && (!isspace(UCHAR(*p)))) {
	    p++;
	}
	if (*p != 0) {
	    p++;
	}
	entryName = p;
	while (*p != 0) {
	    p++;
	}
	p++;
	if ((strcmp(name, entryName) == 0)) {
	    /*
	     * Found the matching entry.  Copy everything after it
	     * down on top of it.
	     */

	    count = regPtr->propLength - (p - regPtr->property);
	    if (count > 0)  {
		char *src, *dst;

		for (src = p, dst = entry; count > 0; src++, dst++, count--) {
		    *dst = *src;
		}
	    }
	    regPtr->propLength -=  p - entry;
	    regPtr->modified = 1;
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * RegAddName --
 *
 *	Add a new entry to an open registry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The open registry is expanded;  it is marked as modified so that
 *	it will be written back when closed.
 *
 *----------------------------------------------------------------------
 */

static void
RegAddName(regPtr, name, commWindow)
    NameRegistry *regPtr;	/* Pointer to a registry opened with a
				 * previous call to RegOpen. */
    CONST char *name;		/* Name of an application.  The caller
				 * must ensure that this name isn't
				 * already registered. */
    Window commWindow;		/* X identifier for comm. window of
				 * application.  */
{
    char id[30];
    char *newProp;
    int idLength, newBytes;

    sprintf(id, "%x ", (unsigned int) commWindow);
    idLength = strlen(id);
    newBytes = idLength + strlen(name) + 1;
    newProp = (char *) ckalloc((unsigned) (regPtr->propLength + newBytes));
    strcpy(newProp, id);
    strcpy(newProp+idLength, name);
    if (regPtr->property != NULL) {
	memcpy((VOID *) (newProp + newBytes), (VOID *) regPtr->property,
		regPtr->propLength);
	if (regPtr->allocedByX) {
	    XFree(regPtr->property);
	} else {
	    ckfree(regPtr->property);
	}
    }
    regPtr->modified = 1;
    regPtr->propLength += newBytes;
    regPtr->property = newProp;
    regPtr->allocedByX = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * RegClose --
 *
 *	This procedure is called to end a series of operations on
 *	a name registry.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The registry is written back if it has been modified, and the
 *	X server is unlocked if it was locked.  Memory for the
 *	registry is freed, so the caller should never use regPtr
 *	again.
 *
 *----------------------------------------------------------------------
 */

static void
RegClose(regPtr)
    NameRegistry *regPtr;	/* Pointer to a registry opened with a
				 * previous call to RegOpen. */
{
    if (regPtr->modified) {
	if (!regPtr->locked && !sendDebug) {
	    panic("The name registry was modified without being locked!");
	}
	XChangeProperty(regPtr->dispPtr->display,
		RootWindow(regPtr->dispPtr->display, 0),
		regPtr->dispPtr->registryProperty, XA_STRING, 8,
		PropModeReplace, (unsigned char *) regPtr->property,
		(int) regPtr->propLength);
    }

    if (regPtr->locked) {
	XUngrabServer(regPtr->dispPtr->display);
    }

    /*
     * After ungrabbing the server, it's important to flush the output
     * immediately so that the server sees the ungrab command.  Otherwise
     * we might do something else that needs to communicate with the
     * server (such as invoking a subprocess that needs to do I/O to
     * the screen); if the ungrab command is still sitting in our
     * output buffer, we could deadlock.
     */

    XFlush(regPtr->dispPtr->display);

    if (regPtr->property != NULL) {
	if (regPtr->allocedByX) {
	    XFree(regPtr->property);
	} else {
	    ckfree(regPtr->property);
	}
    }
    ckfree((char *) regPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateName --
 *
 *	This procedure checks to see if an entry in the registry
 *	is still valid.
 *
 * Results:
 *	The return value is 1 if the given commWindow exists and its
 *	name is "name".  Otherwise 0 is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ValidateName(dispPtr, name, commWindow, oldOK)
    TkDisplay *dispPtr;		/* Display for which to perform the
				 * validation. */
    CONST char *name;		/* The name of an application. */
    Window commWindow;		/* X identifier for the application's
				 * comm. window. */
    int oldOK;			/* Non-zero means that we should consider
				 * an application to be valid even if it
				 * looks like an old-style (pre-4.0) one;
				 * 0 means consider these invalid. */
{
    int result, actualFormat, argc, i;
    unsigned long length, bytesAfter;
    Atom actualType;
    char *property;
    Tk_ErrorHandler handler;
    CONST char **argv;

    property = NULL;

    /*
     * Ignore X errors when reading the property (e.g., the window
     * might not exist).  If an error occurs, result will be some
     * value other than Success.
     */

    handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
	    (Tk_ErrorProc *) NULL, (ClientData) NULL);
    result = XGetWindowProperty(dispPtr->display, commWindow,
	    dispPtr->appNameProperty, 0, MAX_PROP_WORDS,
	    False, XA_STRING, &actualType, &actualFormat,
	    &length, &bytesAfter, (unsigned char **) &property);

    if ((result == Success) && (actualType == None)) {
	XWindowAttributes atts;

	/*
	 * The comm. window exists but the property we're looking for
	 * doesn't exist.  This probably means that the application
	 * comes from an older version of Tk (< 4.0) that didn't set the
	 * property;  if this is the case, then assume for compatibility's
	 * sake that everything's OK.  However, it's also possible that
	 * some random application has re-used the window id for something
	 * totally unrelated.  Check a few characteristics of the window,
	 * such as its dimensions and mapped state, to be sure that it
	 * still "smells" like a commWindow.
	 */

	if (!oldOK
		|| !XGetWindowAttributes(dispPtr->display, commWindow, &atts)
		|| (atts.width != 1) || (atts.height != 1)
		|| (atts.map_state != IsUnmapped)) {
	    result = 0;
	} else {
	    result = 1;
	}
    } else if ((result == Success) && (actualFormat == 8)
	   && (actualType == XA_STRING)) {
	result = 0;
	if (Tcl_SplitList((Tcl_Interp *) NULL, property, &argc, &argv)
		== TCL_OK) {
	    for (i = 0; i < argc; i++) {
		if (strcmp(argv[i], name) == 0) {
		    result = 1;
		    break;
		}
	    }
	    ckfree((char *) argv);
	}
    } else {
       result = 0;
    }
    Tk_DeleteErrorHandler(handler);
    if (property != NULL) {
	XFree(property);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ServerSecure --
 *
 *	Check whether a server is secure enough for us to trust
 *	Tcl scripts arriving via that server.
 *
 * Results:
 *	The return value is 1 if the server is secure, which means
 *	that host-style authentication is turned on but there are
 *	no hosts in the enabled list.  This means that some other
 *	form of authorization (presumably more secure, such as xauth)
 *	is in use.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ServerSecure(dispPtr)
    TkDisplay *dispPtr;		/* Display to check. */
{
#ifdef TK_NO_SECURITY
    return 1;
#else
    XHostAddress *addrPtr;
    int numHosts, secure;
    Bool enabled;

    secure = 0;
    addrPtr = XListHosts(dispPtr->display, &numHosts, &enabled);
    if (enabled && (numHosts == 0)) {
	secure = 1;
    }
    if (addrPtr != NULL) {
	XFree((char *) addrPtr);
    }
    return secure;
#endif /* TK_NO_SECURITY */
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SetAppName --
 *
 *	This procedure is called to associate an ASCII name with a Tk
 *	application.  If the application has already been named, the
 *	name replaces the old one.
 *
 * Results:
 *	The return value is the name actually given to the application.
 *	This will normally be the same as name, but if name was already
 *	in use for an application then a name of the form "name #2" will
 *	be chosen,  with a high enough number to make the name unique.
 *
 * Side effects:
 *	Registration info is saved, thereby allowing the "send" command
 *	to be used later to invoke commands in the application.  In
 *	addition, the "send" command is created in the application's
 *	interpreter.  The registration will be removed automatically
 *	if the interpreter is deleted or the "send" command is removed.
 *
 *--------------------------------------------------------------
 */

CONST char *
Tk_SetAppName(tkwin, name)
    Tk_Window tkwin;		/* Token for any window in the application
				 * to be named:  it is just used to identify
				 * the application and the display.  */
    CONST char *name;		/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
{
    RegisteredInterp *riPtr, *riPtr2;
    Window w;
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr = winPtr->dispPtr;
    NameRegistry *regPtr;
    Tcl_Interp *interp;
    CONST char *actualName;
    Tcl_DString dString;
    int offset, i;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    interp = winPtr->mainPtr->interp;
    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, winPtr->dispPtr);
    }

    /*
     * See if the application is already registered;  if so, remove its
     * current name from the registry.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 1);
    for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
	if (riPtr == NULL) {

	    /*
	     * This interpreter isn't currently registered;  create
	     * the data structure that will be used to register it locally,
	     * plus add the "send" command to the interpreter.
	     */

	    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
	    riPtr->interp = interp;
	    riPtr->dispPtr = winPtr->dispPtr;
	    riPtr->nextPtr = tsdPtr->interpListPtr;
	    tsdPtr->interpListPtr = riPtr;
	    riPtr->name = NULL;
	    Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
		    DeleteProc);
            if (Tcl_IsSafe(interp)) {
                Tcl_HideCommand(interp, "send", "send");
            }
	    break;
	}
	if (riPtr->interp == interp) {
	    /*
	     * The interpreter is currently registered;  remove it from
	     * the name registry.
	     */

	    if (riPtr->name) {
		RegDeleteName(regPtr, riPtr->name);
		ckfree(riPtr->name);
	    }
	    break;
	}
    }

    /*
     * Pick a name to use for the application.  Use "name" if it's not
     * already in use.  Otherwise add a suffix such as " #2", trying
     * larger and larger numbers until we eventually find one that is
     * unique.
     */

    actualName = name;
    offset = 0;				/* Needed only to avoid "used before
					 * set" compiler warnings. */
    for (i = 1; ; i++) {
	if (i > 1) {
	    if (i == 2) {
		Tcl_DStringInit(&dString);
		Tcl_DStringAppend(&dString, name, -1);
		Tcl_DStringAppend(&dString, " #", 2);
		offset = Tcl_DStringLength(&dString);
		Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
		actualName = Tcl_DStringValue(&dString);
	    }
	    sprintf(Tcl_DStringValue(&dString) + offset, "%d", i);
	}
	w = RegFindName(regPtr, actualName);
	if (w == None) {
	    break;
	}
    
	/*
	 * The name appears to be in use already, but double-check to
	 * be sure (perhaps the application died without removing its
	 * name from the registry?).
	 */

	if (w == Tk_WindowId(dispPtr->commTkwin)) {
	    for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL; 
                    riPtr2 = riPtr2->nextPtr) {
		if ((riPtr2->interp != interp) &&
			(strcmp(riPtr2->name, actualName) == 0)) {
		    goto nextSuffix;
		}
	    }
	    RegDeleteName(regPtr, actualName);
	    break;
	} else if (!ValidateName(winPtr->dispPtr, actualName, w, 1)) {
	    RegDeleteName(regPtr, actualName);
	    break;
	}
	nextSuffix:
	continue;
    }

    /*
     * We've now got a name to use.  Store it in the name registry and
     * in the local entry for this application, plus put it in a property
     * on the commWindow.
     */

    RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin));
    RegClose(regPtr);
    riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1));
    strcpy(riPtr->name, actualName);
    if (actualName != name) {
	Tcl_DStringFree(&dString);
    }
    UpdateCommWindow(dispPtr);

    return riPtr->name;
}

/*
 *--------------------------------------------------------------
 *
 * Tk_SendCmd --
 *
 *	This procedure is invoked to process the "send" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *--------------------------------------------------------------
 */

int
Tk_SendCmd(clientData, interp, argc, argv)
    ClientData clientData;		/* Information about sender (only
					 * dispPtr field is used). */
    Tcl_Interp *interp;			/* Current interpreter. */
    int argc;				/* Number of arguments. */
    CONST char **argv;			/* Argument strings. */
{
    TkWindow *winPtr;
    Window commWindow;
    PendingCommand pending;
    register RegisteredInterp *riPtr;
    CONST char *destName;
    int result, c, async, i, firstArg;
    size_t length;
    Tk_RestrictProc *prevRestrictProc;
    ClientData prevArg;
    TkDisplay *dispPtr;
    Tcl_Time timeout;
    NameRegistry *regPtr;
    Tcl_DString request;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
    Tcl_Interp *localInterp;		/* Used when the interpreter to
                                         * send the command to is within
                                         * the same process. */

    /*
     * Process options, if any.
     */

    async = 0;
    winPtr = (TkWindow *) Tk_MainWindow(interp);
    if (winPtr == NULL) {
	return TCL_ERROR;
    }
    for (i = 1; i < (argc-1); ) {
	if (argv[i][0] != '-') {
	    break;
	}
	c = argv[i][1];
	length = strlen(argv[i]);
	if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) {
	    async = 1;
	    i++;
	} else if ((c == 'd') && (strncmp(argv[i], "-displayof",
		length) == 0)) {
	    winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1],
		    (Tk_Window) winPtr);
	    if (winPtr == NULL) {
		return TCL_ERROR;
	    }
	    i += 2;
	} else if (strcmp(argv[i], "--") == 0) {
	    i++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", argv[i],
		    "\": must be -async, -displayof, or --", (char *) NULL);
	    return TCL_ERROR;
	}
    }

    if (argc < (i+2)) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" ?options? interpName arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }
    destName = argv[i];
    firstArg = i+1;

    dispPtr = winPtr->dispPtr;
    if (dispPtr->commTkwin == NULL) {
	SendInit(interp, winPtr->dispPtr);
    }

    /*
     * See if the target interpreter is local.  If so, execute
     * the command directly without going through the X server.
     * The only tricky thing is passing the result from the target
     * interpreter to the invoking interpreter.  Watch out:  they
     * could be the same!
     */

    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
            riPtr = riPtr->nextPtr) {
	if ((riPtr->dispPtr != dispPtr)
		|| (strcmp(riPtr->name, destName) != 0)) {
	    continue;
	}
	Tcl_Preserve((ClientData) riPtr);
        localInterp = riPtr->interp;
        Tcl_Preserve((ClientData) localInterp);
	if (firstArg == (argc-1)) {
	    result = Tcl_GlobalEval(localInterp, argv[firstArg]);
	} else {
	    Tcl_DStringInit(&request);
	    Tcl_DStringAppend(&request, argv[firstArg], -1);
	    for (i = firstArg+1; i < argc; i++) {
		Tcl_DStringAppend(&request, " ", 1);
		Tcl_DStringAppend(&request, argv[i], -1);
	    }
	    result = Tcl_GlobalEval(localInterp, Tcl_DStringValue(&request));
	    Tcl_DStringFree(&request);
	}
	if (interp != localInterp) {
	    if (result == TCL_ERROR) {
		Tcl_Obj *errorObjPtr;

		/*
		 * An error occurred, so transfer error information from the
		 * destination interpreter back to our interpreter.  Must clear
		 * interp's result before calling Tcl_AddErrorInfo, since
		 * Tcl_AddErrorInfo will store the interp's result in errorInfo
		 * before appending riPtr's $errorInfo;  we've already got
		 * everything we need in riPtr's $errorInfo.
		 */

		Tcl_ResetResult(interp);
		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
		errorObjPtr = Tcl_GetVar2Ex(localInterp, "errorCode", NULL,
			TCL_GLOBAL_ONLY);
		Tcl_SetObjErrorCode(interp, errorObjPtr);
	    }
	    Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
            Tcl_ResetResult(localInterp);
	}
	Tcl_Release((ClientData) riPtr);
        Tcl_Release((ClientData) localInterp);
	return result;
    }

    /*
     * Bind the interpreter name to a communication window.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 0);
    commWindow = RegFindName(regPtr, destName);
    RegClose(regPtr);
    if (commWindow == None) {
	Tcl_AppendResult(interp, "no application named \"",
		destName, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Send the command to the target interpreter by appending it to the
     * comm window in the communication window.
     */

    tkSendSerial++;
    Tcl_DStringInit(&request);
    Tcl_DStringAppend(&request, "\0c\0-n ", 6);
    Tcl_DStringAppend(&request, destName, -1);
    if (!async) {
	char buffer[TCL_INTEGER_SPACE * 2];

	sprintf(buffer, "%x %d",
		(unsigned int) Tk_WindowId(dispPtr->commTkwin),
		tkSendSerial);
	Tcl_DStringAppend(&request, "\0-r ", 4);
	Tcl_DStringAppend(&request, buffer, -1);
    }
    Tcl_DStringAppend(&request, "\0-s ", 4);
    Tcl_DStringAppend(&request, argv[firstArg], -1);
    for (i = firstArg+1; i < argc; i++) {
	Tcl_DStringAppend(&request, " ", 1);
	Tcl_DStringAppend(&request, argv[i], -1);
    }
    (void) AppendPropCarefully(dispPtr->display, commWindow,
	    dispPtr->commProperty, Tcl_DStringValue(&request),
	    Tcl_DStringLength(&request) + 1,
	    (async) ? (PendingCommand *) NULL : &pending);
    Tcl_DStringFree(&request);
    if (async) {
	/*
	 * This is an asynchronous send:  return immediately without
	 * waiting for a response.
	 */

	return TCL_OK;
    }

    /*
     * Register the fact that we're waiting for a command to complete
     * (this is needed by SendEventProc and by AppendErrorProc to pass
     * back the command's results).  Set up a timeout handler so that
     * we can check during long sends to make sure that the destination
     * application is still alive.
     */

    pending.serial = tkSendSerial;
    pending.dispPtr = dispPtr;
    pending.target = destName;
    pending.commWindow = commWindow;
    pending.interp = interp;
    pending.result = NULL;
    pending.errorInfo = NULL;
    pending.errorCode = NULL;
    pending.gotResponse = 0;
    pending.nextPtr = tsdPtr->pendingCommands;
    tsdPtr->pendingCommands = &pending;

    /*
     * Enter a loop processing X events until the result comes
     * in or the target is declared to be dead.  While waiting
     * for a result, look only at send-related events so that
     * the send is synchronous with respect to other events in
     * the application.
     */

    prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
	    (ClientData) NULL, &prevArg);
    Tcl_GetTime(&timeout);
    timeout.sec += 2;
    while (!pending.gotResponse) {
	if (!TkUnixDoOneXEvent(&timeout)) {
	    /*
	     * An unusually long amount of time has elapsed during the
	     * processing of a sent command.  Check to make sure that the
	     * target application still exists.  If it does, reset the timeout.
	     */

	    if (!ValidateName(pending.dispPtr, pending.target,
		    pending.commWindow, 0)) {
		char *msg;
		if (ValidateName(pending.dispPtr, pending.target,
			pending.commWindow, 1)) {
		    msg = "target application died or uses a Tk version before 4.0";
		} else {
		    msg = "target application died";
		}
		pending.code = TCL_ERROR;
		pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1));
		strcpy(pending.result, msg);
		pending.gotResponse = 1;
	    } else {
		Tcl_GetTime(&timeout);
		timeout.sec += 2;
	    }
	}
    }
    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);

    /*
     * Unregister the information about the pending command
     * and return the result.
     */

    if (tsdPtr->pendingCommands != &pending) {
	panic("Tk_SendCmd: corrupted send stack");
    }
    tsdPtr->pendingCommands = pending.nextPtr;
    if (pending.errorInfo != NULL) {
	/*
	 * Special trick: must clear the interp's result before calling
	 * Tcl_AddErrorInfo, since Tcl_AddErrorInfo will store the interp's
	 * result in errorInfo before appending pending.errorInfo;  we've
	 * already got everything we need in pending.errorInfo.
	 */

	Tcl_ResetResult(interp);
	Tcl_AddErrorInfo(interp, pending.errorInfo);
	ckfree(pending.errorInfo);
    }
    if (pending.errorCode != NULL) {
	Tcl_Obj *errorObjPtr;
	errorObjPtr = Tcl_NewStringObj(pending.errorCode, -1);
	Tcl_SetObjErrorCode(interp, errorObjPtr);
	ckfree(pending.errorCode);
    }
    Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
    return pending.code;
}

/*
 *----------------------------------------------------------------------
 *
 * TkGetInterpNames --
 *
 *	This procedure is invoked to fetch a list of all the
 *	interpreter names currently registered for the display
 *	of a particular window.
 *
 * Results:
 *	A standard Tcl return value.  The interp's result will be set
 *	to hold a list of all the interpreter names defined for
 *	tkwin's display.  If an error occurs, then TCL_ERROR
 *	is returned and the interp's result will hold an error message.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TkGetInterpNames(interp, tkwin)
    Tcl_Interp *interp;		/* Interpreter for returning a result. */
    Tk_Window tkwin;		/* Window whose display is to be used
				 * for the lookup. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    char *p, *entry, *entryName;
    NameRegistry *regPtr;
    Window commWindow;
    int count;
    unsigned int id;

    /*
     * Read the registry property, then scan through all of its entries.
     * Validate each entry to be sure that its application still exists.
     */

    regPtr = RegOpen(interp, winPtr->dispPtr, 1);
    for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
	entry = p;
	if (sscanf(p,  "%x",(unsigned int *) &id) != 1) {
	    commWindow =  None;
	} else {
	    commWindow = id;
	}
	while ((*p != 0) && (!isspace(UCHAR(*p)))) {
	    p++;
	}
	if (*p != 0) {
	    p++;
	}
	entryName = p;
	while (*p != 0) {
	    p++;
	}
	p++;
	if (ValidateName(winPtr->dispPtr, entryName, commWindow, 1)) {
	    /*
	     * The application still exists; add its name to the result.
	     */

	    Tcl_AppendElement(interp, entryName);
	} else {
	    /*
	     * This name is bogus (perhaps the application died without
	     * cleaning up its entry in the registry?).  Delete the name.
	     */

	    count = regPtr->propLength - (p - regPtr->property);
	    if (count > 0)  {
		char *src, *dst;

		for (src = p, dst = entry; count > 0; src++, dst++, count--) {
		    *dst = *src;
		}
	    }
	    regPtr->propLength -= p - entry;
	    regPtr->modified = 1;
	    p = entry;
	}
    }
    RegClose(regPtr);
    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * TkSendCleanup --
 *
 *	This procedure is called to free resources used by the
 *	communication channels for sending commands and
 *	receiving results.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees various data structures and windows.
 *
 *--------------------------------------------------------------
 */

void
TkSendCleanup(dispPtr)
    TkDisplay *dispPtr;
{
    if (dispPtr->commTkwin != NULL) {
	Tk_DeleteEventHandler(dispPtr->commTkwin, PropertyChangeMask,
		SendEventProc, (ClientData) dispPtr);
	Tk_DestroyWindow(dispPtr->commTkwin);
	Tcl_Release((ClientData) dispPtr->commTkwin);
	dispPtr->commTkwin = NULL;
    }
}

/*
 *--------------------------------------------------------------
 *
 * SendInit --
 *
 *	This procedure is called to initialize the
 *	communication channels for sending commands and
 *	receiving results.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up various data structures and windows.
 *
 *--------------------------------------------------------------
 */

static int
SendInit(interp, dispPtr)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting
				 * (no errors are ever returned, but the
				 * interpreter is needed anyway). */
    TkDisplay *dispPtr;		/* Display to initialize. */
{
    XSetWindowAttributes atts;

    /*
     * Create the window used for communication, and set up an
     * event handler for it.
     */

    dispPtr->commTkwin = Tk_CreateWindow(interp, (Tk_Window) NULL,
	    "_comm", DisplayString(dispPtr->display));
    if (dispPtr->commTkwin == NULL) {
	panic("Tk_CreateWindow failed in SendInit!");
    }
    Tcl_Preserve((ClientData) dispPtr->commTkwin);
    atts.override_redirect = True;
    Tk_ChangeWindowAttributes(dispPtr->commTkwin,
	    CWOverrideRedirect, &atts);
    Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask,
	    SendEventProc, (ClientData) dispPtr);
    Tk_MakeWindowExist(dispPtr->commTkwin);

    /*
     * Get atoms used as property names.
     */

    dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm");
    dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin,
	    "InterpRegistry");
    dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin,
	    "TK_APPLICATION");

    return TCL_OK;
}

/*
 *--------------------------------------------------------------
 *
 * SendEventProc --
 *
 *	This procedure is invoked automatically by the toolkit
 *	event manager when a property changes on the communication
 *	window.  This procedure reads the property and handles
 *	command requests and responses.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there are command requests in the property, they
 *	are executed.  If there are responses in the property,
 *	their information is saved for the (ostensibly waiting)
 *	"send" commands. The property is deleted.
 *
 *--------------------------------------------------------------
 */

static void
SendEventProc(clientData, eventPtr)
    ClientData clientData;	/* Display information. */	
    XEvent *eventPtr;		/* Information about event. */
{
    TkDisplay *dispPtr = (TkDisplay *) clientData;
    char *propInfo;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;
    Tcl_Interp *remoteInterp;	/* Interp in which to execute the command. */
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if ((eventPtr->xproperty.atom != dispPtr->commProperty)
	    || (eventPtr->xproperty.state != PropertyNewValue)) {
	return;
    }

    /*
     * Read the comm property and delete it.
     */

    propInfo = NULL;
    result = XGetWindowProperty(dispPtr->display,
	    Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
	    XA_STRING, &actualType, &actualFormat,
	    &numItems, &bytesAfter, (unsigned char **) &propInfo);

    /*
     * If the property doesn't exist or is improperly formed
     * then ignore it.
     */

    if ((result != Success) || (actualType != XA_STRING)
	    || (actualFormat != 8)) {
	if (propInfo != NULL) {
	    XFree(propInfo);
	}
	return;
    }

    /*
     * Several commands and results could arrive in the property at
     * one time;  each iteration through the outer loop handles a
     * single command or result.
     */

    for (p = propInfo; (p-propInfo) < (int) numItems; ) {
	/*
	 * Ignore leading NULLs; each command or result starts with a
	 * NULL so that no matter how badly formed a preceding command
	 * is, we'll be able to tell that a new command/result is
	 * starting.
	 */

	if (*p == 0) {
	    p++;
	    continue;
	}

	if ((*p == 'c') && (p[1] == 0)) {
	    Window commWindow;
	    char *interpName, *script, *serial, *end;
	    Tcl_DString reply;
	    RegisteredInterp *riPtr;

	    /*
	     *----------------------------------------------------------
	     * This is an incoming command from some other application.
	     * Iterate over all of its options.  Stop when we reach
	     * the end of the property or something that doesn't look
	     * like an option.
	     *----------------------------------------------------------
	     */

	    p += 2;
	    interpName = NULL;
	    commWindow = None;
	    serial = "";
	    script = NULL;
	    while (((p-propInfo) < (int) numItems) && (*p == '-')) {
		switch (p[1]) {
		    case 'r':
			commWindow = (Window) strtoul(p+2, &end, 16);
			if ((end == p+2) || (*end != ' ')) {
			    commWindow = None;
			} else {
			    p = serial = end+1;
			}
			break;
		    case 'n':
			if (p[2] == ' ') {
			    interpName = p+3;
			}
			break;
		    case 's':
			if (p[2] == ' ') {
			    script = p+3;
			}
			break;
		}
		while (*p != 0) {
		    p++;
		}
		p++;
	    }

	    if ((script == NULL) || (interpName == NULL)) {
		continue;
	    }

	    /*
	     * Initialize the result property, so that we're ready at any
	     * time if we need to return an error.
	     */

	    if (commWindow != None) {
		Tcl_DStringInit(&reply);
		Tcl_DStringAppend(&reply, "\0r\0-s ", 6);
		Tcl_DStringAppend(&reply, serial, -1);
		Tcl_DStringAppend(&reply, "\0-r ", 4);
	    }

	    if (!ServerSecure(dispPtr)) {
		if (commWindow != None) {
		    Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style authorization); command ignored", -1);
		}
		result = TCL_ERROR;
		goto returnResult;
	    }

	    /*
	     * Locate the application, then execute the script.
	     */

	    for (riPtr = tsdPtr->interpListPtr; ; riPtr = riPtr->nextPtr) {
		if (riPtr == NULL) {
		    if (commWindow != None) {
			Tcl_DStringAppend(&reply,
				"receiver never heard of interpreter \"", -1);
			Tcl_DStringAppend(&reply, interpName, -1);
			Tcl_DStringAppend(&reply, "\"", 1);
		    }
		    result = TCL_ERROR;
		    goto returnResult;
		}
		if (strcmp(riPtr->name, interpName) == 0) {
		    break;
		}
	    }
	    Tcl_Preserve((ClientData) riPtr);

            /*
             * We must protect the interpreter because the script may
             * enter another event loop, which might call Tcl_DeleteInterp.
             */

            remoteInterp = riPtr->interp;
            Tcl_Preserve((ClientData) remoteInterp);

            result = Tcl_GlobalEval(remoteInterp, script);

            /*
             * The call to Tcl_Release may have released the interpreter
             * which will cause the "send" command for that interpreter
             * to be deleted. The command deletion callback will set the
             * riPtr->interp field to NULL, hence the check below for NULL.
             */

	    if (commWindow != None) {
		Tcl_DStringAppend(&reply, Tcl_GetStringResult(remoteInterp),
			-1);
		if (result == TCL_ERROR) {
		    CONST char *varValue;
    
		    varValue = Tcl_GetVar2(remoteInterp, "errorInfo",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-i ", 4);
			Tcl_DStringAppend(&reply, varValue, -1);
		    }
		    varValue = Tcl_GetVar2(remoteInterp, "errorCode",
			    (char *) NULL, TCL_GLOBAL_ONLY);
		    if (varValue != NULL) {
			Tcl_DStringAppend(&reply, "\0-e ", 4);
			Tcl_DStringAppend(&reply, varValue, -1);
		    }
		}
	    }
            Tcl_Release((ClientData) remoteInterp);
	    Tcl_Release((ClientData) riPtr);

	    /*
	     * Return the result to the sender if a commWindow was
	     * specified (if none was specified then this is an asynchronous
	     * call).  Right now reply has everything but the completion
	     * code, but it needs the NULL to terminate the current option.
	     */

	    returnResult:
	    if (commWindow != None) {
		if (result != TCL_OK) {
		    char buffer[TCL_INTEGER_SPACE];
    
		    sprintf(buffer, "%d", result);
		    Tcl_DStringAppend(&reply, "\0-c ", 4);
		    Tcl_DStringAppend(&reply, buffer, -1);
		}
		(void) AppendPropCarefully(dispPtr->display, commWindow,
			dispPtr->commProperty, Tcl_DStringValue(&reply),
			Tcl_DStringLength(&reply) + 1,
			(PendingCommand *) NULL);
		XFlush(dispPtr->display);
		Tcl_DStringFree(&reply);
	    }
	} else if ((*p == 'r') && (p[1] == 0)) {
	    int serial, code, gotSerial;
	    char *errorInfo, *errorCode, *resultString;
	    PendingCommand *pcPtr;

	    /*
	     *----------------------------------------------------------
	     * This is a reply to some command that we sent out.  Iterate
	     * over all of its options.  Stop when we reach the end of the
	     * property or something that doesn't look like an option.
	     *----------------------------------------------------------
	     */

	    p += 2;
	    code = TCL_OK;
	    gotSerial = 0;
	    errorInfo = NULL;
	    errorCode = NULL;
	    resultString = "";
	    while (((p-propInfo) < (int) numItems) && (*p == '-')) {
		switch (p[1]) {
		    case 'c':
			if (sscanf(p+2, " %d", &code) != 1) {
			    code = TCL_OK;
			}
			break;
		    case 'e':
			if (p[2] == ' ') {
			    errorCode = p+3;
			}
			break;
		    case 'i':
			if (p[2] == ' ') {
			    errorInfo = p+3;
			}
			break;
		    case 'r':
			if (p[2] == ' ') {
			    resultString = p+3;
			}
			break;
		    case 's':
			if (sscanf(p+2, " %d", &serial) == 1) {
			    gotSerial = 1;
			}
			break;
		}
		while (*p != 0) {
		    p++;
		}
		p++;
	    }

	    if (!gotSerial) {
		continue;
	    }

	    /*
	     * Give the result information to anyone who's
	     * waiting for it.
	     */

	    for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
		    pcPtr = pcPtr->nextPtr) {
		if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
		    continue;
		}
		pcPtr->code = code;
		if (resultString != NULL) {
		    pcPtr->result = (char *) ckalloc((unsigned)
			    (strlen(resultString) + 1));
		    strcpy(pcPtr->result, resultString);
		}
		if (code == TCL_ERROR) {
		    if (errorInfo != NULL) {
			pcPtr->errorInfo = (char *) ckalloc((unsigned)
				(strlen(errorInfo) + 1));
			strcpy(pcPtr->errorInfo, errorInfo);
		    }
		    if (errorCode != NULL) {
			pcPtr->errorCode = (char *) ckalloc((unsigned)
				(strlen(errorCode) + 1));
			strcpy(pcPtr->errorCode, errorCode);
		    }
		}
		pcPtr->gotResponse = 1;
		break;
	    }
	} else {
	    /*
	     * Didn't recognize this thing.  Just skip through the next
	     * null character and try again.
	     */

	    while (*p != 0) {
		p++;
	    }
	    p++;
	}
    }
    XFree(propInfo);
}

/*
 *--------------------------------------------------------------
 *
 * AppendPropCarefully --
 *
 *	Append a given property to a given window, but set up
 *	an X error handler so that if the append fails this
 *	procedure can return an error code rather than having
 *	Xlib panic.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The given property on the given window is appended to.
 *	If this operation fails and if pendingPtr is non-NULL,
 *	then the pending operation is marked as complete with
 *	an error.
 *
 *--------------------------------------------------------------
 */

static void
AppendPropCarefully(display, window, property, value, length, pendingPtr)
    Display *display;		/* Display on which to operate. */
    Window window;		/* Window whose property is to
				 * be modified. */
    Atom property;		/* Name of property. */
    char *value;		/* Characters to append to property. */
    int length;			/* Number of bytes to append. */
    PendingCommand *pendingPtr;	/* Pending command to mark complete
				 * if an error occurs during the
				 * property op.  NULL means just
				 * ignore the error. */
{
    Tk_ErrorHandler handler;

    handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
	(ClientData) pendingPtr);
    XChangeProperty(display, window, property, XA_STRING, 8,
	    PropModeAppend, (unsigned char *) value, length);
    Tk_DeleteErrorHandler(handler);
}

/*
 * The procedure below is invoked if an error occurs during
 * the XChangeProperty operation above.
 */

	/* ARGSUSED */
static int
AppendErrorProc(clientData, errorPtr)
    ClientData clientData;	/* Command to mark complete, or NULL. */
    XErrorEvent *errorPtr;	/* Information about error. */
{
    PendingCommand *pendingPtr = (PendingCommand *) clientData;
    register PendingCommand *pcPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (pendingPtr == NULL) {
	return 0;
    }

    /*
     * Make sure this command is still pending.
     */

    for (pcPtr = tsdPtr->pendingCommands; pcPtr != NULL;
	    pcPtr = pcPtr->nextPtr) {
	if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
	    pcPtr->result = (char *) ckalloc((unsigned)
		    (strlen(pcPtr->target) + 50));
	    sprintf(pcPtr->result, "no application named \"%s\"",
		    pcPtr->target);
	    pcPtr->code = TCL_ERROR;
	    pcPtr->gotResponse = 1;
	    break;
	}
    }
    return 0;
}

/*
 *--------------------------------------------------------------
 *
 * DeleteProc --
 *
 *	This procedure is invoked by Tcl when the "send" command
 *	is deleted in an interpreter.  It unregisters the interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The interpreter given by riPtr is unregistered.
 *
 *--------------------------------------------------------------
 */

static void
DeleteProc(clientData)
    ClientData clientData;	/* Info about registration, passed
				 * as ClientData. */
{
    RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
    register RegisteredInterp *riPtr2;
    NameRegistry *regPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
    RegDeleteName(regPtr, riPtr->name);
    RegClose(regPtr);

    if (tsdPtr->interpListPtr == riPtr) {
	tsdPtr->interpListPtr = riPtr->nextPtr;
    } else {
	for (riPtr2 = tsdPtr->interpListPtr; riPtr2 != NULL;
		riPtr2 = riPtr2->nextPtr) {
	    if (riPtr2->nextPtr == riPtr) {
		riPtr2->nextPtr = riPtr->nextPtr;
		break;
	    }
	}
    }
    ckfree((char *) riPtr->name);
    riPtr->interp = NULL;
    UpdateCommWindow(riPtr->dispPtr);
    Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * SendRestrictProc --
 *
 *	This procedure filters incoming events when a "send" command
 *	is outstanding.  It defers all events except those containing
 *	send commands and results.
 *
 * Results:
 *	False is returned except for property-change events on a
 *	commWindow.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static Tk_RestrictAction
SendRestrictProc(clientData, eventPtr)
    ClientData clientData;		/* Not used. */
    register XEvent *eventPtr;		/* Event that just arrived. */
{
    TkDisplay *dispPtr;

    if (eventPtr->type != PropertyNotify) {
	return TK_DEFER_EVENT;
    }
    for (dispPtr = TkGetDisplayList(); dispPtr != NULL; 
            dispPtr = dispPtr->nextPtr) {
	if ((eventPtr->xany.display == dispPtr->display)
		&& (eventPtr->xproperty.window
		== Tk_WindowId(dispPtr->commTkwin))) {
	    return TK_PROCESS_EVENT;
	}
    }
    return TK_DEFER_EVENT;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateCommWindow --
 *
 *	This procedure updates the list of application names stored
 *	on our commWindow.  It is typically called when interpreters
 *	are registered and unregistered.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The TK_APPLICATION property on the comm window is updated.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateCommWindow(dispPtr)
    TkDisplay *dispPtr;		/* Display whose commWindow is to be
				 * updated. */
{
    Tcl_DString names;
    RegisteredInterp *riPtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) 
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    Tcl_DStringInit(&names);
    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL; 
            riPtr = riPtr->nextPtr) {
	Tcl_DStringAppendElement(&names, riPtr->name);
    }
    XChangeProperty(dispPtr->display, Tk_WindowId(dispPtr->commTkwin),
	    dispPtr->appNameProperty, XA_STRING, 8, PropModeReplace,
	    (unsigned char *) Tcl_DStringValue(&names),
	    Tcl_DStringLength(&names));
    Tcl_DStringFree(&names);
}