comparison src/xselect.c @ 83250:89ac10c67e45

Merged from [e-mail]--gnu-2005 (patch 12-13, 79-90) Patches applied: * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-79 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-80 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-81 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-82 Merge from gnus--rel--5.10 * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-83 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-84 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-85 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-86 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-87 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-88 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-89 Update from CVS * [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-90 Update from CVS: man/calc.texi: Add macro for LaTeX for info output. * [e-mail]--gnu-2005/gnus--rel--5.10--patch-12 Merge from emacs--cvs-trunk--0 * [e-mail]--gnu-2005/gnus--rel--5.10--patch-13 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-290

83249:267c2ab562ab

static Lisp_Object Vselection_converter_alist;

/* If the selection owner takes too long to reply to a selection request,
   we give up on it.  This is in milliseconds (0 = no timeout.)  */
static EMACS_INT x_selection_timeout;

/* Utility functions */

static void lisp_data_to_selection_data ();
static Lisp_Object selection_data_to_lisp_data ();
static Lisp_Object x_get_window_property_as_lisp_data ();



/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */

      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);

      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
      XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
		       32, PropModeReplace,
		       (unsigned char *) &bytes_remaining, 1);
      XSelectInput (display, window, PropertyChangeMask);

      /* Tell 'em the INCR data is there...  */
      TRACE0 ("Send SelectionNotify event");
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);

	unexpect_property_change (wait_object);

      TRACE0 ("Got ACK");
      while (bytes_remaining)
	{
	  int i = ((bytes_remaining < max_bytes)
		   ? bytes_remaining
		   : max_bytes);

	  BLOCK_INPUT;

	  wait_object
	    = expect_property_change (display, window, reply.property,

      /* If this doesn't return Success at this point, it means that
	 some clod deleted the selection while we were in the midst of
	 reading it.  Deal with that, I guess.... */
      if (result != Success)
	break;
      *actual_size_ret *= *actual_format_ret / 8;
      bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
      offset += *actual_size_ret;

      /* This was allocated by Xlib, so use XFree.  */
      XFree ((char *) tmp_data);
    }

   of format 16 if every element in the vector is an integer, and is assumed
   to be of format 32 if any element is a cons of two integers.

   When converting an object to C, it may be of the form (SYMBOL . <data>)
   where SYMBOL is what we should claim that the type is.  Format and
   representation are as above.  */



static Lisp_Object
selection_data_to_lisp_data (display, data, size, type, format)

     a vector of symbols.
   */
  else if (type == XA_ATOM)
    {
      int i;
      if (size == sizeof (Atom))
	return x_atom_to_symbol (display, *((Atom *) data));
      else
	{
	  Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
					make_number (0));
	  for (i = 0; i < size / sizeof (Atom); i++)
	    Faset (v, make_number (i),
		   x_atom_to_symbol (display, ((Atom *) data) [i]));
	  return v;
	}
    }

  /* Convert a single 16 or small 32 bit number to a Lisp_Int.

	}
#endif
      else
	/* This vector is an INTEGER set, or something like it */
	{
	  *size_ret = XVECTOR (obj)->size;
	  if (NILP (type)) type = QINTEGER;
	  *format_ret = 16;
	  for (i = 0; i < *size_ret; i++)
	    if (CONSP (XVECTOR (obj)->contents [i]))

	      Fsignal (Qerror, /* Qselection_error */
		       Fcons (build_string
	("elements of selection vector must be integers or conses of integers"),
			      Fcons (obj, Qnil)));

	  *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
	  for (i = 0; i < *size_ret; i++)
	    if (*format_ret == 32)
	      (*((unsigned long **) data_ret)) [i]
		= cons_to_long (XVECTOR (obj)->contents [i]);
	    else

   DPY is the display use to look up X atoms.
   DATA is a Lisp list of values to be converted.
   RET is the C array that contains the converted values.  It is assumed
   it is big enough to hold all values.
   FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
   be stored in RET.  */

void
x_fill_property_data (dpy, data, ret, format)
     Display *dpy;
     Lisp_Object data;
     void *ret;
     int format;
{
  CARD32 val;
  CARD32 *d32 = (CARD32 *) ret;
  CARD16 *d16 = (CARD16 *) ret;
  CARD8  *d08 = (CARD8  *) ret;
  Lisp_Object iter;

  for (iter = data; CONSP (iter); iter = XCDR (iter))
    {
      Lisp_Object o = XCAR (iter);

      if (INTEGERP (o))
        val = (CARD32) XFASTINT (o);
      else if (FLOATP (o))
        val = (CARD32) XFLOAT_DATA (o);
      else if (CONSP (o))
        val = (CARD32) cons_to_long (o);
      else if (STRINGP (o))
        {
          BLOCK_INPUT;
          val = XInternAtom (dpy, (char *) SDATA (o), False);
          UNBLOCK_INPUT;
        }
      else
        error ("Wrong type, must be string, number or cons");

      if (format == 8)
        *d08++ = (CARD8) val;
      else if (format == 16)
        *d16++ = (CARD16) val;
      else
        *d32++ = val;
    }
}

   each number in DATA to its corresponfing X atom as a symbol.
   FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
   be stored in RET.
   SIZE is the number of elements in DATA.

   Also see comment for selection_data_to_lisp_data above.  */

Lisp_Object
x_property_data_to_lisp (f, data, type, format, size)
     struct frame *f;

{
  return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
                                      data, size*format/8, type, format);
}

