xselect.c

/* X Selection processing for Emacs.
   Copyright (C) 1993-1997, 2000-2012 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


/* Rewritten by jwz */

#include <config.h>
#include <limits.h>
#include <stdio.h>      /* termhooks.h needs this */
#include <setjmp.h>

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif

#include <unistd.h>

#include "lisp.h"
#include "xterm.h"	/* for all of the X includes */
#include "dispextern.h"	/* frame.h seems to want this */
#include "frame.h"	/* Need this to get the X window of selected_frame */
#include "blockinput.h"
#include "buffer.h"
#include "process.h"
#include "termhooks.h"
#include "keyboard.h"
#include "character.h"

#include <X11/Xproto.h>

struct prop_location;
struct selection_data;

static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
					  struct x_display_info *);
static void x_decline_selection_request (struct input_event *);
static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
static Lisp_Object x_catch_errors_unwind (Lisp_Object);
static void x_reply_selection_request (struct input_event *, struct x_display_info *);
static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
				Atom, int, struct x_display_info *);
static int waiting_for_other_props_on_window (Display *, Window);
static struct prop_location *expect_property_change (Display *, Window,
                                                     Atom, int);
static void unexpect_property_change (struct prop_location *);
static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
static void wait_for_property_change (struct prop_location *);
static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
					    Lisp_Object, Lisp_Object);
static Lisp_Object x_get_window_property_as_lisp_data (Display *,
                                                       Window, Atom,
                                                       Lisp_Object, Atom);
static Lisp_Object selection_data_to_lisp_data (Display *,
						const unsigned char *,
						ptrdiff_t, Atom, int);
static void lisp_data_to_selection_data (Display *, Lisp_Object,
                                         unsigned char **, Atom *,
					 ptrdiff_t *, int *, int *);
static Lisp_Object clean_local_selection_data (Lisp_Object);

/* Printing traces to stderr.  */

#ifdef TRACE_SELECTION
#define TRACE0(fmt) \
  fprintf (stderr, "%d: " fmt "\n", getpid ())
#define TRACE1(fmt, a0) \
  fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
#define TRACE2(fmt, a0, a1) \
  fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
#define TRACE3(fmt, a0, a1, a2) \
  fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
#else
#define TRACE0(fmt)		(void) 0
#define TRACE1(fmt, a0)		(void) 0
#define TRACE2(fmt, a0, a1)	(void) 0
#endif


static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;

static Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */
static Lisp_Object QUTF8_STRING;	/* This is a type of selection.  */

static Lisp_Object Qcompound_text_with_extensions;

static Lisp_Object Qforeign_selection;
static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions;

/* Bytes needed to represent 'long' data.  This is as per libX11; it
   is not necessarily sizeof (long).  */
#define X_LONG_SIZE 4

/* Extreme 'short' and 'long' values suitable for libX11.  */
#define X_SHRT_MAX 0x7fff
#define X_SHRT_MIN (-1 - X_SHRT_MAX)
#define X_LONG_MAX 0x7fffffff
#define X_LONG_MIN (-1 - X_LONG_MAX)
#define X_ULONG_MAX 0xffffffffUL

/* 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.

   This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
   because it is multiplied by X_LONG_SIZE and by sizeof (long) in
   subscript calculations.  Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
   - 1 in place of INT_MAX.  */
#define MAX_SELECTION_QUANTUM						\
  ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1)	\
			 / max (X_LONG_SIZE, sizeof (long)))))

static int
selection_quantum (Display *display)
{
  long mrs = XMaxRequestSize (display);
  return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25
	  ? (mrs - 25) * X_LONG_SIZE
	  : MAX_SELECTION_QUANTUM);
}

#define LOCAL_SELECTION(selection_symbol,dpyinfo)			\
  assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)

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

struct selection_event_queue
  {
    struct input_event event;
    struct selection_event_queue *next;
  };

static struct selection_event_queue *selection_queue;

/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */

static int x_queue_selection_requests;

/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */

