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

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

Jim Blandy's avatar
Jim Blandy committed
22

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

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

37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
struct prop_location;

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


/* Printing traces to stderr.  */

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


Richard M. Stallman's avatar
Richard M. Stallman committed
92 93 94 95 96 97
#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
98 99
Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */

100
Lisp_Object Qcompound_text_with_extensions;
101

Richard M. Stallman's avatar
Richard M. Stallman committed
102 103 104 105 106
#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#endif

107 108
static Lisp_Object Vx_lost_selection_hooks;
static Lisp_Object Vx_sent_selection_hooks;
109 110
/* Coding system for communicating with other X clients via cutbuffer,
   selection, and clipboard.  */
111
static Lisp_Object Vselection_coding_system;
Richard M. Stallman's avatar
Richard M. Stallman committed
112

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

Richard M. Stallman's avatar
Richard M. Stallman committed
116 117 118 119 120
/* 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
121
   incremental transfer stuff, but it might improve server performance.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
122 123
#define MAX_SELECTION_QUANTUM 0xFFFFFF

124 125 126 127 128
#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
129

130
/* The timestamp of the last input event Emacs received from the X server.  */
131 132
/* Defined in keyboard.c.  */
extern unsigned long last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
133 134

/* This is an association list whose elements are of the form
135 136 137
     ( 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
138
     It may be any kind of Lisp object.
139
   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
Richard M. Stallman's avatar
Richard M. Stallman committed
140
     as a cons of two 16-bit numbers (making a 32 bit time.)
141 142
   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
143 144
    that selection.
   The only (eq) parts of this list that are visible from Lisp are the
145 146
    selection-values.  */
static Lisp_Object Vselection_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
147 148 149 150 151

/* 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
152 153
   selection handling.  */
static Lisp_Object Vselection_converter_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
154 155

/* If the selection owner takes too long to reply to a selection request,
156 157
   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
158 159 160 161 162 163 164 165 166 167 168

/* 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
169 170
symbol_to_x_atom (dpyinfo, display, sym)
     struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
171 172 173 174 175 176 177 178 179 180
     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;
181 182 183
  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
184
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
185 186 187 188 189 190
  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
191 192 193 194 195 196 197 198 199 200 201 202
#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 ();

203
  TRACE1 (" XInternAtom %s", (char *) XSYMBOL (sym)->name->data);
Richard M. Stallman's avatar
Richard M. Stallman committed
204 205 206 207 208 209 210 211 212 213 214
  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
215 216
x_atom_to_symbol (dpy, atom)
     Display *dpy;
Richard M. Stallman's avatar
Richard M. Stallman committed
217 218
     Atom atom;
{
219
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
220 221
  char *str;
  Lisp_Object val;
222 223 224 225
  
  if (! atom)
    return Qnil;
  
226 227 228 229 230 231 232 233 234 235 236 237
  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
238
#ifdef CUT_BUFFER_SUPPORT
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254
    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
255
#endif
256 257
    }

258
  dpyinfo = x_display_info_for_display (dpy);
259
  if (atom == dpyinfo->Xatom_CLIPBOARD)
260
    return QCLIPBOARD;
261
  if (atom == dpyinfo->Xatom_TIMESTAMP)
262
    return QTIMESTAMP;
263
  if (atom == dpyinfo->Xatom_TEXT)
264
    return QTEXT;
Karl Heuer's avatar
Karl Heuer committed
265 266
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
267
  if (atom == dpyinfo->Xatom_DELETE)
268
    return QDELETE;
269
  if (atom == dpyinfo->Xatom_MULTIPLE)
270
    return QMULTIPLE;
271
  if (atom == dpyinfo->Xatom_INCR)
272
    return QINCR;
273
  if (atom == dpyinfo->Xatom_EMACS_TMP)
274
    return QEMACS_TMP;
275
  if (atom == dpyinfo->Xatom_TARGETS)
276
    return QTARGETS;
277
  if (atom == dpyinfo->Xatom_NULL)
278
    return QNULL;
Richard M. Stallman's avatar
Richard M. Stallman committed
279 280

  BLOCK_INPUT;
281
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
282
  UNBLOCK_INPUT;
283
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
284 285 286
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
287
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
288 289 290 291
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
292

Richard M. Stallman's avatar
Richard M. Stallman committed
293 294 295 296 297 298 299 300
/* 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;
{
301 302 303
  struct frame *sf = SELECTED_FRAME ();
  Window selecting_window = FRAME_X_WINDOW (sf);
  Display *display = FRAME_X_DISPLAY (sf);
304
  Time time = last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
305
  Atom selection_atom;
306
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
307
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
308

309
  CHECK_SYMBOL (selection_name);
310
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
311 312

  BLOCK_INPUT;
313
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
314
  XSetSelectionOwner (display, selection_atom, selecting_window, time);
315
  x_check_errors (display, "Can't set selection: %s");
316
  x_uncatch_errors (display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319 320 321 322 323 324 325 326 327
  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,
328
				   Fcons (selection_time,
329
					  Fcons (selected_frame, Qnil))));
Richard M. Stallman's avatar
Richard M. Stallman committed
330 331 332 333 334 335 336 337 338 339 340
    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))
341
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
342
	    {
343
	      XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
344 345 346 347 348 349 350 351 352 353
	      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
354
   and for local x-get-selection-internal.
Richard M. Stallman's avatar
Richard M. Stallman committed
355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373

   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;
374
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
375 376 377 378 379 380 381
    }
#if 0
  else if (EQ (target_type, QDELETE))
    {
      handler_fn = Qnil;
      Fx_disown_selection_internal
	(selection_symbol,
382
	 XCAR (XCDR (XCDR (local_value))));
Richard M. Stallman's avatar
Richard M. Stallman committed
383 384 385 386 387 388
      value = QNULL;
    }
#endif

#if 0 /* #### MULTIPLE doesn't work yet */
  else if (CONSP (target_type)
389
	   && XCAR (target_type) == QMULTIPLE)
