src/sim/makefile: Micropolis build fixes for recent macOS

[micropolis] / src / tk / tksend.c

/* 
 * tkSend.c --
 *
 *	This file provides procedures that implement the "send"
 *	command, allowing commands to be passed from interpreter
 *	to interpreter.
 *
 * Copyright 1989-1992 Regents of the University of California
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSend.c,v 1.26 92/08/13 10:29:26 ouster Exp $ SPRITE (Berkeley)";
#endif

#include "tkconfig.h"
#include "tkint.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. */
    TkDisplay *dispPtr;		/* Display associated with name. */
    TkWindow *winPtr;		/* Window associated with name. */
    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. */

/*
 * 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. */
    char *target;		/* Name of interpreter command is
				 * being sent to. */
    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).
				 * NULL means command still pending. */
    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.  In each case, the property information
 * is in the form of an ASCII string.  The exact syntaxes are:
 *
 * Command:
 *	'C' space window space serial space interpName '|' command '\0'
 * The 'C' character indicates that this is a command and not
 * a response.  Window is the hex identifier for the comm
 * window on which to append the response.  Serial is a hex
 * integer containing an identifying number assigned by the
 * sender;  it may be used by the sender to sort out concurrent
 * responses.  InterpName is the ASCII name of the desired
 * interpreter, which must not contain any vertical bar characters
 * The interpreter name is delimited by a vertical bar (this
 * allows the name to include blanks), and is followed by
 * the command to execute.  The command is terminated by a
 * NULL character.
 *
 * Response:
 *	'R' space serial space code space result '\0'
 * The 'R' character indicates that this is a response.  Serial
 * gives the identifier for the command (same value as in the
 * command message).  The code field is a decimal integer giving
 * the Tcl return code from the command, and result is the string
 * result.  The result is terminated by a NULL character.
 *
 * The register of interpreters 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".
 */

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

#define MAX_PROP_WORDS 100000

/*
 * 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,
		    PendingCommand *pendingPtr));
static void	DeleteProc _ANSI_ARGS_((ClientData clientData));
static Window	LookupName _ANSI_ARGS_((TkDisplay *dispPtr, char *name,
		    int delete));
static void	SendEventProc _ANSI_ARGS_((ClientData clientData,
		    XEvent *eventPtr));
static int	SendInit _ANSI_ARGS_((Tcl_Interp *interp, TkDisplay *dispPtr));
static Bool	SendRestrictProc _ANSI_ARGS_((Display *display,
		    XEvent *eventPtr, char *arg));
static void	TimeoutProc _ANSI_ARGS_((ClientData clientData));
\f
/*
 *--------------------------------------------------------------
 *
 * Tk_RegisterInterp --
 *
 *	This procedure is called to associate an ASCII name
 *	with an interpreter.  Tk_InitSend must previously
 *	have been called to set up communication channels
 *	and specify a display.
 *
 * Results:
 *	Zero is returned if the name was registered successfully.
 *	Non-zero means the name was already in use.
 *
 * Side effects:
 *	Registration info is saved, thereby allowing the
 *	"send" command to be used later to invoke commands
 *	in the interpreter.  The registration will be removed
 *	automatically when the interpreter is deleted.
 *
 *--------------------------------------------------------------
 */

