comparison src/xselect.c @ 45672:1f957476e757

(lisp_data_to_selection_data): Fix last change: *data_ret is not a Lisp string, while unibyte_string is.

45671:a2a919ea2b23

static Lisp_Object Vnext_selection_coding_system;

/* If this is a smaller number than the max-request-size of the display,
   emacs will use INCR selection transfer when the selection is larger
   than this.  The max-request-size is usually around 64k, so if you want
   emacs to use incremental selection transfers when the selection is 
   smaller than that, set this.  I added this mostly for debugging the
   incremental transfer stuff, but it might improve server performance.  */
#define MAX_SELECTION_QUANTUM 0xFFFFFF

#ifdef HAVE_X11R4

    selection-values.  */
static Lisp_Object Vselection_alist;

/* This is an alist whose CARs are selection-types (whose names are the same
   as the names of X Atoms) and whose CDRs are the names of Lisp functions to
   call to convert the given Emacs selection value to a string representing 
   the given selection type.  This is for Lisp-level extension of the emacs
   selection handling.  */
static Lisp_Object Vselection_converter_alist;

/* If the selection owner takes too long to reply to a selection request,

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 ();

/* This converts a Lisp symbol to a server Atom, avoiding a server 
   roundtrip whenever possible.  */

static Atom
symbol_to_x_atom (dpyinfo, display, sym)
     struct x_display_info *dpyinfo;

     Atom atom;
{
  struct x_display_info *dpyinfo;
  char *str;
  Lisp_Object val;
  
  if (! atom)
    return Qnil;
  
  switch (atom)
    {
    case XA_PRIMARY:
      return QPRIMARY;
    case XA_SECONDARY:

  UNBLOCK_INPUT;
  return val;
}

/* Do protocol to assert ourself as a selection owner.
   Update the Vselection_alist so that we can reply to later requests for 
   our selection.  */

static void
x_own_selection (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;

  check = value;
  if (CONSP (value)
      && SYMBOLP (XCAR (value)))
    type = XCAR (value),
    check = XCDR (value);
  
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
      || INTEGERP (check)
      || NILP (value))

x_decline_selection_request (event)
     struct input_event *event;
{
  XSelectionEvent reply;
  int count;
  
  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);

				 frame);
	}

      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
	error ("Attempt to transfer an INCR to ourself!");
      
      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);

	      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);
      XFlush (display);

				      PropertyDelete);

	  TRACE1 ("Sending increment of %d bytes", i);
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));
	  
	  /* Append the next chunk of data to the property.  */
	  XChangeProperty (display, window, reply.property, type, format,
			   PropModeAppend, data, i / format_bytes);
	  bytes_remaining -= i;
	  data += i;

	     property.	 This can run random lisp code or signal.  */
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_property_change (wait_object);
	}
      
      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
      BLOCK_INPUT;
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

#if 0 /* #### MULTIPLE doesn't work yet */
  if (EQ (target_symbol, QMULTIPLE))
    target_symbol = fetch_multiple_target (event);
#endif
  
  /* Convert lisp objects back into binary data */
  
  converted_selection
    = x_get_local_selection (selection_symbol, target_symbol);
  
  if (! NILP (converted_selection))
    {
      unsigned char *data;
      unsigned int size;
      int format;

      int nofree;

      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
				   &data, &type, &size, &format, &nofree);
      
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

      /* Indicate we have successfully processed this event.  */
      x_selection_current_request = 0;

     struct input_event *event;
{
  Display *display = SELECTION_EVENT_DISPLAY (event);
  Atom selection = SELECTION_EVENT_SELECTION (event);
  Time changed_owner_time = SELECTION_EVENT_TIME (event);
  
  Lisp_Object selection_symbol, local_selection_data;
  Time local_selection_time;
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
  struct x_display_info *t_dpyinfo;

