comparison src/xselect.c @ 4373:02a515f35abc

(prop_location_identifier): Was named prop_location_tick. (property_change_reply_identifier): Renamed from ...-tick. (struct prop_location): Field `identifier' renamed from `tick'. Various functions changed accordingly. (x_handle_selection_request): Delete local struct var `reply'. (wait_for_property_change_unwind): New function. (wait_for_property_change): Add unwind protect. (wait_for_property_change): Eventually time out with error. (x_reply_selection_request): XFlushQueue and UNBLOCK_INPUT before calling wait_for_property_change. (x_get_window_property): Simplify input blocking/unblocking. Don't delete the property here. (receive_incremental_selection): Delete property here. Call XSelectInput to enable and disable PropertyChangeMask. (x_get_window_property_as_lisp_data): And here.

4372:189b84c7dbc5

  if (reply.property == None)
    reply.property = reply.target;

  /* #### XChangeProperty can generate BadAlloc, and we must handle it! */

  BLOCK_INPUT;
  /* Store the data on the requested property.
     If the selection is large, only store the first N bytes of it.
   */
  bytes_remaining = size * format_bytes;
  if (bytes_remaining <= max_bytes)
    {
      /* Send all the data at once, with minimal handshaking.  */
#if 0
      fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
#endif
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, size);
      /* At this point, the selection was successfully stored; ack it.  */
      (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
    }
  else
    {
      /* Send an INCR selection.  */
      int prop_id;

      if (x_window_to_frame (window)) /* #### debug */
	error ("attempt to transfer an INCR to ourself!");
#if 0
      fprintf (stderr, "\nINCR %d\n", bytes_remaining);

		       32, PropModeReplace, (unsigned char *)
		       &bytes_remaining, 1);
      XSelectInput (display, window, PropertyChangeMask);
      /* Tell 'em the INCR data is there...  */
      (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);

      /* First, wait for the requestor to ack by deleting the property.
	 This can run random lisp code (process handlers) or signal.  */
      wait_for_property_change (prop_id);

      while (bytes_remaining)
	{
	  int i = ((bytes_remaining < max_bytes)
		   ? bytes_remaining
		   : max_bytes);
	  prop_id = expect_property_change (display, window, reply.property,
					    PropertyDelete);
#if 0
	  fprintf (stderr,"  INCR adding %d\n", i);
#endif
	  /* 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;

	  /* Now wait for the requestor to ack this chunk by deleting the
	     property.	 This can run random lisp code or signal.
	   */
	  wait_for_property_change (prop_id);

      /* Now write a zero-length chunk to the property to tell the requestor
	 that we're done.  */
#if 0
      fprintf (stderr,"  INCR done\n");
#endif
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
    }
  XFlushQueue ();
  UNBLOCK_INPUT;
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

void
x_handle_selection_request (event)
     struct input_event *event;
{
  struct gcpro gcpro1, gcpro2, gcpro3;
  XSelectionEvent reply;
  Lisp_Object local_selection_data = Qnil;
  Lisp_Object selection_symbol;
  Lisp_Object target_symbol = Qnil;
  Lisp_Object converted_selection = Qnil;
  Time local_selection_time;
  Lisp_Object successful_p = Qnil;
  int count;

  GCPRO3 (local_selection_data, converted_selection, target_symbol);

  reply.type = SelectionNotify;		/* Construct the reply event */
  reply.display = SELECTION_EVENT_DISPLAY (event);
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = SELECTION_EVENT_PROPERTY (event);
  if (reply.property == None)
    reply.property = reply.target;

