/*
* 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.
*
* RCS: @(#) $Id: tkUnixSelect.c,v 1.2 1998/09/14 18:23:57 stanton Exp $
*/
#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 int SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr,Tk_Window tkwin));
static int SelGetProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *portion));
static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
static void FreeHandler _ANSI_ARGS_((ClientData clientData));
static int HandleCompat _ANSI_ARGS_((ClientData clientData,
int offset, long *buffer, int maxBytes,
Atom type, Tk_Window tkwin));
/*
*----------------------------------------------------------------------
*
* 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_GetXSelProc *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 = 8;
Atom target, formatType = None;
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;
format = (formatType == XA_STRING) ? 8: 32;
numItems = (*selPtr->proc)(selPtr->clientData,
incrPtr->offsets[i], buffer,
TK_SEL_BYTES_AT_ONCE, formatType, (Tk_Window) incrPtr->winPtr);
pendingPtr = ip.nextPtr;
if (ip.selPtr == NULL) {
/*
* The selection handler deleted itself.
*/
return;
}
if (numItems > TK_SEL_BYTES_AT_ONCE*8/format) {
panic("selection handler returned too many bytes");
} else {
if (numItems < 0) {
numItems = 0;
}
}
((char *) buffer)[numItems*format/8] = '\0';
}
if (numItems < TK_SEL_BYTES_AT_ONCE*8/format) {
if (numItems <= 0) {
incrPtr->offsets[i] = -1;
incrPtr->numIncrs--;
} else {
incrPtr->offsets[i] = -2;
}
} else {
incrPtr->offsets[i] += numItems;
}
propPtr = (char *) buffer;
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;
long *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((char *) propInfo);
return;
}
if ((type == XA_STRING) || (type == dispPtr->textAtom)
|| (type == dispPtr->compoundTextAtom)) {
interp = retrPtr->interp;
Tcl_Preserve((ClientData) interp);
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
interp, propInfo, (int) numItems, format, XA_STRING, (Tk_Window) winPtr);
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 {
interp = retrPtr->interp;
Tcl_Preserve((ClientData) interp);
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
interp, propInfo, (int) numItems, format, type, (Tk_Window) winPtr);
Tcl_Release((ClientData) interp);
}
XFree((char *) 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 && incr.numConversions == 0 && format == 32 &&
type != XA_ATOM && type != None) {
result = XGetWindowProperty(eventPtr->display,
eventPtr->requestor, eventPtr->property,
0, MAX_PROP_WORDS, False, type,
&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 = XA_STRING;
long buffer[TK_SEL_WORDS_AT_ONCE];
register TkSelHandler *selPtr;
int numItems, format = 8;
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, buffer,
TK_SEL_BYTES_AT_ONCE, &type, &format);
if (numItems < 0) {
incr.multAtoms[2*i + 1] = None;
continue;
}
} else {
ip.selPtr = selPtr;
ip.nextPtr = pendingPtr;
pendingPtr = &ip;
type = selPtr->format;
format = (type == XA_STRING) ? 8: 32;
numItems = (*selPtr->proc)(selPtr->clientData, 0,
buffer, TK_SEL_BYTES_AT_ONCE, type, (Tk_Window) winPtr);
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, (Tk_Window) winPtr);
if (buffer[0] == 0) {
incr.multAtoms[2*i + 1] = None;
continue;
}
numItems = 1;
propPtr = (char *) buffer;
format = 32;
incr.offsets[i] = 0;
} else {
propPtr = (char *) buffer;
}
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;
long *propInfo;
Atom type = XA_STRING;
int format = 8, 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, (int) numItems, format, XA_STRING, (Tk_Window) retrPtr->winPtr);
Tcl_Release((ClientData) interp);
if (result != TCL_OK) {
retrPtr->result = result;
}
} else {
interp = retrPtr->interp;
Tcl_Preserve((ClientData) interp);
result = (*retrPtr->proc)(retrPtr->clientData, interp,
propInfo, (int) numItems, format, type, (Tk_Window) retrPtr->winPtr);
Tcl_Release((ClientData) interp);
if (result != TCL_OK) {
retrPtr->result = result;
}
}
done:
XFree((char *) 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,tkwin)
TkSelHandler *selPtr; /* Information about how to retrieve
* the selection whose size is wanted. */
Tk_Window tkwin;
{
long buffer[TK_SEL_WORDS_AT_ONCE];
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,
buffer, TK_SEL_BYTES_AT_ONCE, XA_STRING, tkwin);
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.
*
*----------------------------------------------------------------------
*/
int
TkSelCvtToX(propPtr, string, type, tkwin, maxBytes)
long *propPtr;
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 maxBytes; /* Number of 32-bit words contained in the
* result. */
{
register char *p;
char *field;
int numFields;
int bytes;
long *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, bytes = 0, p = string; bytes < maxBytes
; bytes += sizeof(long), longPtr++) {
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 bytes / sizeof(long);
}
/*
*----------------------------------------------------------------------
*
* 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.
*
*----------------------------------------------------------------------
*/
char *
TkSelCvtFromX(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;
}