static void
x_queue_event (struct input_event *event)
{
  struct selection_event_queue *queue_tmp;

  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
      if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
	{
	  TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
	  x_decline_selection_request (event);
	  return;
	}
    }

  queue_tmp
    = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));

  if (queue_tmp != NULL)
    {
      TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
      queue_tmp->event = *event;
      queue_tmp->next = selection_queue;
      selection_queue = queue_tmp;
    }
}

/* Start queuing SELECTION_REQUEST_EVENT events.  */

static void
x_start_queuing_selection_requests (void)
{
  if (x_queue_selection_requests)
    abort ();

  x_queue_selection_requests++;
  TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
}

/* Stop queuing SELECTION_REQUEST_EVENT events.  */

static void
x_stop_queuing_selection_requests (void)
{
  TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
  --x_queue_selection_requests;

  /* Take all the queued events and put them back
     so that they get processed afresh.  */

  while (selection_queue != NULL)
    {
      struct selection_event_queue *queue_tmp = selection_queue;
      TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
      xfree ((char *)queue_tmp);
    }
}


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

static Atom
symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
{
  Atom val;
  if (NILP (sym))	    return 0;
  if (EQ (sym, QPRIMARY))   return XA_PRIMARY;
  if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
  if (EQ (sym, QSTRING))    return XA_STRING;
  if (EQ (sym, QINTEGER))   return XA_INTEGER;
  if (EQ (sym, QATOM))	    return XA_ATOM;
  if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
  if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
  if (EQ (sym, QTEXT))	    return dpyinfo->Xatom_TEXT;
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
  if (EQ (sym, QDELETE))    return dpyinfo->Xatom_DELETE;
  if (EQ (sym, QMULTIPLE))  return dpyinfo->Xatom_MULTIPLE;
  if (EQ (sym, QINCR))	    return dpyinfo->Xatom_INCR;
  if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
  if (EQ (sym, QTARGETS))   return dpyinfo->Xatom_TARGETS;
  if (EQ (sym, QNULL))	    return dpyinfo->Xatom_NULL;
  if (!SYMBOLP (sym)) abort ();

  TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
  BLOCK_INPUT;
  val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
  UNBLOCK_INPUT;
  return val;
}


/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
   and calls to intern whenever possible.  */

static Lisp_Object
x_atom_to_symbol (Display *dpy, 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:
      return QSECONDARY;
    case XA_STRING:
      return QSTRING;
    case XA_INTEGER:
      return QINTEGER;
    case XA_ATOM:
      return QATOM;
    }

  dpyinfo = x_display_info_for_display (dpy);
  if (dpyinfo == NULL)
    return Qnil;
  if (atom == dpyinfo->Xatom_CLIPBOARD)
    return QCLIPBOARD;
  if (atom == dpyinfo->Xatom_TIMESTAMP)
    return QTIMESTAMP;
  if (atom == dpyinfo->Xatom_TEXT)
    return QTEXT;
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
  if (atom == dpyinfo->Xatom_UTF8_STRING)
    return QUTF8_STRING;
  if (atom == dpyinfo->Xatom_DELETE)
    return QDELETE;
  if (atom == dpyinfo->Xatom_MULTIPLE)
    return QMULTIPLE;
  if (atom == dpyinfo->Xatom_INCR)
    return QINCR;
  if (atom == dpyinfo->Xatom_EMACS_TMP)
    return QEMACS_TMP;
  if (atom == dpyinfo->Xatom_TARGETS)
    return QTARGETS;
  if (atom == dpyinfo->Xatom_NULL)
    return QNULL;

  BLOCK_INPUT;
  str = XGetAtomName (dpy, atom);
  UNBLOCK_INPUT;
  TRACE1 ("XGetAtomName --> %s", str);
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
  /* This was allocated by Xlib, so use XFree.  */
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}

/* Do protocol to assert ourself as a selection owner.
   FRAME shall be the owner; it must be a valid X frame.
   Update the Vselection_alist so that we can reply to later requests for
   our selection.  */

