Initial revision

1 files changed, 1189 insertions, 0 deletions

diff --git a/unix/tkUnixSelect.c b/unix/tkUnixSelect.c
new file mode 100644
index 0000000..404631e
--- /dev/null
+++ b/unix/tkUnixSelect.c
@@ -0,0 +1,1189 @@
+/* 
+ * tkUnixSelect.c --
+ *
+ *	This file contains X specific routines for manipulating 
+ *	selections.
+ *
+ * Copyright (c) 1995 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: @(#) tkUnixSelect.c 1.5 96/03/29 14:14:31
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When handling INCR-style selection retrievals, the selection owner
+ * uses the following data structure to communicate between the
+ * ConvertSelection procedure and TkSelPropProc.
+ */
+
+typedef struct IncrInfo {
+    TkWindow *winPtr;		/* Window that owns selection. */
+    Atom selection;		/* Selection that is being retrieved. */
+    Atom *multAtoms;		/* Information about conversions to
+				 * perform:  one or more pairs of
+				 * (target, property).  This either
+				 * points to a retrieved  property (for
+				 * MULTIPLE retrievals) or to a static
+				 * array. */
+    unsigned long numConversions;
+				/* Number of entries in offsets (same as
+				 * # of pairs in multAtoms). */
+    int *offsets;		/* One entry for each pair in
+				 * multAtoms;  -1 means all data has
+				 * been transferred for this
+				 * conversion.  -2 means only the
+				 * final zero-length transfer still
+				 * has to be done.  Otherwise it is the
+				 * offset of the next chunk of data
+				 * to transfer.  This array is malloc-ed. */
+    int numIncrs;		/* Number of entries in offsets that
+				 * aren't -1 (i.e. # of INCR-mode transfers
+				 * not yet completed). */
+    Tcl_TimerToken timeout;	/* Token for timer procedure. */
+    int idleTime;		/* Number of seconds since we heard
+				 * anything from the selection
+				 * requestor. */
+    Window reqWindow;		/* Requestor's window id. */
+    Time time;			/* Timestamp corresponding to
+				 * selection at beginning of request;
+				 * used to abort transfer if selection
+				 * changes. */
+    struct IncrInfo *nextPtr;	/* Next in list of all INCR-style
+				 * retrievals currently pending. */
+} IncrInfo;
+
+static IncrInfo *pendingIncrs = NULL;
+				/* List of all incr structures
+				 * currently active. */
+
+/*
+ * Largest property that we'll accept when sending or receiving the
+ * selection:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+static TkSelRetrievalInfo *pendingRetrievals = NULL;
+				/* List of all retrievals currently
+				 * being waited for. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void		ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
+			    XSelectionRequestEvent *eventPtr));
+static void		IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
+static char *		SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
+			    Atom type, Tk_Window tkwin));
+static long *		SelCvtToX _ANSI_ARGS_((char *string, Atom type,
+			    Tk_Window tkwin, int *numLongsPtr));
+static int		SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
+static void		SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
+			    XEvent *eventPtr));
+static void		SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetSelection --
+ *
+ *	Retrieve the specified selection from another process.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value.
+ *	If an error occurs (such as no selection exists)
+ *	then an error message is left in interp->result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
+    Tcl_Interp *interp;		/* Interpreter to use for reporting
+				 * errors. */
+    Tk_Window tkwin;		/* Window on whose behalf to retrieve
+				 * the selection (determines display
+				 * from which to retrieve). */
+    Atom selection;		/* Selection to retrieve. */
+    Atom target;		/* Desired form in which selection
+				 * is to be returned. */
+    Tk_GetSelProc *proc;	/* Procedure to call to process the
+				 * selection, once it has been retrieved. */
+    ClientData clientData;	/* Arbitrary value to pass to proc. */
+{
+    TkSelRetrievalInfo retr;
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+
+    /*
+     * The selection is owned by some other process.  To
+     * retrieve it, first record information about the retrieval
+     * in progress.  Use an internal window as the requestor.
+     */
+
+    retr.interp = interp;
+    if (dispPtr->clipWindow == NULL) {
+	int result;
+
+	result = TkClipInit(interp, dispPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+    }
+    retr.winPtr = (TkWindow *) dispPtr->clipWindow;
+    retr.selection = selection;
+    retr.property = selection;
+    retr.target = target;
+    retr.proc = proc;
+    retr.clientData = clientData;
+    retr.result = -1;
+    retr.idleTime = 0;
+    retr.nextPtr = pendingRetrievals;
+    pendingRetrievals = &retr;
+
+    /*
+     * Initiate the request for the selection.  Note:  can't use
+     * TkCurrentTime for the time.  If we do, and this application hasn't
+     * received any X events in a long time, the current time will be way
+     * in the past and could even predate the time when the selection was
+     * made;  if this happens, the request will be rejected.
+     */
+
+    XConvertSelection(winPtr->display, retr.selection, retr.target,
+	    retr.property, retr.winPtr->window, CurrentTime);
+
+    /*
+     * Enter a loop processing X events until the selection
+     * has been retrieved and processed.  If no response is
+     * received within a few seconds, then timeout.
+     */
+
+    retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+	    (ClientData) &retr);
+    while (retr.result == -1) {
+	Tcl_DoOneEvent(0);
+    }
+    Tcl_DeleteTimerHandler(retr.timeout);
+
+    /*
+     * Unregister the information about the selection retrieval
+     * in progress.
+     */
+
+    if (pendingRetrievals == &retr) {
+	pendingRetrievals = retr.nextPtr;
+    } else {
+	TkSelRetrievalInfo *retrPtr;
+
+	for (retrPtr = pendingRetrievals; retrPtr != NULL;
+		retrPtr = retrPtr->nextPtr) {
+	    if (retrPtr->nextPtr == &retr) {
+		retrPtr->nextPtr = retr.nextPtr;
+		break;
+	    }
+	}
+    }
+    return retr.result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelPropProc --
+ *
+ *	This procedure is invoked when property-change events
+ *	occur on windows not known to the toolkit.  Its function
+ *	is to implement the sending side of the INCR selection
+ *	retrieval protocol when the selection requestor deletes
+ *	the property containing a part of the selection.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If the property that is receiving the selection was just
+ *	deleted, then a new piece of the selection is fetched and
+ *	placed in the property, until eventually there's no more
+ *	selection to fetch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelPropProc(eventPtr)
+    register XEvent *eventPtr;		/* X PropertyChange event. */
+{
+    register IncrInfo *incrPtr;
+    int i, format;
+    Atom target, formatType;
+    register TkSelHandler *selPtr;
+    long buffer[TK_SEL_WORDS_AT_ONCE];
+    int numItems;
+    char *propPtr;
+    Tk_ErrorHandler errorHandler;
+
+    /*
+     * See if this event announces the deletion of a property being
+     * used for an INCR transfer.  If so, then add the next chunk of
+     * data to the property.
+     */
+
+    if (eventPtr->xproperty.state != PropertyDelete) {
+	return;
+    }
+    for (incrPtr = pendingIncrs; incrPtr != NULL;
+	    incrPtr = incrPtr->nextPtr) {
+	if (incrPtr->reqWindow != eventPtr->xproperty.window) {
+	    continue;
+	}
+	for (i = 0; i < incrPtr->numConversions; i++) {
+	    if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
+		    || (incrPtr->offsets[i] == -1)){
+		continue;
+	    }
+	    target = incrPtr->multAtoms[2*i];
+	    incrPtr->idleTime = 0;
+	    for (selPtr = incrPtr->winPtr->selHandlerList; ;
+		    selPtr = selPtr->nextPtr) {
+		if (selPtr == NULL) {
+		    incrPtr->multAtoms[2*i + 1] = None;
+		    incrPtr->offsets[i] = -1;
+		    incrPtr->numIncrs --;
+		    return;
+		}
+		if ((selPtr->target == target)
+			&& (selPtr->selection == incrPtr->selection)) {
+		    formatType = selPtr->format;
+		    if (incrPtr->offsets[i] == -2) {
+			numItems = 0;
+			((char *) buffer)[0] = 0;
+		    } else {
+			TkSelInProgress ip;
+			ip.selPtr = selPtr;
+			ip.nextPtr = pendingPtr;
+			pendingPtr = &ip;
+			numItems = (*selPtr->proc)(selPtr->clientData,
+				incrPtr->offsets[i], (char *) buffer,
+				TK_SEL_BYTES_AT_ONCE);
+			pendingPtr = ip.nextPtr;
+			if (ip.selPtr == NULL) {
+			    /*
+			     * The selection handler deleted itself.
+			     */
+
+			    return;
+			}
+			if (numItems > TK_SEL_BYTES_AT_ONCE) {
+			    panic("selection handler returned too many bytes");
+			} else {
+			    if (numItems < 0) {
+				numItems = 0;
+			    }
+			}
+			((char *) buffer)[numItems] = '\0';
+		    }
+		    if (numItems < TK_SEL_BYTES_AT_ONCE) {
+			if (numItems <= 0) {
+			    incrPtr->offsets[i] = -1;
+			    incrPtr->numIncrs--;
+			} else {
+			    incrPtr->offsets[i] = -2;
+			}
+		    } else {
+			incrPtr->offsets[i] += numItems;
+		    }
+		    if (formatType == XA_STRING) {
+			propPtr = (char *) buffer;
+			format = 8;
+		    } else {
+			propPtr = (char *) SelCvtToX((char *) buffer,
+				formatType, (Tk_Window) incrPtr->winPtr,
+				&numItems);
+			format = 32;
+		    }
+		    errorHandler = Tk_CreateErrorHandler(
+			    eventPtr->xproperty.display, -1, -1, -1,
+			    (int (*)()) NULL, (ClientData) NULL);
+		    XChangeProperty(eventPtr->xproperty.display,
+			    eventPtr->xproperty.window,
+			    eventPtr->xproperty.atom, formatType,
+			    format, PropModeReplace,
+			    (unsigned char *) propPtr, numItems);
+		    Tk_DeleteErrorHandler(errorHandler);
+		    if (propPtr != (char *) buffer) {
+			ckfree(propPtr);
+		    }
+		    return;
+		}
+	    }
+	}
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSelEventProc --
+ *
+ *	This procedure is invoked whenever a selection-related
+ *	event occurs.  It does the lion's share of the work
+ *	in implementing the selection protocol.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Lots:  depends on the type of event.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSelEventProc(tkwin, eventPtr)
+    Tk_Window tkwin;		/* Window for which event was
+				 * targeted. */
+    register XEvent *eventPtr;	/* X event:  either SelectionClear,
+				 * SelectionRequest, or
+				 * SelectionNotify. */
+{
+    register TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+    Tcl_Interp *interp;
+
+    /*
+     * Case #1: SelectionClear events.
+     */
+
+    if (eventPtr->type == SelectionClear) {
+	TkSelClearSelection(tkwin, eventPtr);
+    }
+
+    /*
+     * Case #2: SelectionNotify events.  Call the relevant procedure
+     * to handle the incoming selection.
+     */
+
+    if (eventPtr->type == SelectionNotify) {
+	register TkSelRetrievalInfo *retrPtr;
+	char *propInfo;
+	Atom type;
+	int format, result;
+	unsigned long numItems, bytesAfter;
+
+	for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
+	    if (retrPtr == NULL) {
+		return;
+	    }
+	    if ((retrPtr->winPtr == winPtr)
+		    && (retrPtr->selection == eventPtr->xselection.selection)
+		    && (retrPtr->target == eventPtr->xselection.target)
+		    && (retrPtr->result == -1)) {
+		if (retrPtr->property == eventPtr->xselection.property) {
+		    break;
+		}
+		if (eventPtr->xselection.property == None) {
+		    Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
+		    Tcl_AppendResult(retrPtr->interp,
+			    Tk_GetAtomName(tkwin, retrPtr->selection),
+			    " selection doesn't exist or form \"",
+			    Tk_GetAtomName(tkwin, retrPtr->target),
+			    "\" not defined", (char *) NULL);
+		    retrPtr->result = TCL_ERROR;
+		    return;
+		}
+	    }
+	}
+
+	propInfo = NULL;
+	result = XGetWindowProperty(eventPtr->xselection.display,
+		eventPtr->xselection.requestor, retrPtr->property,
+		0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
+		&type, &format, &numItems, &bytesAfter,
+		(unsigned char **) &propInfo);
+	if ((result != Success) || (type == None)) {
+	    return;
+	}
+	if (bytesAfter != 0) {
+	    Tcl_SetResult(retrPtr->interp, "selection property too large",
+		TCL_STATIC);
+	    retrPtr->result = TCL_ERROR;
+	    XFree(propInfo);
+	    return;
+	}
+	if ((type == XA_STRING) || (type == dispPtr->textAtom)
+		|| (type == dispPtr->compoundTextAtom)) {
+	    if (format != 8) {
+		sprintf(retrPtr->interp->result,
+		    "bad format for string selection: wanted \"8\", got \"%d\"",
+		    format);
+		retrPtr->result = TCL_ERROR;
+		return;
+	    }
+            interp = retrPtr->interp;
+            Tcl_Preserve((ClientData) interp);
+	    retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+		    interp, propInfo);
+            Tcl_Release((ClientData) interp);
+	} else if (type == dispPtr->incrAtom) {
+
+	    /*
+	     * It's a !?#@!?!! INCR-style reception.  Arrange to receive
+	     * the selection in pieces, using the ICCCM protocol, then
+	     * hang around until either the selection is all here or a
+	     * timeout occurs.
+	     */
+
+	    retrPtr->idleTime = 0;
+	    Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
+		    (ClientData) retrPtr);
+	    XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
+		    retrPtr->property);
+	    while (retrPtr->result == -1) {
+		Tcl_DoOneEvent(0);
+	    }
+	    Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
+		    (ClientData) retrPtr);
+	} else {
+	    char *string;
+
+	    if (format != 32) {
+		sprintf(retrPtr->interp->result,
+		    "bad format for selection: wanted \"32\", got \"%d\"",
+		    format);
+		retrPtr->result = TCL_ERROR;
+		return;
+	    }
+	    string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+		    (Tk_Window) winPtr);
+            interp = retrPtr->interp;
+            Tcl_Preserve((ClientData) interp);
+	    retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+		    interp, string);
+            Tcl_Release((ClientData) interp);
+	    ckfree(string);
+	}
+	XFree(propInfo);
+	return;
+    }
+
+    /*
+     * Case #3: SelectionRequest events.  Call ConvertSelection to
+     * do the dirty work.
+     */
+
+    if (eventPtr->type == SelectionRequest) {
+	ConvertSelection(winPtr, &eventPtr->xselectionrequest);
+	return;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelTimeoutProc --
+ *
+ *	This procedure is invoked once every second while waiting for
+ *	the selection to be returned.  After a while it gives up and
+ *	aborts the selection retrieval.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A new timer callback is created to call us again in another
+ *	second, unless time has expired, in which case an error is
+ *	recorded for the retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelTimeoutProc(clientData)
+    ClientData clientData;		/* Information about retrieval
+					 * in progress. */
+{
+    register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+
+    /*
+     * Make sure that the retrieval is still in progress.  Then
+     * see how long it's been since any sort of response was received
+     * from the other side.
+     */
+
+    if (retrPtr->result != -1) {
+	return;
+    }
+    retrPtr->idleTime++;
+    if (retrPtr->idleTime >= 5) {
+
+	/*
+	 * Use a careful procedure to store the error message, because
+	 * the result could already be partially filled in with a partial
+	 * selection return.
+	 */
+
+	Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
+		TCL_STATIC);
+	retrPtr->result = TCL_ERROR;
+    } else {
+	retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+	    (ClientData) retrPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertSelection --
+ *
+ *	This procedure is invoked to handle SelectionRequest events.
+ *	It responds to the requests, obeying the ICCCM protocols.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Properties are created for the selection requestor, and a
+ *	SelectionNotify event is generated for the selection
+ *	requestor.  In the event of long selections, this procedure
+ *	implements INCR-mode transfers, using the ICCCM protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConvertSelection(winPtr, eventPtr)
+    TkWindow *winPtr;			/* Window that received the
+					 * conversion request;  may not be
+					 * selection's current owner, be we
+					 * set it to the current owner. */
+    register XSelectionRequestEvent *eventPtr;
+					/* Event describing request. */
+{
+    XSelectionEvent reply;		/* Used to notify requestor that
+					 * selection info is ready. */
+    int multiple;			/* Non-zero means a MULTIPLE request
+					 * is being handled. */
+    IncrInfo incr;			/* State of selection conversion. */
+    Atom singleInfo[2];			/* incr.multAtoms points here except
+					 * for multiple conversions. */
+    int i;
+    Tk_ErrorHandler errorHandler;
+    TkSelectionInfo *infoPtr;
+    TkSelInProgress ip;
+
+    errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
+	    (int (*)()) NULL, (ClientData) NULL);
+
+    /*
+     * Initialize the reply event.
+     */
+
+    reply.type = SelectionNotify;
+    reply.serial = 0;
+    reply.send_event = True;
+    reply.display = eventPtr->display;
+    reply.requestor = eventPtr->requestor;
+    reply.selection = eventPtr->selection;
+    reply.target = eventPtr->target;
+    reply.property = eventPtr->property;
+    if (reply.property == None) {
+	reply.property = reply.target;
+    }
+    reply.time = eventPtr->time;
+
+    for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
+	    infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->selection == eventPtr->selection)
+	    break;
+    }
+    if (infoPtr == NULL) {
+	goto refuse;
+    }
+    winPtr = (TkWindow *) infoPtr->owner;
+
+    /*
+     * Figure out which kind(s) of conversion to perform.  If handling
+     * a MULTIPLE conversion, then read the property describing which
+     * conversions to perform.
+     */
+
+    incr.winPtr = winPtr;
+    incr.selection = eventPtr->selection;
+    if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
+	multiple = 0;
+	singleInfo[0] = reply.target;
+	singleInfo[1] = reply.property;
+	incr.multAtoms = singleInfo;
+	incr.numConversions = 1;
+    } else {
+	Atom type;
+	int format, result;
+	unsigned long bytesAfter;
+
+	multiple = 1;
+	incr.multAtoms = NULL;
+	if (eventPtr->property == None) {
+	    goto refuse;
+	}
+	result = XGetWindowProperty(eventPtr->display,
+		eventPtr->requestor, eventPtr->property,
+		0, MAX_PROP_WORDS, False, XA_ATOM,
+		&type, &format, &incr.numConversions, &bytesAfter,
+		(unsigned char **) &incr.multAtoms);
+	if ((result != Success) || (bytesAfter != 0) || (format != 32)
+		|| (type == None)) {
+	    if (incr.multAtoms != NULL) {
+		XFree((char *) incr.multAtoms);
+	    }
+	    goto refuse;
+	}
+	incr.numConversions /= 2;		/* Two atoms per conversion. */
+    }
+
+    /*
+     * Loop through all of the requested conversions, and either return
+     * the entire converted selection, if it can be returned in a single
+     * bunch, or return INCR information only (the actual selection will
+     * be returned below).
+     */
+
+    incr.offsets = (int *) ckalloc((unsigned)
+	    (incr.numConversions*sizeof(int)));
+    incr.numIncrs = 0;
+    for (i = 0; i < incr.numConversions; i++) {
+	Atom target, property, type;
+	long buffer[TK_SEL_WORDS_AT_ONCE];
+	register TkSelHandler *selPtr;
+	int numItems, format;
+	char *propPtr;
+
+	target = incr.multAtoms[2*i];
+	property = incr.multAtoms[2*i + 1];
+	incr.offsets[i] = -1;
+
+	for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+		selPtr = selPtr->nextPtr) {
+	    if ((selPtr->target == target)
+		    && (selPtr->selection == eventPtr->selection)) {
+		break;
+	    }
+	}
+
+	if (selPtr == NULL) {
+	    /*
+	     * Nobody seems to know about this kind of request.  If
+	     * it's of a sort that we can handle without any help, do
+	     * it.  Otherwise mark the request as an errror.
+	     */
+
+	    numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
+		    TK_SEL_BYTES_AT_ONCE, &type);
+	    if (numItems < 0) {
+		incr.multAtoms[2*i + 1] = None;
+		continue;
+	    }
+	} else {
+	    ip.selPtr = selPtr;
+	    ip.nextPtr = pendingPtr;
+	    pendingPtr = &ip;
+	    type = selPtr->format;
+	    numItems = (*selPtr->proc)(selPtr->clientData, 0,
+		    (char *) buffer, TK_SEL_BYTES_AT_ONCE);
+	    pendingPtr = ip.nextPtr;
+	    if ((ip.selPtr == NULL) || (numItems < 0)) {
+		incr.multAtoms[2*i + 1] = None;
+		continue;
+	    }
+	    if (numItems > TK_SEL_BYTES_AT_ONCE) {
+		panic("selection handler returned too many bytes");
+	    }
+	    ((char *) buffer)[numItems] = '\0';
+	}
+
+	/*
+	 * Got the selection;  store it back on the requestor's property.
+	 */
+
+	if (numItems == TK_SEL_BYTES_AT_ONCE) {
+	    /*
+	     * Selection is too big to send at once;  start an
+	     * INCR-mode transfer.
+	     */
+
+	    incr.numIncrs++;
+	    type = winPtr->dispPtr->incrAtom;
+	    buffer[0] = SelectionSize(selPtr);
+	    if (buffer[0] == 0) {
+		incr.multAtoms[2*i + 1] = None;
+		continue;
+	    }
+	    numItems = 1;
+	    propPtr = (char *) buffer;
+	    format = 32;
+	    incr.offsets[i] = 0;
+	} else if (type == XA_STRING) {
+	    propPtr = (char *) buffer;
+	    format = 8;
+	} else {
+	    propPtr = (char *) SelCvtToX((char *) buffer,
+		    type, (Tk_Window) winPtr, &numItems);
+	    format = 32;
+	}
+	XChangeProperty(reply.display, reply.requestor,
+		property, type, format, PropModeReplace,
+		(unsigned char *) propPtr, numItems);
+	if (propPtr != (char *) buffer) {
+	    ckfree(propPtr);
+	}
+    }
+
+    /*
+     * Send an event back to the requestor to indicate that the
+     * first stage of conversion is complete (everything is done
+     * except for long conversions that have to be done in INCR
+     * mode).
+     */
+
+    if (incr.numIncrs > 0) {
+	XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
+	incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
+	    (ClientData) &incr);
+	incr.idleTime = 0;
+	incr.reqWindow = reply.requestor;
+	incr.time = infoPtr->time;
+	incr.nextPtr = pendingIncrs;
+	pendingIncrs = &incr;
+    }
+    if (multiple) {
+	XChangeProperty(reply.display, reply.requestor, reply.property,
+		XA_ATOM, 32, PropModeReplace,
+		(unsigned char *) incr.multAtoms,
+		(int) incr.numConversions*2);
+    } else {
+
+	/*
+	 * Not a MULTIPLE request.  The first property in "multAtoms"
+	 * got set to None if there was an error in conversion.
+	 */
+
+	reply.property = incr.multAtoms[1];
+    }
+    XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+    Tk_DeleteErrorHandler(errorHandler);
+
+    /*
+     * Handle any remaining INCR-mode transfers.  This all happens
+     * in callbacks to TkSelPropProc, so just wait until the number
+     * of uncompleted INCR transfers drops to zero.
+     */
+
+    if (incr.numIncrs > 0) {
+	IncrInfo *incrPtr2;
+
+	while (incr.numIncrs > 0) {
+	    Tcl_DoOneEvent(0);
+	}
+	Tcl_DeleteTimerHandler(incr.timeout);
+	errorHandler = Tk_CreateErrorHandler(winPtr->display,
+		-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
+	XSelectInput(reply.display, reply.requestor, 0L);
+	Tk_DeleteErrorHandler(errorHandler);
+	if (pendingIncrs == &incr) {
+	    pendingIncrs = incr.nextPtr;
+	} else {
+	    for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
+		    incrPtr2 = incrPtr2->nextPtr) {
+		if (incrPtr2->nextPtr == &incr) {
+		    incrPtr2->nextPtr = incr.nextPtr;
+		    break;
+		}
+	    }
+	}
+    }
+
+    /*
+     * All done.  Cleanup and return.
+     */
+
+    ckfree((char *) incr.offsets);
+    if (multiple) {
+	XFree((char *) incr.multAtoms);
+    }
+    return;
+
+    /*
+     * An error occurred.  Send back a refusal message.
+     */
+
+    refuse:
+    reply.property = None;
+    XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+    Tk_DeleteErrorHandler(errorHandler);
+    return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelRcvIncrProc --
+ *
+ *	This procedure handles the INCR protocol on the receiving
+ *	side.  It is invoked in response to property changes on
+ *	the requestor's window (which hopefully are because a new
+ *	chunk of the selection arrived).
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If a new piece of selection has arrived, a procedure is
+ *	invoked to deal with that piece.  When the whole selection
+ *	is here, a flag is left for the higher-level procedure that
+ *	initiated the selection retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelRcvIncrProc(clientData, eventPtr)
+    ClientData clientData;		/* Information about retrieval. */
+    register XEvent *eventPtr;		/* X PropertyChange event. */
+{
+    register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+    char *propInfo;
+    Atom type;
+    int format, result;
+    unsigned long numItems, bytesAfter;
+    Tcl_Interp *interp;
+
+    if ((eventPtr->xproperty.atom != retrPtr->property)
+	    || (eventPtr->xproperty.state != PropertyNewValue)
+	    || (retrPtr->result != -1)) {
+	return;
+    }
+    propInfo = NULL;
+    result = XGetWindowProperty(eventPtr->xproperty.display,
+	    eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
+	    True, (Atom) AnyPropertyType, &type, &format, &numItems,
+	    &bytesAfter, (unsigned char **) &propInfo);
+    if ((result != Success) || (type == None)) {
+	return;
+    }
+    if (bytesAfter != 0) {
+	Tcl_SetResult(retrPtr->interp, "selection property too large",
+		TCL_STATIC);
+	retrPtr->result = TCL_ERROR;
+	goto done;
+    }
+    if (numItems == 0) {
+	retrPtr->result = TCL_OK;
+    } else if ((type == XA_STRING)
+	    || (type == retrPtr->winPtr->dispPtr->textAtom)
+	    || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
+	if (format != 8) {
+	    Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
+	    sprintf(retrPtr->interp->result,
+		"bad format for string selection: wanted \"8\", got \"%d\"",
+		format);
+	    retrPtr->result = TCL_ERROR;
+	    goto done;
+	}
+        interp = retrPtr->interp;
+        Tcl_Preserve((ClientData) interp);
+	result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
+        Tcl_Release((ClientData) interp);
+	if (result != TCL_OK) {
+	    retrPtr->result = result;
+	}
+    } else {
+	char *string;
+
+	if (format != 32) {
+	    Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
+	    sprintf(retrPtr->interp->result,
+		"bad format for selection: wanted \"32\", got \"%d\"",
+		format);
+	    retrPtr->result = TCL_ERROR;
+	    goto done;
+	}
+	string = SelCvtFromX((long *) propInfo, (int) numItems, type,
+		(Tk_Window) retrPtr->winPtr);
+        interp = retrPtr->interp;
+        Tcl_Preserve((ClientData) interp);
+	result = (*retrPtr->proc)(retrPtr->clientData, interp, string);
+        Tcl_Release((ClientData) interp);
+	if (result != TCL_OK) {
+	    retrPtr->result = result;
+	}
+	ckfree(string);
+    }
+
+    done:
+    XFree(propInfo);
+    retrPtr->idleTime = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelectionSize --
+ *
+ *	This procedure is called when the selection is too large to
+ *	send in a single buffer;  it computes the total length of
+ *	the selection in bytes.
+ *
+ * Results:
+ *	The return value is the number of bytes in the selection
+ *	given by selPtr.
+ *
+ * Side effects:
+ *	The selection is retrieved from its current owner (this is
+ *	the only way to compute its size).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SelectionSize(selPtr)
+    TkSelHandler *selPtr;	/* Information about how to retrieve
+				 * the selection whose size is wanted. */
+{
+    char buffer[TK_SEL_BYTES_AT_ONCE+1];
+    int size, chunkSize;
+    TkSelInProgress ip;
+
+    size = TK_SEL_BYTES_AT_ONCE;
+    ip.selPtr = selPtr;
+    ip.nextPtr = pendingPtr;
+    pendingPtr = &ip;
+    do {
+	chunkSize = (*selPtr->proc)(selPtr->clientData, size,
+			(char *) buffer, TK_SEL_BYTES_AT_ONCE);
+	if (ip.selPtr == NULL) {
+	    size = 0;
+	    break;
+	}
+	size += chunkSize;
+    } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
+    pendingPtr = ip.nextPtr;
+    return size;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncrTimeoutProc --
+ *
+ *	This procedure is invoked once a second while sending the
+ *	selection to a requestor in INCR mode.  After a while it
+ *	gives up and aborts the selection operation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A new timeout gets registered so that this procedure gets
+ *	called again in another second, unless too many seconds
+ *	have elapsed, in which case incrPtr is marked as "all done".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncrTimeoutProc(clientData)
+    ClientData clientData;		/* Information about INCR-mode
+					 * selection retrieval for which
+					 * we are selection owner. */
+{
+    register IncrInfo *incrPtr = (IncrInfo *) clientData;
+
+    incrPtr->idleTime++;
+    if (incrPtr->idleTime >= 5) {
+	incrPtr->numIncrs = 0;
+    } else {
+	incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
+		(ClientData) incrPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtToX --
+ *
+ *	Given a selection represented as a string (the normal Tcl form),
+ *	convert it to the ICCCM-mandated format for X, depending on
+ *	the type argument.  This procedure and SelCvtFromX are inverses.
+ *
+ * Results:
+ *	The return value is a malloc'ed buffer holding a value
+ *	equivalent to "string", but formatted as for "type".  It is
+ *	the caller's responsibility to free the string when done with
+ *	it.  The word at *numLongsPtr is filled in with the number of
+ *	32-bit words returned in the result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static long *
+SelCvtToX(string, type, tkwin, numLongsPtr)
+    char *string;		/* String representation of selection. */
+    Atom type;			/* Atom specifying the X format that is
+				 * desired for the selection.  Should not
+				 * be XA_STRING (if so, don't bother calling
+				 * this procedure at all). */
+    Tk_Window tkwin;		/* Window that governs atom conversion. */
+    int *numLongsPtr;		/* Number of 32-bit words contained in the
+				 * result. */
+{
+    register char *p;
+    char *field;
+    int numFields;
+    long *propPtr, *longPtr;
+#define MAX_ATOM_NAME_LENGTH 100
+    char atomName[MAX_ATOM_NAME_LENGTH+1];
+
+    /*
+     * The string is assumed to consist of fields separated by spaces.
+     * The property gets generated by converting each field to an
+     * integer number, in one of two ways:
+     * 1. If type is XA_ATOM, convert each field to its corresponding
+     *	  atom.
+     * 2. If type is anything else, convert each field from an ASCII number
+     *    to a 32-bit binary number.
+     */
+
+    numFields = 1;
+    for (p = string; *p != 0; p++) {
+	if (isspace(UCHAR(*p))) {
+	    numFields++;
+	}
+    }
+    propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
+
+    /*
+     * Convert the fields one-by-one.
+     */
+
+    for (longPtr = propPtr, *numLongsPtr = 0, p = string;
+	    ; longPtr++, (*numLongsPtr)++) {
+	while (isspace(UCHAR(*p))) {
+	    p++;
+	}
+	if (*p == 0) {
+	    break;
+	}
+	field = p;
+	while ((*p != 0) && !isspace(UCHAR(*p))) {
+	    p++;
+	}
+	if (type == XA_ATOM) {
+	    int length;
+
+	    length = p - field;
+	    if (length > MAX_ATOM_NAME_LENGTH) {
+		length = MAX_ATOM_NAME_LENGTH;
+	    }
+	    strncpy(atomName, field, (unsigned) length);
+	    atomName[length] = 0;
+	    *longPtr = (long) Tk_InternAtom(tkwin, atomName);
+	} else {
+	    char *dummy;
+
+	    *longPtr = strtol(field, &dummy, 0);
+	}
+    }
+    return propPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtFromX --
+ *
+ *	Given an X property value, formatted as a collection of 32-bit
+ *	values according to "type" and the ICCCM conventions, convert
+ *	the value to a string suitable for manipulation by Tcl.  This
+ *	procedure is the inverse of SelCvtToX.
+ *
+ * Results:
+ *	The return value is the string equivalent of "property".  It is
+ *	malloc-ed and should be freed by the caller when no longer
+ *	needed.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SelCvtFromX(propPtr, numValues, type, tkwin)
+    register long *propPtr;	/* Property value from X. */
+    int numValues;		/* Number of 32-bit values in property. */
+    Atom type;			/* Type of property  Should not be
+				 * XA_STRING (if so, don't bother calling
+				 * this procedure at all). */
+    Tk_Window tkwin;		/* Window to use for atom conversion. */
+{
+    char *result;
+    int resultSpace, curSize, fieldSize;
+    char *atomName;
+
+    /*
+     * Convert each long in the property to a string value, which is
+     * either the name of an atom (if type is XA_ATOM) or a hexadecimal
+     * string.  Make an initial guess about the size of the result, but
+     * be prepared to enlarge the result if necessary.
+     */
+
+    resultSpace = 12*numValues+1;
+    curSize = 0;
+    atomName = "";	/* Not needed, but eliminates compiler warning. */
+    result = (char *) ckalloc((unsigned) resultSpace);
+    *result  = '\0';
+    for ( ; numValues > 0; propPtr++, numValues--) {
+	if (type == XA_ATOM) {
+	    atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
+	    fieldSize = strlen(atomName) + 1;
+	} else {
+	    fieldSize = 12;
+	}
+	if (curSize+fieldSize >= resultSpace) {
+	    char *newResult;
+
+	    resultSpace *= 2;
+	    if (curSize+fieldSize >= resultSpace) {
+		resultSpace = curSize + fieldSize + 1;
+	    }
+	    newResult = (char *) ckalloc((unsigned) resultSpace);
+	    strncpy(newResult, result, (unsigned) curSize);
+	    ckfree(result);
+	    result = newResult;
+	}
+	if (curSize != 0) {
+	    result[curSize] = ' ';
+	    curSize++;
+	}
+	if (type == XA_ATOM) {
+	    strcpy(result+curSize, atomName);
+	} else {
+	    sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
+	}
+	curSize += strlen(result+curSize);
+    }
+    return result;
+}