diff options
Diffstat (limited to 'unix/tkUnixSelect.c')
| -rw-r--r-- | unix/tkUnixSelect.c | 1189 |
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; +} |