static void
x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
		 Lisp_Object frame)
{
  struct frame *f = XFRAME (frame);
  Window selecting_window = FRAME_X_WINDOW (f);
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
  Display *display = dpyinfo->display;
  Time timestamp = last_event_timestamp;
  Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);

  BLOCK_INPUT;
  x_catch_errors (display);
  XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
  x_check_errors (display, "Can't set selection: %s");
  x_uncatch_errors ();
  UNBLOCK_INPUT;

  /* Now update the local cache */
  {
    Lisp_Object selection_data;
    Lisp_Object prev_value;

    selection_data = list4 (selection_name, selection_value,
			    INTEGER_TO_CONS (timestamp), frame);
    prev_value = LOCAL_SELECTION (selection_name, dpyinfo);

    dpyinfo->terminal->Vselection_alist
      = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);

    /* If we already owned the selection, remove the old selection
       data.  Don't use Fdelq as that may QUIT.  */
    if (!NILP (prev_value))
      {
	/* We know it's not the CAR, so it's easy.  */
	Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
	for (; CONSP (rest); rest = XCDR (rest))
	  if (EQ (prev_value, Fcar (XCDR (rest))))
	    {
	      XSETCDR (rest, XCDR (XCDR (rest)));
	      break;
	    }
      }
  }
}

/* Given a selection-name and desired type, look up our local copy of
   the selection value and convert it to the type.
   Return nil, a string, a vector, a symbol, an integer, or a cons
   that CONS_TO_INTEGER could plausibly handle.
   This function is used both for remote requests (LOCAL_REQUEST is zero)
   and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).

   This calls random Lisp code, and may signal or gc.  */

static Lisp_Object
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
		       int local_request, struct x_display_info *dpyinfo)
{
  Lisp_Object local_value;
  Lisp_Object handler_fn, value, check;
  int count;

  local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);

  if (NILP (local_value)) return Qnil;

  /* TIMESTAMP is a special case.  */
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
      value = XCAR (XCDR (XCDR (local_value)));
    }
  else
    {
      /* Don't allow a quit within the converter.
	 When the user types C-g, he would be surprised
	 if by luck it came during a converter.  */
      count = SPECPDL_INDEX ();
      specbind (Qinhibit_quit, Qt);

      CHECK_SYMBOL (target_type);
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

      if (!NILP (handler_fn))
	value = call3 (handler_fn,
		       selection_symbol, (local_request ? Qnil : target_type),
		       XCAR (XCDR (local_value)));
      else
	value = Qnil;
      unbind_to (count, Qnil);
    }

  /* Make sure this value is of a type that we could transmit
     to another X client.  */

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

  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
      || INTEGERP (check)
      || NILP (value))
    return value;
  /* Check for a value that CONS_TO_INTEGER could handle.  */
  else if (CONSP (check)
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
	       ||
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
    return value;

  signal_error ("Invalid data returned by selection-conversion function",
		list2 (handler_fn, value));
}

/* Subroutines of x_reply_selection_request.  */

/* Send a SelectionNotify event to the requestor with property=None,
   meaning we were unable to do what they wanted.  */

static void
x_decline_selection_request (struct input_event *event)
{
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);

  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);
  reply->target = SELECTION_EVENT_TARGET (event);
  reply->property = None;

  /* The reason for the error may be that the receiver has
     died in the meantime.  Handle that case.  */
  BLOCK_INPUT;
  x_catch_errors (reply->display);
  XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
  XFlush (reply->display);
  x_uncatch_errors ();
  UNBLOCK_INPUT;
}

/* This is the selection request currently being processed.
   It is set to zero when the request is fully processed.  */
static struct input_event *x_selection_current_request;

/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

/* Raw selection data, for sending to a requestor window.  */

struct selection_data
{
  unsigned char *data;
  ptrdiff_t size;
  int format;
  Atom type;
  int nofree;
  Atom property;
  /* This can be set to non-NULL during x_reply_selection_request, if
     the selection is waiting for an INCR transfer to complete.  Don't
     free these; that's done by unexpect_property_change.  */
  struct prop_location *wait_object;
  struct selection_data *next;
};

