geos_one/archie
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
d71d446104
archie/tk3.6/tkSelect.c

2118 lines
60 KiB
C
Raw Normal View History

Intial commit
2024-05-27 16:13:40 +02:00
/*
* 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.
* All rights reserved.
*
* Permission is hereby granted, without written agreement and without
* license or royalty fees, to use, copy, modify, and distribute this
* software and its documentation for any purpose, provided that the
* above copyright notice and the following two paragraphs appear in
* all copies of this software.
*
* IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
* DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
* OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
* CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
* AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
* ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
* PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
*/
#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSelect.c,v 1.34 93/08/18 16:24:57 ouster Exp $ SPRITE (Berkeley)";
#endif
#include "tkConfig.h"
#include "tkInt.h"
/*
* When the selection is being retrieved, one of the following
* structures is present on a list of pending selection retrievals.
* The structure is used to communicate between the background
* procedure that requests the selection and the foreground
* event handler that processes the events in which the selection
* is returned. There is a list of such structures so that there
* can be multiple simultaneous selection retrievals (e.g. on
* different displays).
*/
typedef struct RetrievalInfo {
Tcl_Interp *interp; /* Interpreter for error reporting. */
TkWindow *winPtr; /* Window used as requestor for
* selection. */
Atom property; /* Property where selection will appear. */
Atom target; /* Desired form for selection. */
int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
char *portion)); /* Procedure to call to handle pieces
* of selection. */
ClientData clientData; /* Argument for proc. */
int result; /* Initially -1. Set to a Tcl
* return value once the selection
* has been retrieved. */
Tk_TimerToken timeout; /* Token for current timeout procedure. */
int idleTime; /* Number of seconds that have gone by
* without hearing anything from the
* selection owner. */
struct RetrievalInfo *nextPtr;
/* Next in list of all pending
* selection retrievals. NULL means
* end of list. */
} RetrievalInfo;
static RetrievalInfo *pendingRetrievals = NULL;
/* List of all retrievals currently
* being waited for. */
/*
* When "selection get" is being used to retrieve the selection,
* the following data structure is used for communication between
* Tk_SelectionCmd and SelGetProc. Its purpose is to keep track
* of the selection contents, which are gradually assembled in a
* string.
*/
typedef struct {
char *string; /* Contents of selection are
* here. This space is malloc-ed. */
int bytesAvl; /* Total number of bytes available
* at string. */
int bytesUsed; /* Bytes currently in use in string,
* not including the terminating
* NULL. */
} GetInfo;
/*
* When handling INCR-style selection retrievals, the selection owner
* uses the following data structure to communicate between the
* ConvertSelection procedure and TkSelPropProc.
*/
typedef struct IncrInfo {
TkWindow *winPtr; /* Window that owns selection. */
Atom *multAtoms; /* Information about conversions to
* perform: one or more pairs of
* (target, property). This either
* points to a retrieved property (for
* MULTIPLE retrievals) or to a static
* array. */
unsigned long numConversions;
/* Number of entries in offsets (same as
* # of pairs in multAtoms). */
int *offsets; /* One entry for each pair in
* multAtoms; -1 means all data has
* been transferred for this
* conversion. -2 means only the
* final zero-length transfer still
* has to be done. Otherwise it is the
* offset of the next chunk of data
* to transfer. This array is malloc-ed. */
int numIncrs; /* Number of entries in offsets that
* aren't -1 (i.e. # of INCR-mode transfers
* not yet completed). */
Tk_TimerToken timeout; /* Token for timer procedure. */
int idleTime; /* Number of seconds since we heard
* anything from the selection
* requestor. */
Window reqWindow; /* Requestor's window id. */
Time time; /* Timestamp corresponding to
* selection at beginning of request;
* used to abort transfer if selection
* changes. */
struct IncrInfo *nextPtr; /* Next in list of all INCR-style
* retrievals currently pending. */
} IncrInfo;
static IncrInfo *pendingIncrs = NULL;
/* List of all IncrInfo structures
* currently active. */
/*
* 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. */
char command[4]; /* 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. */
char command[4]; /* Command to invoke. Actual space is
* allocated as large as necessary. This
* must be the last entry in the structure. */
} LostCommand;
/*
* Chunk size for retrieving selection. It's defined both in
* words and in bytes; the word size is used to allocate
* buffer space that's guaranteed to be word-aligned and that
* has an extra character for the terminating NULL.
*/
#define TK_SEL_BYTES_AT_ONCE 4000
#define TK_SEL_WORDS_AT_ONCE 1001
/*
* Largest property that we'll accept when sending or receiving the
* selection:
*/
#define MAX_PROP_WORDS 100000
/*
* Forward declarations for procedures defined in this file:
*/
static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
XSelectionRequestEvent *eventPtr));
static int DefaultSelection _ANSI_ARGS_((TkWindow *winPtr,
Atom target, char *buffer, int maxBytes,
Atom *typePtr));
static int HandleTclCommand _ANSI_ARGS_((ClientData clientData,
int offset, char *buffer, int maxBytes));
static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
static void LostSelection _ANSI_ARGS_((ClientData clientData));
static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
Atom type, Tk_Window tkwin));
static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
Tk_Window tkwin, int *numLongsPtr));
static int SelGetProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *portion));
static void SelInit _ANSI_ARGS_((Tk_Window tkwin));
static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
XEvent *eventPtr));
static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
/*
*--------------------------------------------------------------
*
* Tk_CreateSelHandler --
*
* This procedure is called to register a procedure
* as the handler for selection requests of a particular
* target type on a particular window.
*
* 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 and target type, then it is replaced. Proc
* should have the following form:
*
* int
* proc(clientData, offset, buffer, maxBytes)
* ClientData clientData;
* int offset;
* char *buffer;
* int maxBytes;
* {
* }
*
* The clientData argument to proc will be the same as
* the clientData argument to this procedure. 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(tkwin, target, proc, clientData, format)
Tk_Window tkwin; /* Token for window. */
Atom target; /* The kind of selection conversions
* that can be handled by proc,
* e.g. TARGETS or XA_STRING. */
Tk_SelectionProc *proc; /* Procedure 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) {
SelInit(tkwin);
}
/*
* See if there's already a handler for this target 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->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((char *) selPtr->clientData);
}
break;
}
}
selPtr->target = target;
selPtr->format = format;
selPtr->proc = proc;
selPtr->clientData = clientData;
if (format == XA_STRING) {
selPtr->size = 8;
} else {
selPtr->size = 32;
}
}
/*
*----------------------------------------------------------------------
*
* Tk_DeleteSelHandler --
*
* Remove the selection handler for a given window and target,
* 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(tkwin, target)
Tk_Window tkwin; /* Token for window. */
Atom target; /* The target whose selection
* handler is to be removed. */
{
TkWindow *winPtr = (TkWindow *) tkwin;
register TkSelHandler *selPtr, *prevPtr;
for (selPtr = winPtr->selHandlerList, prevPtr = NULL;
selPtr != NULL; prevPtr = selPtr, selPtr = selPtr->nextPtr) {
if (selPtr->target == target) {
if (prevPtr == NULL) {
winPtr->selHandlerList = selPtr->nextPtr;
} else {
prevPtr->nextPtr = selPtr->nextPtr;
}
if (selPtr->proc == HandleTclCommand) {
ckfree((char *) selPtr->clientData);
}
ckfree((char *) selPtr);
return;
}
}
}
/*
*--------------------------------------------------------------
*
* Tk_OwnSelection --
*
* Arrange for tkwin to become the selection owner.
*
* Results:
* None.
*
* Side effects:
* From now on, requests for the selection will be
* directed to procedures 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).
*
*--------------------------------------------------------------
*/
void
Tk_OwnSelection(tkwin, proc, clientData)
Tk_Window tkwin; /* Window to become new selection
* owner. */
Tk_LostSelProc *proc; /* Procedure 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;
if (dispPtr->multipleAtom == None) {
SelInit(tkwin);
}
Tk_MakeWindowExist(tkwin);
winPtr->selClearProc = proc;
winPtr->selClearData = clientData;
if (dispPtr->selectionOwner != tkwin) {
TkWindow *ownerPtr = (TkWindow *) dispPtr->selectionOwner;
if ((ownerPtr != NULL)
&& (ownerPtr->selClearProc != NULL)) {
(*ownerPtr->selClearProc)(ownerPtr->selClearData);
ownerPtr->selClearProc = NULL;
}
}
dispPtr->selectionOwner = tkwin;
dispPtr->selectionSerial = NextRequest(winPtr->display);
dispPtr->selectionTime = TkCurrentTime(dispPtr);
XSetSelectionOwner(winPtr->display, XA_PRIMARY, winPtr->window,
dispPtr->selectionTime);
}
/*
*----------------------------------------------------------------------
*
* Tk_ClearSelection --
*
* Eliminate the selection on tkwin's display, if there is one.
*
* Results:
* None.
*
* Side effects:
* The selection is cleared, so that future requests to retrieve
* it will fail until some application owns it again..
*
*----------------------------------------------------------------------
*/
void
Tk_ClearSelection(tkwin)
Tk_Window tkwin; /* Window that selects a display. */
{
register TkWindow *winPtr = (TkWindow *) tkwin;
TkDisplay *dispPtr = winPtr->dispPtr;
if (dispPtr->multipleAtom == None) {
SelInit(tkwin);
}
if (dispPtr->selectionOwner != NULL) {
TkWindow *ownerPtr = (TkWindow *) dispPtr->selectionOwner;
if ((ownerPtr != NULL)
&& (ownerPtr->selClearProc != NULL)) {
(*ownerPtr->selClearProc)(ownerPtr->selClearData);
ownerPtr->selClearProc = NULL;
}
}
dispPtr->selectionOwner = NULL;
XSetSelectionOwner(winPtr->display, XA_PRIMARY, None, CurrentTime);
}
/*
*--------------------------------------------------------------
*
* Tk_GetSelection --
*
* Retrieve the selection and pass it off (in pieces,
* possibly) to a given procedure.
*
* 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 interp->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, interp, portion)
* 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 interp->result; the
* remainder of the selection retrieval will be aborted.
*
*--------------------------------------------------------------
*/
int
Tk_GetSelection(interp, tkwin, target, proc, clientData)
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 target; /* Desired form in which selection
* is to be returned. */
Tk_GetSelProc *proc; /* Procedure to call to process the
* selection, once it has been retrieved. */
ClientData clientData; /* Arbitrary value to pass to proc. */
{
RetrievalInfo retr;
TkWindow *winPtr = (TkWindow *) tkwin;
TkDisplay *dispPtr = winPtr->dispPtr;
if (dispPtr->multipleAtom == None) {
SelInit(tkwin);
}
Tk_MakeWindowExist(tkwin);
/*
* If the selection is owned by a window managed by this
* process, then call the retrieval procedure 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).
*/
if (dispPtr->selectionOwner != NULL) {
register TkSelHandler *selPtr;
int offset, result, count;
char buffer[TK_SEL_BYTES_AT_ONCE+1];
Time time;
/*
* Make sure that the selection predates the request
* time.
*/
time = TkCurrentTime(dispPtr);
if ((time < dispPtr->selectionTime)
&& (time != CurrentTime)
&& (dispPtr->selectionTime != CurrentTime)) {
interp->result = "selection changed before it could be retrieved";
return TCL_ERROR;
}
for (selPtr = ((TkWindow *) dispPtr->selectionOwner)->selHandlerList;
; selPtr = selPtr->nextPtr) {
if (selPtr == NULL) {
Atom type;
count = DefaultSelection((TkWindow *) dispPtr->selectionOwner,
target, buffer, TK_SEL_BYTES_AT_ONCE, &type);
if (count > TK_SEL_BYTES_AT_ONCE) {
panic("selection handler returned too many bytes");
}
if (count < 0) {
cantget:
Tcl_AppendResult(interp, "selection doesn't exist",
" or form \"", Tk_GetAtomName(tkwin, target),
"\" not defined", (char *) NULL);
return TCL_ERROR;
}
buffer[count] = 0;
return (*proc)(clientData, interp, buffer);
}
if (selPtr->target == target) {
break;
}
}
offset = 0;
while (1) {
count = (*selPtr->proc)(selPtr->clientData, offset,
buffer, TK_SEL_BYTES_AT_ONCE);
if (count < 0) {
goto cantget;
}
if (count > TK_SEL_BYTES_AT_ONCE) {
panic("selection handler returned too many bytes");
}
buffer[count] = '\0';
result = (*proc)(clientData, interp, buffer);
if (result != TCL_OK) {
return result;
}
if (count < TK_SEL_BYTES_AT_ONCE) {
return TCL_OK;
}
offset += count;
}
}
/*
* The selection is owned by some other process. To
* retrieve it, first record information about the retrieval
* in progress. Also, try to use a non-top-level window
* as the requestor (property changes on this window may
* be monitored by a window manager, which will waste time).
*/
retr.interp = interp;
if ((winPtr->flags & TK_TOP_LEVEL)
&& (winPtr->childList != NULL)) {
winPtr = winPtr->childList;
}
retr.winPtr = winPtr;
retr.property = XA_PRIMARY;
retr.target = target;
retr.proc = proc;
retr.clientData = clientData;
retr.result = -1;
retr.idleTime = 0;
retr.nextPtr = pendingRetrievals;
pendingRetrievals = &retr;
/*
* Initiate the request for the selection.
*/
Tk_MakeWindowExist((Tk_Window) winPtr);
XConvertSelection(winPtr->display, XA_PRIMARY, target,
retr.property, winPtr->window, TkCurrentTime(dispPtr));
/*
* Enter a loop processing X events until the selection
* has been retrieved and processed. If no response is
* received within a few seconds, then timeout.
*/
retr.timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
(ClientData) &retr);
while (retr.result == -1) {
Tk_DoOneEvent(0);
}
Tk_DeleteTimerHandler(retr.timeout);
/*
* Unregister the information about the selection retrieval
* in progress.
*/
if (pendingRetrievals == &retr) {
pendingRetrievals = retr.nextPtr;
} else {
RetrievalInfo *retrPtr;
for (retrPtr = pendingRetrievals; retrPtr != NULL;
retrPtr = retrPtr->nextPtr) {
if (retrPtr->nextPtr == &retr) {
retrPtr->nextPtr = retr.nextPtr;
break;
}
}
}
return retr.result;
}
/*
*--------------------------------------------------------------
*
* Tk_SelectionCmd --
*
* This procedure 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_SelectionCmd(clientData, interp, argc, argv)
ClientData clientData; /* Main window associated with
* interpreter. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
char **argv; /* Argument strings. */
{
Tk_Window tkwin = (Tk_Window) clientData;
int length;
char c;
if (argc < 2) {
sprintf(interp->result,
"wrong # args: should be \"%.50s option ?arg arg ...?\"",
argv[0]);
return TCL_ERROR;
}
c = argv[1][0];
length = strlen(argv[1]);
if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
Tk_Window window;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" clear window\"", (char *) NULL);
return TCL_ERROR;
}
window = Tk_NameToWindow(interp, argv[2], tkwin);
if (window == NULL) {
return TCL_ERROR;
}
Tk_ClearSelection(window);
return TCL_OK;
} else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
Atom target;
GetInfo getInfo;
int result;
if (argc > 3) {
sprintf(interp->result,
"too may args: should be \"%.50s get ?type?\"",
argv[0]);
return TCL_ERROR;
}
if (argc == 3) {
target = Tk_InternAtom(tkwin, argv[2]);
} else {
target = XA_STRING;
}
getInfo.string = (char *) ckalloc(100);
getInfo.bytesAvl = 100;
getInfo.bytesUsed = 0;
result = Tk_GetSelection(interp, tkwin, target, SelGetProc,
(ClientData) &getInfo);
if (result == TCL_OK) {
Tcl_SetResult(interp, getInfo.string, TCL_DYNAMIC);
} else {
ckfree(getInfo.string);
}
return result;
} else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
Tk_Window window;
Atom target, format;
register CommandInfo *cmdInfoPtr;
int cmdLength;
if ((argc < 4) || (argc > 6)) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" handle window command ?type? ?format?\"", (char *) NULL);
return TCL_ERROR;
}
window = Tk_NameToWindow(interp, argv[2], tkwin);
if (window == NULL) {
return TCL_ERROR;
}
if (argc > 4) {
target = Tk_InternAtom(window, argv[4]);
} else {
target = XA_STRING;
}
if (argc > 5) {
format = Tk_InternAtom(window, argv[5]);
} else {
format = XA_STRING;
}
cmdLength = strlen(argv[3]);
if (cmdLength == 0) {
Tk_DeleteSelHandler(window, target);
} else {
cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
sizeof(CommandInfo) - 3 + cmdLength));
cmdInfoPtr->interp = interp;
cmdInfoPtr->cmdLength = cmdLength;
strcpy(cmdInfoPtr->command, argv[3]);
Tk_CreateSelHandler(window, target, HandleTclCommand,
(ClientData) cmdInfoPtr, format);
}
return TCL_OK;
} else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
Tk_Window window;
register LostCommand *lostPtr;
int cmdLength;
if (argc > 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" own ?window? ?command?\"", (char *) NULL);
return TCL_ERROR;
}
if (argc == 2) {
window = ((TkWindow *) tkwin)->dispPtr->selectionOwner;
if (window != NULL) {
interp->result = Tk_PathName(window);
}
return TCL_OK;
}
window = Tk_NameToWindow(interp, argv[2], tkwin);
if (window == NULL) {
return TCL_ERROR;
}
if (argc == 3) {
Tk_OwnSelection(window, (Tk_LostSelProc *) NULL,
(ClientData) NULL);
return TCL_OK;
}
cmdLength = strlen(argv[3]);
lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
-3 + cmdLength));
lostPtr->interp = interp;
strcpy(lostPtr->command, argv[3]);
Tk_OwnSelection(window, LostSelection, (ClientData) lostPtr);
return TCL_OK;
} else {
sprintf(interp->result,
"bad option \"%.50s\": must be clear, get, handle, or own",
argv[1]);
return TCL_ERROR;
}
}
/*
*----------------------------------------------------------------------
*
* TkSelDeadWindow --
*
* This procedure 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(winPtr)
register TkWindow *winPtr; /* Window that's being deleted. */
{
register TkSelHandler *selPtr;
while (1) {
selPtr = winPtr->selHandlerList;
if (selPtr == NULL) {
break;
}
winPtr->selHandlerList = selPtr->nextPtr;
if (selPtr->proc == HandleTclCommand) {
ckfree((char *) selPtr->clientData);
}
ckfree((char *) selPtr);
}
if (winPtr->selClearProc == LostSelection) {
ckfree((char *) winPtr->selClearData);
}
winPtr->selClearProc = NULL;
if (winPtr->dispPtr->selectionOwner == (Tk_Window) winPtr) {
winPtr->dispPtr->selectionOwner = NULL;
}
}
/*
*----------------------------------------------------------------------
*
* SelInit --
*
* Initialize selection-related information for a display.
*
* Results:
* None.
*
* Side effects:
* Selection-related information is initialized.
*
*----------------------------------------------------------------------
*/
static void
SelInit(tkwin)
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, "APPLICATION");
dispPtr->windowNameAtom = Tk_InternAtom(tkwin, "WINDOW_NAME");
}
/*
*--------------------------------------------------------------
*
* TkSelEventProc --
*
* This procedure is invoked whenever a selection-related
* event occurs. It does the lion's share of the work
* in implementing the selection protocol.
*
* Results:
* None.
*
* Side effects:
* Lots: depends on the type of event.
*
*--------------------------------------------------------------
*/
void
TkSelEventProc(tkwin, eventPtr)
Tk_Window tkwin; /* Window for which event was
* targeted. */
register XEvent *eventPtr; /* X event: either SelectionClear,
* SelectionRequest, or
* SelectionNotify. */
{
register TkWindow *winPtr = (TkWindow *) tkwin;
/*
* Case #1: SelectionClear events. Invoke clear procedure
* for window that just lost the selection. This code is a
* bit tricky, because any callbacks to due 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.
*/
if (eventPtr->type == SelectionClear) {
if ((eventPtr->xselectionclear.selection == XA_PRIMARY)
&& (winPtr->dispPtr->selectionOwner == tkwin)
&& (eventPtr->xselectionclear.serial
>= winPtr->dispPtr->selectionSerial)
&& (winPtr->selClearProc != NULL)) {
(*winPtr->selClearProc)(winPtr->selClearData);
winPtr->selClearProc = NULL;
winPtr->dispPtr->selectionOwner = NULL;
}
return;
}
/*
* Case #2: SelectionNotify events. Call the relevant procedure
* to handle the incoming selection.
*/
if (eventPtr->type == SelectionNotify) {
register RetrievalInfo *retrPtr;
char *propInfo;
Atom type;
int format, result;
unsigned long numItems, bytesAfter;
for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
if (retrPtr == NULL) {
return;
}
if ((retrPtr->winPtr == winPtr)
&& (eventPtr->xselection.selection == XA_PRIMARY)
&& (retrPtr->target == eventPtr->xselection.target)
&& (retrPtr->result == -1)) {
if (retrPtr->property == eventPtr->xselection.property) {
break;
}
if (eventPtr->xselection.property == None) {
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
Tcl_AppendResult(retrPtr->interp,
"selection doesn't exist or form \"",
Tk_GetAtomName(tkwin, retrPtr->target),
"\" not defined", (char *) NULL);
retrPtr->result = TCL_ERROR;
return;
}
}
}
propInfo = NULL;
result = XGetWindowProperty(eventPtr->xselection.display,
eventPtr->xselection.requestor, retrPtr->property,
0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
&type, &format, &numItems, &bytesAfter,
(unsigned char **) &propInfo);
if ((result != Success) || (type == None)) {
return;
}
if (bytesAfter != 0) {
Tcl_SetResult(retrPtr->interp, "selection property too large",
TCL_STATIC);
retrPtr->result = TCL_ERROR;
XFree(propInfo);
return;
}
if ((type == XA_STRING) || (type == winPtr->dispPtr->textAtom)
|| (type == winPtr->dispPtr->compoundTextAtom)) {
if (format != 8) {
sprintf(retrPtr->interp->result,
"bad format for string selection: wanted \"8\", got \"%d\"",
format);
retrPtr->result = TCL_ERROR;
return;
}
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
retrPtr->interp, propInfo);
} else if (type == winPtr->dispPtr->incrAtom) {
/*
* It's a !?#@!?!! INCR-style reception. Arrange to receive
* the selection in pieces, using the ICCCM protocol, then
* hang around until either the selection is all here or a
* timeout occurs.
*/
retrPtr->idleTime = 0;
Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
(ClientData) retrPtr);
XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
retrPtr->property);
while (retrPtr->result == -1) {
Tk_DoOneEvent(0);
}
Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
(ClientData) retrPtr);
} else {
char *string;
if (format != 32) {
sprintf(retrPtr->interp->result,
"bad format for selection: wanted \"32\", got \"%d\"",
format);
retrPtr->result = TCL_ERROR;
return;
}
string = SelCvtFromX((long *) propInfo, (int) numItems, type,
(Tk_Window) winPtr);
retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
retrPtr->interp, string);
ckfree(string);
}
XFree(propInfo);
return;
}
/*
* Case #3: SelectionRequest events. Call ConvertSelection to
* do the dirty work.
*/
if ((eventPtr->type == SelectionRequest)
&& (eventPtr->xselectionrequest.selection == XA_PRIMARY)) {
ConvertSelection(winPtr, &eventPtr->xselectionrequest);
return;
}
}
/*
*--------------------------------------------------------------
*
* SelGetProc --
*
* This procedure 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 result currently stored
* in interp->result, and its memory area gets
* expanded if necessary.
*
*--------------------------------------------------------------
*/
/* ARGSUSED */
static int
SelGetProc(clientData, interp, portion)
ClientData clientData; /* Information about partially-
* assembled result. */
Tcl_Interp *interp; /* Interpreter used for error
* reporting (not used). */
char *portion; /* New information to be appended. */
{
register GetInfo *getInfoPtr = (GetInfo *) clientData;
int newLength;
newLength = strlen(portion) + getInfoPtr->bytesUsed;
/*
* Grow the result area if we've run out of space.
*/
if (newLength >= getInfoPtr->bytesAvl) {
char *newString;
getInfoPtr->bytesAvl *= 2;
if (getInfoPtr->bytesAvl <= newLength) {
getInfoPtr->bytesAvl = newLength + 1;
}
newString = (char *) ckalloc((unsigned) getInfoPtr->bytesAvl);
memcpy((VOID *) newString, (VOID *) getInfoPtr->string,
getInfoPtr->bytesUsed);
ckfree(getInfoPtr->string);
getInfoPtr->string = newString;
}
/*
* Append the new data to what was already there.
*/
strcpy(getInfoPtr->string + getInfoPtr->bytesUsed, portion);
getInfoPtr->bytesUsed = newLength;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* SelCvtToX --
*
* Given a selection represented as a string (the normal Tcl form),
* convert it to the ICCCM-mandated format for X, depending on
* the type argument. This procedure and SelCvtFromX are inverses.
*
* Results:
* The return value is a malloc'ed buffer holding a value
* equivalent to "string", but formatted as for "type". It is
* the caller's responsibility to free the string when done with
* it. The word at *numLongsPtr is filled in with the number of
* 32-bit words returned in the result.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static long *
SelCvtToX(string, type, tkwin, numLongsPtr)
char *string; /* String representation of selection. */
Atom type; /* Atom specifying the X format that is
* desired for the selection. Should not
* be XA_STRING (if so, don't bother calling
* this procedure at all). */
Tk_Window tkwin; /* Window that governs atom conversion. */
int *numLongsPtr; /* Number of 32-bit words contained in the
* result. */
{
register char *p;
char *field;
int numFields;
long *propPtr, *longPtr;
#define MAX_ATOM_NAME_LENGTH 100
char atomName[MAX_ATOM_NAME_LENGTH+1];
/*
* The string is assumed to consist of fields separated by spaces.
* The property gets generated by converting each field to an
* integer number, in one of two ways:
* 1. If type is XA_ATOM, convert each field to its corresponding
* atom.
* 2. If type is anything else, convert each field from an ASCII number
* to a 32-bit binary number.
*/
numFields = 1;
for (p = string; *p != 0; p++) {
if (isspace(UCHAR(*p))) {
numFields++;
}
}
propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
/*
* Convert the fields one-by-one.
*/
for (longPtr = propPtr, *numLongsPtr = 0, p = string;
; longPtr++, (*numLongsPtr)++) {
while (isspace(UCHAR(*p))) {
p++;
}
if (*p == 0) {
break;
}
field = p;
while ((*p != 0) && !isspace(UCHAR(*p))) {
p++;
}
if (type == XA_ATOM) {
int length;
length = p - field;
if (length > MAX_ATOM_NAME_LENGTH) {
length = MAX_ATOM_NAME_LENGTH;
}
strncpy(atomName, field, length);
atomName[length] = 0;
*longPtr = (long) Tk_InternAtom(tkwin, atomName);
} else {
char *dummy;
*longPtr = strtol(field, &dummy, 0);
}
}
return propPtr;
}
/*
*----------------------------------------------------------------------
*
* SelCvtFromX --
*
* Given an X property value, formatted as a collection of 32-bit
* values according to "type" and the ICCCM conventions, convert
* the value to a string suitable for manipulation by Tcl. This
* procedure is the inverse of SelCvtToX.
*
* Results:
* The return value is the string equivalent of "property". It is
* malloc-ed and should be freed by the caller when no longer
* needed.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static char *
SelCvtFromX(propPtr, numValues, type, tkwin)
register long *propPtr; /* Property value from X. */
int numValues; /* Number of 32-bit values in property. */
Atom type; /* Type of property Should not be
* XA_STRING (if so, don't bother calling
* this procedure at all). */
Tk_Window tkwin; /* Window to use for atom conversion. */
{
char *result;
int resultSpace, curSize, fieldSize;
char *atomName;
/*
* Convert each long in the property to a string value, which is
* either the name of an atom (if type is XA_ATOM) or a hexadecimal
* string. Make an initial guess about the size of the result, but
* be prepared to enlarge the result if necessary.
*/
resultSpace = 12*numValues;
curSize = 0;
atomName = ""; /* Not needed, but eliminates compiler warning. */
result = (char *) ckalloc((unsigned) resultSpace);
for ( ; numValues > 0; propPtr++, numValues--) {
if (type == XA_ATOM) {
atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
fieldSize = strlen(atomName) + 1;
} else {
fieldSize = 12;
}
if (curSize+fieldSize >= resultSpace) {
char *newResult;
resultSpace *= 2;
if (curSize+fieldSize >= resultSpace) {
resultSpace = curSize + fieldSize + 1;
}
newResult = (char *) ckalloc((unsigned) resultSpace);
strcpy(newResult, result);
ckfree(result);
result = newResult;
}
if (curSize != 0) {
result[curSize] = ' ';
curSize++;
}
if (type == XA_ATOM) {
strcpy(result+curSize, atomName);
} else {
sprintf(result+curSize, "%#x", *propPtr);
}
curSize += strlen(result+curSize);
}
return result;
}
/*
*----------------------------------------------------------------------
*
* ConvertSelection --
*
* This procedure is invoked to handle SelectionRequest events.
* It responds to the requests, obeying the ICCCM protocols.
*
* Results:
* None.
*
* Side effects:
* Properties are created for the selection requestor, and a
* SelectionNotify event is generated for the selection
* requestor. In the event of long selections, this procedure
* implements INCR-mode transfers, using the ICCCM protocol.
*
*----------------------------------------------------------------------
*/
static void
ConvertSelection(winPtr, eventPtr)
TkWindow *winPtr; /* Window that owns selection. */
register XSelectionRequestEvent *eventPtr;
/* Event describing request. */
{
XSelectionEvent reply; /* Used to notify requestor that
* selection info is ready. */
int multiple; /* Non-zero means a MULTIPLE request
* is being handled. */
IncrInfo info; /* State of selection conversion. */
Atom singleInfo[2]; /* info.multAtoms points here except
* for multiple conversions. */
int i;
Tk_ErrorHandler errorHandler;
errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
(int (*)()) NULL, (ClientData) NULL);
/*
* Initialize the reply event.
*/
reply.type = SelectionNotify;
reply.serial = 0;
reply.send_event = True;
reply.display = eventPtr->display;
reply.requestor = eventPtr->requestor;
reply.selection = XA_PRIMARY;
reply.target = eventPtr->target;
reply.property = eventPtr->property;
if (reply.property == None) {
reply.property = reply.target;
}
reply.time = eventPtr->time;
/*
* Watch out for races between conversion requests and
* selection ownership changes: reject the conversion
* request if it's for the wrong window or the wrong
* time.
*/
if ((winPtr->dispPtr->selectionOwner != (Tk_Window) winPtr)
|| ((eventPtr->time < winPtr->dispPtr->selectionTime)
&& (eventPtr->time != CurrentTime)
&& (winPtr->dispPtr->selectionTime != CurrentTime))) {
goto refuse;
}
/*
* Figure out which kind(s) of conversion to perform. If handling
* a MULTIPLE conversion, then read the property describing which
* conversions to perform.
*/
info.winPtr = winPtr;
if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
multiple = 0;
singleInfo[0] = reply.target;
singleInfo[1] = reply.property;
info.multAtoms = singleInfo;
info.numConversions = 1;
} else {
Atom type;
int format, result;
unsigned long bytesAfter;
multiple = 1;
info.multAtoms = NULL;
if (eventPtr->property == None) {
goto refuse;
}
result = XGetWindowProperty(eventPtr->display,
eventPtr->requestor, eventPtr->property,
0, MAX_PROP_WORDS, False, XA_ATOM,
&type, &format, &info.numConversions, &bytesAfter,
(unsigned char **) &info.multAtoms);
if ((result != Success) || (bytesAfter != 0) || (format != 32)
|| (type == None)) {
if (info.multAtoms != NULL) {
XFree((char *) info.multAtoms);
}
goto refuse;
}
info.numConversions /= 2; /* Two atoms per conversion. */
}
/*
* Loop through all of the requested conversions, and either return
* the entire converted selection, if it can be returned in a single
* bunch, or return INCR information only (the actual selection will
* be returned below).
*/
info.offsets = (int *) ckalloc((unsigned) (info.numConversions*sizeof(int)));
info.numIncrs = 0;
for (i = 0; i < info.numConversions; i++) {
Atom target, property;
long buffer[TK_SEL_WORDS_AT_ONCE];
register TkSelHandler *selPtr;
target = info.multAtoms[2*i];
property = info.multAtoms[2*i + 1];
info.offsets[i] = -1;
for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
int numItems, format;
char *propPtr;
Atom type;
if (selPtr == NULL) {
/*
* Nobody seems to know about this kind of request. If
* it's of a sort that we can handle without any help, do
* it. Otherwise mark the request as an errror.
*/
numItems = DefaultSelection(winPtr, target, (char *) buffer,
TK_SEL_BYTES_AT_ONCE, &type);
if (numItems >= 0) {
goto gotStuff;
}
info.multAtoms[2*i + 1] = None;
break;
} else if (selPtr->target == target) {
numItems = (*selPtr->proc)(selPtr->clientData, 0,
(char *) buffer, TK_SEL_BYTES_AT_ONCE);
if (numItems < 0) {
info.multAtoms[2*i + 1] = None;
break;
}
if (numItems > TK_SEL_BYTES_AT_ONCE) {
panic("selection handler returned too many bytes");
}
((char *) buffer)[numItems] = '\0';
type = selPtr->format;
} else {
continue;
}
gotStuff:
if (numItems == TK_SEL_BYTES_AT_ONCE) {
info.numIncrs++;
type = winPtr->dispPtr->incrAtom;
buffer[0] = 10; /* Guess at # items avl. */
numItems = 1;
propPtr = (char *) buffer;
format = 32;
info.offsets[i] = 0;
} else if (type == XA_STRING) {
propPtr = (char *) buffer;
format = 8;
} else {
propPtr = (char *) SelCvtToX((char *) buffer,
type, (Tk_Window) winPtr, &numItems);
format = 32;
}
XChangeProperty(reply.display, reply.requestor,
property, type, format, PropModeReplace,
(unsigned char *) propPtr, numItems);
if (propPtr != (char *) buffer) {
ckfree(propPtr);
}
break;
}
}
/*
* Send an event back to the requestor to indicate that the
* first stage of conversion is complete (everything is done
* except for long conversions that have to be done in INCR
* mode).
*/
if (info.numIncrs > 0) {
XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
info.timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
(ClientData) &info);
info.idleTime = 0;
info.reqWindow = reply.requestor;
info.time = winPtr->dispPtr->selectionTime;
info.nextPtr = pendingIncrs;
pendingIncrs = &info;
}
if (multiple) {
XChangeProperty(reply.display, reply.requestor, reply.property,
XA_ATOM, 32, PropModeReplace,
(unsigned char *) info.multAtoms,
(int) info.numConversions*2);
} else {
/*
* Not a MULTIPLE request. The first property in "multAtoms"
* got set to None if there was an error in conversion.
*/
reply.property = info.multAtoms[1];
}
XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
Tk_DeleteErrorHandler(errorHandler);
/*
* Handle any remaining INCR-mode transfers. This all happens
* in callbacks to TkSelPropProc, so just wait until the number
* of uncompleted INCR transfers drops to zero.
*/
if (info.numIncrs > 0) {
IncrInfo *infoPtr2;
while (info.numIncrs > 0) {
Tk_DoOneEvent(0);
}
Tk_DeleteTimerHandler(info.timeout);
errorHandler = Tk_CreateErrorHandler(winPtr->display,
-1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
XSelectInput(reply.display, reply.requestor, 0L);
Tk_DeleteErrorHandler(errorHandler);
if (pendingIncrs == &info) {
pendingIncrs = info.nextPtr;
} else {
for (infoPtr2 = pendingIncrs; infoPtr2 != NULL;
infoPtr2 = infoPtr2->nextPtr) {
if (infoPtr2->nextPtr == &info) {
infoPtr2->nextPtr = info.nextPtr;
break;
}
}
}
}
/*
* All done. Cleanup and return.
*/
ckfree((char *) info.offsets);
if (multiple) {
XFree((char *) info.multAtoms);
}
return;
/*
* An error occurred. Send back a refusal message.
*/
refuse:
reply.property = None;
XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
Tk_DeleteErrorHandler(errorHandler);
return;
}
/*
*----------------------------------------------------------------------
*
* SelRcvIncrProc --
*
* This procedure handles the INCR protocol on the receiving
* side. It is invoked in response to property changes on
* the requestor's window (which hopefully are because a new
* chunk of the selection arrived).
*
* Results:
* None.
*
* Side effects:
* If a new piece of selection has arrived, a procedure is
* invoked to deal with that piece. When the whole selection
* is here, a flag is left for the higher-level procedure that
* initiated the selection retrieval.
*
*----------------------------------------------------------------------
*/
static void
SelRcvIncrProc(clientData, eventPtr)
ClientData clientData; /* Information about retrieval. */
register XEvent *eventPtr; /* X PropertyChange event. */
{
register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
char *propInfo;
Atom type;
int format, result;
unsigned long numItems, bytesAfter;
if ((eventPtr->xproperty.atom != retrPtr->property)
|| (eventPtr->xproperty.state != PropertyNewValue)
|| (retrPtr->result != -1)) {
return;
}
propInfo = NULL;
result = XGetWindowProperty(eventPtr->xproperty.display,
eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
True, (Atom) AnyPropertyType, &type, &format, &numItems,
&bytesAfter, (unsigned char **) &propInfo);
if ((result != Success) || (type == None)) {
return;
}
if (bytesAfter != 0) {
Tcl_SetResult(retrPtr->interp, "selection property too large",
TCL_STATIC);
retrPtr->result = TCL_ERROR;
goto done;
}
if (numItems == 0) {
retrPtr->result = TCL_OK;
} else if ((type == XA_STRING)
|| (type == retrPtr->winPtr->dispPtr->textAtom)
|| (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
if (format != 8) {
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
sprintf(retrPtr->interp->result,
"bad format for string selection: wanted \"8\", got \"%d\"",
format);
retrPtr->result = TCL_ERROR;
goto done;
}
result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
propInfo);
if (result != TCL_OK) {
retrPtr->result = result;
}
} else {
char *string;
if (format != 32) {
Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
sprintf(retrPtr->interp->result,
"bad format for selection: wanted \"32\", got \"%d\"",
format);
retrPtr->result = TCL_ERROR;
goto done;
}
string = SelCvtFromX((long *) propInfo, (int) numItems, type,
(Tk_Window) retrPtr->winPtr);
result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
string);
if (result != TCL_OK) {
retrPtr->result = result;
}
ckfree(string);
}
done:
XFree(propInfo);
retrPtr->idleTime = 0;
}
/*
*----------------------------------------------------------------------
*
* TkSelPropProc --
*
* This procedure is invoked when property-change events
* occur on windows not known to the toolkit. Its function
* is to implement the sending side of the INCR selection
* retrieval protocol when the selection requestor deletes
* the property containing a part of the selection.
*
* Results:
* None.
*
* Side effects:
* If the property that is receiving the selection was just
* deleted, then a new piece of the selection is fetched and
* placed in the property, until eventually there's no more
* selection to fetch.
*
*----------------------------------------------------------------------
*/
void
TkSelPropProc(eventPtr)
register XEvent *eventPtr; /* X PropertyChange event. */
{
register IncrInfo *infoPtr;
int i, format;
Atom target;
register TkSelHandler *selPtr;
long buffer[TK_SEL_WORDS_AT_ONCE];
int numItems;
char *propPtr;
Tk_ErrorHandler errorHandler;
/*
* See if this event announces the deletion of a property being
* used for an INCR transfer. If so, then add the next chunk of
* data to the property.
*/
if (eventPtr->xproperty.state != PropertyDelete) {
return;
}
for (infoPtr = pendingIncrs; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
/*
* To avoid races between selection conversions and
* changes in selection ownership, make sure the window
* and timestamp for the current selection match those
* in the INCR request.
*/
if ((infoPtr->reqWindow != eventPtr->xproperty.window)
|| (infoPtr->winPtr->dispPtr->selectionOwner
!= (Tk_Window) infoPtr->winPtr)
|| (infoPtr->winPtr->dispPtr->selectionTime
!= infoPtr->time)) {
continue;
}
for (i = 0; i < infoPtr->numConversions; i++) {
if ((eventPtr->xproperty.atom != infoPtr->multAtoms[2*i + 1])
|| (infoPtr->offsets[i] == -1)){
continue;
}
target = infoPtr->multAtoms[2*i];
infoPtr->idleTime = 0;
for (selPtr = infoPtr->winPtr->selHandlerList; ;
selPtr = selPtr->nextPtr) {
if (selPtr == NULL) {
infoPtr->multAtoms[2*i + 1] = None;
infoPtr->offsets[i] = -1;
infoPtr->numIncrs --;
return;
}
if (selPtr->target == target) {
if (infoPtr->offsets[i] == -2) {
numItems = 0;
((char *) buffer)[0] = 0;
} else {
numItems = (*selPtr->proc)(selPtr->clientData,
infoPtr->offsets[i], (char *) buffer,
TK_SEL_BYTES_AT_ONCE);
if (numItems > TK_SEL_BYTES_AT_ONCE) {
panic("selection handler returned too many bytes");
} else {
if (numItems < 0) {
numItems = 0;
}
}
((char *) buffer)[numItems] = '\0';
}
if (numItems < TK_SEL_BYTES_AT_ONCE) {
if (numItems <= 0) {
infoPtr->offsets[i] = -1;
infoPtr->numIncrs--;
} else {
infoPtr->offsets[i] = -2;
}
} else {
infoPtr->offsets[i] += numItems;
}
if (selPtr->format == XA_STRING) {
propPtr = (char *) buffer;
format = 8;
} else {
propPtr = (char *) SelCvtToX((char *) buffer,
selPtr->format,
(Tk_Window) infoPtr->winPtr,
&numItems);
format = 32;
}
errorHandler = Tk_CreateErrorHandler(
eventPtr->xproperty.display, -1, -1, -1,
(int (*)()) NULL, (ClientData) NULL);
XChangeProperty(eventPtr->xproperty.display,
eventPtr->xproperty.window,
eventPtr->xproperty.atom, selPtr->format,
format, PropModeReplace,
(unsigned char *) propPtr, numItems);
Tk_DeleteErrorHandler(errorHandler);
if (propPtr != (char *) buffer) {
ckfree(propPtr);
}
return;
}
}
}
}
}
/*
*----------------------------------------------------------------------
*
* HandleTclCommand --
*
* This procedure 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, offset, buffer, maxBytes)
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. */
{
register CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
char *oldResultString;
Tcl_FreeProc *oldFreeProc;
int spaceNeeded, length;
#define MAX_STATIC_SIZE 100
char staticSpace[MAX_STATIC_SIZE];
char *command;
/*
* First, generate a command by taking the command string
* and appending the offset and maximum # of bytes.
*/
spaceNeeded = cmdInfoPtr->cmdLength + 30;
if (spaceNeeded < MAX_STATIC_SIZE) {
command = staticSpace;
} else {
command = (char *) ckalloc((unsigned) spaceNeeded);
}
sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
/*
* Execute the command. Be sure to restore the state of the
* interpreter after executing the command.
*/
oldFreeProc = cmdInfoPtr->interp->freeProc;
if (oldFreeProc != 0) {
oldResultString = cmdInfoPtr->interp->result;
} else {
oldResultString = (char *) ckalloc((unsigned)
(strlen(cmdInfoPtr->interp->result) + 1));
strcpy(oldResultString, cmdInfoPtr->interp->result);
oldFreeProc = TCL_DYNAMIC;
}
cmdInfoPtr->interp->freeProc = 0;
if (TkCopyAndGlobalEval(cmdInfoPtr->interp, command) == TCL_OK) {
length = strlen(cmdInfoPtr->interp->result);
if (length > maxBytes) {
length = maxBytes;
}
memcpy((VOID *) buffer, (VOID *) cmdInfoPtr->interp->result, length);
buffer[length] = '\0';
} else {
length = -1;
}
Tcl_FreeResult(cmdInfoPtr->interp);
cmdInfoPtr->interp->result = oldResultString;
cmdInfoPtr->interp->freeProc = oldFreeProc;
if (command != staticSpace) {
ckfree(command);
}
return length;
}
/*
*----------------------------------------------------------------------
*
* SelTimeoutProc --
*
* This procedure is invoked once every second while waiting for
* the selection to be returned. After a while it gives up and
* aborts the selection retrieval.
*
* Results:
* None.
*
* Side effects:
* A new timer callback is created to call us again in another
* second, unless time has expired, in which case an error is
* recorded for the retrieval.
*
*----------------------------------------------------------------------
*/
static void
SelTimeoutProc(clientData)
ClientData clientData; /* Information about retrieval
* in progress. */
{
register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
/*
* Make sure that the retrieval is still in progress. Then
* see how long it's been since any sort of response was received
* from the other side.
*/
if (retrPtr->result != -1) {
return;
}
retrPtr->idleTime++;
if (retrPtr->idleTime >= 5) {
/*
* Use a careful procedure to store the error message, because
* the result could already be partially filled in with a partial
* selection return.
*/
Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
TCL_STATIC);
retrPtr->result = TCL_ERROR;
} else {
retrPtr->timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
(ClientData) retrPtr);
}
}
/*
*----------------------------------------------------------------------
*
* IncrTimeoutProc --
*
* This procedure is invoked once a second while sending the
* selection to a requestor in INCR mode. After a while it
* gives up and aborts the selection operation.
*
* Results:
* None.
*
* Side effects:
* A new timeout gets registered so that this procedure gets
* called again in another second, unless too many seconds
* have elapsed, in which case infoPtr is marked as "all done".
*
*----------------------------------------------------------------------
*/
static void
IncrTimeoutProc(clientData)
ClientData clientData; /* Information about INCR-mode
* selection retrieval for which
* we are selection owner. */
{
register IncrInfo *infoPtr = (IncrInfo *) clientData;
infoPtr->idleTime++;
if (infoPtr->idleTime >= 5) {
infoPtr->numIncrs = 0;
} else {
infoPtr->timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
(ClientData) infoPtr);
}
}
/*
*----------------------------------------------------------------------
*
* DefaultSelection --
*
* This procedure 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 procedure,
* 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.
*
*----------------------------------------------------------------------
*/
static int
DefaultSelection(winPtr, target, buffer, maxBytes, typePtr)
TkWindow *winPtr; /* Window that owns selection. */
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. */
{
if (target == winPtr->dispPtr->timestampAtom) {
if (maxBytes < 20) {
return -1;
}
sprintf(buffer, "%#x", winPtr->dispPtr->selectionTime);
*typePtr = XA_INTEGER;
return strlen(buffer);
}
if (target == winPtr->dispPtr->targetsAtom) {
register TkSelHandler *selPtr;
char *atomString;
int length, atomLength;
if (maxBytes < 50) {
return -1;
}
strcpy(buffer, "APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME");
length = strlen(buffer);
for (selPtr = winPtr->selHandlerList; selPtr != NULL;
selPtr = selPtr->nextPtr) {
atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target);
atomLength = strlen(atomString) + 1;
if ((length + atomLength) >= maxBytes) {
return -1;
}
sprintf(buffer+length, " %s", atomString);
length += atomLength;
}
*typePtr = XA_ATOM;
return length;
}
if (target == winPtr->dispPtr->applicationAtom) {
int length;
char *name = winPtr->mainPtr->winPtr->nameUid;
length = strlen(name);
if (maxBytes <= length) {
return -1;
}
strcpy(buffer, name);
*typePtr = XA_STRING;
return length;
}
if (target == winPtr->dispPtr->windowNameAtom) {
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 procedure 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 clientData; /* Pointer to zCommandInfo structure. */
{
LostCommand *lostPtr = (LostCommand *) clientData;
char *oldResultString;
Tcl_FreeProc *oldFreeProc;
/*
* Execute the command. Save the interpreter's result, if any, and
* restore it after executing the command.
*/
oldFreeProc = lostPtr->interp->freeProc;
if (oldFreeProc != 0) {
oldResultString = lostPtr->interp->result;
} else {
oldResultString = (char *) ckalloc((unsigned)
(strlen(lostPtr->interp->result) + 1));
strcpy(oldResultString, lostPtr->interp->result);
oldFreeProc = TCL_DYNAMIC;
}
lostPtr->interp->freeProc = 0;
if (TkCopyAndGlobalEval(lostPtr->interp, lostPtr->command) != TCL_OK) {
Tk_BackgroundError(lostPtr->interp);
}
Tcl_FreeResult(lostPtr->interp);
lostPtr->interp->result = oldResultString;
lostPtr->interp->freeProc = oldFreeProc;
/*
* Free the storage for the command, since we're done with it now.
*/
ckfree((char *) lostPtr);
}
Reference in New Issue Copy Permalink