--- /dev/null
+/*
+ * 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[4]; /* A buffer to hold part of a UTF character
+ * that is split across chunks. */
+ char command[TKFLEXARRAY]; /* 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 {
+ 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);
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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). */
+{
+ 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 = (TkSelHandler *)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 = (TkSelHandler *)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;
+ }
+ }
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ TkSelHandler *selPtr, *prevPtr;
+ TkSelInProgress *ipPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ 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);
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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 = (TkSelectionInfo *)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);
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 = (ThreadSpecificData *)
+ 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) {
+ 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;
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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 = (Tk_Window)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;
+ 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 = (CommandInfo *)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: {
+ 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 = (LostCommand *)ckalloc(sizeof(LostCommand));
+ lostPtr->interp = interp;
+ lostPtr->cmdObj = commandObj;
+ Tcl_IncrRefCount(commandObj);
+ Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
+ return TCL_OK;
+ }
+ }
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ return tsdPtr->pendingPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = (ThreadSpecificData *)
+ Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
+
+ tsdPtr->pendingPtr = pendingPtr;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ TkWindow *winPtr) /* Window that's being deleted. */
+{
+ TkSelHandler *selPtr;
+ TkSelInProgress *ipPtr;
+ TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
+ 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;
+ }
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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). */
+{
+ 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");
+ dispPtr->atomPairAtom = Tk_InternAtom(tkwin, "ATOM_PAIR");
+
+ /*
+ * 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:
+ * https://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
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+ XEvent *eventPtr) /* X SelectionClear event. */
+{
+ 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);
+ }
+}
+\f
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SelGetProc(
+ ClientData clientData, /* Dynamic string holding partially assembled
+ * selection. */
+ TCL_UNUSED(Tcl_Interp *), /* Interpreter used for error reporting (not
+ * used). */
+ const char *portion) /* New information to be appended. */
+{
+ Tcl_DStringAppend((Tcl_DString *)clientData, portion, -1);
+ return TCL_OK;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = (CommandInfo *)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 {
+ Tcl_UniChar ch = 0;
+ p = string;
+ string += count;
+ numChars = 0;
+ while (p < string) {
+ p += Tcl_UtfToUniChar(p, &ch);
+ numChars++;
+ }
+ cmdInfoPtr->charOffset += numChars;
+ length = p - string;
+ if (length > 0) {
+ strncpy(cmdInfoPtr->buffer, string, 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ 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) {
+ 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), length + 1);
+ 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;
+}
+\f
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 = (LostCommand *)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);
+}
+\f
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
OSDN Git Service
