xselect.c

/* X Selection processing for Emacs.
   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
   Free Software Foundation.

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 2, 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; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */


/* Rewritten by jwz */

#include <config.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"

struct prop_location;

static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
				  Lisp_Object));
static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
static void x_decline_selection_request P_ ((struct input_event *));
static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
static void x_reply_selection_request P_ ((struct input_event *, int,
					   unsigned char *, int, Atom));
static int waiting_for_other_props_on_window P_ ((Display *, Window));
static struct prop_location *expect_property_change P_ ((Display *, Window,
							 Atom, int));
static void unexpect_property_change P_ ((struct prop_location *));
static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
static void wait_for_property_change P_ ((struct prop_location *));
static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, Lisp_Object));
static void x_get_window_property P_ ((Display *, Window, Atom,
				       unsigned char **, int *,
				       Atom *, int *, unsigned long *, int));
static void receive_incremental_selection P_ ((Display *, Window, Atom,
					       Lisp_Object, unsigned,
					       unsigned char **, int *,
					       Atom *, int *, unsigned long *));
static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
							   Window, Atom,
							   Lisp_Object, Atom));
static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
						    int, Atom, int));
static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
					     unsigned char **, Atom *,
					     unsigned *, int *, int *));
static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
static void initialize_cut_buffers P_ ((Display *, Window));


/* 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)
#else
#define TRACE0(fmt)		(void) 0
#define TRACE1(fmt, a0)		(void) 0
#define TRACE2(fmt, a0, a1)	(void) 0
#endif


#define CUT_BUFFER_SUPPORT

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

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

Lisp_Object Qcompound_text_with_extensions;

#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#endif

static Lisp_Object Vx_lost_selection_hooks;
static Lisp_Object Vx_sent_selection_hooks;
/* Coding system for communicating with other X clients via cutbuffer,
   selection, and clipboard.  */
static Lisp_Object Vselection_coding_system;

/* Coding system for the next communicating with other X clients.  */
static Lisp_Object Vnext_selection_coding_system;

static Lisp_Object Qforeign_selection;

/* 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
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
#else
#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
#endif

/* The timestamp of the last input event Emacs received from the X server.  */
/* Defined in keyboard.c.  */
extern unsigned long last_event_timestamp;