int
Tk_RegisterInterp(interp, name, tkwin)
    Tcl_Interp *interp;		/* Interpreter associated with name. */
    char *name;			/* The name that will be used to
				 * refer to the interpreter in later
				 * "send" commands.  Must be globally
				 * unique. */
    Tk_Window tkwin;		/* Token for window associated with
				 * interp;  used to identify display
				 * for communication.  */
{
#define TCL_MAX_NAME_LENGTH 1000
    char propInfo[TCL_MAX_NAME_LENGTH + 20];
    register RegisteredInterp *riPtr;
    Window w;
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkDisplay *dispPtr;

    if (strchr(name, '|') != NULL) {
	interp->result =
		"interpreter name cannot contain '|' character";
	return TCL_ERROR;
    }

    dispPtr = winPtr->dispPtr;
    if (dispPtr->commWindow == NULL) {
	int result;

	result = SendInit(interp, dispPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    /*
     * Make sure the name is unique, and append info about it to
     * the registry property.  Eventually, it would probably be
     * a good idea to lock the server here to prevent conflicting
     * changes to the registry property.  But that would make
     * testing more difficult, and probably isn't necessary
     * anyway because new windows don't get created all that often.
     */

    w = LookupName(dispPtr, name, 0);
    if (w != (Window) 0) {
	Tcl_Interp *tmpInterp;
	RegisteredInterp tmpRi;
	int result;
	char *argv[3];

	/*
	 * Name already exists.  Ping the interpreter with a
	 * NULL command to see if it already exists.  If not,
	 * unregister the old name (this could happen if an
	 * application dies without cleaning up the registry).
	 */

	tmpInterp = Tcl_CreateInterp();
	argv[0] = "send";
	argv[1] = name;
	argv[2] = "";
	tmpRi.dispPtr = dispPtr;
	tmpRi.winPtr = winPtr;
	result = Tk_SendCmd((ClientData) &tmpRi, tmpInterp, 3, argv);
	Tcl_DeleteInterp(tmpInterp);
	if (result == TCL_OK) {
	    Tcl_AppendResult(interp, "interpreter name \"", name,
		    "\" is already in use", (char *) NULL);
	    return TCL_ERROR;
	}
	(void) LookupName(winPtr->dispPtr, name, 1);
    }
    sprintf(propInfo, "%x %.*s", Tk_WindowId(dispPtr->commWindow),
	    TCL_MAX_NAME_LENGTH, name);
    XChangeProperty(dispPtr->display,
	    Tk_DefaultRootWindow(dispPtr->display),
	    dispPtr->registryProperty, XA_STRING, 8, PropModeAppend,
	    (unsigned char *) propInfo, strlen(propInfo)+1);

    /*
     * Add an entry in the local registry of names owned by this
     * process.
     */

    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
    riPtr->name = (char *) ckalloc((unsigned) (strlen(name) + 1));
    strcpy(riPtr->name, name);
    riPtr->interp = interp;
    riPtr->dispPtr = dispPtr;
    riPtr->winPtr = winPtr;
    riPtr->nextPtr = registry;
    registry = riPtr;

    /*
     * Add the "send" command to this interpreter, and arrange for
     * us to be notified when the interpreter is deleted (actually,
     * when the "send" command is deleted).
     */

    Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
	    DeleteProc);

    return TCL_OK;
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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. */
{
    RegisteredInterp *senderRiPtr = (RegisteredInterp *) clientData;
    Window w;
#define STATIC_PROP_SPACE 100
    char *property, staticSpace[STATIC_PROP_SPACE];
    int length;
    int quick = 0;
    static int serial = 0;	/* Running count of sent commands.
				 * Used to give each command a
				 * different serial number. */
    PendingCommand pending;
    Tk_TimerToken timeout;
    register RegisteredInterp *riPtr;
    char *cmd;
    int result;
    Bool (*prevRestrictProc)();
    char *prevArg;
    TkWindow *winPtr = senderRiPtr->winPtr;
    TkDisplay *dispPtr = senderRiPtr->dispPtr;
    int to_server = 0;

    if (argc >= 2) {
      Tk_Window tkwin = NULL;

      if ((argv[1][0] == '-') &&
	  (strncmp(argv[1], "-quick", strlen(argv[1])) == 0)) {
	quick = 1;
	argv += 1; argc -= 1;
      }
    }

    if (argc >= 3) {
      Tk_Window tkwin = NULL;

      if ((argv[1][0] == '-') &&
	  (strncmp(argv[1], "-server", strlen(argv[1])) == 0)) {
	to_server = 1;
	tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) winPtr);
	if (tkwin == NULL) {
	  Tcl_AppendResult(interp, "bad server arg, should be window name: ",
			   argv[2], (char *) NULL);
	  return TCL_ERROR;
	}
	winPtr = (TkWindow *) tkwin;
	dispPtr = winPtr->dispPtr;
	argv += 2; argc -= 2;
      }
    }

    if (dispPtr->commWindow == NULL) {
	result = SendInit(interp, dispPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    if (argc < 3) {
    badargs:
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" interpName arg ?arg ...?\"", (char *) NULL);
	return TCL_ERROR;
    }

    if (argc == 3) {
	cmd = argv[2];
    } else {
	cmd = Tcl_Concat(argc-2, argv+2);
    }

    /*
     * 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 (strcmp(riPtr->name, argv[1]) != 0) {
	    continue;
	}
	if (interp == riPtr->interp) {
	    result = Tcl_GlobalEval(interp, cmd);
	} else {
	    result = Tcl_GlobalEval(riPtr->interp, cmd);
	    interp->result = riPtr->interp->result;
	    interp->freeProc = riPtr->interp->freeProc;
	    riPtr->interp->freeProc = 0;
	    Tcl_ResetResult(riPtr->interp);
	}
	if (cmd != argv[2]) {
	    ckfree(cmd);
	}
	return result;
    }

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

    w = LookupName(dispPtr, argv[1], 0);
    if (w == 0) {
	Tcl_AppendResult(interp, "no registered interpeter named \"",
		argv[1], "\"", (char *) NULL);
	if (cmd != argv[2]) {
	    ckfree(cmd);
	}
	return TCL_ERROR;
    }

    if (!quick) {
	/*
	 * 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).
	 */

	serial++;
	pending.serial = serial;
	pending.target = argv[1];
	pending.interp = interp;
	pending.result = NULL;
	pending.nextPtr = pendingCommands;
	pendingCommands = &pending;
    }

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

    length = strlen(argv[1]) + strlen(cmd) + 30;
    if (length <= STATIC_PROP_SPACE) {
	property = staticSpace;
    } else {
	property = (char *) ckalloc((unsigned) length);
    }
    sprintf(property, "C %x %x %s|%s",
	    Tk_WindowId(dispPtr->commWindow), serial, argv[1], cmd);
    (void) AppendPropCarefully(dispPtr->display, w, dispPtr->commProperty,
	    property, &pending);
    if (length > STATIC_PROP_SPACE) {
	ckfree(property);
    }
    if (cmd != argv[2]) {
	ckfree(cmd);
    }

    if (quick) {
      sprintf(interp->result, "NoReturnValue");
      return TCL_OK;
    }

    /*
     * Enter a loop processing X events until the result comes
     * in.  If no response is received within a few seconds,
     * then timeout.  While waiting for a result, look only at
     * send-related events (otherwise it would be possible for
     * additional input events, such as mouse motion, to cause
     * other sends, leading eventually to such a large number
     * of nested Tcl_Eval calls that the Tcl interpreter panics).
     */

    prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
	    (char *) dispPtr->commWindow, &prevArg);
    timeout = Tk_CreateTimerHandler(5000, TimeoutProc,
	    (ClientData) &pending);
    while (pending.result == NULL) {
	Tk_DoOneEvent(0);
    }
    Tk_DeleteTimerHandler(timeout);
    (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);

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

    if (pendingCommands == &pending) {
	pendingCommands = pending.nextPtr;
    } else {
	PendingCommand *pcPtr;

	for (pcPtr = pendingCommands; pcPtr != NULL;
		pcPtr = pcPtr->nextPtr) {
	    if (pcPtr->nextPtr == &pending) {
		pcPtr->nextPtr = pending.nextPtr;
		break;
	    }
	}
    }
    Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
    return pending.code;
    
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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. */
{
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
    char *regProp, *separator, *name;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;

    /*
     * Read the registry property.
     */

    regProp = NULL;
    result = XGetWindowProperty(dispPtr->display,
	    Tk_DefaultRootWindow(dispPtr->display),
	    dispPtr->registryProperty, 0, MAX_PROP_WORDS,
	    False, XA_STRING, &actualType, &actualFormat,
	    &numItems, &bytesAfter, (unsigned char **) &regProp);

    if (actualType == None) {
	sprintf(interp->result, "couldn't read intepreter registry property");
	return TCL_ERROR;
    }

    /*
     * If the property is improperly formed, then delete it.
     */

    if ((result != Success) || (actualFormat != 8)
	    || (actualType != XA_STRING)) {
	if (regProp != NULL) {
	    XFree(regProp);
	}
	sprintf(interp->result, "intepreter registry property is badly formed");
	return TCL_ERROR;
    }

    /*
     * Scan all of the names out of the property.
     */

    separator = "";
    for (p = regProp; (p-regProp) < numItems; p++) {
	name = p;
	while ((*p != 0) && (!isspace(*p))) {
	    p++;
	}
	if (*p != 0) {
	    name = p+1;
	    name = Tcl_Merge(1, &name);
	    Tcl_AppendResult(interp, separator, name, (char *) NULL);
	    while (*p != 0) {
		p++;
	    }
	    separator = " ";
	}
    }
    XFree(regProp);
    return TCL_OK;
}
\f
/*
 *--------------------------------------------------------------
 *
 * SendInit --
 *
 *	This procedure is called to initialize the
 *	communication channels for sending commands and
 *	receiving results.
 *
 * Results:
 *	The result is a standard Tcl return value, which is
 *	normally TCL_OK.  If an error occurs then an error
 *	message is left in interp->result and TCL_ERROR is
 *	returned.
 *
 * Side effects:
 *	Sets up various data structures and windows.
 *
 *--------------------------------------------------------------
 */