/* Linked list of the above (in support of MULTIPLE targets).  */

static struct selection_data *converted_selections;

/* "Data" to send a requestor for a failed MULTIPLE subtarget.  */
static Atom conversion_fail_tag;

/* Used as an unwind-protect clause so that, if a selection-converter signals
   an error, we tell the requestor that we were unable to do what they wanted
   before we throw to top-level or go into the debugger or whatever.  */

static Lisp_Object
x_selection_request_lisp_error (Lisp_Object ignore)
{
  struct selection_data *cs, *next;

  for (cs = converted_selections; cs; cs = next)
    {
      next = cs->next;
      if (cs->nofree == 0 && cs->data)
	xfree (cs->data);
      xfree (cs);
    }
  converted_selections = NULL;

  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
    x_decline_selection_request (x_selection_current_request);
  return Qnil;
}

static Lisp_Object
x_catch_errors_unwind (Lisp_Object dummy)
{
  BLOCK_INPUT;
  x_uncatch_errors ();
  UNBLOCK_INPUT;
  return Qnil;
}


/* 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.  */

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

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

static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state);
static void wait_for_property_change (struct prop_location *location);
static void unexpect_property_change (struct prop_location *location);
static int waiting_for_other_props_on_window (Display *display, Window window);

static int prop_location_identifier;

static Lisp_Object property_change_reply;

static struct prop_location *property_change_reply_object;

static struct prop_location *property_change_wait_list;

static Lisp_Object
queue_selection_requests_unwind (Lisp_Object tem)
{
  x_stop_queuing_selection_requests ();
  return Qnil;
}


/* Send the reply to a selection request event EVENT.  */

#ifdef TRACE_SELECTION
static int x_reply_selection_request_cnt;
#endif  /* TRACE_SELECTION */

static void
x_reply_selection_request (struct input_event *event,
                           struct x_display_info *dpyinfo)
{
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
  Display *display = SELECTION_EVENT_DISPLAY (event);
  Window window = SELECTION_EVENT_REQUESTOR (event);
  ptrdiff_t bytes_remaining;
  int max_bytes = selection_quantum (display);
  int count = SPECPDL_INDEX ();
  struct selection_data *cs;

  reply->type = SelectionNotify;
  reply->display = display;
  reply->requestor = window;
  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;

  BLOCK_INPUT;
  /* The protected block contains wait_for_property_change, which can
     run random lisp code (process handlers) or signal.  Therefore, we
     put the x_uncatch_errors call in an unwind.  */
  record_unwind_protect (x_catch_errors_unwind, Qnil);
  x_catch_errors (display);

  /* Loop over converted selections, storing them in the requested
     properties.  If data is large, only store the first N bytes
     (section 2.7.2 of ICCCM).  Note that we store the data for a
     MULTIPLE request in the opposite order; the ICCM says only that
     the conversion itself must be done in the same order. */
  for (cs = converted_selections; cs; cs = cs->next)
    {
      if (cs->property == None)
	continue;

      bytes_remaining = cs->size;
      bytes_remaining *= cs->format >> 3;
      if (bytes_remaining <= max_bytes)
	{
	  /* Send all the data at once, with minimal handshaking.  */
	  TRACE1 ("Sending all %"pD"d bytes", bytes_remaining);
	  XChangeProperty (display, window, cs->property,
			   cs->type, cs->format, PropModeReplace,
			   cs->data, cs->size);
	}
      else
	{
	  /* Send an INCR tag to initiate incremental transfer.  */
	  long value[1];

	  TRACE2 ("Start sending %"pD"d bytes incrementally (%s)",
		  bytes_remaining, XGetAtomName (display, cs->property));
	  cs->wait_object
	    = expect_property_change (display, window, cs->property,
				      PropertyDelete);

	  /* XChangeProperty expects an array of long even if long is
	     more than 32 bits.  */
	  value[0] = min (bytes_remaining, X_LONG_MAX);
	  XChangeProperty (display, window, cs->property,
			   dpyinfo->Xatom_INCR, 32, PropModeReplace,
			   (unsigned char *) value, 1);
	  XSelectInput (display, window, PropertyChangeMask);
	}
    }

