xselect.c 69.4 KB
Newer Older
1
/* X Selection processing for Emacs.
Richard M. Stallman's avatar
Richard M. Stallman committed
2
   Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation.
Richard M. Stallman's avatar
Richard M. Stallman committed
3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

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
18 19
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
20

Jim Blandy's avatar
Jim Blandy committed
21

Richard M. Stallman's avatar
Richard M. Stallman committed
22 23
/* Rewritten by jwz */

24
#include <config.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
25 26
#include "lisp.h"
#include "xterm.h"	/* for all of the X includes */
27 28
#include "dispextern.h"	/* frame.h seems to want this */
#include "frame.h"	/* Need this to get the X window of selected_frame */
29
#include "blockinput.h"
Karl Heuer's avatar
Karl Heuer committed
30 31
#include "charset.h"
#include "coding.h"
32

Richard M. Stallman's avatar
Richard M. Stallman committed
33 34 35 36 37 38
#define CUT_BUFFER_SUPPORT

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

Karl Heuer's avatar
Karl Heuer committed
39 40
Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */

Richard M. Stallman's avatar
Richard M. Stallman committed
41 42 43 44 45
#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#endif

46 47
static Lisp_Object Vx_lost_selection_hooks;
static Lisp_Object Vx_sent_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
48 49 50 51 52 53

/* 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
54
   incremental transfer stuff, but it might improve server performance.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
55 56
#define MAX_SELECTION_QUANTUM 0xFFFFFF

57 58 59 60 61
#ifdef HAVE_X11R4
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
#else
#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
62

63
/* The timestamp of the last input event Emacs received from the X server.  */
64 65
/* Defined in keyboard.c.  */
extern unsigned long last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
66 67

/* This is an association list whose elements are of the form
68 69 70
     ( 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
71
     It may be any kind of Lisp object.
72
   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
Richard M. Stallman's avatar
Richard M. Stallman committed
73
     as a cons of two 16-bit numbers (making a 32 bit time.)
74 75
   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
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77
    that selection.
   The only (eq) parts of this list that are visible from Lisp are the
78 79
    selection-values.  */
static Lisp_Object Vselection_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
80 81 82 83 84

/* 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
85 86
   selection handling.  */
static Lisp_Object Vselection_converter_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
87 88

/* If the selection owner takes too long to reply to a selection request,
89 90
   we give up on it.  This is in milliseconds (0 = no timeout.)  */
static int x_selection_timeout;
Richard M. Stallman's avatar
Richard M. Stallman committed
91 92 93 94 95 96 97 98 99 100 101

