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