4
* This file contains X specific routines for manipulating
7
* Copyright (c) 1995 Sun Microsystems, Inc.
9
* See the file "license.terms" for information on usage and redistribution
10
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12
* RCS: @(#) $Id: tkUnixSelect.c,v 1.2 1998/09/14 18:23:57 stanton Exp $
19
* When handling INCR-style selection retrievals, the selection owner
20
* uses the following data structure to communicate between the
21
* ConvertSelection procedure and TkSelPropProc.
24
typedef struct IncrInfo {
25
TkWindow *winPtr; /* Window that owns selection. */
26
Atom selection; /* Selection that is being retrieved. */
27
Atom *multAtoms; /* Information about conversions to
28
* perform: one or more pairs of
29
* (target, property). This either
30
* points to a retrieved property (for
31
* MULTIPLE retrievals) or to a static
33
unsigned long numConversions;
34
/* Number of entries in offsets (same as
35
* # of pairs in multAtoms). */
36
int *offsets; /* One entry for each pair in
37
* multAtoms; -1 means all data has
38
* been transferred for this
39
* conversion. -2 means only the
40
* final zero-length transfer still
41
* has to be done. Otherwise it is the
42
* offset of the next chunk of data
43
* to transfer. This array is malloc-ed. */
44
int numIncrs; /* Number of entries in offsets that
45
* aren't -1 (i.e. # of INCR-mode transfers
46
* not yet completed). */
47
Tcl_TimerToken timeout; /* Token for timer procedure. */
48
int idleTime; /* Number of seconds since we heard
49
* anything from the selection
51
Window reqWindow; /* Requestor's window id. */
52
Time time; /* Timestamp corresponding to
53
* selection at beginning of request;
54
* used to abort transfer if selection
56
struct IncrInfo *nextPtr; /* Next in list of all INCR-style
57
* retrievals currently pending. */
60
static IncrInfo *pendingIncrs = NULL;
61
/* List of all incr structures
62
* currently active. */
65
* Largest property that we'll accept when sending or receiving the
69
#define MAX_PROP_WORDS 100000
71
static TkSelRetrievalInfo *pendingRetrievals = NULL;
72
/* List of all retrievals currently
73
* being waited for. */
76
* Forward declarations for procedures defined in this file:
79
static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
80
XSelectionRequestEvent *eventPtr));
81
static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
82
static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
83
Atom type, Tk_Window tkwin));
84
static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
85
Tk_Window tkwin, int *numLongsPtr));
86
static int SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
87
static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
89
static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
92
*----------------------------------------------------------------------
94
* TkSelGetSelection --
96
* Retrieve the specified selection from another process.
99
* The return value is a standard Tcl return value.
100
* If an error occurs (such as no selection exists)
101
* then an error message is left in interp->result.
106
*----------------------------------------------------------------------
110
TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
111
Tcl_Interp *interp; /* Interpreter to use for reporting
113
Tk_Window tkwin; /* Window on whose behalf to retrieve
114
* the selection (determines display
115
* from which to retrieve). */
116
Atom selection; /* Selection to retrieve. */
117
Atom target; /* Desired form in which selection
118
* is to be returned. */
119
Tk_GetSelProc *proc; /* Procedure to call to process the
120
* selection, once it has been retrieved. */
121
ClientData clientData; /* Arbitrary value to pass to proc. */
123
TkSelRetrievalInfo retr;
124
TkWindow *winPtr = (TkWindow *) tkwin;
125
TkDisplay *dispPtr = winPtr->dispPtr;
128
* The selection is owned by some other process. To
129
* retrieve it, first record information about the retrieval
130
* in progress. Use an internal window as the requestor.
133
retr.interp = interp;
134
if (dispPtr->clipWindow == NULL) {
137
result = TkClipInit(interp, dispPtr);
138
if (result != TCL_OK) {
142
retr.winPtr = (TkWindow *) dispPtr->clipWindow;
143
retr.selection = selection;
144
retr.property = selection;
145
retr.target = target;
147
retr.clientData = clientData;
150
retr.nextPtr = pendingRetrievals;
151
pendingRetrievals = &retr;
154
* Initiate the request for the selection. Note: can't use
155
* TkCurrentTime for the time. If we do, and this application hasn't
156
* received any X events in a long time, the current time will be way
157
* in the past and could even predate the time when the selection was
158
* made; if this happens, the request will be rejected.
161
XConvertSelection(winPtr->display, retr.selection, retr.target,
162
retr.property, retr.winPtr->window, CurrentTime);
165
* Enter a loop processing X events until the selection
166
* has been retrieved and processed. If no response is
167
* received within a few seconds, then timeout.
170
retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
172
while (retr.result == -1) {
175
Tcl_DeleteTimerHandler(retr.timeout);
178
* Unregister the information about the selection retrieval
182
if (pendingRetrievals == &retr) {
183
pendingRetrievals = retr.nextPtr;
185
TkSelRetrievalInfo *retrPtr;
187
for (retrPtr = pendingRetrievals; retrPtr != NULL;
188
retrPtr = retrPtr->nextPtr) {
189
if (retrPtr->nextPtr == &retr) {
190
retrPtr->nextPtr = retr.nextPtr;
199
*----------------------------------------------------------------------
203
* This procedure is invoked when property-change events
204
* occur on windows not known to the toolkit. Its function
205
* is to implement the sending side of the INCR selection
206
* retrieval protocol when the selection requestor deletes
207
* the property containing a part of the selection.
213
* If the property that is receiving the selection was just
214
* deleted, then a new piece of the selection is fetched and
215
* placed in the property, until eventually there's no more
216
* selection to fetch.
218
*----------------------------------------------------------------------
222
TkSelPropProc(eventPtr)
223
register XEvent *eventPtr; /* X PropertyChange event. */
225
register IncrInfo *incrPtr;
227
Atom target, formatType;
228
register TkSelHandler *selPtr;
229
long buffer[TK_SEL_WORDS_AT_ONCE];
232
Tk_ErrorHandler errorHandler;
235
* See if this event announces the deletion of a property being
236
* used for an INCR transfer. If so, then add the next chunk of
237
* data to the property.
240
if (eventPtr->xproperty.state != PropertyDelete) {
243
for (incrPtr = pendingIncrs; incrPtr != NULL;
244
incrPtr = incrPtr->nextPtr) {
245
if (incrPtr->reqWindow != eventPtr->xproperty.window) {
248
for (i = 0; i < incrPtr->numConversions; i++) {
249
if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
250
|| (incrPtr->offsets[i] == -1)){
253
target = incrPtr->multAtoms[2*i];
254
incrPtr->idleTime = 0;
255
for (selPtr = incrPtr->winPtr->selHandlerList; ;
256
selPtr = selPtr->nextPtr) {
257
if (selPtr == NULL) {
258
incrPtr->multAtoms[2*i + 1] = None;
259
incrPtr->offsets[i] = -1;
260
incrPtr->numIncrs --;
263
if ((selPtr->target == target)
264
&& (selPtr->selection == incrPtr->selection)) {
265
formatType = selPtr->format;
266
if (incrPtr->offsets[i] == -2) {
268
((char *) buffer)[0] = 0;
272
ip.nextPtr = pendingPtr;
274
numItems = (*selPtr->proc)(selPtr->clientData,
275
incrPtr->offsets[i], (char *) buffer,
276
TK_SEL_BYTES_AT_ONCE);
277
pendingPtr = ip.nextPtr;
278
if (ip.selPtr == NULL) {
280
* The selection handler deleted itself.
285
if (numItems > TK_SEL_BYTES_AT_ONCE) {
286
panic("selection handler returned too many bytes");
292
((char *) buffer)[numItems] = '\0';
294
if (numItems < TK_SEL_BYTES_AT_ONCE) {
296
incrPtr->offsets[i] = -1;
299
incrPtr->offsets[i] = -2;
302
incrPtr->offsets[i] += numItems;
304
if (formatType == XA_STRING) {
305
propPtr = (char *) buffer;
308
propPtr = (char *) SelCvtToX((char *) buffer,
309
formatType, (Tk_Window) incrPtr->winPtr,
313
errorHandler = Tk_CreateErrorHandler(
314
eventPtr->xproperty.display, -1, -1, -1,
315
(int (*)()) NULL, (ClientData) NULL);
316
XChangeProperty(eventPtr->xproperty.display,
317
eventPtr->xproperty.window,
318
eventPtr->xproperty.atom, formatType,
319
format, PropModeReplace,
320
(unsigned char *) propPtr, numItems);
321
Tk_DeleteErrorHandler(errorHandler);
322
if (propPtr != (char *) buffer) {
333
*--------------------------------------------------------------
337
* This procedure is invoked whenever a selection-related
338
* event occurs. It does the lion's share of the work
339
* in implementing the selection protocol.
345
* Lots: depends on the type of event.
347
*--------------------------------------------------------------
351
TkSelEventProc(tkwin, eventPtr)
352
Tk_Window tkwin; /* Window for which event was
354
register XEvent *eventPtr; /* X event: either SelectionClear,
355
* SelectionRequest, or
356
* SelectionNotify. */
358
register TkWindow *winPtr = (TkWindow *) tkwin;
359
TkDisplay *dispPtr = winPtr->dispPtr;
363
* Case #1: SelectionClear events.
366
if (eventPtr->type == SelectionClear) {
367
TkSelClearSelection(tkwin, eventPtr);
371
* Case #2: SelectionNotify events. Call the relevant procedure
372
* to handle the incoming selection.
375
if (eventPtr->type == SelectionNotify) {
376
register TkSelRetrievalInfo *retrPtr;
380
unsigned long numItems, bytesAfter;
382
for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
383
if (retrPtr == NULL) {
386
if ((retrPtr->winPtr == winPtr)
387
&& (retrPtr->selection == eventPtr->xselection.selection)
388
&& (retrPtr->target == eventPtr->xselection.target)
389
&& (retrPtr->result == -1)) {
390
if (retrPtr->property == eventPtr->xselection.property) {
393
if (eventPtr->xselection.property == None) {
394
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
395
Tcl_AppendResult(retrPtr->interp,
396
Tk_GetAtomName(tkwin, retrPtr->selection),
397
" selection doesn't exist or form \"",
398
Tk_GetAtomName(tkwin, retrPtr->target),
399
"\" not defined", (char *) NULL);
400
retrPtr->result = TCL_ERROR;
407
result = XGetWindowProperty(eventPtr->xselection.display,
408
eventPtr->xselection.requestor, retrPtr->property,
409
0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
410
&type, &format, &numItems, &bytesAfter,
411
(unsigned char **) &propInfo);
412
if ((result != Success) || (type == None)) {
415
if (bytesAfter != 0) {
416
Tcl_SetResult(retrPtr->interp, "selection property too large",
418
retrPtr->result = TCL_ERROR;
422
if ((type == XA_STRING) || (type == dispPtr->textAtom)
423
|| (type == dispPtr->compoundTextAtom)) {
425
sprintf(retrPtr->interp->result,
426
"bad format for string selection: wanted \"8\", got \"%d\"",
428
retrPtr->result = TCL_ERROR;
431
interp = retrPtr->interp;
432
Tcl_Preserve((ClientData) interp);
433
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
435
Tcl_Release((ClientData) interp);
436
} else if (type == dispPtr->incrAtom) {
439
* It's a !?#@!?!! INCR-style reception. Arrange to receive
440
* the selection in pieces, using the ICCCM protocol, then
441
* hang around until either the selection is all here or a
445
retrPtr->idleTime = 0;
446
Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
447
(ClientData) retrPtr);
448
XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
450
while (retrPtr->result == -1) {
453
Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
454
(ClientData) retrPtr);
459
sprintf(retrPtr->interp->result,
460
"bad format for selection: wanted \"32\", got \"%d\"",
462
retrPtr->result = TCL_ERROR;
465
string = SelCvtFromX((long *) propInfo, (int) numItems, type,
467
interp = retrPtr->interp;
468
Tcl_Preserve((ClientData) interp);
469
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
471
Tcl_Release((ClientData) interp);
479
* Case #3: SelectionRequest events. Call ConvertSelection to
483
if (eventPtr->type == SelectionRequest) {
484
ConvertSelection(winPtr, &eventPtr->xselectionrequest);
490
*----------------------------------------------------------------------
494
* This procedure is invoked once every second while waiting for
495
* the selection to be returned. After a while it gives up and
496
* aborts the selection retrieval.
502
* A new timer callback is created to call us again in another
503
* second, unless time has expired, in which case an error is
504
* recorded for the retrieval.
506
*----------------------------------------------------------------------
510
SelTimeoutProc(clientData)
511
ClientData clientData; /* Information about retrieval
514
register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
517
* Make sure that the retrieval is still in progress. Then
518
* see how long it's been since any sort of response was received
519
* from the other side.
522
if (retrPtr->result != -1) {
526
if (retrPtr->idleTime >= 5) {
529
* Use a careful procedure to store the error message, because
530
* the result could already be partially filled in with a partial
534
Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
536
retrPtr->result = TCL_ERROR;
538
retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
539
(ClientData) retrPtr);
544
*----------------------------------------------------------------------
546
* ConvertSelection --
548
* This procedure is invoked to handle SelectionRequest events.
549
* It responds to the requests, obeying the ICCCM protocols.
555
* Properties are created for the selection requestor, and a
556
* SelectionNotify event is generated for the selection
557
* requestor. In the event of long selections, this procedure
558
* implements INCR-mode transfers, using the ICCCM protocol.
560
*----------------------------------------------------------------------
564
ConvertSelection(winPtr, eventPtr)
565
TkWindow *winPtr; /* Window that received the
566
* conversion request; may not be
567
* selection's current owner, be we
568
* set it to the current owner. */
569
register XSelectionRequestEvent *eventPtr;
570
/* Event describing request. */
572
XSelectionEvent reply; /* Used to notify requestor that
573
* selection info is ready. */
574
int multiple; /* Non-zero means a MULTIPLE request
575
* is being handled. */
576
IncrInfo incr; /* State of selection conversion. */
577
Atom singleInfo[2]; /* incr.multAtoms points here except
578
* for multiple conversions. */
580
Tk_ErrorHandler errorHandler;
581
TkSelectionInfo *infoPtr;
584
errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
585
(int (*)()) NULL, (ClientData) NULL);
588
* Initialize the reply event.
591
reply.type = SelectionNotify;
593
reply.send_event = True;
594
reply.display = eventPtr->display;
595
reply.requestor = eventPtr->requestor;
596
reply.selection = eventPtr->selection;
597
reply.target = eventPtr->target;
598
reply.property = eventPtr->property;
599
if (reply.property == None) {
600
reply.property = reply.target;
602
reply.time = eventPtr->time;
604
for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
605
infoPtr = infoPtr->nextPtr) {
606
if (infoPtr->selection == eventPtr->selection)
609
if (infoPtr == NULL) {
612
winPtr = (TkWindow *) infoPtr->owner;
615
* Figure out which kind(s) of conversion to perform. If handling
616
* a MULTIPLE conversion, then read the property describing which
617
* conversions to perform.
620
incr.winPtr = winPtr;
621
incr.selection = eventPtr->selection;
622
if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
624
singleInfo[0] = reply.target;
625
singleInfo[1] = reply.property;
626
incr.multAtoms = singleInfo;
627
incr.numConversions = 1;
631
unsigned long bytesAfter;
634
incr.multAtoms = NULL;
635
if (eventPtr->property == None) {
638
result = XGetWindowProperty(eventPtr->display,
639
eventPtr->requestor, eventPtr->property,
640
0, MAX_PROP_WORDS, False, XA_ATOM,
641
&type, &format, &incr.numConversions, &bytesAfter,
642
(unsigned char **) &incr.multAtoms);
643
if ((result != Success) || (bytesAfter != 0) || (format != 32)
645
if (incr.multAtoms != NULL) {
646
XFree((char *) incr.multAtoms);
650
incr.numConversions /= 2; /* Two atoms per conversion. */
654
* Loop through all of the requested conversions, and either return
655
* the entire converted selection, if it can be returned in a single
656
* bunch, or return INCR information only (the actual selection will
657
* be returned below).
660
incr.offsets = (int *) ckalloc((unsigned)
661
(incr.numConversions*sizeof(int)));
663
for (i = 0; i < incr.numConversions; i++) {
664
Atom target, property, type;
665
long buffer[TK_SEL_WORDS_AT_ONCE];
666
register TkSelHandler *selPtr;
667
int numItems, format;
670
target = incr.multAtoms[2*i];
671
property = incr.multAtoms[2*i + 1];
672
incr.offsets[i] = -1;
674
for (selPtr = winPtr->selHandlerList; selPtr != NULL;
675
selPtr = selPtr->nextPtr) {
676
if ((selPtr->target == target)
677
&& (selPtr->selection == eventPtr->selection)) {
682
if (selPtr == NULL) {
684
* Nobody seems to know about this kind of request. If
685
* it's of a sort that we can handle without any help, do
686
* it. Otherwise mark the request as an errror.
689
numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
690
TK_SEL_BYTES_AT_ONCE, &type);
692
incr.multAtoms[2*i + 1] = None;
697
ip.nextPtr = pendingPtr;
699
type = selPtr->format;
700
numItems = (*selPtr->proc)(selPtr->clientData, 0,
701
(char *) buffer, TK_SEL_BYTES_AT_ONCE);
702
pendingPtr = ip.nextPtr;
703
if ((ip.selPtr == NULL) || (numItems < 0)) {
704
incr.multAtoms[2*i + 1] = None;
707
if (numItems > TK_SEL_BYTES_AT_ONCE) {
708
panic("selection handler returned too many bytes");
710
((char *) buffer)[numItems] = '\0';
714
* Got the selection; store it back on the requestor's property.
717
if (numItems == TK_SEL_BYTES_AT_ONCE) {
719
* Selection is too big to send at once; start an
720
* INCR-mode transfer.
724
type = winPtr->dispPtr->incrAtom;
725
buffer[0] = SelectionSize(selPtr);
726
if (buffer[0] == 0) {
727
incr.multAtoms[2*i + 1] = None;
731
propPtr = (char *) buffer;
734
} else if (type == XA_STRING) {
735
propPtr = (char *) buffer;
738
propPtr = (char *) SelCvtToX((char *) buffer,
739
type, (Tk_Window) winPtr, &numItems);
742
XChangeProperty(reply.display, reply.requestor,
743
property, type, format, PropModeReplace,
744
(unsigned char *) propPtr, numItems);
745
if (propPtr != (char *) buffer) {
751
* Send an event back to the requestor to indicate that the
752
* first stage of conversion is complete (everything is done
753
* except for long conversions that have to be done in INCR
757
if (incr.numIncrs > 0) {
758
XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
759
incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
762
incr.reqWindow = reply.requestor;
763
incr.time = infoPtr->time;
764
incr.nextPtr = pendingIncrs;
765
pendingIncrs = &incr;
768
XChangeProperty(reply.display, reply.requestor, reply.property,
769
XA_ATOM, 32, PropModeReplace,
770
(unsigned char *) incr.multAtoms,
771
(int) incr.numConversions*2);
775
* Not a MULTIPLE request. The first property in "multAtoms"
776
* got set to None if there was an error in conversion.
779
reply.property = incr.multAtoms[1];
781
XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
782
Tk_DeleteErrorHandler(errorHandler);
785
* Handle any remaining INCR-mode transfers. This all happens
786
* in callbacks to TkSelPropProc, so just wait until the number
787
* of uncompleted INCR transfers drops to zero.
790
if (incr.numIncrs > 0) {
793
while (incr.numIncrs > 0) {
796
Tcl_DeleteTimerHandler(incr.timeout);
797
errorHandler = Tk_CreateErrorHandler(winPtr->display,
798
-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
799
XSelectInput(reply.display, reply.requestor, 0L);
800
Tk_DeleteErrorHandler(errorHandler);
801
if (pendingIncrs == &incr) {
802
pendingIncrs = incr.nextPtr;
804
for (incrPtr2 = pendingIncrs; incrPtr2 != NULL;
805
incrPtr2 = incrPtr2->nextPtr) {
806
if (incrPtr2->nextPtr == &incr) {
807
incrPtr2->nextPtr = incr.nextPtr;
815
* All done. Cleanup and return.
818
ckfree((char *) incr.offsets);
820
XFree((char *) incr.multAtoms);
825
* An error occurred. Send back a refusal message.
829
reply.property = None;
830
XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
831
Tk_DeleteErrorHandler(errorHandler);
836
*----------------------------------------------------------------------
840
* This procedure handles the INCR protocol on the receiving
841
* side. It is invoked in response to property changes on
842
* the requestor's window (which hopefully are because a new
843
* chunk of the selection arrived).
849
* If a new piece of selection has arrived, a procedure is
850
* invoked to deal with that piece. When the whole selection
851
* is here, a flag is left for the higher-level procedure that
852
* initiated the selection retrieval.
854
*----------------------------------------------------------------------
858
SelRcvIncrProc(clientData, eventPtr)
859
ClientData clientData; /* Information about retrieval. */
860
register XEvent *eventPtr; /* X PropertyChange event. */
862
register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
866
unsigned long numItems, bytesAfter;
869
if ((eventPtr->xproperty.atom != retrPtr->property)
870
|| (eventPtr->xproperty.state != PropertyNewValue)
871
|| (retrPtr->result != -1)) {
875
result = XGetWindowProperty(eventPtr->xproperty.display,
876
eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
877
True, (Atom) AnyPropertyType, &type, &format, &numItems,
878
&bytesAfter, (unsigned char **) &propInfo);
879
if ((result != Success) || (type == None)) {
882
if (bytesAfter != 0) {
883
Tcl_SetResult(retrPtr->interp, "selection property too large",
885
retrPtr->result = TCL_ERROR;
889
retrPtr->result = TCL_OK;
890
} else if ((type == XA_STRING)
891
|| (type == retrPtr->winPtr->dispPtr->textAtom)
892
|| (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
894
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
895
sprintf(retrPtr->interp->result,
896
"bad format for string selection: wanted \"8\", got \"%d\"",
898
retrPtr->result = TCL_ERROR;
901
interp = retrPtr->interp;
902
Tcl_Preserve((ClientData) interp);
903
result = (*retrPtr->proc)(retrPtr->clientData, interp, propInfo);
904
Tcl_Release((ClientData) interp);
905
if (result != TCL_OK) {
906
retrPtr->result = result;
912
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
913
sprintf(retrPtr->interp->result,
914
"bad format for selection: wanted \"32\", got \"%d\"",
916
retrPtr->result = TCL_ERROR;
919
string = SelCvtFromX((long *) propInfo, (int) numItems, type,
920
(Tk_Window) retrPtr->winPtr);
921
interp = retrPtr->interp;
922
Tcl_Preserve((ClientData) interp);
923
result = (*retrPtr->proc)(retrPtr->clientData, interp, string);
924
Tcl_Release((ClientData) interp);
925
if (result != TCL_OK) {
926
retrPtr->result = result;
933
retrPtr->idleTime = 0;
937
*----------------------------------------------------------------------
941
* This procedure is called when the selection is too large to
942
* send in a single buffer; it computes the total length of
943
* the selection in bytes.
946
* The return value is the number of bytes in the selection
950
* The selection is retrieved from its current owner (this is
951
* the only way to compute its size).
953
*----------------------------------------------------------------------
957
SelectionSize(selPtr)
958
TkSelHandler *selPtr; /* Information about how to retrieve
959
* the selection whose size is wanted. */
961
char buffer[TK_SEL_BYTES_AT_ONCE+1];
965
size = TK_SEL_BYTES_AT_ONCE;
967
ip.nextPtr = pendingPtr;
970
chunkSize = (*selPtr->proc)(selPtr->clientData, size,
971
(char *) buffer, TK_SEL_BYTES_AT_ONCE);
972
if (ip.selPtr == NULL) {
977
} while (chunkSize == TK_SEL_BYTES_AT_ONCE);
978
pendingPtr = ip.nextPtr;
983
*----------------------------------------------------------------------
987
* This procedure is invoked once a second while sending the
988
* selection to a requestor in INCR mode. After a while it
989
* gives up and aborts the selection operation.
995
* A new timeout gets registered so that this procedure gets
996
* called again in another second, unless too many seconds
997
* have elapsed, in which case incrPtr is marked as "all done".
999
*----------------------------------------------------------------------
1003
IncrTimeoutProc(clientData)
1004
ClientData clientData; /* Information about INCR-mode
1005
* selection retrieval for which
1006
* we are selection owner. */
1008
register IncrInfo *incrPtr = (IncrInfo *) clientData;
1010
incrPtr->idleTime++;
1011
if (incrPtr->idleTime >= 5) {
1012
incrPtr->numIncrs = 0;
1014
incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
1015
(ClientData) incrPtr);
1020
*----------------------------------------------------------------------
1024
* Given a selection represented as a string (the normal Tcl form),
1025
* convert it to the ICCCM-mandated format for X, depending on
1026
* the type argument. This procedure and SelCvtFromX are inverses.
1029
* The return value is a malloc'ed buffer holding a value
1030
* equivalent to "string", but formatted as for "type". It is
1031
* the caller's responsibility to free the string when done with
1032
* it. The word at *numLongsPtr is filled in with the number of
1033
* 32-bit words returned in the result.
1038
*----------------------------------------------------------------------
1042
SelCvtToX(string, type, tkwin, numLongsPtr)
1043
char *string; /* String representation of selection. */
1044
Atom type; /* Atom specifying the X format that is
1045
* desired for the selection. Should not
1046
* be XA_STRING (if so, don't bother calling
1047
* this procedure at all). */
1048
Tk_Window tkwin; /* Window that governs atom conversion. */
1049
int *numLongsPtr; /* Number of 32-bit words contained in the
1055
long *propPtr, *longPtr;
1056
#define MAX_ATOM_NAME_LENGTH 100
1057
char atomName[MAX_ATOM_NAME_LENGTH+1];
1060
* The string is assumed to consist of fields separated by spaces.
1061
* The property gets generated by converting each field to an
1062
* integer number, in one of two ways:
1063
* 1. If type is XA_ATOM, convert each field to its corresponding
1065
* 2. If type is anything else, convert each field from an ASCII number
1066
* to a 32-bit binary number.
1070
for (p = string; *p != 0; p++) {
1071
if (isspace(UCHAR(*p))) {
1075
propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
1078
* Convert the fields one-by-one.
1081
for (longPtr = propPtr, *numLongsPtr = 0, p = string;
1082
; longPtr++, (*numLongsPtr)++) {
1083
while (isspace(UCHAR(*p))) {
1090
while ((*p != 0) && !isspace(UCHAR(*p))) {
1093
if (type == XA_ATOM) {
1097
if (length > MAX_ATOM_NAME_LENGTH) {
1098
length = MAX_ATOM_NAME_LENGTH;
1100
strncpy(atomName, field, (unsigned) length);
1101
atomName[length] = 0;
1102
*longPtr = (long) Tk_InternAtom(tkwin, atomName);
1106
*longPtr = strtol(field, &dummy, 0);
1113
*----------------------------------------------------------------------
1117
* Given an X property value, formatted as a collection of 32-bit
1118
* values according to "type" and the ICCCM conventions, convert
1119
* the value to a string suitable for manipulation by Tcl. This
1120
* procedure is the inverse of SelCvtToX.
1123
* The return value is the string equivalent of "property". It is
1124
* malloc-ed and should be freed by the caller when no longer
1130
*----------------------------------------------------------------------
1134
SelCvtFromX(propPtr, numValues, type, tkwin)
1135
register long *propPtr; /* Property value from X. */
1136
int numValues; /* Number of 32-bit values in property. */
1137
Atom type; /* Type of property Should not be
1138
* XA_STRING (if so, don't bother calling
1139
* this procedure at all). */
1140
Tk_Window tkwin; /* Window to use for atom conversion. */
1143
int resultSpace, curSize, fieldSize;
1147
* Convert each long in the property to a string value, which is
1148
* either the name of an atom (if type is XA_ATOM) or a hexadecimal
1149
* string. Make an initial guess about the size of the result, but
1150
* be prepared to enlarge the result if necessary.
1153
resultSpace = 12*numValues+1;
1155
atomName = ""; /* Not needed, but eliminates compiler warning. */
1156
result = (char *) ckalloc((unsigned) resultSpace);
1158
for ( ; numValues > 0; propPtr++, numValues--) {
1159
if (type == XA_ATOM) {
1160
atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
1161
fieldSize = strlen(atomName) + 1;
1165
if (curSize+fieldSize >= resultSpace) {
1169
if (curSize+fieldSize >= resultSpace) {
1170
resultSpace = curSize + fieldSize + 1;
1172
newResult = (char *) ckalloc((unsigned) resultSpace);
1173
strncpy(newResult, result, (unsigned) curSize);
1178
result[curSize] = ' ';
1181
if (type == XA_ATOM) {
1182
strcpy(result+curSize, atomName);
1184
sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
1186
curSize += strlen(result+curSize);
added
removed
unix/tkUnixSelect.c
