home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkSelect.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  39.0 KB  |  1,398 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.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10.  *
  11.  * See the file "license.terms" for information on usage and redistribution
  12.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13.  *
  14.  * SCCS: @(#) tkSelect.c 1.56 96/03/21 13:16:29
  15.  */
  16.  
  17. #include "tkInt.h"
  18. #include "tkSelect.h"
  19.  
  20. /*
  21.  * When a selection handler is set up by invoking "selection handle",
  22.  * one of the following data structures is set up to hold information
  23.  * about the command to invoke and its interpreter.
  24.  */
  25.  
  26. typedef struct {
  27.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  28.     int cmdLength;        /* # of non-NULL bytes in command. */
  29.     char command[4];        /* Command to invoke.  Actual space is
  30.                  * allocated as large as necessary.  This
  31.                  * must be the last entry in the structure. */
  32. } CommandInfo;
  33.  
  34. /*
  35.  * When selection ownership is claimed with the "selection own" Tcl command,
  36.  * one of the following structures is created to record the Tcl command
  37.  * to be executed when the selection is lost again.
  38.  */
  39.  
  40. typedef struct LostCommand {
  41.     Tcl_Interp *interp;        /* Interpreter in which to invoke command. */
  42.     char command[4];        /* Command to invoke.  Actual space is
  43.                  * allocated as large as necessary.  This
  44.                  * must be the last entry in the structure. */
  45. } LostCommand;
  46.  
  47. /*
  48.  * Shared variables:
  49.  */
  50.  
  51. TkSelInProgress *pendingPtr = NULL;
  52.                 /* Topmost search in progress, or
  53.                  * NULL if none. */
  54.  
  55. /*
  56.  * Forward declarations for procedures defined in this file:
  57.  */
  58.  
  59. static int        HandleTclCommand _ANSI_ARGS_((ClientData clientData,
  60.                 int offset, char *buffer, int maxBytes));
  61. static void        LostSelection _ANSI_ARGS_((ClientData clientData));
  62. static int        SelGetProc _ANSI_ARGS_((ClientData clientData,
  63.                 Tcl_Interp *interp, char *portion));
  64.  
  65. /*
  66.  *--------------------------------------------------------------
  67.  *
  68.  * Tk_CreateSelHandler --
  69.  *
  70.  *    This procedure is called to register a procedure
  71.  *    as the handler for selection requests of a particular
  72.  *    target type on a particular window for a particular
  73.  *    selection.
  74.  *
  75.  * Results:
  76.  *    None.
  77.  *
  78.  * Side effects:
  79.  *    In the future, whenever the selection is in tkwin's
  80.  *    window and someone requests the selection in the
  81.  *    form given by target, proc will be invoked to provide
  82.  *    part or all of the selection in the given form.  If
  83.  *    there was already a handler declared for the given
  84.  *    window, target and selection type, then it is replaced.
  85.  *    Proc should have the following form:
  86.  *
  87.  *    int
  88.  *    proc(clientData, offset, buffer, maxBytes)
  89.  *        ClientData clientData;
  90.  *        int offset;
  91.  *        char *buffer;
  92.  *        int maxBytes;
  93.  *    {
  94.  *    }
  95.  *
  96.  *    The clientData argument to proc will be the same as
  97.  *    the clientData argument to this procedure.  The offset
  98.  *    argument indicates which portion of the selection to
  99.  *    return:  skip the first offset bytes.  Buffer is a
  100.  *    pointer to an area in which to place the converted
  101.  *    selection, and maxBytes gives the number of bytes
  102.  *    available at buffer.  Proc should place the selection
  103.  *    in buffer as a string, and return a count of the number
  104.  *    of bytes of selection actually placed in buffer (not
  105.  *    including the terminating NULL character).  If the
  106.  *    return value equals maxBytes, this is a sign that there
  107.  *    is probably still more selection information available.
  108.  *
  109.  *--------------------------------------------------------------
  110.  */
  111.  
  112. void
  113. Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format)
  114.     Tk_Window tkwin;        /* Token for window. */
  115.     Atom selection;        /* Selection to be handled. */
  116.     Atom target;        /* The kind of selection conversions
  117.                  * that can be handled by proc,
  118.                  * e.g. TARGETS or STRING. */
  119.     Tk_SelectionProc *proc;    /* Procedure to invoke to convert
  120.                  * selection to type "target". */
  121.     ClientData clientData;    /* Value to pass to proc. */
  122.     Atom format;        /* Format in which the selection
  123.                  * information should be returned to
  124.                  * the requestor. XA_STRING is best by
  125.                  * far, but anything listed in the ICCCM
  126.                  * will be tolerated (blech). */
  127. {
  128.     register TkSelHandler *selPtr;
  129.     TkWindow *winPtr = (TkWindow *) tkwin;
  130.  
  131.     if (winPtr->dispPtr->multipleAtom == None) {
  132.     TkSelInit(tkwin);
  133.     }
  134.  
  135.     /*
  136.      * See if there's already a handler for this target and selection on
  137.      * this window.  If so, re-use it.  If not, create a new one.
  138.      */
  139.  
  140.     for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
  141.     if (selPtr == NULL) {
  142.         selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
  143.         selPtr->nextPtr = winPtr->selHandlerList;
  144.         winPtr->selHandlerList = selPtr;
  145.         break;
  146.     }
  147.     if ((selPtr->selection == selection) && (selPtr->target == target)) {
  148.  
  149.         /*
  150.          * Special case:  when replacing handler created by
  151.          * "selection handle", free up memory.  Should there be a
  152.          * callback to allow other clients to do this too?
  153.          */
  154.  
  155.         if (selPtr->proc == HandleTclCommand) {
  156.         ckfree((char *) selPtr->clientData);
  157.         }
  158.         break;
  159.     }
  160.     }
  161.     selPtr->selection = selection;
  162.     selPtr->target = target;
  163.     selPtr->format = format;
  164.     selPtr->proc = proc;
  165.     selPtr->clientData = clientData;
  166.     if (format == XA_STRING) {
  167.     selPtr->size = 8;
  168.     } else {
  169.     selPtr->size = 32;
  170.     }
  171. }
  172.  
  173. /*
  174.  *----------------------------------------------------------------------
  175.  *
  176.  * Tk_DeleteSelHandler --
  177.  *
  178.  *    Remove the selection handler for a given window, target, and
  179.  *    selection, if it exists.
  180.  *
  181.  * Results:
  182.  *    None.
  183.  *
  184.  * Side effects:
  185.  *    The selection handler for tkwin and target is removed.  If there
  186.  *    is no such handler then nothing happens.
  187.  *
  188.  *----------------------------------------------------------------------
  189.  */
  190.  
  191. void
  192. Tk_DeleteSelHandler(tkwin, selection, target)
  193.     Tk_Window tkwin;            /* Token for window. */
  194.     Atom selection;            /* The selection whose handler
  195.                      * is to be removed. */
  196.     Atom target;            /* The target whose selection
  197.                      * handler is to be removed. */
  198. {
  199.     TkWindow *winPtr = (TkWindow *) tkwin;
  200.     register TkSelHandler *selPtr, *prevPtr;
  201.     register TkSelInProgress *ipPtr;
  202.  
  203.     /*
  204.      * Find the selection handler to be deleted, or return if it doesn't
  205.      * exist.
  206.      */ 
  207.  
  208.     for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
  209.         prevPtr = selPtr, selPtr = selPtr->nextPtr) {
  210.     if (selPtr == NULL) {
  211.         return;
  212.     }
  213.     if ((selPtr->selection == selection) && (selPtr->target == target)) {
  214.         break;
  215.     }
  216.     }
  217.  
  218.     /*
  219.      * If ConvertSelection is processing this handler, tell it that the
  220.      * handler is dead.
  221.      */
  222.  
  223.     for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
  224.     if (ipPtr->selPtr == selPtr) {
  225.         ipPtr->selPtr = NULL;
  226.     }
  227.     }
  228.  
  229.     /*
  230.      * Free resources associated with the handler.
  231.      */
  232.  
  233.     if (prevPtr == NULL) {
  234.     winPtr->selHandlerList = selPtr->nextPtr;
  235.     } else {
  236.     prevPtr->nextPtr = selPtr->nextPtr;
  237.     }
  238.     if (selPtr->proc == HandleTclCommand) {
  239.     ckfree((char *) selPtr->clientData);
  240.     }
  241.     ckfree((char *) selPtr);
  242. }
  243.  
  244. /*
  245.  *--------------------------------------------------------------
  246.  *
  247.  * Tk_OwnSelection --
  248.  *
  249.  *    Arrange for tkwin to become the owner of a selection.
  250.  *
  251.  * Results:
  252.  *    None.
  253.  *
  254.  * Side effects:
  255.  *    From now on, requests for the selection will be directed
  256.  *    to procedures associated with tkwin (they must have been
  257.  *    declared with calls to Tk_CreateSelHandler).  When the
  258.  *    selection is lost by this window, proc will be invoked
  259.  *    (see the manual entry for details).  This procedure may
  260.  *    invoke callbacks, including Tcl scripts, so any calling
  261.  *    function should be reentrant at the point where
  262.  *    Tk_OwnSelection is invoked.
  263.  *
  264.  *--------------------------------------------------------------
  265.  */
  266.  
  267. void
  268. Tk_OwnSelection(tkwin, selection, proc, clientData)
  269.     Tk_Window tkwin;        /* Window to become new selection
  270.                  * owner. */
  271.     Atom selection;        /* Selection that window should own. */
  272.     Tk_LostSelProc *proc;    /* Procedure to call when selection
  273.                  * is taken away from tkwin. */
  274.     ClientData clientData;    /* Arbitrary one-word argument to
  275.                  * pass to proc. */
  276. {
  277.     register TkWindow *winPtr = (TkWindow *) tkwin;
  278.     TkDisplay *dispPtr = winPtr->dispPtr;
  279.     TkSelectionInfo *infoPtr;
  280.     Tk_LostSelProc *clearProc = NULL;
  281.     ClientData clearData = NULL;    /* Initialization needed only to
  282.                      * prevent compiler warning. */
  283.     
  284.     
  285.     if (dispPtr->multipleAtom == None) {
  286.     TkSelInit(tkwin);
  287.     }
  288.     Tk_MakeWindowExist(tkwin);
  289.  
  290.     /*
  291.      * This code is somewhat tricky.  First, we find the specified selection
  292.      * on the selection list.  If the previous owner is in this process, and
  293.      * is a different window, then we need to invoke the clearProc.  However,
  294.      * it's dangerous to call the clearProc right now, because it could
  295.      * invoke a Tcl script that wrecks the current state (e.g. it could
  296.      * delete the window).  To be safe, defer the call until the end of the
  297.      * procedure when we no longer care about the state.
  298.      */
  299.  
  300.     for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
  301.         infoPtr = infoPtr->nextPtr) {
  302.     if (infoPtr->selection == selection) {
  303.         break;
  304.     }
  305.     }
  306.     if (infoPtr == NULL) {
  307.     infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
  308.     infoPtr->selection = selection;
  309.     infoPtr->nextPtr = dispPtr->selectionInfoPtr;
  310.     dispPtr->selectionInfoPtr = infoPtr;
  311.     } else if (infoPtr->clearProc != NULL) {
  312.     if (infoPtr->owner != tkwin) {
  313.         clearProc = infoPtr->clearProc;
  314.         clearData = infoPtr->clearData;
  315.     } else if (infoPtr->clearProc == LostSelection) {
  316.         /*
  317.          * If the selection handler is one created by "selection own",
  318.          * be sure to free the record for it;  otherwise there will be
  319.          * a memory leak.
  320.          */
  321.  
  322.         ckfree((char *) infoPtr->clearData);
  323.     }
  324.     }
  325.  
  326.     infoPtr->owner = tkwin;
  327.     infoPtr->serial = NextRequest(winPtr->display);
  328.     infoPtr->clearProc = proc;
  329.     infoPtr->clearData = clientData;
  330.  
  331.     /*
  332.      * Note that we are using CurrentTime, even though ICCCM recommends against
  333.      * this practice (the problem is that we don't necessarily have a valid
  334.      * time to use).  We will not be able to retrieve a useful timestamp for
  335.      * the TIMESTAMP target later.
  336.      */
  337.  
  338.     infoPtr->time = CurrentTime;
  339.  
  340.     /*
  341.      * Note that we are not checking to see if the selection claim succeeded.
  342.      * If the ownership does not change, then the clearProc may never be
  343.      * invoked, and we will return incorrect information when queried for the
  344.      * current selection owner.
  345.      */
  346.  
  347.     XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
  348.         infoPtr->time);
  349.  
  350.     /*
  351.      * Now that we are done, we can invoke clearProc without running into
  352.      * reentrancy problems.
  353.      */
  354.  
  355.     if (clearProc != NULL) {
  356.     (*clearProc)(clearData);
  357.     }
  358. }
  359.  
  360. /*
  361.  *----------------------------------------------------------------------
  362.  *
  363.  * Tk_ClearSelection --
  364.  *
  365.  *    Eliminate the specified selection on tkwin's display, if there is one.
  366.  *
  367.  * Results:
  368.  *    None.
  369.  *
  370.  * Side effects:
  371.  *    The specified selection is cleared, so that future requests to retrieve
  372.  *    it will fail until some application owns it again.  This procedure
  373.  *    invokes callbacks, possibly including Tcl scripts, so any calling
  374.  *    function should be reentrant at the point Tk_ClearSelection is invoked.
  375.  *
  376.  *----------------------------------------------------------------------
  377.  */
  378.  
  379. void
  380. Tk_ClearSelection(tkwin, selection)
  381.     Tk_Window tkwin;        /* Window that selects a display. */
  382.     Atom selection;        /* Selection to be cancelled. */
  383. {
  384.     register TkWindow *winPtr = (TkWindow *) tkwin;
  385.     TkDisplay *dispPtr = winPtr->dispPtr;
  386.     TkSelectionInfo *infoPtr;
  387.     TkSelectionInfo *prevPtr;
  388.     TkSelectionInfo *nextPtr;
  389.     Tk_LostSelProc *clearProc = NULL;
  390.     ClientData clearData = NULL;    /* Initialization needed only to
  391.                      * prevent compiler warning. */
  392.  
  393.     if (dispPtr->multipleAtom == None) {
  394.     TkSelInit(tkwin);
  395.     }
  396.  
  397.     for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
  398.          infoPtr != NULL; infoPtr = nextPtr) {
  399.     nextPtr = infoPtr->nextPtr;
  400.     if (infoPtr->selection == selection) {
  401.         if (prevPtr == NULL) {
  402.         dispPtr->selectionInfoPtr = nextPtr;
  403.         } else {
  404.         prevPtr->nextPtr = nextPtr;
  405.         }
  406.         break;
  407.     }
  408.     prevPtr = infoPtr;
  409.     }
  410.     
  411.     if (infoPtr != NULL) {
  412.     clearProc = infoPtr->clearProc;
  413.     clearData = infoPtr->clearData;
  414.     ckfree((char *) infoPtr);
  415.     }
  416.     XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
  417.  
  418.     if (clearProc != NULL) {
  419.     (*clearProc)(clearData);
  420.     }
  421. }
  422.  
  423. /*
  424.  *--------------------------------------------------------------
  425.  *
  426.  * Tk_GetSelection --
  427.  *
  428.  *    Retrieve the value of a selection and pass it off (in
  429.  *    pieces, possibly) to a given procedure.
  430.  *
  431.  * Results:
  432.  *    The return value is a standard Tcl return value.
  433.  *    If an error occurs (such as no selection exists)
  434.  *    then an error message is left in interp->result.
  435.  *
  436.  * Side effects:
  437.  *    The standard X11 protocols are used to retrieve the
  438.  *    selection.  When it arrives, it is passed to proc.  If
  439.  *    the selection is very large, it will be passed to proc
  440.  *    in several pieces.  Proc should have the following
  441.  *    structure:
  442.  *
  443.  *    int
  444.  *    proc(clientData, interp, portion)
  445.  *        ClientData clientData;
  446.  *        Tcl_Interp *interp;
  447.  *        char *portion;
  448.  *    {
  449.  *    }
  450.  *
  451.  *    The interp and clientData arguments to proc will be the
  452.  *    same as the corresponding arguments to Tk_GetSelection.
  453.  *    The portion argument points to a character string
  454.  *    containing part of the selection, and numBytes indicates
  455.  *    the length of the portion, not including the terminating
  456.  *    NULL character.  If the selection arrives in several pieces,
  457.  *    the "portion" arguments in separate calls will contain
  458.  *    successive parts of the selection.  Proc should normally
  459.  *    return TCL_OK.  If it detects an error then it should return
  460.  *    TCL_ERROR and leave an error message in interp->result; the
  461.  *    remainder of the selection retrieval will be aborted.
  462.  *
  463.  *--------------------------------------------------------------
  464.  */
  465.  
  466. int
  467. Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
  468.     Tcl_Interp *interp;        /* Interpreter to use for reporting
  469.                  * errors. */
  470.     Tk_Window tkwin;        /* Window on whose behalf to retrieve
  471.                  * the selection (determines display
  472.                  * from which to retrieve). */
  473.     Atom selection;        /* Selection to retrieve. */
  474.     Atom target;        /* Desired form in which selection
  475.                  * is to be returned. */
  476.     Tk_GetSelProc *proc;    /* Procedure to call to process the
  477.                  * selection, once it has been retrieved. */
  478.     ClientData clientData;    /* Arbitrary value to pass to proc. */
  479. {
  480.     TkWindow *winPtr = (TkWindow *) tkwin;
  481.     TkDisplay *dispPtr = winPtr->dispPtr;
  482.     TkSelectionInfo *infoPtr;
  483.  
  484.     if (dispPtr->multipleAtom == None) {
  485.     TkSelInit(tkwin);
  486.     }
  487.  
  488.     /*
  489.      * If the selection is owned by a window managed by this
  490.      * process, then call the retrieval procedure directly,
  491.      * rather than going through the X server (it's dangerous
  492.      * to go through the X server in this case because it could
  493.      * result in deadlock if an INCR-style selection results).
  494.      */
  495.  
  496.     for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
  497.         infoPtr = infoPtr->nextPtr) {
  498.     if (infoPtr->selection == selection)
  499.         break;
  500.     }
  501.     if (infoPtr != NULL) {
  502.     register TkSelHandler *selPtr;
  503.     int offset, result, count;
  504.     char buffer[TK_SEL_BYTES_AT_ONCE+1];
  505.     TkSelInProgress ip;
  506.  
  507.     for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
  508.         selPtr != NULL; selPtr = selPtr->nextPtr) {
  509.         if ((selPtr->target == target)
  510.             && (selPtr->selection == selection)) {
  511.         break;
  512.         }
  513.     }
  514.     if (selPtr == NULL) {
  515.         Atom type;
  516.  
  517.         count = TkSelDefaultSelection(infoPtr, target, buffer,
  518.             TK_SEL_BYTES_AT_ONCE, &type);
  519.         if (count > TK_SEL_BYTES_AT_ONCE) {
  520.         panic("selection handler returned too many bytes");
  521.         }
  522.         if (count < 0) {
  523.         goto cantget;
  524.         }
  525.         buffer[count] = 0;
  526.         result = (*proc)(clientData, interp, buffer);
  527.     } else {
  528.         offset = 0;
  529.         result = TCL_OK;
  530.         ip.selPtr = selPtr;
  531.         ip.nextPtr = pendingPtr;
  532.         pendingPtr = &ip;
  533.         while (1) {
  534.         count = (selPtr->proc)(selPtr->clientData, offset, buffer,
  535.             TK_SEL_BYTES_AT_ONCE);
  536.         if ((count < 0) || (ip.selPtr == NULL)) {
  537.             pendingPtr = ip.nextPtr;
  538.             goto cantget;
  539.         }
  540.         if (count > TK_SEL_BYTES_AT_ONCE) {
  541.             panic("selection handler returned too many bytes");
  542.         }
  543.         buffer[count] = '\0';
  544.         result = (*proc)(clientData, interp, buffer);
  545.         if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
  546.             || (ip.selPtr == NULL)) {
  547.             break;
  548.         }
  549.         offset += count;
  550.         }
  551.         pendingPtr = ip.nextPtr;
  552.     }
  553.     return result;
  554.     }
  555.  
  556.     /*
  557.      * The selection is owned by some other process.
  558.      */
  559.  
  560.     return TkSelGetSelection(interp, tkwin, selection, target, proc,
  561.         clientData);
  562.  
  563.     cantget:
  564.     Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
  565.     " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
  566.     "\" not defined", (char *) NULL);
  567.     return TCL_ERROR;
  568. }
  569.  
  570. /*
  571.  *--------------------------------------------------------------
  572.  *
  573.  * Tk_SelectionCmd --
  574.  *
  575.  *    This procedure is invoked to process the "selection" Tcl
  576.  *    command.  See the user documentation for details on what
  577.  *    it does.
  578.  *
  579.  * Results:
  580.  *    A standard Tcl result.
  581.  *
  582.  * Side effects:
  583.  *    See the user documentation.
  584.  *
  585.  *--------------------------------------------------------------
  586.  */
  587.  
  588. int
  589. Tk_SelectionCmd(clientData, interp, argc, argv)
  590.     ClientData clientData;    /* Main window associated with
  591.                  * interpreter. */
  592.     Tcl_Interp *interp;        /* Current interpreter. */
  593.     int argc;            /* Number of arguments. */
  594.     char **argv;        /* Argument strings. */
  595. {
  596.     Tk_Window tkwin = (Tk_Window) clientData;
  597.     char *path = NULL;
  598.     Atom selection;
  599.     char *selName = NULL;
  600.     int c, count;
  601.     size_t length;
  602.     char **args;
  603.  
  604.     if (argc < 2) {
  605.     sprintf(interp->result,
  606.         "wrong # args: should be \"%.50s option ?arg arg ...?\"",
  607.         argv[0]);
  608.     return TCL_ERROR;
  609.     }
  610.     c = argv[1][0];
  611.     length = strlen(argv[1]);
  612.     if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
  613.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  614.         if (args[0][0] != '-') {
  615.         break;
  616.         }
  617.         if (count < 2) {
  618.         Tcl_AppendResult(interp, "value for \"", *args,
  619.             "\" missing", (char *) NULL);
  620.         return TCL_ERROR;
  621.         }
  622.         c = args[0][1];
  623.         length = strlen(args[0]);
  624.         if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
  625.         path = args[1];
  626.         } else if ((c == 's')
  627.             && (strncmp(args[0], "-selection", length) == 0)) {
  628.         selName = args[1];
  629.         } else {
  630.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  631.             "\"", (char *) NULL);
  632.         return TCL_ERROR;
  633.         }
  634.     }
  635.     if (count == 1) {
  636.         path = args[0];
  637.     } else if (count > 1) {
  638.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  639.             " clear ?options?\"", (char *) NULL);
  640.         return TCL_ERROR;
  641.     }
  642.     if (path != NULL) {
  643.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  644.     }
  645.     if (tkwin == NULL) {
  646.         return TCL_ERROR;
  647.     }
  648.     if (selName != NULL) {
  649.         selection = Tk_InternAtom(tkwin, selName);
  650.     } else {
  651.         selection = XA_PRIMARY;
  652.     }
  653.         
  654.     Tk_ClearSelection(tkwin, selection);
  655.     return TCL_OK;
  656.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  657.     Atom target;
  658.     char *targetName = NULL;
  659.     Tcl_DString selBytes;
  660.     int result;
  661.     
  662.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  663.         if (args[0][0] != '-') {
  664.         break;
  665.         }
  666.         if (count < 2) {
  667.         Tcl_AppendResult(interp, "value for \"", *args,
  668.             "\" missing", (char *) NULL);
  669.         return TCL_ERROR;
  670.         }
  671.         c = args[0][1];
  672.         length = strlen(args[0]);
  673.         if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
  674.         path = args[1];
  675.         } else if ((c == 's')
  676.             && (strncmp(args[0], "-selection", length) == 0)) {
  677.         selName = args[1];
  678.         } else if ((c == 't')
  679.             && (strncmp(args[0], "-type", length) == 0)) {
  680.         targetName = args[1];
  681.         } else {
  682.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  683.             "\"", (char *) NULL);
  684.         return TCL_ERROR;
  685.         }
  686.     }
  687.     if (path != NULL) {
  688.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  689.     }
  690.     if (tkwin == NULL) {
  691.         return TCL_ERROR;
  692.     }
  693.     if (selName != NULL) {
  694.         selection = Tk_InternAtom(tkwin, selName);
  695.     } else {
  696.         selection = XA_PRIMARY;
  697.     }
  698.     if (count > 1) {
  699.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  700.             " get ?options?\"", (char *) NULL);
  701.         return TCL_ERROR;
  702.     } else if (count == 1) {
  703.         target = Tk_InternAtom(tkwin, args[0]);
  704.     } else if (targetName != NULL) {
  705.         target = Tk_InternAtom(tkwin, targetName);
  706.     } else {
  707.         target = XA_STRING;
  708.     }
  709.  
  710.     Tcl_DStringInit(&selBytes);
  711.     result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc,
  712.         (ClientData) &selBytes);
  713.     if (result == TCL_OK) {
  714. #ifdef STk_CODE
  715.         STk_stringify_result(interp, Tcl_DStringValue(&selBytes));
  716.         /* DString re-initialization not useful here */
  717. #else
  718.         Tcl_DStringResult(interp, &selBytes);
  719. #endif
  720.     } else {
  721.         Tcl_DStringFree(&selBytes);
  722.     }
  723.     return result;
  724.     } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
  725.     Atom target, format;
  726.     char *targetName = NULL;
  727.     char *formatName = NULL;
  728.     register CommandInfo *cmdInfoPtr;
  729.     int cmdLength;
  730.     
  731.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  732.         if (args[0][0] != '-') {
  733.         break;
  734.         }
  735.         if (count < 2) {
  736.         Tcl_AppendResult(interp, "value for \"", *args,
  737.             "\" missing", (char *) NULL);
  738.         return TCL_ERROR;
  739.         }
  740.         c = args[0][1];
  741.         length = strlen(args[0]);
  742.         if ((c == 'f') && (strncmp(args[0], "-format", length) == 0)) {
  743.         formatName = args[1];
  744.         } else if ((c == 's')
  745.             && (strncmp(args[0], "-selection", length) == 0)) {
  746.         selName = args[1];
  747.         } else if ((c == 't')
  748.             && (strncmp(args[0], "-type", length) == 0)) {
  749.         targetName = args[1];
  750.         } else {
  751.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  752.             "\"", (char *) NULL);
  753.         return TCL_ERROR;
  754.         }
  755.     }
  756.  
  757.     if ((count < 2) || (count > 4)) {
  758.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  759.             " handle ?options? window command\"", (char *) NULL);
  760.         return TCL_ERROR;
  761.     }
  762.     tkwin = Tk_NameToWindow(interp, args[0], tkwin);
  763.     if (tkwin == NULL) {
  764.         return TCL_ERROR;
  765.     }
  766.     if (selName != NULL) {
  767.         selection = Tk_InternAtom(tkwin, selName);
  768.     } else {
  769.         selection = XA_PRIMARY;
  770. #ifdef STk_CODE
  771.         selName = "XA_PRIMARY";
  772. #endif
  773.     }
  774.         
  775.     if (count > 2) {
  776.         target = Tk_InternAtom(tkwin, args[2]);
  777. #ifdef STk_CODE
  778.         targetName = args[2];
  779. #endif
  780.     } else if (targetName != NULL) {
  781.         target = Tk_InternAtom(tkwin, targetName);
  782.     } else {
  783.         target = XA_STRING;
  784. #ifdef STk_CODE
  785.         targetName = "XA_STRING";
  786. #endif
  787.     }
  788.     if (count > 3) {
  789.         format = Tk_InternAtom(tkwin, args[3]);
  790.     } else if (formatName != NULL) {
  791.         format = Tk_InternAtom(tkwin, formatName);
  792.     } else {
  793.         format = XA_STRING;
  794.     }
  795.     cmdLength = strlen(args[1]);
  796. #ifdef STk_CODE
  797.     if (cmdLength == 0 || strcmp(args[1], "()") == 0) {
  798.         Tk_DeleteSelHandler(tkwin, selection, target);
  799.         /* Delete old callback from callback table */
  800.         STk_add_callback(args[0], selName, targetName, STk_get_NIL_value());
  801. #else
  802.     if (cmdLength == 0) {
  803.         Tk_DeleteSelHandler(tkwin, selection, target);
  804. #endif
  805.     } else {
  806. #ifdef STk_CODE
  807.       SCM p;
  808.       
  809.       if (!STk_valid_callback(args[1], &p) || (p == NULL)) {
  810.         Tcl_AppendResult(interp, "bad closure specification \"",
  811.                  args[1], "\"", (char *) NULL);
  812.         return TCL_ERROR;
  813.       }
  814. #endif
  815.         cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
  816.             sizeof(CommandInfo) - 3 + cmdLength));
  817.         cmdInfoPtr->interp = interp;
  818.         cmdInfoPtr->cmdLength = cmdLength;
  819.         strcpy(cmdInfoPtr->command, args[1]);
  820.         Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
  821.             (ClientData) cmdInfoPtr, format);
  822. #ifdef STk_CODE
  823.         STk_add_callback(args[0], selName, targetName, p);
  824. #endif
  825.     }
  826.     return TCL_OK;
  827.     } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
  828.     register LostCommand *lostPtr;
  829.     char *script = NULL;
  830.     int cmdLength;
  831. #ifdef STk_CODE
  832.     SCM p;
  833. #endif
  834.  
  835.     for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
  836.         if (args[0][0] != '-') {
  837.         break;
  838.         }
  839.         if (count < 2) {
  840.         Tcl_AppendResult(interp, "value for \"", *args,
  841.             "\" missing", (char *) NULL);
  842.         return TCL_ERROR;
  843.         }
  844.         c = args[0][1];
  845.         length = strlen(args[0]);
  846.         if ((c == 'c') && (strncmp(args[0], "-command", length) == 0)) {
  847.         script = args[1];
  848.         } else if ((c == 'd')
  849.             && (strncmp(args[0], "-displayof", length) == 0)) {
  850.         path = args[1];
  851.         } else if ((c == 's')
  852.             && (strncmp(args[0], "-selection", length) == 0)) {
  853.         selName = args[1];
  854.         } else {
  855.         Tcl_AppendResult(interp, "unknown option \"", args[0],
  856.             "\"", (char *) NULL);
  857.         return TCL_ERROR;
  858.         }
  859.     }
  860.  
  861.     if (count > 2) {
  862.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  863.             " own ?options? ?window?\"", (char *) NULL);
  864.         return TCL_ERROR;
  865.     }
  866.     if (selName != NULL) {
  867.         selection = Tk_InternAtom(tkwin, selName);
  868.     } else {
  869.         selection = XA_PRIMARY;
  870. #ifdef STk_CODE
  871.         selName = "XA_PRIMARY";
  872. #endif
  873.     }
  874.     if (count == 0) {
  875.         TkSelectionInfo *infoPtr;
  876.         TkWindow *winPtr;
  877.         if (path != NULL) {
  878.         tkwin = Tk_NameToWindow(interp, path, tkwin);
  879.         }
  880.         if (tkwin == NULL) {
  881.         return TCL_ERROR;
  882.         }
  883.         winPtr = (TkWindow *)tkwin;
  884.         for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
  885.             infoPtr = infoPtr->nextPtr) {
  886.         if (infoPtr->selection == selection)
  887.             break;
  888.         }
  889.  
  890.         /*
  891.          * Ignore the internal clipboard window.
  892.          */
  893.  
  894.         if ((infoPtr != NULL)
  895.             && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
  896. #ifdef STk_CODE
  897.         STk_sharp_dot_result(interp, Tk_PathName(infoPtr->owner));
  898. #else
  899.         interp->result = Tk_PathName(infoPtr->owner);
  900. #endif
  901.         }
  902. #ifdef STk_CODE
  903.         else interp->result = "#f";
  904. #endif
  905.         return TCL_OK;
  906.     }
  907.     tkwin = Tk_NameToWindow(interp, args[0], tkwin);
  908.     if (tkwin == NULL) {
  909.         return TCL_ERROR;
  910.     }
  911.     if (count == 2) {
  912.         script = args[1];
  913.     }
  914.     if (script == NULL) {
  915.         Tk_OwnSelection(tkwin, selection, (Tk_LostSelProc *) NULL,
  916.             (ClientData) NULL);
  917.         return TCL_OK;
  918.     }
  919. #ifdef STk_CODE
  920.       if (!STk_valid_callback(script, &p) || (p == NULL)) {
  921.         Tcl_AppendResult(interp, "bad closure specification \"",
  922.                  script, "\"", (char *) NULL);
  923.         return TCL_ERROR;
  924.       }
  925. #endif
  926.     cmdLength = strlen(script);
  927.     lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
  928.         -3 + cmdLength));
  929.     lostPtr->interp = interp;
  930.     strcpy(lostPtr->command, script);
  931.     Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
  932. #ifdef STk_CODE
  933.     STk_add_callback(args[0], selName, "", p);
  934. #endif
  935.     return TCL_OK;
  936.     } else {
  937.     sprintf(interp->result,
  938.         "bad option \"%.50s\": must be clear, get, handle, or own",
  939.         argv[1]);
  940.     return TCL_ERROR;
  941.     }
  942. }
  943.  
  944. /*
  945.  *----------------------------------------------------------------------
  946.  *
  947.  * TkSelDeadWindow --
  948.  *
  949.  *    This procedure is invoked just before a TkWindow is deleted.
  950.  *    It performs selection-related cleanup.
  951.  *
  952.  * Results:
  953.  *    None.
  954.  *
  955.  * Side effects:
  956.  *    Frees up memory associated with the selection.
  957.  *
  958.  *----------------------------------------------------------------------
  959.  */
  960.  
  961. void
  962. TkSelDeadWindow(winPtr)
  963.     register TkWindow *winPtr;    /* Window that's being deleted. */
  964. {
  965.     register TkSelHandler *selPtr;
  966.     register TkSelInProgress *ipPtr;
  967.     TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
  968.  
  969.     /*
  970.      * While deleting all the handlers, be careful to check whether
  971.      * ConvertSelection or TkSelPropProc are about to process one of the
  972.      * deleted handlers.
  973.      */
  974.  
  975.     while (winPtr->selHandlerList != NULL) {
  976.     selPtr = winPtr->selHandlerList;
  977.     winPtr->selHandlerList = selPtr->nextPtr;
  978.     for (ipPtr = pendingPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
  979.         if (ipPtr->selPtr == selPtr) {
  980.         ipPtr->selPtr = NULL;
  981.         }
  982.     }
  983.     if (selPtr->proc == HandleTclCommand) {
  984.         ckfree((char *) selPtr->clientData);
  985.     }
  986.     ckfree((char *) selPtr);
  987.     }
  988.  
  989.     /*
  990.      * Remove selections owned by window being deleted.
  991.      */
  992.  
  993.     for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
  994.          infoPtr != NULL; infoPtr = nextPtr) {
  995.     nextPtr = infoPtr->nextPtr;
  996.     if (infoPtr->owner == (Tk_Window) winPtr) {
  997.         if (infoPtr->clearProc == LostSelection) {
  998.         ckfree((char *) infoPtr->clearData);
  999.         }
  1000.         ckfree((char *) infoPtr);
  1001.         infoPtr = prevPtr;
  1002.         if (prevPtr == NULL) {
  1003.         winPtr->dispPtr->selectionInfoPtr = nextPtr;
  1004.         } else {
  1005.         prevPtr->nextPtr = nextPtr;
  1006.         }
  1007.     }
  1008.     prevPtr = infoPtr;
  1009.     }
  1010. }
  1011.  
  1012. /*
  1013.  *----------------------------------------------------------------------
  1014.  *
  1015.  * TkSelInit --
  1016.  *
  1017.  *    Initialize selection-related information for a display.
  1018.  *
  1019.  * Results:
  1020.  *    None.
  1021.  *
  1022.  * Side effects:
  1023.  *    Selection-related information is initialized.
  1024.  *
  1025.  *----------------------------------------------------------------------
  1026.  */
  1027.  
  1028. void
  1029. TkSelInit(tkwin)
  1030.     Tk_Window tkwin;        /* Window token (used to find
  1031.                  * display to initialize). */
  1032. {
  1033.     register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  1034.  
  1035.     /*
  1036.      * Fetch commonly-used atoms.
  1037.      */
  1038.  
  1039.     dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
  1040.     dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
  1041.     dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
  1042.     dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
  1043.     dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
  1044.     dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
  1045.     dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
  1046.     dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
  1047.     dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
  1048. }
  1049.  
  1050. /*
  1051.  *----------------------------------------------------------------------
  1052.  *
  1053.  * TkSelClearSelection --
  1054.  *
  1055.  *    This procedure is invoked to process a SelectionClear event.
  1056.  *
  1057.  * Results:
  1058.  *    None.
  1059.  *
  1060.  * Side effects:
  1061.  *    Invokes the clear procedure for the window which lost the
  1062.  *    selection.
  1063.  *
  1064.  *----------------------------------------------------------------------
  1065.  */
  1066.  
  1067. void
  1068. TkSelClearSelection(tkwin, eventPtr)
  1069.     Tk_Window tkwin;        /* Window for which event was targeted. */
  1070.     register XEvent *eventPtr;    /* X SelectionClear event. */
  1071. {
  1072.     register TkWindow *winPtr = (TkWindow *) tkwin;
  1073.     TkDisplay *dispPtr = winPtr->dispPtr;
  1074.     TkSelectionInfo *infoPtr;
  1075.     TkSelectionInfo *prevPtr;
  1076.  
  1077.     /*
  1078.      * Invoke clear procedure for window that just lost the selection.  This
  1079.      * code is a bit tricky, because any callbacks due to selection changes
  1080.      * between windows managed by the process have already been made.  Thus,
  1081.      * ignore the event unless it refers to the window that's currently the
  1082.      * selection owner and the event was generated after the server saw the
  1083.      * SetSelectionOwner request.
  1084.      */
  1085.  
  1086.     for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
  1087.      infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
  1088.     if (infoPtr->selection == eventPtr->xselectionclear.selection) {
  1089.         break;
  1090.     }
  1091.     prevPtr = infoPtr;
  1092.     }
  1093.  
  1094.     if (infoPtr != NULL && (infoPtr->owner == tkwin)
  1095.         && (eventPtr->xselectionclear.serial >= infoPtr->serial)) {
  1096.     if (prevPtr == NULL) {
  1097.         dispPtr->selectionInfoPtr = infoPtr->nextPtr;
  1098.     } else {
  1099.         prevPtr->nextPtr = infoPtr->nextPtr;
  1100.     }
  1101.  
  1102.     /*
  1103.      * Because of reentrancy problems, calling clearProc must be done
  1104.      * after the infoPtr has been removed from the selectionInfoPtr
  1105.      * list (clearProc could modify the list, e.g. by creating
  1106.      * a new selection).
  1107.      */
  1108.  
  1109.     if (infoPtr->clearProc != NULL) {
  1110.         (*infoPtr->clearProc)(infoPtr->clearData);
  1111.     }
  1112.     ckfree((char *) infoPtr);
  1113.     }
  1114. }
  1115.  
  1116. /*
  1117.  *--------------------------------------------------------------
  1118.  *
  1119.  * SelGetProc --
  1120.  *
  1121.  *    This procedure is invoked to process pieces of the selection
  1122.  *    as they arrive during "selection get" commands.
  1123.  *
  1124.  * Results:
  1125.  *    Always returns TCL_OK.
  1126.  *
  1127.  * Side effects:
  1128.  *    Bytes get appended to the dynamic string pointed to by the
  1129.  *    clientData argument.
  1130.  *
  1131.  *--------------------------------------------------------------
  1132.  */
  1133.  
  1134.     /* ARGSUSED */
  1135. static int
  1136. SelGetProc(clientData, interp, portion)
  1137.     ClientData clientData;    /* Dynamic string holding partially
  1138.                  * assembled selection. */
  1139.     Tcl_Interp *interp;        /* Interpreter used for error
  1140.                  * reporting (not used). */
  1141.     char *portion;        /* New information to be appended. */
  1142. {
  1143.     Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
  1144.     return TCL_OK;
  1145. }
  1146.  
  1147. /*
  1148.  *----------------------------------------------------------------------
  1149.  *
  1150.  * HandleTclCommand --
  1151.  *
  1152.  *    This procedure acts as selection handler for handlers created
  1153.  *    by the "selection handle" command.  It invokes a Tcl command to
  1154.  *    retrieve the selection.
  1155.  *
  1156.  * Results:
  1157.  *    The return value is a count of the number of bytes actually
  1158.  *    stored at buffer, or -1 if an error occurs while executing
  1159.  *    the Tcl command to retrieve the selection.
  1160.  *
  1161.  * Side effects:
  1162.  *    None except for things done by the Tcl command.
  1163.  *
  1164.  *----------------------------------------------------------------------
  1165.  */
  1166.  
  1167. static int
  1168. HandleTclCommand(clientData, offset, buffer, maxBytes)
  1169.     ClientData clientData;    /* Information about command to execute. */
  1170.     int offset;            /* Return selection bytes starting at this
  1171.                  * offset. */
  1172.     char *buffer;        /* Place to store converted selection. */
  1173.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  1174. {
  1175.     CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
  1176.     int spaceNeeded, length;
  1177. #define MAX_STATIC_SIZE 100
  1178.     char staticSpace[MAX_STATIC_SIZE];
  1179.     char *command;
  1180.     Tcl_Interp *interp;
  1181.     Tcl_DString oldResult;
  1182.  
  1183.     /*
  1184.      * We must copy the interpreter pointer from CommandInfo because the
  1185.      * command could delete the handler, freeing the CommandInfo data before we
  1186.      * are done using it. We must also protect the interpreter from being
  1187.      * deleted too soo.
  1188.      */
  1189.  
  1190.     interp = cmdInfoPtr->interp;
  1191.     Tcl_Preserve((ClientData) interp);
  1192.  
  1193.     /*
  1194.      * First, generate a command by taking the command string
  1195.      * and appending the offset and maximum # of bytes.
  1196.      */
  1197.  
  1198.     spaceNeeded = cmdInfoPtr->cmdLength + 30;
  1199.     if (spaceNeeded < MAX_STATIC_SIZE) {
  1200.     command = staticSpace;
  1201.     } else {
  1202.     command = (char *) ckalloc((unsigned) spaceNeeded);
  1203.     }
  1204.     sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
  1205.  
  1206.     /*
  1207.      * Execute the command.  Be sure to restore the state of the
  1208.      * interpreter after executing the command.
  1209.      */
  1210.  
  1211.     Tcl_DStringInit(&oldResult);
  1212.     Tcl_DStringGetResult(interp, &oldResult);
  1213.     if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
  1214.     length = strlen(interp->result);
  1215.     if (length > maxBytes) {
  1216.         length = maxBytes;
  1217.     }
  1218.     memcpy((VOID *) buffer, (VOID *) interp->result, (size_t) length);
  1219.     buffer[length] = '\0';
  1220.     } else {
  1221.     length = -1;
  1222.     }
  1223.     Tcl_DStringResult(interp, &oldResult);
  1224.  
  1225.     if (command != staticSpace) {
  1226.     ckfree(command);
  1227.     }
  1228.  
  1229.     Tcl_Release((ClientData) interp);
  1230.     return length;
  1231. }
  1232.  
  1233. /*
  1234.  *----------------------------------------------------------------------
  1235.  *
  1236.  * TkSelDefaultSelection --
  1237.  *
  1238.  *    This procedure is called to generate selection information
  1239.  *    for a few standard targets such as TIMESTAMP and TARGETS.
  1240.  *    It is invoked only if no handler has been declared by the
  1241.  *    application.
  1242.  *
  1243.  * Results:
  1244.  *    If "target" is a standard target understood by this procedure,
  1245.  *    the selection is converted to that form and stored as a
  1246.  *    character string in buffer.  The type of the selection (e.g.
  1247.  *    STRING or ATOM) is stored in *typePtr, and the return value is
  1248.  *    a count of the # of non-NULL bytes at buffer.  If the target
  1249.  *    wasn't understood, or if there isn't enough space at buffer
  1250.  *    to hold the entire selection (no INCR-mode transfers for this
  1251.  *    stuff!), then -1 is returned.
  1252.  *
  1253.  * Side effects:
  1254.  *    None.
  1255.  *
  1256.  *----------------------------------------------------------------------
  1257.  */
  1258.  
  1259. int
  1260. TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
  1261.     TkSelectionInfo *infoPtr;    /* Info about selection being retrieved. */
  1262.     Atom target;        /* Desired form of selection. */
  1263.     char *buffer;        /* Place to put selection characters. */
  1264.     int maxBytes;        /* Maximum # of bytes to store at buffer. */
  1265.     Atom *typePtr;        /* Store here the type of the selection,
  1266.                  * for use in converting to proper X format. */
  1267. {
  1268.     register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
  1269.     TkDisplay *dispPtr = winPtr->dispPtr;
  1270.  
  1271.     if (target == dispPtr->timestampAtom) {
  1272.     if (maxBytes < 20) {
  1273.         return -1;
  1274.     }
  1275.     sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
  1276.     *typePtr = XA_INTEGER;
  1277.     return strlen(buffer);
  1278.     }
  1279.  
  1280.     if (target == dispPtr->targetsAtom) {
  1281.     register TkSelHandler *selPtr;
  1282.     char *atomString;
  1283.     int length, atomLength;
  1284.  
  1285.     if (maxBytes < 50) {
  1286.         return -1;
  1287.     }
  1288.     strcpy(buffer, "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW");
  1289.     length = strlen(buffer);
  1290.     for (selPtr = winPtr->selHandlerList; selPtr != NULL;
  1291.         selPtr = selPtr->nextPtr) {
  1292.         if ((selPtr->selection == infoPtr->selection)
  1293.             && (selPtr->target != dispPtr->applicationAtom)
  1294.             && (selPtr->target != dispPtr->windowAtom)) {
  1295.         atomString = Tk_GetAtomName((Tk_Window) winPtr,
  1296.             selPtr->target);
  1297.         atomLength = strlen(atomString) + 1;
  1298.         if ((length + atomLength) >= maxBytes) {
  1299.             return -1;
  1300.         }
  1301.         sprintf(buffer+length, " %s", atomString);
  1302.         length += atomLength;
  1303.         }
  1304.     }
  1305.     *typePtr = XA_ATOM;
  1306.     return length;
  1307.     }
  1308.  
  1309.     if (target == dispPtr->applicationAtom) {
  1310.     int length;
  1311.     char *name = winPtr->mainPtr->winPtr->nameUid;
  1312.  
  1313.     length = strlen(name);
  1314.     if (maxBytes <= length) {
  1315.         return -1;
  1316.     }
  1317.     strcpy(buffer, name);
  1318.     *typePtr = XA_STRING;
  1319.     return length;
  1320.     }
  1321.  
  1322.     if (target == dispPtr->windowAtom) {
  1323.     int length;
  1324.     char *name = winPtr->pathName;
  1325.  
  1326.     length = strlen(name);
  1327.     if (maxBytes <= length) {
  1328.         return -1;
  1329.     }
  1330.     strcpy(buffer, name);
  1331.     *typePtr = XA_STRING;
  1332.     return length;
  1333.     }
  1334.  
  1335.     return -1;
  1336. }
  1337.  
  1338. /*
  1339.  *----------------------------------------------------------------------
  1340.  *
  1341.  * LostSelection --
  1342.  *
  1343.  *    This procedure is invoked when a window has lost ownership of
  1344.  *    the selection and the ownership was claimed with the command
  1345.  *    "selection own".
  1346.  *
  1347.  * Results:
  1348.  *    None.
  1349.  *
  1350.  * Side effects:
  1351.  *    A Tcl script is executed;  it can do almost anything.
  1352.  *
  1353.  *----------------------------------------------------------------------
  1354.  */
  1355.  
  1356. static void
  1357. LostSelection(clientData)
  1358.     ClientData clientData;        /* Pointer to CommandInfo structure. */
  1359. {
  1360.     LostCommand *lostPtr = (LostCommand *) clientData;
  1361.     char *oldResultString;
  1362.     Tcl_FreeProc *oldFreeProc;
  1363.     Tcl_Interp *interp;
  1364.  
  1365.     interp = lostPtr->interp;
  1366.     Tcl_Preserve((ClientData) interp);
  1367.     
  1368.     /*
  1369.      * Execute the command.  Save the interpreter's result, if any, and
  1370.      * restore it after executing the command.
  1371.      */
  1372.  
  1373.     oldFreeProc = interp->freeProc;
  1374.     if (oldFreeProc != TCL_STATIC) {
  1375.     oldResultString = interp->result;
  1376.     } else {
  1377.     oldResultString = (char *) ckalloc((unsigned)
  1378.         (strlen(interp->result) + 1));
  1379.     strcpy(oldResultString, interp->result);
  1380.     oldFreeProc = TCL_DYNAMIC;
  1381.     }
  1382.     interp->freeProc = TCL_STATIC;
  1383.     if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
  1384.     Tcl_BackgroundError(interp);
  1385.     }
  1386.     Tcl_FreeResult(interp);
  1387.     interp->result = oldResultString;
  1388.     interp->freeProc = oldFreeProc;
  1389.  
  1390.     Tcl_Release((ClientData) interp);
  1391.     
  1392.     /*
  1393.      * Free the storage for the command, since we're done with it now.
  1394.      */
  1395.  
  1396.     ckfree((char *) lostPtr);
  1397. }
  1398.