xselect.c 74.1 KB
Newer Older
1
/* X Selection processing for Emacs.
2
   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
3
   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"
Andreas Schwab's avatar
Andreas Schwab committed
32
#include "process.h"
33

34 35 36 37 38 39
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));
Kenichi Handa's avatar
Kenichi Handa committed
40
static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
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
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
89 90 91 92 93 94
#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
95
Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */
Kenichi Handa's avatar
Kenichi Handa committed
96
Lisp_Object QUTF8_STRING;	/* This is a type of selection.  */
Karl Heuer's avatar
Karl Heuer committed
97

98
Lisp_Object Qcompound_text_with_extensions;
99

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

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

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

114 115
static Lisp_Object Qforeign_selection;

Richard M. Stallman's avatar
Richard M. Stallman committed
116 117 118
/* 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
119
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
120
   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

/* 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
150
   call to convert the given Emacs selection value to a string representing
Richard M. Stallman's avatar
Richard M. Stallman committed
151
   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
   we give up on it.  This is in milliseconds (0 = no timeout.)  */
157
static EMACS_INT x_selection_timeout;
Richard M. Stallman's avatar
Richard M. Stallman committed
158 159 160 161 162 163 164

/* 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 ();

165
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
166 167 168
   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;
Kenichi Handa's avatar
Kenichi Handa committed
185
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
186 187 188 189 190 191
  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
192 193 194 195 196 197 198 199 200 201 202 203
#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 ();

204
  TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
Richard M. Stallman's avatar
Richard M. Stallman committed
205
  BLOCK_INPUT;
206
  val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
Richard M. Stallman's avatar
Richard M. Stallman committed
207 208 209 210 211 212 213 214 215
  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
216 217
x_atom_to_symbol (dpy, atom)
     Display *dpy;
Richard M. Stallman's avatar
Richard M. Stallman committed
218 219
     Atom atom;
{
220
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
221 222
  char *str;
  Lisp_Object val;
223

224 225
  if (! atom)
    return Qnil;
226

227 228 229 230 231 232 233 234 235 236 237 238
  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
239
#ifdef CUT_BUFFER_SUPPORT
240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255
    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
256
#endif
257 258
    }

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

  BLOCK_INPUT;
284
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
285
  UNBLOCK_INPUT;
286
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
287 288 289
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
290
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292 293 294
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
295

Richard M. Stallman's avatar
Richard M. Stallman committed
296
/* Do protocol to assert ourself as a selection owner.
297
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
298 299 300 301 302 303
   our selection.  */

static void
x_own_selection (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;
{
304 305 306
  struct frame *sf = SELECTED_FRAME ();
  Window selecting_window = FRAME_X_WINDOW (sf);
  Display *display = FRAME_X_DISPLAY (sf);
307
  Time time = last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
308
  Atom selection_atom;
309
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
310
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
311

312
  CHECK_SYMBOL (selection_name);
313
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
314 315

  BLOCK_INPUT;
316
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
317
  XSetSelectionOwner (display, selection_atom, selecting_window, time);
318
  x_check_errors (display, "Can't set selection: %s");
319
  x_uncatch_errors (display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
320 321 322 323 324 325 326 327 328 329 330
  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,
331
				   Fcons (selection_time,
332
					  Fcons (selected_frame, Qnil))));
Richard M. Stallman's avatar
Richard M. Stallman committed
333 334 335 336 337 338 339 340 341 342 343
    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))
