Import Micropolis from http://www.donhopkins.com/home/micropolis/

[micropolis] / src / tk / tkselect.c

/* 
 * tkSelect.c --
 *
 *      This file manages the selection for the Tk toolkit,
 *      translating between the standard X ICCCM conventions
 *      and Tcl commands.
 *
 * Copyright 1990 Regents of the University of California.
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appear in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#ifndef lint
static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSelect.c,v 1.27 92/08/10 15:03:03 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;

/*
 * 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 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));
\f
/*
 *--------------------------------------------------------------
 *
 * 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;
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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);
    }

    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);
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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);
    }

    /*
     * 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.
     */

    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;
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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 *cmd = argv[0];
    char c;

    if (argc < 2) {
        sprintf(interp->result,
                "wrong # args: should be \"%.50s [-window win] option ?arg arg ...?\"",
                cmd);
        return TCL_ERROR;
    }

    argc--; argv++;
    c = argv[0][0];
    length = strlen(argv[0]);

    if ((c == '-') && (strncmp(argv[0], "-window", length) == 0)) {
      if ((argc < 2) ||
          ((tkwin = Tk_NameToWindow(interp, argv[1], tkwin)) == NULL)) {
            sprintf(interp->result, "bad arg to %s -window", cmd);
            return TCL_ERROR;
      }
      argc -= 2; argv += 2;

      if (argc == 0) {
        sprintf(interp->result, "not enough args to %s", cmd);
        return TCL_ERROR;
      }

      c = argv[0][0];
      length = strlen(argv[0]);
    }

    if ((c == 'g') && (strncmp(argv[0], "get", length) == 0)) {
        Atom target;
        GetInfo getInfo;
        int result;

        argc--; argv++;

        if (argc > 1) {
            sprintf(interp->result,
                    "too may args: should be \"%.50s get ?type?\"",
                    cmd);
            return TCL_ERROR;
        }
        if (argc == 1) {
            target = Tk_InternAtom(tkwin, argv[0]);
        } 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[0], "handle", length) == 0)) {
        Tk_Window window;
        Atom target, format;
        register CommandInfo *cmdInfoPtr;
        int cmdLength;

        argc--; argv++;

        if ((argc < 2) || (argc > 4)) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", cmd,
                    " handle window command ?type? ?format?\"", (char *) NULL);
            return TCL_ERROR;
        }
        window = Tk_NameToWindow(interp, argv[0], tkwin);
        if (window == NULL) {
            return TCL_ERROR;
        }
        if (argc > 2) {
            target = Tk_InternAtom(window, argv[2]);
        } else {
            target = XA_STRING;
        }
        if (argc > 3) {
            format = Tk_InternAtom(window, argv[3]);
        } else {
            format = XA_STRING;
        }
        cmdLength = strlen(argv[1]);
        cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (sizeof(CommandInfo)
                + cmdLength));
        cmdInfoPtr->interp = interp;
        cmdInfoPtr->cmdLength = cmdLength;
        strcpy(cmdInfoPtr->command, argv[1]);
        Tk_CreateSelHandler(window, target, HandleTclCommand,
                (ClientData) cmdInfoPtr, format);
        return TCL_OK;
    } else {
        sprintf(interp->result,
                "bad option to \"%.50s\":  must be get or handle",
                cmd);
        return TCL_ERROR;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
        ckfree((char *) selPtr);
    }
    winPtr->selClearProc = NULL;

    if (winPtr->dispPtr->selectionOwner == (Tk_Window) winPtr) {
        winPtr->dispPtr->selectionOwner = NULL;
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * SelInit --
 *
 *      Initialize selection-related information for a display.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      .
 *
 *----------------------------------------------------------------------
 */

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");
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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;
    }
}
\f
/*
 *--------------------------------------------------------------
 *
 * 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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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(*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(*p)) {
            p++;
        }
        if (*p == 0) {
            break;
        }
        field = p;
        while ((*p != 0) && !isspace(*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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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;
                }
            }
        }
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 * 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 (Tcl_GlobalEval(cmdInfoPtr->interp, command) == TCL_OK) {
        length = strlen(cmdInfoPtr->interp->result);
    } else {
        length = 0;
    }
    if (length > maxBytes) {
        length = maxBytes;
    }
    memcpy((VOID *) buffer, (VOID *) cmdInfoPtr->interp->result, length);
    buffer[length] = '\0';
    Tcl_FreeResult(cmdInfoPtr->interp);
    cmdInfoPtr->interp->result = oldResultString;
    cmdInfoPtr->interp->freeProc = oldFreeProc;

    if (command != staticSpace) {
        ckfree(command);
    }

    return length;
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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);
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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);
    }
}
\f
/*
 *----------------------------------------------------------------------
 *
 * 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, "TARGETS MULTIPLE TIMESTAMP");
        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;
    }

    return -1;
}