/[dtapublic]/projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkselect.c

Diff of /projs/ets/trunk/src/c_tk_base_7_5_w_mods/tkselect.c

Parent Directory | Revision Log | View Patch Patch

-projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkselect.c
revision 69 by dashley,
Sat Nov  5 10:54:17 2016 UTC
+projs/dtats/trunk/shared_source/c_tk_base_7_5_w_mods/tkselect.c
revision 98 by dashley,
Sun Dec 18 00:57:31 2016 UTC
 Line 1
  /* $Header$ */
  /*
   * tkSelect.c --
   *
   *      This file manages the selection for the Tk toolkit,
   *      translating between the standard X ICCCM conventions
   *      and Tcl commands.
   *
   * Copyright (c) 1990-1993 The Regents of the University of California.
   * Copyright (c) 1994-1997 Sun Microsystems, Inc.
   *
   * See the file "license.terms" for information on usage and redistribution
   * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   *
   * RCS: @(#) $Id: tkselect.c,v 1.1.1.1 2001/06/13 05:08:09 dtashley Exp $
   */
  #include "tkInt.h"
  #include "tkSelect.h"
  /*
   * When a selection handler is set up by invoking "selection handle",
   * one of the following data structures is set up to hold information
   * about the command to invoke and its interpreter.
   */
  typedef struct {
      Tcl_Interp *interp;         /* Interpreter in which to invoke command. */
      int cmdLength;              /* # of non-NULL bytes in command. */
      int charOffset;             /* The offset of the next char to retrieve. */
      int byteOffset;             /* The expected byte offset of the next
                                   * chunk. */
      char buffer[TCL_UTF_MAX];   /* A buffer to hold part of a UTF character
                                   * that is split across chunks.*/
      char command[4];            /* Command to invoke.  Actual space is
                                   * allocated as large as necessary.  This
                                   * must be the last entry in the structure. */
  } CommandInfo;
  /*
   * When selection ownership is claimed with the "selection own" Tcl command,
   * one of the following structures is created to record the Tcl command
   * to be executed when the selection is lost again.
   */
  typedef struct LostCommand {
      Tcl_Interp *interp;         /* Interpreter in which to invoke command. */
      char command[4];            /* Command to invoke.  Actual space is
                                   * allocated as large as necessary.  This
                                   * must be the last entry in the structure. */
  } LostCommand;
  /*
   * The structure below is used to keep each thread's pending list
   * separate.
   */
  typedef struct ThreadSpecificData {
      TkSelInProgress *pendingPtr;
                                  /* Topmost search in progress, or
                                   * NULL if none. */
  } ThreadSpecificData;
  static Tcl_ThreadDataKey dataKey;
  /*
   * Forward declarations for procedures defined in this file:
   */
  static int              HandleTclCommand _ANSI_ARGS_((ClientData clientData,
                              int offset, char *buffer, int maxBytes));
  static void             LostSelection _ANSI_ARGS_((ClientData clientData));
  static int              SelGetProc _ANSI_ARGS_((ClientData clientData,
                              Tcl_Interp *interp, char *portion));
  /*
   *--------------------------------------------------------------
   *
   * Tk_CreateSelHandler --
   *
   *      This procedure is called to register a procedure
   *      as the handler for selection requests of a particular
   *      target type on a particular window for a particular
   *      selection.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      In the future, whenever the selection is in tkwin's
   *      window and someone requests the selection in the
   *      form given by target, proc will be invoked to provide
   *      part or all of the selection in the given form.  If
   *      there was already a handler declared for the given
   *      window, target and selection type, then it is replaced.
   *      Proc should have the following form:
   *
   *      int
   *      proc(clientData, offset, buffer, maxBytes)
   *          ClientData clientData;
   *          int offset;
   *          char *buffer;
   *          int maxBytes;
   *      {
   *      }
   *
   *      The clientData argument to proc will be the same as
   *      the clientData argument to this procedure.  The offset
   *      argument indicates which portion of the selection to
   *      return:  skip the first offset bytes.  Buffer is a
   *      pointer to an area in which to place the converted
   *      selection, and maxBytes gives the number of bytes
   *      available at buffer.  Proc should place the selection
   *      in buffer as a string, and return a count of the number
   *      of bytes of selection actually placed in buffer (not
   *      including the terminating NULL character).  If the
   *      return value equals maxBytes, this is a sign that there
   *      is probably still more selection information available.
   *
   *--------------------------------------------------------------
   */
  void
  Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format)
      Tk_Window tkwin;            /* Token for window. */
      Atom selection;             /* Selection to be handled. */
      Atom target;                /* The kind of selection conversions
                                   * that can be handled by proc,
                                   * e.g. TARGETS or STRING. */
      Tk_SelectionProc *proc;     /* Procedure to invoke to convert
                                   * selection to type "target". */
      ClientData clientData;      /* Value to pass to proc. */
      Atom format;                /* Format in which the selection
                                   * information should be returned to
                                   * the requestor. XA_STRING is best by
                                   * far, but anything listed in the ICCCM
                                   * will be tolerated (blech). */
  {
      register TkSelHandler *selPtr;
      TkWindow *winPtr = (TkWindow *) tkwin;
      if (winPtr->dispPtr->multipleAtom == None) {
          TkSelInit(tkwin);
      }
      /*
       * See if there's already a handler for this target and selection on
       * this window.  If so, re-use it.  If not, create a new one.
       */
      for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
          if (selPtr == NULL) {
              selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
              selPtr->nextPtr = winPtr->selHandlerList;
              winPtr->selHandlerList = selPtr;
              break;
          }
          if ((selPtr->selection == selection) && (selPtr->target == target)) {
              /*
               * Special case:  when replacing handler created by
               * "selection handle", free up memory.  Should there be a
               * callback to allow other clients to do this too?
               */
              if (selPtr->proc == HandleTclCommand) {
                  ckfree((char *) selPtr->clientData);
              }
              break;
          }
      }
      selPtr->selection = selection;
      selPtr->target = target;
      selPtr->format = format;
      selPtr->proc = proc;
      selPtr->clientData = clientData;
      if (format == XA_STRING) {
          selPtr->size = 8;
      } else {
          selPtr->size = 32;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tk_DeleteSelHandler --
   *
   *      Remove the selection handler for a given window, target, and
   *      selection, if it exists.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The selection handler for tkwin and target is removed.  If there
   *      is no such handler then nothing happens.
   *
   *----------------------------------------------------------------------
   */
  void
  Tk_DeleteSelHandler(tkwin, selection, target)
      Tk_Window tkwin;                    /* Token for window. */
      Atom selection;                     /* The selection whose handler
                                           * is to be removed. */
      Atom target;                        /* The target whose selection
                                           * handler is to be removed. */
  {
      TkWindow *winPtr = (TkWindow *) tkwin;
      register TkSelHandler *selPtr, *prevPtr;
      register TkSelInProgress *ipPtr;
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      /*
       * Find the selection handler to be deleted, or return if it doesn't
       * exist.
       */
      for (selPtr = winPtr->selHandlerList, prevPtr = NULL; ;
              prevPtr = selPtr, selPtr = selPtr->nextPtr) {
          if (selPtr == NULL) {
              return;
          }
          if ((selPtr->selection == selection) && (selPtr->target == target)) {
              break;
          }
      }
      /*
       * If ConvertSelection is processing this handler, tell it that the
       * handler is dead.
       */
      for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
              ipPtr = ipPtr->nextPtr) {
          if (ipPtr->selPtr == selPtr) {
              ipPtr->selPtr = NULL;
          }
      }
      /*
       * Free resources associated with the handler.
       */
      if (prevPtr == NULL) {
          winPtr->selHandlerList = selPtr->nextPtr;
      } else {
          prevPtr->nextPtr = selPtr->nextPtr;
      }
      if (selPtr->proc == HandleTclCommand) {
          /*
           * Mark the CommandInfo as deleted and free it if we can.
           */
          ((CommandInfo*)selPtr->clientData)->interp = NULL;
          Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
      }
      ckfree((char *) selPtr);
  }
  /*
   *--------------------------------------------------------------
   *
   * Tk_OwnSelection --
   *
   *      Arrange for tkwin to become the owner of a selection.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      From now on, requests for the selection will be directed
   *      to procedures associated with tkwin (they must have been
   *      declared with calls to Tk_CreateSelHandler).  When the
   *      selection is lost by this window, proc will be invoked
   *      (see the manual entry for details).  This procedure may
   *      invoke callbacks, including Tcl scripts, so any calling
   *      function should be reentrant at the point where
   *      Tk_OwnSelection is invoked.
   *
   *--------------------------------------------------------------
   */
  void
  Tk_OwnSelection(tkwin, selection, proc, clientData)
      Tk_Window tkwin;            /* Window to become new selection
                                   * owner. */
      Atom selection;             /* Selection that window should own. */
      Tk_LostSelProc *proc;       /* Procedure to call when selection
                                   * is taken away from tkwin. */
      ClientData clientData;      /* Arbitrary one-word argument to
                                   * pass to proc. */
  {
      register TkWindow *winPtr = (TkWindow *) tkwin;
      TkDisplay *dispPtr = winPtr->dispPtr;
      TkSelectionInfo *infoPtr;
      Tk_LostSelProc *clearProc = NULL;
      ClientData clearData = NULL;        /* Initialization needed only to
                                           * prevent compiler warning. */
      if (dispPtr->multipleAtom == None) {
          TkSelInit(tkwin);
      }
      Tk_MakeWindowExist(tkwin);
      /*
       * This code is somewhat tricky.  First, we find the specified selection
       * on the selection list.  If the previous owner is in this process, and
       * is a different window, then we need to invoke the clearProc.  However,
       * it's dangerous to call the clearProc right now, because it could
       * invoke a Tcl script that wrecks the current state (e.g. it could
       * delete the window).  To be safe, defer the call until the end of the
       * procedure when we no longer care about the state.
       */
      for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
              infoPtr = infoPtr->nextPtr) {
          if (infoPtr->selection == selection) {
              break;
          }
      }
      if (infoPtr == NULL) {
          infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
          infoPtr->selection = selection;
          infoPtr->nextPtr = dispPtr->selectionInfoPtr;
          dispPtr->selectionInfoPtr = infoPtr;
      } else if (infoPtr->clearProc != NULL) {
          if (infoPtr->owner != tkwin) {
              clearProc = infoPtr->clearProc;
              clearData = infoPtr->clearData;
          } else if (infoPtr->clearProc == LostSelection) {
              /*
               * If the selection handler is one created by "selection own",
               * be sure to free the record for it;  otherwise there will be
               * a memory leak.
               */
              ckfree((char *) infoPtr->clearData);
          }
      }
      infoPtr->owner = tkwin;
      infoPtr->serial = NextRequest(winPtr->display);
      infoPtr->clearProc = proc;
      infoPtr->clearData = clientData;
      /*
       * Note that we are using CurrentTime, even though ICCCM recommends against
       * this practice (the problem is that we don't necessarily have a valid
       * time to use).  We will not be able to retrieve a useful timestamp for
       * the TIMESTAMP target later.
       */
      infoPtr->time = CurrentTime;
      /*
       * Note that we are not checking to see if the selection claim succeeded.
       * If the ownership does not change, then the clearProc may never be
       * invoked, and we will return incorrect information when queried for the
       * current selection owner.
       */
      XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
              infoPtr->time);
      /*
       * Now that we are done, we can invoke clearProc without running into
       * reentrancy problems.
       */
      if (clearProc != NULL) {
          (*clearProc)(clearData);
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * Tk_ClearSelection --
   *
   *      Eliminate the specified selection on tkwin's display, if there is one.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      The specified selection is cleared, so that future requests to retrieve
   *      it will fail until some application owns it again.  This procedure
   *      invokes callbacks, possibly including Tcl scripts, so any calling
   *      function should be reentrant at the point Tk_ClearSelection is invoked.
   *
   *----------------------------------------------------------------------
   */
  void
  Tk_ClearSelection(tkwin, selection)
      Tk_Window tkwin;            /* Window that selects a display. */
      Atom selection;             /* Selection to be cancelled. */
  {
      register TkWindow *winPtr = (TkWindow *) tkwin;
      TkDisplay *dispPtr = winPtr->dispPtr;
      TkSelectionInfo *infoPtr;
      TkSelectionInfo *prevPtr;
      TkSelectionInfo *nextPtr;
      Tk_LostSelProc *clearProc = NULL;
      ClientData clearData = NULL;        /* Initialization needed only to
                                           * prevent compiler warning. */
      if (dispPtr->multipleAtom == None) {
          TkSelInit(tkwin);
      }
      for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
               infoPtr != NULL; infoPtr = nextPtr) {
          nextPtr = infoPtr->nextPtr;
          if (infoPtr->selection == selection) {
              if (prevPtr == NULL) {
                  dispPtr->selectionInfoPtr = nextPtr;
              } else {
                  prevPtr->nextPtr = nextPtr;
              }
              break;
          }
          prevPtr = infoPtr;
      }
      if (infoPtr != NULL) {
          clearProc = infoPtr->clearProc;
          clearData = infoPtr->clearData;
          ckfree((char *) infoPtr);
      }
      XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
      if (clearProc != NULL) {
          (*clearProc)(clearData);
      }
  }
  /*
   *--------------------------------------------------------------
   *
   * Tk_GetSelection --
   *
   *      Retrieve the value of a selection and pass it off (in
   *      pieces, possibly) to a given procedure.
   *
   * Results:
   *      The return value is a standard Tcl return value.
   *      If an error occurs (such as no selection exists)
   *      then an error message is left in the interp's result.
   *
   * Side effects:
   *      The standard X11 protocols are used to retrieve the
   *      selection.  When it arrives, it is passed to proc.  If
   *      the selection is very large, it will be passed to proc
   *      in several pieces.  Proc should have the following
   *      structure:
   *
   *      int
   *      proc(clientData, interp, portion)
   *          ClientData clientData;
   *          Tcl_Interp *interp;
   *          char *portion;
   *      {
   *      }
   *
   *      The interp and clientData arguments to proc will be the
   *      same as the corresponding arguments to Tk_GetSelection.
   *      The portion argument points to a character string
   *      containing part of the selection, and numBytes indicates
   *      the length of the portion, not including the terminating
   *      NULL character.  If the selection arrives in several pieces,
   *      the "portion" arguments in separate calls will contain
   *      successive parts of the selection.  Proc should normally
   *      return TCL_OK.  If it detects an error then it should return
   *      TCL_ERROR and leave an error message in the interp's result; the
   *      remainder of the selection retrieval will be aborted.
   *
   *--------------------------------------------------------------
   */
  int
  Tk_GetSelection(interp, tkwin, selection, target, proc, clientData)
      Tcl_Interp *interp;         /* Interpreter to use for reporting
                                   * errors. */
      Tk_Window tkwin;            /* Window on whose behalf to retrieve
                                   * the selection (determines display
                                   * from which to retrieve). */
      Atom selection;             /* Selection to retrieve. */
      Atom target;                /* Desired form in which selection
                                   * is to be returned. */
      Tk_GetSelProc *proc;        /* Procedure to call to process the
                                   * selection, once it has been retrieved. */
      ClientData clientData;      /* Arbitrary value to pass to proc. */
  {
      TkWindow *winPtr = (TkWindow *) tkwin;
      TkDisplay *dispPtr = winPtr->dispPtr;
      TkSelectionInfo *infoPtr;
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      if (dispPtr->multipleAtom == None) {
          TkSelInit(tkwin);
      }
      /*
       * If the selection is owned by a window managed by this
       * process, then call the retrieval procedure directly,
       * rather than going through the X server (it's dangerous
       * to go through the X server in this case because it could
       * result in deadlock if an INCR-style selection results).
       */
      for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
              infoPtr = infoPtr->nextPtr) {
          if (infoPtr->selection == selection)
              break;
      }
      if (infoPtr != NULL) {
          register TkSelHandler *selPtr;
          int offset, result, count;
          char buffer[TK_SEL_BYTES_AT_ONCE+1];
          TkSelInProgress ip;
          for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
                  selPtr != NULL; selPtr = selPtr->nextPtr) {
              if ((selPtr->target == target)
                      && (selPtr->selection == selection)) {
                  break;
              }
          }
          if (selPtr == NULL) {
              Atom type;
              count = TkSelDefaultSelection(infoPtr, target, buffer,
                      TK_SEL_BYTES_AT_ONCE, &type);
              if (count > TK_SEL_BYTES_AT_ONCE) {
                  panic("selection handler returned too many bytes");
              }
              if (count < 0) {
                  goto cantget;
              }
              buffer[count] = 0;
              result = (*proc)(clientData, interp, buffer);
          } else {
              offset = 0;
              result = TCL_OK;
              ip.selPtr = selPtr;
              ip.nextPtr = tsdPtr->pendingPtr;
              tsdPtr->pendingPtr = &ip;
              while (1) {
                  count = (selPtr->proc)(selPtr->clientData, offset, buffer,
                          TK_SEL_BYTES_AT_ONCE);
                  if ((count < 0) || (ip.selPtr == NULL)) {
                      tsdPtr->pendingPtr = ip.nextPtr;
                      goto cantget;
                  }
                  if (count > TK_SEL_BYTES_AT_ONCE) {
                      panic("selection handler returned too many bytes");
                  }
                  buffer[count] = '\0';
                  result = (*proc)(clientData, interp, buffer);
                  if ((result != TCL_OK) || (count < TK_SEL_BYTES_AT_ONCE)
                          || (ip.selPtr == NULL)) {
                      break;
                  }
                  offset += count;
              }
              tsdPtr->pendingPtr = ip.nextPtr;
          }
          return result;
      }
      /*
       * The selection is owned by some other process.
       */
      return TkSelGetSelection(interp, tkwin, selection, target, proc,
              clientData);
      cantget:
      Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
          " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
          "\" not defined", (char *) NULL);
      return TCL_ERROR;
  }
  /*
   *--------------------------------------------------------------
   *
   * Tk_SelectionCmd --
   *
   *      This procedure is invoked to process the "selection" Tcl
   *      command.  See the user documentation for details on what
   *      it does.
   *
   * Results:
   *      A standard Tcl result.
   *
   * Side effects:
   *      See the user documentation.
   *
   *--------------------------------------------------------------
   */
  int
  Tk_SelectionCmd(clientData, interp, argc, argv)
      ClientData clientData;      /* Main window associated with
                                   * interpreter. */
      Tcl_Interp *interp;         /* Current interpreter. */
      int argc;                   /* Number of arguments. */
      char **argv;                /* Argument strings. */
  {
      Tk_Window tkwin = (Tk_Window) clientData;
      char *path = NULL;
      Atom selection;
      char *selName = NULL;
      int c, count;
      size_t length;
      char **args;
      if (argc < 2) {
          Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                  " option ?arg arg ...?\"", (char *) NULL);
          return TCL_ERROR;
      }
      c = argv[1][0];
      length = strlen(argv[1]);
      if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
          for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
              if (args[0][0] != '-') {
                  break;
              }
              if (count < 2) {
                  Tcl_AppendResult(interp, "value for \"", *args,
                          "\" missing", (char *) NULL);
                  return TCL_ERROR;
              }
              c = args[0][1];
              length = strlen(args[0]);
              if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
                  path = args[1];
              } else if ((c == 's')
                      && (strncmp(args[0], "-selection", length) == 0)) {
                  selName = args[1];
              } else {
                  Tcl_AppendResult(interp, "unknown option \"", args[0],
                          "\"", (char *) NULL);
                  return TCL_ERROR;
              }
          }
          if (count == 1) {
              path = args[0];
          } else if (count > 1) {
              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                      " clear ?options?\"", (char *) NULL);
              return TCL_ERROR;
          }
          if (path != NULL) {
              tkwin = Tk_NameToWindow(interp, path, tkwin);
          }
          if (tkwin == NULL) {
              return TCL_ERROR;
          }
          if (selName != NULL) {
              selection = Tk_InternAtom(tkwin, selName);
          } else {
              selection = XA_PRIMARY;
          }
          Tk_ClearSelection(tkwin, selection);
          return TCL_OK;
      } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
          Atom target;
          char *targetName = NULL;
          Tcl_DString selBytes;
          int result;
          for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
              if (args[0][0] != '-') {
                  break;
              }
              if (count < 2) {
                  Tcl_AppendResult(interp, "value for \"", *args,
                          "\" missing", (char *) NULL);
                  return TCL_ERROR;
              }
              c = args[0][1];
              length = strlen(args[0]);
              if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
                  path = args[1];
              } else if ((c == 's')
                      && (strncmp(args[0], "-selection", length) == 0)) {
                  selName = args[1];
              } else if ((c == 't')
                      && (strncmp(args[0], "-type", length) == 0)) {
                  targetName = args[1];
              } else {
                  Tcl_AppendResult(interp, "unknown option \"", args[0],
                          "\"", (char *) NULL);
                  return TCL_ERROR;
              }
          }
          if (path != NULL) {
              tkwin = Tk_NameToWindow(interp, path, tkwin);
          }
          if (tkwin == NULL) {
              return TCL_ERROR;
          }
          if (selName != NULL) {
              selection = Tk_InternAtom(tkwin, selName);
          } else {
              selection = XA_PRIMARY;
          }
          if (count > 1) {
              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                      " get ?options?\"", (char *) NULL);
              return TCL_ERROR;
          } else if (count == 1) {
              target = Tk_InternAtom(tkwin, args[0]);
          } else if (targetName != NULL) {
              target = Tk_InternAtom(tkwin, targetName);
          } else {
              target = XA_STRING;
          }
          Tcl_DStringInit(&selBytes);
          result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc,
                  (ClientData) &selBytes);
          if (result == TCL_OK) {
              Tcl_DStringResult(interp, &selBytes);
          } else {
              Tcl_DStringFree(&selBytes);
          }
          return result;
      } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
          Atom target, format;
          char *targetName = NULL;
          char *formatName = NULL;
          register CommandInfo *cmdInfoPtr;
          int cmdLength;
          for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
              if (args[0][0] != '-') {
                  break;
              }
              if (count < 2) {
                  Tcl_AppendResult(interp, "value for \"", *args,
                          "\" missing", (char *) NULL);
                  return TCL_ERROR;
              }
              c = args[0][1];
              length = strlen(args[0]);
              if ((c == 'f') && (strncmp(args[0], "-format", length) == 0)) {
                  formatName = args[1];
              } else if ((c == 's')
                      && (strncmp(args[0], "-selection", length) == 0)) {
                  selName = args[1];
              } else if ((c == 't')
                      && (strncmp(args[0], "-type", length) == 0)) {
                  targetName = args[1];
              } else {
                  Tcl_AppendResult(interp, "unknown option \"", args[0],
                          "\"", (char *) NULL);
                  return TCL_ERROR;
              }
          }
          if ((count < 2) || (count > 4)) {
              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                      " handle ?options? window command\"", (char *) NULL);
              return TCL_ERROR;
          }
          tkwin = Tk_NameToWindow(interp, args[0], tkwin);
          if (tkwin == NULL) {
              return TCL_ERROR;
          }
          if (selName != NULL) {
              selection = Tk_InternAtom(tkwin, selName);
          } else {
              selection = XA_PRIMARY;
          }
          if (count > 2) {
              target = Tk_InternAtom(tkwin, args[2]);
          } else if (targetName != NULL) {
              target = Tk_InternAtom(tkwin, targetName);
          } else {
              target = XA_STRING;
          }
          if (count > 3) {
              format = Tk_InternAtom(tkwin, args[3]);
          } else if (formatName != NULL) {
              format = Tk_InternAtom(tkwin, formatName);
          } else {
              format = XA_STRING;
          }
          cmdLength = strlen(args[1]);
          if (cmdLength == 0) {
              Tk_DeleteSelHandler(tkwin, selection, target);
          } else {
              cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
                      sizeof(CommandInfo) - 3 + cmdLength));
              cmdInfoPtr->interp = interp;
              cmdInfoPtr->charOffset = 0;
              cmdInfoPtr->byteOffset = 0;
              cmdInfoPtr->buffer[0] = '\0';
              cmdInfoPtr->cmdLength = cmdLength;
              strcpy(cmdInfoPtr->command, args[1]);
              Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
                      (ClientData) cmdInfoPtr, format);
          }
          return TCL_OK;
      } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
          register LostCommand *lostPtr;
          char *script = NULL;
          int cmdLength;
          for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
              if (args[0][0] != '-') {
                  break;
              }
              if (count < 2) {
                  Tcl_AppendResult(interp, "value for \"", *args,
                          "\" missing", (char *) NULL);
                  return TCL_ERROR;
              }
              c = args[0][1];
              length = strlen(args[0]);
              if ((c == 'c') && (strncmp(args[0], "-command", length) == 0)) {
                  script = args[1];
              } else if ((c == 'd')
                      && (strncmp(args[0], "-displayof", length) == 0)) {
                  path = args[1];
              } else if ((c == 's')
                      && (strncmp(args[0], "-selection", length) == 0)) {
                  selName = args[1];
              } else {
                  Tcl_AppendResult(interp, "unknown option \"", args[0],
                          "\"", (char *) NULL);
                  return TCL_ERROR;
              }
          }
          if (count > 2) {
              Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                      " own ?options? ?window?\"", (char *) NULL);
              return TCL_ERROR;
          }
          if (selName != NULL) {
              selection = Tk_InternAtom(tkwin, selName);
          } else {
              selection = XA_PRIMARY;
          }
          if (count == 0) {
              TkSelectionInfo *infoPtr;
              TkWindow *winPtr;
              if (path != NULL) {
                  tkwin = Tk_NameToWindow(interp, path, tkwin);
              }
              if (tkwin == NULL) {
                  return TCL_ERROR;
              }
              winPtr = (TkWindow *)tkwin;
              for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
                      infoPtr = infoPtr->nextPtr) {
                  if (infoPtr->selection == selection)
                      break;
              }
              /*
               * Ignore the internal clipboard window.
               */
              if ((infoPtr != NULL)
                      && (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
                  Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
              }
              return TCL_OK;
          }
          tkwin = Tk_NameToWindow(interp, args[0], tkwin);
          if (tkwin == NULL) {
              return TCL_ERROR;
          }
          if (count == 2) {
              script = args[1];
          }
          if (script == NULL) {
              Tk_OwnSelection(tkwin, selection, (Tk_LostSelProc *) NULL,
                      (ClientData) NULL);
              return TCL_OK;
          }
          cmdLength = strlen(script);
          lostPtr = (LostCommand *) ckalloc((unsigned) (sizeof(LostCommand)
                  -3 + cmdLength));
          lostPtr->interp = interp;
          strcpy(lostPtr->command, script);
          Tk_OwnSelection(tkwin, selection, LostSelection, (ClientData) lostPtr);
          return TCL_OK;
      } else {
          Tcl_AppendResult(interp, "bad option \"", argv[1],
                  "\": must be clear, get, handle, or own", (char *) NULL);
          return TCL_ERROR;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelGetInProgress --
   *
   *      This procedure returns a pointer to the thread-local
   *      list of pending searches.
   *
   * Results:
   *      The return value is a pointer to the first search in progress,
   *      or NULL if there are none.
   *
   * Side effects:
   *      None.
   *
   *----------------------------------------------------------------------
   */
  TkSelInProgress *
  TkSelGetInProgress _ANSI_ARGS_((void))
  {
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      return tsdPtr->pendingPtr;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelSetInProgress --
   *
   *      This procedure is used to set the thread-local list of pending
   *      searches.  It is required because the pending list is kept
   *      in thread local storage.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      None.
   *
   *----------------------------------------------------------------------
   */
  void
  TkSelSetInProgress(pendingPtr)
      TkSelInProgress *pendingPtr;
  {
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
     tsdPtr->pendingPtr = pendingPtr;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelDeadWindow --
   *
   *      This procedure is invoked just before a TkWindow is deleted.
   *      It performs selection-related cleanup.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Frees up memory associated with the selection.
   *
   *----------------------------------------------------------------------
   */
  void
  TkSelDeadWindow(winPtr)
      register TkWindow *winPtr;  /* Window that's being deleted. */
  {
      register TkSelHandler *selPtr;
      register TkSelInProgress *ipPtr;
      TkSelectionInfo *infoPtr, *prevPtr, *nextPtr;
      ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
              Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
      /*
       * While deleting all the handlers, be careful to check whether
       * ConvertSelection or TkSelPropProc are about to process one of the
       * deleted handlers.
       */
      while (winPtr->selHandlerList != NULL) {
          selPtr = winPtr->selHandlerList;
          winPtr->selHandlerList = selPtr->nextPtr;
          for (ipPtr = tsdPtr->pendingPtr; ipPtr != NULL;
                  ipPtr = ipPtr->nextPtr) {
              if (ipPtr->selPtr == selPtr) {
                  ipPtr->selPtr = NULL;
              }
          }
          if (selPtr->proc == HandleTclCommand) {
              /*
               * Mark the CommandInfo as deleted and free it if we can.
               */
              ((CommandInfo*)selPtr->clientData)->interp = NULL;
              Tcl_EventuallyFree(selPtr->clientData, Tcl_Free);
          }
          ckfree((char *) selPtr);
      }
      /*
       * Remove selections owned by window being deleted.
       */
      for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
               infoPtr != NULL; infoPtr = nextPtr) {
          nextPtr = infoPtr->nextPtr;
          if (infoPtr->owner == (Tk_Window) winPtr) {
              if (infoPtr->clearProc == LostSelection) {
                  ckfree((char *) infoPtr->clearData);
              }
              ckfree((char *) infoPtr);
              infoPtr = prevPtr;
              if (prevPtr == NULL) {
                  winPtr->dispPtr->selectionInfoPtr = nextPtr;
              } else {
                  prevPtr->nextPtr = nextPtr;
              }
          }
          prevPtr = infoPtr;
      }
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelInit --
   *
   *      Initialize selection-related information for a display.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Selection-related information is initialized.
   *
   *----------------------------------------------------------------------
   */
  void
  TkSelInit(tkwin)
      Tk_Window tkwin;            /* Window token (used to find
                                   * display to initialize). */
  {
      register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
      /*
       * Fetch commonly-used atoms.
       */
      dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
      dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
      dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
      dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
      dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
      dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
      dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
      dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
      dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelClearSelection --
   *
   *      This procedure is invoked to process a SelectionClear event.
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      Invokes the clear procedure for the window which lost the
   *      selection.
   *
   *----------------------------------------------------------------------
   */
  void
  TkSelClearSelection(tkwin, eventPtr)
      Tk_Window tkwin;            /* Window for which event was targeted. */
      register XEvent *eventPtr;  /* X SelectionClear event. */
  {
      register TkWindow *winPtr = (TkWindow *) tkwin;
      TkDisplay *dispPtr = winPtr->dispPtr;
      TkSelectionInfo *infoPtr;
      TkSelectionInfo *prevPtr;
      /*
       * Invoke clear procedure for window that just lost the selection.  This
       * code is a bit tricky, because any callbacks due to selection changes
       * between windows managed by the process have already been made.  Thus,
       * ignore the event unless it refers to the window that's currently the
       * selection owner and the event was generated after the server saw the
       * SetSelectionOwner request.
       */
      for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
           infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
          if (infoPtr->selection == eventPtr->xselectionclear.selection) {
              break;
          }
          prevPtr = infoPtr;
      }
      if (infoPtr != NULL && (infoPtr->owner == tkwin)
              && (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
          if (prevPtr == NULL) {
              dispPtr->selectionInfoPtr = infoPtr->nextPtr;
          } else {
              prevPtr->nextPtr = infoPtr->nextPtr;
          }
          /*
           * Because of reentrancy problems, calling clearProc must be done
           * after the infoPtr has been removed from the selectionInfoPtr
           * list (clearProc could modify the list, e.g. by creating
           * a new selection).
           */
          if (infoPtr->clearProc != NULL) {
              (*infoPtr->clearProc)(infoPtr->clearData);
          }
          ckfree((char *) infoPtr);
      }
  }
  /*
   *--------------------------------------------------------------
   *
   * SelGetProc --
   *
   *      This procedure is invoked to process pieces of the selection
   *      as they arrive during "selection get" commands.
   *
   * Results:
   *      Always returns TCL_OK.
   *
   * Side effects:
   *      Bytes get appended to the dynamic string pointed to by the
   *      clientData argument.
   *
   *--------------------------------------------------------------
   */
          /* ARGSUSED */
  static int
  SelGetProc(clientData, interp, portion)
      ClientData clientData;      /* Dynamic string holding partially
                                   * assembled selection. */
      Tcl_Interp *interp;         /* Interpreter used for error
                                   * reporting (not used). */
      char *portion;              /* New information to be appended. */
  {
      Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
      return TCL_OK;
  }
  /*
   *----------------------------------------------------------------------
   *
   * HandleTclCommand --
   *
   *      This procedure acts as selection handler for handlers created
   *      by the "selection handle" command.  It invokes a Tcl command to
   *      retrieve the selection.
   *
   * Results:
   *      The return value is a count of the number of bytes actually
   *      stored at buffer, or -1 if an error occurs while executing
   *      the Tcl command to retrieve the selection.
   *
   * Side effects:
   *      None except for things done by the Tcl command.
   *
   *----------------------------------------------------------------------
   */
  static int
  HandleTclCommand(clientData, offset, buffer, maxBytes)
      ClientData clientData;      /* Information about command to execute. */
      int offset;                 /* Return selection bytes starting at this
                                   * offset. */
      char *buffer;               /* Place to store converted selection. */
      int maxBytes;               /* Maximum # of bytes to store at buffer. */
  {
      CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
      int spaceNeeded, length;
  #define MAX_STATIC_SIZE 100
      char staticSpace[MAX_STATIC_SIZE];
      char *command, *string;
      Tcl_Interp *interp = cmdInfoPtr->interp;
      Tcl_DString oldResult;
      Tcl_Obj *objPtr;
      int extraBytes, charOffset, count, numChars;
      char *p;
      /*
       * We must also protect the interpreter and the command from being
       * deleted too soon.
       */
      Tcl_Preserve(clientData);
      Tcl_Preserve((ClientData) interp);
      /*
       * Compute the proper byte offset in the case where the last chunk
       * split a character.
       */
      if (offset == cmdInfoPtr->byteOffset) {
          charOffset = cmdInfoPtr->charOffset;
          extraBytes = strlen(cmdInfoPtr->buffer);
          if (extraBytes > 0) {
              strcpy(buffer, cmdInfoPtr->buffer);
              maxBytes -= extraBytes;
              buffer += extraBytes;
          }
      } else {
          cmdInfoPtr->byteOffset = 0;
          cmdInfoPtr->charOffset = 0;
          extraBytes = 0;
          charOffset = 0;
      }
      /*
       * First, generate a command by taking the command string
       * and appending the offset and maximum # of bytes.
       */
      spaceNeeded = cmdInfoPtr->cmdLength + 30;
      if (spaceNeeded < MAX_STATIC_SIZE) {
          command = staticSpace;
      } else {
          command = (char *) ckalloc((unsigned) spaceNeeded);
      }
      sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes);
      /*
       * Execute the command.  Be sure to restore the state of the
       * interpreter after executing the command.
       */
      Tcl_DStringInit(&oldResult);
      Tcl_DStringGetResult(interp, &oldResult);
      if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
          objPtr = Tcl_GetObjResult(interp);
          string = Tcl_GetStringFromObj(objPtr, &length);
          count = (length > maxBytes) ? maxBytes : length;
          memcpy((VOID *) buffer, (VOID *) string, (size_t) count);
          buffer[count] = '\0';
          /*
           * Update the partial character information for the next
           * retrieval if the command has not been deleted.
           */
          if (cmdInfoPtr->interp != NULL) {
              if (length <= maxBytes) {
                  cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
                  cmdInfoPtr->buffer[0] = '\0';
              } else {
                  p = string;
                  string += count;
                  numChars = 0;
                  while (p < string) {
                      p = Tcl_UtfNext(p);
                      numChars++;
                  }
                  cmdInfoPtr->charOffset += numChars;
                  length = p - string;
                  if (length > 0) {
                      strncpy(cmdInfoPtr->buffer, string, (size_t) length);
                  }
                  cmdInfoPtr->buffer[length] = '\0';
              }
              cmdInfoPtr->byteOffset += count + extraBytes;
          }
          count += extraBytes;
      } else {
          count = -1;
      }
      Tcl_DStringResult(interp, &oldResult);
      if (command != staticSpace) {
          ckfree(command);
      }
      Tcl_Release(clientData);
      Tcl_Release((ClientData) interp);
      return count;
  }
  /*
   *----------------------------------------------------------------------
   *
   * TkSelDefaultSelection --
   *
   *      This procedure is called to generate selection information
   *      for a few standard targets such as TIMESTAMP and TARGETS.
   *      It is invoked only if no handler has been declared by the
   *      application.
   *
   * Results:
   *      If "target" is a standard target understood by this procedure,
   *      the selection is converted to that form and stored as a
   *      character string in buffer.  The type of the selection (e.g.
   *      STRING or ATOM) is stored in *typePtr, and the return value is
   *      a count of the # of non-NULL bytes at buffer.  If the target
   *      wasn't understood, or if there isn't enough space at buffer
   *      to hold the entire selection (no INCR-mode transfers for this
   *      stuff!), then -1 is returned.
   *
   * Side effects:
   *      None.
   *
   *----------------------------------------------------------------------
   */
  int
  TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
      TkSelectionInfo *infoPtr;   /* Info about selection being retrieved. */
      Atom target;                /* Desired form of selection. */
      char *buffer;               /* Place to put selection characters. */
      int maxBytes;               /* Maximum # of bytes to store at buffer. */
      Atom *typePtr;              /* Store here the type of the selection,
                                   * for use in converting to proper X format. */
  {
      register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
      TkDisplay *dispPtr = winPtr->dispPtr;
      if (target == dispPtr->timestampAtom) {
          if (maxBytes < 20) {
              return -1;
          }
          sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
          *typePtr = XA_INTEGER;
          return strlen(buffer);
      }
      if (target == dispPtr->targetsAtom) {
          register TkSelHandler *selPtr;
          char *atomString;
          int length, atomLength;
          if (maxBytes < 50) {
              return -1;
          }
          strcpy(buffer, "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW");
          length = strlen(buffer);
          for (selPtr = winPtr->selHandlerList; selPtr != NULL;
                  selPtr = selPtr->nextPtr) {
              if ((selPtr->selection == infoPtr->selection)
                      && (selPtr->target != dispPtr->applicationAtom)
                      && (selPtr->target != dispPtr->windowAtom)) {
                  atomString = Tk_GetAtomName((Tk_Window) winPtr,
                          selPtr->target);
                  atomLength = strlen(atomString) + 1;
                  if ((length + atomLength) >= maxBytes) {
                      return -1;
                  }
                  sprintf(buffer+length, " %s", atomString);
                  length += atomLength;
              }
          }
          *typePtr = XA_ATOM;
          return length;
      }
      if (target == dispPtr->applicationAtom) {
          int length;
          char *name = winPtr->mainPtr->winPtr->nameUid;
          length = strlen(name);
          if (maxBytes <= length) {
              return -1;
          }
          strcpy(buffer, name);
          *typePtr = XA_STRING;
          return length;
      }
      if (target == dispPtr->windowAtom) {
          int length;
          char *name = winPtr->pathName;
          length = strlen(name);
          if (maxBytes <= length) {
              return -1;
          }
          strcpy(buffer, name);
          *typePtr = XA_STRING;
          return length;
      }
      return -1;
  }
  /*
   *----------------------------------------------------------------------
   *
   * LostSelection --
   *
   *      This procedure is invoked when a window has lost ownership of
   *      the selection and the ownership was claimed with the command
   *      "selection own".
   *
   * Results:
   *      None.
   *
   * Side effects:
   *      A Tcl script is executed;  it can do almost anything.
   *
   *----------------------------------------------------------------------
   */
  static void
  LostSelection(clientData)
      ClientData clientData;              /* Pointer to LostCommand structure. */
  {
      LostCommand *lostPtr = (LostCommand *) clientData;
      Tcl_Obj *objPtr;
      Tcl_Interp *interp;
      interp = lostPtr->interp;
      Tcl_Preserve((ClientData) interp);
      /*
       * Execute the command.  Save the interpreter's result, if any, and
       * restore it after executing the command.
       */
      objPtr = Tcl_GetObjResult(interp);
      Tcl_IncrRefCount(objPtr);
      Tcl_ResetResult(interp);
      if (TkCopyAndGlobalEval(interp, lostPtr->command) != TCL_OK) {
          Tcl_BackgroundError(interp);
      }
      Tcl_SetObjResult(interp, objPtr);
      Tcl_DecrRefCount(objPtr);
      Tcl_Release((ClientData) interp);
      /*
       * Free the storage for the command, since we're done with it now.
       */
      ckfree((char *) lostPtr);
  }
  /* End of tkselect.c */

 Legend:



Removed from v.69
 


changed lines


 
Added in v.98
 Legend:



Removed from v.69
 


changed lines


 
Added in v.98
-Removed from v.69
+Added in v.98

dashley@gmail.com	ViewVC Help
Powered by ViewVC 1.1.25