static int
SendInit(interp, dispPtr)
    Tcl_Interp *interp;		/* Interpreter to use for error
				 * reporting. */
    register TkDisplay *dispPtr;/* Display to initialize. */

{
    XSetWindowAttributes atts;

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

    dispPtr->commWindow = Tk_CreateWindow(interp, (Tk_Window) NULL,
	    "_comm", DisplayString(dispPtr->display));
    if (dispPtr->commWindow == NULL) {
	return TCL_ERROR;
    }
    atts.override_redirect = True;
    Tk_ChangeWindowAttributes(dispPtr->commWindow,
	    CWOverrideRedirect, &atts);
    Tk_CreateEventHandler(dispPtr->commWindow, PropertyChangeMask,
	    SendEventProc, (ClientData) dispPtr);
    Tk_MakeWindowExist(dispPtr->commWindow);

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

    dispPtr->commProperty = XInternAtom(dispPtr->display,
	    "Comm", False);
    dispPtr->registryProperty = XInternAtom(dispPtr->display,
	    "InterpRegistry", False);
    return TCL_OK;
}
\f
/*
 *--------------------------------------------------------------
 *
 * LookupName --
 *
 *	Given an interpreter name, see if the name exists in
 *	the interpreter registry for a particular display.
 *
 * Results:
 *	If the given name is registered, return the ID of
 *	the window associated with the name.  If the name
 *	isn't registered, then return 0.
 *
 * Side effects:
 *	If the registry property is improperly formed, then
 *	it is deleted.  If "delete" is non-zero, then if the
 *	named interpreter is found it is removed from the
 *	registry property.
 *
 *--------------------------------------------------------------
 */