344
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
345
	    {
346
	      XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
347 348 349 350 351 352 353 354 355
	      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.
Kenichi Handa's avatar
Kenichi Handa committed
356 357
   This function is used both for remote requests (LOCAL_REQUEST is zero)
   and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
Richard M. Stallman's avatar
Richard M. Stallman committed
358 359 360 361

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

static Lisp_Object
Kenichi Handa's avatar
Kenichi Handa committed
362
x_get_local_selection (selection_symbol, target_type, local_request)
Richard M. Stallman's avatar
Richard M. Stallman committed
363
     Lisp_Object selection_symbol, target_type;
Kenichi Handa's avatar
Kenichi Handa committed
364
     int local_request;
Richard M. Stallman's avatar
Richard M. Stallman committed
365 366 367 368 369 370 371 372 373 374 375 376 377
{
  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;
378
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
379 380 381 382 383 384 385
    }
#if 0
  else if (EQ (target_type, QDELETE))
    {
      handler_fn = Qnil;
      Fx_disown_selection_internal
	(selection_symbol,
386
	 XCAR (XCDR (XCDR (local_value))));
Richard M. Stallman's avatar
Richard M. Stallman committed
387 388 389 390 391 392
      value = QNULL;
    }
#endif

#if 0 /* #### MULTIPLE doesn't work yet */
  else if (CONSP (target_type)
393
	   && XCAR (target_type) == QMULTIPLE)
Richard M. Stallman's avatar
Richard M. Stallman committed
394
    {
395 396
      Lisp_Object pairs;
      int size;
Richard M. Stallman's avatar
Richard M. Stallman committed
397
      int i;
398
      pairs = XCDR (target_type);
399
      size = XVECTOR (pairs)->size;
Richard M. Stallman's avatar
Richard M. Stallman committed
400 401 402 403 404 405 406
      /* 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++)
	{
407 408
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
Richard M. Stallman's avatar
Richard M. Stallman committed
409 410
	  XVECTOR (pair)->contents [1]
	    = x_get_local_selection (XVECTOR (pair)->contents [0],
Kenichi Handa's avatar
Kenichi Handa committed
411 412
				     XVECTOR (pair)->contents [1],
				     local_request);
Richard M. Stallman's avatar
Richard M. Stallman committed
413 414 415 416 417 418 419 420 421
	}
      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.  */
Juanma Barranquero's avatar
Juanma Barranquero committed
422
      count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
423 424
      specbind (Qinhibit_quit, Qt);

425
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
426
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
427 428 429
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

430 431
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
Kenichi Handa's avatar
Kenichi Handa committed
432
		       selection_symbol, (local_request ? Qnil : target_type),
433
		       XCAR (XCDR (local_value)));
434 435
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
436 437 438 439 440
      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
441

Richard M. Stallman's avatar
Richard M. Stallman committed
442 443
  check = value;
  if (CONSP (value)
444 445 446
      && SYMBOLP (XCAR (value)))
    type = XCAR (value),
    check = XCDR (value);
447

Richard M. Stallman's avatar
Richard M. Stallman committed
448 449 450
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
451
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
452 453
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
454
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
455
  else if (CONSP (check)
456 457
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
458
	       ||
459 460 461
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
462 463 464 465
    return value;
  else
    return
      Fsignal (Qerror,
Richard M. Stallman's avatar
Richard M. Stallman committed
466
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
Richard M. Stallman's avatar
Richard M. Stallman committed
467 468 469 470 471
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

472
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
473 474 475 476 477 478 479
   meaning we were unable to do what they wanted.  */

static void
x_decline_selection_request (event)
     struct input_event *event;
{
  XSelectionEvent reply;
480
  int count;
481

Richard M. Stallman's avatar
Richard M. Stallman committed
482 483
  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
484
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
485 486 487 488 489
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = None;

490 491
  /* 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
492
  BLOCK_INPUT;
493 494
  count = x_catch_errors (reply.display);
  XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
495
  XFlush (reply.display);
496
  x_uncatch_errors (reply.display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
497 498 499 500 501 502 503
  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;

504 505 506 507
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

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

/* 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;
552 553 554 555 556 557 558 559 560

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));
561
  return Qnil;
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580
}

/* 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;
}
581

Richard M. Stallman's avatar
Richard M. Stallman committed
582 583 584 585 586 587 588 589 590 591 592 593 594 595
/* 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);
596
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
597 598 599
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
600
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
601
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
602 603 604 605 606 607

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  reply.type = SelectionNotify;
  reply.display = display;
608
  reply.requestor = window;
Richard M. Stallman's avatar
Richard M. Stallman committed
609 610 611 612 613 614 615 616
  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! */
617
  BLOCK_INPUT;
618
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
619 620 621 622 623 624 625 626

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

640 641 642 643 644 645 646 647 648 649 650 651
      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);
	}
652

653
      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
654
	error ("Attempt to transfer an INCR to ourself!");
655

656 657
      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
658 659
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
660

661 662
      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
663
      XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
664 665
		       32, PropModeReplace,
		       (unsigned char *) &bytes_remaining, 1);
Richard M. Stallman's avatar
Richard M. Stallman committed
666
      XSelectInput (display, window, PropertyChangeMask);
667

Richard M. Stallman's avatar
Richard M. Stallman committed
668
      /* Tell 'em the INCR data is there...  */
669
      TRACE0 ("Send SelectionNotify event");
670
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
671
      XFlush (display);
672 673

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

676
      /* First, wait for the requester to ack by deleting the property.
Richard M. Stallman's avatar
Richard M. Stallman committed
677
	 This can run random lisp code (process handlers) or signal.  */
678
      if (! had_errors)
679 680 681 682 683
	{
	  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
684

685
      TRACE0 ("Got ACK");
Richard M. Stallman's avatar
Richard M. Stallman committed
686 687 688 689 690
      while (bytes_remaining)
	{
	  int i = ((bytes_remaining < max_bytes)
		   ? bytes_remaining
		   : max_bytes);
691 692 693

	  BLOCK_INPUT;

694 695 696
	  wait_object
	    = expect_property_change (display, window, reply.property,
				      PropertyDelete);
697 698 699 700

	  TRACE1 ("Sending increment of %d bytes", i);
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));
701

Richard M. Stallman's avatar
Richard M. Stallman committed
702 703 704 705 706
	  /* 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;
707
	  XFlush (display);
708
	  had_errors = x_had_errors_p (display);
709
	  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
710

711 712 713
	  if (had_errors)
	    break;

714
	  /* Now wait for the requester to ack this chunk by deleting the
715 716 717
	     property.	 This can run random lisp code or signal.  */
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
718
	  wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
719
	}