/* 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
102 103
symbol_to_x_atom (dpyinfo, display, sym)
     struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
104 105 106 107 108 109 110 111 112 113
     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;
114 115 116
  if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
  if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
  if (EQ (sym, QTEXT))	    return dpyinfo->Xatom_TEXT;
Karl Heuer's avatar
Karl Heuer committed
117
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
118 119 120 121 122 123
  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;
Richard M. Stallman's avatar
Richard M. Stallman committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
#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
150 151
x_atom_to_symbol (dpyinfo, display, atom)
     struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
152 153 154 155 156 157
     Display *display;
     Atom atom;
{
  char *str;
  Lisp_Object val;
  if (! atom) return Qnil;
158 159 160 161 162 163 164 165 166 167 168 169
  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;
Richard M. Stallman's avatar
Richard M. Stallman committed
170
#ifdef CUT_BUFFER_SUPPORT
171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
    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;
Richard M. Stallman's avatar
Richard M. Stallman committed
187
#endif
188 189
    }

190
  if (atom == dpyinfo->Xatom_CLIPBOARD)
191
    return QCLIPBOARD;
192
  if (atom == dpyinfo->Xatom_TIMESTAMP)
193
    return QTIMESTAMP;
194
  if (atom == dpyinfo->Xatom_TEXT)
195
    return QTEXT;
Karl Heuer's avatar
Karl Heuer committed
196 197
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
198
  if (atom == dpyinfo->Xatom_DELETE)
199
    return QDELETE;
200
  if (atom == dpyinfo->Xatom_MULTIPLE)
201
    return QMULTIPLE;
202
  if (atom == dpyinfo->Xatom_INCR)
203
    return QINCR;
204
  if (atom == dpyinfo->Xatom_EMACS_TMP)
205
    return QEMACS_TMP;
206
  if (atom == dpyinfo->Xatom_TARGETS)
207
    return QTARGETS;
208
  if (atom == dpyinfo->Xatom_NULL)
209
    return QNULL;
Richard M. Stallman's avatar
Richard M. Stallman committed
210 211 212 213 214 215 216 217 218 219

  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;
220
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
221 222 223 224
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
225

Richard M. Stallman's avatar
Richard M. Stallman committed
226 227 228 229 230 231 232 233 234
/* 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;
{
  Window selecting_window = FRAME_X_WINDOW (selected_frame);
235
  Display *display = FRAME_X_DISPLAY (selected_frame);
236
  Time time = last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
237
  Atom selection_atom;
238
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
Richard M. Stallman's avatar
Richard M. Stallman committed
239 240

  CHECK_SYMBOL (selection_name, 0);
241
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
242 243

  BLOCK_INPUT;
244
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
245
  XSetSelectionOwner (display, selection_atom, selecting_window, time);
246 247
  x_check_errors (display, "Can't set selection: %s");
  x_uncatch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
248 249 250 251 252 253 254 255 256 257 258
  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,
259 260
				   Fcons (selection_time,
					  Fcons (Fselected_frame (), Qnil))));
Richard M. Stallman's avatar
Richard M. Stallman committed
261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284
    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
285
   and for local x-get-selection-internal.
Richard M. Stallman's avatar
Richard M. Stallman committed
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321

   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)
    {
322 323
      Lisp_Object pairs;
      int size;
Richard M. Stallman's avatar
Richard M. Stallman committed
324
      int i;
325 326
      pairs = XCONS (target_type)->cdr;
      size = XVECTOR (pairs)->size;
Richard M. Stallman's avatar
Richard M. Stallman committed
327 328 329 330 331 332 333
      /* 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++)
	{
334 335
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
Richard M. Stallman's avatar
Richard M. Stallman committed
336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352
	  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));
353 354 355 356 357 358
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
		       selection_symbol, target_type,
		       XCONS (XCONS (local_value)->cdr)->car);
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
359 360 361 362 363
      unbind_to (count, Qnil);
    }

  /* Make sure this value is of a type that we could transmit
     to another X client.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
364

Richard M. Stallman's avatar
Richard M. Stallman committed
365 366 367 368 369 370 371 372 373
  check = value;
  if (CONSP (value)
      && SYMBOLP (XCONS (value)->car))
    type = XCONS (value)->car,
    check = XCONS (value)->cdr;
  
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
374
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
375 376
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
377
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
378
  else if (CONSP (check)
379 380
	   && INTEGERP (XCONS (check)->car)
	   && (INTEGERP (XCONS (check)->cdr)
Richard M. Stallman's avatar
Richard M. Stallman committed
381 382
	       ||
	       (CONSP (XCONS (check)->cdr)
383
		&& INTEGERP (XCONS (XCONS (check)->cdr)->car)
Richard M. Stallman's avatar
Richard M. Stallman committed
384 385 386 387 388
		&& NILP (XCONS (XCONS (check)->cdr)->cdr))))
    return value;
  else
    return
      Fsignal (Qerror,
Richard M. Stallman's avatar
Richard M. Stallman committed
389
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
Richard M. Stallman's avatar
Richard M. Stallman committed
390 391 392 393 394
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

395
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
396 397 398 399 400 401 402 403 404
   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);
405
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
406 407 408 409 410 411
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = None;

  BLOCK_INPUT;
412
  XSendEvent (reply.display, reply.requestor, False, 0L,
413
	      (XEvent *) &reply);
414
  XFlush (reply.display);
Richard M. Stallman's avatar
Richard M. Stallman committed
415 416 417 418 419 420 421 422
  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
423
   an error, we tell the requester that we were unable to do what they wanted
Richard M. Stallman's avatar
Richard M. Stallman committed
424 425 426 427 428 429 430 431 432 433 434
   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;
}

435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464

/* 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;
465 466 467 468 469 470 471 472 473

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));
474
  return Qnil;
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493
}

/* 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;
}
494

Richard M. Stallman's avatar
Richard M. Stallman committed
495 496 497 498 499 500 501 502 503 504 505 506 507 508
/* 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);
509
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
510 511 512
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
513
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
514 515 516 517 518 519

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  reply.type = SelectionNotify;
  reply.display = display;
520
  reply.requestor = window;
Richard M. Stallman's avatar
Richard M. Stallman committed
521 522 523 524 525 526 527 528
  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! */
529 530
  BLOCK_INPUT;
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
531 532 533 534 535 536 537 538 539 540 541 542 543 544

  /* 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.  */
