1/*
2 * tkSelect.c --
3 *
4 *	This file manages the selection for the Tk toolkit, translating
5 *	between the standard X ICCCM conventions and Tcl commands.
6 *
7 * Copyright (c) 1990-1993 The Regents of the University of California.
8 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 *
13 * RCS: @(#) $Id$
14 */
15
16#include "tkInt.h"
17#include "tkSelect.h"
18
19/*
20 * When a selection handler is set up by invoking "selection handle", one of
21 * the following data structures is set up to hold information about the
22 * command to invoke and its interpreter.
23 */
24
25typedef struct {
26    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
27    int cmdLength;		/* # of non-NULL bytes in command. */
28    int charOffset;		/* The offset of the next char to retrieve. */
29    int byteOffset;		/* The expected byte offset of the next
30				 * chunk. */
31    char buffer[TCL_UTF_MAX];	/* A buffer to hold part of a UTF character
32				 * that is split across chunks. */
33    char command[4];		/* Command to invoke. Actual space is
34				 * allocated as large as necessary. This must
35				 * be the last entry in the structure. */
36} CommandInfo;
37
38/*
39 * When selection ownership is claimed with the "selection own" Tcl command,
40 * one of the following structures is created to record the Tcl command to be
41 * executed when the selection is lost again.
42 */
43
44typedef struct LostCommand {
45    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
46    char command[4];		/* Command to invoke. Actual space is
47				 * allocated as large as necessary. This must
48				 * be the last entry in the structure. */
49} LostCommand;
50
51/*
52 * The structure below is used to keep each thread's pending list separate.
53 */
54
55typedef struct ThreadSpecificData {
56    TkSelInProgress *pendingPtr;
57				/* Topmost search in progress, or NULL if
58				 * none. */
59} ThreadSpecificData;
60static Tcl_ThreadDataKey dataKey;
61
62/*
63 * Forward declarations for functions defined in this file:
64 */
65
66static int		HandleTclCommand(ClientData clientData,
67			    int offset, char *buffer, int maxBytes);
68static void		LostSelection(ClientData clientData);
69static int		SelGetProc(ClientData clientData,
70			    Tcl_Interp *interp, char *portion);
71
72/*
73 *--------------------------------------------------------------
74 *
75 * Tk_CreateSelHandler --
76 *
77 *	This function is called to register a function as the handler for
78 *	selection requests of a particular target type on a particular window
79 *	for a particular selection.
80 *
81 * Results:
82 *	None.
83 *
84 * Side effects:
85
86 *	In the future, whenever the selection is in tkwin's window and someone
87 *	requests the selection in the form given by target, proc will be
88 *	invoked to provide part or all of the selection in the given form. If
89 *	there was already a handler declared for the given window, target and
90 *	selection type, then it is replaced. Proc should have the following
91 *	form:
92 *
93 *	int
94 *	proc(
95 *	    ClientData clientData,
96 *	    int offset,
97 *	    char *buffer,
98 *	    int maxBytes)
99 *	{
100 *	}
101 *
102 *	The clientData argument to proc will be the same as the clientData
103 *	argument to this function. The offset argument indicates which portion
104 *	of the selection to return: skip the first offset bytes. Buffer is a
105 *	pointer to an area in which to place the converted selection, and
106 *	maxBytes gives the number of bytes available at buffer. Proc should
107 *	place the selection in buffer as a string, and return a count of the
108 *	number of bytes of selection actually placed in buffer (not including
109 *	the terminating NULL character). If the return value equals maxBytes,
110 *	this is a sign that there is probably still more selection information
111 *	available.
112 *
113 *--------------------------------------------------------------
114 */
115
116void
117Tk_CreateSelHandler(
118    Tk_Window tkwin,		/* Token for window. */
119    Atom selection,		/* Selection to be handled. */
120    Atom target,		/* The kind of selection conversions that can
121				 * be handled by proc, e.g. TARGETS or
122				 * STRING. */
123    Tk_SelectionProc *proc,	/* Function to invoke to convert selection to
124				 * type "target". */
125    ClientData clientData,	/* Value to pass to proc. */
126    Atom format)		/* Format in which the selection information
127				 * should be returned to the requestor.
128				 * XA_STRING is best by far, but anything
129				 * listed in the ICCCM will be tolerated
130				 * (blech). */
131{
132    register TkSelHandler *selPtr;
133    TkWindow *winPtr = (TkWindow *) tkwin;
134
135    if (winPtr->dispPtr->multipleAtom == None) {
136	TkSelInit(tkwin);
137    }
138
139    /*
140     * See if there's already a handler for this target and selection on this
141     * window. If so, re-use it. If not, create a new one.
142     */
143
144    for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
145	if (selPtr == NULL) {
146	    selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
147	    selPtr->nextPtr = winPtr->selHandlerList;
148	    winPtr->selHandlerList = selPtr;
149	    break;
150	}
151	if ((selPtr->selection == selection) && (selPtr->target == target)) {
152	    /*
153	     * Special case: when replacing handler created by "selection
154	     * handle", free up memory. Should there be a callback to allow
155	     * other clients to do this too?
156	     */
157
158	    if (selPtr->proc == HandleTclCommand) {
159		ckfree((char *) selPtr->clientData);
160	    }
161	    break;
162	}
163    }
164    selPtr->selection = selection;
165    selPtr->target = target;
166    selPtr->format = format;
167    selPtr->proc = proc;
168    selPtr->clientData = clientData;
169    if (format == XA_STRING) {
170	selPtr->size = 8;
171    } else {
172	selPtr->size = 32;
173    }
174
175    if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) {
176	/*
177	 * If the user asked for a STRING handler and we understand
178	 * UTF8_STRING, we implicitly create a UTF8_STRING handler for them.
179	 */
180
181	target = winPtr->dispPtr->utf8Atom;
182	for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
183	    if (selPtr == NULL) {
184		selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
185		selPtr->nextPtr = winPtr->selHandlerList;
186		winPtr->selHandlerList = selPtr;
187		selPtr->selection = selection;
188		selPtr->target = target;
189		selPtr->format = target; /* We want UTF8_STRING format */
190		selPtr->proc = proc;
191		if (selPtr->proc == HandleTclCommand) {
192		    /*
193		     * The clientData is selection controlled memory, so we
194		     * should make a copy for this selPtr.
195		     */
196
197		    unsigned cmdInfoLen = sizeof(CommandInfo) +
198			    ((CommandInfo*)clientData)->cmdLength - 3;
199
200		    selPtr->clientData = (ClientData)ckalloc(cmdInfoLen);
201		    memcpy(selPtr->clientData, clientData, cmdInfoLen);
202		} else {
203		    selPtr->clientData = clientData;
204		}
205		selPtr->size = 8;
206		break;
207	    }
208	    if (selPtr->selection==selection && selPtr->target==target) {
209		/*
210		 * Looks like we had a utf-8 target already. Leave it alone.
211		 */
212
213		break;
214	    }
215	}
216    }
217}
218
219/*
220 *----------------------------------------------------------------------
221 *
222 * Tk_DeleteSelHandler --
223 *
224 *	Remove the selection handler for a given window, target, and
225 *	selection, if it exists.
226 *
227 * Results:
228 *	None.
229 *
230 * Side effects:
231 *	The selection handler for tkwin and target is removed. If there is no
232 *	such handler then nothing happens.
233 *
234 *----------------------------------------------------------------------
235 */
236
237void
238Tk_DeleteSelHandler(
239    Tk_Window tkwin,		/* Token for window. */
240    Atom selection,		/* The selection whose handler is to be
241				 * removed. */
242    Atom target)		/* The target whose selection handler is to be
243				 * removed. */
244{
245    TkWindow *winPtr = (TkWindow *) tkwin;
246    register TkSelHandler *selPtr, *prevPtr;
247    register TkSelInProgress *ipPtr;
248    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
249	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
250
251    /*
252     * Find the selection handler to be deleted, or return if it doesn't
253     * exist.
254     */
255
256    for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
257	    prevPtr = selPtr, selPtr = selPtr->nextPtr) {
258	if (selPtr == NULL) {
259	    return;
260	}
261	if ((selPtr->selection == selection) && (selPtr->target == target)) {
262	    break;
263	}
264    }
265
266    /*
267     * If ConvertSelection is processing this handler, tell it that the
268     * handler is dead.
269     */
270
271    for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
272	    ipPtr = ipPtr->nextPtr) {
273	if (ipPtr->selPtr == selPtr) {
274	    ipPtr->selPtr = NULL;
275	}
276    }
277
278    /*
279     * Free resources associated with the handler.
280     */
281
282    if (prevPtr == NULL) {
283	winPtr->selHandlerList = selPtr->nextPtr;
284    } else {
285	prevPtr->nextPtr = selPtr->nextPtr;
286    }
287
288    if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) NULL)) {
289	/*
290	 * If the user asked for a STRING handler and we understand
291	 * UTF8_STRING, we may have implicitly created a UTF8_STRING handler
292	 * for them. Look for it and delete it as necessary.
293	 */
294
295	TkSelHandler *utf8selPtr;
296
297	target = winPtr->dispPtr->utf8Atom;
298	for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL;
299		utf8selPtr = utf8selPtr->nextPtr) {
300	    if ((utf8selPtr->selection == selection)
301		    && (utf8selPtr->target == target)) {
302		break;
303	    }
304	}
305	if (utf8selPtr != NULL) {
306	    if ((utf8selPtr->format == target)
307		    && (utf8selPtr->proc == selPtr->proc)
308		    && (utf8selPtr->size == selPtr->size)) {
309		/*
310		 * This recursive call is OK, because we've changed the value
311		 * of 'target'.
312		 */
313
314		Tk_DeleteSelHandler(tkwin, selection, target);
315	    }
316	}
317    }
318
319    if (selPtr->proc == HandleTclCommand) {
320	/*
321	 * Mark the CommandInfo as deleted and free it if we can.
322	 */
323
324	((CommandInfo*)selPtr->clientData)->interp = NULL;
325	Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
326    }
327    ckfree((char *) selPtr);
328}
329
330/*
331 *--------------------------------------------------------------
332 *
333 * Tk_OwnSelection --
334 *
335 *	Arrange for tkwin to become the owner of a selection.
336 *
337 * Results:
338 *	None.
339 *
340 * Side effects:
341 *	From now on, requests for the selection will be directed to functions
342 *	associated with tkwin (they must have been declared with calls to
343 *	Tk_CreateSelHandler). When the selection is lost by this window, proc
344 *	will be invoked (see the manual entry for details). This function may
345 *	invoke callbacks, including Tcl scripts, so any calling function
346 *	should be reentrant at the point where Tk_OwnSelection is invoked.
347 *
348 *--------------------------------------------------------------
349 */
350
351void
352Tk_OwnSelection(
353    Tk_Window tkwin,		/* Window to become new selection owner. */
354    Atom selection,		/* Selection that window should own. */
355    Tk_LostSelProc *proc,	/* Function to call when selection is taken
356				 * away from tkwin. */
357    ClientData clientData)	/* Arbitrary one-word argument to pass to
358				 * proc. */
359{
360    register TkWindow *winPtr = (TkWindow *) tkwin;
361    TkDisplay *dispPtr = winPtr->dispPtr;
362    TkSelectionInfo *infoPtr;
363    Tk_LostSelProc *clearProc = NULL;
364    ClientData clearData = NULL;/* Initialization needed only to prevent
365				 * compiler warning. */
366
367    if (dispPtr->multipleAtom == None) {
368	TkSelInit(tkwin);
369    }
370    Tk_MakeWindowExist(tkwin);
371
372    /*
373     * This code is somewhat tricky. First, we find the specified selection on
374     * the selection list. If the previous owner is in this process, and is a
375     * different window, then we need to invoke the clearProc. However, it's
376     * dangerous to call the clearProc right now, because it could invoke a
377     * Tcl script that wrecks the current state (e.g. it could delete the
378     * window). To be safe, defer the call until the end of the function when
379     * we no longer care about the state.
380     */
381
382    for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
383	    infoPtr = infoPtr->nextPtr) {
384	if (infoPtr->selection == selection) {
385	    break;
386	}
387    }
388    if (infoPtr == NULL) {
389	infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
390	infoPtr->selection = selection;
391	infoPtr->nextPtr = dispPtr->selectionInfoPtr;
392	dispPtr->selectionInfoPtr = infoPtr;
393    } else if (infoPtr->clearProc != NULL) {
394	if (infoPtr->owner != tkwin) {
395	    clearProc = infoPtr->clearProc;
396	    clearData = infoPtr->clearData;
397	} else if (infoPtr->clearProc == LostSelection) {
398	    /*
399	     * If the selection handler is one created by "selection own", be
400	     * sure to free the record for it; otherwise there will be a
401	     * memory leak.
402	     */
403
404	    ckfree((char *) infoPtr->clearData);
405	}
406    }
407
408    infoPtr->owner = tkwin;
409    infoPtr->serial = NextRequest(winPtr->display);
410    infoPtr->clearProc = proc;
411    infoPtr->clearData = clientData;
412
413    /*
414     * Note that we are using CurrentTime, even though ICCCM recommends
415     * against this practice (the problem is that we don't necessarily have a
416     * valid time to use). We will not be able to retrieve a useful timestamp
417     * for the TIMESTAMP target later.
418     */
419
420    infoPtr->time = CurrentTime;
421
422    /*
423     * Note that we are not checking to see if the selection claim succeeded.
424     * If the ownership does not change, then the clearProc may never be
425     * invoked, and we will return incorrect information when queried for the
426     * current selection owner.
427     */
428
429    XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
430	    infoPtr->time);
431
432    /*
433     * Now that we are done, we can invoke clearProc without running into
434     * reentrancy problems.
435     */
436
437    if (clearProc != NULL) {
438	(*clearProc)(clearData);
439    }
440}
441
442/*
443 *----------------------------------------------------------------------
444 *
445 * Tk_ClearSelection --
446 *
447 *	Eliminate the specified selection on tkwin's display, if there is one.
448 *
449 * Results:
450 *	None.
451 *
452 * Side effects:
453 *	The specified selection is cleared, so that future requests to
454 *	retrieve it will fail until some application owns it again. This
455 *	function invokes callbacks, possibly including Tcl scripts, so any
456 *	calling function should be reentrant at the point Tk_ClearSelection is
457 *	invoked.
458 *
459 *----------------------------------------------------------------------
460 */
461
462void
463Tk_ClearSelection(
464    Tk_Window tkwin,		/* Window that selects a display. */
465    Atom selection)		/* Selection to be cancelled. */
466{
467    register TkWindow *winPtr = (TkWindow *) tkwin;
468    TkDisplay *dispPtr = winPtr->dispPtr;
469    TkSelectionInfo *infoPtr;
470    TkSelectionInfo *prevPtr;
471    TkSelectionInfo *nextPtr;
472    Tk_LostSelProc *clearProc = NULL;
473    ClientData clearData = NULL;/* Initialization needed only to prevent
474				 * compiler warning. */
475
476    if (dispPtr->multipleAtom == None) {
477	TkSelInit(tkwin);
478    }
479
480    for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
481	    infoPtr != NULL; infoPtr = nextPtr) {
482	nextPtr = infoPtr->nextPtr;
483	if (infoPtr->selection == selection) {
484	    if (prevPtr == NULL) {
485		dispPtr->selectionInfoPtr = nextPtr;
486	    } else {
487		prevPtr->nextPtr = nextPtr;
488	    }
489	    break;
490	}
491	prevPtr = infoPtr;
492    }
493
494    if (infoPtr != NULL) {
495	clearProc = infoPtr->clearProc;
496	clearData = infoPtr->clearData;
497	ckfree((char *) infoPtr);
498    }
499    XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
500
501    if (clearProc != NULL) {
502	(*clearProc)(clearData);
503    }
504}
505
506/*
507 *--------------------------------------------------------------
508 *
509 * Tk_GetSelection --
510 *
511 *	Retrieve the value of a selection and pass it off (in pieces,
512 *	possibly) to a given function.
513 *
514 * Results:
515 *	The return value is a standard Tcl return value. If an error occurs
516 *	(such as no selection exists) then an error message is left in the
517 *	interp's result.
518 *
519 * Side effects:
520 *	The standard X11 protocols are used to retrieve the selection. When it
521 *	arrives, it is passed to proc. If the selection is very large, it will
522 *	be passed to proc in several pieces. Proc should have the following
523 *	structure:
524 *
525 *	int
526 *	proc(
527 *	    ClientData clientData,
528 *	    Tcl_Interp *interp,
529 *	    char *portion)
530 *	{
531 *	}
532 *
533 *	The interp and clientData arguments to proc will be the same as the
534 *	corresponding arguments to Tk_GetSelection. The portion argument
535 *	points to a character string containing part of the selection, and
536 *	numBytes indicates the length of the portion, not including the
537 *	terminating NULL character. If the selection arrives in several
538 *	pieces, the "portion" arguments in separate calls will contain
539 *	successive parts of the selection. Proc should normally return TCL_OK.
540 *	If it detects an error then it should return TCL_ERROR and leave an
541 *	error message in the interp's result; the remainder of the selection
542 *	retrieval will be aborted.
543 *
544 *--------------------------------------------------------------
545 */
546
547int
548Tk_GetSelection(
549    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
550    Tk_Window tkwin,		/* Window on whose behalf to retrieve the
551				 * selection (determines display from which to
552				 * retrieve). */
553    Atom selection,		/* Selection to retrieve. */
554    Atom target,		/* Desired form in which selection is to be
555				 * returned. */
556    Tk_GetSelProc *proc,	/* Function to call to process the selection,
557				 * once it has been retrieved. */
558    ClientData clientData)	/* Arbitrary value to pass to proc. */
559{
560    TkWindow *winPtr = (TkWindow *) tkwin;
561    TkDisplay *dispPtr = winPtr->dispPtr;
562    TkSelectionInfo *infoPtr;
563    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
564	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
565
566    if (dispPtr->multipleAtom == None) {
567	TkSelInit(tkwin);
568    }
569
570    /*
571     * If the selection is owned by a window managed by this process, then
572     * call the retrieval function directly, rather than going through the X
573     * server (it's dangerous to go through the X server in this case because
574     * it could result in deadlock if an INCR-style selection results).
575     */
576
577    for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
578	    infoPtr = infoPtr->nextPtr) {
579	if (infoPtr->selection == selection) {
580	    break;
581	}
582    }
583    if (infoPtr != NULL) {
584	register TkSelHandler *selPtr;
585	int offset, result, count;
586	char buffer[TK_SEL_BYTES_AT_ONCE+1];
587	TkSelInProgress ip;
588
589	for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
590		selPtr != NULL; selPtr = selPtr->nextPtr) {
591	    if (selPtr->target==target && selPtr->selection==selection) {
592		break;
593	    }
594	}
595	if (selPtr == NULL) {
596	    Atom type;
597
598	    count = TkSelDefaultSelection(infoPtr, target, buffer,
599		    TK_SEL_BYTES_AT_ONCE, &type);
600	    if (count > TK_SEL_BYTES_AT_ONCE) {
601		Tcl_Panic("selection handler returned too many bytes");
602	    }
603	    if (count < 0) {
604		goto cantget;
605	    }
606	    buffer[count] = 0;
607	    result = (*proc)(clientData, interp, buffer);
608	} else {
609	    offset = 0;
610	    result = TCL_OK;
611	    ip.selPtr = selPtr;
612	    ip.nextPtr = tsdPtr->pendingPtr;
613	    tsdPtr->pendingPtr = &ip;
614	    while (1) {
615		count = (selPtr->proc)(selPtr->clientData, offset, buffer,
616			TK_SEL_BYTES_AT_ONCE);
617		if ((count < 0) || (ip.selPtr == NULL)) {
618		    tsdPtr->pendingPtr = ip.nextPtr;
619		    goto cantget;
620		}
621		if (count > TK_SEL_BYTES_AT_ONCE) {
622		    Tcl_Panic("selection handler returned too many bytes");
623		}
624		buffer[count] = '\0';
625		result = (*proc)(clientData, interp, buffer);
626		if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
627			|| (ip.selPtr == NULL)) {
628		    break;
629		}
630		offset += count;
631	    }
632	    tsdPtr->pendingPtr = ip.nextPtr;
633	}
634	return result;
635    }
636
637    /*
638     * The selection is owned by some other process.
639     */
640
641    return TkSelGetSelection(interp, tkwin, selection, target, proc,
642	    clientData);
643
644  cantget:
645    Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
646	    " selection doesn't exist or form \"",
647	    Tk_GetAtomName(tkwin, target), "\" not defined", NULL);
648    return TCL_ERROR;
649}
650
651/*
652 *--------------------------------------------------------------
653 *
654 * Tk_SelectionObjCmd --
655 *
656 *	This function is invoked to process the "selection" Tcl command. See
657 *	the user documentation for details on what it does.
658 *
659 * Results:
660 *	A standard Tcl result.
661 *
662 * Side effects:
663 *	See the user documentation.
664 *
665 *--------------------------------------------------------------
666 */
667
668int
669Tk_SelectionObjCmd(
670    ClientData clientData,	/* Main window associated with
671				 * interpreter. */
672    Tcl_Interp *interp,		/* Current interpreter. */
673    int objc,			/* Number of arguments. */
674    Tcl_Obj *CONST objv[])	/* Argument objects. */
675{
676    Tk_Window tkwin = (Tk_Window) clientData;
677    char *path = NULL;
678    Atom selection;
679    char *selName = NULL, *string;
680    int count, index;
681    Tcl_Obj **objs;
682    static CONST char *optionStrings[] = {
683	"clear", "get", "handle", "own", NULL
684    };
685    enum options {
686	SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
687    };
688
689    if (objc < 2) {
690	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
691	return TCL_ERROR;
692    }
693
694    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
695	    &index) != TCL_OK) {
696	return TCL_ERROR;
697    }
698
699    switch ((enum options) index) {
700    case SELECTION_CLEAR: {
701	static CONST char *clearOptionStrings[] = {
702	    "-displayof", "-selection", NULL
703	};
704	enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
705	int clearIndex;
706
707	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
708		count-=2, objs+=2) {
709	    string = Tcl_GetString(objs[0]);
710	    if (string[0] != '-') {
711		break;
712	    }
713	    if (count < 2) {
714		Tcl_AppendResult(interp, "value for \"", string,
715			"\" missing", NULL);
716		return TCL_ERROR;
717	    }
718
719	    if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
720		    "option", 0, &clearIndex) != TCL_OK) {
721		return TCL_ERROR;
722	    }
723	    switch ((enum clearOptions) clearIndex) {
724	    case CLEAR_DISPLAYOF:
725		path = Tcl_GetString(objs[1]);
726		break;
727	    case CLEAR_SELECTION:
728		selName = Tcl_GetString(objs[1]);
729		break;
730	    }
731	}
732
733	if (count == 1) {
734	    path = Tcl_GetString(objs[0]);
735	} else if (count > 1) {
736	    Tcl_WrongNumArgs(interp, 2, objv, "?options?");
737	    return TCL_ERROR;
738	}
739	if (path != NULL) {
740	    tkwin = Tk_NameToWindow(interp, path, tkwin);
741	}
742	if (tkwin == NULL) {
743	    return TCL_ERROR;
744	}
745	if (selName != NULL) {
746	    selection = Tk_InternAtom(tkwin, selName);
747	} else {
748	    selection = XA_PRIMARY;
749	}
750
751	Tk_ClearSelection(tkwin, selection);
752	break;
753    }
754
755    case SELECTION_GET: {
756	Atom target;
757	char *targetName = NULL;
758	Tcl_DString selBytes;
759	int result;
760	static CONST char *getOptionStrings[] = {
761	    "-displayof", "-selection", "-type", NULL
762	};
763	enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
764	int getIndex;
765
766	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
767		count-=2, objs+=2) {
768	    string = Tcl_GetString(objs[0]);
769	    if (string[0] != '-') {
770		break;
771	    }
772	    if (count < 2) {
773		Tcl_AppendResult(interp, "value for \"", string,
774			"\" missing", NULL);
775		return TCL_ERROR;
776	    }
777
778	    if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
779		    "option", 0, &getIndex) != TCL_OK) {
780		return TCL_ERROR;
781	    }
782
783	    switch ((enum getOptions) getIndex) {
784	    case GET_DISPLAYOF:
785		path = Tcl_GetString(objs[1]);
786		break;
787	    case GET_SELECTION:
788		selName = Tcl_GetString(objs[1]);
789		break;
790	    case GET_TYPE:
791		targetName = Tcl_GetString(objs[1]);
792		break;
793	    }
794	}
795
796	if (path != NULL) {
797	    tkwin = Tk_NameToWindow(interp, path, tkwin);
798	}
799	if (tkwin == NULL) {
800	    return TCL_ERROR;
801	}
802	if (selName != NULL) {
803	    selection = Tk_InternAtom(tkwin, selName);
804	} else {
805	    selection = XA_PRIMARY;
806	}
807	if (count > 1) {
808	    Tcl_WrongNumArgs(interp, 2, objv, "?options?");
809	    return TCL_ERROR;
810	} else if (count == 1) {
811	    target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
812	} else if (targetName != NULL) {
813	    target = Tk_InternAtom(tkwin, targetName);
814	} else {
815	    target = XA_STRING;
816	}
817
818	Tcl_DStringInit(&selBytes);
819	result = Tk_GetSelection(interp, tkwin, selection, target,
820		SelGetProc, (ClientData) &selBytes);
821	if (result == TCL_OK) {
822	    Tcl_DStringResult(interp, &selBytes);
823	} else {
824	    Tcl_DStringFree(&selBytes);
825	}
826	return result;
827    }
828
829    case SELECTION_HANDLE: {
830	Atom target, format;
831	char *targetName = NULL;
832	char *formatName = NULL;
833	register CommandInfo *cmdInfoPtr;
834	int cmdLength;
835	static CONST char *handleOptionStrings[] = {
836	    "-format", "-selection", "-type", NULL
837	};
838	enum handleOptions {
839	    HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
840	};
841	int handleIndex;
842
843	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
844		count-=2, objs+=2) {
845	    string = Tcl_GetString(objs[0]);
846	    if (string[0] != '-') {
847		break;
848	    }
849	    if (count < 2) {
850		Tcl_AppendResult(interp, "value for \"", string,
851			"\" missing", NULL);
852		return TCL_ERROR;
853	    }
854
855	    if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
856		    "option", 0, &handleIndex) != TCL_OK) {
857		return TCL_ERROR;
858	    }
859
860	    switch ((enum handleOptions) handleIndex) {
861	    case HANDLE_FORMAT:
862		formatName = Tcl_GetString(objs[1]);
863		break;
864	    case HANDLE_SELECTION:
865		selName = Tcl_GetString(objs[1]);
866		break;
867	    case HANDLE_TYPE:
868		targetName = Tcl_GetString(objs[1]);
869		break;
870	    }
871	}
872
873	if ((count < 2) || (count > 4)) {
874	    Tcl_WrongNumArgs(interp, 2, objv, "?options? window command");
875	    return TCL_ERROR;
876	}
877	tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
878	if (tkwin == NULL) {
879	    return TCL_ERROR;
880	}
881	if (selName != NULL) {
882	    selection = Tk_InternAtom(tkwin, selName);
883	} else {
884	    selection = XA_PRIMARY;
885	}
886
887	if (count > 2) {
888	    target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
889	} else if (targetName != NULL) {
890	    target = Tk_InternAtom(tkwin, targetName);
891	} else {
892	    target = XA_STRING;
893	}
894	if (count > 3) {
895	    format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
896	} else if (formatName != NULL) {
897	    format = Tk_InternAtom(tkwin, formatName);
898	} else {
899	    format = XA_STRING;
900	}
901	string = Tcl_GetStringFromObj(objs[1], &cmdLength);
902	if (cmdLength == 0) {
903	    Tk_DeleteSelHandler(tkwin, selection, target);
904	} else {
905	    cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
906		    sizeof(CommandInfo) - 3 + cmdLength));
907	    cmdInfoPtr->interp = interp;
908	    cmdInfoPtr->charOffset = 0;
909	    cmdInfoPtr->byteOffset = 0;
910	    cmdInfoPtr->buffer[0] = '\0';
911	    cmdInfoPtr->cmdLength = cmdLength;
912	    strcpy(cmdInfoPtr->command, string);
913	    Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
914		    (ClientData) cmdInfoPtr, format);
915	}
916	return TCL_OK;
917    }
918
919    case SELECTION_OWN: {
920	register LostCommand *lostPtr;
921	char *script = NULL;
922	int cmdLength;
923	static CONST char *ownOptionStrings[] = {
924	    "-command", "-displayof", "-selection", NULL
925	};
926	enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
927	int ownIndex;
928
929	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
930		count-=2, objs+=2) {
931	    string = Tcl_GetString(objs[0]);
932	    if (string[0] != '-') {
933		break;
934	    }
935	    if (count < 2) {
936		Tcl_AppendResult(interp, "value for \"", string,
937			"\" missing", NULL);
938		return TCL_ERROR;
939	    }
940
941	    if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
942		    "option", 0, &ownIndex) != TCL_OK) {
943		return TCL_ERROR;
944	    }
945
946	    switch ((enum ownOptions) ownIndex) {
947	    case OWN_COMMAND:
948		script = Tcl_GetString(objs[1]);
949		break;
950	    case OWN_DISPLAYOF:
951		path = Tcl_GetString(objs[1]);
952		break;
953	    case OWN_SELECTION:
954		selName = Tcl_GetString(objs[1]);
955		break;
956	    }
957	}
958
959	if (count > 2) {
960	    Tcl_WrongNumArgs(interp, 2, objv, "?options? ?window?");
961	    return TCL_ERROR;
962	}
963	if (selName != NULL) {
964	    selection = Tk_InternAtom(tkwin, selName);
965	} else {
966	    selection = XA_PRIMARY;
967	}
968
969	if (count == 0) {
970	    TkSelectionInfo *infoPtr;
971	    TkWindow *winPtr;
972
973	    if (path != NULL) {
974		tkwin = Tk_NameToWindow(interp, path, tkwin);
975	    }
976	    if (tkwin == NULL) {
977		return TCL_ERROR;
978	    }
979	    winPtr = (TkWindow *)tkwin;
980	    for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
981		    infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
982		if (infoPtr->selection == selection) {
983		    break;
984		}
985	    }
986
987	    /*
988	     * Ignore the internal clipboard window.
989	     */
990
991	    if ((infoPtr != NULL)
992		    && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
993		Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
994	    }
995	    return TCL_OK;
996	}
997
998	tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
999	if (tkwin == NULL) {
1000	    return TCL_ERROR;
1001	}
1002	if (count == 2) {
1003	    script = Tcl_GetString(objs[1]);
1004	}
1005	if (script == NULL) {
1006	    Tk_OwnSelection(tkwin, selection, NULL, (ClientData) NULL);
1007	    return TCL_OK;
1008	}
1009	cmdLength = strlen(script);
1010	lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
1011		-3 + cmdLength));
1012	lostPtr->interp = interp;
1013	strcpy(lostPtr->command, script);
1014	Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
1015	return TCL_OK;
1016    }
1017    }
1018    return TCL_OK;
1019}
1020
1021/*
1022 *----------------------------------------------------------------------
1023 *
1024 * TkSelGetInProgress --
1025 *
1026 *	This function returns a pointer to the thread-local list of pending
1027 *	searches.
1028 *
1029 * Results:
1030 *	The return value is a pointer to the first search in progress, or NULL
1031 *	if there are none.
1032 *
1033 * Side effects:
1034 *	None.
1035 *
1036 *----------------------------------------------------------------------
1037 */
1038
1039TkSelInProgress *
1040TkSelGetInProgress(void)
1041{
1042    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1043	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1044
1045    return tsdPtr->pendingPtr;
1046}
1047
1048/*
1049 *----------------------------------------------------------------------
1050 *
1051 * TkSelSetInProgress --
1052 *
1053 *	This function is used to set the thread-local list of pending
1054 *	searches. It is required because the pending list is kept in thread
1055 *	local storage.
1056 *
1057 * Results:
1058 *	None.
1059 *
1060 * Side effects:
1061 *	None.
1062 *
1063 *----------------------------------------------------------------------
1064 */
1065void
1066TkSelSetInProgress(
1067    TkSelInProgress *pendingPtr)
1068{
1069    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1070	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1071
1072    tsdPtr->pendingPtr = pendingPtr;
1073}
1074
1075/*
1076 *----------------------------------------------------------------------
1077 *
1078 * TkSelDeadWindow --
1079 *
1080 *	This function is invoked just before a TkWindow is deleted. It
1081 *	performs selection-related cleanup.
1082 *
1083 * Results:
1084 *	None.
1085 *
1086 * Side effects:
1087 *	Frees up memory associated with the selection.
1088 *
1089 *----------------------------------------------------------------------
1090 */
1091
1092void
1093TkSelDeadWindow(
1094    register TkWindow *winPtr)	/* Window that's being deleted. */
1095{
1096    register TkSelHandler *selPtr;
1097    register TkSelInProgress *ipPtr;
1098    TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
1099    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
1100	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
1101
1102    /*
1103     * While deleting all the handlers, be careful to check whether
1104     * ConvertSelection or TkSelPropProc are about to process one of the
1105     * deleted handlers.
1106     */
1107
1108    while (winPtr->selHandlerList != NULL) {
1109	selPtr = winPtr->selHandlerList;
1110	winPtr->selHandlerList = selPtr->nextPtr;
1111	for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
1112		ipPtr = ipPtr->nextPtr) {
1113	    if (ipPtr->selPtr == selPtr) {
1114		ipPtr->selPtr = NULL;
1115	    }
1116	}
1117	if (selPtr->proc == HandleTclCommand) {
1118	    /*
1119	     * Mark the CommandInfo as deleted and free it when we can.
1120	     */
1121
1122	    ((CommandInfo*)selPtr->clientData)->interp = NULL;
1123	    Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
1124	}
1125	ckfree((char *) selPtr);
1126    }
1127
1128    /*
1129     * Remove selections owned by window being deleted.
1130     */
1131
1132    for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
1133	    infoPtr != NULL; infoPtr = nextPtr) {
1134	nextPtr = infoPtr->nextPtr;
1135	if (infoPtr->owner == (Tk_Window) winPtr) {
1136	    if (infoPtr->clearProc == LostSelection) {
1137		ckfree((char *) infoPtr->clearData);
1138	    }
1139	    ckfree((char *) infoPtr);
1140	    infoPtr = prevPtr;
1141	    if (prevPtr == NULL) {
1142		winPtr->dispPtr->selectionInfoPtr = nextPtr;
1143	    } else {
1144		prevPtr->nextPtr = nextPtr;
1145	    }
1146	}
1147	prevPtr = infoPtr;
1148    }
1149}
1150
1151/*
1152 *----------------------------------------------------------------------
1153 *
1154 * TkSelInit --
1155 *
1156 *	Initialize selection-related information for a display.
1157 *
1158 * Results:
1159 *	None.
1160 *
1161 * Side effects:
1162 *	Selection-related information is initialized.
1163 *
1164 *----------------------------------------------------------------------
1165 */
1166
1167void
1168TkSelInit(
1169    Tk_Window tkwin)		/* Window token (used to find display to
1170				 * initialize). */
1171{
1172    register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
1173
1174    /*
1175     * Fetch commonly-used atoms.
1176     */
1177
1178    dispPtr->multipleAtom	= Tk_InternAtom(tkwin, "MULTIPLE");
1179    dispPtr->incrAtom		= Tk_InternAtom(tkwin, "INCR");
1180    dispPtr->targetsAtom	= Tk_InternAtom(tkwin, "TARGETS");
1181    dispPtr->timestampAtom	= Tk_InternAtom(tkwin, "TIMESTAMP");
1182    dispPtr->textAtom		= Tk_InternAtom(tkwin, "TEXT");
1183    dispPtr->compoundTextAtom	= Tk_InternAtom(tkwin, "COMPOUND_TEXT");
1184    dispPtr->applicationAtom	= Tk_InternAtom(tkwin, "TK_APPLICATION");
1185    dispPtr->windowAtom		= Tk_InternAtom(tkwin, "TK_WINDOW");
1186    dispPtr->clipboardAtom	= Tk_InternAtom(tkwin, "CLIPBOARD");
1187
1188    /*
1189     * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us to
1190     * support older X servers that didn't have UTF8_STRING yet. This is
1191     * necessary on Unix systems. For more information, see:
1192     *	  http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11
1193     */
1194
1195#if !defined(__WIN32__)
1196    dispPtr->utf8Atom		= Tk_InternAtom(tkwin, "UTF8_STRING");
1197#else
1198    dispPtr->utf8Atom		= (Atom) NULL;
1199#endif
1200}
1201
1202/*
1203 *----------------------------------------------------------------------
1204 *
1205 * TkSelClearSelection --
1206 *
1207 *	This function is invoked to process a SelectionClear event.
1208 *
1209 * Results:
1210 *	None.
1211 *
1212 * Side effects:
1213 *	Invokes the clear function for the window which lost the
1214 *	selection.
1215 *
1216 *----------------------------------------------------------------------
1217 */
1218
1219void
1220TkSelClearSelection(
1221    Tk_Window tkwin,		/* Window for which event was targeted. */
1222    register XEvent *eventPtr)	/* X SelectionClear event. */
1223{
1224    register TkWindow *winPtr = (TkWindow *) tkwin;
1225    TkDisplay *dispPtr = winPtr->dispPtr;
1226    TkSelectionInfo *infoPtr;
1227    TkSelectionInfo *prevPtr;
1228
1229    /*
1230     * Invoke clear function for window that just lost the selection. This
1231     * code is a bit tricky, because any callbacks due to selection changes
1232     * between windows managed by the process have already been made. Thus,
1233     * ignore the event unless it refers to the window that's currently the
1234     * selection owner and the event was generated after the server saw the
1235     * SetSelectionOwner request.
1236     */
1237
1238    for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
1239	    infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
1240	if (infoPtr->selection == eventPtr->xselectionclear.selection) {
1241	    break;
1242	}
1243	prevPtr = infoPtr;
1244    }
1245
1246    if (infoPtr != NULL && (infoPtr->owner == tkwin) &&
1247	    (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
1248	if (prevPtr == NULL) {
1249	    dispPtr->selectionInfoPtr = infoPtr->nextPtr;
1250	} else {
1251	    prevPtr->nextPtr = infoPtr->nextPtr;
1252	}
1253
1254	/*
1255	 * Because of reentrancy problems, calling clearProc must be done
1256	 * after the infoPtr has been removed from the selectionInfoPtr list
1257	 * (clearProc could modify the list, e.g. by creating a new
1258	 * selection).
1259	 */
1260
1261	if (infoPtr->clearProc != NULL) {
1262	    (*infoPtr->clearProc)(infoPtr->clearData);
1263	}
1264	ckfree((char *) infoPtr);
1265    }
1266}
1267
1268/*
1269 *--------------------------------------------------------------
1270 *
1271 * SelGetProc --
1272 *
1273 *	This function is invoked to process pieces of the selection as they
1274 *	arrive during "selection get" commands.
1275 *
1276 * Results:
1277 *	Always returns TCL_OK.
1278 *
1279 * Side effects:
1280 *	Bytes get appended to the dynamic string pointed to by the clientData
1281 *	argument.
1282 *
1283 *--------------------------------------------------------------
1284 */
1285
1286	/* ARGSUSED */
1287static int
1288SelGetProc(
1289    ClientData clientData,	/* Dynamic string holding partially assembled
1290				 * selection. */
1291    Tcl_Interp *interp,		/* Interpreter used for error reporting (not
1292				 * used). */
1293    char *portion)		/* New information to be appended. */
1294{
1295    Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
1296    return TCL_OK;
1297}
1298
1299/*
1300 *----------------------------------------------------------------------
1301 *
1302 * HandleTclCommand --
1303 *
1304 *	This function acts as selection handler for handlers created by the
1305 *	"selection handle" command. It invokes a Tcl command to retrieve the
1306 *	selection.
1307 *
1308 * Results:
1309 *	The return value is a count of the number of bytes actually stored at
1310 *	buffer, or -1 if an error occurs while executing the Tcl command to
1311 *	retrieve the selection.
1312 *
1313 * Side effects:
1314 *	None except for things done by the Tcl command.
1315 *
1316 *----------------------------------------------------------------------
1317 */
1318
1319static int
1320HandleTclCommand(
1321    ClientData clientData,	/* Information about command to execute. */
1322    int offset,			/* Return selection bytes starting at this
1323				 * offset. */
1324    char *buffer,		/* Place to store converted selection. */
1325    int maxBytes)		/* Maximum # of bytes to store at buffer. */
1326{
1327    CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
1328    int spaceNeeded, length;
1329#define MAX_STATIC_SIZE 100
1330    char staticSpace[MAX_STATIC_SIZE];
1331    char *command, *string;
1332    Tcl_Interp *interp = cmdInfoPtr->interp;
1333    Tcl_DString oldResult;
1334    Tcl_Obj *objPtr;
1335    int extraBytes, charOffset, count, numChars;
1336    CONST char *p;
1337
1338    /*
1339     * We must also protect the interpreter and the command from being deleted
1340     * too soon.
1341     */
1342
1343    Tcl_Preserve(clientData);
1344    Tcl_Preserve((ClientData) interp);
1345
1346    /*
1347     * Compute the proper byte offset in the case where the last chunk split a
1348     * character.
1349     */
1350
1351    if (offset == cmdInfoPtr->byteOffset) {
1352	charOffset = cmdInfoPtr->charOffset;
1353	extraBytes = strlen(cmdInfoPtr->buffer);
1354	if (extraBytes > 0) {
1355	    strcpy(buffer, cmdInfoPtr->buffer);
1356	    maxBytes -= extraBytes;
1357	    buffer += extraBytes;
1358	}
1359    } else {
1360	cmdInfoPtr->byteOffset = 0;
1361	cmdInfoPtr->charOffset = 0;
1362	extraBytes = 0;
1363	charOffset = 0;
1364    }
1365
1366    /*
1367     * First, generate a command by taking the command string and appending
1368     * the offset and maximum # of bytes.
1369     */
1370
1371    spaceNeeded = cmdInfoPtr->cmdLength + 30;
1372    if (spaceNeeded < MAX_STATIC_SIZE) {
1373	command = staticSpace;
1374    } else {
1375	command = (char *) ckalloc((unsigned) spaceNeeded);
1376    }
1377    sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes);
1378
1379    /*
1380     * Execute the command. Be sure to restore the state of the interpreter
1381     * after executing the command.
1382     */
1383
1384    Tcl_DStringInit(&oldResult);
1385    Tcl_DStringGetResult(interp, &oldResult);
1386    if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
1387	objPtr = Tcl_GetObjResult(interp);
1388	string = Tcl_GetStringFromObj(objPtr, &length);
1389	count = (length > maxBytes) ? maxBytes : length;
1390	memcpy(buffer, string, (size_t) count);
1391	buffer[count] = '\0';
1392
1393	/*
1394	 * Update the partial character information for the next retrieval if
1395	 * the command has not been deleted.
1396	 */
1397
1398	if (cmdInfoPtr->interp != NULL) {
1399	    if (length <= maxBytes) {
1400		cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
1401		cmdInfoPtr->buffer[0] = '\0';
1402	    } else {
1403		p = string;
1404		string += count;
1405		numChars = 0;
1406		while (p < string) {
1407		    p = Tcl_UtfNext(p);
1408		    numChars++;
1409		}
1410		cmdInfoPtr->charOffset += numChars;
1411		length = p - string;
1412		if (length > 0) {
1413		    strncpy(cmdInfoPtr->buffer, string, (size_t) length);
1414		}
1415		cmdInfoPtr->buffer[length] = '\0';
1416	    }
1417	    cmdInfoPtr->byteOffset += count + extraBytes;
1418	}
1419	count += extraBytes;
1420    } else {
1421	count = -1;
1422    }
1423    Tcl_DStringResult(interp, &oldResult);
1424
1425    if (command != staticSpace) {
1426	ckfree(command);
1427    }
1428
1429    Tcl_Release(clientData);
1430    Tcl_Release((ClientData) interp);
1431    return count;
1432}
1433
1434/*
1435 *----------------------------------------------------------------------
1436 *
1437 * TkSelDefaultSelection --
1438 *
1439 *	This function is called to generate selection information for a few
1440 *	standard targets such as TIMESTAMP and TARGETS. It is invoked only if
1441 *	no handler has been declared by the application.
1442 *
1443 * Results:
1444 *	If "target" is a standard target understood by this function, the
1445 *	selection is converted to that form and stored as a character string
1446 *	in buffer. The type of the selection (e.g. STRING or ATOM) is stored
1447 *	in *typePtr, and the return value is a count of the # of non-NULL
1448 *	bytes at buffer. If the target wasn't understood, or if there isn't
1449 *	enough space at buffer to hold the entire selection (no INCR-mode
1450 *	transfers for this stuff!), then -1 is returned.
1451 *
1452 * Side effects:
1453 *	None.
1454 *
1455 *----------------------------------------------------------------------
1456 */
1457
1458int
1459TkSelDefaultSelection(
1460    TkSelectionInfo *infoPtr,	/* Info about selection being retrieved. */
1461    Atom target,		/* Desired form of selection. */
1462    char *buffer,		/* Place to put selection characters. */
1463    int maxBytes,		/* Maximum # of bytes to store at buffer. */
1464    Atom *typePtr)		/* Store here the type of the selection, for
1465				 * use in converting to proper X format. */
1466{
1467    register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
1468    TkDisplay *dispPtr = winPtr->dispPtr;
1469
1470    if (target == dispPtr->timestampAtom) {
1471	if (maxBytes < 20) {
1472	    return -1;
1473	}
1474	sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
1475	*typePtr = XA_INTEGER;
1476	return strlen(buffer);
1477    }
1478
1479    if (target == dispPtr->targetsAtom) {
1480	register TkSelHandler *selPtr;
1481	int length;
1482	Tcl_DString ds;
1483
1484	if (maxBytes < 50) {
1485	    return -1;
1486	}
1487	Tcl_DStringInit(&ds);
1488	Tcl_DStringAppend(&ds,
1489		"MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW", -1);
1490	for (selPtr = winPtr->selHandlerList; selPtr != NULL;
1491		selPtr = selPtr->nextPtr) {
1492	    if ((selPtr->selection == infoPtr->selection)
1493		    && (selPtr->target != dispPtr->applicationAtom)
1494		    && (selPtr->target != dispPtr->windowAtom)) {
1495		CONST char *atomString = Tk_GetAtomName((Tk_Window) winPtr,
1496			selPtr->target);
1497		Tcl_DStringAppendElement(&ds, atomString);
1498	    }
1499	}
1500	length = Tcl_DStringLength(&ds);
1501	if (length >= maxBytes) {
1502	    Tcl_DStringFree(&ds);
1503	    return -1;
1504	}
1505	memcpy(buffer, Tcl_DStringValue(&ds), (unsigned) (1+length));
1506	Tcl_DStringFree(&ds);
1507	*typePtr = XA_ATOM;
1508	return length;
1509    }
1510
1511    if (target == dispPtr->applicationAtom) {
1512	int length;
1513	Tk_Uid name = winPtr->mainPtr->winPtr->nameUid;
1514
1515	length = strlen(name);
1516	if (maxBytes <= length) {
1517	    return -1;
1518	}
1519	strcpy(buffer, name);
1520	*typePtr = XA_STRING;
1521	return length;
1522    }
1523
1524    if (target == dispPtr->windowAtom) {
1525	int length;
1526	char *name = winPtr->pathName;
1527
1528	length = strlen(name);
1529	if (maxBytes <= length) {
1530	    return -1;
1531	}
1532	strcpy(buffer, name);
1533	*typePtr = XA_STRING;
1534	return length;
1535    }
1536
1537    return -1;
1538}
1539
1540/*
1541 *----------------------------------------------------------------------
1542 *
1543 * LostSelection --
1544 *
1545 *	This function is invoked when a window has lost ownership of the
1546 *	selection and the ownership was claimed with the command "selection
1547 *	own".
1548 *
1549 * Results:
1550 *	None.
1551 *
1552 * Side effects:
1553 *	A Tcl script is executed; it can do almost anything.
1554 *
1555 *----------------------------------------------------------------------
1556 */
1557
1558static void
1559LostSelection(
1560    ClientData clientData)	/* Pointer to LostCommand structure. */
1561{
1562    LostCommand *lostPtr = (LostCommand *) clientData;
1563    Tcl_Obj *objPtr;
1564    Tcl_Interp *interp;
1565
1566    interp = lostPtr->interp;
1567    Tcl_Preserve((ClientData) interp);
1568
1569    /*
1570     * Execute the command. Save the interpreter's result, if any, and restore
1571     * it after executing the command.
1572     */
1573
1574    objPtr = Tcl_GetObjResult(interp);
1575    Tcl_IncrRefCount(objPtr);
1576    Tcl_ResetResult(interp);
1577
1578    if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
1579	Tcl_BackgroundError(interp);
1580    }
1581
1582    Tcl_SetObjResult(interp, objPtr);
1583    Tcl_DecrRefCount(objPtr);
1584
1585    Tcl_Release((ClientData) interp);
1586
1587    /*
1588     * Free the storage for the command, since we're done with it now.
1589     */
1590
1591    ckfree((char *) lostPtr);
1592}
1593
1594/*
1595 * Local Variables:
1596 * mode: c
1597 * c-basic-offset: 4
1598 * fill-column: 78
1599 * End:
1600 */
1601