720

721 722
      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
723
      BLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
724 725 726
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

727 728
      TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
	      XGetAtomName (display, reply.property));
Richard M. Stallman's avatar
Richard M. Stallman committed
729 730
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
731
      TRACE0 ("Done sending incrementally");
Richard M. Stallman's avatar
Richard M. Stallman committed
732
    }
733

Richard M. Stallman's avatar
Richard M. Stallman committed
734
  /* rms, 2003-01-03: I think I have fixed this bug.  */
735 736 737 738 739 740
  /* 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.   */
741
  XFlush (display);
742
  x_uncatch_errors (display, count);
743
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
744 745 746 747 748 749 750 751 752 753
}

/* 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;
754
  Lisp_Object local_selection_data;
Richard M. Stallman's avatar
Richard M. Stallman committed
755
  Lisp_Object selection_symbol;
756 757
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
Richard M. Stallman's avatar
Richard M. Stallman committed
758
  Time local_selection_time;
759
  Lisp_Object successful_p;
Richard M. Stallman's avatar
Richard M. Stallman committed
760
  int count;
761 762
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
Richard M. Stallman's avatar
Richard M. Stallman committed
763

764 765 766 767 768
  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

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

771
  selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
772 773 774 775 776 777 778 779 780 781 782 783 784
				       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)
785
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
786 787

  if (SELECTION_EVENT_TIME (event) != CurrentTime
788
      && local_selection_time > SELECTION_EVENT_TIME (event))
Richard M. Stallman's avatar
Richard M. Stallman committed
789 790 791 792 793 794 795 796 797
    {
      /* 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;
798
  count = SPECPDL_INDEX ();
799
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
800 801
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

802
  target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
803 804 805 806 807 808
				    SELECTION_EVENT_TARGET (event));

#if 0 /* #### MULTIPLE doesn't work yet */
  if (EQ (target_symbol, QMULTIPLE))
    target_symbol = fetch_multiple_target (event);
#endif
809

Richard M. Stallman's avatar
Richard M. Stallman committed
810
  /* Convert lisp objects back into binary data */
811

Richard M. Stallman's avatar
Richard M. Stallman committed
812
  converted_selection
Kenichi Handa's avatar
Kenichi Handa committed
813
    = x_get_local_selection (selection_symbol, target_symbol, 0);
814

Richard M. Stallman's avatar
Richard M. Stallman committed
815 816 817 818 819 820
  if (! NILP (converted_selection))
    {
      unsigned char *data;
      unsigned int size;
      int format;
      Atom type;
821 822
      int nofree;

823 824
      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
825
				   &data, &type, &size, &format, &nofree);
826

Richard M. Stallman's avatar
Richard M. Stallman committed
827 828 829 830
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

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

833
      /* Use xfree, not XFree, because lisp_data_to_selection_data
834
	 calls xmalloc itself.  */
835
      if (!nofree)
836
	xfree (data);
Richard M. Stallman's avatar
Richard M. Stallman committed
837 838 839 840 841 842 843
    }
  unbind_to (count, Qnil);

 DONE:

  /* Let random lisp code notice that the selection has been asked for.  */
  {
844 845
    Lisp_Object rest;
    rest = Vx_sent_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
846 847 848 849
    if (!EQ (rest, Qunbound))
      for (; CONSP (rest); rest = Fcdr (rest))
	call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
  }
850 851

  UNGCPRO;
Richard M. Stallman's avatar
Richard M. Stallman committed
852 853
}

