Mercurial > emacs

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/xselect.c	Sat Mar 13 20:12:23 1993 +0000
@@ -0,0 +1,1949 @@
+/* x_handle_selection_notify
+x_reply_selection_request
+XFree
+x_selection_timeout initial value  */
+
+/* X Selection processing for emacs
+   Copyright (C) 1990-1993 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, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+
+/* Rewritten by jwz */
+
+#include "config.h"
+#include "lisp.h"
+#include "xterm.h"	/* for all of the X includes */
+#include "dispextern.h"	/* screen.h seems to want this */
+#include "screen.h"	/* Need this to get the X window of selected_screen */
+
+#define CUT_BUFFER_SUPPORT
+
+static Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE,
+  Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL,
+  Xatom_ATOM_PAIR;
+
+Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
+  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
+  QATOM_PAIR;
+
+#ifdef CUT_BUFFER_SUPPORT
+Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
+  QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
+#endif
+
+Lisp_Object Vx_lost_selection_hooks;
+Lisp_Object Vx_sent_selection_hooks;
+
+/* 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
+
+#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
+
+
+/* The time of the last-read mouse or keyboard event.
+   For selection purposes, we use this as a sleazy way of knowing what the
+   current time is in server-time.  This assumes that the most recently read
+   mouse or keyboard event has something to do with the assertion of the
+   selection, which is probably true.
+ */
+extern Time mouse_timestamp;
+
+
+/* This is an association list whose elements are of the form
+     ( selection-name selection-value selection-timestamp )
+   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.)
+   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.
+ */
+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.
+ */
+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 seconds (0 = no timeout.)
+ */
+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 ();
+
+static int expect_property_change ();
+static void wait_for_property_change ();
+static void unexpect_property_change ();
+static int waiting_for_other_props_on_window ();
+
+/* This converts a Lisp symbol to a server Atom, avoiding a server
+   roundtrip whenever possible.  */
+
+static Atom
+symbol_to_x_atom (display, sym)
+     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 Xatom_CLIPBOARD;
+  if (EQ (sym, QTIMESTAMP)) return Xatom_TIMESTAMP;
+  if (EQ (sym, QTEXT))	    return Xatom_TEXT;
+  if (EQ (sym, QDELETE))    return Xatom_DELETE;
+  if (EQ (sym, QMULTIPLE))  return Xatom_MULTIPLE;
+  if (EQ (sym, QINCR))	    return Xatom_INCR;
+  if (EQ (sym, QEMACS_TMP)) return Xatom_EMACS_TMP;
+  if (EQ (sym, QTARGETS))   return Xatom_TARGETS;
+  if (EQ (sym, QNULL))	    return 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 ();
+
+#if 0
+  fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
+#endif
+  BLOCK_INPUT;
+  val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, 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, atom)
+     Display *display;
+     Atom atom;
+{
+  char *str;
+  Lisp_Object val;
+  if (! atom) return Qnil;
+ 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;
+ case Xatom_CLIPBOARD:
+  return QCLIPBOARD;
+ case Xatom_TIMESTAMP:
+  return QTIMESTAMP;
+ case Xatom_TEXT:
+  return QTEXT;
+ case Xatom_DELETE:
+  return QDELETE;
+ case Xatom_MULTIPLE:
+  return QMULTIPLE;
+ case Xatom_INCR:
+  return QINCR;
+ case Xatom_EMACS_TMP:
+  return QEMACS_TMP;
+ case Xatom_TARGETS:
+  return QTARGETS;
+ case Xatom_NULL:
+  return QNULL;
+#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
+
+  BLOCK_INPUT;
+  str = XGetAtomName (display, atom);
+  UNBLOCK_INPUT;
+#if 0
+  fprintf (stderr, " XGetAtomName --> %s\n", str);
+#endif
+  if (! str) return Qnil;
+  val = intern (str);
+  BLOCK_INPUT;
+  XFree (str);
+  UNBLOCK_INPUT;
+  return val;
+}
+
+
+static Lisp_Object
+long_to_cons (i)
+     unsigned long i;
+{
+  unsigned int top = i >> 16;
+  unsigned int bot = i & 0xFFFF;
+  if (top == 0) return make_number (bot);
+  if (top == 0xFFFF) return Fcons (make_number (-1), make_number (bot));
+  return Fcons (make_number (top), make_number (bot));
+}
+
+static unsigned long
+cons_to_long (c)
+     Lisp_Object c;
+{
+  int top, bot;
+  if (FIXNUMP (c)) return XINT (c);
+  top = XCONS (c)->car;
+  bot = XCONS (c)->cdr;
+  if (CONSP (bot)) bot = XCONS (bot)->car;
+  return ((XINT (top) << 16) | XINT (bot));
+}
+
+
+
+/* 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;
+{
+  Display *display = x_current_display;
+#ifdef X_TOOLKIT
+  Window selecting_window = XtWindow (selected_screen->display.x->edit_widget);
+#else
+  Window selecting_window = FRAME_X_WINDOW (selected_frame);
+#endif
+  Time time = mouse_timestamp;
+  Atom selection_atom;
+
+  CHECK_SYMBOL (selection_name, 0);
+  selection_atom = symbol_to_x_atom (display, selection_name);
+
+  BLOCK_INPUT;
+  XSetSelectionOwner (display, selection_atom, selecting_window, time);
+  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, 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 (XCONS (rest)->cdr)))
+	    {
+	      XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
+	      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
+   and for local x-get-selection-internal.  */
+
+   This calls random Lisp code, and may signal or gc.  */
+
+static Lisp_Object
+x_get_local_selection (selection_symbol, target_type)
+     Lisp_Object selection_symbol, target_type;
+{
+  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 = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
+    }
+#if 0
+  else if (EQ (target_type, QDELETE))
+    {
+      handler_fn = Qnil;
+      Fx_disown_selection_internal
+	(selection_symbol,
+	 XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
+      value = QNULL;
+    }
+#endif
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+  else if (CONSP (target_type)
+	   && XCONS (target_type)->car == QMULTIPLE)
+    {
+      Lisp_Object pairs = XCONS (target_type)->cdr;
+      int size = XVECTOR (pairs)->size;
+      int i;
+      /* 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 = XVECTOR (pairs)->contents [i];
+	  XVECTOR (pair)->contents [1]
+	    = x_get_local_selection (XVECTOR (pair)->contents [0],
+				     XVECTOR (pair)->contents [1]);
+	}
+      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_ptr - specpdl;
+      specbind (Qinhibit_quit, Qt);
+
+      CHECK_SYMBOL (target_type, 0);
+      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
+      if (NILP (handler_fn)) return Qnil;
+      value = call3 (handler_fn,
+		     selection_symbol, target_type,
+		     XCONS (XCONS (local_value)->cdr)->car);
+      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 (XCONS (value)->car))
+    type = XCONS (value)->car,
+    check = XCONS (value)->cdr;
+
+  if (STRINGP (check)
+      || VECTORP (check)
+      || SYMBOLP (check)
+      || FIXNUMP (check)
+      || NILP (value))
+    return value;
+  else if (CONSP (check)
+	   && FIXNUMP (XCONS (check)->car)
+	   && (FIXNUMP (XCONS (check)->cdr)
+	       ||
+	       (CONSP (XCONS (check)->cdr)
+		&& FIXNUMP (XCONS (XCONS (check)->cdr)->car)
+		&& NILP (XCONS (XCONS (check)->cdr)->cdr))))
+    return value;
+  else
+    return
+      Fsignal (Qerror,
+	       Fcons (build_string ("unrecognised selection-conversion type"),
+		      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;
+  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;
+
+  BLOCK_INPUT;
+  (void) XSendEvent (reply.display, reply.requestor, False, 0L,
+		     (XEvent *) &reply);
+  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;
+
+/* 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 (ignore)
+     Lisp_Object ignore;
+{
+  if (x_selection_current_request != 0)
+    x_decline_selection_request (x_selection_current_request);
+  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);
+
+  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;
+  /* 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_screen (window)) /* #### debug */
+	error ("attempt to transfer an INCR to ourself!");
+#if 0
+      fprintf (stderr, "\nINCR %d\n", bytes_remaining);
+#endif
+      prop_id = expect_property_change (display, window, reply.property,
+					PropertyDelete);
+
+      XChangeProperty (display, window, reply.property, Xatom_INCR,
+		       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);
+    }
+  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 (!FIXNUMP (CAR (CAR (CDR (CDR (local_selection_data)))))) abort ();
+  if (!FIXNUMP (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.
+       */
+      x_decline_selection_request (event);
+      goto DONE;
+    }
+
+  local_selection_time = (Time)
+    cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
+
+  if (SELECTION_EVENT_TIME (event) != CurrentTime
+      && local_selection_time > event->time)
+    {
+      /* Someone asked for the selection, and we have one, but not the one
+	 they're looking for.
+       */
+      x_decline_selection_request (event);
+      goto DONE;
+    }
+
+  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);
+#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;
+      Atom type;
+      lisp_data_to_selection_data (reply.display, converted_selection,
+				   &data, &type, &size, &format);
+
+      x_reply_selection_request (event, format, data, size, type);
+      successful_p = Qt;
+
+      /* Indicate we have successfully processed this event.  */
+      x_selection_current_event = 0;
+
+      xfree (data);
+    }
+  unbind_to (count, Qnil);
+
+ DONE:
+
+  UNGCPRO;
+
+  /* Let random lisp code notice that the selection has been asked for.  */
+  {
+    Lisp_Object rest = Vx_sent_selection_hooks;
+    if (!EQ (rest, Qunbound))
+      for (; CONSP (rest); rest = Fcdr (rest))
+	call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
+  }
+}
+
+/* Handle a SelectionClear event EVENT, which indicates that some other
+   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;
+
+  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 (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
+
+  /* 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 (XCONS (rest)->cdr)))
+	  {
+	    XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
+	    break;
+	  }
+    }
+
+  /* Let random lisp code notice that the selection has been stolen.  */
+
+  {
+    Lisp_Object rest = Vx_lost_selection_hooks;
+    if (!EQ (rest, Qunbound))
+      for (; CONSP (rest); rest = Fcdr (rest))
+	call1 (Fcar (rest), selection_symbol);
+  }
+}
+
+
+/* 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;
+}
+
+/* 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 int
+expect_property_change (display, window, property, state)
+     Display *display;
+     Window window;
+     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;
+	  xfree (rest);
+	  return;
+	}
+      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
+x_handle_property_notify (event)
+     XPropertyEvent *event;
+{
+  struct prop_location *prev = 0, *rest = property_change_wait_list;
+  while (rest)
+    {
+      if (rest->property == event->atom
+	  && rest->window == event->window
+	  && rest->display == event->display
+	  && rest->desired_state == event->state)
+	{
+#if 0
+	  fprintf (stderr, "Saw expected prop-%s on %s\n",
+		   (event->state == PropertyDelete ? "delete" : "change"),
+		   (char *) XSYMBOL (x_atom_to_symbol (event->display,
+						       event->atom))
+		   ->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
+	    property_change_wait_list = rest->next;
+	  xfree (rest);
+	  return;
+	}
+      prev = rest;
+      rest = rest->next;
+    }
+#if 0
+  fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
+	   (event->state == PropertyDelete ? "delete" : "change"),
+	   (char *) XSYMBOL (x_atom_to_symbol (event->display, event->atom))
+	   ->name->data);
+#endif
+}
+
+
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+
+static Lisp_Object
+fetch_multiple_target (event)
+     XSelectionRequestEvent *event;
+{
+  Display *display = event->display;
+  Window window = event->requestor;
+  Atom target = event->target;
+  Atom selection_atom = event->selection;
+  int result;
+
+  return
+    Fcons (QMULTIPLE,
+	   x_get_window_property_as_lisp_data (display, window, target,
+					       QMULTIPLE, selection_atom));
+}
+
+static Lisp_Object
+copy_multiple_data (obj)
+     Lisp_Object obj;
+{
+  Lisp_Object vec;
+  int i;
+  int size;
+  if (CONSP (obj))
+    return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
+
+  CHECK_VECTOR (obj, 0);
+  vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
+  for (i = 0; i < size; i++)
+    {
+      Lisp_Object vec2 = XVECTOR (obj)->contents [i];
+      CHECK_VECTOR (vec2, 0);
+      if (XVECTOR (vec2)->size != 2)
+	/* ??? Confusing error message */
+	Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
+				Fcons (vec2, Qnil)));
+      XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
+      XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
+	= XVECTOR (vec2)->contents [0];
+      XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
+	= XVECTOR (vec2)->contents [1];
+    }
+  return vec;
+}
+
+#endif
+
+
+/* Variables for communication with x_handle_selection_notify.  */
+static Atom reading_which_selection;
+static Lisp_Object reading_selection_reply;
+static Window reading_selection_window;
+
+/* Do protocol to read selection-data from the server.
+   Converts this to Lisp data and returns it.  */
+
+static Lisp_Object
+x_get_foreign_selection (selection_symbol, target_type)
+     Lisp_Object selection_symbol, target_type;
+{
+  Display *display = x_current_display;
+#ifdef X_TOOLKIT
+  Window selecting_window = XtWindow (selected_screen->display.x->edit_widget);
+#else
+  Window selecting_window = FRAME_X_WINDOW (selected_frame);
+#endif
+  Time requestor_time = mouse_timestamp;
+  Atom target_property = Xatom_EMACS_TMP;
+  Atom selection_atom = symbol_to_x_atom (display, selection_symbol);
+  Atom type_atom;
+
+  if (CONSP (target_type))
+    type_atom = symbol_to_x_atom (display, XCONS (target_type)->car);
+  else
+    type_atom = symbol_to_x_atom (display, target_type);
+
+  BLOCK_INPUT;
+  XConvertSelection (display, selection_atom, type_atom, target_property,
+		     requestor_window, requestor_time);
+
+  /* Prepare to block until the reply has been read.  */
+  reading_selection_window = requestor_window;
+  reading_which_selection = selection_atom;
+  XCONS (reading_selection_reply)->car = Qnil;
+  UNBLOCK_INPUT;
+
+  /* This allows quits.  */
+  wait_reading_process_input (x_selection_timeout, 0,
+			      reading_selection_reply, 0);
+
+  if (NILP (XCONS (reading_selection_reply)->car))
+    error ("timed out waiting for reply from selection owner");
+
+  /* Otherwise, the selection is waiting for us on the requested property.  */
+  return
+    x_get_window_property_as_lisp_data (display, requestor_window,
+					target_property, target_type,
+					selection_atom);
+}
+
+/* Subroutines of x_get_window_property_as_lisp_data */
+
+static void
+x_get_window_property (display, window, property, data_ret, bytes_ret,
+		       actual_type_ret, actual_format_ret, actual_size_ret,
+		       delete_p)
+     Display *display;
+     Window window;
+     Atom property;
+     unsigned char **data_ret;
+     int *bytes_ret;
+     Atom *actual_type_ret;
+     int *actual_format_ret;
+     unsigned long *actual_size_ret;
+     int delete_p;
+{
+  int total_size;
+  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,
+			       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);
+#endif
+      /* If this doesn't return Success at this point, it means that
+	 some clod deleted the selection while we were in the midst of
+	 reading it.  Deal with that, I guess....
+       */
+      if (result != Success) break;
+      *actual_size_ret *= *actual_format_ret / 8;
+      bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
+      offset += *actual_size_ret;
+      XFree ((char *) tmp_data);
+    }
+  UNBLOCK_INPUT;
+  *bytes_ret = offset;
+}
+
+static void
+receive_incremental_selection (display, window, property, target_type,
+			       min_size_bytes, data_ret, size_bytes_ret,
+			       type_ret, format_ret, size_ret)
+     Display *display;
+     Window window;
+     Atom property;
+     Lisp_Object target_type; /* for error messages only */
+     unsigned int min_size_bytes;
+     unsigned char **data_ret;
+     int *size_bytes_ret;
+     Atom *type_ret;
+     unsigned long *size_ret;
+     int *format_ret;
+{
+  int offset = 0;
+  int prop_id;
+  *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)
+	{
+#if 0
+	  fprintf (stderr, "  read INCR realloc %d -> %d\n",
+		   *size_bytes_ret, offset + tmp_size_bytes);
+#endif
+	  *size_bytes_ret = offset + tmp_size_bytes;
+	  *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
+	}
+      memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
+      offset += tmp_size_bytes;
+      xfree (tmp_data);
+    }
+}
+
+/* Once a requested selection is "ready" (we got a SelectionNotify event),
+   fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
+   TARGET_TYPE and SELECTION_ATOM are used in error message if this fails.  */
+
+static Lisp_Object
+x_get_window_property_as_lisp_data (display, window, property, target_type,
+				    selection_atom)
+     Display *display;
+     Window window;
+     Atom property;
+     Lisp_Object target_type;	/* for error messages only */
+     Atom selection_atom;	/* for error messages only */
+{
+  Atom actual_type;
+  int actual_format;
+  unsigned long actual_size;
+  unsigned char *data = 0;
+  int bytes = 0;
+  Lisp_Object val;
+
+  x_get_window_property (display, window, property, &data, &bytes,
+			 &actual_type, &actual_format, &actual_size, 1);
+  if (! data)
+    {
+      int there_is_a_selection_owner;
+      BLOCK_INPUT;
+      there_is_a_selection_owner
+	= XGetSelectionOwner (display, selection_atom);
+      UNBLOCK_INPUT;
+      while (1) /* Note debugger can no longer return, so this is obsolete */
+	Fsignal (Qerror,
+		 there_is_a_selection_owner ?
+		 Fcons (build_string ("selection owner couldn't convert"),
+			actual_type
+			? Fcons (target_type,
+				 Fcons (x_atom_to_symbol (display, actual_type),
+					Qnil))
+			: Fcons (target_type, Qnil))
+		 : Fcons (build_string ("no selection"),
+			  Fcons (x_atom_to_symbol (display, selection_atom),
+				 Qnil)));
+    }
+
+  if (actual_type == Xatom_INCR)
+    {
+      /* That wasn't really the data, just the beginning.  */
+
+      unsigned int min_size_bytes = * ((unsigned int *) data);
+      BLOCK_INPUT;
+      XFree ((char *) data);
+      UNBLOCK_INPUT;
+      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);
+
+  xfree ((char *) data);
+  return val;
+}
+
+/* These functions convert from the selection data read from the server into
+   something that we can use from Lisp, and vice versa.
+
+	Type:	Format:	Size:		Lisp Type:
+	-----	-------	-----		-----------
+	*	8	*		String
+	ATOM	32	1		Symbol
+	ATOM	32	> 1		Vector of Symbols
+	*	16	1		Integer
+	*	16	> 1		Vector of Integers
+	*	32	1		if <=16 bits: Integer
+					if > 16 bits: Cons of top16, bot16
+	*	32	> 1		Vector of the above
+
+   When converting a Lisp number to C, it is assumed to be of format 16 if
+   it is an integer, and of format 32 if it is a cons of two integers.
+
+   When converting a vector of numbers from Lisp to C, it is assumed to be
+   of format 16 if every element in the vector is an integer, and is assumed
+   to be of format 32 if any element is a cons of two integers.
+
+   When converting an object to C, it may be of the form (SYMBOL . <data>)
+   where SYMBOL is what we should claim that the type is.  Format and
+   representation are as above.  */
+
+
+
+static Lisp_Object
+selection_data_to_lisp_data (display, data, size, type, format)
+     Display *display;
+     unsigned char *data;
+     Atom type;
+     int size, format;
+{
+
+  if (type == Xatom_NULL)
+    return QNULL;
+
+  /* Convert any 8-bit data to a string, for compactness.  */
+  else if (format == 8)
+    return make_string ((char *) data, size);
+
+  /* Convert a single atom to a Lisp_Symbol.  Convert a set of atoms to
+     a vector of symbols.
+   */
+  else if (type == XA_ATOM)
+    {
+      int i;
+      if (size == sizeof (Atom))
+	return x_atom_to_symbol (display, *((Atom *) data));
+      else
+	{
+	  Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
+	  for (i = 0; i < size / sizeof (Atom); i++)
+	    Faset (v, i, x_atom_to_symbol (display, ((Atom *) data) [i]));
+	  return v;
+	}
+    }
+
+  /* Convert a single 16 or small 32 bit number to a Lisp_Int.
+     If the number is > 16 bits, convert it to a cons of integers,
+     16 bits in each half.
+   */
+  else if (format == 32 && size == sizeof (long))
+    return long_to_cons (((unsigned long *) data) [0]);
+  else if (format == 16 && size == sizeof (short))
+    return make_number ((int) (((unsigned short *) data) [0]));
+
+  /* Convert any other kind of data to a vector of numbers, represented
+     as above (as an integer, or a cons of two 16 bit integers.)
+   */
+  else if (format == 16)
+    {
+      int i;
+      Lisp_Object v = Fmake_vector (size / 4, 0);
+      for (i = 0; i < size / 4; i++)
+	{
+	  int j = (int) ((unsigned short *) data) [i];
+	  Faset (v, i, make_number (j));
+	}
+      return v;
+    }
+  else
+    {
+      int i;
+      Lisp_Object v = Fmake_vector (size / 4, 0);
+      for (i = 0; i < size / 4; i++)
+	{
+	  unsigned long j = ((unsigned long *) data) [i];
+	  Faset (v, i, long_to_cons (j));
+	}
+      return v;
+    }
+}
+
+
+static void
+lisp_data_to_selection_data (display, obj,
+			     data_ret, type_ret, size_ret, format_ret)
+     Display *display;
+     Lisp_Object obj;
+     unsigned char **data_ret;
+     Atom *type_ret;
+     unsigned int *size_ret;
+     int *format_ret;
+{
+  Lisp_Object type = Qnil;
+  if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
+    {
+      type = XCONS (obj)->car;
+      obj = XCONS (obj)->cdr;
+      if (CONSP (obj) && NILP (XCONS (obj)->cdr))
+	obj = XCONS (obj)->car;
+    }
+
+  if (EQ (obj, QNULL) || (EQ (type, QNULL)))
+    {				/* This is not the same as declining */
+      *format_ret = 32;
+      *size_ret = 0;
+      *data_ret = 0;
+      type = QNULL;
+    }
+  else if (STRINGP (obj))
+    {
+      *format_ret = 8;
+      *size_ret = XSTRING (obj)->size;
+      *data_ret = (unsigned char *) xmalloc (*size_ret);
+      memcpy (*data_ret, (char *) XSTRING (obj)->data, *size_ret);
+      if (NILP (type)) type = QSTRING;
+    }
+  else if (SYMBOLP (obj))
+    {
+      *format_ret = 32;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
+      (*data_ret) [sizeof (Atom)] = 0;
+      (*(Atom **) data_ret) [0] = symbol_to_x_atom (display, obj);
+      if (NILP (type)) type = QATOM;
+    }
+  else if (FIXNUMP (obj)
+	   && XINT (obj) < 0xFFFF
+	   && XINT (obj) > -0xFFFF)
+    {
+      *format_ret = 16;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
+      (*data_ret) [sizeof (short)] = 0;
+      (*(short **) data_ret) [0] = (short) XINT (obj);
+      if (NILP (type)) type = QINTEGER;
+    }
+  else if (FIXNUMP (obj) || CONSP (obj))
+    {
+      *format_ret = 32;
+      *size_ret = 1;
+      *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
+      (*data_ret) [sizeof (long)] = 0;
+      (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
+      if (NILP (type)) type = QINTEGER;
+    }
+  else if (VECTORP (obj))
+    {
+      /* Lisp_Vectors may represent a set of ATOMs;
+	 a set of 16 or 32 bit INTEGERs;
+	 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
+       */
+      int i;
+
+      if (SYMBOLP (XVECTOR (obj)->contents [0]))
+	/* This vector is an ATOM set */
+	{
+	  if (NILP (type)) type = QATOM;
+	  *size_ret = XVECTOR (obj)->size;
+	  *format_ret = 32;
+	  *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
+	  for (i = 0; i < *size_ret; i++)
+	    if (SYMBOLP (XVECTOR (obj)->contents [i]))
+	      (*(Atom **) data_ret) [i]
+		= symbol_to_x_atom (display, XVECTOR (obj)->contents [i]);
+	    else
+	      Fsignal (Qerror, /* Qselection_error */
+		       Fcons (build_string
+		   ("all elements of selection vector must have same type"),
+			      Fcons (obj, Qnil)));
+	}
+#if 0 /* #### MULTIPLE doesn't work yet */
+      else if (VECTORP (XVECTOR (obj)->contents [0]))
+	/* This vector is an ATOM_PAIR set */
+	{
+	  if (NILP (type)) type = QATOM_PAIR;
+	  *size_ret = XVECTOR (obj)->size;
+	  *format_ret = 32;
+	  *data_ret = (unsigned char *)
+	    xmalloc ((*size_ret) * sizeof (Atom) * 2);
+	  for (i = 0; i < *size_ret; i++)
+	    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 (display, XVECTOR (pair)->contents [0]);
+		(*(Atom **) data_ret) [(i * 2) + 1]
+		  = symbol_to_x_atom (display, XVECTOR (pair)->contents [1]);
+	      }
+	    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 */
+	{
+	  *size_ret = XVECTOR (obj)->size;
+	  if (NILP (type)) type = QINTEGER;
+	  *format_ret = 16;
+	  for (i = 0; i < *size_ret; i++)
+	    if (CONSP (XVECTOR (obj)->contents [i]))
+	      *format_ret = 32;
+	    else if (!FIXNUMP (XVECTOR (obj)->contents [i]))
+	      Fsignal (Qerror, /* Qselection_error */
+		       Fcons (build_string
+	("elements of selection vector must be integers or conses of integers"),
+			      Fcons (obj, Qnil)));
+
+	  *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
+	  for (i = 0; i < *size_ret; i++)
+	    if (*format_ret == 32)
+	      (*((unsigned long **) data_ret)) [i]
+		= cons_to_long (XVECTOR (obj)->contents [i]);
+	    else
+	      (*((unsigned short **) data_ret)) [i]
+		= (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
+	}
+    }
+  else
+    Fsignal (Qerror, /* Qselection_error */
+	     Fcons (build_string ("unrecognised selection data"),
+		    Fcons (obj, Qnil)));
+
+  *type_ret = symbol_to_x_atom (display, type);
+}
+
+static Lisp_Object
+clean_local_selection_data (obj)
+     Lisp_Object obj;
+{
+  if (CONSP (obj)
+      && FIXNUMP (XCONS (obj)->car)
+      && CONSP (XCONS (obj)->cdr)
+      && FIXNUMP (XCONS (XCONS (obj)->cdr)->car)
+      && NILP (XCONS (XCONS (obj)->cdr)->cdr))
+    obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
+
+  if (CONSP (obj)
+      && FIXNUMP (XCONS (obj)->car)
+      && FIXNUMP (XCONS (obj)->cdr))
+    {
+      if (XINT (XCONS (obj)->car) == 0)
+	return XCONS (obj)->cdr;
+      if (XINT (XCONS (obj)->car) == -1)
+	return make_number (- XINT (XCONS (obj)->cdr));
+    }
+  if (VECTORP (obj))
+    {
+      int i;
+      int size = XVECTOR (obj)->size;
+      Lisp_Object copy;
+      if (size == 1)
+	return clean_local_selection_data (XVECTOR (obj)->contents [0]);
+      copy = Fmake_vector (size, Qnil);
+      for (i = 0; i < size; i++)
+	XVECTOR (copy)->contents [i]
+	  = clean_local_selection_data (XVECTOR (obj)->contents [i]);
+      return copy;
+    }
+  return obj;
+}
+
+/* Called from XTread_socket to handle SelectionNotify events.
+   If it's the selection we are waiting for, stop waiting.  */
+
+void
+x_handle_selection_notify (event)
+     XSelectionEvent *event;
+{
+  if (event->requestor != reading_selection_window)
+    return;
+  if (event->selection != reading_which_selection)
+    return;
+
+  XCONS (reading_selection_reply)->car = Qt;
+}
+
+
+DEFUN ("x-own-selection-internal",
+       Fx_own_selection_internal, Sx_own_selection_internal,
+  2, 2, 0,
+  "Assert an X selection of the given TYPE with the given VALUE.\n\
+TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
+\(Those are literal upper-case symbol names, since that's what X expects.)\n\
+VALUE is typically a string, or a cons of two markers, but may be\n\
+anything that the functions on selection-converter-alist know about.")
+  (selection_name, selection_value)
+     Lisp_Object selection_name, selection_value;
+{
+  CHECK_SYMBOL (selection_name, 0);
+  if (NILP (selection_value)) error ("selection-value may not be nil.");
+  x_own_selection (selection_name, selection_value);
+  return selection_value;
+}
+
+
+/* Request the selection value from the owner.  If we are the owner,
+   simply return our selection value.  If we are not the owner, this
+   will block until all of the data has arrived.  */
+
+DEFUN ("x-get-selection-internal",
+  Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
+  "Return text selected from some X window.\n\
+SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
+\(Those are literal upper-case symbol names, since that's what X expects.)\n\
+TYPE is the type of data desired, typically STRING.")
+  (selection_symbol, target_type)
+     Lisp_Object selection_symbol, target_type;
+{
+  Lisp_Object val = Qnil;
+  struct gcpro gcpro1, gcpro2;
+  GCPRO2 (target_type, val); /* we store newly consed data into these */
+  CHECK_SYMBOL (selection_symbol, 0);
+
+#if 0 /* #### MULTIPLE doesn't work yet */
+  if (CONSP (target_type)
+      && XCONS (target_type)->car == QMULTIPLE)
+    {
+      CHECK_VECTOR (XCONS (target_type)->cdr, 0);
+      /* So we don't destructively modify this...  */
+      target_type = copy_multiple_data (target_type);
+    }
+  else
+#endif
+    CHECK_SYMBOL (target_type, 0);
+
+  val = x_get_local_selection (selection_symbol, target_type);
+
+  if (NILP (val))
+    {
+      val = x_get_foreign_selection (selection_symbol, target_type);
+      goto DONE;
+    }
+
+  if (CONSP (val)
+      && SYMBOLP (XCONS (val)->car))
+    {
+      val = XCONS (val)->cdr;
+      if (CONSP (val) && NILP (XCONS (val)->cdr))
+	val = XCONS (val)->car;
+    }
+  val = clean_local_selection_data (val);
+ DONE:
+  UNGCPRO;
+  return val;
+}
+
+DEFUN ("x-disown-selection-internal",
+  Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
+  "If we own the named selection, then disown it (make there be no selection).")
+  (selection, time)
+     Lisp_Object selection;
+     Lisp_Object time;
+{
+  Display *display = x_current_display;
+  Time timestamp;
+  Atom selection_atom;
+  XSelectionClearEvent event;
+
+  CHECK_SYMBOL (selection, 0);
+  if (NILP (time))
+    timestamp = mouse_timestamp;
+  else
+    timestamp = cons_to_long (time);
+
+  if (NILP (assq_no_quit (selection, Vselection_alist)))
+    return Qnil;  /* Don't disown the selection when we're not the owner.  */
+
+  selection_atom = symbol_to_x_atom (display, selection);
+
+  BLOCK_INPUT;
+  XSetSelectionOwner (display, selection_atom, None, timestamp);
+  UNBLOCK_INPUT;
+
+  /* It doesn't seem to be guarenteed that a SelectionClear event will be
+     generated for a window which owns the selection when that window sets
+     the selection owner to None.  The NCD server does, the MIT Sun4 server
+     doesn't.  So we synthesize one; this means we might get two, but
+     that's ok, because the second one won't have any effect.  */
+  event.display = display;
+  event.selection = selection_atom;
+  event.time = timestamp;
+  x_handle_selection_clear (&event);
+
+  return Qt;
+}
+
+
+DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
+  0, 1, 0,
+  "Whether the current emacs process owns the given X Selection.\n\
+The arg should be the name of the selection in question, typically one of\n\
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
+\(Those are literal upper-case symbol names, since that's what X expects.)\n\
+For convenience, the symbol nil is the same as `PRIMARY',\n\
+and t is the same as `SECONDARY'.)")
+  (selection)
+     Lisp_Object selection;
+{
+  CHECK_SYMBOL (selection, 0);
+  if (EQ (selection, Qnil)) selection = QPRIMARY;
+  if (EQ (selection, Qt)) selection = QSECONDARY;
+
+  if (NILP (Fassq (selection, Vselection_alist)))
+    return Qnil;
+  return Qt;
+}
+
+DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
+  0, 1, 0,
+  "Whether there is an owner for the given X Selection.\n\
+The arg should be the name of the selection in question, typically one of\n\
+the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
+\(Those are literal upper-case symbol names, since that's what X expects.)\n\
+For convenience, the symbol nil is the same as `PRIMARY',\n\
+and t is the same as `SECONDARY'.)")
+  (selection)
+     Lisp_Object selection;
+{
+  Window owner;
+  Display *dpy = x_current_display;
+  CHECK_SYMBOL (selection, 0);
+  if (!NILP (Fx_selection_owner_p (selection)))
+    return Qt;
+  BLOCK_INPUT;
+  owner = XGetSelectionOwner (dpy, symbol_to_x_atom (dpy, selection));
+  UNBLOCK_INPUT;
+  return (owner ? Qt : Qnil);
+}
+
+
+#ifdef CUT_BUFFER_SUPPORT
+
+static int cut_buffers_initialized; /* Whether we're sure they all exist */
+
+/* Ensure that all 8 cut buffers exist.  ICCCM says we gotta...  */
+static void
+initialize_cut_buffers (display, window)
+     Display *display;
+     Window window;
+{
+  unsigned char *data = (unsigned char *) "";
+  BLOCK_INPUT;
+#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
+				    PropModeAppend, data, 0)
+  FROB (XA_CUT_BUFFER0);
+  FROB (XA_CUT_BUFFER1);
+  FROB (XA_CUT_BUFFER2);
+  FROB (XA_CUT_BUFFER3);
+  FROB (XA_CUT_BUFFER4);
+  FROB (XA_CUT_BUFFER5);
+  FROB (XA_CUT_BUFFER6);
+  FROB (XA_CUT_BUFFER7);
+#undef FROB
+  UNBLOCK_INPUT;
+  cut_buffers_initialized = 1;
+}
+
+
+#define CHECK_CUTBUFFER(symbol,n)					\
+  { CHECK_SYMBOL ((symbol), (n));					\
+    if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1)	\
+	&& !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3)	\
+	&& !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5)	\
+	&& !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7))	\
+      Fsignal (Qerror,							\
+	       Fcons (build_string ("doesn't name a cutbuffer"),	\
+			     Fcons ((symbol), Qnil)));			\
+  }
+
+DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal,
+  Sx_get_cutbuffer_internal, 1, 1, 0,
+  "Returns the value of the named cutbuffer (typically CUT_BUFFER0).")
+  (buffer)
+     Lisp_Object buffer;
+{
+  Display *display = x_current_display;
+  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+  Atom buffer_atom;
+  unsigned char *data;
+  int bytes;
+  Atom type;
+  int format;
+  unsigned long size;
+  Lisp_Object ret;
+
+  CHECK_CUTBUFFER (buffer, 0);
+  buffer_atom = symbol_to_x_atom (display, buffer);
+
+  x_get_window_property (display, window, buffer_atom, &data, &bytes,
+			 &type, &format, &size, 0);
+  if (!data) 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))));
+
+  ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
+  xfree (data);
+  return ret;
+}
+
+
+DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal,
+  Sx_store_cutbuffer_internal, 2, 2, 0,
+  "Sets the value of the named cutbuffer (typically CUT_BUFFER0).")
+  (buffer, string)
+     Lisp_Object buffer, string;
+{
+  Display *display = x_current_display;
+  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+  Atom buffer_atom;
+  unsigned char *data;
+  int bytes;
+  int bytes_remaining;
+  int max_bytes = SELECTION_QUANTUM (display);
+  if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
+
+  CHECK_CUTBUFFER (buffer, 0);
+  CHECK_STRING (string, 0);
+  buffer_atom = symbol_to_x_atom (display, buffer);
+  data = (unsigned char *) XSTRING (string)->data;
+  bytes = XSTRING (string)->size;
+  bytes_remaining = bytes;
+
+  if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
+
+  BLOCK_INPUT;
+  while (bytes_remaining)
+    {
+      int chunk = (bytes_remaining < max_bytes
+		   ? bytes_remaining : max_bytes);
+      XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
+		       (bytes_remaining == bytes
+			? PropModeReplace
+			: PropModeAppend),
+		       data, chunk);
+      data += chunk;
+      bytes_remaining -= chunk;
+    }
+  UNBLOCK_INPUT;
+  return string;
+}
+
+
+DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal,
+  Sx_rotate_cutbuffers_internal, 1, 1, 0,
+  "Rotate the values of the cutbuffers by the given number of steps;\n\
+positive means move values forward, negative means backward.")
+  (n)
+     Lisp_Object n;
+{
+  Display *display = x_current_display;
+  Window window = RootWindow (display, 0); /* Cutbuffers are on screen 0 */
+  Atom props [8];
+
+  CHECK_FIXNUM (n, 0);
+  if (XINT (n) == 0) return n;
+  if (! cut_buffers_initialized) initialize_cut_buffers (display, window);
+  props[0] = XA_CUT_BUFFER0;
+  props[1] = XA_CUT_BUFFER1;
+  props[2] = XA_CUT_BUFFER2;
+  props[3] = XA_CUT_BUFFER3;
+  props[4] = XA_CUT_BUFFER4;
+  props[5] = XA_CUT_BUFFER5;
+  props[6] = XA_CUT_BUFFER6;
+  props[7] = XA_CUT_BUFFER7;
+  BLOCK_INPUT;
+  XRotateWindowProperties (display, window, props, 8, XINT (n));
+  UNBLOCK_INPUT;
+  return n;
+}
+
+#endif
+
+static void
+atoms_of_xselect ()
+{
+#define ATOM(x) XInternAtom (x_current_display, (x), False)
+
+  BLOCK_INPUT;
+  /* Non-predefined atoms that we might end up using a lot */
+  Xatom_CLIPBOARD =	ATOM ("CLIPBOARD");
+  Xatom_TIMESTAMP =	ATOM ("TIMESTAMP");
+  Xatom_TEXT =		ATOM ("TEXT");
+  Xatom_DELETE =	ATOM ("DELETE");
+  Xatom_MULTIPLE =	ATOM ("MULTIPLE");
+  Xatom_INCR =		ATOM ("INCR");
+  Xatom_EMACS_TMP =	ATOM ("_EMACS_TMP_");
+  Xatom_TARGETS =	ATOM ("TARGETS");
+  Xatom_NULL =		ATOM ("NULL");
+  Xatom_ATOM_PAIR =	ATOM ("ATOM_PAIR");
+  UNBLOCK_INPUT;
+}
+
+void
+syms_of_xselect ()
+{
+  atoms_of_select ();
+
+  defsubr (&Sx_get_selection_internal);
+  defsubr (&Sx_own_selection_internal);
+  defsubr (&Sx_disown_selection_internal);
+  defsubr (&Sx_selection_owner_p);
+  defsubr (&Sx_selection_exists_p);
+
+#ifdef CUT_BUFFER_SUPPORT
+  defsubr (&Sx_get_cutbuffer_internal);
+  defsubr (&Sx_store_cutbuffer_internal);
+  defsubr (&Sx_rotate_cutbuffers_internal);
+  cut_buffers_initialized = 0;
+#endif
+
+  reading_selection_reply = Fcons (Qnil, Qnil);
+  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);
+
+  DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
+  "An alist associating X Windows selection-types with functions.\n\
+These functions are called to convert the selection, with three args:\n\
+the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
+a desired type to which the selection should be converted;\n\
+and the local selection value (whatever was given to `x-own-selection').\n\
+\n\
+The function should return the value to send to the X server\n\
+\(typically a string).  A return value of nil\n\
+means that the conversion could not be done.\n\
+A return value which is the symbol `NULL'\n\
+means that a side-effect was executed,\n\
+and there is no meaningful selection value.");
+  Vselection_converter_alist = Qnil;
+
+  DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
+  "A list of functions to be called when Emacs loses an X selection.\n\
+\(This happens when some other X client makes its own selection\n\
+or when a Lisp program explicitly clears the selection.)\n\
+The functions are called with one argument, the selection type\n\
+\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.)");
+  Vx_lost_selection_hooks = Qnil;
+
+  DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
+  "A list of functions to be called when Emacs answers a selection request.\n\
+The functions are called with four arguments:\n\
+  - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
+  - the selection-type which Emacs was asked to convert the\n\
+    selection into before sending (for example, `STRING' or `LENGTH');\n\
+  - a flag indicating success or failure for responding to the request.\n\
+We might have failed (and declined the request) for any number of reasons,\n\
+including being asked for a selection that we no longer own, or being asked\n\
+to convert into a type that we don't know about or that is inappropriate.\n\
+This hook doesn't let you change the behavior of Emacs's selection replies,\n\
+it merely informs you that they have happened.");
+  Vx_sent_selection_hooks = Qnil;
+
+  DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
+   "Number of seconds to wait for a selection reply from another X client.\n\
+If the selection owner doens't reply in this many seconds, we give up.\n\
+A value of 0 means wait as long as necessary.  This is initialized from the\n\
+\"*selectionTimeout\" resource (which is expressed in milliseconds).");
+  x_selection_timeout = 0;
+
+  QPRIMARY   = intern ("PRIMARY");	staticpro (&QPRIMARY);
+  QSECONDARY = intern ("SECONDARY");	staticpro (&QSECONDARY);
+  QSTRING    = intern ("STRING");	staticpro (&QSTRING);
+  QINTEGER   = intern ("INTEGER");	staticpro (&QINTEGER);
+  QCLIPBOARD = intern ("CLIPBOARD");	staticpro (&QCLIPBOARD);
+  QTIMESTAMP = intern ("TIMESTAMP");	staticpro (&QTIMESTAMP);
+  QTEXT      = intern ("TEXT"); 	staticpro (&QTEXT);
+  QTIMESTAMP = intern ("TIMESTAMP");	staticpro (&QTIMESTAMP);
+  QDELETE    = intern ("DELETE");	staticpro (&QDELETE);
+  QMULTIPLE  = intern ("MULTIPLE");	staticpro (&QMULTIPLE);
+  QINCR      = intern ("INCR");		staticpro (&QINCR);
+  QEMACS_TMP = intern ("_EMACS_TMP_");	staticpro (&QEMACS_TMP);
+  QTARGETS   = intern ("TARGETS");	staticpro (&QTARGETS);
+  QATOM	     = intern ("ATOM");		staticpro (&QATOM);
+  QATOM_PAIR = intern ("ATOM_PAIR");	staticpro (&QATOM_PAIR);
+  QNULL	     = intern ("NULL");		staticpro (&QNULL);
+
+#ifdef CUT_BUFFER_SUPPORT
+  QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
+  QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
+  QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
+  QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
+  QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
+  QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
+  QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
+  QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
+#endif
+
+}