	  else
	    property_change_wait_list = rest->next;
	  xfree (rest);
	  return;
	}
      
      prev = rest;
      rest = rest->next;
    }
}

  Lisp_Object vec;
  int i;
  int size;
  if (CONSP (obj))
    return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
    
  CHECK_VECTOR (obj);
  vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
  for (i = 0; i < size; i++)
    {
      Lisp_Object vec2 = XVECTOR (obj)->contents [i];

    type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
  else
    type_atom = symbol_to_x_atom (dpyinfo, display, target_type);

  BLOCK_INPUT;
  
  count = x_catch_errors (display);
  
  TRACE2 ("Get selection %s, type %s",
	  XGetAtomName (display, type_atom),
	  XGetAtomName (display, target_property));

  XConvertSelection (display, selection_atom, type_atom, target_property,

  unsigned long bytes_remaining;
  int offset = 0;
  unsigned char *tmp_data = 0;
  int result;
  int buffer_size = SELECTION_QUANTUM (display);
  
  if (buffer_size > MAX_SELECTION_QUANTUM)
    buffer_size = MAX_SELECTION_QUANTUM;
  
  BLOCK_INPUT;
  
  /* First probe the thing to find out how big it is.  */
  result = XGetWindowProperty (display, window, property,
			       0L, 0L, False, AnyPropertyType,
			       actual_type_ret, actual_format_ret,
			       actual_size_ret,

      UNBLOCK_INPUT;
      *data_ret = 0;
      *bytes_ret = 0;
      return;
    }
  
  /* This was allocated by Xlib, so use XFree.  */
  XFree ((char *) tmp_data);
  
  if (*actual_type_ret == None || *actual_format_ret == 0)
    {
      UNBLOCK_INPUT;
      return;
    }

  total_size = bytes_remaining + 1;
  *data_ret = (unsigned char *) xmalloc (total_size);
  
  /* Now read, until we've gotten it all.  */
  while (bytes_remaining)
    {
#ifdef TRACE_SELECTION
      int last = bytes_remaining;

      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);
    }

  XFlush (display);

      unsigned char *tmp_data;
      int tmp_size_bytes;

      TRACE0 ("  Wait for property change");
      wait_for_property_change (wait_object);
      
      /* expect it again immediately, because x_get_window_property may
	 .. no it won't, I don't get it.
	 .. Ok, I get it now, the Xt code that implements INCR is broken. */
      TRACE0 ("  Get property value");
      x_get_window_property (display, window, property,

      if (*size_bytes_ret < offset + tmp_size_bytes)
	{
	  *size_bytes_ret = offset + tmp_size_bytes;
	  *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
	}
      
      bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
      offset += tmp_size_bytes;
      
      /* Use xfree, not XFree, because x_get_window_property
	 calls xmalloc itself.  */
      xfree (tmp_data);
    }
}

	       : Fcons (build_string ("no selection"),
			Fcons (x_atom_to_symbol (display,
						 selection_atom),
			       Qnil)));
    }
  
  if (actual_type == dpyinfo->Xatom_INCR)
    {
      /* That wasn't really the data, just the beginning.  */

      unsigned int min_size_bytes = * ((unsigned int *) data);

  /* It's been read.  Now convert it to a lisp object in some semi-rational
     manner.  */
  val = selection_data_to_lisp_data (display, data, bytes,
				     actual_type, actual_format);
  
  /* Use xfree, not XFree, because x_get_window_property
     calls xmalloc itself.  */
  xfree ((char *) data);
  return val;
}

	  Lisp_Object unibyte_string;

	  unibyte_string = string_make_unibyte (obj);
	  *data_ret = XSTRING (unibyte_string)->data;
	  *nofree_ret = 1;
	  *size_ret = STRING_BYTES (*data_ret);
	}
      else
	{
	  *data_ret = x_encode_text (obj, Vnext_selection_coding_system, 1,
				     (int *) size_ret, &stringp);

	    if (VECTORP (XVECTOR (obj)->contents [i]))
	      {
		Lisp_Object pair = XVECTOR (obj)->contents [i];
		if (XVECTOR (pair)->size != 2)
		  Fsignal (Qerror,
			   Fcons (build_string 
       ("elements of the vector must be vectors of exactly two elements"),
				  Fcons (pair, Qnil)));
		
		(*(Atom **) data_ret) [i * 2]
		  = symbol_to_x_atom (dpyinfo, display,
				      XVECTOR (pair)->contents [0]);
		(*(Atom **) data_ret) [(i * 2) + 1]
		  = symbol_to_x_atom (dpyinfo, display,

	    else
	      Fsignal (Qerror,
		       Fcons (build_string
		   ("all elements of the vector must be of the same type"),
			      Fcons (obj, Qnil)));
	  
	}
#endif
      else
	/* This vector is an INTEGER set, or something like it */
	{

{
  check_x ();
  CHECK_SYMBOL (selection);
  if (EQ (selection, Qnil)) selection = QPRIMARY;
  if (EQ (selection, Qt)) selection = QSECONDARY;
  
  if (NILP (Fassq (selection, Vselection_alist)))
    return Qnil;
  return Qt;
}

  x_get_window_property (display, window, buffer_atom, &data, &bytes,
			 &type, &format, &size, 0);
  if (!data || !format)
    return Qnil;
  
  if (format != 8 || type != XA_STRING)
    Fsignal (Qerror,
	     Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
		    Fcons (x_atom_to_symbol (display, type),
			   Fcons (make_number (format), Qnil))));

45672:1f957476e757

static Lisp_Object Vnext_selection_coding_system;

/* If this is a smaller number than the max-request-size of the display,
   emacs will use INCR selection transfer when the selection is larger
   than this.  The max-request-size is usually around 64k, so if you want
   emacs to use incremental selection transfers when the selection is
   smaller than that, set this.  I added this mostly for debugging the
   incremental transfer stuff, but it might improve server performance.  */
#define MAX_SELECTION_QUANTUM 0xFFFFFF

#ifdef HAVE_X11R4

    selection-values.  */
static Lisp_Object Vselection_alist;

/* This is an alist whose CARs are selection-types (whose names are the same
   as the names of X Atoms) and whose CDRs are the names of Lisp functions to
   call to convert the given Emacs selection value to a string representing
   the given selection type.  This is for Lisp-level extension of the emacs
   selection handling.  */
static Lisp_Object Vselection_converter_alist;

/* If the selection owner takes too long to reply to a selection request,

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 ();

/* This converts a Lisp symbol to a server Atom, avoiding a server
   roundtrip whenever possible.  */

static Atom
symbol_to_x_atom (dpyinfo, display, sym)
     struct x_display_info *dpyinfo;

     Atom atom;
{
  struct x_display_info *dpyinfo;
  char *str;
  Lisp_Object val;

  if (! atom)
    return Qnil;

  switch (atom)
    {
    case XA_PRIMARY:
      return QPRIMARY;
    case XA_SECONDARY:

  UNBLOCK_INPUT;
  return val;
}

/* Do protocol to assert ourself as a selection owner.
   Update the Vselection_alist so that we can reply to later requests for
   our selection.  */

static void
x_own_selection (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;

  check = value;
  if (CONSP (value)
      && SYMBOLP (XCAR (value)))
    type = XCAR (value),
    check = XCDR (value);

  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
      || INTEGERP (check)
      || NILP (value))

x_decline_selection_request (event)
     struct input_event *event;
{
  XSelectionEvent reply;
  int count;

  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);

				 frame);
	}

      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
	error ("Attempt to transfer an INCR to ourself!");

      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);

	      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);
      XFlush (display);

				      PropertyDelete);

	  TRACE1 ("Sending increment of %d bytes", i);
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));

	  /* Append the next chunk of data to the property.  */
	  XChangeProperty (display, window, reply.property, type, format,
			   PropModeAppend, data, i / format_bytes);
	  bytes_remaining -= i;
	  data += i;

	     property.	 This can run random lisp code or signal.  */
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_property_change (wait_object);
	}

      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
      BLOCK_INPUT;
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