Richard M. Stallman's avatar
Richard M. Stallman committed
390
    {
391 392
      Lisp_Object pairs;
      int size;
Richard M. Stallman's avatar
Richard M. Stallman committed
393
      int i;
394
      pairs = XCDR (target_type);
395
      size = XVECTOR (pairs)->size;
Richard M. Stallman's avatar
Richard M. Stallman committed
396 397 398 399 400 401 402
      /* 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++)
	{
403 404
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
Richard M. Stallman's avatar
Richard M. Stallman committed
405 406 407 408 409 410 411 412 413 414 415 416 417 418 419
	  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);

420
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
421
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
422 423 424
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
		       selection_symbol, target_type,
425
		       XCAR (XCDR (local_value)));
426 427
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
428 429 430 431 432
      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
433

Richard M. Stallman's avatar
Richard M. Stallman committed
434 435
  check = value;
  if (CONSP (value)
436 437 438
      && SYMBOLP (XCAR (value)))
    type = XCAR (value),
    check = XCDR (value);
Richard M. Stallman's avatar
Richard M. Stallman committed
439 440 441 442
  
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
443
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
444 445
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
446
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
447
  else if (CONSP (check)
448 449
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
450
	       ||
451 452 453
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
454 455 456 457
    return value;
  else
    return
      Fsignal (Qerror,
Richard M. Stallman's avatar
Richard M. Stallman committed
458
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
Richard M. Stallman's avatar
Richard M. Stallman committed
459 460 461 462 463
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

464
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
465 466 467 468 469 470 471
   meaning we were unable to do what they wanted.  */

static void
x_decline_selection_request (event)
     struct input_event *event;
{
  XSelectionEvent reply;
472 473
  int count;
  
Richard M. Stallman's avatar
Richard M. Stallman committed
474 475
  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
476
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
477 478 479 480 481
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = None;

482 483
  /* The reason for the error may be that the receiver has
     died in the meantime.  Handle that case.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
484
  BLOCK_INPUT;
485 486
  count = x_catch_errors (reply.display);
  XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
487
  XFlush (reply.display);
488
  x_uncatch_errors (reply.display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
489 490 491 492 493 494 495
  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;

496 497 498 499
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

Richard M. Stallman's avatar
Richard M. Stallman committed
500
/* Used as an unwind-protect clause so that, if a selection-converter signals
501
   an error, we tell the requester that we were unable to do what they wanted
Richard M. Stallman's avatar
Richard M. Stallman committed
502 503 504 505 506 507
   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;
{
508 509
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
Richard M. Stallman's avatar
Richard M. Stallman committed
510 511 512 513
    x_decline_selection_request (x_selection_current_request);
  return Qnil;
}

514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543

/* 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;
544 545 546 547 548 549 550 551 552

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));
553
  return Qnil;
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572
}

/* 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;
}
573

Richard M. Stallman's avatar
Richard M. Stallman committed
574 575 576 577 578 579 580 581 582 583 584 585 586 587
/* 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);
588
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
589 590 591
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
592
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
593
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
594 595 596 597 598 599

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  reply.type = SelectionNotify;
  reply.display = display;
600
  reply.requestor = window;
Richard M. Stallman's avatar
Richard M. Stallman committed
601 602 603 604 605 606 607 608
  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! */
609
  BLOCK_INPUT;
610
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
611 612 613 614 615 616 617 618

  /* 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.  */
619
      TRACE1 ("Sending all %d bytes", bytes_remaining);
Richard M. Stallman's avatar
Richard M. Stallman committed
620 621 622
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, size);
      /* At this point, the selection was successfully stored; ack it.  */
623
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
Richard M. Stallman's avatar
Richard M. Stallman committed
624 625 626 627
    }
  else
    {
      /* Send an INCR selection.  */
628
      struct prop_location *wait_object;
629
      int had_errors;
630
      Lisp_Object frame;
Richard M. Stallman's avatar
Richard M. Stallman committed
631

632 633 634 635 636 637 638 639 640 641 642 643
      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);
	}