/* Get the mouse position frame relative coordinates.  */

static void
mouse_position_for_drop (f, x, y)
     FRAME_PTR f;
     int *x;

     struct x_display_info *dpyinfo;
     struct input_event *bufp;
{
  Lisp_Object vec;
  Lisp_Object frame;
  unsigned long size = (8*sizeof (event->data))/event->format;
  int x, y;

  XSETFRAME (frame, f);

  vec = Fmake_vector (make_number (4), Qnil);
  AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
                                                 event->message_type));
  AREF (vec, 1) = frame;
  AREF (vec, 2) = make_number (event->format);
  AREF (vec, 3) = x_property_data_to_lisp (f,
                                           event->data.b,
                                           event->message_type,
                                           event->format,
                                           size);

  mouse_position_for_drop (f, &x, &y);

  /* Some clients (metacity for example) expects sending window to be here
     when sending to the root window.  */
  event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;

  memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
  x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
                        event.xclient.format);

  /* If event mask is 0 the event is sent to the client that created

83250:89ac10c67e45

static Lisp_Object Vselection_converter_alist;

/* If the selection owner takes too long to reply to a selection request,
   we give up on it.  This is in milliseconds (0 = no timeout.)  */
static EMACS_INT x_selection_timeout;



/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */

      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);

      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
      {
        /* XChangeProperty expects an array of long even if long is more than
           32 bits.  */
        long value[1];

        value[0] = bytes_remaining;
        XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
                         32, PropModeReplace,
                         (unsigned char *) value, 1);
      }

      XSelectInput (display, window, PropertyChangeMask);

      /* Tell 'em the INCR data is there...  */
      TRACE0 ("Send SelectionNotify event");
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);

	unexpect_property_change (wait_object);

      TRACE0 ("Got ACK");
      while (bytes_remaining)
	{
          int i = ((bytes_remaining < max_bytes)
                   ? bytes_remaining
                   : max_bytes);

	  BLOCK_INPUT;

	  wait_object
	    = expect_property_change (display, window, reply.property,

      /* If this doesn't return Success at this point, it means that
	 some clod deleted the selection while we were in the midst of
	 reading it.  Deal with that, I guess.... */
      if (result != Success)
	break;

      /* The man page for XGetWindowProperty says:
         "If the returned format is 32, the returned data is represented
          as a long array and should be cast to that type to obtain the
          elements."
         This applies even if long is more than 32 bits, the X library
         converts from 32 bit elements received from the X server to long
         and passes the long array to us.  Thus, for that case bcopy can not
         be used.  We convert to a 32 bit type here, because so much code
         assume on that.

         The bytes and offsets passed to XGetWindowProperty refers to the
         property and those are indeed in 32 bit quantities if format is 32.  */

      if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
        {
          unsigned long i;
          int  *idata = (int *) ((*data_ret) + offset);
          long *ldata = (long *) tmp_data;

          for (i = 0; i < *actual_size_ret; ++i)
            {
              idata[i]= (int) ldata[i];
              offset += 4;
            }
        }
      else
        {
          *actual_size_ret *= *actual_format_ret / 8;
          bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
          offset += *actual_size_ret;
        }

      /* This was allocated by Xlib, so use XFree.  */
      XFree ((char *) tmp_data);
    }

   of format 16 if every element in the vector is an integer, and is assumed
   to be of format 32 if any element is a cons of two integers.

   When converting an object to C, it may be of the form (SYMBOL . <data>)
   where SYMBOL is what we should claim that the type is.  Format and
   representation are as above.

   Important: When format is 32, data should contain an array of int,
   not an array of long as the X library returns.  This makes a difference
   when sizeof(long) != sizeof(int).  */



static Lisp_Object
selection_data_to_lisp_data (display, data, size, type, format)

     a vector of symbols.
   */
  else if (type == XA_ATOM)
    {
      int i;
      /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
         But the callers of these function has made sure the data for
         format == 32 is an array of int.  Thus, use int instead
         of Atom.  */
      int *idata = (int *) data;

      if (size == sizeof (int))
	return x_atom_to_symbol (display, (Atom) idata[0]);
      else
	{
	  Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
					make_number (0));
	  for (i = 0; i < size / sizeof (int); i++)
	    Faset (v, make_number (i),
                   x_atom_to_symbol (display, (Atom) idata[i]));
	  return v;
	}
    }

  /* Convert a single 16 or small 32 bit number to a Lisp_Int.

	}
#endif
      else
	/* This vector is an INTEGER set, or something like it */
	{
          int data_size = 2;
	  *size_ret = XVECTOR (obj)->size;
	  if (NILP (type)) type = QINTEGER;
	  *format_ret = 16;
	  for (i = 0; i < *size_ret; i++)
	    if (CONSP (XVECTOR (obj)->contents [i]))

	      Fsignal (Qerror, /* Qselection_error */
		       Fcons (build_string
	("elements of selection vector must be integers or conses of integers"),
			      Fcons (obj, Qnil)));

          /* Use sizeof(long) even if it is more than 32 bits.  See comment
             in x_get_window_property and x_fill_property_data.  */
          
          if (*format_ret == 32) data_size = sizeof(long);
	  *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
	  for (i = 0; i < *size_ret; i++)
	    if (*format_ret == 32)
	      (*((unsigned long **) data_ret)) [i]
		= cons_to_long (XVECTOR (obj)->contents [i]);
	    else

   DPY is the display use to look up X atoms.
   DATA is a Lisp list of values to be converted.
   RET is the C array that contains the converted values.  It is assumed
   it is big enough to hold all values.
   FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
   be stored in RET.  Note that long is used for 32 even if long is more
   than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
   XClientMessageEvent).  */

