tkSelect.c
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:45k
源码类别:

通讯编程

开发平台:

Visual C++

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