  selection_symbol = x_atom_to_symbol (reply.display,
				       SELECTION_EVENT_SELECTION (event));

  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
  
#if 0
# define CDR(x) (XCONS (x)->cdr)
# define CAR(x) (XCONS (x)->car)
  /* This list isn't user-visible, so it can't "go bad." */
  if (!CONSP (local_selection_data)) abort ();
  if (!CONSP (CDR (local_selection_data))) abort ();
  if (!CONSP (CDR (CDR (local_selection_data)))) abort ();
  if (!NILP (CDR (CDR (CDR (local_selection_data))))) abort ();
  if (!CONSP (CAR (CDR (CDR (local_selection_data))))) abort ();
  if (!INTEGERP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort ();
  if (!INTEGERP (CDR (CAR (CDR (CDR (local_selection_data)))))) abort ();
# undef CAR
# undef CDR
#endif

  if (NILP (local_selection_data))
    {
      /* Someone asked for the selection, but we don't have it any more.
       */

  count = specpdl_ptr - specpdl;
  x_selection_current_request = event;
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

  target_symbol = x_atom_to_symbol (reply.display,
				    SELECTION_EVENT_TARGET (event));

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

      unsigned int size;
      int format;
      Atom type;
      int nofree;

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


/* This stuff is so that INCR selections are reentrant (that is, so we can
   be servicing multiple INCR selection requests simultaneously.)  I haven't
   actually tested that yet.  */

static int prop_location_tick;

static Lisp_Object property_change_reply;
static int property_change_reply_tick;

/* Keep a list of the property changes that are awaited.  */

struct prop_location
{
  int tick;
  Display *display;
  Window window;
  Atom property;
  int desired_state;
  struct prop_location *next;
};

static struct prop_location *property_change_wait_list;

static int
property_deleted_p (tick)
     void *tick;
{
  struct prop_location *rest = property_change_wait_list;
  while (rest)
    if (rest->tick == (int) tick)
      return 0;
    else
      rest = rest->next;
  return 1;
}

     Lisp_Object property;
     int state;
{
  struct prop_location *pl
    = (struct prop_location *) xmalloc (sizeof (struct prop_location));
  pl->tick = ++prop_location_tick;
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
  property_change_wait_list = pl;
  return pl->tick;
}

/* Delete an entry from the list of property changes we are waiting for.
   TICK is the number that uniquely identifies the entry.  */

static void
unexpect_property_change (tick)
     int tick;
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
      if (rest->tick == tick)
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;

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

/* Actually wait for a property change.
   TICK should be the value that expect_property_change returned.  */

static void
wait_for_property_change (tick)
{
  XCONS (property_change_reply)->car = Qnil;
  property_change_reply_tick = tick;
  wait_reading_process_input (0, 0, property_change_reply, 0);
}

/* Called from XTread_socket in response to a PropertyNotify event.  */

void

		   ->name->data);
#endif

	  /* If this is the one wait_for_property_change is waiting for,
	     tell it to wake up.  */
	  if (rest->tick == property_change_reply_tick)
	    XCONS (property_change_reply)->car = Qt;

	  if (prev)
	    prev->next = rest->next;
	  else

  result = XGetWindowProperty (display, window, property,
			       0, 0, False, AnyPropertyType,
			       actual_type_ret, actual_format_ret,
			       actual_size_ret,
			       &bytes_remaining, &tmp_data);
  UNBLOCK_INPUT;
  if (result != Success)
    {
      *data_ret = 0;
      *bytes_ret = 0;
      return;
    }
  BLOCK_INPUT;
  XFree ((char *) tmp_data);
  UNBLOCK_INPUT;
  
  if (*actual_type_ret == None || *actual_format_ret == 0)
    {
      if (delete_p) XDeleteProperty (display, window, property);
      return;
    }

  total_size = bytes_remaining + 1;
  *data_ret = (unsigned char *) xmalloc (total_size);
  
  /* Now read, until weve gotten it all.  */
  BLOCK_INPUT;
  while (bytes_remaining)
    {
#if 0
      int last = bytes_remaining;
#endif
      result
	= XGetWindowProperty (display, window, property,
			      offset/4, buffer_size/4,
			      (delete_p ? True : False),
			      AnyPropertyType,
			      actual_type_ret, actual_format_ret,
			      actual_size_ret, &bytes_remaining, &tmp_data);
#if 0
      fprintf (stderr, "<< read %d\n", 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;
      XFree ((char *) tmp_data);
    }
  UNBLOCK_INPUT;
  *bytes_ret = offset;
}

static void

  *size_bytes_ret = min_size_bytes;
  *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
#if 0
  fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
#endif
  /* At this point, we have read an INCR property, and deleted it (which
     is how we ack its receipt: the sending window will be selecting
     PropertyNotify events on our window to notice this.)

     Now, we must loop, waiting for the sending window to put a value on
     that property, then reading the property, then deleting it to ack.
     We are done when the sender places a property of length 0.
   */
  prop_id = expect_property_change (display, window, property,
				    PropertyNewValue);
  while (1)
    {
      unsigned char *tmp_data;
      int tmp_size_bytes;
      wait_for_property_change (prop_id);
      /* expect it again immediately, because x_get_window_property may
	 .. no it wont, I dont get it.
	 .. Ok, I get it now, the Xt code that implements INCR is broken.
       */
      prop_id = expect_property_change (display, window, property,
					PropertyNewValue);
      x_get_window_property (display, window, property,
			     &tmp_data, &tmp_size_bytes,
			     type_ret, format_ret, size_ret, 1);

      if (tmp_size_bytes == 0) /* we're done */
	{
#if 0
	  fprintf (stderr, "  read INCR done\n");
#endif
	  unexpect_property_change (prop_id);
	  if (tmp_data) xfree (tmp_data);
	  break;
	}
#if 0
      fprintf (stderr, "  read INCR %d\n", tmp_size_bytes);
#endif
      if (*size_bytes_ret < offset + tmp_size_bytes)
	{

      receive_incremental_selection (display, window, property, target_type,
				     min_size_bytes, &data, &bytes,
				     &actual_type, &actual_format,
				     &actual_size);
    }

  /* 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);

  staticpro (&reading_selection_reply);
  reading_selection_window = 0;
  reading_which_selection = 0;

  property_change_wait_list = 0;
  prop_location_tick = 0;
  property_change_reply = Fcons (Qnil, Qnil);
  staticpro (&property_change_reply);

  Vselection_alist = Qnil;
  staticpro (&Vselection_alist);

4373:02a515f35abc

  if (reply.property == None)
    reply.property = reply.target;

  /* #### XChangeProperty can generate BadAlloc, and we must handle it! */

  /* Store the data on the requested property.
     If the selection is large, only store the first N bytes of it.
   */
  bytes_remaining = size * format_bytes;
  if (bytes_remaining <= max_bytes)
    {
      /* Send all the data at once, with minimal handshaking.  */
#if 0
      fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
#endif
      BLOCK_INPUT;
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, size);
      /* At this point, the selection was successfully stored; ack it.  */
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
      XFlushQueue ();
      UNBLOCK_INPUT;
    }
  else
    {
      /* Send an INCR selection.  */
      int prop_id;

      BLOCK_INPUT;

      if (x_window_to_frame (window)) /* #### debug */
	error ("attempt to transfer an INCR to ourself!");
#if 0
      fprintf (stderr, "\nINCR %d\n", bytes_remaining);

		       32, PropModeReplace, (unsigned char *)
		       &bytes_remaining, 1);
      XSelectInput (display, window, PropertyChangeMask);
      /* Tell 'em the INCR data is there...  */
      (void) XSendEvent (display, window, False, 0L, (XEvent *) &reply);
      XFlushQueue ();
      UNBLOCK_INPUT;

      /* First, wait for the requestor to ack by deleting the property.
	 This can run random lisp code (process handlers) or signal.  */
      wait_for_property_change (prop_id);

      while (bytes_remaining)
	{
	  int i = ((bytes_remaining < max_bytes)
		   ? bytes_remaining
		   : max_bytes);

	  BLOCK_INPUT;

	  prop_id = expect_property_change (display, window, reply.property,
					    PropertyDelete);
#if 0
	  fprintf (stderr,"  INCR adding %d\n", i);
#endif
	  /* 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;
	  XFlushQueue ();
	  UNBLOCK_INPUT;

	  /* Now wait for the requestor to ack this chunk by deleting the
	     property.	 This can run random lisp code or signal.
	   */
	  wait_for_property_change (prop_id);

      /* Now write a zero-length chunk to the property to tell the requestor
	 that we're done.  */
#if 0
      fprintf (stderr,"  INCR done\n");
#endif
      BLOCK_INPUT;
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
      XFlushQueue ();
      UNBLOCK_INPUT;
    }
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

void
x_handle_selection_request (event)
     struct input_event *event;
{
  struct gcpro gcpro1, gcpro2, gcpro3;
  Lisp_Object local_selection_data = Qnil;
  Lisp_Object selection_symbol;
  Lisp_Object target_symbol = Qnil;
  Lisp_Object converted_selection = Qnil;
  Time local_selection_time;
  Lisp_Object successful_p = Qnil;
  int count;

  GCPRO3 (local_selection_data, converted_selection, target_symbol);

  selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
				       SELECTION_EVENT_SELECTION (event));

  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);