/* This is an association list whose elements are of the form
     ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
   SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
   SELECTION-VALUE is the value that emacs owns for that selection.
     It may be any kind of Lisp object.
   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
     as a cons of two 16-bit numbers (making a 32 bit time.)
   FRAME is the frame for which we made the selection.
   If there is an entry in this alist, then it can be assumed that Emacs owns
    that selection.
   The only (eq) parts of this list that are visible from Lisp are the
    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,
   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 ();

/* 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;
     Display *display;
     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;
#ifdef CUT_BUFFER_SUPPORT
  if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
  if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
  if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
  if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
  if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
  if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
  if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
  if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
#endif
  if (!SYMBOLP (sym)) abort ();

  TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
  BLOCK_INPUT;
  val = XInternAtom (display, (char *) SDATA (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 (dpy, atom)
     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;
#ifdef CUT_BUFFER_SUPPORT
    case XA_CUT_BUFFER0:
      return QCUT_BUFFER0;
    case XA_CUT_BUFFER1:
      return QCUT_BUFFER1;
    case XA_CUT_BUFFER2:
      return QCUT_BUFFER2;
    case XA_CUT_BUFFER3:
      return QCUT_BUFFER3;
    case XA_CUT_BUFFER4:
      return QCUT_BUFFER4;
    case XA_CUT_BUFFER5:
      return QCUT_BUFFER5;
    case XA_CUT_BUFFER6:
      return QCUT_BUFFER6;
    case XA_CUT_BUFFER7:
      return QCUT_BUFFER7;
#endif
    }

  dpyinfo = x_display_info_for_display (dpy);
  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.
   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;
{
  struct frame *sf = SELECTED_FRAME ();
  Window selecting_window = FRAME_X_WINDOW (sf);
  Display *display = FRAME_X_DISPLAY (sf);
  Time time = last_event_timestamp;
  Atom selection_atom;
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
  int count;

  CHECK_SYMBOL (selection_name);
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);

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

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

    selection_time = long_to_cons ((unsigned long) time);
    selection_data = Fcons (selection_name,
			    Fcons (selection_value,
				   Fcons (selection_time,
					  Fcons (selected_frame, Qnil))));
    prev_value = assq_no_quit (selection_name, Vselection_alist);

    Vselection_alist = Fcons (selection_data, Vselection_alist);

    /* If we already owned the selection, remove the old selection data.
       Perhaps we should destructively modify it instead.
       Don't use Fdelq as that may QUIT.  */
    if (!NILP (prev_value))
      {
	Lisp_Object rest;	/* we know it's not the CAR, so it's easy.  */
	for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
	  if (EQ (prev_value, Fcar (XCDR (rest))))
	    {
	      XSETCDR (rest, Fcdr (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.
   The value is nil or a string.
   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 (selection_symbol, target_type, local_request)
     Lisp_Object selection_symbol, target_type;
     int local_request;
{
  Lisp_Object local_value;
  Lisp_Object handler_fn, value, type, check;
  int count;

  local_value = assq_no_quit (selection_symbol, Vselection_alist);

  if (NILP (local_value)) return Qnil;

  /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest.  */
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
      value = XCAR (XCDR (XCDR (local_value)));
    }
#if 0
  else if (EQ (target_type, QDELETE))
    {
      handler_fn = Qnil;
      Fx_disown_selection_internal
	(selection_symbol,
	 XCAR (XCDR (XCDR (local_value))));
      value = QNULL;
    }
#endif

#if 0 /* #### MULTIPLE doesn't work yet */
  else if (CONSP (target_type)
	   && XCAR (target_type) == QMULTIPLE)
    {
      Lisp_Object pairs;
      int size;
      int i;
      pairs = XCDR (target_type);
      size = XVECTOR (pairs)->size;
      /* If the target is MULTIPLE, then target_type looks like
	  (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
	 We modify the second element of each pair in the vector and
	 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
       */
      for (i = 0; i < size; i++)
	{
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
	  XVECTOR (pair)->contents [1]
	    = x_get_local_selection (XVECTOR (pair)->contents [0],
				     XVECTOR (pair)->contents [1],
				     local_request);
	}
      return pairs;
    }
#endif
  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)))
    type = 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_long 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;
  else
    return
      Fsignal (Qerror,
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* 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 (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);
  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;
  count = x_catch_errors (reply.display);
  XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
  XFlush (reply.display);
  x_uncatch_errors (reply.display, count);
  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;

/* Used as an unwind-protect clause so that, if a selection-converter signals
   an error, we tell the requester 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 (ignore)
     Lisp_Object ignore;
{
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
    x_decline_selection_request (x_selection_current_request);
  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 ();
static void wait_for_property_change ();
static void unexpect_property_change ();
static int waiting_for_other_props_on_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 (frame)
     Lisp_Object frame;
{
  FRAME_PTR f = XFRAME (frame);

  if (! NILP (frame))
    x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
  return Qnil;
}

/* Return some frame whose display info is DPYINFO.
   Return nil if there is none.  */

static Lisp_Object
some_frame_on_display (dpyinfo)
     struct x_display_info *dpyinfo;
{
  Lisp_Object list, frame;

  FOR_EACH_FRAME (list, frame)
    {
      if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
	return frame;
    }

  return Qnil;
}

/* Send the reply to a selection request event EVENT.
   TYPE is the type of selection data requested.
   DATA and SIZE describe the data to send, already converted.
   FORMAT is the unit-size (in bits) of the data to be transmitted.  */

static void
x_reply_selection_request (event, format, data, size, type)
     struct input_event *event;
     int format, size;
     unsigned char *data;
     Atom type;
{
  XSelectionEvent reply;
  Display *display = SELECTION_EVENT_DISPLAY (event);
  Window window = SELECTION_EVENT_REQUESTOR (event);
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
  int count;

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  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;

  /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
  BLOCK_INPUT;
  count = x_catch_errors (display);

  /* 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.  */
      TRACE1 ("Sending all %d bytes", bytes_remaining);
      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);
    }
  else
    {
      /* Send an INCR selection.  */
      struct prop_location *wait_object;
      int had_errors;
      Lisp_Object frame;

      frame = some_frame_on_display (dpyinfo);

      /* If the display no longer has frames, we can't expect
	 to get many more selection requests from it, so don't
	 bother trying to queue them.  */
      if (!NILP (frame))
	{
	  x_start_queuing_selection_requests (display);

	  record_unwind_protect (queue_selection_requests_unwind,
				 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);

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

      had_errors = x_had_errors_p (display);
      UNBLOCK_INPUT;

      /* First, wait for the requester to ack by deleting the property.
	 This can run random lisp code (process handlers) or signal.  */
      if (! had_errors)
	{
	  TRACE1 ("Waiting for ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_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,
				      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;
	  XFlush (display);
	  had_errors = x_had_errors_p (display);
	  UNBLOCK_INPUT;

	  if (had_errors)
	    break;

	  /* Now wait for the requester to ack this chunk by deleting the
	     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);

      TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
	      XGetAtomName (display, reply.property));
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, 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
     refering 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.   */
  XFlush (display);
  x_uncatch_errors (display, count);
  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;
  Lisp_Object selection_symbol;
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
  Time local_selection_time;
  Lisp_Object successful_p;
  int count;
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));

  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

  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.
       */
      x_decline_selection_request (event);
      goto DONE;
    }

  local_selection_time = (Time)
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));

  if (SELECTION_EVENT_TIME (event) != CurrentTime
      && local_selection_time > SELECTION_EVENT_TIME (event))
    {
      /* Someone asked for the selection, and we have one, but not the one
	 they're looking for.
       */
      x_decline_selection_request (event);
      goto DONE;
    }

  x_selection_current_request = event;
  count = SPECPDL_INDEX ();
  selection_request_dpyinfo = dpyinfo;
  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);