#if 0 /* #### MULTIPLE doesn't work yet */
  if (EQ (target_symbol, QMULTIPLE))
    target_symbol = fetch_multiple_target (event);
#endif

  /* Convert lisp objects back into binary data */

  converted_selection
    = x_get_local_selection (selection_symbol, target_symbol);

  if (! NILP (converted_selection))
    {
      unsigned char *data;
      unsigned int size;
      int format;

      int nofree;

      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
				   &data, &type, &size, &format, &nofree);

      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

      /* Indicate we have successfully processed this event.  */
      x_selection_current_request = 0;

     struct input_event *event;
{
  Display *display = SELECTION_EVENT_DISPLAY (event);
  Atom selection = SELECTION_EVENT_SELECTION (event);
  Time changed_owner_time = SELECTION_EVENT_TIME (event);

  Lisp_Object selection_symbol, local_selection_data;
  Time local_selection_time;
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
  struct x_display_info *t_dpyinfo;

	  else
	    property_change_wait_list = rest->next;
	  xfree (rest);
	  return;
	}

      prev = rest;
      rest = rest->next;
    }
}

  Lisp_Object vec;
  int i;
  int size;
  if (CONSP (obj))
    return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));

  CHECK_VECTOR (obj);
  vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
  for (i = 0; i < size; i++)
    {
      Lisp_Object vec2 = XVECTOR (obj)->contents [i];

    type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
  else
    type_atom = symbol_to_x_atom (dpyinfo, display, target_type);

  BLOCK_INPUT;

  count = x_catch_errors (display);

  TRACE2 ("Get selection %s, type %s",
	  XGetAtomName (display, type_atom),
	  XGetAtomName (display, target_property));

  XConvertSelection (display, selection_atom, type_atom, target_property,

  unsigned long bytes_remaining;
  int offset = 0;
  unsigned char *tmp_data = 0;
  int result;
  int buffer_size = SELECTION_QUANTUM (display);

  if (buffer_size > MAX_SELECTION_QUANTUM)
    buffer_size = MAX_SELECTION_QUANTUM;

  BLOCK_INPUT;

  /* First probe the thing to find out how big it is.  */
  result = XGetWindowProperty (display, window, property,
			       0L, 0L, False, AnyPropertyType,
			       actual_type_ret, actual_format_ret,
			       actual_size_ret,

      UNBLOCK_INPUT;
      *data_ret = 0;
      *bytes_ret = 0;
      return;
    }

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

  if (*actual_type_ret == None || *actual_format_ret == 0)
    {
      UNBLOCK_INPUT;
      return;
    }

  total_size = bytes_remaining + 1;
  *data_ret = (unsigned char *) xmalloc (total_size);

  /* Now read, until we've gotten it all.  */
  while (bytes_remaining)
    {
#ifdef TRACE_SELECTION
      int last = bytes_remaining;

      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);
    }

  XFlush (display);

      unsigned char *tmp_data;
      int tmp_size_bytes;

      TRACE0 ("  Wait for property change");
      wait_for_property_change (wait_object);

      /* expect it again immediately, because x_get_window_property may
	 .. no it won't, I don't get it.
	 .. Ok, I get it now, the Xt code that implements INCR is broken. */
      TRACE0 ("  Get property value");
      x_get_window_property (display, window, property,

      if (*size_bytes_ret < offset + tmp_size_bytes)
	{
	  *size_bytes_ret = offset + tmp_size_bytes;
	  *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
	}

      bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
      offset += tmp_size_bytes;

      /* Use xfree, not XFree, because x_get_window_property
	 calls xmalloc itself.  */
      xfree (tmp_data);
    }
}

	       : Fcons (build_string ("no selection"),
			Fcons (x_atom_to_symbol (display,
						 selection_atom),
			       Qnil)));
    }

  if (actual_type == dpyinfo->Xatom_INCR)
    {
      /* That wasn't really the data, just the beginning.  */

      unsigned int min_size_bytes = * ((unsigned int *) data);

  /* It's been read.  Now convert it to a lisp object in some semi-rational
     manner.  */
  val = selection_data_to_lisp_data (display, data, bytes,
				     actual_type, actual_format);

  /* Use xfree, not XFree, because x_get_window_property
     calls xmalloc itself.  */
  xfree ((char *) data);
  return val;
}

	  Lisp_Object unibyte_string;

	  unibyte_string = string_make_unibyte (obj);
	  *data_ret = XSTRING (unibyte_string)->data;
	  *nofree_ret = 1;
	  *size_ret = SBYTES (unibyte_string);
	}
      else
	{
	  *data_ret = x_encode_text (obj, Vnext_selection_coding_system, 1,
				     (int *) size_ret, &stringp);

	    if (VECTORP (XVECTOR (obj)->contents [i]))
	      {
		Lisp_Object pair = XVECTOR (obj)->contents [i];
		if (XVECTOR (pair)->size != 2)
		  Fsignal (Qerror,
			   Fcons (build_string
       ("elements of the vector must be vectors of exactly two elements"),
				  Fcons (pair, Qnil)));

		(*(Atom **) data_ret) [i * 2]
		  = symbol_to_x_atom (dpyinfo, display,
				      XVECTOR (pair)->contents [0]);
		(*(Atom **) data_ret) [(i * 2) + 1]
		  = symbol_to_x_atom (dpyinfo, display,

	    else
	      Fsignal (Qerror,
		       Fcons (build_string
		   ("all elements of the vector must be of the same type"),
			      Fcons (obj, Qnil)));

	}
#endif
      else
	/* This vector is an INTEGER set, or something like it */
	{

{
  check_x ();
  CHECK_SYMBOL (selection);
  if (EQ (selection, Qnil)) selection = QPRIMARY;
  if (EQ (selection, Qt)) selection = QSECONDARY;

  if (NILP (Fassq (selection, Vselection_alist)))
    return Qnil;
  return Qt;
}

  x_get_window_property (display, window, buffer_atom, &data, &bytes,
			 &type, &format, &size, 0);
  if (!data || !format)
    return Qnil;

  if (format != 8 || type != XA_STRING)
    Fsignal (Qerror,
	     Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
		    Fcons (x_atom_to_symbol (display, type),
			   Fcons (make_number (format), Qnil))));