  if (NILP (local_selection_data))
    {
      /* Someone asked for the selection, but we don't have it any more.
       */

  count = specpdl_ptr - specpdl;
  x_selection_current_request = event;
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

  target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
				    SELECTION_EVENT_TARGET (event));

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

      unsigned int size;
      int format;
      Atom type;
      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;


/* This stuff is so that INCR selections are reentrant (that is, so we can
   be servicing multiple INCR selection requests simultaneously.)  I haven't
   actually tested that yet.  */

static int prop_location_identifier;

static Lisp_Object property_change_reply;
static int property_change_reply_identifier;

/* Keep a list of the property changes that are awaited.  */

struct prop_location
{
  int identifier;
  Display *display;
  Window window;
  Atom property;
  int desired_state;
  struct prop_location *next;
};

static struct prop_location *property_change_wait_list;

static int
property_deleted_p (identifier)
     void *identifier;
{
  struct prop_location *rest = property_change_wait_list;
  while (rest)
    if (rest->identifier == (int) identifier)
      return 0;
    else
      rest = rest->next;
  return 1;
}

     Lisp_Object property;
     int state;
{
  struct prop_location *pl
    = (struct prop_location *) xmalloc (sizeof (struct prop_location));
  pl->identifier = ++prop_location_identifier;
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
  property_change_wait_list = pl;
  return pl->identifier;
}

/* Delete an entry from the list of property changes we are waiting for.
   IDENTIFIER is the number that uniquely identifies the entry.  */

static void
unexpect_property_change (identifier)
     int identifier;
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
      if (rest->identifier == identifier)
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;

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

/* Remove the property change expectation element for IDENTIFIER.  */

static Lisp_Object
wait_for_property_change_unwind (identifierval)
     Lisp_Object identifierval;
{
  unexpect_property_change (XFASTINT (identifierval));
}

/* Actually wait for a property change.
   IDENTIFIER should be the value that expect_property_change returned.  */

static void
wait_for_property_change (identifier)
{
  int secs, usecs;
  int count = specpdl_ptr - specpdl;

  /* Make sure to do unexpect_property_change if we quit or err.  */
  record_unwind_protect (wait_for_property_change_unwind,
			 make_number (identifier));

  XCONS (property_change_reply)->car = Qnil;
  property_change_reply_identifier = identifier;
  secs = x_selection_timeout / 1000;
  usecs = (x_selection_timeout % 1000) * 1000;
  wait_reading_process_input (secs, usecs, property_change_reply, 0);

  if (NILP (XCONS (property_change_reply)->car))
    error ("timed out waiting for property-notify event");

  unbind_to (count, Qnil);
}

/* Called from XTread_socket in response to a PropertyNotify event.  */

void