static Window
LookupName(dispPtr, name, delete)
    register TkDisplay *dispPtr;
			/* Display whose registry to check. */
    char *name;		/* Name of an interpreter. */
    int delete;		/* If non-zero, delete info about name. */
{
    char *regProp, *entry;
    register char *p;
    int result, actualFormat;
    unsigned long numItems, bytesAfter;
    Atom actualType;
    Window returnValue;

    /*
     * Read the registry property.
     */

    regProp = NULL;
    result = XGetWindowProperty(dispPtr->display,
	    Tk_DefaultRootWindow(dispPtr->display),
	    dispPtr->registryProperty, 0, MAX_PROP_WORDS,
	    False, XA_STRING, &actualType, &actualFormat,
	    &numItems, &bytesAfter, (unsigned char **) &regProp);

    if (actualType == None) {
	return 0;
    }

    /*
     * If the property is improperly formed, then delete it.
     */

    if ((result != Success) || (actualFormat != 8)
	    || (actualType != XA_STRING)) {
	if (regProp != NULL) {
	    XFree(regProp);
	}
	XDeleteProperty(dispPtr->display,
		Tk_DefaultRootWindow(dispPtr->display),
		dispPtr->registryProperty);
	return 0;
    }

    /*
     * Scan the property for the desired name.
     */

    returnValue = (Window) 0;
    entry = NULL;	/* Not needed, but eliminates compiler warning. */
    for (p = regProp; (p-regProp) < numItems; ) {
	entry = p;
	while ((*p != 0) && (!isspace(*p))) {
	    p++;
	}
	if ((*p != 0) && (strcmp(name, p+1) == 0)) {
	    sscanf(entry, "%x", &returnValue);
	    break;
	}
	while (*p != 0) {
	    p++;
	}
	p++;
    }

    /*
     * Delete the property, if that is desired (copy down the
     * remainder of the registry property to overlay the deleted
     * info, then rewrite the property).
     */

    if ((delete) && (returnValue != 0)) {
	int count;

	while (*p != 0) {
	    p++;
	}
	p++;
	count = numItems - (p-regProp);
	if (count > 0) {
	    memcpy((VOID *) entry, (VOID *) p, count);
	}
	XChangeProperty(dispPtr->display,
		Tk_DefaultRootWindow(dispPtr->display),
		dispPtr->registryProperty, XA_STRING, 8,
		PropModeReplace, (unsigned char *) regProp,
		(int) (numItems - (p-entry)));
	XSync(dispPtr->display, False);
    }

    XFree(regProp);
    return returnValue;
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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;

    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->commWindow),
	    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;
    }

    /*
     * The property is divided into records separated by null
     * characters.  Each record represents one command request
     * or response.  Scan through the property one record at a
     * time.
     */

    for (p = propInfo; (p-propInfo) < numItems; ) {
	if (*p == 'C') {
	    Window window;
	    int serial, resultSize;
	    char *resultString, *interpName, *returnProp, *end;
	    register RegisteredInterp *riPtr;
	    char errorMsg[100];
#define STATIC_RESULT_SPACE 100
	    char staticSpace[STATIC_RESULT_SPACE];

	    /*
	     *-----------------------------------------------------
	     * This is an incoming command sent by another window.
	     * Parse the fields of the command string.  If the command
	     * string isn't properly formed, send back an error message
	     * if there's enough well-formed information to generate
	     * a proper reply;  otherwise just ignore the message.
	     *-----------------------------------------------------
	     */

	    p++;
	    window = (Window) strtol(p, &end, 16);
	    if (end == p) {
		goto nextRecord;
	    }
	    p = end;
	    if (*p != ' ') {
		goto nextRecord;
	    }
	    p++;
	    serial = strtol(p, &end, 16);
	    if (end == p) {
		goto nextRecord;
	    }
	    p = end;
	    if (*p != ' ') {
		goto nextRecord;
	    }
	    p++;
	    interpName = p;
	    while ((*p != 0) && (*p != '|')) {
		p++;
	    }
	    if (*p != '|') {
		result = TCL_ERROR;
		resultString = "bad property format for sent command";
		goto returnResult;
	    }
	    *p = 0;
	    p++;

	    /*
	     * Locate the interpreter for the command, then
	     * execute the command.
	     */

	    for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
		if (riPtr == NULL) {
		    result = TCL_ERROR;
		    sprintf(errorMsg,
			    "receiver never heard of interpreter \"%.40s\"",
			    interpName);
		    resultString = errorMsg;
		    goto returnResult;
		}
		if (strcmp(riPtr->name, interpName) == 0) {
		    break;
		}
	    }
	    result = Tcl_GlobalEval(riPtr->interp, p);
	    resultString = riPtr->interp->result;

	    /*
	     * Return the result to the sender.
	     */

	    returnResult:
	    resultSize = strlen(resultString) + 30;
	    if (resultSize <= STATIC_RESULT_SPACE) {
		returnProp = staticSpace;
	    } else {
		returnProp = (char *) ckalloc((unsigned) resultSize);
	    }
	    sprintf(returnProp, "R %x %d %s", serial, result,
		    resultString);
	    (void) AppendPropCarefully(dispPtr->display, window,
		    dispPtr->commProperty, returnProp,
		    (PendingCommand *) NULL);
	    if (returnProp != staticSpace) {
		ckfree(returnProp);
	    }
	} else if (*p == 'R') {
	    int serial, code;
	    char *end;
	    register PendingCommand *pcPtr;

	    /*
	     *-----------------------------------------------------
	     * This record in the property is a result being
	     * returned for a command sent from here.  First
	     * parse the fields.
	     *-----------------------------------------------------
	     */

	    p++;
	    serial = strtol(p, &end, 16);
	    if (end == p) {
		goto nextRecord;
	    }
	    p = end;
	    if (*p != ' ') {
		goto nextRecord;
	    }
	    p++;
	    code = strtol(p, &end, 10);
	    if (end == p) {
		goto nextRecord;
	    }
	    p = end;
	    if (*p != ' ') {
		goto nextRecord;
	    }
	    p++;

	    /*
	     * 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;
		pcPtr->result = ckalloc((unsigned) (strlen(p) + 1));
		strcpy(pcPtr->result, p);
		break;
	    }
	}

	nextRecord:
	while (*p != 0) {
	    p++;
	}
	p++;
    }
    XFree(propInfo);
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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, 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 (null-terminated) to
				 * append to property. */
    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, strlen(value)+1);
    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 = ckalloc((unsigned) (strlen(pcPtr->target) + 50));
	    sprintf(pcPtr->result,
		    "send to \"%s\" failed (no communication window)",
		    pcPtr->target);
	    pcPtr->code = TCL_ERROR;
	    break;
	}
    }
    return 0;
}
\f
/*
 *--------------------------------------------------------------
 *
 * TimeoutProc --
 *
 *	This procedure is invoked when too much time has elapsed
 *	during the processing of a sent command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Mark the pending command as complete, with an error
 *	message signalling the timeout.
 *
 *--------------------------------------------------------------
 */

