home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / tcl / tk3.3b1 / tkSelect.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-06-26  |  60.5 KB  |  2,118 lines
  1. /* 
  2.  * tkSelect.c --
  3.  *
  4.  *    This file manages the selection for the Tk toolkit,
  5.  *    translating between the standard X ICCCM conventions
  6.  *    and Tcl commands.
  7.  *
  8.  * Copyright (c) 1990-1993 The Regents of the University of California.
  9.  * All rights reserved.
  10.  *
  11.  * Permission is hereby granted, without written agreement and without
  12.  * license or royalty fees, to use, copy, modify, and distribute this
  13.  * software and its documentation for any purpose, provided that the
  14.  * above copyright notice and the following two paragraphs appear in
  15.  * all copies of this software.
  16.  * 
  17.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  18.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  19.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  20.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  21.  *
  22.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  23.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  24.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  25.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  26.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  27.  */
  28.  
  29. #ifndef lint
  30. static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSelect.c,v 1.33 93/06/26 17:38:28 ouster Exp $ SPRITE (Berkeley)";
  31. #endif
  32.  
  33. #include "tkConfig.h"
  34. #include "tkInt.h"
  35.  
  36. /*
  37.  * When the selection is being retrieved, one of the following
  38.  * structures is present on a list of pending selection retrievals.
  39.  * The structure is used to communicate between the background
  40.  * procedure that requests the selection and the foreground
  41.  * event handler that processes the events in which the selection
  42.  * is returned.  There is a list of such structures so that there
  43.  * can be multiple simultaneous selection retrievals (e.g. on
  44.  * different displays).
  45.  */
  46.  
  47. typedef struct RetrievalInfo {
  48.     Tcl_Interp *interp;        /* Interpreter for error reporting. */
  49.     TkWindow *winPtr;        /* Window used as requestor for
  50.                  * selection. */
  51.     Atom property;        /* Property where selection will appear. */
  52.     Atom target;        /* Desired form for selection. */
  53.     int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
  54.     char *portion));    /* Procedure to call to handle pieces
  55.                  * of selection. */
  56.     ClientData clientData;    /* Argument for proc. */
  57.     int result;            /* Initially -1.  Set to a Tcl
  58.                  * return value once the selection
  59.                  * has been retrieved. */
  60.     Tk_TimerToken timeout;    /* Token for current timeout procedure. */
  61.     int idleTime;        /* Number of seconds that have gone by
  62.                  * without hearing anything from the
  63.                  * selection owner. */
  64.     struct RetrievalInfo *nextPtr;
  65.                 /* Next in list of all pending
  66.                  * selection retrievals.  NULL means
  67.                  * end of list. */
  68. } RetrievalInfo;
  69.  
  70. static RetrievalInfo *pendingRetrievals = NULL;
  71.                 /* List of all retrievals currently
  72.                  * being waited for. */
  73.  
  74. /*
  75.  * When "selection get" is being used to retrieve the selection,
  76.  * the following data structure is used for communication between
  77.  * Tk_SelectionCmd and SelGetProc.  Its purpose is to keep track
  78.  * of the selection contents, which are gradually assembled in a
  79.  * string.
  80.  */
  81.  
  82. typedef struct {
  83.     char *string;        /* Contents of selection are
  84.                  * here.  This space is malloc-ed. */
  85.     int bytesAvl;        /* Total number of bytes available
  86.                  * at string. */
  87.     int bytesUsed;        /* Bytes currently in use in string,
  88.                  * not including the terminating
  89.                  * NULL. */
  90. } GetInfo;
  91.  
  92. /*
  93.  * When handling INCR-style selection retrievals, the selection owner
  94.  * uses the following data structure to communicate between the
  95.  * ConvertSelection procedure and TkSelPropProc.
  96.  */
  97.  
  98. typedef struct IncrInfo {
  99.     TkWindow *winPtr;        /* Window that owns selection. */
  100.     Atom *multAtoms;        /* Information about conversions to
  101.                  * perform:  one or more pairs of
  102.                  * (target, property).  This either
  103.                  * points to a retrieved  property (for
  104.                  * MULTIPLE retrievals) or to a static
  105.                  * array. */
  106.     unsigned long numConversions;
  107.                 /* Number of entries in offsets (same as
  108.                  * # of pairs in multAtoms). */
  109.     int *offsets;        /* One entry for each pair in
  110.                  * multAtoms;  -1 means all data has
  111.                  * been transferred for this
  112.                  * conversion.  -2 means only the
  113.                  * final zero-length transfer still
  114.                  * has to be done.  Otherwise it is the
  115.                  * offset of the next chunk of data
  116.                  * to transfer.  This array is malloc-ed. */
  117.     int numIncrs;        /* Number of entries in offsets that
  118.                  * aren't -1 (i.e. # of INCR-mode transfers
  119.                  * not yet completed). */
  120.     Tk_TimerToken timeout;    /* Token for timer procedure. */
  121.     int idleTime;        /* Number of seconds since we heard
  122.                  * anything from the selection
  123.                  * requestor. */
  124.     Window reqWindow;        /* Requestor's window id. */
  125.     Time time;            /* Timestamp corresponding to
  126.                  * selection at beginning of request;
  127.                  * used to abort transfer if selection
  128.                  * changes. */
  129.     struct IncrInfo *nextPtr;    /* Next in list of all INCR-style
  130.                  * retrievals currently pending. */
  131. } IncrInfo;
  132.  
  133. static IncrInfo *pendingIncrs = NULL;
  134.                 /* List of all IncrInfo structures
  135.                  * currently active. */
  136.  
  137. /*
  138.  * When a selection handler is set up by invoking "selection handle",
  139.  * one of the following data structures is set up to hold information
  140.  * about the command to invoke and its interpreter.
  141.  */
  142.  
  143. typedef struct {
  144.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  145.     int cmdLength;        /* # of non-NULL bytes in command. */
  146.     char command[4];        /* Command to invoke.  Actual space is
  147.                  * allocated as large as necessary.  This
  148.                  * must be the last entry in the structure. */
  149. } CommandInfo;
  150.  
  151. /*
  152.  * When selection ownership is claimed with the "selection own" Tcl command,
  153.  * one of the following structures is created to record the Tcl command
  154.  * to be executed when the selection is lost again.
  155.  */
  156.  
  157. typedef struct LostCommand {
  158.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  159.     char command[4];        /* Command to invoke.  Actual space is
  160.                  * allocated as large as necessary.  This
  161.                  * must be the last entry in the structure. */
  162. } LostCommand;
  163.  
  164. /*
  165.  * Chunk size for retrieving selection.  It's defined both in
  166.  * words and in bytes;  the word size is used to allocate
  167.  * buffer space that's guaranteed to be word-aligned and that
  168.  * has an extra character for the terminating NULL.
  169.  */
  170.  
  171. #define TK_SEL_BYTES_AT_ONCE 4000
  172. #define TK_SEL_WORDS_AT_ONCE 1001
  173.  
  174. /*
  175.  * Largest property that we'll accept when sending or receiving the
  176.  * selection:
  177.  */
  178.  
  179. #define MAX_PROP_WORDS 100000
  180.  
  181. /*
  182.  * Forward declarations for procedures defined in this file:
  183.  */
  184.  
  185. static void        ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
  186.                 XSelectionRequestEvent *eventPtr));
  187. static int        DefaultSelection _ANSI_ARGS_((TkWindow *winPtr,
  188.                 Atom target, char *buffer, int maxBytes,
  189.                 Atom *typePtr));
  190. static int        HandleTclCommand _ANSI_ARGS_((ClientData clientData,
  191.                 int offset, char *buffer, int maxBytes));
  192. static void        IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
  193. static void        LostSelection _ANSI_ARGS_((ClientData clientData));
  194. static char *        SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
  195.                 Atom type, Tk_Window tkwin));
  196. static long *        SelCvtToX _ANSI_ARGS_((char *string, Atom type,
  197.                 Tk_Window tkwin, int *numLongsPtr));
  198. static int        SelGetProc _ANSI_ARGS_((ClientData clientData,
  199.                 Tcl_Interp *interp, char *portion));
  200. static void        SelInit _ANSI_ARGS_((Tk_Window tkwin));
  201. static void        SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
  202.                 XEvent *eventPtr));
  203. static void        SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
  204.  
  205. /*
  206.  *--------------------------------------------------------------
  207.  *
  208.  * Tk_CreateSelHandler --
  209.  *
  210.  *    This procedure is called to register a procedure
  211.  *    as the handler for selection requests of a particular
  212.  *    target type on a particular window.
  213.  *
  214.  * Results:
  215.  *    None.
  216.  *
  217.  * Side effects:
  218.  *    In the future, whenever the selection is in tkwin's
  219.  *    window and someone requests the selection in the
  220.  *    form given by target, proc will be invoked to provide
  221.  *    part or all of the selection in the given form.  If
  222.  *    there was already a handler declared for the given
  223.  *    window and target type, then it is replaced.  Proc
  224.  *    should have the following form:
  225.  *
  226.  *    int
  227.  *    proc(clientData, offset, buffer, maxBytes)
  228.  *        ClientData clientData;
  229.  *        int offset;
  230.  *        char *buffer;
  231.  *        int maxBytes;
  232.  *    {
  233.  *    }
  234.  *
  235.  *    The clientData argument to proc will be the same as
  236.  *    the clientData argument to this procedure.  The offset
  237.  *    argument indicates which portion of the selection to
  238.  *    return:  skip the first offset bytes.  Buffer is a
  239.  *    pointer to an area in which to place the converted
  240.  *    selection, and maxBytes gives the number of bytes
  241.  *    available at buffer.  Proc should place the selection
  242.  *    in buffer as a string, and return a count of the number
  243.  *    of bytes of selection actually placed in buffer (not
  244.  *    including the terminating NULL character).  If the
  245.  *    return value equals maxBytes, this is a sign that there
  246.  *    is probably still more selection information available.
  247.  *
  248.  *--------------------------------------------------------------
  249.  */
  250.  
  251. void
  252. Tk_CreateSelHandler(tkwin, target, proc, clientData, format)
  253.     Tk_Window tkwin;        /* Token for window. */
  254.     Atom target;        /* The kind of selection conversions
  255.                  * that can be handled by proc,
  256.                  * e.g. TARGETS or XA_STRING. */
  257.     Tk_SelectionProc *proc;    /* Procedure to invoke to convert
  258.                  * selection to type "target". */
  259.     ClientData clientData;    /* Value to pass to proc. */
  260.     Atom format;        /* Format in which the selection
  261.                  * information should be returned to
  262.                  * the requestor. XA_STRING is best by
  263.                  * far, but anything listed in the ICCCM
  264.                  * will be tolerated (blech). */
  265. {
  266.     register TkSelHandler *selPtr;
  267.     TkWindow *winPtr = (TkWindow *) tkwin;
  268.  
  269.     if (winPtr->dispPtr->multipleAtom == None) {
  270.     SelInit(tkwin);
  271.     }
  272.  
  273.     /*
  274.      * See if there's already a handler for this target on
  275.      * this window.  If so, re-use it.  If not, create a new one.
  276.      */
  277.  
  278.     for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
  279.     if (selPtr == NULL) {
  280.         selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
  281.         selPtr->nextPtr = winPtr->selHandlerList;
  282.         winPtr->selHandlerList = selPtr;
  283.         break;
  284.     }
  285.     if (selPtr->target == target) {
  286.  
  287.         /*
  288.          * Special case:  when replacing handler created by
  289.          * "selection handle" free up memory.  Should there be a
  290.          * callback to allow other clients to do this too?
  291.          */
  292.  
  293.         if (selPtr->proc == HandleTclCommand) {
  294.         ckfree((char *) selPtr->clientData);
  295.         }
  296.         break;
  297.     }
  298.     }
  299.     selPtr->target = target;
  300.     selPtr->format = format;
  301.     selPtr->proc = proc;
  302.     selPtr->clientData = clientData;
  303.     if (format == XA_STRING) {
  304.     selPtr->size = 8;
  305.     } else {
  306.     selPtr->size = 32;
  307.     }
  308. }
  309.  
  310. /*
  311.  *----------------------------------------------------------------------
  312.  *
  313.  * Tk_DeleteSelHandler --
  314.  *
  315.  *    Remove the selection handler for a given window and target,
  316.  *    if it exists.
  317.  *
  318.  * Results:
  319.  *    None.
  320.  *
  321.  * Side effects:
  322.  *    The selection handler for tkwin and target is removed.  If there
  323.  *    is no such handler then nothing happens.
  324.  *
  325.  *----------------------------------------------------------------------
  326.  */
  327.  
  328. void
  329. Tk_DeleteSelHandler(tkwin, target)
  330.     Tk_Window tkwin;            /* Token for window. */
  331.     Atom target;            /* The target whose selection
  332.                      * handler is to be removed. */
  333. {
  334.     TkWindow *winPtr = (TkWindow *) tkwin;
  335.     register TkSelHandler *selPtr, *prevPtr;
  336.  
  337.     for (selPtr = winPtr->selHandlerList, prevPtr = NULL;
  338.         selPtr != NULL; prevPtr = selPtr, selPtr = selPtr->nextPtr) {
  339.     if (selPtr->target == target) {
  340.         if (prevPtr == NULL) {
  341.         winPtr->selHandlerList = selPtr->nextPtr;
  342.         } else {
  343.         prevPtr->nextPtr = selPtr->nextPtr;
  344.         }
  345.         if (selPtr->proc == HandleTclCommand) {
  346.         ckfree((char *) selPtr->clientData);
  347.         }
  348.         ckfree((char *) selPtr);
  349.         return;
  350.     }
  351.     }
  352. }
  353.  
  354. /*
  355.  *--------------------------------------------------------------
  356.  *
  357.  * Tk_OwnSelection --
  358.  *
  359.  *    Arrange for tkwin to become the selection owner.
  360.  *
  361.  * Results:
  362.  *    None.
  363.  *
  364.  * Side effects:
  365.  *    From now on, requests for the selection will be
  366.  *    directed to procedures associated with tkwin (they
  367.  *    must have been declared with calls to Tk_CreateSelHandler).
  368.  *    When the selection is lost by this window, proc will
  369.  *    be invoked (see the manual entry for details).
  370.  *
  371.  *--------------------------------------------------------------
  372.  */
  373.  
  374. void
  375. Tk_OwnSelection(tkwin, proc, clientData)
  376.     Tk_Window tkwin;        /* Window to become new selection
  377.                  * owner. */
  378.     Tk_LostSelProc *proc;    /* Procedure to call when selection
  379.                  * is taken away from tkwin. */
  380.     ClientData clientData;    /* Arbitrary one-word argument to
  381.                  * pass to proc. */
  382. {
  383.     register TkWindow *winPtr = (TkWindow *) tkwin;
  384.     TkDisplay *dispPtr = winPtr->dispPtr;
  385.  
  386.     if (dispPtr->multipleAtom == None) {
  387.     SelInit(tkwin);
  388.     }
  389.  
  390.     Tk_MakeWindowExist(tkwin);
  391.     winPtr->selClearProc = proc;
  392.     winPtr->selClearData = clientData;
  393.     if (dispPtr->selectionOwner != tkwin) {
  394.     TkWindow *ownerPtr = (TkWindow *) dispPtr->selectionOwner;
  395.  
  396.     if ((ownerPtr != NULL)
  397.         && (ownerPtr->selClearProc != NULL)) {
  398.         (*ownerPtr->selClearProc)(ownerPtr->selClearData);
  399.         ownerPtr->selClearProc = NULL;
  400.     }
  401.     }
  402.     dispPtr->selectionOwner = tkwin;
  403.     dispPtr->selectionSerial = NextRequest(winPtr->display);
  404.     dispPtr->selectionTime = TkCurrentTime(dispPtr);
  405.     XSetSelectionOwner(winPtr->display, XA_PRIMARY, winPtr->window,
  406.         dispPtr->selectionTime);
  407. }
  408.  
  409. /*
  410.  *----------------------------------------------------------------------
  411.  *
  412.  * Tk_ClearSelection --
  413.  *
  414.  *    Eliminate the selection on tkwin's display, if there is one.
  415.  *
  416.  * Results:
  417.  *    None.
  418.  *
  419.  * Side effects:
  420.  *    The selection is cleared, so that future requests to retrieve
  421.  *    it will fail until some application owns it again..
  422.  *
  423.  *----------------------------------------------------------------------
  424.  */
  425.  
  426. void
  427. Tk_ClearSelection(tkwin)
  428.     Tk_Window tkwin;        /* Window that selects a display. */
  429. {
  430.     register TkWindow *winPtr = (TkWindow *) tkwin;
  431.     TkDisplay *dispPtr = winPtr->dispPtr;
  432.  
  433.     if (dispPtr->multipleAtom == None) {
  434.     SelInit(tkwin);
  435.     }
  436.  
  437.     if (dispPtr->selectionOwner != NULL) {
  438.     TkWindow *ownerPtr = (TkWindow *) dispPtr->selectionOwner;
  439.  
  440.     if ((ownerPtr != NULL)
  441.         && (ownerPtr->selClearProc != NULL)) {
  442.         (*ownerPtr->selClearProc)(ownerPtr->selClearData);
  443.         ownerPtr->selClearProc = NULL;
  444.     }
  445.     }
  446.     dispPtr->selectionOwner = NULL;
  447.     XSetSelectionOwner(winPtr->display, XA_PRIMARY, None, CurrentTime);
  448. }
  449.  
  450. /*
  451.  *--------------------------------------------------------------
  452.  *
  453.  * Tk_GetSelection --
  454.  *
  455.  *    Retrieve the selection and pass it off (in pieces,
  456.  *    possibly) to a given procedure.
  457.  *
  458.  * Results:
  459.  *    The return value is a standard Tcl return value.
  460.  *    If an error occurs (such as no selection exists)
  461.  *    then an error message is left in interp->result.
  462.  *
  463.  * Side effects:
  464.  *    The standard X11 protocols are used to retrieve the
  465.  *    selection.  When it arrives, it is passed to proc.  If
  466.  *    the selection is very large, it will be passed to proc
  467.  *    in several pieces.  Proc should have the following
  468.  *    structure:
  469.  *
  470.  *    int
  471.  *    proc(clientData, interp, portion)
  472.  *        ClientData clientData;
  473.  *        Tcl_Interp *interp;
  474.  *        char *portion;
  475.  *    {
  476.  *    }
  477.  *
  478.  *    The interp and clientData arguments to proc will be the
  479.  *    same as the corresponding arguments to Tk_GetSelection.
  480.  *    The portion argument points to a character string
  481.  *    containing part of the selection, and numBytes indicates
  482.  *    the length of the portion, not including the terminating
  483.  *    NULL character.  If the selection arrives in several pieces,
  484.  *    the "portion" arguments in separate calls will contain
  485.  *    successive parts of the selection.  Proc should normally
  486.  *    return TCL_OK.  If it detects an error then it should return
  487.  *    TCL_ERROR and leave an error message in interp->result; the
  488.  *    remainder of the selection retrieval will be aborted.
  489.  *
  490.  *--------------------------------------------------------------
  491.  */
  492.  
  493. int
  494. Tk_GetSelection(interp, tkwin, target, proc, clientData)
  495.     Tcl_Interp *interp;        /* Interpreter to use for reporting
  496.                  * errors. */
  497.     Tk_Window tkwin;        /* Window on whose behalf to retrieve
  498.                  * the selection (determines display
  499.                  * from which to retrieve). */
  500.     Atom target;        /* Desired form in which selection
  501.                  * is to be returned. */
  502.     Tk_GetSelProc *proc;    /* Procedure to call to process the
  503.                  * selection, once it has been retrieved. */
  504.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  505. {
  506.     RetrievalInfo retr;
  507.     TkWindow *winPtr = (TkWindow *) tkwin;
  508.     TkDisplay *dispPtr = winPtr->dispPtr;
  509.  
  510.     if (dispPtr->multipleAtom == None) {
  511.     SelInit(tkwin);
  512.     }
  513.     Tk_MakeWindowExist(tkwin);
  514.  
  515.     /*
  516.      * If the selection is owned by a window managed by this
  517.      * process, then call the retrieval procedure directly,
  518.      * rather than going through the X server (it's dangerous
  519.      * to go through the X server in this case because it could
  520.      * result in deadlock if an INCR-style selection results).
  521.      */
  522.  
  523.     if (dispPtr->selectionOwner != NULL) {
  524.     register TkSelHandler *selPtr;
  525.     int offset, result, count;
  526.     char buffer[TK_SEL_BYTES_AT_ONCE+1];
  527.     Time time;
  528.  
  529.     /*
  530.      * Make sure that the selection predates the request
  531.      * time.
  532.      */
  533.  
  534.     time = TkCurrentTime(dispPtr);
  535.     if ((time < dispPtr->selectionTime)
  536.         && (time != CurrentTime)
  537.         && (dispPtr->selectionTime != CurrentTime)) {
  538.         interp->result = "selection changed before it could be retrieved";
  539.         return TCL_ERROR;
  540.     }
  541.  
  542.     for (selPtr = ((TkWindow *) dispPtr->selectionOwner)->selHandlerList;
  543.         ; selPtr = selPtr->nextPtr) {
  544.         if (selPtr == NULL) {
  545.         Atom type;
  546.  
  547.         count = DefaultSelection((TkWindow *) dispPtr->selectionOwner,
  548.             target, buffer, TK_SEL_BYTES_AT_ONCE, &type);
  549.         if (count > TK_SEL_BYTES_AT_ONCE) {
  550.             panic("selection handler returned too many bytes");
  551.         }
  552.         if (count < 0) {
  553.             cantget:
  554.             Tcl_AppendResult(interp, "selection doesn't exist",
  555.                 " or form \"", Tk_GetAtomName(tkwin, target),
  556.                 "\" not defined", (char *) NULL);
  557.             return TCL_ERROR;
  558.         }
  559.         buffer[count] = 0;
  560.         return (*proc)(clientData, interp, buffer);
  561.         }
  562.         if (selPtr->target == target) {
  563.         break;
  564.         }
  565.     }
  566.     offset = 0;
  567.     while (1) {
  568.         count = (*selPtr->proc)(selPtr->clientData, offset,
  569.         buffer, TK_SEL_BYTES_AT_ONCE);
  570.         if (count < 0) {
  571.         goto cantget;
  572.         }
  573.         if (count > TK_SEL_BYTES_AT_ONCE) {
  574.         panic("selection handler returned too many bytes");
  575.         }
  576.         buffer[count] = '\0';
  577.         result = (*proc)(clientData, interp, buffer);
  578.         if (result != TCL_OK) {
  579.         return result;
  580.         }
  581.         if (count < TK_SEL_BYTES_AT_ONCE) {
  582.         return TCL_OK;
  583.         }
  584.         offset += count;
  585.     }
  586.     }
  587.  
  588.     /*
  589.      * The selection is owned by some other process.  To
  590.      * retrieve it, first record information about the retrieval
  591.      * in progress.  Also, try to use a non-top-level window
  592.      * as the requestor (property changes on this window may
  593.      * be monitored by a window manager, which will waste time).
  594.      */
  595.  
  596.     retr.interp = interp;
  597.     if ((winPtr->flags & TK_TOP_LEVEL)
  598.         && (winPtr->childList != NULL)) {
  599.     winPtr = winPtr->childList;
  600.     }
  601.     retr.winPtr = winPtr;
  602.     retr.property = XA_PRIMARY;
  603.     retr.target = target;
  604.     retr.proc = proc;
  605.     retr.clientData = clientData;
  606.     retr.result = -1;
  607.     retr.idleTime = 0;
  608.     retr.nextPtr = pendingRetrievals;
  609.     pendingRetrievals = &retr;
  610.  
  611.     /*
  612.      * Initiate the request for the selection.
  613.      */
  614.  
  615.     Tk_MakeWindowExist((Tk_Window) winPtr);
  616.     XConvertSelection(winPtr->display, XA_PRIMARY, target,
  617.         retr.property, winPtr->window, TkCurrentTime(dispPtr));
  618.  
  619.     /*
  620.      * Enter a loop processing X events until the selection
  621.      * has been retrieved and processed.  If no response is
  622.      * received within a few seconds, then timeout.
  623.      */
  624.  
  625.     retr.timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
  626.         (ClientData) &retr);
  627.     while (retr.result == -1) {
  628.     Tk_DoOneEvent(0);
  629.     }
  630.     Tk_DeleteTimerHandler(retr.timeout);
  631.  
  632.     /*
  633.      * Unregister the information about the selection retrieval
  634.      * in progress.
  635.      */
  636.  
  637.     if (pendingRetrievals == &retr) {
  638.     pendingRetrievals = retr.nextPtr;
  639.     } else {
  640.     RetrievalInfo *retrPtr;
  641.  
  642.     for (retrPtr = pendingRetrievals; retrPtr != NULL;
  643.         retrPtr = retrPtr->nextPtr) {
  644.         if (retrPtr->nextPtr == &retr) {
  645.         retrPtr->nextPtr = retr.nextPtr;
  646.         break;
  647.         }
  648.     }
  649.     }
  650.     return retr.result;
  651. }
  652.  
  653. /*
  654.  *--------------------------------------------------------------
  655.  *
  656.  * Tk_SelectionCmd --
  657.  *
  658.  *    This procedure is invoked to process the "selection" Tcl
  659.  *    command.  See the user documentation for details on what
  660.  *    it does.
  661.  *
  662.  * Results:
  663.  *    A standard Tcl result.
  664.  *
  665.  * Side effects:
  666.  *    See the user documentation.
  667.  *
  668.  *--------------------------------------------------------------
  669.  */
  670.  
  671. int
  672. Tk_SelectionCmd(clientData, interp, argc, argv)
  673.     ClientData clientData;    /* Main window associated with
  674.                  * interpreter. */
  675.     Tcl_Interp *interp;        /* Current interpreter. */
  676.     int argc;            /* Number of arguments. */
  677.     char **argv;        /* Argument strings. */
  678. {
  679.     Tk_Window tkwin = (Tk_Window) clientData;
  680.     int length;
  681.     char c;
  682.  
  683.     if (argc < 2) {
  684.     sprintf(interp->result,
  685.         "wrong # args: should be \"%.50s option ?arg arg ...?\"",
  686.         argv[0]);
  687.     return TCL_ERROR;
  688.     }
  689.     c = argv[1][0];
  690.     length = strlen(argv[1]);
  691.     if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
  692.     Tk_Window window;
  693.     if (argc != 3) {
  694.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  695.             " clear window\"", (char *) NULL);
  696.         return TCL_ERROR;
  697.     }
  698.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  699.     if (window == NULL) {
  700.         return TCL_ERROR;
  701.     }
  702.     Tk_ClearSelection(window);
  703.     return TCL_OK;
  704.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  705.     Atom target;
  706.     GetInfo getInfo;
  707.     int result;
  708.  
  709.     if (argc > 3) {
  710.         sprintf(interp->result,
  711.             "too may args: should be \"%.50s get ?type?\"",
  712.             argv[0]);
  713.         return TCL_ERROR;
  714.     }
  715.     if (argc == 3) {
  716.         target = Tk_InternAtom(tkwin, argv[2]);
  717.     } else {
  718.         target = XA_STRING;
  719.     }
  720.     getInfo.string = (char *) ckalloc(100);
  721.     getInfo.bytesAvl = 100;
  722.     getInfo.bytesUsed = 0;
  723.     result = Tk_GetSelection(interp, tkwin, target, SelGetProc,
  724.         (ClientData) &getInfo);
  725.     if (result == TCL_OK) {
  726.         Tcl_SetResult(interp, getInfo.string, TCL_DYNAMIC);
  727.     } else {
  728.         ckfree(getInfo.string);
  729.     }
  730.     return result;
  731.     } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
  732.     Tk_Window window;
  733.     Atom target, format;
  734.     register CommandInfo *cmdInfoPtr;
  735.     int cmdLength;
  736.  
  737.     if ((argc < 4) || (argc > 6)) {
  738.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  739.             " handle window command ?type? ?format?\"", (char *) NULL);
  740.         return TCL_ERROR;
  741.     }
  742.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  743.     if (window == NULL) {
  744.         return TCL_ERROR;
  745.     }
  746.     if (argc > 4) {
  747.         target = Tk_InternAtom(window, argv[4]);
  748.     } else {
  749.         target = XA_STRING;
  750.     }
  751.     if (argc > 5) {
  752.         format = Tk_InternAtom(window, argv[5]);
  753.     } else {
  754.         format = XA_STRING;
  755.     }
  756.     cmdLength = strlen(argv[3]);
  757.     if (cmdLength == 0) {
  758.         Tk_DeleteSelHandler(window, target);
  759.     } else {
  760.         cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
  761.             sizeof(CommandInfo) - 3 + cmdLength));
  762.         cmdInfoPtr->interp = interp;
  763.         cmdInfoPtr->cmdLength = cmdLength;
  764.         strcpy(cmdInfoPtr->command, argv[3]);
  765.         Tk_CreateSelHandler(window, target, HandleTclCommand,
  766.             (ClientData) cmdInfoPtr, format);
  767.     }
  768.     return TCL_OK;
  769.     } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
  770.     Tk_Window window;
  771.     register LostCommand *lostPtr;
  772.     int cmdLength;
  773.  
  774.     if (argc > 4) {
  775.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  776.             " own ?window? ?command?\"", (char *) NULL);
  777.         return TCL_ERROR;
  778.     }
  779.     if (argc == 2) {
  780.         window = ((TkWindow *) tkwin)->dispPtr->selectionOwner;
  781.         if (window != NULL) {
  782.         interp->result = Tk_PathName(window);
  783.         }
  784.         return TCL_OK;
  785.     }
  786.     window = Tk_NameToWindow(interp, argv[2], tkwin);
  787.     if (window == NULL) {
  788.         return TCL_ERROR;
  789.     }
  790.     if (argc == 3) {
  791.         Tk_OwnSelection(window, (Tk_LostSelProc *) NULL,
  792.             (ClientData) NULL);
  793.         return TCL_OK;
  794.     }
  795.     cmdLength = strlen(argv[3]);
  796.     lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
  797.         -3 + cmdLength));
  798.     lostPtr->interp = interp;
  799.     strcpy(lostPtr->command, argv[3]);
  800.     Tk_OwnSelection(window, LostSelection, (ClientData) lostPtr);
  801.     return TCL_OK;
  802.     } else {
  803.     sprintf(interp->result,
  804.         "bad option \"%.50s\":  must be clear, get, handle, or own",
  805.         argv[1]);
  806.     return TCL_ERROR;
  807.     }
  808. }
  809.  
  810. /*
  811.  *----------------------------------------------------------------------
  812.  *
  813.  * TkSelDeadWindow --
  814.  *
  815.  *    This procedure is invoked just before a TkWindow is deleted.
  816.  *    It performs selection-related cleanup.
  817.  *
  818.  * Results:
  819.  *    None.
  820.  *
  821.  * Side effects:
  822.  *    Frees up memory associated with the selection.
  823.  *
  824.  *----------------------------------------------------------------------
  825.  */
  826.  
  827. void
  828. TkSelDeadWindow(winPtr)
  829.     register TkWindow *winPtr;    /* Window that's being deleted. */
  830. {
  831.     register TkSelHandler *selPtr;
  832.  
  833.     while (1) {
  834.     selPtr = winPtr->selHandlerList;
  835.     if (selPtr == NULL) {
  836.         break;
  837.     }
  838.     winPtr->selHandlerList = selPtr->nextPtr;
  839.     if (selPtr->proc == HandleTclCommand) {
  840.         ckfree((char *) selPtr->clientData);
  841.     }
  842.     ckfree((char *) selPtr);
  843.     }
  844.     if (winPtr->selClearProc == LostSelection) {
  845.     ckfree((char *) winPtr->selClearData);
  846.     }
  847.     winPtr->selClearProc = NULL;
  848.  
  849.     if (winPtr->dispPtr->selectionOwner == (Tk_Window) winPtr) {
  850.     winPtr->dispPtr->selectionOwner = NULL;
  851.     }
  852. }
  853.  
  854. /*
  855.  *----------------------------------------------------------------------
  856.  *
  857.  * SelInit --
  858.  *
  859.  *    Initialize selection-related information for a display.
  860.  *
  861.  * Results:
  862.  *    None.
  863.  *
  864.  * Side effects:
  865.  *    Selection-related information is initialized.
  866.  *
  867.  *----------------------------------------------------------------------
  868.  */
  869.  
  870. static void
  871. SelInit(tkwin)
  872.     Tk_Window tkwin;        /* Window token (used to find
  873.                  * display to initialize). */
  874. {
  875.     register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  876.  
  877.     /*
  878.      * Fetch commonly-used atoms.
  879.      */
  880.  
  881.     dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
  882.     dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
  883.     dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
  884.     dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
  885.     dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
  886.     dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
  887.     dispPtr->applicationAtom = Tk_InternAtom(tkwin, "APPLICATION");
  888.     dispPtr->windowNameAtom = Tk_InternAtom(tkwin, "WINDOW_NAME");
  889. }
  890.  
  891. /*
  892.  *--------------------------------------------------------------
  893.  *
  894.  * TkSelEventProc --
  895.  *
  896.  *    This procedure is invoked whenever a selection-related
  897.  *    event occurs.  It does the lion's share of the work
  898.  *    in implementing the selection protocol.
  899.  *
  900.  * Results:
  901.  *    None.
  902.  *
  903.  * Side effects:
  904.  *    Lots:  depends on the type of event.
  905.  *
  906.  *--------------------------------------------------------------
  907.  */
  908.  
  909. void
  910. TkSelEventProc(tkwin, eventPtr)
  911.     Tk_Window tkwin;        /* Window for which event was
  912.                  * targeted. */
  913.     register XEvent *eventPtr;    /* X event:  either SelectionClear,
  914.                  * SelectionRequest, or
  915.                  * SelectionNotify. */
  916. {
  917.     register TkWindow *winPtr = (TkWindow *) tkwin;
  918.  
  919.     /*
  920.      * Case #1: SelectionClear events.  Invoke clear procedure
  921.      * for window that just lost the selection.  This code is a
  922.      * bit tricky, because any callbacks to due selection changes
  923.      * between windows managed by the process have already been
  924.      * made.  Thus, ignore the event unless it refers to the
  925.      * window that's currently the selection owner and the event
  926.      * was generated after the server saw the SetSelectionOwner
  927.      * request.
  928.      */
  929.  
  930.     if (eventPtr->type == SelectionClear) {
  931.     if ((eventPtr->xselectionclear.selection == XA_PRIMARY)
  932.         && (winPtr->dispPtr->selectionOwner == tkwin)
  933.         && (eventPtr->xselectionclear.serial
  934.             >= winPtr->dispPtr->selectionSerial)
  935.         && (winPtr->selClearProc != NULL)) {
  936.         (*winPtr->selClearProc)(winPtr->selClearData);
  937.         winPtr->selClearProc = NULL;
  938.         winPtr->dispPtr->selectionOwner = NULL;
  939.     }
  940.     return;
  941.     }
  942.  
  943.     /*
  944.      * Case #2: SelectionNotify events.  Call the relevant procedure
  945.      * to handle the incoming selection.
  946.      */
  947.  
  948.     if (eventPtr->type == SelectionNotify) {
  949.     register RetrievalInfo *retrPtr;
  950.     char *propInfo;
  951.     Atom type;
  952.     int format, result;
  953.     unsigned long numItems, bytesAfter;
  954.  
  955.     for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
  956.         if (retrPtr == NULL) {
  957.         return;
  958.         }
  959.         if ((retrPtr->winPtr == winPtr)
  960.             && (eventPtr->xselection.selection == XA_PRIMARY)
  961.             && (retrPtr->target == eventPtr->xselection.target)
  962.             && (retrPtr->result == -1)) {
  963.         if (retrPtr->property == eventPtr->xselection.property) {
  964.             break;
  965.         }
  966.         if (eventPtr->xselection.property == None) {
  967.             Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  968.             Tcl_AppendResult(retrPtr->interp,
  969.                 "selection doesn't exist or form \"",
  970.                 Tk_GetAtomName(tkwin, retrPtr->target),
  971.                 "\" not defined", (char *) NULL);
  972.             retrPtr->result = TCL_ERROR;
  973.             return;
  974.         }
  975.         }
  976.     }
  977.  
  978.     propInfo = NULL;
  979.     result = XGetWindowProperty(eventPtr->xselection.display,
  980.         eventPtr->xselection.requestor, retrPtr->property,
  981.         0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
  982.         &type, &format, &numItems, &bytesAfter,
  983.         (unsigned char **) &propInfo);
  984.     if ((result != Success) || (type == None)) {
  985.         return;
  986.     }
  987.     if (bytesAfter != 0) {
  988.         Tcl_SetResult(retrPtr->interp, "selection property too large",
  989.         TCL_STATIC);
  990.         retrPtr->result = TCL_ERROR;
  991.         XFree(propInfo);
  992.         return;
  993.     }
  994.     if ((type == XA_STRING) || (type == winPtr->dispPtr->textAtom)
  995.         || (type == winPtr->dispPtr->compoundTextAtom)) {
  996.         if (format != 8) {
  997.         sprintf(retrPtr->interp->result,
  998.             "bad format for string selection: wanted \"8\", got \"%d\"",
  999.             format);
  1000.         retrPtr->result = TCL_ERROR;
  1001.         return;
  1002.         }
  1003.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  1004.             retrPtr->interp, propInfo);
  1005.     } else if (type == winPtr->dispPtr->incrAtom) {
  1006.  
  1007.         /*
  1008.          * It's a !?#@!?!! INCR-style reception.  Arrange to receive
  1009.          * the selection in pieces, using the ICCCM protocol, then
  1010.          * hang around until either the selection is all here or a
  1011.          * timeout occurs.
  1012.          */
  1013.  
  1014.         retrPtr->idleTime = 0;
  1015.         Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  1016.             (ClientData) retrPtr);
  1017.         XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
  1018.             retrPtr->property);
  1019.         while (retrPtr->result == -1) {
  1020.         Tk_DoOneEvent(0);
  1021.         }
  1022.         Tk_DeleteEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
  1023.             (ClientData) retrPtr);
  1024.     } else {
  1025.         char *string;
  1026.  
  1027.         if (format != 32) {
  1028.         sprintf(retrPtr->interp->result,
  1029.             "bad format for selection: wanted \"32\", got \"%d\"",
  1030.             format);
  1031.         retrPtr->result = TCL_ERROR;
  1032.         return;
  1033.         }
  1034.         string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  1035.             (Tk_Window) winPtr);
  1036.         retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
  1037.             retrPtr->interp, string);
  1038.         ckfree(string);
  1039.     }
  1040.     XFree(propInfo);
  1041.     return;
  1042.     }
  1043.  
  1044.     /*
  1045.      * Case #3: SelectionRequest events.  Call ConvertSelection to
  1046.      * do the dirty work.
  1047.      */
  1048.  
  1049.     if ((eventPtr->type == SelectionRequest)
  1050.         && (eventPtr->xselectionrequest.selection == XA_PRIMARY)) {
  1051.     ConvertSelection(winPtr, &eventPtr->xselectionrequest);
  1052.     return;
  1053.     }
  1054. }
  1055.  
  1056. /*
  1057.  *--------------------------------------------------------------
  1058.  *
  1059.  * SelGetProc --
  1060.  *
  1061.  *    This procedure is invoked to process pieces of the
  1062.  *    selection as they arrive during "selection get"
  1063.  *    commands.
  1064.  *
  1065.  * Results:
  1066.  *    Always returns TCL_OK.
  1067.  *
  1068.  * Side effects:
  1069.  *    Bytes get appended to the result currently stored
  1070.  *    in interp->result, and its memory area gets
  1071.  *    expanded if necessary.
  1072.  *
  1073.  *--------------------------------------------------------------
  1074.  */
  1075.  
  1076.     /* ARGSUSED */
  1077. static int
  1078. SelGetProc(clientData, interp, portion)
  1079.     ClientData clientData;    /* Information about partially-
  1080.                  * assembled result. */
  1081.     Tcl_Interp *interp;        /* Interpreter used for error
  1082.                  * reporting (not used). */
  1083.     char *portion;        /* New information to be appended. */
  1084. {
  1085.     register GetInfo *getInfoPtr = (GetInfo *) clientData;
  1086.     int newLength;
  1087.  
  1088.     newLength = strlen(portion) + getInfoPtr->bytesUsed;
  1089.  
  1090.     /*
  1091.      * Grow the result area if we've run out of space.
  1092.      */
  1093.  
  1094.     if (newLength >= getInfoPtr->bytesAvl) {
  1095.     char *newString;
  1096.  
  1097.     getInfoPtr->bytesAvl *= 2;
  1098.     if (getInfoPtr->bytesAvl <= newLength) {
  1099.         getInfoPtr->bytesAvl = newLength + 1;
  1100.     }
  1101.     newString = (char *) ckalloc((unsigned) getInfoPtr->bytesAvl);
  1102.     memcpy((VOID *) newString, (VOID *) getInfoPtr->string,
  1103.         getInfoPtr->bytesUsed);
  1104.     ckfree(getInfoPtr->string);
  1105.     getInfoPtr->string = newString;
  1106.     }
  1107.  
  1108.     /*
  1109.      * Append the new data to what was already there.
  1110.      */
  1111.  
  1112.     strcpy(getInfoPtr->string + getInfoPtr->bytesUsed, portion);
  1113.     getInfoPtr->bytesUsed = newLength;
  1114.     return TCL_OK;
  1115. }
  1116.  
  1117. /*
  1118.  *----------------------------------------------------------------------
  1119.  *
  1120.  * SelCvtToX --
  1121.  *
  1122.  *    Given a selection represented as a string (the normal Tcl form),
  1123.  *    convert it to the ICCCM-mandated format for X, depending on
  1124.  *    the type argument.  This procedure and SelCvtFromX are inverses.
  1125.  *
  1126.  * Results:
  1127.  *    The return value is a malloc'ed buffer holding a value
  1128.  *    equivalent to "string", but formatted as for "type".  It is
  1129.  *    the caller's responsibility to free the string when done with
  1130.  *    it.  The word at *numLongsPtr is filled in with the number of
  1131.  *    32-bit words returned in the result.
  1132.  *
  1133.  * Side effects:
  1134.  *    None.
  1135.  *
  1136.  *----------------------------------------------------------------------
  1137.  */
  1138.  
  1139. static long *
  1140. SelCvtToX(string, type, tkwin, numLongsPtr)
  1141.     char *string;        /* String representation of selection. */
  1142.     Atom type;            /* Atom specifying the X format that is
  1143.                  * desired for the selection.  Should not
  1144.                  * be XA_STRING (if so, don't bother calling
  1145.                  * this procedure at all). */
  1146.     Tk_Window tkwin;        /* Window that governs atom conversion. */
  1147.     int *numLongsPtr;        /* Number of 32-bit words contained in the
  1148.                  * result. */
  1149. {
  1150.     register char *p;
  1151.     char *field;
  1152.     int numFields;
  1153.     long *propPtr, *longPtr;
  1154. #define MAX_ATOM_NAME_LENGTH 100
  1155.     char atomName[MAX_ATOM_NAME_LENGTH+1];
  1156.  
  1157.     /*
  1158.      * The string is assumed to consist of fields separated by spaces.
  1159.      * The property gets generated by converting each field to an
  1160.      * integer number, in one of two ways:
  1161.      * 1. If type is XA_ATOM, convert each field to its corresponding
  1162.      *      atom.
  1163.      * 2. If type is anything else, convert each field from an ASCII number
  1164.      *    to a 32-bit binary number.
  1165.      */
  1166.  
  1167.     numFields = 1;
  1168.     for (p = string; *p != 0; p++) {
  1169.     if (isspace(*p)) {
  1170.         numFields++;
  1171.     }
  1172.     }
  1173.     propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
  1174.  
  1175.     /*
  1176.      * Convert the fields one-by-one.
  1177.      */
  1178.  
  1179.     for (longPtr = propPtr, *numLongsPtr = 0, p = string;
  1180.         ; longPtr++, (*numLongsPtr)++) {
  1181.     while (isspace(*p)) {
  1182.         p++;
  1183.     }
  1184.     if (*p == 0) {
  1185.         break;
  1186.     }
  1187.     field = p;
  1188.     while ((*p != 0) && !isspace(*p)) {
  1189.         p++;
  1190.     }
  1191.     if (type == XA_ATOM) {
  1192.         int length;
  1193.  
  1194.         length = p - field;
  1195.         if (length > MAX_ATOM_NAME_LENGTH) {
  1196.         length = MAX_ATOM_NAME_LENGTH;
  1197.         }
  1198.         strncpy(atomName, field, length);
  1199.         atomName[length] = 0;
  1200.         *longPtr = (long) Tk_InternAtom(tkwin, atomName);
  1201.     } else {
  1202.         char *dummy;
  1203.  
  1204.         *longPtr = strtol(field, &dummy, 0);
  1205.     }
  1206.     }
  1207.     return propPtr;
  1208. }
  1209.  
  1210. /*
  1211.  *----------------------------------------------------------------------
  1212.  *
  1213.  * SelCvtFromX --
  1214.  *
  1215.  *    Given an X property value, formatted as a collection of 32-bit
  1216.  *    values according to "type" and the ICCCM conventions, convert
  1217.  *    the value to a string suitable for manipulation by Tcl.  This
  1218.  *    procedure is the inverse of SelCvtToX.
  1219.  *
  1220.  * Results:
  1221.  *    The return value is the string equivalent of "property".  It is
  1222.  *    malloc-ed and should be freed by the caller when no longer
  1223.  *    needed.
  1224.  *
  1225.  * Side effects:
  1226.  *    None.
  1227.  *
  1228.  *----------------------------------------------------------------------
  1229.  */
  1230.  
  1231. static char *
  1232. SelCvtFromX(propPtr, numValues, type, tkwin)
  1233.     register long *propPtr;    /* Property value from X. */
  1234.     int numValues;        /* Number of 32-bit values in property. */
  1235.     Atom type;            /* Type of property  Should not be
  1236.                  * XA_STRING (if so, don't bother calling
  1237.                  * this procedure at all). */
  1238.     Tk_Window tkwin;        /* Window to use for atom conversion. */
  1239. {
  1240.     char *result;
  1241.     int resultSpace, curSize, fieldSize;
  1242.     char *atomName;
  1243.  
  1244.     /*
  1245.      * Convert each long in the property to a string value, which is
  1246.      * either the name of an atom (if type is XA_ATOM) or a hexadecimal
  1247.      * string.  Make an initial guess about the size of the result, but
  1248.      * be prepared to enlarge the result if necessary.
  1249.      */
  1250.  
  1251.     resultSpace = 12*numValues;
  1252.     curSize = 0;
  1253.     atomName = "";    /* Not needed, but eliminates compiler warning. */
  1254.     result = (char *) ckalloc((unsigned) resultSpace);
  1255.     for ( ; numValues > 0; propPtr++, numValues--) {
  1256.     if (type == XA_ATOM) {
  1257.         atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
  1258.         fieldSize = strlen(atomName) + 1;
  1259.     } else {
  1260.         fieldSize = 12;
  1261.     }
  1262.     if (curSize+fieldSize >= resultSpace) {
  1263.         char *newResult;
  1264.  
  1265.         resultSpace *= 2;
  1266.         if (curSize+fieldSize >= resultSpace) {
  1267.         resultSpace = curSize + fieldSize + 1;
  1268.         }
  1269.         newResult = (char *) ckalloc((unsigned) resultSpace);
  1270.         strcpy(newResult, result);
  1271.         ckfree(result);
  1272.         result = newResult;
  1273.     }
  1274.     if (curSize != 0) {
  1275.         result[curSize] = ' ';
  1276.         curSize++;
  1277.     }
  1278.     if (type == XA_ATOM) {
  1279.         strcpy(result+curSize, atomName);
  1280.     } else {
  1281.         sprintf(result+curSize, "%#x", *propPtr);
  1282.     }
  1283.     curSize += strlen(result+curSize);
  1284.     }
  1285.     return result;
  1286. }
  1287.  
  1288. /*
  1289.  *----------------------------------------------------------------------
  1290.  *
  1291.  * ConvertSelection --
  1292.  *
  1293.  *    This procedure is invoked to handle SelectionRequest events.
  1294.  *    It responds to the requests, obeying the ICCCM protocols.
  1295.  *
  1296.  * Results:
  1297.  *    None.
  1298.  *
  1299.  * Side effects:
  1300.  *    Properties are created for the selection requestor, and a
  1301.  *    SelectionNotify event is generated for the selection
  1302.  *    requestor.  In the event of long selections, this procedure
  1303.  *    implements INCR-mode transfers, using the ICCCM protocol.
  1304.  *
  1305.  *----------------------------------------------------------------------
  1306.  */
  1307.  
  1308. static void
  1309. ConvertSelection(winPtr, eventPtr)
  1310.     TkWindow *winPtr;            /* Window that owns selection. */
  1311.     register XSelectionRequestEvent *eventPtr;
  1312.                     /* Event describing request. */
  1313. {
  1314.     XSelectionEvent reply;        /* Used to notify requestor that
  1315.                      * selection info is ready. */
  1316.     int multiple;            /* Non-zero means a MULTIPLE request
  1317.                      * is being handled. */
  1318.     IncrInfo info;            /* State of selection conversion. */
  1319.     Atom singleInfo[2];            /* info.multAtoms points here except
  1320.                      * for multiple conversions. */
  1321.     int i;
  1322.     Tk_ErrorHandler errorHandler;
  1323.  
  1324.     errorHandler = Tk_CreateErrorHandler(eventPtr->display, -1, -1,-1,
  1325.         (int (*)()) NULL, (ClientData) NULL);
  1326.  
  1327.     /*
  1328.      * Initialize the reply event.
  1329.      */
  1330.  
  1331.     reply.type = SelectionNotify;
  1332.     reply.serial = 0;
  1333.     reply.send_event = True;
  1334.     reply.display = eventPtr->display;
  1335.     reply.requestor = eventPtr->requestor;
  1336.     reply.selection = XA_PRIMARY;
  1337.     reply.target = eventPtr->target;
  1338.     reply.property = eventPtr->property;
  1339.     if (reply.property == None) {
  1340.     reply.property = reply.target;
  1341.     }
  1342.     reply.time = eventPtr->time;
  1343.  
  1344.     /*
  1345.      * Watch out for races between conversion requests and
  1346.      * selection ownership changes:  reject the conversion
  1347.      * request if it's for the wrong window or the wrong
  1348.      * time.
  1349.      */
  1350.  
  1351.     if ((winPtr->dispPtr->selectionOwner != (Tk_Window) winPtr)
  1352.         || ((eventPtr->time < winPtr->dispPtr->selectionTime)
  1353.         && (eventPtr->time != CurrentTime)
  1354.         && (winPtr->dispPtr->selectionTime != CurrentTime))) {
  1355.     goto refuse;
  1356.     }
  1357.  
  1358.     /*
  1359.      * Figure out which kind(s) of conversion to perform.  If handling
  1360.      * a MULTIPLE conversion, then read the property describing which
  1361.      * conversions to perform.
  1362.      */
  1363.  
  1364.     info.winPtr = winPtr;
  1365.     if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
  1366.     multiple = 0;
  1367.     singleInfo[0] = reply.target;
  1368.     singleInfo[1] = reply.property;
  1369.     info.multAtoms = singleInfo;
  1370.     info.numConversions = 1;
  1371.     } else {
  1372.     Atom type;
  1373.     int format, result;
  1374.     unsigned long bytesAfter;
  1375.  
  1376.     multiple = 1;
  1377.     info.multAtoms = NULL;
  1378.     if (eventPtr->property == None) {
  1379.         goto refuse;
  1380.     }
  1381.     result = XGetWindowProperty(eventPtr->display,
  1382.         eventPtr->requestor, eventPtr->property,
  1383.         0, MAX_PROP_WORDS, False, XA_ATOM,
  1384.         &type, &format, &info.numConversions, &bytesAfter,
  1385.         (unsigned char **) &info.multAtoms);
  1386.     if ((result != Success) || (bytesAfter != 0) || (format != 32)
  1387.         || (type == None)) {
  1388.         if (info.multAtoms != NULL) {
  1389.         XFree((char *) info.multAtoms);
  1390.         }
  1391.         goto refuse;
  1392.     }
  1393.     info.numConversions /= 2;        /* Two atoms per conversion. */
  1394.     }
  1395.  
  1396.     /*
  1397.      * Loop through all of the requested conversions, and either return
  1398.      * the entire converted selection, if it can be returned in a single
  1399.      * bunch, or return INCR information only (the actual selection will
  1400.      * be returned below).
  1401.      */
  1402.  
  1403.     info.offsets = (int *) ckalloc((unsigned) (info.numConversions*sizeof(int)));
  1404.     info.numIncrs = 0;
  1405.     for (i = 0; i < info.numConversions; i++) {
  1406.     Atom target, property;
  1407.     long buffer[TK_SEL_WORDS_AT_ONCE];
  1408.     register TkSelHandler *selPtr;
  1409.  
  1410.     target = info.multAtoms[2*i];
  1411.     property = info.multAtoms[2*i + 1];
  1412.     info.offsets[i] = -1;
  1413.  
  1414.     for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
  1415.         int numItems, format;
  1416.         char *propPtr;
  1417.         Atom type;
  1418.  
  1419.         if (selPtr == NULL) {
  1420.  
  1421.         /*
  1422.          * Nobody seems to know about this kind of request.  If
  1423.          * it's of a sort that we can handle without any help, do
  1424.          * it.  Otherwise mark the request as an errror.
  1425.          */
  1426.  
  1427.         numItems = DefaultSelection(winPtr, target, (char *) buffer,
  1428.             TK_SEL_BYTES_AT_ONCE, &type);
  1429.         if (numItems >= 0) {
  1430.             goto gotStuff;
  1431.         }
  1432.         info.multAtoms[2*i + 1] = None;
  1433.         break;
  1434.         } else if (selPtr->target == target) {
  1435.         numItems = (*selPtr->proc)(selPtr->clientData, 0,
  1436.             (char *) buffer, TK_SEL_BYTES_AT_ONCE);
  1437.         if (numItems < 0) {
  1438.             info.multAtoms[2*i + 1] = None;
  1439.             break;
  1440.         }
  1441.         if (numItems > TK_SEL_BYTES_AT_ONCE) {
  1442.             panic("selection handler returned too many bytes");
  1443.         }
  1444.         ((char *) buffer)[numItems] = '\0';
  1445.         type = selPtr->format;
  1446.         } else {
  1447.         continue;
  1448.         }
  1449.  
  1450.         gotStuff:
  1451.         if (numItems == TK_SEL_BYTES_AT_ONCE) {
  1452.         info.numIncrs++;
  1453.         type = winPtr->dispPtr->incrAtom;
  1454.         buffer[0] = 10;    /* Guess at # items avl. */
  1455.         numItems = 1;
  1456.         propPtr = (char *) buffer;
  1457.         format = 32;
  1458.         info.offsets[i] = 0;
  1459.         } else if (type == XA_STRING) {
  1460.         propPtr = (char *) buffer;
  1461.         format = 8;
  1462.         } else {
  1463.         propPtr = (char *) SelCvtToX((char *) buffer,
  1464.             type, (Tk_Window) winPtr, &numItems);
  1465.         format = 32;
  1466.         }
  1467.         XChangeProperty(reply.display, reply.requestor,
  1468.             property, type, format, PropModeReplace,
  1469.             (unsigned char *) propPtr, numItems);
  1470.         if (propPtr != (char *) buffer) {
  1471.         ckfree(propPtr);
  1472.         }
  1473.         break;
  1474.     }
  1475.     }
  1476.  
  1477.     /*
  1478.      * Send an event back to the requestor to indicate that the
  1479.      * first stage of conversion is complete (everything is done
  1480.      * except for long conversions that have to be done in INCR
  1481.      * mode).
  1482.      */
  1483.  
  1484.     if (info.numIncrs > 0) {
  1485.     XSelectInput(reply.display, reply.requestor, PropertyChangeMask);
  1486.     info.timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
  1487.         (ClientData) &info);
  1488.     info.idleTime = 0;
  1489.     info.reqWindow = reply.requestor;
  1490.     info.time = winPtr->dispPtr->selectionTime;
  1491.     info.nextPtr = pendingIncrs;
  1492.     pendingIncrs = &info;
  1493.     }
  1494.     if (multiple) {
  1495.     XChangeProperty(reply.display, reply.requestor, reply.property,
  1496.         XA_ATOM, 32, PropModeReplace,
  1497.         (unsigned char *) info.multAtoms,
  1498.         (int) info.numConversions*2);
  1499.     } else {
  1500.  
  1501.     /*
  1502.      * Not a MULTIPLE request.  The first property in "multAtoms"
  1503.      * got set to None if there was an error in conversion.
  1504.      */
  1505.  
  1506.     reply.property = info.multAtoms[1];
  1507.     }
  1508.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  1509.     Tk_DeleteErrorHandler(errorHandler);
  1510.  
  1511.     /*
  1512.      * Handle any remaining INCR-mode transfers.  This all happens
  1513.      * in callbacks to TkSelPropProc, so just wait until the number
  1514.      * of uncompleted INCR transfers drops to zero.
  1515.      */
  1516.  
  1517.     if (info.numIncrs > 0) {
  1518.     IncrInfo *infoPtr2;
  1519.  
  1520.     while (info.numIncrs > 0) {
  1521.         Tk_DoOneEvent(0);
  1522.     }
  1523.     Tk_DeleteTimerHandler(info.timeout);
  1524.     errorHandler = Tk_CreateErrorHandler(winPtr->display,
  1525.         -1, -1,-1, (int (*)()) NULL, (ClientData) NULL);
  1526.     XSelectInput(reply.display, reply.requestor, 0L);
  1527.     Tk_DeleteErrorHandler(errorHandler);
  1528.     if (pendingIncrs == &info) {
  1529.         pendingIncrs = info.nextPtr;
  1530.     } else {
  1531.         for (infoPtr2 = pendingIncrs; infoPtr2 != NULL;
  1532.             infoPtr2 = infoPtr2->nextPtr) {
  1533.         if (infoPtr2->nextPtr == &info) {
  1534.             infoPtr2->nextPtr = info.nextPtr;
  1535.             break;
  1536.         }
  1537.         }
  1538.     }
  1539.     }
  1540.  
  1541.     /*
  1542.      * All done.  Cleanup and return.
  1543.      */
  1544.  
  1545.     ckfree((char *) info.offsets);
  1546.     if (multiple) {
  1547.     XFree((char *) info.multAtoms);
  1548.     }
  1549.     return;
  1550.  
  1551.     /*
  1552.      * An error occurred.  Send back a refusal message.
  1553.      */
  1554.  
  1555.     refuse:
  1556.     reply.property = None;
  1557.     XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
  1558.     Tk_DeleteErrorHandler(errorHandler);
  1559.     return;
  1560. }
  1561.  
  1562. /*
  1563.  *----------------------------------------------------------------------
  1564.  *
  1565.  * SelRcvIncrProc --
  1566.  *
  1567.  *    This procedure handles the INCR protocol on the receiving
  1568.  *    side.  It is invoked in response to property changes on
  1569.  *    the requestor's window (which hopefully are because a new
  1570.  *    chunk of the selection arrived).
  1571.  *
  1572.  * Results:
  1573.  *    None.
  1574.  *
  1575.  * Side effects:
  1576.  *    If a new piece of selection has arrived, a procedure is
  1577.  *    invoked to deal with that piece.  When the whole selection
  1578.  *    is here, a flag is left for the higher-level procedure that
  1579.  *    initiated the selection retrieval.
  1580.  *
  1581.  *----------------------------------------------------------------------
  1582.  */
  1583.  
  1584. static void
  1585. SelRcvIncrProc(clientData, eventPtr)
  1586.     ClientData clientData;        /* Information about retrieval. */
  1587.     register XEvent *eventPtr;        /* X PropertyChange event. */
  1588. {
  1589.     register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
  1590.     char *propInfo;
  1591.     Atom type;
  1592.     int format, result;
  1593.     unsigned long numItems, bytesAfter;
  1594.  
  1595.     if ((eventPtr->xproperty.atom != retrPtr->property)
  1596.         || (eventPtr->xproperty.state != PropertyNewValue)
  1597.         || (retrPtr->result != -1)) {
  1598.     return;
  1599.     }
  1600.     propInfo = NULL;
  1601.     result = XGetWindowProperty(eventPtr->xproperty.display,
  1602.         eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
  1603.         True, (Atom) AnyPropertyType, &type, &format, &numItems,
  1604.         &bytesAfter, (unsigned char **) &propInfo);
  1605.     if ((result != Success) || (type == None)) {
  1606.     return;
  1607.     }
  1608.     if (bytesAfter != 0) {
  1609.     Tcl_SetResult(retrPtr->interp, "selection property too large",
  1610.         TCL_STATIC);
  1611.     retrPtr->result = TCL_ERROR;
  1612.     goto done;
  1613.     }
  1614.     if (numItems == 0) {
  1615.     retrPtr->result = TCL_OK;
  1616.     } else if ((type == XA_STRING)
  1617.         || (type == retrPtr->winPtr->dispPtr->textAtom)
  1618.         || (type == retrPtr->winPtr->dispPtr->compoundTextAtom)) {
  1619.     if (format != 8) {
  1620.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  1621.         sprintf(retrPtr->interp->result,
  1622.         "bad format for string selection: wanted \"8\", got \"%d\"",
  1623.         format);
  1624.         retrPtr->result = TCL_ERROR;
  1625.         goto done;
  1626.     }
  1627.     result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
  1628.         propInfo);
  1629.     if (result != TCL_OK) {
  1630.         retrPtr->result = result;
  1631.     }
  1632.     } else {
  1633.     char *string;
  1634.  
  1635.     if (format != 32) {
  1636.         Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
  1637.         sprintf(retrPtr->interp->result,
  1638.         "bad format for selection: wanted \"32\", got \"%d\"",
  1639.         format);
  1640.         retrPtr->result = TCL_ERROR;
  1641.         goto done;
  1642.     }
  1643.     string = SelCvtFromX((long *) propInfo, (int) numItems, type,
  1644.         (Tk_Window) retrPtr->winPtr);
  1645.     result = (*retrPtr->proc)(retrPtr->clientData, retrPtr->interp,
  1646.         string);
  1647.     if (result != TCL_OK) {
  1648.         retrPtr->result = result;
  1649.     }
  1650.     ckfree(string);
  1651.     }
  1652.  
  1653.     done:
  1654.     XFree(propInfo);
  1655.     retrPtr->idleTime = 0;
  1656. }
  1657.  
  1658. /*
  1659.  *----------------------------------------------------------------------
  1660.  *
  1661.  * TkSelPropProc --
  1662.  *
  1663.  *    This procedure is invoked when property-change events
  1664.  *    occur on windows not known to the toolkit.  Its function
  1665.  *    is to implement the sending side of the INCR selection
  1666.  *    retrieval protocol when the selection requestor deletes
  1667.  *    the property containing a part of the selection.
  1668.  *
  1669.  * Results:
  1670.  *    None.
  1671.  *
  1672.  * Side effects:
  1673.  *    If the property that is receiving the selection was just
  1674.  *    deleted, then a new piece of the selection is fetched and
  1675.  *    placed in the property, until eventually there's no more
  1676.  *    selection to fetch.
  1677.  *
  1678.  *----------------------------------------------------------------------
  1679.  */
  1680.  
  1681. void
  1682. TkSelPropProc(eventPtr)
  1683.     register XEvent *eventPtr;        /* X PropertyChange event. */
  1684. {
  1685.     register IncrInfo *infoPtr;
  1686.     int i, format;
  1687.     Atom target;
  1688.     register TkSelHandler *selPtr;
  1689.     long buffer[TK_SEL_WORDS_AT_ONCE];
  1690.     int numItems;
  1691.     char *propPtr;
  1692.     Tk_ErrorHandler errorHandler;
  1693.  
  1694.     /*
  1695.      * See if this event announces the deletion of a property being
  1696.      * used for an INCR transfer.  If so, then add the next chunk of
  1697.      * data to the property.
  1698.      */
  1699.  
  1700.     if (eventPtr->xproperty.state != PropertyDelete) {
  1701.     return;
  1702.     }
  1703.     for (infoPtr = pendingIncrs; infoPtr != NULL;
  1704.         infoPtr = infoPtr->nextPtr) {
  1705.  
  1706.     /*
  1707.      * To avoid races between selection conversions and
  1708.      * changes in selection ownership, make sure the window
  1709.      * and timestamp for the current selection match those
  1710.      * in the INCR request.
  1711.      */
  1712.  
  1713.     if ((infoPtr->reqWindow != eventPtr->xproperty.window)
  1714.         || (infoPtr->winPtr->dispPtr->selectionOwner
  1715.             != (Tk_Window) infoPtr->winPtr)
  1716.         || (infoPtr->winPtr->dispPtr->selectionTime
  1717.         != infoPtr->time)) {
  1718.         continue;
  1719.     }
  1720.     for (i = 0; i < infoPtr->numConversions; i++) {
  1721.         if ((eventPtr->xproperty.atom != infoPtr->multAtoms[2*i + 1])
  1722.             || (infoPtr->offsets[i] == -1)){
  1723.         continue;
  1724.         }
  1725.         target = infoPtr->multAtoms[2*i];
  1726.         infoPtr->idleTime = 0;
  1727.         for (selPtr = infoPtr->winPtr->selHandlerList; ;
  1728.             selPtr = selPtr->nextPtr) {
  1729.         if (selPtr == NULL) {
  1730.             infoPtr->multAtoms[2*i + 1] = None;
  1731.             infoPtr->offsets[i] = -1;
  1732.             infoPtr->numIncrs --;
  1733.             return;
  1734.         }
  1735.         if (selPtr->target == target) {
  1736.             if (infoPtr->offsets[i] == -2) {
  1737.             numItems = 0;
  1738.             ((char *) buffer)[0] = 0;
  1739.             } else {
  1740.             numItems = (*selPtr->proc)(selPtr->clientData,
  1741.                 infoPtr->offsets[i], (char *) buffer,
  1742.                 TK_SEL_BYTES_AT_ONCE);
  1743.             if (numItems > TK_SEL_BYTES_AT_ONCE) {
  1744.                 panic("selection handler returned too many bytes");
  1745.             } else {
  1746.                 if (numItems < 0) {
  1747.                 numItems = 0;
  1748.                 }
  1749.             }
  1750.             ((char *) buffer)[numItems] = '\0';
  1751.             }
  1752.             if (numItems < TK_SEL_BYTES_AT_ONCE) {
  1753.             if (numItems <= 0) {
  1754.                 infoPtr->offsets[i] = -1;
  1755.                 infoPtr->numIncrs--;
  1756.             } else {
  1757.                 infoPtr->offsets[i] = -2;
  1758.             }
  1759.             } else {
  1760.             infoPtr->offsets[i] += numItems;
  1761.             }
  1762.             if (selPtr->format == XA_STRING) {
  1763.             propPtr = (char *) buffer;
  1764.             format = 8;
  1765.             } else {
  1766.             propPtr = (char *) SelCvtToX((char *) buffer,
  1767.                 selPtr->format,
  1768.                 (Tk_Window) infoPtr->winPtr,
  1769.                 &numItems);
  1770.             format = 32;
  1771.             }
  1772.             errorHandler = Tk_CreateErrorHandler(
  1773.                 eventPtr->xproperty.display, -1, -1, -1,
  1774.                 (int (*)()) NULL, (ClientData) NULL);
  1775.             XChangeProperty(eventPtr->xproperty.display,
  1776.                 eventPtr->xproperty.window,
  1777.                 eventPtr->xproperty.atom, selPtr->format,
  1778.                 format, PropModeReplace,
  1779.                 (unsigned char *) propPtr, numItems);
  1780.             Tk_DeleteErrorHandler(errorHandler);
  1781.             if (propPtr != (char *) buffer) {
  1782.             ckfree(propPtr);
  1783.             }
  1784.             return;
  1785.         }
  1786.         }
  1787.     }
  1788.     }
  1789. }
  1790.  
  1791. /*
  1792.  *----------------------------------------------------------------------
  1793.  *
  1794.  * HandleTclCommand --
  1795.  *
  1796.  *    This procedure acts as selection handler for handlers created
  1797.  *    by the "selection handle" command.  It invokes a Tcl command to
  1798.  *    retrieve the selection.
  1799.  *
  1800.  * Results:
  1801.  *    The return value is a count of the number of bytes actually
  1802.  *    stored at buffer, or -1 if an error occurs while executing
  1803.  *    the Tcl command to retrieve the selection.
  1804.  *
  1805.  * Side effects:
  1806.  *    None except for things done by the Tcl command.
  1807.  *
  1808.  *----------------------------------------------------------------------
  1809.  */
  1810.  
  1811. static int
  1812. HandleTclCommand(clientData, offset, buffer, maxBytes)
  1813.     ClientData clientData;    /* Information about command to execute. */
  1814.     int offset;            /* Return selection bytes starting at this
  1815.                  * offset. */
  1816.     char *buffer;        /* Place to store converted selection. */
  1817.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  1818. {
  1819.     register CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
  1820.     char *oldResultString;
  1821.     Tcl_FreeProc *oldFreeProc;
  1822.     int spaceNeeded, length;
  1823. #define MAX_STATIC_SIZE 100
  1824.     char staticSpace[MAX_STATIC_SIZE];
  1825.     char *command;
  1826.  
  1827.     /*
  1828.      * First, generate a command by taking the command string
  1829.      * and appending the offset and maximum # of bytes.
  1830.      */
  1831.  
  1832.     spaceNeeded = cmdInfoPtr->cmdLength + 30;
  1833.     if (spaceNeeded < MAX_STATIC_SIZE) {
  1834.     command = staticSpace;
  1835.     } else {
  1836.     command = (char *) ckalloc((unsigned) spaceNeeded);
  1837.     }
  1838.     sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
  1839.  
  1840.     /*
  1841.      * Execute the command.  Be sure to restore the state of the
  1842.      * interpreter after executing the command.
  1843.      */
  1844.  
  1845.     oldFreeProc = cmdInfoPtr->interp->freeProc;
  1846.     if (oldFreeProc != 0) {
  1847.     oldResultString = cmdInfoPtr->interp->result;
  1848.     } else {
  1849.     oldResultString = (char *) ckalloc((unsigned)
  1850.         (strlen(cmdInfoPtr->interp->result) + 1));
  1851.     strcpy(oldResultString, cmdInfoPtr->interp->result);
  1852.     oldFreeProc = TCL_DYNAMIC;
  1853.     }
  1854.     cmdInfoPtr->interp->freeProc = 0;
  1855.     if (TkCopyAndGlobalEval(cmdInfoPtr->interp, command) == TCL_OK) {
  1856.     length = strlen(cmdInfoPtr->interp->result);
  1857.     if (length > maxBytes) {
  1858.         length = maxBytes;
  1859.     }
  1860.     memcpy((VOID *) buffer, (VOID *) cmdInfoPtr->interp->result, length);
  1861.     buffer[length] = '\0';
  1862.     } else {
  1863.     length = -1;
  1864.     }
  1865.     Tcl_FreeResult(cmdInfoPtr->interp);
  1866.     cmdInfoPtr->interp->result = oldResultString;
  1867.     cmdInfoPtr->interp->freeProc = oldFreeProc;
  1868.  
  1869.     if (command != staticSpace) {
  1870.     ckfree(command);
  1871.     }
  1872.  
  1873.     return length;
  1874. }
  1875.  
  1876. /*
  1877.  *----------------------------------------------------------------------
  1878.  *
  1879.  * SelTimeoutProc --
  1880.  *
  1881.  *    This procedure is invoked once every second while waiting for
  1882.  *    the selection to be returned.  After a while it gives up and
  1883.  *    aborts the selection retrieval.
  1884.  *
  1885.  * Results:
  1886.  *    None.
  1887.  *
  1888.  * Side effects:
  1889.  *    A new timer callback is created to call us again in another
  1890.  *    second, unless time has expired, in which case an error is
  1891.  *    recorded for the retrieval.
  1892.  *
  1893.  *----------------------------------------------------------------------
  1894.  */
  1895.  
  1896. static void
  1897. SelTimeoutProc(clientData)
  1898.     ClientData clientData;        /* Information about retrieval
  1899.                      * in progress. */
  1900. {
  1901.     register RetrievalInfo *retrPtr = (RetrievalInfo *) clientData;
  1902.  
  1903.     /*
  1904.      * Make sure that the retrieval is still in progress.  Then
  1905.      * see how long it's been since any sort of response was received
  1906.      * from the other side.
  1907.      */
  1908.  
  1909.     if (retrPtr->result != -1) {
  1910.     return;
  1911.     }
  1912.     retrPtr->idleTime++;
  1913.     if (retrPtr->idleTime >= 5) {
  1914.  
  1915.     /*
  1916.      * Use a careful procedure to store the error message, because
  1917.      * the result could already be partially filled in with a partial
  1918.      * selection return.
  1919.      */
  1920.  
  1921.     Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
  1922.         TCL_STATIC);
  1923.     retrPtr->result = TCL_ERROR;
  1924.     } else {
  1925.     retrPtr->timeout = Tk_CreateTimerHandler(1000, SelTimeoutProc,
  1926.         (ClientData) retrPtr);
  1927.     }
  1928. }
  1929.  
  1930. /*
  1931.  *----------------------------------------------------------------------
  1932.  *
  1933.  * IncrTimeoutProc --
  1934.  *
  1935.  *    This procedure is invoked once a second while sending the
  1936.  *    selection to a requestor in INCR mode.  After a while it
  1937.  *    gives up and aborts the selection operation.
  1938.  *
  1939.  * Results:
  1940.  *    None.
  1941.  *
  1942.  * Side effects:
  1943.  *    A new timeout gets registered so that this procedure gets
  1944.  *    called again in another second, unless too many seconds
  1945.  *    have elapsed, in which case infoPtr is marked as "all done".
  1946.  *
  1947.  *----------------------------------------------------------------------
  1948.  */
  1949.  
  1950. static void
  1951. IncrTimeoutProc(clientData)
  1952.     ClientData clientData;        /* Information about INCR-mode
  1953.                      * selection retrieval for which
  1954.                      * we are selection owner. */
  1955. {
  1956.     register IncrInfo *infoPtr = (IncrInfo *) clientData;
  1957.  
  1958.     infoPtr->idleTime++;
  1959.     if (infoPtr->idleTime >= 5) {
  1960.     infoPtr->numIncrs = 0;
  1961.     } else {
  1962.     infoPtr->timeout = Tk_CreateTimerHandler(1000, IncrTimeoutProc,
  1963.         (ClientData) infoPtr);
  1964.     }
  1965. }
  1966.  
  1967. /*
  1968.  *----------------------------------------------------------------------
  1969.  *
  1970.  * DefaultSelection --
  1971.  *
  1972.  *    This procedure is called to generate selection information
  1973.  *    for a few standard targets such as TIMESTAMP and TARGETS.
  1974.  *    It is invoked only if no handler has been declared by the
  1975.  *    application.
  1976.  *
  1977.  * Results:
  1978.  *    If "target" is a standard target understood by this procedure,
  1979.  *    the selection is converted to that form and stored as a
  1980.  *    character string in buffer.  The type of the selection (e.g.
  1981.  *    STRING or ATOM) is stored in *typePtr, and the return value is
  1982.  *    a count of the # of non-NULL bytes at buffer.  If the target
  1983.  *    wasn't understood, or if there isn't enough space at buffer
  1984.  *    to hold the entire selection (no INCR-mode transfers for this
  1985.  *    stuff!), then -1 is returned.
  1986.  *
  1987.  * Side effects:
  1988.  *    None.
  1989.  *
  1990.  *----------------------------------------------------------------------
  1991.  */
  1992.  
  1993. static int
  1994. DefaultSelection(winPtr, target, buffer, maxBytes, typePtr)
  1995.     TkWindow *winPtr;        /* Window that owns selection. */
  1996.     Atom target;        /* Desired form of selection. */
  1997.     char *buffer;        /* Place to put selection characters. */
  1998.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  1999.     Atom *typePtr;        /* Store here the type of the selection,
  2000.                  * for use in converting to proper X format. */
  2001. {
  2002.     if (target == winPtr->dispPtr->timestampAtom) {
  2003.     if (maxBytes < 20) {
  2004.         return -1;
  2005.     }
  2006.     sprintf(buffer, "%#x", winPtr->dispPtr->selectionTime);
  2007.     *typePtr = XA_INTEGER;
  2008.     return strlen(buffer);
  2009.     }
  2010.  
  2011.     if (target == winPtr->dispPtr->targetsAtom) {
  2012.     register TkSelHandler *selPtr;
  2013.     char *atomString;
  2014.     int length, atomLength;
  2015.  
  2016.     if (maxBytes < 50) {
  2017.         return -1;
  2018.     }
  2019.     strcpy(buffer, "APPLICATION MULTIPLE TARGETS TIMESTAMP WINDOW_NAME");
  2020.     length = strlen(buffer);
  2021.     for (selPtr = winPtr->selHandlerList; selPtr != NULL;
  2022.         selPtr = selPtr->nextPtr) {
  2023.         atomString = Tk_GetAtomName((Tk_Window) winPtr, selPtr->target);
  2024.         atomLength = strlen(atomString) + 1;
  2025.         if ((length + atomLength) >= maxBytes) {
  2026.         return -1;
  2027.         }
  2028.         sprintf(buffer+length, " %s", atomString);
  2029.         length += atomLength;
  2030.     }
  2031.     *typePtr = XA_ATOM;
  2032.     return length;
  2033.     }
  2034.  
  2035.     if (target == winPtr->dispPtr->applicationAtom) {
  2036.     int length;
  2037.     char *name = winPtr->mainPtr->winPtr->nameUid;
  2038.  
  2039.     length = strlen(name);
  2040.     if (maxBytes <= length) {
  2041.         return -1;
  2042.     }
  2043.     strcpy(buffer, name);
  2044.     *typePtr = XA_STRING;
  2045.     return length;
  2046.     }
  2047.  
  2048.     if (target == winPtr->dispPtr->windowNameAtom) {
  2049.     int length;
  2050.     char *name = winPtr->pathName;
  2051.  
  2052.     length = strlen(name);
  2053.     if (maxBytes <= length) {
  2054.         return -1;
  2055.     }
  2056.     strcpy(buffer, name);
  2057.     *typePtr = XA_STRING;
  2058.     return length;
  2059.     }
  2060.  
  2061.     return -1;
  2062. }
  2063.  
  2064. /*
  2065.  *----------------------------------------------------------------------
  2066.  *
  2067.  * LostSelection --
  2068.  *
  2069.  *    This procedure is invoked when a window has lost ownership of
  2070.  *    the selection and the ownership was claimed with the command
  2071.  *    "selection own".
  2072.  *
  2073.  * Results:
  2074.  *    None.
  2075.  *
  2076.  * Side effects:
  2077.  *    A Tcl script is executed;  it can do almost anything.
  2078.  *
  2079.  *----------------------------------------------------------------------
  2080.  */
  2081.  
  2082. static void
  2083. LostSelection(clientData)
  2084.     ClientData clientData;        /* Pointer to zCommandInfo structure. */
  2085. {
  2086.     LostCommand *lostPtr = (LostCommand *) clientData;
  2087.     char *oldResultString;
  2088.     Tcl_FreeProc *oldFreeProc;
  2089.  
  2090.     /*
  2091.      * Execute the command.  Save the interpreter's result, if any, and
  2092.      * restore it after executing the command.
  2093.      */
  2094.  
  2095.     oldFreeProc = lostPtr->interp->freeProc;
  2096.     if (oldFreeProc != 0) {
  2097.     oldResultString = lostPtr->interp->result;
  2098.     } else {
  2099.     oldResultString = (char *) ckalloc((unsigned)
  2100.         (strlen(lostPtr->interp->result) + 1));
  2101.     strcpy(oldResultString, lostPtr->interp->result);
  2102.     oldFreeProc = TCL_DYNAMIC;
  2103.     }
  2104.     lostPtr->interp->freeProc = 0;
  2105.     if (TkCopyAndGlobalEval(lostPtr->interp, lostPtr->command) != TCL_OK) {
  2106.     Tk_BackgroundError(lostPtr->interp);
  2107.     }
  2108.     Tcl_FreeResult(lostPtr->interp);
  2109.     lostPtr->interp->result = oldResultString;
  2110.     lostPtr->interp->freeProc = oldFreeProc;
  2111.  
  2112.     /*
  2113.      * Free the storage for the command, since we're done with it now.
  2114.      */
  2115.  
  2116.     ckfree((char *) lostPtr);
  2117. }
  2118.