summaryrefslogtreecommitdiffstats
path: root/unix/tkUnixSelect.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tkUnixSelect.c')
-rw-r--r--unix/tkUnixSelect.c1189
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;
+}