  /* Now issue the SelectionNotify event.  */
  XSendEvent (display, window, False, 0L, &reply_base);
  XFlush (display);

#ifdef TRACE_SELECTION
  {
    char *sel = XGetAtomName (display, reply->selection);
    char *tgt = XGetAtomName (display, reply->target);
    TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
	    sel, tgt, ++x_reply_selection_request_cnt);
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

  /* Finish sending the rest of each of the INCR values.  This should
     be improved; there's a chance of deadlock if more than one
     subtarget in a MULTIPLE selection requires an INCR transfer, and
     the requestor and Emacs loop waiting on different transfers.  */
  for (cs = converted_selections; cs; cs = cs->next)
    if (cs->wait_object)
      {
	int format_bytes = cs->format / 8;
	int had_errors = x_had_errors_p (display);
	UNBLOCK_INPUT;

	bytes_remaining = cs->size;
	bytes_remaining *= format_bytes;

	/* Wait for the requestor to ack by deleting the property.
	   This can run Lisp code (process handlers) or signal.  */
	if (! had_errors)
	  {
	    TRACE1 ("Waiting for ACK (deletion of %s)",
		    XGetAtomName (display, cs->property));
	    wait_for_property_change (cs->wait_object);
	  }
	else
	  unexpect_property_change (cs->wait_object);

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

	    cs->wait_object
	      = expect_property_change (display, window, cs->property,
					PropertyDelete);

	    TRACE1 ("Sending increment of %d elements", i);
	    TRACE1 ("Set %s to increment data",
		    XGetAtomName (display, cs->property));

	    /* Append the next chunk of data to the property.  */
	    XChangeProperty (display, window, cs->property,
			     cs->type, cs->format, PropModeAppend,
			     cs->data, i);
	    bytes_remaining -= i * format_bytes;
	    cs->data += i * ((cs->format == 32) ? sizeof (long)
			     : format_bytes);
	    XFlush (display);
	    had_errors = x_had_errors_p (display);
	    UNBLOCK_INPUT;

	    if (had_errors) break;

	    /* Wait for the requestor to ack this chunk by deleting
	       the property.  This can run Lisp code or signal.  */
	    TRACE1 ("Waiting for increment ACK (deletion of %s)",
		    XGetAtomName (display, cs->property));
	    wait_for_property_change (cs->wait_object);
	  }

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

	TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
		XGetAtomName (display, cs->property));
	XChangeProperty (display, window, cs->property,
			 cs->type, cs->format, PropModeReplace,
			 cs->data, 0);
	TRACE0 ("Done sending incrementally");
      }

  /* rms, 2003-01-03: I think I have fixed this bug.  */
  /* The window we're communicating with may have been deleted
     in the meantime (that's a real situation from a bug report).
     In this case, there may be events in the event queue still
     referring to the deleted window, and we'll get a BadWindow error
     in XTread_socket when processing the events.  I don't have
     an idea how to fix that.  gerd, 2001-01-98.   */
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
  UNBLOCK_INPUT;

  /* GTK queues events in addition to the queue in Xlib.  So we
     UNBLOCK to enter the event loop and get possible errors delivered,
     and then BLOCK again because x_uncatch_errors requires it.  */
  BLOCK_INPUT;
  /* This calls x_uncatch_errors.  */
  unbind_to (count, Qnil);
  UNBLOCK_INPUT;
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

