summaryrefslogtreecommitdiffstats
path: root/tk8.6/generic/tkSelect.c
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2019-04-22 15:46:20 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2019-04-22 15:46:20 (GMT)
commit7e8909a08b8e425eeaa69085cbe86e848f2f5650 (patch)
treef26e5e21fe28674bab321d6453ea32b5a4a491e2 /tk8.6/generic/tkSelect.c
parent346eeb31d1c0a2ee959ecfade3cd66e3dc07cf4b (diff)
downloadblt-7e8909a08b8e425eeaa69085cbe86e848f2f5650.zip
blt-7e8909a08b8e425eeaa69085cbe86e848f2f5650.tar.gz
blt-7e8909a08b8e425eeaa69085cbe86e848f2f5650.tar.bz2
backout tcl/tk 8.6.9
Diffstat (limited to 'tk8.6/generic/tkSelect.c')
-rw-r--r--tk8.6/generic/tkSelect.c1603
1 files changed, 0 insertions, 1603 deletions
diff --git a/tk8.6/generic/tkSelect.c b/tk8.6/generic/tkSelect.c
deleted file mode 100644
index fcfd323..0000000
--- a/tk8.6/generic/tkSelect.c
+++ /dev/null
@@ -1,1603 +0,0 @@
-/*
- * 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");
- 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:
- * 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:
- */