		   ->name->data);
#endif

	  /* If this is the one wait_for_property_change is waiting for,
	     tell it to wake up.  */
	  if (rest->identifier == property_change_reply_identifier)
	    XCONS (property_change_reply)->car = Qt;

	  if (prev)
	    prev->next = rest->next;
	  else

  result = XGetWindowProperty (display, window, property,
			       0, 0, False, AnyPropertyType,
			       actual_type_ret, actual_format_ret,
			       actual_size_ret,
			       &bytes_remaining, &tmp_data);
  if (result != Success)
    {
      UNBLOCK_INPUT;
      *data_ret = 0;
      *bytes_ret = 0;
      return;
    }
  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 weve gotten it all.  */
  while (bytes_remaining)
    {
#if 0
      int last = bytes_remaining;
#endif
      result
	= XGetWindowProperty (display, window, property,
			      offset/4, buffer_size/4,
			      False,
			      AnyPropertyType,
			      actual_type_ret, actual_format_ret,
			      actual_size_ret, &bytes_remaining, &tmp_data);
#if 0
      fprintf (stderr, "<< read %d\n", 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;
      xfree ((char *) tmp_data);
    }

  XFlushQueue ();
  UNBLOCK_INPUT;
  *bytes_ret = offset;
}

static void

  *size_bytes_ret = min_size_bytes;
  *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
