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