#endif

  /* Convert lisp objects back into binary data */

  converted_selection
    = x_get_local_selection (selection_symbol, target_symbol, 0);

  if (! NILP (converted_selection))
    {
      unsigned char *data;
      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;

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

      /* Use xfree, not XFree, because lisp_data_to_selection_data
	 calls xmalloc itself.  */
      if (!nofree)
	xfree (data);
    }
  unbind_to (count, Qnil);

 DONE:

  /* Let random lisp code notice that the selection has been asked for.  */
  {
    Lisp_Object rest;
    rest = Vx_sent_selection_hooks;
    if (!EQ (rest, Qunbound))
      for (; CONSP (rest); rest = Fcdr (rest))
	call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
  }

  UNGCPRO;
}

/* Handle a SelectionClear event EVENT, which indicates that some
   client cleared out our previously asserted selection.
   This is called from keyboard.c when such an event is found in the queue.  */

void
x_handle_selection_clear (event)
     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;

  /* If the new selection owner is also Emacs,
     don't clear the new selection.  */
  BLOCK_INPUT;
  /* Check each display on the same terminal,
     to see if this Emacs job now owns the selection
     through that display.  */
  for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
    if (t_dpyinfo->kboard == dpyinfo->kboard)
      {
	Window owner_window
	  = XGetSelectionOwner (t_dpyinfo->display, selection);
	if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
	  {
	    UNBLOCK_INPUT;
	    return;
	  }
      }
  UNBLOCK_INPUT;

  selection_symbol = x_atom_to_symbol (display, selection);

  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);

  /* Well, we already believe that we don't own it, so that's just fine.  */
  if (NILP (local_selection_data)) return;

  local_selection_time = (Time)
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));

  /* This SelectionClear is for a selection that we no longer own, so we can
     disregard it.  (That is, we have reasserted the selection since this
     request was generated.)  */

  if (changed_owner_time != CurrentTime
      && local_selection_time > changed_owner_time)
    return;

  /* Otherwise, we're really honest and truly being told to drop it.
     Don't use Fdelq as that may QUIT;.  */

  if (EQ (local_selection_data, Fcar (Vselection_alist)))
    Vselection_alist = Fcdr (Vselection_alist);
  else
    {
      Lisp_Object rest;
      for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
	if (EQ (local_selection_data, Fcar (XCDR (rest))))
	  {
	    XSETCDR (rest, Fcdr (XCDR (rest)));
	    break;
	  }
    }

  /* Let random lisp code notice that the selection has been stolen.  */

  {
    Lisp_Object rest;
    rest = Vx_lost_selection_hooks;
    if (!EQ (rest, Qunbound))
      {
	for (; CONSP (rest); rest = Fcdr (rest))
	  call1 (Fcar (rest), selection_symbol);
	prepare_menu_bars ();
	redisplay_preserve_echo_area (20);
      }
  }
}