#if 0
  fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
#endif

  /* At this point, we have read an INCR property.
     Delete the property to ack it.
     (But first, prepare to receive the next event in this handshake.)

     Now, we must loop, waiting for the sending window to put a value on
     that property, then reading the property, then deleting it to ack.
     We are done when the sender places a property of length 0.
   */
  BLOCK_INPUT;
  XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
  XDeleteProperty (display, window, property);
  prop_id = expect_property_change (display, window, property,
				    PropertyNewValue);
  XFlushQueue ();
  UNBLOCK_INPUT;

  while (1)
    {
      unsigned char *tmp_data;
      int tmp_size_bytes;
      wait_for_property_change (prop_id);
      /* expect it again immediately, because x_get_window_property may
	 .. no it wont, I dont get it.
	 .. Ok, I get it now, the Xt code that implements INCR is broken.
       */
      x_get_window_property (display, window, property,
			     &tmp_data, &tmp_size_bytes,
			     type_ret, format_ret, size_ret, 1);

      if (tmp_size_bytes == 0) /* we're done */
	{
#if 0
	  fprintf (stderr, "  read INCR done\n");
#endif
	  if (! waiting_for_other_props_on_window (display, window))
	    XSelectInput (display, window, STANDARD_EVENT_SET);
	  unexpect_property_change (prop_id);
	  if (tmp_data) xfree (tmp_data);
	  break;
	}

      BLOCK_INPUT;
      XDeleteProperty (display, window, property);
      prop_id = expect_property_change (display, window, property,
					PropertyNewValue);
      XFlushQueue ();
      UNBLOCK_INPUT;

#if 0
      fprintf (stderr, "  read INCR %d\n", tmp_size_bytes);
#endif
      if (*size_bytes_ret < offset + tmp_size_bytes)
	{

      receive_incremental_selection (display, window, property, target_type,
				     min_size_bytes, &data, &bytes,
				     &actual_type, &actual_format,
				     &actual_size);
    }

  BLOCK_INPUT;
  XDeleteProperty (display, window, property);
  XFlushQueue ();
  UNBLOCK_INPUT;

  /* 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);

  staticpro (&reading_selection_reply);
  reading_selection_window = 0;
  reading_which_selection = 0;

  property_change_wait_list = 0;
  prop_location_identifier = 0;
  property_change_reply = Fcons (Qnil, Qnil);
  staticpro (&property_change_reply);

  Vselection_alist = Qnil;
  staticpro (&Vselection_alist);