854
/* Handle a SelectionClear event EVENT, which indicates that some
Richard M. Stallman's avatar
Richard M. Stallman committed
855 856 857 858 859 860 861 862 863 864
   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);
865

Richard M. Stallman's avatar
Richard M. Stallman committed
866 867
  Lisp_Object selection_symbol, local_selection_data;
  Time local_selection_time;
868
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888
  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
889

890
  selection_symbol = x_atom_to_symbol (display, selection);
Richard M. Stallman's avatar
Richard M. Stallman committed
891 892 893 894 895 896 897

  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)
898
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916

  /* 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))
917
	if (EQ (local_selection_data, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
918
	  {
919
	    XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
920 921 922 923 924 925 926
	    break;
	  }
    }

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

  {
927 928
    Lisp_Object rest;
    rest = Vx_lost_selection_hooks;
Richard M. Stallman's avatar
Richard M. Stallman committed
929
    if (!EQ (rest, Qunbound))
930 931 932
      {
	for (; CONSP (rest); rest = Fcdr (rest))
	  call1 (Fcar (rest), selection_symbol);
933
	prepare_menu_bars ();
934
	redisplay_preserve_echo_area (20);
935
      }
Richard M. Stallman's avatar
Richard M. Stallman committed
936 937 938
  }
}

939 940 941 942 943 944 945 946 947 948
/* 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;

949
  XSETFRAME (frame, f);
950 951 952 953

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

954 955 956 957 958 959 960 961 962 963 964 965 966 967
  /* 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);
968 969 970
#if 0 /* This can crash when deleting a frame
	 from x_connection_closed.  Anyway, it seems unnecessary;
	 something else should cause a redisplay.  */
971
	  redisplay_preserve_echo_area (21);
972
#endif
973 974 975 976 977 978
	}

      Vselection_alist = Fcdr (Vselection_alist);
    }

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

	hooks = Vx_lost_selection_hooks;
986
	selection_symbol = Fcar (Fcar (XCDR (rest)));
987 988 989 990 991

	if (!EQ (hooks, Qunbound))
	  {
	    for (; CONSP (hooks); hooks = Fcdr (hooks))
	      call1 (Fcar (hooks), selection_symbol);
992
#if 0 /* See above */
993
	    redisplay_preserve_echo_area (22);
994
#endif
995
	  }
996
	XSETCDR (rest, Fcdr (XCDR (rest)));
997 998 999
	break;
      }
}
Richard M. Stallman's avatar
Richard M. Stallman committed
1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022

/* 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.  */

1023
static struct prop_location *
Richard M. Stallman's avatar
Richard M. Stallman committed
1024 1025 1026
expect_property_change (display, window, property, state)
     Display *display;
     Window window;
1027
     Atom property;
Richard M. Stallman's avatar
Richard M. Stallman committed
1028 1029
     int state;
{
1030
  struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1031
  pl->identifier = ++prop_location_identifier;
Richard M. Stallman's avatar
Richard M. Stallman committed
1032 1033 1034 1035 1036
  pl->display = display;
  pl->window = window;
  pl->property = property;
  pl->desired_state = state;
  pl->next = property_change_wait_list;
1037
  pl->arrived = 0;
Richard M. Stallman's avatar
Richard M. Stallman committed
1038
  property_change_wait_list = pl;
1039
  return pl;
Richard M. Stallman's avatar
Richard M. Stallman committed
1040 1041 1042
}

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

static void
1046 1047
unexpect_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
1048 1049 1050 1051
{
  struct prop_location *prev = 0, *rest = property_change_wait_list;
  while (rest)
    {
1052
      if (rest == location)
Richard M. Stallman's avatar
Richard M. Stallman committed
1053 1054 1055 1056 1057
	{
	  if (prev)
	    prev->next = rest->next;
	  else
	    property_change_wait_list = rest->next;
1058
	  xfree (rest);
Richard M. Stallman's avatar
Richard M. Stallman committed
1059 1060 1061 1062 1063 1064 1065
	  return;
	}
      prev = rest;
      rest = rest->next;
    }
}

1066 1067 1068 1069 1070 1071
/* Remove the property change expectation element for IDENTIFIER.  */

static Lisp_Object
wait_for_property_change_unwind (identifierval)
     Lisp_Object identifierval;
{
1072
  unexpect_property_change ((struct prop_location *)
1073 1074
			    (XFASTINT (XCAR (identifierval)) << 16
			     | XFASTINT (XCDR (identifierval))));
1075
  return Qnil;
1076 1077
}

Richard M. Stallman's avatar
Richard M. Stallman committed
1078
/* Actually wait for a property change.
1079
   IDENTIFIER should be the value that expect_property_change returned.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
1080 1081

static void
1082 1083
wait_for_property_change (location)
     struct prop_location *location;
Richard M. Stallman's avatar
Richard M. Stallman committed
1084
{
1085
  int secs, usecs;
Juanma Barranquero's avatar
Juanma Barranquero committed
1086
  int count = SPECPDL_INDEX ();
1087 1088
  Lisp_Object tem;

1089
  tem = Fcons (Qnil, Qnil);
1090 1091
  XSETCARFASTINT (tem, (EMACS_UINT)location >> 16);
  XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);
1092 1093

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