void
x_fill_property_data (dpy, data, ret, format)
     Display *dpy;
     Lisp_Object data;
     void *ret;
     int format;
{
  long val;
  long  *d32 = (long  *) ret;
  short *d16 = (short *) ret;
  char  *d08 = (char  *) ret;
  Lisp_Object iter;

  for (iter = data; CONSP (iter); iter = XCDR (iter))
    {
      Lisp_Object o = XCAR (iter);

      if (INTEGERP (o))
        val = (long) XFASTINT (o);
      else if (FLOATP (o))
        val = (long) XFLOAT_DATA (o);
      else if (CONSP (o))
        val = (long) cons_to_long (o);
      else if (STRINGP (o))
        {
          BLOCK_INPUT;
          val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
          UNBLOCK_INPUT;
        }
      else
        error ("Wrong type, must be string, number or cons");

      if (format == 8)
        *d08++ = (char) val;
      else if (format == 16)
        *d16++ = (short) val;
      else
        *d32++ = val;
    }
}

   each number in DATA to its corresponfing X atom as a symbol.
   FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
   be stored in RET.
   SIZE is the number of elements in DATA.

   Important: When format is 32, data should contain an array of int,
   not an array of long as the X library returns.  This makes a difference
   when sizeof(long) != sizeof(int).

   Also see comment for selection_data_to_lisp_data above.  */

Lisp_Object
x_property_data_to_lisp (f, data, type, format, size)
     struct frame *f;

{
  return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
                                      data, size*format/8, type, format);
}

/* Get the mouse position in frame relative coordinates.  */

static void
mouse_position_for_drop (f, x, y)
     FRAME_PTR f;
     int *x;

     struct x_display_info *dpyinfo;
     struct input_event *bufp;
{
  Lisp_Object vec;
  Lisp_Object frame;
  /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
  unsigned long size = 160/event->format;
  int x, y;
  unsigned char *data = (unsigned char *) event->data.b;
  int idata[5];

  XSETFRAME (frame, f);

  /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
     but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
     function expects them to be of size int (i.e. 32).  So to be able to
     use that function, put the data in the form it expects if format is 32. */

  if (event->format == 32 && event->format < BITS_PER_LONG)
    {
      int i;
      for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
        idata[i] = (int) event->data.l[i];
      data = (unsigned char *) idata;
    }

  vec = Fmake_vector (make_number (4), Qnil);
  AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
                                                 event->message_type));
  AREF (vec, 1) = frame;
  AREF (vec, 2) = make_number (event->format);
  AREF (vec, 3) = x_property_data_to_lisp (f,
                                           data,
                                           event->message_type,
                                           event->format,
                                           size);

  mouse_position_for_drop (f, &x, &y);

  /* Some clients (metacity for example) expects sending window to be here
     when sending to the root window.  */
  event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;

  
  memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
  x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
                        event.xclient.format);

  /* If event mask is 0 the event is sent to the client that created