static void
x_handle_selection_request (struct input_event *event)
{
  struct gcpro gcpro1, gcpro2;
  Time local_selection_time;

  Display *display = SELECTION_EVENT_DISPLAY (event);
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
  Atom selection = SELECTION_EVENT_SELECTION (event);
  Lisp_Object selection_symbol = x_atom_to_symbol (display, selection);
  Atom target = SELECTION_EVENT_TARGET (event);
  Lisp_Object target_symbol = x_atom_to_symbol (display, target);
  Atom property = SELECTION_EVENT_PROPERTY (event);
  Lisp_Object local_selection_data;
  int success = 0;
  int count = SPECPDL_INDEX ();
  GCPRO2 (local_selection_data, target_symbol);

  if (!dpyinfo) goto DONE;

  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);

  /* Decline if we don't own any selections.  */
  if (NILP (local_selection_data)) goto DONE;

  /* Decline requests issued prior to our acquiring the selection.  */
  CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
		   Time, local_selection_time);
  if (SELECTION_EVENT_TIME (event) != CurrentTime
      && local_selection_time > SELECTION_EVENT_TIME (event))
    goto DONE;

  x_selection_current_request = event;
  selection_request_dpyinfo = dpyinfo;
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

  /* We might be able to handle nested x_handle_selection_requests,
     but this is difficult to test, and seems unimportant.  */
  x_start_queuing_selection_requests ();
  record_unwind_protect (queue_selection_requests_unwind, Qnil);

  TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
	  SDATA (SYMBOL_NAME (selection_symbol)),
	  SDATA (SYMBOL_NAME (target_symbol)));

  if (EQ (target_symbol, QMULTIPLE))
    {
      /* For MULTIPLE targets, the event property names a list of atom
	 pairs; the first atom names a target and the second names a
	 non-None property.  */
      Window requestor = SELECTION_EVENT_REQUESTOR (event);
      Lisp_Object multprop;
      ptrdiff_t j, nselections;

      if (property == None) goto DONE;
      multprop
	= x_get_window_property_as_lisp_data (display, requestor, property,
					      QMULTIPLE, selection);

      if (!VECTORP (multprop) || ASIZE (multprop) % 2)
	goto DONE;

      nselections = ASIZE (multprop) / 2;
      /* Perform conversions.  This can signal.  */
      for (j = 0; j < nselections; j++)
	{
	  Lisp_Object subtarget = AREF (multprop, 2*j);
	  Atom subproperty = symbol_to_x_atom (dpyinfo,
					       AREF (multprop, 2*j+1));

	  if (subproperty != None)
	    x_convert_selection (event, selection_symbol, subtarget,
				 subproperty, 1, dpyinfo);
	}
      success = 1;
    }
  else
    {
      if (property == None)
	property = SELECTION_EVENT_TARGET (event);
      success = x_convert_selection (event, selection_symbol,
				     target_symbol, property,
				     0, dpyinfo);
    }

 DONE:

  if (success)
    x_reply_selection_request (event, dpyinfo);
  else
    x_decline_selection_request (event);
  x_selection_current_request = 0;

  /* Run the `x-sent-selection-functions' abnormal hook.  */
  if (!NILP (Vx_sent_selection_functions)
      && !EQ (Vx_sent_selection_functions, Qunbound))
    {
      Lisp_Object args[4];
      args[0] = Qx_sent_selection_functions;
      args[1] = selection_symbol;
      args[2] = target_symbol;
      args[3] = success ? Qt : Qnil;
      Frun_hook_with_args (4, args);
    }

  unbind_to (count, Qnil);
  UNGCPRO;
}

/* Perform the requested selection conversion, and write the data to
   the converted_selections linked list, where it can be accessed by
   x_reply_selection_request.  If FOR_MULTIPLE is non-zero, write out
   the data even if conversion fails, using conversion_fail_tag.

   Return 0 if the selection failed to convert, 1 otherwise.  */

static int
x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
		     Lisp_Object target_symbol, Atom property,
		     int for_multiple, struct x_display_info *dpyinfo)
{
  struct gcpro gcpro1;
  Lisp_Object lisp_selection;
  struct selection_data *cs;
  GCPRO1 (lisp_selection);

  lisp_selection