1 /*
2 * tkUnixSelect.c --
3 *
4 * This file contains X specific routines for manipulating selections.
5 *
6 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
7 *
8 * See the file "license.terms" for information on usage and redistribution of
9 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 */
11
12 #include "tkInt.h"
13 #include "tkSelect.h"
14
15 typedef struct ConvertInfo {
16 int offset; /* The starting byte offset into the selection
17 * for the next chunk; -1 means all data has
18 * been transferred for this conversion. -2
19 * means only the final zero-length transfer
20 * still has to be done. Otherwise it is the
21 * offset of the next chunk of data to
22 * transfer. */
23 Tcl_EncodingState state; /* The encoding state needed across chunks. */
24 char buffer[4]; /* A buffer to hold part of a UTF character
25 * that is split across chunks.*/
26 } ConvertInfo;
27
28 /*
29 * When handling INCR-style selection retrievals, the selection owner uses the
30 * following data structure to communicate between the ConvertSelection
31 * function and TkSelPropProc.
32 */
33
34 typedef struct IncrInfo {
35 TkWindow *winPtr; /* Window that owns selection. */
36 Atom selection; /* Selection that is being retrieved. */
37 Atom *multAtoms; /* Information about conversions to perform:
38 * one or more pairs of (target, property).
39 * This either points to a retrieved property
40 * (for MULTIPLE retrievals) or to a static
41 * array. */
42 unsigned long numConversions;
43 /* Number of entries in converts (same as # of
44 * pairs in multAtoms). */
45 ConvertInfo *converts; /* One entry for each pair in multAtoms. This
46 * array is malloc-ed. */
47 char **tempBufs; /* One pointer for each pair in multAtoms;
48 * each pointer is either NULL, or it points
49 * to a small bit of character data that was
50 * left over from the previous chunk. */
51 Tcl_EncodingState *state; /* One state info per pair in multAtoms: State
52 * info for encoding conversions that span
53 * multiple buffers. */
54 int *flags; /* One state flag per pair in multAtoms:
55 * Encoding flags, set to TCL_ENCODING_START
56 * at the beginning of an INCR transfer. */
57 int numIncrs; /* Number of entries in converts that aren't
58 * -1 (i.e. # of INCR-mode transfers not yet
59 * completed). */
60 Tcl_TimerToken timeout; /* Token for timer function. */
61 int idleTime; /* Number of seconds since we heard anything
62 * from the selection requestor. */
63 Window reqWindow; /* Requestor's window id. */
64 Time time; /* Timestamp corresponding to selection at
65 * beginning of request; used to abort
66 * transfer if selection changes. */
67 struct IncrInfo *nextPtr; /* Next in list of all INCR-style retrievals
68 * currently pending. */
69 } IncrInfo;
70
71 typedef struct {
72 IncrInfo *pendingIncrs; /* List of all incr structures currently
73 * active. */
74 } ThreadSpecificData;
75 static Tcl_ThreadDataKey dataKey;
76
77 /*
78 * Largest property that we'll accept when sending or receiving the selection:
79 */
80
81 #define MAX_PROP_WORDS 100000
82
83 static TkSelRetrievalInfo *pendingRetrievals = NULL;
84 /* List of all retrievals currently being
85 * waited for. */
86
87 /*
88 * Forward declarations for functions defined in this file:
89 */
90
91 static void ConvertSelection(TkWindow *winPtr,
92 XSelectionRequestEvent *eventPtr);
93 static void IncrTimeoutProc(ClientData clientData);
94 static void SelCvtFromX32(long *propPtr, int numValues, Atom type,
95 Tk_Window tkwin, Tcl_DString *dsPtr);
96 static void SelCvtFromX8(char *propPtr, int numValues, Atom type,
97 Tk_Window tkwin, Tcl_DString *dsPtr);
98 static long * SelCvtToX(char *string, Atom type, Tk_Window tkwin,
99 int *numLongsPtr);
100 static int SelectionSize(TkSelHandler *selPtr);
101 static void SelRcvIncrProc(ClientData clientData,
102 XEvent *eventPtr);
103 static void SelTimeoutProc(ClientData clientData);
104
105 /*
106 *----------------------------------------------------------------------
107 *
108 * TkSelGetSelection --
109 *
110 * Retrieve the specified selection from another process.
111 *
112 * Results:
113 * The return value is a standard Tcl return value. If an error occurs
114 * (such as no selection exists) then an error message is left in the
115 * interp's result.
116 *
117 * Side effects:
118 * None.
119 *
120 *----------------------------------------------------------------------
121 */
122
123 int
TkSelGetSelection(Tcl_Interp * interp,Tk_Window tkwin,Atom selection,Atom target,Tk_GetSelProc * proc,ClientData clientData)124 TkSelGetSelection(
125 Tcl_Interp *interp, /* Interpreter to use for reporting errors. */
126 Tk_Window tkwin, /* Window on whose behalf to retrieve the
127 * selection (determines display from which to
128 * retrieve). */
129 Atom selection, /* Selection to retrieve. */
130 Atom target, /* Desired form in which selection is to be
131 * returned. */
132 Tk_GetSelProc *proc, /* Function to call to process the selection,
133 * once it has been retrieved. */
134 ClientData clientData) /* Arbitrary value to pass to proc. */
135 {
136 TkSelRetrievalInfo retr;
137 TkWindow *winPtr = (TkWindow *) tkwin;
138 TkDisplay *dispPtr = winPtr->dispPtr;
139
140 /*
141 * The selection is owned by some other process. To retrieve it, first
142 * record information about the retrieval in progress. Use an internal
143 * window as the requestor.
144 */
145
146 retr.interp = interp;
147 if (dispPtr->clipWindow == NULL) {
148 int result;
149
150 result = TkClipInit(interp, dispPtr);
151 if (result != TCL_OK) {
152 return result;
153 }
154 }
155 retr.winPtr = (TkWindow *) dispPtr->clipWindow;
156 retr.selection = selection;
157 retr.property = selection;
158 retr.target = target;
159 retr.proc = proc;
160 retr.clientData = clientData;
161 retr.result = -1;
162 retr.idleTime = 0;
163 retr.encFlags = TCL_ENCODING_START;
164 retr.nextPtr = pendingRetrievals;
165 Tcl_DStringInit(&retr.buf);
166 pendingRetrievals = &retr;
167
168 /*
169 * Delete the property to indicate that no parameters are supplied for
170 * the conversion request.
171 */
172
173 XDeleteProperty(winPtr->display, retr.winPtr->window, retr.property);
174
175 /*
176 * Initiate the request for the selection. Note: can't use TkCurrentTime
177 * for the time. If we do, and this application hasn't received any X
178 * events in a long time, the current time will be way in the past and
179 * could even predate the time when the selection was made; if this
180 * happens, the request will be rejected.
181 */
182
183 XConvertSelection(winPtr->display, retr.selection, retr.target,
184 retr.property, retr.winPtr->window, CurrentTime);
185
186 /*
187 * Enter a loop processing X events until the selection has been retrieved
188 * and processed. If no response is received within a few seconds, then
189 * timeout.
190 */
191
192 retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
193 &retr);
194 while (retr.result == -1) {
195 Tcl_DoOneEvent(0);
196 }
197 Tcl_DeleteTimerHandler(retr.timeout);
198
199 /*
200 * Unregister the information about the selection retrieval in progress.
201 */
202
203 if (pendingRetrievals == &retr) {
204 pendingRetrievals = retr.nextPtr;
205 } else {
206 TkSelRetrievalInfo *retrPtr;
207
208 for (retrPtr = pendingRetrievals; retrPtr != NULL;
209 retrPtr = retrPtr->nextPtr) {
210 if (retrPtr->nextPtr == &retr) {
211 retrPtr->nextPtr = retr.nextPtr;
212 break;
213 }
214 }
215 }
216 Tcl_DStringFree(&retr.buf);
217 return retr.result;
218 }
219
220 /*
221 *----------------------------------------------------------------------
222 *
223 * TkSelPropProc --
224 *
225 * This function is invoked when property-change events occur on windows
226 * not known to the toolkit. Its function is to implement the sending
227 * side of the INCR selection retrieval protocol when the selection
228 * requestor deletes the property containing a part of the selection.
229 *
230 * Results:
231 * None.
232 *
233 * Side effects:
234 * If the property that is receiving the selection was just deleted, then
235 * a new piece of the selection is fetched and placed in the property,
236 * until eventually there's no more selection to fetch.
237 *
238 *----------------------------------------------------------------------
239 */
240
241 void
TkSelPropProc(XEvent * eventPtr)242 TkSelPropProc(
243 XEvent *eventPtr) /* X PropertyChange event. */
244 {
245 IncrInfo *incrPtr;
246 TkSelHandler *selPtr;
247 int length, numItems;
248 unsigned long i;
249 Atom target, formatType;
250 long buffer[TK_SEL_WORDS_AT_ONCE];
251 TkDisplay *dispPtr = TkGetDisplay(eventPtr->xany.display);
252 Tk_ErrorHandler errorHandler;
253 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
254 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
255
256 /*
257 * See if this event announces the deletion of a property being used for
258 * an INCR transfer. If so, then add the next chunk of data to the
259 * property.
260 */
261
262 if (eventPtr->xproperty.state != PropertyDelete) {
263 return;
264 }
265 for (incrPtr = tsdPtr->pendingIncrs; incrPtr != NULL;
266 incrPtr = incrPtr->nextPtr) {
267 if (incrPtr->reqWindow != eventPtr->xproperty.window) {
268 continue;
269 }
270
271 /*
272 * For each conversion that has been requested, handle any chunks that
273 * haven't been transmitted yet.
274 */
275
276 for (i = 0; i < incrPtr->numConversions; i++) {
277 if ((eventPtr->xproperty.atom != incrPtr->multAtoms[2*i + 1])
278 || (incrPtr->converts[i].offset == -1)) {
279 continue;
280 }
281 target = incrPtr->multAtoms[2*i];
282 incrPtr->idleTime = 0;
283
284 /*
285 * Look for a matching selection handler.
286 */
287
288 for (selPtr = incrPtr->winPtr->selHandlerList; ;
289 selPtr = selPtr->nextPtr) {
290 if (selPtr == NULL) {
291 /*
292 * No handlers match, so mark the conversion as done.
293 */
294
295 incrPtr->multAtoms[2*i + 1] = None;
296 incrPtr->converts[i].offset = -1;
297 incrPtr->numIncrs --;
298 return;
299 }
300 if ((selPtr->target == target)
301 && (selPtr->selection == incrPtr->selection)) {
302 break;
303 }
304 }
305
306 /*
307 * We found a handler, so get the next chunk from it.
308 */
309
310 formatType = selPtr->format;
311 if (incrPtr->converts[i].offset == -2) {
312 /*
313 * We already got the last chunk, so send a null chunk to
314 * indicate that we are finished.
315 */
316
317 numItems = 0;
318 length = 0;
319 } else {
320 TkSelInProgress ip;
321
322 ip.selPtr = selPtr;
323 ip.nextPtr = TkSelGetInProgress();
324 TkSelSetInProgress(&ip);
325
326 /*
327 * Copy any bytes left over from a partial character at the
328 * end of the previous chunk into the beginning of the buffer.
329 * Pass the rest of the buffer space into the selection
330 * handler.
331 */
332
333 length = strlen(incrPtr->converts[i].buffer);
334 strcpy((char *)buffer, incrPtr->converts[i].buffer);
335
336 numItems = selPtr->proc(selPtr->clientData,
337 incrPtr->converts[i].offset,
338 ((char *) buffer) + length,
339 TK_SEL_BYTES_AT_ONCE - length);
340 TkSelSetInProgress(ip.nextPtr);
341 if (ip.selPtr == NULL) {
342 /*
343 * The selection handler deleted itself.
344 */
345
346 return;
347 }
348 if (numItems < 0) {
349 numItems = 0;
350 }
351 numItems += length;
352 if (numItems > TK_SEL_BYTES_AT_ONCE) {
353 Tcl_Panic("selection handler returned too many bytes");
354 }
355 }
356 ((char *) buffer)[numItems] = 0;
357
358 errorHandler = Tk_CreateErrorHandler(eventPtr->xproperty.display,
359 -1, -1, -1, NULL, NULL);
360
361 /*
362 * Encode the data using the proper format for each type.
363 */
364
365 if ((formatType == XA_STRING)
366 || (dispPtr && formatType==dispPtr->utf8Atom)
367 || (dispPtr && formatType==dispPtr->compoundTextAtom)) {
368 Tcl_DString ds;
369 int encodingCvtFlags;
370 int srcLen, dstLen, result, srcRead, dstWrote, soFar;
371 char *src, *dst;
372 Tcl_Encoding encoding;
373
374 /*
375 * Set up the encoding state based on the format and whether
376 * this is the first and/or last chunk.
377 */
378
379 encodingCvtFlags = 0;
380 if (incrPtr->converts[i].offset == 0) {
381 encodingCvtFlags |= TCL_ENCODING_START;
382 }
383 if (numItems < TK_SEL_BYTES_AT_ONCE) {
384 encodingCvtFlags |= TCL_ENCODING_END;
385 }
386 if (formatType == XA_STRING) {
387 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
388 } else if (dispPtr && formatType==dispPtr->utf8Atom) {
389 encoding = Tcl_GetEncoding(NULL, "utf-8");
390 } else {
391 encoding = Tcl_GetEncoding(NULL, "iso2022");
392 }
393
394 /*
395 * Now convert the data.
396 */
397
398 src = (char *)buffer;
399 srcLen = numItems;
400 Tcl_DStringInit(&ds);
401 dst = Tcl_DStringValue(&ds);
402 dstLen = ds.spaceAvl - 1;
403
404
405 /*
406 * Now convert the data, growing the destination buffer as
407 * needed.
408 */
409
410 while (1) {
411 result = Tcl_UtfToExternal(NULL, encoding, src, srcLen,
412 encodingCvtFlags, &incrPtr->converts[i].state,
413 dst, dstLen, &srcRead, &dstWrote, NULL);
414 soFar = dst + dstWrote - Tcl_DStringValue(&ds);
415 encodingCvtFlags &= ~TCL_ENCODING_START;
416 src += srcRead;
417 srcLen -= srcRead;
418 if (result != TCL_CONVERT_NOSPACE) {
419 Tcl_DStringSetLength(&ds, soFar);
420 break;
421 }
422 if (Tcl_DStringLength(&ds) == 0) {
423 Tcl_DStringSetLength(&ds, dstLen);
424 }
425 Tcl_DStringSetLength(&ds, 2 * Tcl_DStringLength(&ds) + 1);
426 dst = Tcl_DStringValue(&ds) + soFar;
427 dstLen = Tcl_DStringLength(&ds) - soFar - 1;
428 }
429 Tcl_DStringSetLength(&ds, soFar);
430
431 if (encoding) {
432 Tcl_FreeEncoding(encoding);
433 }
434
435 /*
436 * Set the property to the encoded string value.
437 */
438
439 XChangeProperty(eventPtr->xproperty.display,
440 eventPtr->xproperty.window, eventPtr->xproperty.atom,
441 formatType, 8, PropModeReplace,
442 (unsigned char *) Tcl_DStringValue(&ds),
443 Tcl_DStringLength(&ds));
444
445 /*
446 * Preserve any left-over bytes.
447 */
448
449 if (srcLen > 3) {
450 Tcl_Panic("selection conversion left too many bytes unconverted");
451 }
452 memcpy(incrPtr->converts[i].buffer, src, srcLen + 1);
453 Tcl_DStringFree(&ds);
454 } else {
455 /*
456 * Set the property to the encoded string value.
457 */
458
459 char *propPtr = (char *) SelCvtToX((char *) buffer,
460 formatType, (Tk_Window) incrPtr->winPtr, &numItems);
461
462 if (propPtr == NULL) {
463 numItems = 0;
464 }
465 XChangeProperty(eventPtr->xproperty.display,
466 eventPtr->xproperty.window, eventPtr->xproperty.atom,
467 formatType, 32, PropModeReplace,
468 (unsigned char *) propPtr, numItems);
469 if (propPtr != NULL) {
470 ckfree(propPtr);
471 }
472 }
473 Tk_DeleteErrorHandler(errorHandler);
474
475 /*
476 * Compute the next offset value. If this was the last chunk, then
477 * set the offset to -2. If this was an empty chunk, then set the
478 * offset to -1 to indicate we are done.
479 */
480
481 if (numItems < TK_SEL_BYTES_AT_ONCE) {
482 if (numItems <= 0) {
483 incrPtr->converts[i].offset = -1;
484 incrPtr->numIncrs--;
485 } else {
486 incrPtr->converts[i].offset = -2;
487 }
488 } else {
489 /*
490 * Advance over the selection data that was consumed this
491 * time.
492 */
493
494 incrPtr->converts[i].offset += numItems - length;
495 }
496 return;
497 }
498 }
499 }
500
501 /*
502 *--------------------------------------------------------------
503 *
504 * TkSelEventProc --
505 *
506 * This function is invoked whenever a selection-related event occurs.
507 * It does the lion's share of the work in implementing the selection
508 * protocol.
509 *
510 * Results:
511 * None.
512 *
513 * Side effects:
514 * Lots: depends on the type of event.
515 *
516 *--------------------------------------------------------------
517 */
518
519 void
TkSelEventProc(Tk_Window tkwin,XEvent * eventPtr)520 TkSelEventProc(
521 Tk_Window tkwin, /* Window for which event was targeted. */
522 XEvent *eventPtr) /* X event: either SelectionClear,
523 * SelectionRequest, or SelectionNotify. */
524 {
525 TkWindow *winPtr = (TkWindow *) tkwin;
526 TkDisplay *dispPtr = winPtr->dispPtr;
527 Tcl_Interp *interp;
528
529 /*
530 * Case #1: SelectionClear events.
531 */
532
533 if (eventPtr->type == SelectionClear) {
534 TkSelClearSelection(tkwin, eventPtr);
535 }
536
537 /*
538 * Case #2: SelectionNotify events. Call the relevant function to handle
539 * the incoming selection.
540 */
541
542 if (eventPtr->type == SelectionNotify) {
543 TkSelRetrievalInfo *retrPtr;
544 char *propInfo, **propInfoPtr = &propInfo;
545 Atom type;
546 int format, result;
547 unsigned long numItems, bytesAfter;
548
549 for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
550 if (retrPtr == NULL) {
551 return;
552 }
553 if ((retrPtr->winPtr == winPtr)
554 && (retrPtr->selection == eventPtr->xselection.selection)
555 && (retrPtr->target == eventPtr->xselection.target)
556 && (retrPtr->result == -1)) {
557 if (retrPtr->property == eventPtr->xselection.property) {
558 break;
559 }
560 if (eventPtr->xselection.property == None) {
561 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
562 "%s selection doesn't exist or form \"%s\" not defined",
563 Tk_GetAtomName(tkwin, retrPtr->selection),
564 Tk_GetAtomName(tkwin, retrPtr->target)));
565 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION",
566 "NONE", NULL);
567 retrPtr->result = TCL_ERROR;
568 return;
569 }
570 }
571 }
572
573 propInfo = NULL;
574 result = XGetWindowProperty(eventPtr->xselection.display,
575 eventPtr->xselection.requestor, retrPtr->property,
576 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
577 &type, &format, &numItems, &bytesAfter,
578 (unsigned char **) propInfoPtr);
579 if ((result != Success) || (type == None)) {
580 return;
581 }
582 if (bytesAfter != 0) {
583 Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
584 "selection property too large", -1));
585 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE",NULL);
586 retrPtr->result = TCL_ERROR;
587 XFree(propInfo);
588 return;
589 }
590 if ((type == XA_STRING) || (type == dispPtr->textAtom)
591 || (type == dispPtr->compoundTextAtom)) {
592 Tcl_Encoding encoding;
593 Tcl_DString ds;
594
595 if (format != 8) {
596 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
597 "bad format for string selection: wanted \"8\", got \"%d\"",
598 format));
599 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
600 NULL);
601 retrPtr->result = TCL_ERROR;
602 return;
603 }
604 interp = retrPtr->interp;
605 Tcl_Preserve(interp);
606
607 /*
608 * Convert the X selection data into UTF before passing it to the
609 * selection callback. Note that the COMPOUND_TEXT uses a modified
610 * iso2022 encoding, not the current system encoding. For now
611 * we'll just blindly apply the iso2022 encoding. This is probably
612 * wrong, but it's a placeholder until we figure out what we're
613 * really supposed to do. For STRING, we need to use Latin-1
614 * instead. Again, it's not really the full iso8859-1 space, but
615 * this is close enough.
616 */
617
618 if (type == dispPtr->compoundTextAtom) {
619 encoding = Tcl_GetEncoding(NULL, "iso2022");
620 } else {
621 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
622 }
623 Tcl_ExternalToUtfDString(encoding, propInfo, (int)numItems, &ds);
624 if (encoding) {
625 Tcl_FreeEncoding(encoding);
626 }
627
628 retrPtr->result = retrPtr->proc(retrPtr->clientData, interp,
629 Tcl_DStringValue(&ds));
630 Tcl_DStringFree(&ds);
631 Tcl_Release(interp);
632 } else if (type == dispPtr->utf8Atom) {
633 /*
634 * The X selection data is in UTF-8 format already. We can't
635 * guarantee that propInfo is NULL-terminated, so we might have to
636 * copy the string.
637 */
638
639 char *propData = propInfo;
640
641 if (format != 8) {
642 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
643 "bad format for string selection: wanted \"8\", got \"%d\"",
644 format));
645 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
646 NULL);
647 retrPtr->result = TCL_ERROR;
648 return;
649 }
650
651 if (propInfo[numItems] != '\0') {
652 propData = (char *)ckalloc(numItems + 1);
653 strcpy(propData, propInfo);
654 propData[numItems] = '\0';
655 }
656 retrPtr->result = retrPtr->proc(retrPtr->clientData,
657 retrPtr->interp, propData);
658 if (propData != propInfo) {
659 ckfree(propData);
660 }
661
662 } else if (type == dispPtr->incrAtom) {
663 /*
664 * It's a !?#@!?!! INCR-style reception. Arrange to receive the
665 * selection in pieces, using the ICCCM protocol, then hang around
666 * until either the selection is all here or a timeout occurs.
667 */
668
669 retrPtr->idleTime = 0;
670 Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
671 retrPtr);
672 XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
673 retrPtr->property);
674 while (retrPtr->result == -1) {
675 Tcl_DoOneEvent(0);
676 }
677 Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
678 retrPtr);
679 } else {
680 Tcl_DString ds;
681
682 if (format != 32 && format != 8) {
683 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
684 "bad format for selection: wanted \"32\" or "
685 "\"8\", got \"%d\"", format));
686 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
687 NULL);
688 retrPtr->result = TCL_ERROR;
689 return;
690 }
691 Tcl_DStringInit(&ds);
692 if (format == 32) {
693 SelCvtFromX32((long *) propInfo, (int) numItems, type,
694 (Tk_Window) winPtr, &ds);
695 } else {
696 SelCvtFromX8((char *) propInfo, (int) numItems, type,
697 (Tk_Window) winPtr, &ds);
698 }
699 interp = retrPtr->interp;
700 Tcl_Preserve(interp);
701 retrPtr->result = retrPtr->proc(retrPtr->clientData,
702 interp, Tcl_DStringValue(&ds));
703 Tcl_Release(interp);
704 Tcl_DStringFree(&ds);
705 }
706 XFree(propInfo);
707 return;
708 }
709
710 /*
711 * Case #3: SelectionRequest events. Call ConvertSelection to do the dirty
712 * work.
713 */
714
715 if (eventPtr->type == SelectionRequest) {
716 ConvertSelection(winPtr, &eventPtr->xselectionrequest);
717 return;
718 }
719 }
720
721 /*
722 *----------------------------------------------------------------------
723 *
724 * SelTimeoutProc --
725 *
726 * This function is invoked once every second while waiting for the
727 * selection to be returned. After a while it gives up and aborts the
728 * selection retrieval.
729 *
730 * Results:
731 * None.
732 *
733 * Side effects:
734 * A new timer callback is created to call us again in another second,
735 * unless time has expired, in which case an error is recorded for the
736 * retrieval.
737 *
738 *----------------------------------------------------------------------
739 */
740
741 static void
SelTimeoutProc(ClientData clientData)742 SelTimeoutProc(
743 ClientData clientData) /* Information about retrieval in progress. */
744 {
745 TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *)clientData;
746
747 /*
748 * Make sure that the retrieval is still in progress. Then see how long
749 * it's been since any sort of response was received from the other side.
750 */
751
752 if (retrPtr->result != -1) {
753 return;
754 }
755 retrPtr->idleTime++;
756 if (retrPtr->idleTime >= 5) {
757 /*
758 * Use a careful function to store the error message, because the
759 * result could already be partially filled in with a partial
760 * selection return.
761 */
762
763 Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
764 "selection owner didn't respond", -1));
765 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "IGNORED", NULL);
766 retrPtr->result = TCL_ERROR;
767 } else {
768 retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
769 retrPtr);
770 }
771 }
772
773 /*
774 *----------------------------------------------------------------------
775 *
776 * ConvertSelection --
777 *
778 * This function is invoked to handle SelectionRequest events. It
779 * responds to the requests, obeying the ICCCM protocols.
780 *
781 * Results:
782 * None.
783 *
784 * Side effects:
785 * Properties are created for the selection requestor, and a
786 * SelectionNotify event is generated for the selection requestor. In the
787 * event of long selections, this function implements INCR-mode
788 * transfers, using the ICCCM protocol.
789 *
790 *----------------------------------------------------------------------
791 */
792
793 static void
ConvertSelection(TkWindow * winPtr,XSelectionRequestEvent * eventPtr)794 ConvertSelection(
795 TkWindow *winPtr, /* Window that received the conversion
796 * request; may not be selection's current
797 * owner, be we set it to the current
798 * owner. */
799 XSelectionRequestEvent *eventPtr)
800 /* Event describing request. */
801 {
802 union {
803 XSelectionEvent xsel;
804 XEvent ev;
805 } reply; /* Used to notify requestor that selection
806 * info is ready. */
807 int multiple; /* Non-zero means a MULTIPLE request is being
808 * handled. */
809 IncrInfo incr; /* State of selection conversion. */
810 Atom singleInfo[2]; /* incr.multAtoms points here except for
811 * multiple conversions. */
812 unsigned long i;
813 Tk_ErrorHandler errorHandler;
814 TkSelectionInfo *infoPtr;
815 TkSelInProgress ip;
816 ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
817 Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
818
819 errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,
820 -1, NULL, NULL);
821
822 /*
823 * Initialize the reply event.
824 */
825
826 reply.xsel.type = SelectionNotify;
827 reply.xsel.serial = 0;
828 reply.xsel.send_event = True;
829 reply.xsel.display = eventPtr->display;
830 reply.xsel.requestor = eventPtr->requestor;
831 reply.xsel.selection = eventPtr->selection;
832 reply.xsel.target = eventPtr->target;
833 reply.xsel.property = eventPtr->property;
834 if (reply.xsel.property == None) {
835 reply.xsel.property = reply.xsel.target;
836 }
837 reply.xsel.time = eventPtr->time;
838
839 for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
840 infoPtr = infoPtr->nextPtr) {
841 if (infoPtr->selection == eventPtr->selection) {
842 break;
843 }
844 }
845 if (infoPtr == NULL) {
846 goto refuse;
847 }
848 winPtr = (TkWindow *) infoPtr->owner;
849
850 /*
851 * Figure out which kind(s) of conversion to perform. If handling a
852 * MULTIPLE conversion, then read the property describing which
853 * conversions to perform.
854 */
855
856 incr.winPtr = winPtr;
857 incr.selection = eventPtr->selection;
858 if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
859 multiple = 0;
860 singleInfo[0] = reply.xsel.target;
861 singleInfo[1] = reply.xsel.property;
862 incr.multAtoms = singleInfo;
863 incr.numConversions = 1;
864 } else {
865 Atom type, **multAtomsPtr = &incr.multAtoms;
866 int format, result;
867 unsigned long bytesAfter;
868
869 multiple = 1;
870 incr.multAtoms = NULL;
871 if (eventPtr->property == None) {
872 goto refuse;
873 }
874 result = XGetWindowProperty(eventPtr->display, eventPtr->requestor,
875 eventPtr->property, 0, MAX_PROP_WORDS, False,
876 winPtr->dispPtr->atomPairAtom, &type, &format,
877 &incr.numConversions, &bytesAfter,
878 (unsigned char **) multAtomsPtr);
879 if ((result != Success) || (bytesAfter != 0) || (format != 32)
880 || (type == None)) {
881 if (incr.multAtoms != NULL) {
882 XFree((char *) incr.multAtoms);
883 }
884 goto refuse;
885 }
886 incr.numConversions /= 2; /* Two atoms per conversion. */
887 }
888
889 /*
890 * Loop through all of the requested conversions, and either return the
891 * entire converted selection, if it can be returned in a single bunch, or
892 * return INCR information only (the actual selection will be returned
893 * below).
894 */
895
896 incr.converts = (ConvertInfo *)ckalloc(incr.numConversions * sizeof(ConvertInfo));
897 incr.numIncrs = 0;
898 for (i = 0; i < incr.numConversions; i++) {
899 Atom target, property, type;
900 long buffer[TK_SEL_WORDS_AT_ONCE];
901 TkSelHandler *selPtr;
902 int numItems, format;
903 char *propPtr;
904
905 target = incr.multAtoms[2*i];
906 property = incr.multAtoms[2*i + 1];
907 incr.converts[i].offset = -1;
908 incr.converts[i].buffer[0] = '\0';
909
910 for (selPtr = winPtr->selHandlerList; selPtr != NULL;
911 selPtr = selPtr->nextPtr) {
912 if ((selPtr->target == target)
913 && (selPtr->selection == eventPtr->selection)) {
914 break;
915 }
916 }
917
918 if (selPtr == NULL) {
919 /*
920 * Nobody seems to know about this kind of request. If it's of a
921 * sort that we can handle without any help, do it. Otherwise mark
922 * the request as an error.
923 */
924
925 numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
926 TK_SEL_BYTES_AT_ONCE, &type);
927 if (numItems < 0) {
928 incr.multAtoms[2*i + 1] = None;
929 continue;
930 }
931 } else {
932 ip.selPtr = selPtr;
933 ip.nextPtr = TkSelGetInProgress();
934 TkSelSetInProgress(&ip);
935 type = selPtr->format;
936 numItems = selPtr->proc(selPtr->clientData, 0, (char *) buffer,
937 TK_SEL_BYTES_AT_ONCE);
938 TkSelSetInProgress(ip.nextPtr);
939 if ((ip.selPtr == NULL) || (numItems < 0)) {
940 incr.multAtoms[2*i + 1] = None;
941 continue;
942 }
943 if (numItems > TK_SEL_BYTES_AT_ONCE) {
944 Tcl_Panic("selection handler returned too many bytes");
945 }
946 ((char *) buffer)[numItems] = '\0';
947 }
948
949 /*
950 * Got the selection; store it back on the requestor's property.
951 */
952
953 if (numItems == TK_SEL_BYTES_AT_ONCE) {
954 /*
955 * Selection is too big to send at once; start an INCR-mode
956 * transfer.
957 */
958
959 incr.numIncrs++;
960 type = winPtr->dispPtr->incrAtom;
961 buffer[0] = SelectionSize(selPtr);
962 if (buffer[0] == 0) {
963 incr.multAtoms[2*i + 1] = None;
964 continue;
965 }
966 numItems = 1;
967 propPtr = (char *) buffer;
968 format = 32;
969 incr.converts[i].offset = 0;
970 XChangeProperty(reply.xsel.display, reply.xsel.requestor,
971 property, type, format, PropModeReplace,
972 (unsigned char *) propPtr, numItems);
973 } else if (type == winPtr->dispPtr->utf8Atom) {
974 /*
975 * This matches selection requests of type UTF8_STRING, which
976 * allows us to pass our utf-8 information untouched.
977 */
978
979 XChangeProperty(reply.xsel.display, reply.xsel.requestor,
980 property, type, 8, PropModeReplace,
981 (unsigned char *) buffer, numItems);
982 } else if ((type == XA_STRING)
983 || (type == winPtr->dispPtr->compoundTextAtom)) {
984 Tcl_DString ds;
985 Tcl_Encoding encoding;
986
987 /*
988 * STRING is Latin-1, COMPOUND_TEXT is an iso2022 variant. We need
989 * to convert the selection text into these external forms before
990 * modifying the property.
991 */
992
993 if (type == XA_STRING) {
994 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
995 } else {
996 encoding = Tcl_GetEncoding(NULL, "iso2022");
997 }
998 Tcl_UtfToExternalDString(encoding, (char *) buffer, -1, &ds);
999 XChangeProperty(reply.xsel.display, reply.xsel.requestor,
1000 property, type, 8, PropModeReplace,
1001 (unsigned char *) Tcl_DStringValue(&ds),
1002 Tcl_DStringLength(&ds));
1003 if (encoding) {
1004 Tcl_FreeEncoding(encoding);
1005 }
1006 Tcl_DStringFree(&ds);
1007 } else {
1008 propPtr = (char *) SelCvtToX((char *) buffer,
1009 type, (Tk_Window) winPtr, &numItems);
1010 if (propPtr == NULL) {
1011 goto refuse;
1012 }
1013 format = 32;
1014 XChangeProperty(reply.xsel.display, reply.xsel.requestor,
1015 property, type, format, PropModeReplace,
1016 (unsigned char *) propPtr, numItems);
1017 ckfree(propPtr);
1018 }
1019 }
1020
1021 /*
1022 * Send an event back to the requestor to indicate that the first stage of
1023 * conversion is complete (everything is done except for long conversions
1024 * that have to be done in INCR mode).
1025 */
1026
1027 if (incr.numIncrs > 0) {
1028 XSelectInput(reply.xsel.display, reply.xsel.requestor,
1029 PropertyChangeMask);
1030 incr.timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc, &incr);
1031 incr.idleTime = 0;
1032 incr.reqWindow = reply.xsel.requestor;
1033 incr.time = infoPtr->time;
1034 incr.nextPtr = tsdPtr->pendingIncrs;
1035 tsdPtr->pendingIncrs = &incr;
1036 }
1037 if (multiple) {
1038 XChangeProperty(reply.xsel.display, reply.xsel.requestor,
1039 reply.xsel.property, winPtr->dispPtr->atomPairAtom,
1040 32, PropModeReplace, (unsigned char *) incr.multAtoms,
1041 (int) incr.numConversions*2);
1042 } else {
1043 /*
1044 * Not a MULTIPLE request. The first property in "multAtoms" got set
1045 * to None if there was an error in conversion.
1046 */
1047
1048 reply.xsel.property = incr.multAtoms[1];
1049 }
1050 XSendEvent(reply.xsel.display, reply.xsel.requestor, False, 0, &reply.ev);
1051 Tk_DeleteErrorHandler(errorHandler);
1052
1053 /*
1054 * Handle any remaining INCR-mode transfers. This all happens in callbacks
1055 * to TkSelPropProc, so just wait until the number of uncompleted INCR
1056 * transfers drops to zero.
1057 */
1058
1059 if (incr.numIncrs > 0) {
1060 IncrInfo *incrPtr2;
1061
1062 while (incr.numIncrs > 0) {
1063 Tcl_DoOneEvent(0);
1064 }
1065 Tcl_DeleteTimerHandler(incr.timeout);
1066 errorHandler = Tk_CreateErrorHandler(winPtr->display,
1067 -1, -1, -1, NULL, NULL);
1068 XSelectInput(reply.xsel.display, reply.xsel.requestor, 0L);
1069 Tk_DeleteErrorHandler(errorHandler);
1070 if (tsdPtr->pendingIncrs == &incr) {
1071 tsdPtr->pendingIncrs = incr.nextPtr;
1072 } else {
1073 for (incrPtr2 = tsdPtr->pendingIncrs; incrPtr2 != NULL;
1074 incrPtr2 = incrPtr2->nextPtr) {
1075 if (incrPtr2->nextPtr == &incr) {
1076 incrPtr2->nextPtr = incr.nextPtr;
1077 break;
1078 }
1079 }
1080 }
1081 }
1082
1083 /*
1084 * All done. Cleanup and return.
1085 */
1086
1087 ckfree(incr.converts);
1088 if (multiple) {
1089 XFree((char *) incr.multAtoms);
1090 }
1091 return;
1092
1093 /*
1094 * An error occurred. Send back a refusal message.
1095 */
1096
1097 refuse:
1098 reply.xsel.property = None;
1099 XSendEvent(reply.xsel.display, reply.xsel.requestor, False, 0, &reply.ev);
1100 Tk_DeleteErrorHandler(errorHandler);
1101 return;
1102 }
1103
1104 /*
1105 *----------------------------------------------------------------------
1106 *
1107 * SelRcvIncrProc --
1108 *
1109 * This function handles the INCR protocol on the receiving side. It is
1110 * invoked in response to property changes on the requestor's window
1111 * (which hopefully are because a new chunk of the selection arrived).
1112 *
1113 * Results:
1114 * None.
1115 *
1116 * Side effects:
1117 * If a new piece of selection has arrived, a function is invoked to deal
1118 * with that piece. When the whole selection is here, a flag is left for
1119 * the higher-level function that initiated the selection retrieval.
1120 *
1121 *----------------------------------------------------------------------
1122 */
1123
1124 static void
SelRcvIncrProc(ClientData clientData,XEvent * eventPtr)1125 SelRcvIncrProc(
1126 ClientData clientData, /* Information about retrieval. */
1127 XEvent *eventPtr) /* X PropertyChange event. */
1128 {
1129 TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *)clientData;
1130 char *propInfo, **propInfoPtr = &propInfo;
1131 Atom type;
1132 int format, result;
1133 unsigned long numItems, bytesAfter;
1134 Tcl_Interp *interp;
1135
1136 if ((eventPtr->xproperty.atom != retrPtr->property)
1137 || (eventPtr->xproperty.state != PropertyNewValue)
1138 || (retrPtr->result != -1)) {
1139 return;
1140 }
1141 propInfo = NULL;
1142 result = XGetWindowProperty(eventPtr->xproperty.display,
1143 eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
1144 True, (Atom) AnyPropertyType, &type, &format, &numItems,
1145 &bytesAfter, (unsigned char **) propInfoPtr);
1146 if ((result != Success) || (type == None)) {
1147 return;
1148 }
1149 if (bytesAfter != 0) {
1150 Tcl_SetObjResult(retrPtr->interp, Tcl_NewStringObj(
1151 "selection property too large", -1));
1152 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "SIZE", NULL);
1153 retrPtr->result = TCL_ERROR;
1154 goto done;
1155 }
1156 if ((type == XA_STRING)
1157 || (type == retrPtr->winPtr->dispPtr->textAtom)
1158 || (type == retrPtr->winPtr->dispPtr->utf8Atom)
1159 || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
1160 char *dst, *src;
1161 int srcLen, dstLen, srcRead, dstWrote, soFar;
1162 Tcl_Encoding encoding;
1163 Tcl_DString *dstPtr, temp;
1164
1165 if (format != 8) {
1166 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
1167 "bad format for string selection: wanted \"8\", got \"%d\"",
1168 format));
1169 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
1170 NULL);
1171 retrPtr->result = TCL_ERROR;
1172 goto done;
1173 }
1174 interp = retrPtr->interp;
1175 Tcl_Preserve(interp);
1176
1177 if (type == retrPtr->winPtr->dispPtr->compoundTextAtom) {
1178 encoding = Tcl_GetEncoding(NULL, "iso2022");
1179 } else if (type == retrPtr->winPtr->dispPtr->utf8Atom) {
1180 encoding = Tcl_GetEncoding(NULL, "utf-8");
1181 } else {
1182 encoding = Tcl_GetEncoding(NULL, "iso8859-1");
1183 }
1184
1185 /*
1186 * Check to see if there is any data left over from the previous
1187 * chunk. If there is, copy the old data and the new data into a new
1188 * buffer.
1189 */
1190
1191 Tcl_DStringInit(&temp);
1192 if (Tcl_DStringLength(&retrPtr->buf) > 0) {
1193 Tcl_DStringAppend(&temp, Tcl_DStringValue(&retrPtr->buf),
1194 Tcl_DStringLength(&retrPtr->buf));
1195 if (numItems > 0) {
1196 Tcl_DStringAppend(&temp, propInfo, (int)numItems);
1197 }
1198 src = Tcl_DStringValue(&temp);
1199 srcLen = Tcl_DStringLength(&temp);
1200 } else if (numItems == 0) {
1201 /*
1202 * There is no new data, so we're done.
1203 */
1204
1205 retrPtr->result = TCL_OK;
1206 Tcl_Release(interp);
1207 goto done;
1208 } else {
1209 src = propInfo;
1210 srcLen = numItems;
1211 }
1212
1213 /*
1214 * Set up the destination buffer so we can use as much space as is
1215 * available.
1216 */
1217
1218 dstPtr = &retrPtr->buf;
1219 dst = Tcl_DStringValue(dstPtr);
1220 dstLen = dstPtr->spaceAvl - 1;
1221
1222 /*
1223 * Now convert the data, growing the destination buffer as needed.
1224 */
1225
1226 while (1) {
1227 result = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
1228 retrPtr->encFlags, &retrPtr->encState,
1229 dst, dstLen, &srcRead, &dstWrote, NULL);
1230 soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
1231 retrPtr->encFlags &= ~TCL_ENCODING_START;
1232 src += srcRead;
1233 srcLen -= srcRead;
1234 if (result != TCL_CONVERT_NOSPACE) {
1235 Tcl_DStringSetLength(dstPtr, soFar);
1236 break;
1237 }
1238 if (Tcl_DStringLength(dstPtr) == 0) {
1239 Tcl_DStringSetLength(dstPtr, dstLen);
1240 }
1241 Tcl_DStringSetLength(dstPtr, 2 * Tcl_DStringLength(dstPtr) + 1);
1242 dst = Tcl_DStringValue(dstPtr) + soFar;
1243 dstLen = Tcl_DStringLength(dstPtr) - soFar - 1;
1244 }
1245 Tcl_DStringSetLength(dstPtr, soFar);
1246
1247 result = retrPtr->proc(retrPtr->clientData, interp,
1248 Tcl_DStringValue(dstPtr));
1249 Tcl_Release(interp);
1250
1251 /*
1252 * Copy any unused data into the destination buffer so we can pick it
1253 * up next time around.
1254 */
1255
1256 Tcl_DStringSetLength(dstPtr, 0);
1257 Tcl_DStringAppend(dstPtr, src, srcLen);
1258
1259 Tcl_DStringFree(&temp);
1260 if (encoding) {
1261 Tcl_FreeEncoding(encoding);
1262 }
1263 if (result != TCL_OK) {
1264 retrPtr->result = result;
1265 }
1266 } else if (numItems == 0) {
1267 retrPtr->result = TCL_OK;
1268 } else {
1269 Tcl_DString ds;
1270
1271 if (format != 32 && format != 8) {
1272 Tcl_SetObjResult(retrPtr->interp, Tcl_ObjPrintf(
1273 "bad format for selection: wanted \"32\" or "
1274 "\"8\", got \"%d\"", format));
1275 Tcl_SetErrorCode(retrPtr->interp, "TK", "SELECTION", "FORMAT",
1276 NULL);
1277 retrPtr->result = TCL_ERROR;
1278 goto done;
1279 }
1280 Tcl_DStringInit(&ds);
1281 if (format == 32) {
1282 SelCvtFromX32((long *) propInfo, (int) numItems, type,
1283 (Tk_Window) retrPtr->winPtr, &ds);
1284 } else {
1285 SelCvtFromX8((char *) propInfo, (int) numItems, type,
1286 (Tk_Window) retrPtr->winPtr, &ds);
1287 }
1288 interp = retrPtr->interp;
1289 Tcl_Preserve(interp);
1290 result = retrPtr->proc(retrPtr->clientData, interp,
1291 Tcl_DStringValue(&ds));
1292 Tcl_Release(interp);
1293 Tcl_DStringFree(&ds);
1294 if (result != TCL_OK) {
1295 retrPtr->result = result;
1296 }
1297 }
1298
1299 done:
1300 XFree(propInfo);
1301 retrPtr->idleTime = 0;
1302 }
1303
1304 /*
1305 *----------------------------------------------------------------------
1306 *
1307 * SelectionSize --
1308 *
1309 * This function is called when the selection is too large to send in a
1310 * single buffer; it computes the total length of the selection in bytes.
1311 *
1312 * Results:
1313 * The return value is the number of bytes in the selection given by
1314 * selPtr.
1315 *
1316 * Side effects:
1317 * The selection is retrieved from its current owner (this is the only
1318 * way to compute its size).
1319 *
1320 *----------------------------------------------------------------------
1321 */
1322
1323 static int
SelectionSize(TkSelHandler * selPtr)1324 SelectionSize(
1325 TkSelHandler *selPtr) /* Information about how to retrieve the
1326 * selection whose size is wanted. */
1327 {
1328 char buffer[TK_SEL_BYTES_AT_ONCE+1];
1329 int size, chunkSize;
1330 TkSelInProgress ip;
1331
1332 size = TK_SEL_BYTES_AT_ONCE;
1333 ip.selPtr = selPtr;
1334 ip.nextPtr = TkSelGetInProgress();
1335 TkSelSetInProgress(&ip);
1336
1337 do {
1338 chunkSize = selPtr->proc(selPtr->clientData, size, (char *) buffer,
1339 TK_SEL_BYTES_AT_ONCE);
1340 if (ip.selPtr == NULL) {
1341 size = 0;
1342 break;
1343 }
1344 size += chunkSize;
1345 } while (chunkSize == TK_SEL_BYTES_AT_ONCE);
1346
1347 TkSelSetInProgress(ip.nextPtr);
1348 return size;
1349 }
1350
1351 /*
1352 *----------------------------------------------------------------------
1353 *
1354 * IncrTimeoutProc --
1355 *
1356 * This function is invoked once a second while sending the selection to
1357 * a requestor in INCR mode. After a while it gives up and aborts the
1358 * selection operation.
1359 *
1360 * Results:
1361 * None.
1362 *
1363 * Side effects:
1364 * A new timeout gets registered so that this function gets called again
1365 * in another second, unless too many seconds have elapsed, in which case
1366 * incrPtr is marked as "all done".
1367 *
1368 *----------------------------------------------------------------------
1369 */
1370
1371 static void
IncrTimeoutProc(ClientData clientData)1372 IncrTimeoutProc(
1373 ClientData clientData) /* Information about INCR-mode selection
1374 * retrieval for which we are selection
1375 * owner. */
1376 {
1377 IncrInfo *incrPtr = (IncrInfo *)clientData;
1378
1379 incrPtr->idleTime++;
1380 if (incrPtr->idleTime >= 5) {
1381 incrPtr->numIncrs = 0;
1382 } else {
1383 incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
1384 incrPtr);
1385 }
1386 }
1387
1388 /*
1389 *----------------------------------------------------------------------
1390 *
1391 * SelCvtToX --
1392 *
1393 * Given a selection represented as a string (the normal Tcl form),
1394 * convert it to the ICCCM-mandated format for X, depending on the type
1395 * argument. This function and SelCvtFromX are inverses.
1396 *
1397 * Results:
1398 * The return value is a malloc'ed buffer holding a value equivalent to
1399 * "string", but formatted as for "type". It is the caller's
1400 * responsibility to free the string when done with it. The word at
1401 * *numLongsPtr is filled in with the number of 32-bit words returned in
1402 * the result. If NULL is returned, the input list was not actually a
1403 * list.
1404 *
1405 * Side effects:
1406 * None.
1407 *
1408 *----------------------------------------------------------------------
1409 */
1410
1411 static long *
SelCvtToX(char * string,Atom type,Tk_Window tkwin,int * numLongsPtr)1412 SelCvtToX(
1413 char *string, /* String representation of selection. */
1414 Atom type, /* Atom specifying the X format that is
1415 * desired for the selection. Should not be
1416 * XA_STRING (if so, don't bother calling this
1417 * function at all). */
1418 Tk_Window tkwin, /* Window that governs atom conversion. */
1419 int *numLongsPtr) /* Number of 32-bit words contained in the
1420 * result. */
1421 {
1422 const char **field;
1423 int numFields, i;
1424 long *propPtr;
1425
1426 /*
1427 * The string is assumed to consist of fields separated by spaces. The
1428 * property gets generated by converting each field to an integer number,
1429 * in one of two ways:
1430 * 1. If type is XA_ATOM, convert each field to its corresponding atom.
1431 * 2. If type is anything else, convert each field from an ASCII number to
1432 * a 32-bit binary number.
1433 */
1434
1435 if (Tcl_SplitList(NULL, string, &numFields, &field) != TCL_OK) {
1436 return NULL;
1437 }
1438 propPtr = (long *)ckalloc(numFields * sizeof(long));
1439
1440 /*
1441 * Convert the fields one-by-one.
1442 */
1443
1444 for (i=0 ; i<numFields ; i++) {
1445 if (type == XA_ATOM) {
1446 propPtr[i] = (long) Tk_InternAtom(tkwin, field[i]);
1447 } else {
1448 char *dummy;
1449
1450 /*
1451 * If this fails to parse a number, we just plunge on regardless
1452 * anyway.
1453 */
1454
1455 propPtr[i] = strtol(field[i], &dummy, 0);
1456 }
1457 }
1458
1459 /*
1460 * Release the parsed list.
1461 */
1462
1463 ckfree(field);
1464 *numLongsPtr = i;
1465 return propPtr;
1466 }
1467
1468 /*
1469 *----------------------------------------------------------------------
1470 *
1471 * SelCvtFromX32, SelCvtFromX8 --
1472 *
1473 * Given an X property value, formatted as a collection of 32-bit or
1474 * 8-bit values according to "type" and the ICCCM conventions, convert
1475 * the value to a string suitable for manipulation by Tcl. These
1476 * functions are the inverse of SelCvtToX.
1477 *
1478 * Results:
1479 * The return value (stored in a Tcl_DString) is the string equivalent of
1480 * "property". It is up to the caller to initialize and free the DString.
1481 *
1482 * Side effects:
1483 * None.
1484 *
1485 *----------------------------------------------------------------------
1486 */
1487
1488 static void
SelCvtFromX32(long * propPtr,int numValues,Atom type,Tk_Window tkwin,Tcl_DString * dsPtr)1489 SelCvtFromX32(
1490 long *propPtr, /* Property value from X. */
1491 int numValues, /* Number of 32-bit values in property. */
1492 Atom type, /* Type of property Should not be XA_STRING
1493 * (if so, don't bother calling this function
1494 * at all). */
1495 Tk_Window tkwin, /* Window to use for atom conversion. */
1496 Tcl_DString *dsPtr) /* Where to store the converted string. */
1497 {
1498 /*
1499 * Convert each long in the property to a string value, which is either
1500 * the name of an atom (if type is XA_ATOM) or a hexadecimal string. We
1501 * build the list in a Tcl_DString because this is easier than trying to
1502 * get the quoting correct ourselves; this is tricky because atoms can
1503 * contain spaces in their names (encountered when the atoms are really
1504 * MIME types). [Bug 1353414]
1505 */
1506
1507 for ( ; numValues > 0; propPtr++, numValues--) {
1508 if (type == XA_ATOM) {
1509 Tcl_DStringAppendElement(dsPtr,
1510 Tk_GetAtomName(tkwin, (Atom) *propPtr));
1511 } else {
1512 char buf[12];
1513
1514 sprintf(buf, "0x%x", (unsigned int) *propPtr);
1515 Tcl_DStringAppendElement(dsPtr, buf);
1516 }
1517 }
1518 Tcl_DStringAppend(dsPtr, " ", 1);
1519 }
1520
1521 static void
SelCvtFromX8(char * propPtr,int numValues,TCL_UNUSED (Atom),TCL_UNUSED (Tk_Window),Tcl_DString * dsPtr)1522 SelCvtFromX8(
1523 char *propPtr, /* Property value from X. */
1524 int numValues, /* Number of 8-bit values in property. */
1525 TCL_UNUSED(Atom), /* Type of property Should not be XA_STRING
1526 * (if so, don't bother calling this function
1527 * at all). */
1528 TCL_UNUSED(Tk_Window), /* Window to use for atom conversion. */
1529 Tcl_DString *dsPtr) /* Where to store the converted string. */
1530 {
1531 /*
1532 * Convert each long in the property to a string value, which is a
1533 * hexadecimal string. We build the list in a Tcl_DString because this is
1534 * easier than trying to get the quoting correct ourselves.
1535 */
1536
1537 for ( ; numValues > 0; propPtr++, numValues--) {
1538 char buf[12];
1539
1540 sprintf(buf, "0x%x", (unsigned char) *propPtr);
1541 Tcl_DStringAppendElement(dsPtr, buf);
1542 }
1543 Tcl_DStringAppend(dsPtr, " ", 1);
1544 }
1545
1546 /*
1547 * Local Variables:
1548 * mode: c
1549 * c-basic-offset: 4
1550 * fill-column: 78
1551 * End:
1552 */
1553