545
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
Richard M. Stallman's avatar
Richard M. Stallman committed
546 547 548 549
    }
  else
    {
      /* Send an INCR selection.  */
550
      struct prop_location *wait_object;
551
      int had_errors;
552 553
      int count = specpdl_ptr - specpdl;
      Lisp_Object frame;
Richard M. Stallman's avatar
Richard M. Stallman committed
554

555 556 557 558 559 560 561 562 563 564 565 566
      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);
	}
567

568
      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
569
	error ("Attempt to transfer an INCR to ourself!");
Richard M. Stallman's avatar
Richard M. Stallman committed
570 571 572
#if 0
      fprintf (stderr, "\nINCR %d\n", bytes_remaining);
#endif
573 574
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
575

576
      XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
577 578
		       32, PropModeReplace,
		       (unsigned char *) &bytes_remaining, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
579 580
      XSelectInput (display, window, PropertyChangeMask);
      /* Tell 'em the INCR data is there...  */
581
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
582
      XFlush (display);
583 584

      had_errors = x_had_errors_p (display);
585
      UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
586

587
      /* First, wait for the requester to ack by deleting the property.
Richard M. Stallman's avatar
Richard M. Stallman committed
588
	 This can run random lisp code (process handlers) or signal.  */
589 590
      if (! had_errors)
	wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
591 592 593 594 595 596

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

	  BLOCK_INPUT;

600 601 602
	  wait_object
	    = expect_property_change (display, window, reply.property,
				      PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
603 604 605 606 607 608 609 610
#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;
611
	  XFlush (display);
612
	  had_errors = x_had_errors_p (display);
613
	  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
614

615 616 617
	  if (had_errors)
	    break;

618
	  /* Now wait for the requester to ack this chunk by deleting the
Richard M. Stallman's avatar
Richard M. Stallman committed
619 620
	     property.	 This can run random lisp code or signal.
	   */
621
	  wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
622
	}
623
      /* Now write a zero-length chunk to the property to tell the requester
Richard M. Stallman's avatar
Richard M. Stallman committed
624 625 626 627
	 that we're done.  */
#if 0
      fprintf (stderr,"  INCR done\n");
#endif
628
      BLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
629 630 631 632 633
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
634 635

      unbind_to (count, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
636
    }
637 638 639 640

  XFlush (display);
  x_uncatch_errors (display);
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
641 642 643 644 645 646 647 648 649 650
}

/* 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;
651
  Lisp_Object local_selection_data;
Richard M. Stallman's avatar
Richard M. Stallman committed
652
  Lisp_Object selection_symbol;
653 654
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
Richard M. Stallman's avatar
Richard M. Stallman committed
655
  Time local_selection_time;
656
  Lisp_Object successful_p;
Richard M. Stallman's avatar
Richard M. Stallman committed
657
  int count;
658 659
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
Richard M. Stallman's avatar
Richard M. Stallman committed
660

661 662 663 664 665
  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

Richard M. Stallman's avatar
Richard M. Stallman committed
666 667
  GCPRO3 (local_selection_data, converted_selection, target_symbol);

668 669
  selection_symbol = x_atom_to_symbol (dpyinfo,
				       SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685
				       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 (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);

  if (SELECTION_EVENT_TIME (event) != CurrentTime
686
      && local_selection_time > SELECTION_EVENT_TIME (event))
Richard M. Stallman's avatar
Richard M. Stallman committed
687 688 689 690 691 692 693 694 695 696 697 698
    {
      /* 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);

699
  target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717
				    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;
718 719
      int nofree;

720 721
      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
722
				   &data, &type, &size, &format, &nofree);
Richard M. Stallman's avatar
Richard M. Stallman committed
723 724 725 726 727
      
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

      /* Indicate we have successfully processed this event.  */
728
      x_selection_current_request = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
729

Richard M. Stallman's avatar
Richard M. Stallman committed
730
      /* Use free, not XFree, because lisp_data_to_selection_data
731
	 calls xmalloc itself.  */
732
      if (!nofree)
Richard M. Stallman's avatar
Richard M. Stallman committed
733
	free (data);
Richard M. Stallman's avatar
Richard M. Stallman committed
734 735 736 737 738 739 740 741 742
    }
  unbind_to (count, Qnil);

 DONE:

  UNGCPRO;

  /* Let random lisp code notice that the selection has been asked for.  */
  {
743 744
    Lisp_Object rest;
    rest = Vx_sent_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764
    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;
765
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
766

767
  selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
Richard M. Stallman's avatar
Richard M. Stallman committed
768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803

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

  {
804 805
    Lisp_Object rest;
    rest = Vx_lost_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
806
    if (!EQ (rest, Qunbound))
807 808 809
      {
	for (; CONSP (rest); rest = Fcdr (rest))
	  call1 (Fcar (rest), selection_symbol);
810
	prepare_menu_bars ();
811 812
	redisplay_preserve_echo_area ();
      }
Richard M. Stallman's avatar
Richard M. Stallman committed
813 814 815
  }
}