644

645
      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
646
	error ("Attempt to transfer an INCR to ourself!");
647 648 649
      
      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
650 651
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
652

653 654
      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
655
      XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
656 657
		       32, PropModeReplace,
		       (unsigned char *) &bytes_remaining, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
658
      XSelectInput (display, window, PropertyChangeMask);
659
      
Richard M. Stallman's avatar
Richard M. Stallman committed
660
      /* Tell 'em the INCR data is there...  */
661
      TRACE0 ("Send SelectionNotify event");
662
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
663
      XFlush (display);
664 665

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

668
      /* First, wait for the requester to ack by deleting the property.
Richard M. Stallman's avatar
Richard M. Stallman committed
669
	 This can run random lisp code (process handlers) or signal.  */
670
      if (! had_errors)
671 672 673 674 675
	{
	  TRACE1 ("Waiting for ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_property_change (wait_object);
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
676

677
      TRACE0 ("Got ACK");
Richard M. Stallman's avatar
Richard M. Stallman committed
678 679 680 681 682
      while (bytes_remaining)
	{
	  int i = ((bytes_remaining < max_bytes)
		   ? bytes_remaining
		   : max_bytes);
683 684 685

	  BLOCK_INPUT;

686 687 688
	  wait_object
	    = expect_property_change (display, window, reply.property,
				      PropertyDelete);
689 690 691 692 693

	  TRACE1 ("Sending increment of %d bytes", i);
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));
	  
Richard M. Stallman's avatar
Richard M. Stallman committed
694 695 696 697 698
	  /* 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;
699
	  XFlush (display);
700
	  had_errors = x_had_errors_p (display);
701
	  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
702

703 704 705
	  if (had_errors)
	    break;

706
	  /* Now wait for the requester to ack this chunk by deleting the
707 708 709
	     property.	 This can run random lisp code or signal.  */
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
710
	  wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
711
	}
712 713 714
      
      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
715
      BLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
716 717 718
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

719 720
      TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
	      XGetAtomName (display, reply.property));
Richard M. Stallman's avatar
Richard M. Stallman committed
721 722
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
723
      TRACE0 ("Done sending incrementally");
Richard M. Stallman's avatar
Richard M. Stallman committed
724
    }
725

726 727 728 729 730 731
  /* The window we're communicating with may have been deleted
     in the meantime (that's a real situation from a bug report).
     In this case, there may be events in the event queue still
     refering to the deleted window, and we'll get a BadWindow error
     in XTread_socket when processing the events.  I don't have
     an idea how to fix that.  gerd, 2001-01-98.   */
732
  XFlush (display);
733
  x_uncatch_errors (display, count);
734
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
735 736 737 738 739 740 741 742 743 744
}

/* 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;
745
  Lisp_Object local_selection_data;
Richard M. Stallman's avatar
Richard M. Stallman committed
746
  Lisp_Object selection_symbol;
747 748
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
Richard M. Stallman's avatar
Richard M. Stallman committed
749
  Time local_selection_time;
750
  Lisp_Object successful_p;
Richard M. Stallman's avatar
Richard M. Stallman committed
751
  int count;
752 753
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
Richard M. Stallman's avatar
Richard M. Stallman committed
754

755 756 757 758 759
  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

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

762
  selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
763 764 765 766 767 768 769 770 771 772 773 774 775
				       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)
776
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
777 778

  if (SELECTION_EVENT_TIME (event) != CurrentTime
779
      && local_selection_time > SELECTION_EVENT_TIME (event))
Richard M. Stallman's avatar
Richard M. Stallman committed
780 781 782 783 784 785 786 787 788
    {
      /* Someone asked for the selection, and we have one, but not the one
	 they're looking for.
       */
      x_decline_selection_request (event);
      goto DONE;
    }

  x_selection_current_request = event;
789 790
  count = BINDING_STACK_SIZE ();
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
791 792
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

793
  target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811
				    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;
812 813
      int nofree;

814 815
      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
816
				   &data, &type, &size, &format, &nofree);
Richard M. Stallman's avatar
Richard M. Stallman committed
817 818 819 820 821
      
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

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

824
      /* Use xfree, not XFree, because lisp_data_to_selection_data
825
	 calls xmalloc itself.  */
826
      if (!nofree)
827
	xfree (data);
Richard M. Stallman's avatar
Richard M. Stallman committed
828 829 830 831 832 833 834 835 836
    }
  unbind_to (count, Qnil);

 DONE:

  UNGCPRO;

  /* Let random lisp code notice that the selection has been asked for.  */
  {
837 838
    Lisp_Object rest;
    rest = Vx_sent_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
839 840 841 842 843 844
    if (!EQ (rest, Qunbound))
      for (; CONSP (rest); rest = Fcdr (rest))
	call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
  }
}

845
/* Handle a SelectionClear event EVENT, which indicates that some
Richard M. Stallman's avatar
Richard M. Stallman committed
846 847 848 849 850 851 852 853 854 855 856 857 858
   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;
859
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879
  struct x_display_info *t_dpyinfo;

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

881
  selection_symbol = x_atom_to_symbol (display, selection);
Richard M. Stallman's avatar
Richard M. Stallman committed
882 883 884 885 886 887 888

  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)
889
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907

  /* 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))
908
	if (EQ (local_selection_data, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
909
	  {
910
	    XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
911 912 913 914 915 916 917
	    break;
	  }
    }

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

  {
918 919
    Lisp_Object rest;
    rest = Vx_lost_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
920
    if (!EQ (rest, Qunbound))
921 922 923
      {
	for (; CONSP (rest); rest = Fcdr (rest))
	  call1 (Fcar (rest), selection_symbol);
924
	prepare_menu_bars ();
925
	redisplay_preserve_echo_area (20);
926
      }
Richard M. Stallman's avatar
Richard M. Stallman committed
927 928 929
  }
}

930 931 932 933 934 935 936 937 938 939
/* 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;

940
  XSETFRAME (frame, f);
941 942 943 944

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

945 946 947 948 949 950 951 952 953 954 955 956 957 958
  /* 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);
959 960 961
#if 0 /* This can crash when deleting a frame
	 from x_connection_closed.  Anyway, it seems unnecessary;
	 something else should cause a redisplay.  */
962
	  redisplay_preserve_echo_area (21);
963
#endif
964 965 966 967 968 969
	}

      Vselection_alist = Fcdr (Vselection_alist);
    }

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

	hooks = Vx_lost_selection_hooks;
977
	selection_symbol = Fcar (Fcar (XCDR (rest)));
978 979 980 981 982

	if (!EQ (hooks, Qunbound))
	  {
	    for (; CONSP (hooks); hooks = Fcdr (hooks))
	      call1 (Fcar (hooks), selection_symbol);
983
#if 0 /* See above */
984
	    redisplay_preserve_echo_area (22);
985
#endif
986
	  }
987
	XSETCDR (rest, Fcdr (XCDR (rest)));
988 989 990
	break;
      }
}
Richard M. Stallman's avatar
Richard M. Stallman committed
991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013

/* 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.  */

1014
static struct prop_location *
Richard M. Stallman's avatar
Richard M. Stallman committed
1015 1016 1017
expect_property_change (display, window, property, state)
     Display *display;
     Window window;
1018
     Atom property;
Richard M. Stallman's avatar
Richard M. Stallman committed
1019 1020
     int state;
{
1021
  struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1022
  pl->identifier = ++prop_location_identifier;
Richard M. Stallman's avatar
Richard M. Stallman committed
1023 1024 1025 1026 1027
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
1028
  pl->arrived = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
1029
  property_change_wait_list = pl;
1030
  return pl;
Richard M. Stallman's avatar
Richard M. Stallman committed
1031 1032 1033
}

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

static void
1037 1038
unexpect_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
1039 1040 1041 1042
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
1043
      if (rest == location)
Richard M. Stallman's avatar
Richard M. Stallman committed
1044 1045 1046 1047 1048
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
1049
	  xfree (rest);
Richard M. Stallman's avatar
Richard M. Stallman committed
1050 1051 1052 1053 1054 1055 1056
	  return;
	}
      prev = rest;
      rest = rest->next;
    }
}

1057 1058 1059 1060 1061 1062
/* Remove the property change expectation element for IDENTIFIER.  */

static Lisp_Object
wait_for_property_change_unwind (identifierval)
     Lisp_Object identifierval;
{
1063
  unexpect_property_change ((struct prop_location *)
1064 1065
			    (XFASTINT (XCAR (identifierval)) << 16
			     | XFASTINT (XCDR (identifierval))));
1066
  return Qnil;
1067 1068
}

Richard M. Stallman's avatar
Richard M. Stallman committed
1069
/* Actually wait for a property change.
1070
   IDENTIFIER should be the value that expect_property_change returned.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
1071 1072

static void
1073 1074
wait_for_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
1075
{
1076 1077
  int secs, usecs;
  int count = specpdl_ptr - specpdl;
1078 1079
  Lisp_Object tem;

1080
  tem = Fcons (Qnil, Qnil);
1081 1082
  XSETCARFASTINT (tem, (EMACS_UINT)location >> 16);
  XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);
1083 1084

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

1087
  XSETCAR (property_change_reply, Qnil);
1088

1089 1090 1091
  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.  */
1092 1093 1094 1095
  if (! location->arrived)
    {
      secs = x_selection_timeout / 1000;
      usecs = (x_selection_timeout % 1000) * 1000;
1096
      TRACE2 ("  Waiting %d secs, %d usecs", secs, usecs);
1097 1098
      wait_reading_process_input (secs, usecs, property_change_reply, 0);

1099
      if (NILP (XCAR (property_change_reply)))
1100 1101 1102 1103
	{
	  TRACE0 ("  Timed out");
	  error ("Timed out waiting for property-notify event");
	}
1104
    }
1105 1106

  unbind_to (count, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
1107 1108 1109 1110 1111 1112 1113 1114 1115
}

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

Richard M. Stallman's avatar
Richard M. Stallman committed
1117 1118 1119 1120 1121 1122 1123
  while (rest)
    {
      if (rest->property == event->atom
	  && rest->window == event->window
	  && rest->display == event->display
	  && rest->desired_state == event->state)
	{
1124 1125 1126
	  TRACE2 ("Expected %s of property %s",
		  (event->state == PropertyDelete ? "deletion" : "change"),
		  XGetAtomName (event->display, event->atom));
Richard M. Stallman's avatar
Richard M. Stallman committed
1127

1128 1129
	  rest->arrived = 1;

Richard M. Stallman's avatar
Richard M. Stallman committed
1130 1131
	  /* If this is the one wait_for_property_change is waiting for,
	     tell it to wake up.  */
1132
	  if (rest == property_change_reply_object)
1133
	    XSETCAR (property_change_reply, Qt);
Richard M. Stallman's avatar
Richard M. Stallman committed
1134 1135 1136 1137 1138

	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
1139
	  xfree (rest);
Richard M. Stallman's avatar
Richard M. Stallman committed
1140 1141
	  return;
	}
1142
      
Richard M. Stallman's avatar
Richard M. Stallman committed
1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156
      prev = rest;
      rest = rest->next;
    }
}


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

static Lisp_Object
fetch_multiple_target (event)
     XSelectionRequestEvent *event;
{
  Display *display = event->display;
1157
  Window window = event->requestor;
Richard M. Stallman's avatar
Richard M. Stallman committed
1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175
  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))
1176
    return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));