static void
TimeoutProc(clientData)
    ClientData clientData;	/* Information about command that
				 * has been sent but not yet
				 * responded to. */
{
    PendingCommand *pcPtr = (PendingCommand *) clientData;
    register PendingCommand *pcPtr2;

    /*
     * Make sure that the command is still in the pending list
     * and that it hasn't already completed.  Then register the
     * error.
     */

    for (pcPtr2 = pendingCommands; pcPtr2 != NULL;
	    pcPtr2 = pcPtr2->nextPtr) {
	static char msg[] = "remote interpreter did not respond";
	if ((pcPtr2 != pcPtr) || (pcPtr2->result != NULL)) {
	    continue;
	}
	pcPtr2->code = TCL_ERROR;
	pcPtr2->result = ckalloc((unsigned) (sizeof(msg) + 1));
	strcpy(pcPtr2->result, msg);
	return;
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * DeleteProc --
 *
 *	This procedure is invoked by Tcl when a registered
 *	interpreter is about to be deleted.  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;

    (void) LookupName(riPtr->dispPtr, riPtr->name, 1);
    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);
    ckfree((char *) riPtr);
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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 the
 *	given commWindow.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static Bool
SendRestrictProc(display, eventPtr, arg)
    Display *display;		/* Display from which event arrived. */
    register XEvent *eventPtr;	/* Event that just arrived. */
    char *arg;			/* Comunication window in which
				 * we're interested. */
{
    register Tk_Window comm = (Tk_Window) arg;

    if ((display != Tk_Display(comm))
	    || (eventPtr->type != PropertyNotify)
	    || (eventPtr->xproperty.window != Tk_WindowId(comm))) {
	return False;
    }
    return True;
}