Merge commit '1005c7e630baa54e58ac331f48bf876011deb6b3' as 'tk8.6'

1 files changed, 1602 insertions, 0 deletions

diff --git a/tk8.6/generic/tkSelect.c b/tk8.6/generic/tkSelect.c
new file mode 100644
index 0000000..d763411
--- /dev/null
+++ b/tk8.6/generic/tkSelect.c
@@ -0,0 +1,1602 @@
+/*
+ * tkSelect.c --
+ *
+ *	This file manages the selection for the Tk toolkit, translating
+ *	between the standard X ICCCM conventions and Tcl commands.
+ *
+ * Copyright (c) 1990-1993 The Regents of the University of California.
+ * Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When a selection handler is set up by invoking "selection handle", one of
+ * the following data structures is set up to hold information about the
+ * command to invoke and its interpreter.
+ */
+
+typedef struct {
+    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
+    int cmdLength;		/* # of non-NULL bytes in command. */
+    int charOffset;		/* The offset of the next char to retrieve. */
+    int byteOffset;		/* The expected byte offset of the next
+				 * chunk. */
+    char buffer[TCL_UTF_MAX];	/* A buffer to hold part of a UTF character
+				 * that is split across chunks. */
+    char command[1];		/* Command to invoke. Actual space is
+				 * allocated as large as necessary. This must
+				 * be the last entry in the structure. */
+} CommandInfo;
+
+/*
+ * When selection ownership is claimed with the "selection own" Tcl command,
+ * one of the following structures is created to record the Tcl command to be
+ * executed when the selection is lost again.
+ */
+
+typedef struct LostCommand {
+    Tcl_Interp *interp;		/* Interpreter in which to invoke command. */
+    Tcl_Obj *cmdObj;		/* Reference to command to invoke. */
+} LostCommand;
+
+/*
+ * The structure below is used to keep each thread's pending list separate.
+ */
+
+typedef struct ThreadSpecificData {
+    TkSelInProgress *pendingPtr;
+				/* Topmost search in progress, or NULL if
+				 * none. */
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations for functions defined in this file:
+ */
+
+static int		HandleTclCommand(ClientData clientData,
+			    int offset, char *buffer, int maxBytes);
+static void		LostSelection(ClientData clientData);
+static int		SelGetProc(ClientData clientData,
+			    Tcl_Interp *interp, const char *portion);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSelHandler --
+ *
+ *	This function is called to register a function as the handler for
+ *	selection requests of a particular target type on a particular window
+ *	for a particular selection.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+
+ *	In the future, whenever the selection is in tkwin's window and someone
+ *	requests the selection in the form given by target, proc will be
+ *	invoked to provide part or all of the selection in the given form. If
+ *	there was already a handler declared for the given window, target and
+ *	selection type, then it is replaced. Proc should have the following
+ *	form:
+ *
+ *	int
+ *	proc(
+ *	    ClientData clientData,
+ *	    int offset,
+ *	    char *buffer,
+ *	    int maxBytes)
+ *	{
+ *	}
+ *
+ *	The clientData argument to proc will be the same as the clientData
+ *	argument to this function. The offset argument indicates which portion
+ *	of the selection to return: skip the first offset bytes. Buffer is a
+ *	pointer to an area in which to place the converted selection, and
+ *	maxBytes gives the number of bytes available at buffer. Proc should
+ *	place the selection in buffer as a string, and return a count of the
+ *	number of bytes of selection actually placed in buffer (not including
+ *	the terminating NULL character). If the return value equals maxBytes,
+ *	this is a sign that there is probably still more selection information
+ *	available.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateSelHandler(
+    Tk_Window tkwin,		/* Token for window. */
+    Atom selection,		/* Selection to be handled. */
+    Atom target,		/* The kind of selection conversions that can
+				 * be handled by proc, e.g. TARGETS or
+				 * STRING. */
+    Tk_SelectionProc *proc,	/* Function to invoke to convert selection to
+				 * type "target". */
+    ClientData clientData,	/* Value to pass to proc. */
+    Atom format)		/* Format in which the selection information
+				 * should be returned to the requestor.
+				 * XA_STRING is best by far, but anything
+				 * listed in the ICCCM will be tolerated
+				 * (blech). */
+{
+    register TkSelHandler *selPtr;
+    TkWindow *winPtr = (TkWindow *) tkwin;
+
+    if (winPtr->dispPtr->multipleAtom == None) {
+	TkSelInit(tkwin);
+    }
+
+    /*
+     * See if there's already a handler for this target and selection on this
+     * window. If so, re-use it. If not, create a new one.
+     */
+
+    for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+	if (selPtr == NULL) {
+	    selPtr = ckalloc(sizeof(TkSelHandler));
+	    selPtr->nextPtr = winPtr->selHandlerList;
+	    winPtr->selHandlerList = selPtr;
+	    break;
+	}
+	if ((selPtr->selection == selection) && (selPtr->target == target)) {
+	    /*
+	     * Special case: when replacing handler created by "selection
+	     * handle", free up memory. Should there be a callback to allow
+	     * other clients to do this too?
+	     */
+
+	    if (selPtr->proc == HandleTclCommand) {
+		ckfree(selPtr->clientData);
+	    }
+	    break;
+	}
+    }
+    selPtr->selection = selection;
+    selPtr->target = target;
+    selPtr->format = format;
+    selPtr->proc = proc;
+    selPtr->clientData = clientData;
+    if (format == XA_STRING) {
+	selPtr->size = 8;
+    } else {
+	selPtr->size = 32;
+    }
+
+    if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) 0)) {
+	/*
+	 * If the user asked for a STRING handler and we understand
+	 * UTF8_STRING, we implicitly create a UTF8_STRING handler for them.
+	 */
+
+	target = winPtr->dispPtr->utf8Atom;
+	for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+	    if (selPtr == NULL) {
+		selPtr = ckalloc(sizeof(TkSelHandler));
+		selPtr->nextPtr = winPtr->selHandlerList;
+		winPtr->selHandlerList = selPtr;
+		selPtr->selection = selection;
+		selPtr->target = target;
+		selPtr->format = target; /* We want UTF8_STRING format */
+		selPtr->proc = proc;
+		if (selPtr->proc == HandleTclCommand) {
+		    /*
+		     * The clientData is selection controlled memory, so we
+		     * should make a copy for this selPtr.
+		     */
+
+		    unsigned cmdInfoLen = Tk_Offset(CommandInfo, command) + 1 +
+			    ((CommandInfo *)clientData)->cmdLength;
+
+		    selPtr->clientData = ckalloc(cmdInfoLen);
+		    memcpy(selPtr->clientData, clientData, cmdInfoLen);
+		} else {
+		    selPtr->clientData = clientData;
+		}
+		selPtr->size = 8;
+		break;
+	    }
+	    if (selPtr->selection==selection && selPtr->target==target) {
+		/*
+		 * Looks like we had a utf-8 target already. Leave it alone.
+		 */
+
+		break;
+	    }
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteSelHandler --
+ *
+ *	Remove the selection handler for a given window, target, and
+ *	selection, if it exists.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The selection handler for tkwin and target is removed. If there is no
+ *	such handler then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteSelHandler(
+    Tk_Window tkwin,		/* Token for window. */
+    Atom selection,		/* The selection whose handler is to be
+				 * removed. */
+    Atom target)		/* The target whose selection handler is to be
+				 * removed. */
+{
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    register TkSelHandler *selPtr, *prevPtr;
+    register TkSelInProgress *ipPtr;
+    ThreadSpecificData *tsdPtr =
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    /*
+     * Find the selection handler to be deleted, or return if it doesn't
+     * exist.
+     */
+
+    for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
+	    prevPtr = selPtr, selPtr = selPtr->nextPtr) {
+	if (selPtr == NULL) {
+	    return;
+	}
+	if ((selPtr->selection == selection) && (selPtr->target == target)) {
+	    break;
+	}
+    }
+
+    /*
+     * If ConvertSelection is processing this handler, tell it that the
+     * handler is dead.
+     */
+
+    for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+	    ipPtr = ipPtr->nextPtr) {
+	if (ipPtr->selPtr == selPtr) {
+	    ipPtr->selPtr = NULL;
+	}
+    }
+
+    /*
+     * Free resources associated with the handler.
+     */
+
+    if (prevPtr == NULL) {
+	winPtr->selHandlerList = selPtr->nextPtr;
+    } else {
+	prevPtr->nextPtr = selPtr->nextPtr;
+    }
+
+    if ((target == XA_STRING) && (winPtr->dispPtr->utf8Atom != (Atom) 0)) {
+	/*
+	 * If the user asked for a STRING handler and we understand
+	 * UTF8_STRING, we may have implicitly created a UTF8_STRING handler
+	 * for them. Look for it and delete it as necessary.
+	 */
+
+	TkSelHandler *utf8selPtr;
+
+	target = winPtr->dispPtr->utf8Atom;
+	for (utf8selPtr = winPtr->selHandlerList; utf8selPtr != NULL;
+		utf8selPtr = utf8selPtr->nextPtr) {
+	    if ((utf8selPtr->selection == selection)
+		    && (utf8selPtr->target == target)) {
+		break;
+	    }
+	}
+	if (utf8selPtr != NULL) {
+	    if ((utf8selPtr->format == target)
+		    && (utf8selPtr->proc == selPtr->proc)
+		    && (utf8selPtr->size == selPtr->size)) {
+		/*
+		 * This recursive call is OK, because we've changed the value
+		 * of 'target'.
+		 */
+
+		Tk_DeleteSelHandler(tkwin, selection, target);
+	    }
+	}
+    }
+
+    if (selPtr->proc == HandleTclCommand) {
+	/*
+	 * Mark the CommandInfo as deleted and free it if we can.
+	 */
+
+	((CommandInfo *) selPtr->clientData)->interp = NULL;
+	Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+    }
+    ckfree(selPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OwnSelection --
+ *
+ *	Arrange for tkwin to become the owner of a selection.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	From now on, requests for the selection will be directed to functions
+ *	associated with tkwin (they must have been declared with calls to
+ *	Tk_CreateSelHandler). When the selection is lost by this window, proc
+ *	will be invoked (see the manual entry for details). This function may
+ *	invoke callbacks, including Tcl scripts, so any calling function
+ *	should be reentrant at the point where Tk_OwnSelection is invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_OwnSelection(
+    Tk_Window tkwin,		/* Window to become new selection owner. */
+    Atom selection,		/* Selection that window should own. */
+    Tk_LostSelProc *proc,	/* Function to call when selection is taken
+				 * away from tkwin. */
+    ClientData clientData)	/* Arbitrary one-word argument to pass to
+				 * proc. */
+{
+    register TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+    TkSelectionInfo *infoPtr;
+    Tk_LostSelProc *clearProc = NULL;
+    ClientData clearData = NULL;/* Initialization needed only to prevent
+				 * compiler warning. */
+
+    if (dispPtr->multipleAtom == None) {
+	TkSelInit(tkwin);
+    }
+    Tk_MakeWindowExist(tkwin);
+
+    /*
+     * This code is somewhat tricky. First, we find the specified selection on
+     * the selection list. If the previous owner is in this process, and is a
+     * different window, then we need to invoke the clearProc. However, it's
+     * dangerous to call the clearProc right now, because it could invoke a
+     * Tcl script that wrecks the current state (e.g. it could delete the
+     * window). To be safe, defer the call until the end of the function when
+     * we no longer care about the state.
+     */
+
+    for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+	    infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->selection == selection) {
+	    break;
+	}
+    }
+    if (infoPtr == NULL) {
+	infoPtr = ckalloc(sizeof(TkSelectionInfo));
+	infoPtr->selection = selection;
+	infoPtr->nextPtr = dispPtr->selectionInfoPtr;
+	dispPtr->selectionInfoPtr = infoPtr;
+    } else if (infoPtr->clearProc != NULL) {
+	if (infoPtr->owner != tkwin) {
+	    clearProc = infoPtr->clearProc;
+	    clearData = infoPtr->clearData;
+	} else if (infoPtr->clearProc == LostSelection) {
+	    /*
+	     * If the selection handler is one created by "selection own", be
+	     * sure to free the record for it; otherwise there will be a
+	     * memory leak.
+	     */
+
+	    ckfree(infoPtr->clearData);
+	}
+    }
+
+    infoPtr->owner = tkwin;
+    infoPtr->serial = NextRequest(winPtr->display);
+    infoPtr->clearProc = proc;
+    infoPtr->clearData = clientData;
+
+    /*
+     * Note that we are using CurrentTime, even though ICCCM recommends
+     * against this practice (the problem is that we don't necessarily have a
+     * valid time to use). We will not be able to retrieve a useful timestamp
+     * for the TIMESTAMP target later.
+     */
+
+    infoPtr->time = CurrentTime;
+
+    /*
+     * Note that we are not checking to see if the selection claim succeeded.
+     * If the ownership does not change, then the clearProc may never be
+     * invoked, and we will return incorrect information when queried for the
+     * current selection owner.
+     */
+
+    XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
+	    infoPtr->time);
+
+    /*
+     * Now that we are done, we can invoke clearProc without running into
+     * reentrancy problems.
+     */
+
+    if (clearProc != NULL) {
+	clearProc(clearData);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClearSelection --
+ *
+ *	Eliminate the specified selection on tkwin's display, if there is one.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The specified selection is cleared, so that future requests to
+ *	retrieve it will fail until some application owns it again. This
+ *	function invokes callbacks, possibly including Tcl scripts, so any
+ *	calling function should be reentrant at the point Tk_ClearSelection is
+ *	invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ClearSelection(
+    Tk_Window tkwin,		/* Window that selects a display. */
+    Atom selection)		/* Selection to be cancelled. */
+{
+    register TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+    TkSelectionInfo *infoPtr;
+    TkSelectionInfo *prevPtr;
+    TkSelectionInfo *nextPtr;
+    Tk_LostSelProc *clearProc = NULL;
+    ClientData clearData = NULL;/* Initialization needed only to prevent
+				 * compiler warning. */
+
+    if (dispPtr->multipleAtom == None) {
+	TkSelInit(tkwin);
+    }
+
+    for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+	    infoPtr != NULL; infoPtr = nextPtr) {
+	nextPtr = infoPtr->nextPtr;
+	if (infoPtr->selection == selection) {
+	    if (prevPtr == NULL) {
+		dispPtr->selectionInfoPtr = nextPtr;
+	    } else {
+		prevPtr->nextPtr = nextPtr;
+	    }
+	    break;
+	}
+	prevPtr = infoPtr;
+    }
+
+    if (infoPtr != NULL) {
+	clearProc = infoPtr->clearProc;
+	clearData = infoPtr->clearData;
+	ckfree(infoPtr);
+    }
+    XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
+
+    if (clearProc != NULL) {
+	clearProc(clearData);
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetSelection --
+ *
+ *	Retrieve the value of a selection and pass it off (in pieces,
+ *	possibly) to a given function.
+ *
+ * Results:
+ *	The return value is a standard Tcl return value. If an error occurs
+ *	(such as no selection exists) then an error message is left in the
+ *	interp's result.
+ *
+ * Side effects:
+ *	The standard X11 protocols are used to retrieve the selection. When it
+ *	arrives, it is passed to proc. If the selection is very large, it will
+ *	be passed to proc in several pieces. Proc should have the following
+ *	structure:
+ *
+ *	int
+ *	proc(
+ *	    ClientData clientData,
+ *	    Tcl_Interp *interp,
+ *	    char *portion)
+ *	{
+ *	}
+ *
+ *	The interp and clientData arguments to proc will be the same as the
+ *	corresponding arguments to Tk_GetSelection. The portion argument
+ *	points to a character string containing part of the selection, and
+ *	numBytes indicates the length of the portion, not including the
+ *	terminating NULL character. If the selection arrives in several
+ *	pieces, the "portion" arguments in separate calls will contain
+ *	successive parts of the selection. Proc should normally return TCL_OK.
+ *	If it detects an error then it should return TCL_ERROR and leave an
+ *	error message in the interp's result; the remainder of the selection
+ *	retrieval will be aborted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetSelection(
+    Tcl_Interp *interp,		/* Interpreter to use for reporting errors. */
+    Tk_Window tkwin,		/* Window on whose behalf to retrieve the
+				 * selection (determines display from which to
+				 * retrieve). */
+    Atom selection,		/* Selection to retrieve. */
+    Atom target,		/* Desired form in which selection is to be
+				 * returned. */
+    Tk_GetSelProc *proc,	/* Function to call to process the selection,
+				 * once it has been retrieved. */
+    ClientData clientData)	/* Arbitrary value to pass to proc. */
+{
+    TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+    TkSelectionInfo *infoPtr;
+    ThreadSpecificData *tsdPtr =
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    if (dispPtr->multipleAtom == None) {
+	TkSelInit(tkwin);
+    }
+
+    /*
+     * If the selection is owned by a window managed by this process, then
+     * call the retrieval function directly, rather than going through the X
+     * server (it's dangerous to go through the X server in this case because
+     * it could result in deadlock if an INCR-style selection results).
+     */
+
+    for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+	    infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->selection == selection) {
+	    break;
+	}
+    }
+    if (infoPtr != NULL) {
+	register TkSelHandler *selPtr;
+	int offset, result, count;
+	char buffer[TK_SEL_BYTES_AT_ONCE+1];
+	TkSelInProgress ip;
+
+	for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
+		selPtr != NULL; selPtr = selPtr->nextPtr) {
+	    if (selPtr->target==target && selPtr->selection==selection) {
+		break;
+	    }
+	}
+	if (selPtr == NULL) {
+	    Atom type;
+
+	    count = TkSelDefaultSelection(infoPtr, target, buffer,
+		    TK_SEL_BYTES_AT_ONCE, &type);
+	    if (count > TK_SEL_BYTES_AT_ONCE) {
+		Tcl_Panic("selection handler returned too many bytes");
+	    }
+	    if (count < 0) {
+		goto cantget;
+	    }
+	    buffer[count] = 0;
+	    result = proc(clientData, interp, buffer);
+	} else {
+	    offset = 0;
+	    result = TCL_OK;
+	    ip.selPtr = selPtr;
+	    ip.nextPtr = tsdPtr->pendingPtr;
+	    tsdPtr->pendingPtr = &ip;
+	    while (1) {
+		count = selPtr->proc(selPtr->clientData, offset, buffer,
+			TK_SEL_BYTES_AT_ONCE);
+		if ((count < 0) || (ip.selPtr == NULL)) {
+		    tsdPtr->pendingPtr = ip.nextPtr;
+		    goto cantget;
+		}
+		if (count > TK_SEL_BYTES_AT_ONCE) {
+		    Tcl_Panic("selection handler returned too many bytes");
+		}
+		buffer[count] = '\0';
+		result = proc(clientData, interp, buffer);
+		if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
+			|| (ip.selPtr == NULL)) {
+		    break;
+		}
+		offset += count;
+	    }
+	    tsdPtr->pendingPtr = ip.nextPtr;
+	}
+	return result;
+    }
+
+    /*
+     * The selection is owned by some other process.
+     */
+
+    return TkSelGetSelection(interp, tkwin, selection, target, proc,
+	    clientData);
+
+  cantget:
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "%s selection doesn't exist or form \"%s\" not defined",
+	    Tk_GetAtomName(tkwin, selection),
+	    Tk_GetAtomName(tkwin, target)));
+    return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SelectionObjCmd --
+ *
+ *	This function is invoked to process the "selection" Tcl command. See
+ *	the user documentation for details on what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_SelectionObjCmd(
+    ClientData clientData,	/* Main window associated with
+				 * interpreter. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tk_Window tkwin = clientData;
+    const char *path = NULL;
+    Atom selection;
+    const char *selName = NULL;
+    const char *string;
+    int count, index;
+    Tcl_Obj **objs;
+    static const char *const optionStrings[] = {
+	"clear", "get", "handle", "own", NULL
+    };
+    enum options {
+	SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
+    };
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+	return TCL_ERROR;
+    }
+
+    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+	    &index) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    switch ((enum options) index) {
+    case SELECTION_CLEAR: {
+	static const char *const clearOptionStrings[] = {
+	    "-displayof", "-selection", NULL
+	};
+	enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
+	int clearIndex;
+
+	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+		count-=2, objs+=2) {
+	    string = Tcl_GetString(objs[0]);
+	    if (string[0] != '-') {
+		break;
+	    }
+	    if (count < 2) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", string));
+		Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
+		    "option", 0, &clearIndex) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    switch ((enum clearOptions) clearIndex) {
+	    case CLEAR_DISPLAYOF:
+		path = Tcl_GetString(objs[1]);
+		break;
+	    case CLEAR_SELECTION:
+		selName = Tcl_GetString(objs[1]);
+		break;
+	    }
+	}
+
+	if (count == 1) {
+	    path = Tcl_GetString(objs[0]);
+	} else if (count > 1) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+	    return TCL_ERROR;
+	}
+	if (path != NULL) {
+	    tkwin = Tk_NameToWindow(interp, path, tkwin);
+	}
+	if (tkwin == NULL) {
+	    return TCL_ERROR;
+	}
+	if (selName != NULL) {
+	    selection = Tk_InternAtom(tkwin, selName);
+	} else {
+	    selection = XA_PRIMARY;
+	}
+
+	Tk_ClearSelection(tkwin, selection);
+	break;
+    }
+
+    case SELECTION_GET: {
+	Atom target;
+	const char *targetName = NULL;
+	Tcl_DString selBytes;
+	int result;
+	static const char *const getOptionStrings[] = {
+	    "-displayof", "-selection", "-type", NULL
+	};
+	enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
+	int getIndex;
+
+	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
+		count-=2, objs+=2) {
+	    string = Tcl_GetString(objs[0]);
+	    if (string[0] != '-') {
+		break;
+	    }
+	    if (count < 2) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", string));
+		Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
+		    "option", 0, &getIndex) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    switch ((enum getOptions) getIndex) {
+	    case GET_DISPLAYOF:
+		path = Tcl_GetString(objs[1]);
+		break;
+	    case GET_SELECTION:
+		selName = Tcl_GetString(objs[1]);
+		break;
+	    case GET_TYPE:
+		targetName = Tcl_GetString(objs[1]);
+		break;
+	    }
+	}
+
+	if (path != NULL) {
+	    tkwin = Tk_NameToWindow(interp, path, tkwin);
+	}
+	if (tkwin == NULL) {
+	    return TCL_ERROR;
+	}
+	if (selName != NULL) {
+	    selection = Tk_InternAtom(tkwin, selName);
+	} else {
+	    selection = XA_PRIMARY;
+	}
+	if (count > 1) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
+	    return TCL_ERROR;
+	} else if (count == 1) {
+	    target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
+	} else if (targetName != NULL) {
+	    target = Tk_InternAtom(tkwin, targetName);
+	} else {
+	    target = XA_STRING;
+	}
+
+	Tcl_DStringInit(&selBytes);
+	result = Tk_GetSelection(interp, tkwin, selection, target,
+		SelGetProc, &selBytes);
+	if (result == TCL_OK) {
+	    Tcl_DStringResult(interp, &selBytes);
+	} else {
+	    Tcl_DStringFree(&selBytes);
+	}
+	return result;
+    }
+
+    case SELECTION_HANDLE: {
+	Atom target, format;
+	const char *targetName = NULL;
+	const char *formatName = NULL;
+	register CommandInfo *cmdInfoPtr;
+	int cmdLength;
+	static const char *const handleOptionStrings[] = {
+	    "-format", "-selection", "-type", NULL
+	};
+	enum handleOptions {
+	    HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
+	};
+	int handleIndex;
+
+	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+		count-=2, objs+=2) {
+	    string = Tcl_GetString(objs[0]);
+	    if (string[0] != '-') {
+		break;
+	    }
+	    if (count < 2) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", string));
+		Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
+		    "option", 0, &handleIndex) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    switch ((enum handleOptions) handleIndex) {
+	    case HANDLE_FORMAT:
+		formatName = Tcl_GetString(objs[1]);
+		break;
+	    case HANDLE_SELECTION:
+		selName = Tcl_GetString(objs[1]);
+		break;
+	    case HANDLE_TYPE:
+		targetName = Tcl_GetString(objs[1]);
+		break;
+	    }
+	}
+
+	if ((count < 2) || (count > 4)) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+		    "?-option value ...? window command");
+	    return TCL_ERROR;
+	}
+	tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
+	if (tkwin == NULL) {
+	    return TCL_ERROR;
+	}
+	if (selName != NULL) {
+	    selection = Tk_InternAtom(tkwin, selName);
+	} else {
+	    selection = XA_PRIMARY;
+	}
+
+	if (count > 2) {
+	    target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
+	} else if (targetName != NULL) {
+	    target = Tk_InternAtom(tkwin, targetName);
+	} else {
+	    target = XA_STRING;
+	}
+	if (count > 3) {
+	    format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
+	} else if (formatName != NULL) {
+	    format = Tk_InternAtom(tkwin, formatName);
+	} else {
+	    format = XA_STRING;
+	}
+	string = Tcl_GetStringFromObj(objs[1], &cmdLength);
+	if (cmdLength == 0) {
+	    Tk_DeleteSelHandler(tkwin, selection, target);
+	} else {
+	    cmdInfoPtr = ckalloc(Tk_Offset(CommandInfo, command)
+		    + 1 + cmdLength);
+	    cmdInfoPtr->interp = interp;
+	    cmdInfoPtr->charOffset = 0;
+	    cmdInfoPtr->byteOffset = 0;
+	    cmdInfoPtr->buffer[0] = '\0';
+	    cmdInfoPtr->cmdLength = cmdLength;
+	    memcpy(cmdInfoPtr->command, string, cmdLength + 1);
+	    Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
+		    cmdInfoPtr, format);
+	}
+	return TCL_OK;
+    }
+
+    case SELECTION_OWN: {
+	register LostCommand *lostPtr;
+	Tcl_Obj *commandObj = NULL;
+	static const char *const ownOptionStrings[] = {
+	    "-command", "-displayof", "-selection", NULL
+	};
+	enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
+	int ownIndex;
+
+	for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
+		count-=2, objs+=2) {
+	    string = Tcl_GetString(objs[0]);
+	    if (string[0] != '-') {
+		break;
+	    }
+	    if (count < 2) {
+		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			"value for \"%s\" missing", string));
+		Tcl_SetErrorCode(interp, "TK", "SELECTION", "VALUE", NULL);
+		return TCL_ERROR;
+	    }
+
+	    if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
+		    "option", 0, &ownIndex) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+
+	    switch ((enum ownOptions) ownIndex) {
+	    case OWN_COMMAND:
+		commandObj = objs[1];
+		break;
+	    case OWN_DISPLAYOF:
+		path = Tcl_GetString(objs[1]);
+		break;
+	    case OWN_SELECTION:
+		selName = Tcl_GetString(objs[1]);
+		break;
+	    }
+	}
+
+	if (count > 2) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?");
+	    return TCL_ERROR;
+	}
+	if (selName != NULL) {
+	    selection = Tk_InternAtom(tkwin, selName);
+	} else {
+	    selection = XA_PRIMARY;
+	}
+
+	if (count == 0) {
+	    TkSelectionInfo *infoPtr;
+	    TkWindow *winPtr;
+
+	    if (path != NULL) {
+		tkwin = Tk_NameToWindow(interp, path, tkwin);
+	    }
+	    if (tkwin == NULL) {
+		return TCL_ERROR;
+	    }
+	    winPtr = (TkWindow *) tkwin;
+	    for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
+		    infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+		if (infoPtr->selection == selection) {
+		    break;
+		}
+	    }
+
+	    /*
+	     * Ignore the internal clipboard window.
+	     */
+
+	    if ((infoPtr != NULL)
+		    && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
+		Tcl_SetObjResult(interp, TkNewWindowObj(infoPtr->owner));
+	    }
+	    return TCL_OK;
+	}
+
+	tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
+	if (tkwin == NULL) {
+	    return TCL_ERROR;
+	}
+	if (count == 2) {
+	    commandObj = objs[1];
+	}
+	if (commandObj == NULL) {
+	    Tk_OwnSelection(tkwin, selection, NULL, NULL);
+	    return TCL_OK;
+	}
+	lostPtr = ckalloc(sizeof(LostCommand));
+	lostPtr->interp = interp;
+	lostPtr->cmdObj = commandObj;
+	Tcl_IncrRefCount(commandObj);
+	Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
+	return TCL_OK;
+    }
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelGetInProgress --
+ *
+ *	This function returns a pointer to the thread-local list of pending
+ *	searches.
+ *
+ * Results:
+ *	The return value is a pointer to the first search in progress, or NULL
+ *	if there are none.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkSelInProgress *
+TkSelGetInProgress(void)
+{
+    ThreadSpecificData *tsdPtr =
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    return tsdPtr->pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelSetInProgress --
+ *
+ *	This function is used to set the thread-local list of pending
+ *	searches. It is required because the pending list is kept in thread
+ *	local storage.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkSelSetInProgress(
+    TkSelInProgress *pendingPtr)
+{
+    ThreadSpecificData *tsdPtr =
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    tsdPtr->pendingPtr = pendingPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDeadWindow --
+ *
+ *	This function is invoked just before a TkWindow is deleted. It
+ *	performs selection-related cleanup.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Frees up memory associated with the selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelDeadWindow(
+    register TkWindow *winPtr)	/* Window that's being deleted. */
+{
+    register TkSelHandler *selPtr;
+    register TkSelInProgress *ipPtr;
+    TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
+    ThreadSpecificData *tsdPtr =
+	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+    /*
+     * While deleting all the handlers, be careful to check whether
+     * ConvertSelection or TkSelPropProc are about to process one of the
+     * deleted handlers.
+     */
+
+    while (winPtr->selHandlerList != NULL) {
+	selPtr = winPtr->selHandlerList;
+	winPtr->selHandlerList = selPtr->nextPtr;
+	for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
+		ipPtr = ipPtr->nextPtr) {
+	    if (ipPtr->selPtr == selPtr) {
+		ipPtr->selPtr = NULL;
+	    }
+	}
+	if (selPtr->proc == HandleTclCommand) {
+	    /*
+	     * Mark the CommandInfo as deleted and free it when we can.
+	     */
+
+	    ((CommandInfo *) selPtr->clientData)->interp = NULL;
+	    Tcl_EventuallyFree(selPtr->clientData, TCL_DYNAMIC);
+	}
+	ckfree(selPtr);
+    }
+
+    /*
+     * Remove selections owned by window being deleted.
+     */
+
+    for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
+	    infoPtr != NULL; infoPtr = nextPtr) {
+	nextPtr = infoPtr->nextPtr;
+	if (infoPtr->owner == (Tk_Window) winPtr) {
+	    if (infoPtr->clearProc == LostSelection) {
+		ckfree(infoPtr->clearData);
+	    }
+	    ckfree(infoPtr);
+	    infoPtr = prevPtr;
+	    if (prevPtr == NULL) {
+		winPtr->dispPtr->selectionInfoPtr = nextPtr;
+	    } else {
+		prevPtr->nextPtr = nextPtr;
+	    }
+	}
+	prevPtr = infoPtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelInit --
+ *
+ *	Initialize selection-related information for a display.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Selection-related information is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelInit(
+    Tk_Window tkwin)		/* Window token (used to find display to
+				 * initialize). */
+{
+    register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+    /*
+     * Fetch commonly-used atoms.
+     */
+
+    dispPtr->multipleAtom	= Tk_InternAtom(tkwin, "MULTIPLE");
+    dispPtr->incrAtom		= Tk_InternAtom(tkwin, "INCR");
+    dispPtr->targetsAtom	= Tk_InternAtom(tkwin, "TARGETS");
+    dispPtr->timestampAtom	= Tk_InternAtom(tkwin, "TIMESTAMP");
+    dispPtr->textAtom		= Tk_InternAtom(tkwin, "TEXT");
+    dispPtr->compoundTextAtom	= Tk_InternAtom(tkwin, "COMPOUND_TEXT");
+    dispPtr->applicationAtom	= Tk_InternAtom(tkwin, "TK_APPLICATION");
+    dispPtr->windowAtom		= Tk_InternAtom(tkwin, "TK_WINDOW");
+    dispPtr->clipboardAtom	= Tk_InternAtom(tkwin, "CLIPBOARD");
+
+    /*
+     * Using UTF8_STRING instead of the XA_UTF8_STRING macro allows us to
+     * support older X servers that didn't have UTF8_STRING yet. This is
+     * necessary on Unix systems. For more information, see:
+     *	  http://www.cl.cam.ac.uk/~mgk25/unicode.html#x11
+     */
+
+#if !defined(_WIN32)
+    dispPtr->utf8Atom		= Tk_InternAtom(tkwin, "UTF8_STRING");
+#else
+    dispPtr->utf8Atom		= (Atom) 0;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelClearSelection --
+ *
+ *	This function is invoked to process a SelectionClear event.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Invokes the clear function for the window which lost the
+ *	selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelClearSelection(
+    Tk_Window tkwin,		/* Window for which event was targeted. */
+    register XEvent *eventPtr)	/* X SelectionClear event. */
+{
+    register TkWindow *winPtr = (TkWindow *) tkwin;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+    TkSelectionInfo *infoPtr;
+    TkSelectionInfo *prevPtr;
+
+    /*
+     * Invoke clear function for window that just lost the selection. This
+     * code is a bit tricky, because any callbacks due to selection changes
+     * between windows managed by the process have already been made. Thus,
+     * ignore the event unless it refers to the window that's currently the
+     * selection owner and the event was generated after the server saw the
+     * SetSelectionOwner request.
+     */
+
+    for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+	    infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+	if (infoPtr->selection == eventPtr->xselectionclear.selection) {
+	    break;
+	}
+	prevPtr = infoPtr;
+    }
+
+    if (infoPtr != NULL && (infoPtr->owner == tkwin) &&
+	    (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
+	if (prevPtr == NULL) {
+	    dispPtr->selectionInfoPtr = infoPtr->nextPtr;
+	} else {
+	    prevPtr->nextPtr = infoPtr->nextPtr;
+	}
+
+	/*
+	 * Because of reentrancy problems, calling clearProc must be done
+	 * after the infoPtr has been removed from the selectionInfoPtr list
+	 * (clearProc could modify the list, e.g. by creating a new
+	 * selection).
+	 */
+
+	if (infoPtr->clearProc != NULL) {
+	    infoPtr->clearProc(infoPtr->clearData);
+	}
+	ckfree(infoPtr);
+    }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SelGetProc --
+ *
+ *	This function is invoked to process pieces of the selection as they
+ *	arrive during "selection get" commands.
+ *
+ * Results:
+ *	Always returns TCL_OK.
+ *
+ * Side effects:
+ *	Bytes get appended to the dynamic string pointed to by the clientData
+ *	argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+SelGetProc(
+    ClientData clientData,	/* Dynamic string holding partially assembled
+				 * selection. */
+    Tcl_Interp *interp,		/* Interpreter used for error reporting (not
+				 * used). */
+    const char *portion)	/* New information to be appended. */
+{
+    Tcl_DStringAppend(clientData, portion, -1);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleTclCommand --
+ *
+ *	This function acts as selection handler for handlers created by the
+ *	"selection handle" command. It invokes a Tcl command to retrieve the
+ *	selection.
+ *
+ * Results:
+ *	The return value is a count of the number of bytes actually stored at
+ *	buffer, or -1 if an error occurs while executing the Tcl command to
+ *	retrieve the selection.
+ *
+ * Side effects:
+ *	None except for things done by the Tcl command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleTclCommand(
+    ClientData clientData,	/* Information about command to execute. */
+    int offset,			/* Return selection bytes starting at this
+				 * offset. */
+    char *buffer,		/* Place to store converted selection. */
+    int maxBytes)		/* Maximum # of bytes to store at buffer. */
+{
+    CommandInfo *cmdInfoPtr = clientData;
+    int length;
+    Tcl_Obj *command;
+    const char *string;
+    Tcl_Interp *interp = cmdInfoPtr->interp;
+    Tcl_InterpState savedState;
+    int extraBytes, charOffset, count, numChars, code;
+    const char *p;
+
+    /*
+     * We must also protect the interpreter and the command from being deleted
+     * too soon.
+     */
+
+    Tcl_Preserve(clientData);
+    Tcl_Preserve(interp);
+
+    /*
+     * Compute the proper byte offset in the case where the last chunk split a
+     * character.
+     */
+
+    if (offset == cmdInfoPtr->byteOffset) {
+	charOffset = cmdInfoPtr->charOffset;
+	extraBytes = strlen(cmdInfoPtr->buffer);
+	if (extraBytes > 0) {
+	    strcpy(buffer, cmdInfoPtr->buffer);
+	    maxBytes -= extraBytes;
+	    buffer += extraBytes;
+	}
+    } else {
+	cmdInfoPtr->byteOffset = 0;
+	cmdInfoPtr->charOffset = 0;
+	extraBytes = 0;
+	charOffset = 0;
+    }
+
+    /*
+     * First, generate a command by taking the command string and appending
+     * the offset and maximum # of bytes.
+     */
+
+    command = Tcl_ObjPrintf("%s %d %d",
+	    cmdInfoPtr->command, charOffset, maxBytes);
+    Tcl_IncrRefCount(command);
+
+    /*
+     * Execute the command. Be sure to restore the state of the interpreter
+     * after executing the command.
+     */
+
+    savedState = Tcl_SaveInterpState(interp, TCL_OK);
+    code = Tcl_EvalObjEx(interp, command, TCL_EVAL_GLOBAL);
+    Tcl_DecrRefCount(command);
+    if (code == TCL_OK) {
+	/*
+	 * TODO: This assumes that bytes are characters; that's not true!
+	 */
+
+	string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+	count = (length > maxBytes) ? maxBytes : length;
+	memcpy(buffer, string, (size_t) count);
+	buffer[count] = '\0';
+
+	/*
+	 * Update the partial character information for the next retrieval if
+	 * the command has not been deleted.
+	 */
+
+	if (cmdInfoPtr->interp != NULL) {
+	    if (length <= maxBytes) {
+		cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
+		cmdInfoPtr->buffer[0] = '\0';
+	    } else {
+		p = string;
+		string += count;
+		numChars = 0;
+		while (p < string) {
+		    p = Tcl_UtfNext(p);
+		    numChars++;
+		}
+		cmdInfoPtr->charOffset += numChars;
+		length = p - string;
+		if (length > 0) {
+		    strncpy(cmdInfoPtr->buffer, string, (size_t) length);
+		}
+		cmdInfoPtr->buffer[length] = '\0';
+	    }
+	    cmdInfoPtr->byteOffset += count + extraBytes;
+	}
+	count += extraBytes;
+    } else {
+	/*
+	 * Something went wrong. Log errors as background errors, and silently
+	 * drop everything else.
+	 */
+
+	if (code == TCL_ERROR) {
+	    Tcl_AddErrorInfo(interp, "\n    (command handling selection)");
+	    Tcl_BackgroundException(interp, code);
+	}
+	count = -1;
+    }
+    (void) Tcl_RestoreInterpState(interp, savedState);
+
+    Tcl_Release(clientData);
+    Tcl_Release(interp);
+    return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDefaultSelection --
+ *
+ *	This function is called to generate selection information for a few
+ *	standard targets such as TIMESTAMP and TARGETS. It is invoked only if
+ *	no handler has been declared by the application.
+ *
+ * Results:
+ *	If "target" is a standard target understood by this function, the
+ *	selection is converted to that form and stored as a character string
+ *	in buffer. The type of the selection (e.g. STRING or ATOM) is stored
+ *	in *typePtr, and the return value is a count of the # of non-NULL
+ *	bytes at buffer. If the target wasn't understood, or if there isn't
+ *	enough space at buffer to hold the entire selection (no INCR-mode
+ *	transfers for this stuff!), then -1 is returned.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelDefaultSelection(
+    TkSelectionInfo *infoPtr,	/* Info about selection being retrieved. */
+    Atom target,		/* Desired form of selection. */
+    char *buffer,		/* Place to put selection characters. */
+    int maxBytes,		/* Maximum # of bytes to store at buffer. */
+    Atom *typePtr)		/* Store here the type of the selection, for
+				 * use in converting to proper X format. */
+{
+    register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
+    TkDisplay *dispPtr = winPtr->dispPtr;
+
+    if (target == dispPtr->timestampAtom) {
+	if (maxBytes < 20) {
+	    return -1;
+	}
+	sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
+	*typePtr = XA_INTEGER;
+	return strlen(buffer);
+    }
+
+    if (target == dispPtr->targetsAtom) {
+	register TkSelHandler *selPtr;
+	int length;
+	Tcl_DString ds;
+
+	if (maxBytes < 50) {
+	    return -1;
+	}
+	Tcl_DStringInit(&ds);
+	Tcl_DStringAppend(&ds,
+		"MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW", -1);
+	for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+		selPtr = selPtr->nextPtr) {
+	    if ((selPtr->selection == infoPtr->selection)
+		    && (selPtr->target != dispPtr->applicationAtom)
+		    && (selPtr->target != dispPtr->windowAtom)) {
+		const char *atomString = Tk_GetAtomName((Tk_Window) winPtr,
+			selPtr->target);
+
+		Tcl_DStringAppendElement(&ds, atomString);
+	    }
+	}
+	length = Tcl_DStringLength(&ds);
+	if (length >= maxBytes) {
+	    Tcl_DStringFree(&ds);
+	    return -1;
+	}
+	memcpy(buffer, Tcl_DStringValue(&ds), (unsigned) (1+length));
+	Tcl_DStringFree(&ds);
+	*typePtr = XA_ATOM;
+	return length;
+    }
+
+    if (target == dispPtr->applicationAtom) {
+	int length;
+	Tk_Uid name = winPtr->mainPtr->winPtr->nameUid;
+
+	length = strlen(name);
+	if (maxBytes <= length) {
+	    return -1;
+	}
+	strcpy(buffer, name);
+	*typePtr = XA_STRING;
+	return length;
+    }
+
+    if (target == dispPtr->windowAtom) {
+	int length;
+	char *name = winPtr->pathName;
+
+	length = strlen(name);
+	if (maxBytes <= length) {
+	    return -1;
+	}
+	strcpy(buffer, name);
+	*typePtr = XA_STRING;
+	return length;
+    }
+
+    return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LostSelection --
+ *
+ *	This function is invoked when a window has lost ownership of the
+ *	selection and the ownership was claimed with the command "selection
+ *	own".
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	A Tcl script is executed; it can do almost anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+LostSelection(
+    ClientData clientData)	/* Pointer to LostCommand structure. */
+{
+    LostCommand *lostPtr = clientData;
+    Tcl_Interp *interp = lostPtr->interp;
+    Tcl_InterpState savedState;
+    int code;
+
+    Tcl_Preserve(interp);
+
+    /*
+     * Execute the command. Save the interpreter's result, if any, and restore
+     * it after executing the command.
+     */
+
+    savedState = Tcl_SaveInterpState(interp, TCL_OK);
+    Tcl_ResetResult(interp);
+    code = Tcl_EvalObjEx(interp, lostPtr->cmdObj, TCL_EVAL_GLOBAL);
+    if (code != TCL_OK) {
+	Tcl_BackgroundException(interp, code);
+    }
+    (void) Tcl_RestoreInterpState(interp, savedState);
+
+    /*
+     * Free the storage for the command, since we're done with it now.
+     */
+
+    Tcl_DecrRefCount(lostPtr->cmdObj);
+    ckfree(lostPtr);
+    Tcl_Release(interp);
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */