diff options
Diffstat (limited to 'tk8.6/generic/tkSelect.c')
| -rw-r--r-- | tk8.6/generic/tkSelect.c | 1602 |
1 files changed, 0 insertions, 1602 deletions
diff --git a/tk8.6/generic/tkSelect.c b/tk8.6/generic/tkSelect.c deleted file mode 100644 index d763411..0000000 --- a/tk8.6/generic/tkSelect.c +++ /dev/null @@ -1,1602 +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"); - - /* - * 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: - */ |