816 817 818 819 820 821 822 823 824 825
/* 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;

826
  XSETFRAME (frame, f);
827 828 829 830

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

831 832 833 834 835 836 837 838 839 840 841 842 843 844
  /* 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);
845 846 847
#if 0 /* This can crash when deleting a frame
	 from x_connection_closed.  Anyway, it seems unnecessary;
	 something else should cause a redisplay.  */
848
	  redisplay_preserve_echo_area ();
849
#endif
850 851 852 853 854 855
	}

      Vselection_alist = Fcdr (Vselection_alist);
    }

  /* Delete elements after the beginning of Vselection_alist.  */
856 857 858 859 860 861 862
  for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
    if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
      {
	/* Let random Lisp code notice that the selection has been stolen.  */
	Lisp_Object hooks, selection_symbol;

	hooks = Vx_lost_selection_hooks;
863
	selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
864 865 866 867 868

	if (!EQ (hooks, Qunbound))
	  {
	    for (; CONSP (hooks); hooks = Fcdr (hooks))
	      call1 (Fcar (hooks), selection_symbol);
869
#if 0 /* See above */
870
	    redisplay_preserve_echo_area ();
871
#endif
872 873 874 875 876
	  }
	XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
	break;
      }
}
Richard M. Stallman's avatar
Richard M. Stallman committed
877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899

/* 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.  */

900
static struct prop_location *
Richard M. Stallman's avatar
Richard M. Stallman committed
901 902 903
expect_property_change (display, window, property, state)
     Display *display;
     Window window;
904
     Atom property;
Richard M. Stallman's avatar
Richard M. Stallman committed
905 906 907 908
     int state;
{
  struct prop_location *pl
    = (struct prop_location *) xmalloc (sizeof (struct prop_location));
909
  pl->identifier = ++prop_location_identifier;
Richard M. Stallman's avatar
Richard M. Stallman committed
910 911 912 913 914
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
915
  pl->arrived = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
916
  property_change_wait_list = pl;
917
  return pl;
Richard M. Stallman's avatar
Richard M. Stallman committed
918 919 920
}

/* Delete an entry from the list of property changes we are waiting for.
921
   IDENTIFIER is the number that uniquely identifies the entry.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
922 923

static void
924 925
unexpect_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
926 927 928 929
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
930
      if (rest == location)
Richard M. Stallman's avatar
Richard M. Stallman committed
931 932 933 934 935
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
Richard M. Stallman's avatar
Richard M. Stallman committed
936
	  free (rest);
Richard M. Stallman's avatar
Richard M. Stallman committed
937 938 939 940 941 942 943
	  return;
	}
      prev = rest;
      rest = rest->next;
    }
}

944 945 946 947 948 949
/* Remove the property change expectation element for IDENTIFIER.  */

static Lisp_Object
wait_for_property_change_unwind (identifierval)
     Lisp_Object identifierval;
{
950 951 952
  unexpect_property_change ((struct prop_location *)
			    (XFASTINT (XCONS (identifierval)->car) << 16
			     | XFASTINT (XCONS (identifierval)->cdr)));
953
  return Qnil;
954 955
}

Richard M. Stallman's avatar
Richard M. Stallman committed
956
/* Actually wait for a property change.
957
   IDENTIFIER should be the value that expect_property_change returned.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
958 959

static void
960 961
wait_for_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
962
{
963 964
  int secs, usecs;
  int count = specpdl_ptr - specpdl;
965 966
  Lisp_Object tem;

967 968 969
  tem = Fcons (Qnil, Qnil);
  XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
  XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
970 971

  /* Make sure to do unexpect_property_change if we quit or err.  */
972
  record_unwind_protect (wait_for_property_change_unwind, tem);
973

Richard M. Stallman's avatar
Richard M. Stallman committed
974
  XCONS (property_change_reply)->car = Qnil;
975

976 977 978
  property_change_reply_object = location;
  /* If the event we are waiting for arrives beyond here, it will set
     property_change_reply, because property_change_reply_object says so.  */