/* Clear all selections that were made from frame F.
   We do this when about to delete a frame.  */

void
x_clear_frame_selections (f)
     FRAME_PTR f;
{
  Lisp_Object frame;
  Lisp_Object rest;

  XSETFRAME (frame, f);

  /* Otherwise, we're really honest and truly being told to drop it.
     Don't use Fdelq as that may QUIT;.  */

  /* Delete elements from the beginning of Vselection_alist.  */
  while (!NILP (Vselection_alist)
	 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
    {
      /* Let random Lisp code notice that the selection has been stolen.  */
      Lisp_Object hooks, selection_symbol;

      hooks = Vx_lost_selection_hooks;
      selection_symbol = Fcar (Fcar (Vselection_alist));

      if (!EQ (hooks, Qunbound))
	{
	  for (; CONSP (hooks); hooks = Fcdr (hooks))
	    call1 (Fcar (hooks), selection_symbol);
#if 0 /* This can crash when deleting a frame
	 from x_connection_closed.  Anyway, it seems unnecessary;
	 something else should cause a redisplay.  */
	  redisplay_preserve_echo_area (21);
#endif
	}

      Vselection_alist = Fcdr (Vselection_alist);
    }

  /* Delete elements after the beginning of Vselection_alist.  */
  for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
    if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
      {
	/* Let random Lisp code notice that the selection has been stolen.  */
	Lisp_Object hooks, selection_symbol;

	hooks = Vx_lost_selection_hooks;
	selection_symbol = Fcar (Fcar (XCDR (rest)));

	if (!EQ (hooks, Qunbound))
	  {
	    for (; CONSP (hooks); hooks = Fcdr (hooks))
	      call1 (Fcar (hooks), selection_symbol);
#if 0 /* See above */
	    redisplay_preserve_echo_area (22);
#endif
	  }
	XSETCDR (rest, Fcdr (XCDR (rest)));
	break;
      }
}

/* Nonzero if any properties for DISPLAY and WINDOW
   are on the list of what we are waiting for.  */

static int
waiting_for_other_props_on_window (display, window)
     Display *display;
     Window window;
{
  struct prop_location *rest = property_change_wait_list;
  while (rest)
    if (rest->display == display && rest->window == window)
      return 1;
    else
      rest = rest->next;
  return 0;
}

/* Add an entry to the list of property changes we are waiting for.
   DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
   The return value is a number that uniquely identifies
   this awaited property change.  */

static struct prop_location *
expect_property_change (display, window, property, state)
     Display *display;
     Window window;
     Atom property;
     int state;
{
  struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
  pl->identifier = ++prop_location_identifier;
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
  pl->arrived = 0;
  property_change_wait_list = pl;
  return pl;
}

/* 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 (location)
     struct prop_location *location;
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
      if (rest == location)
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
	  xfree (rest);
	  return;
	}
      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 ((struct prop_location *)
			    (XFASTINT (XCAR (identifierval)) << 16
			     | XFASTINT (XCDR (identifierval))));
  return Qnil;
}

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

static void
wait_for_property_change (location)
     struct prop_location *location;
{
  int secs, usecs;
  int count = SPECPDL_INDEX ();
  Lisp_Object tem;

  tem = Fcons (Qnil, Qnil);
  XSETCARFASTINT (tem, (EMACS_UINT)location >> 16);
  XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);

  /* Make sure to do unexpect_property_change if we quit or err.  */