Initial revision

1 files changed, 1851 insertions, 0 deletions

diff --git a/unix/tkUnixSend.c b/unix/tkUnixSend.c
new file mode 100644
index 0000000..f07c59b
--- /dev/null
+++ b/unix/tkUnixSend.c
@@ -0,0 +1,1851 @@
+/* 
+ * 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.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tkUnixSend.c 1.74 97/11/04 17:12:18
+ */
+
+#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;
+
+static RegisteredInterp *registry = NULL;
+				/* List of all interpreters
+				 * registered by this process. */
+
+/*
+ * 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. */
+    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;
+
+static PendingCommand *pendingCommands = NULL;
+				/* List of all commands currently
+				 * being waited for. */
+
+/*
+ * 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,
+			    char *name, Window commWindow));
+static void		RegClose _ANSI_ARGS_((NameRegistry *regPtr));
+static void		RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr,
+			    char *name));
+static Window		RegFindName _ANSI_ARGS_((NameRegistry *regPtr,
+			    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,
+			    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
+ *	neeeded, 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. */
+    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. */
+    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. */
+    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. */
+    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;
+    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.
+ *
+ *--------------------------------------------------------------
+ */
+
+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.  */
+    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;
+    NameRegistry *regPtr;
+    Tcl_Interp *interp;
+    char *actualName;
+    Tcl_DString dString;
+    int offset, i;
+
+#ifdef __WIN32__
+    return name;
+#endif /* __WIN32__ */
+    
+    dispPtr = winPtr->dispPtr;
+    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 = registry; ; 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 = registry;
+	    registry = riPtr;
+	    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.
+	     */
+
+	    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+10);
+		actualName = Tcl_DStringValue(&dString);
+	    }
+	    sprintf(actualName + 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 = registry; 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. */
+    char **argv;			/* Argument strings. */
+{
+    TkWindow *winPtr;
+    Window commWindow;
+    PendingCommand pending;
+    register RegisteredInterp *riPtr;
+    char *destName, buffer[30];
+    int result, c, async, i, firstArg;
+    size_t length;
+    Tk_RestrictProc *prevRestrictProc;
+    ClientData prevArg;
+    TkDisplay *dispPtr;
+    Tcl_Time timeout;
+    NameRegistry *regPtr;
+    Tcl_DString request;
+    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 = registry; 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) {
+
+		/*
+		 * 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));
+		Tcl_SetVar2(interp, "errorCode", (char *) NULL,
+			Tcl_GetVar2(localInterp, "errorCode", (char *) NULL,
+			TCL_GLOBAL_ONLY), TCL_GLOBAL_ONLY);
+	    }
+            if (localInterp->freeProc != TCL_STATIC) {
+                interp->result = localInterp->result;
+                interp->freeProc = localInterp->freeProc;
+                localInterp->freeProc = TCL_STATIC;
+            } else {
+                Tcl_SetResult(interp, localInterp->result, TCL_VOLATILE);
+            }
+            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) {
+	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 = pendingCommands;
+    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);
+    TclpGetTime(&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 {
+		TclpGetTime(&timeout);
+		timeout.sec += 2;
+	    }
+	}
+    }
+    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);
+
+    /*
+     * Unregister the information about the pending command
+     * and return the result.
+     */
+
+    if (pendingCommands != &pending) {
+	panic("Tk_SendCmd: corrupted send stack");
+    }
+    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_SetVar2(interp, "errorCode", (char *) NULL, pending.errorCode,
+		TCL_GLOBAL_ONLY);
+	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.  Interp->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 interp->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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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!");
+    }
+    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. */
+
+    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 = registry; ; 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, remoteInterp->result, -1);
+		if (result == TCL_ERROR) {
+		    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[20];
+    
+		    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 = 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;
+
+    if (pendingPtr == NULL) {
+	return 0;
+    }
+
+    /*
+     * Make sure this command is still pending.
+     */
+
+    for (pcPtr = 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;
+
+    regPtr = RegOpen(riPtr->interp, riPtr->dispPtr, 1);
+    RegDeleteName(regPtr, riPtr->name);
+    RegClose(regPtr);
+
+    if (registry == riPtr) {
+	registry = riPtr->nextPtr;
+    } else {
+	for (riPtr2 = registry; 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 = tkDisplayList; 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;
+
+    Tcl_DStringInit(&names);
+    for (riPtr = registry; 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);
+}