979 980 981 982 983 984 985
  if (! location->arrived)
    {
      secs = x_selection_timeout / 1000;
      usecs = (x_selection_timeout % 1000) * 1000;
      wait_reading_process_input (secs, usecs, property_change_reply, 0);

      if (NILP (XCONS (property_change_reply)->car))
986
	error ("Timed out waiting for property-notify event");
987
    }
988 989

  unbind_to (count, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008
}

/* 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"),
1009
		   (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
Richard M. Stallman's avatar
Richard M. Stallman committed
1010 1011 1012 1013
						       event->atom))
		   ->name->data);
#endif

1014 1015
	  rest->arrived = 1;

Richard M. Stallman's avatar
Richard M. Stallman committed
1016 1017
	  /* If this is the one wait_for_property_change is waiting for,
	     tell it to wake up.  */
1018
	  if (rest == property_change_reply_object)
Richard M. Stallman's avatar
Richard M. Stallman committed
1019 1020 1021 1022 1023 1024
	    XCONS (property_change_reply)->car = Qt;

	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
Richard M. Stallman's avatar
Richard M. Stallman committed
1025
	  free (rest);
Richard M. Stallman's avatar
Richard M. Stallman committed
1026 1027 1028 1029 1030 1031 1032 1033
	  return;
	}
      prev = rest;
      rest = rest->next;
    }
#if 0
  fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
	   (event->state == PropertyDelete ? "delete" : "change"),
1034 1035
	   (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
					       event->display, event->atom))
Richard M. Stallman's avatar
Richard M. Stallman committed
1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048
	   ->name->data);
#endif
}



#if 0 /* #### MULTIPLE doesn't work yet */

static Lisp_Object
fetch_multiple_target (event)
     XSelectionRequestEvent *event;
{
  Display *display = event->display;
1049
  Window window = event->requestor;
Richard M. Stallman's avatar
Richard M. Stallman committed
1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103
  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;
{
1104
  Window requestor_window = FRAME_X_WINDOW (selected_frame);
1105
  Display *display = FRAME_X_DISPLAY (selected_frame);
1106
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1107
  Time requestor_time = last_event_timestamp;
1108 1109
  Atom target_property = dpyinfo->Xatom_EMACS_TMP;
  Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
Richard M. Stallman's avatar
Richard M. Stallman committed
1110
  Atom type_atom;
1111
  int secs, usecs;
1112 1113
  int count = specpdl_ptr - specpdl;
  Lisp_Object frame;
Richard M. Stallman's avatar
Richard M. Stallman committed
1114 1115

  if (CONSP (target_type))
1116
    type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
Richard M. Stallman's avatar
Richard M. Stallman committed
1117
  else
1118
    type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
1119 1120

  BLOCK_INPUT;
1121
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
1122
  XConvertSelection (display, selection_atom, type_atom, target_property,
1123
		     requestor_window, requestor_time);
1124
  XFlush (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
1125 1126

  /* Prepare to block until the reply has been read.  */
1127
  reading_selection_window = requestor_window;
Richard M. Stallman's avatar
Richard M. Stallman committed
1128 1129
  reading_which_selection = selection_atom;
  XCONS (reading_selection_reply)->car = Qnil;
1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142

  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);
    }
Richard M. Stallman's avatar
Richard M. Stallman committed
1143 1144
  UNBLOCK_INPUT;

1145 1146 1147 1148
  /* This allows quits.  Also, don't wait forever.  */
  secs = x_selection_timeout / 1000;
  usecs = (x_selection_timeout % 1000) * 1000;
  wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
Richard M. Stallman's avatar
Richard M. Stallman committed
1149

1150
  BLOCK_INPUT;
1151 1152
  x_check_errors (display, "Cannot get selection: %s");
  x_uncatch_errors (display);
1153
  unbind_to (count, Qnil);
1154 1155
  UNBLOCK_INPUT;

Richard M. Stallman's avatar
Richard M. Stallman committed
1156
  if (NILP (XCONS (reading_selection_reply)->car))
1157 1158 1159
    error ("Timed out waiting for reply from selection owner");
  if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
    error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
Richard M. Stallman's avatar
Richard M. Stallman committed
1160 1161 1162

  /* Otherwise, the selection is waiting for us on the requested property.  */
  return
1163
    x_get_window_property_as_lisp_data (display, requestor_window,
Richard M. Stallman's avatar
Richard M. Stallman committed
1164 1165 1166 1167 1168 1169
					target_property, target_type,
					selection_atom);
}

/* Subroutines of x_get_window_property_as_lisp_data */

Richard M. Stallman's avatar
Richard M. Stallman committed