xselect.c 87.3 KB
Newer Older
1
/* X Selection processing for Emacs.
2
   Copyright (C) 1993-1997, 2000-2012 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
3 4 5

This file is part of GNU Emacs.

6
GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
7
it under the terms of the GNU General Public License as published by
8 9
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12 13 14 15 16

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
17
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
18

Jim Blandy's avatar
Jim Blandy committed
19

Richard M. Stallman's avatar
Richard M. Stallman committed
20 21
/* Rewritten by jwz */

22
#include <config.h>
23
#include <limits.h>
Jan Djärv's avatar
Jan Djärv committed
24
#include <stdio.h>      /* termhooks.h needs this */
25
#include <setjmp.h>
26 27 28 29

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
Paul Eggert's avatar
Paul Eggert committed
30

31 32
#include <unistd.h>

Richard M. Stallman's avatar
Richard M. Stallman committed
33 34
#include "lisp.h"
#include "xterm.h"	/* for all of the X includes */
35 36
#include "dispextern.h"	/* frame.h seems to want this */
#include "frame.h"	/* Need this to get the X window of selected_frame */
37
#include "blockinput.h"
Kenichi Handa's avatar
Kenichi Handa committed
38
#include "buffer.h"
Andreas Schwab's avatar
Andreas Schwab committed
39
#include "process.h"
40
#include "termhooks.h"
41
#include "keyboard.h"
42
#include "character.h"
43 44

#include <X11/Xproto.h>
45

46
struct prop_location;
47
struct selection_data;
48

49
static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
Chong Yidong's avatar
Chong Yidong committed
50 51 52 53
static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
					  struct x_display_info *);
54 55 56 57
static void x_decline_selection_request (struct input_event *);
static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
static Lisp_Object x_catch_errors_unwind (Lisp_Object);
58 59
static void x_reply_selection_request (struct input_event *, struct x_display_info *);
static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
Chong Yidong's avatar
Chong Yidong committed
60
				Atom, int, struct x_display_info *);
61 62 63 64 65 66
static int waiting_for_other_props_on_window (Display *, Window);
static struct prop_location *expect_property_change (Display *, Window,
                                                     Atom, int);
static void unexpect_property_change (struct prop_location *);
static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
static void wait_for_property_change (struct prop_location *);
Chong Yidong's avatar
Chong Yidong committed
67 68
static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
					    Lisp_Object, Lisp_Object);
69 70 71
static Lisp_Object x_get_window_property_as_lisp_data (Display *,
                                                       Window, Atom,
                                                       Lisp_Object, Atom);
72 73
static Lisp_Object selection_data_to_lisp_data (Display *,
						const unsigned char *,
74
						ptrdiff_t, Atom, int);
75 76
static void lisp_data_to_selection_data (Display *, Lisp_Object,
                                         unsigned char **, Atom *,
77
					 ptrdiff_t *, int *, int *);
78
static Lisp_Object clean_local_selection_data (Lisp_Object);
79 80 81 82 83 84 85 86 87 88

/* 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)
89 90
#define TRACE3(fmt, a0, a1, a2) \
  fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
91 92 93 94 95 96 97
#else
#define TRACE0(fmt)		(void) 0
#define TRACE1(fmt, a0)		(void) 0
#define TRACE2(fmt, a0, a1)	(void) 0
#endif


98
static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
Richard M. Stallman's avatar
Richard M. Stallman committed
99
  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
Chong Yidong's avatar
Chong Yidong committed
100
  QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;
Richard M. Stallman's avatar
Richard M. Stallman committed
101

102 103
static Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */
static Lisp_Object QUTF8_STRING;	/* This is a type of selection.  */
Karl Heuer's avatar
Karl Heuer committed
104

105
static Lisp_Object Qcompound_text_with_extensions;
106

107
static Lisp_Object Qforeign_selection;
108
static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions;
109

110 111 112 113
/* Bytes needed to represent 'long' data.  This is as per libX11; it
   is not necessarily sizeof (long).  */
#define X_LONG_SIZE 4

114 115 116 117 118
/* Extreme 'short' and 'long' values suitable for libX11.  */
#define X_SHRT_MAX 0x7fff
#define X_SHRT_MIN (-1 - X_SHRT_MAX)
#define X_LONG_MAX 0x7fffffff
#define X_LONG_MIN (-1 - X_LONG_MAX)
119
#define X_ULONG_MAX 0xffffffffUL
120

Richard M. Stallman's avatar
Richard M. Stallman committed
121 122 123
/* 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
124
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
125
   smaller than that, set this.  I added this mostly for debugging the
126 127 128 129 130 131 132 133 134
   incremental transfer stuff, but it might improve server performance.

   This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
   because it is multiplied by X_LONG_SIZE and by sizeof (long) in
   subscript calculations.  Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
   - 1 in place of INT_MAX.  */
#define MAX_SELECTION_QUANTUM						\
  ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1)	\
			 / max (X_LONG_SIZE, sizeof (long)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
135

136 137 138 139 140 141 142 143
static int
selection_quantum (Display *display)
{
  long mrs = XMaxRequestSize (display);
  return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25
	  ? (mrs - 25) * X_LONG_SIZE
	  : MAX_SELECTION_QUANTUM);
}
Richard M. Stallman's avatar
Richard M. Stallman committed
144

Chong Yidong's avatar
Chong Yidong committed
145 146
#define LOCAL_SELECTION(selection_symbol,dpyinfo)			\
  assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
147 148


149 150
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */
151 152 153 154 155 156 157 158 159

struct selection_event_queue
  {
    struct input_event event;
    struct selection_event_queue *next;
  };

static struct selection_event_queue *selection_queue;

160
/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
161 162 163

static int x_queue_selection_requests;

164
/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
165 166

static void
167
x_queue_event (struct input_event *event)
168 169 170
{
  struct selection_event_queue *queue_tmp;

171 172
  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
173 174
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
175
      if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
176
	{
177
	  TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
178
	  x_decline_selection_request (event);
179 180 181 182 183 184 185 186 187
	  return;
	}
    }

  queue_tmp
    = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));

  if (queue_tmp != NULL)
    {
188
      TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
189 190 191 192 193 194
      queue_tmp->event = *event;
      queue_tmp->next = selection_queue;
      selection_queue = queue_tmp;
    }
}

195
/* Start queuing SELECTION_REQUEST_EVENT events.  */
196 197

static void
198
x_start_queuing_selection_requests (void)
199 200 201 202 203 204 205 206
{
  if (x_queue_selection_requests)
    abort ();

  x_queue_selection_requests++;
  TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
}

207
/* Stop queuing SELECTION_REQUEST_EVENT events.  */
208 209

static void
210
x_stop_queuing_selection_requests (void)
211 212 213 214 215 216 217 218 219 220
{
  TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
  --x_queue_selection_requests;

  /* Take all the queued events and put them back
     so that they get processed afresh.  */

  while (selection_queue != NULL)
    {
      struct selection_event_queue *queue_tmp = selection_queue;
221
      TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
222 223 224 225 226 227 228
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
      xfree ((char *)queue_tmp);
    }
}


229
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
230 231 232
   roundtrip whenever possible.  */

static Atom
Chong Yidong's avatar
Chong Yidong committed
233
symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
Richard M. Stallman's avatar
Richard M. Stallman committed
234 235 236 237 238 239 240 241
{
  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;
242 243 244
  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
245
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
246
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
247 248 249 250 251 252
  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
253 254
  if (!SYMBOLP (sym)) abort ();

255
  TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
Richard M. Stallman's avatar
Richard M. Stallman committed
256
  BLOCK_INPUT;
Chong Yidong's avatar
Chong Yidong committed
257
  val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
Richard M. Stallman's avatar
Richard M. Stallman committed
258 259 260 261 262 263 264 265 266
  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
267
x_atom_to_symbol (Display *dpy, Atom atom)
Richard M. Stallman's avatar
Richard M. Stallman committed
268
{
269
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
270 271
  char *str;
  Lisp_Object val;
272

273 274
  if (! atom)
    return Qnil;
275

276 277 278 279 280 281 282 283 284 285 286 287 288 289
  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;
    }

290
  dpyinfo = x_display_info_for_display (dpy);
Chong Yidong's avatar
Chong Yidong committed
291 292
  if (dpyinfo == NULL)
    return Qnil;
293
  if (atom == dpyinfo->Xatom_CLIPBOARD)
294
    return QCLIPBOARD;
295
  if (atom == dpyinfo->Xatom_TIMESTAMP)
296
    return QTIMESTAMP;
297
  if (atom == dpyinfo->Xatom_TEXT)
298
    return QTEXT;
Karl Heuer's avatar
Karl Heuer committed
299 300
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
301 302
  if (atom == dpyinfo->Xatom_UTF8_STRING)
    return QUTF8_STRING;
303
  if (atom == dpyinfo->Xatom_DELETE)
304
    return QDELETE;
305
  if (atom == dpyinfo->Xatom_MULTIPLE)
306
    return QMULTIPLE;
307
  if (atom == dpyinfo->Xatom_INCR)
308
    return QINCR;
309
  if (atom == dpyinfo->Xatom_EMACS_TMP)
310
    return QEMACS_TMP;
311
  if (atom == dpyinfo->Xatom_TARGETS)
312
    return QTARGETS;
313
  if (atom == dpyinfo->Xatom_NULL)
314
    return QNULL;
Richard M. Stallman's avatar
Richard M. Stallman committed
315 316

  BLOCK_INPUT;
317
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
318
  UNBLOCK_INPUT;
319
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
320 321 322
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
323
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
324 325 326 327
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
328

Richard M. Stallman's avatar
Richard M. Stallman committed
329
/* Do protocol to assert ourself as a selection owner.
Chong Yidong's avatar
Chong Yidong committed
330
   FRAME shall be the owner; it must be a valid X frame.
331
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
332 333 334
   our selection.  */

static void
Chong Yidong's avatar
Chong Yidong committed
335 336
x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
		 Lisp_Object frame)
Richard M. Stallman's avatar
Richard M. Stallman committed
337
{
Chong Yidong's avatar
Chong Yidong committed
338 339 340 341
  struct frame *f = XFRAME (frame);
  Window selecting_window = FRAME_X_WINDOW (f);
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
  Display *display = dpyinfo->display;
342
  Time timestamp = last_event_timestamp;
Chong Yidong's avatar
Chong Yidong committed
343
  Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
344 345

  BLOCK_INPUT;
346
  x_catch_errors (display);
347
  XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
348
  x_check_errors (display, "Can't set selection: %s");
349
  x_uncatch_errors ();
Richard M. Stallman's avatar
Richard M. Stallman committed
350 351 352 353 354 355 356
  UNBLOCK_INPUT;

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

357
    selection_data = list4 (selection_name, selection_value,
358
			    INTEGER_TO_CONS (timestamp), frame);
Chong Yidong's avatar
Chong Yidong committed
359
    prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
360

Chong Yidong's avatar
Chong Yidong committed
361 362
    dpyinfo->terminal->Vselection_alist
      = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
Richard M. Stallman's avatar
Richard M. Stallman committed
363

Chong Yidong's avatar
Chong Yidong committed
364 365
    /* If we already owned the selection, remove the old selection
       data.  Don't use Fdelq as that may QUIT.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
366 367
    if (!NILP (prev_value))
      {
Chong Yidong's avatar
Chong Yidong committed
368 369 370
	/* We know it's not the CAR, so it's easy.  */
	Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
	for (; CONSP (rest); rest = XCDR (rest))
371
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
372
	    {
Chong Yidong's avatar
Chong Yidong committed
373
	      XSETCDR (rest, XCDR (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
374 375 376 377 378 379 380 381
	      break;
	    }
      }
  }
}

/* Given a selection-name and desired type, look up our local copy of
   the selection value and convert it to the type.
382 383
   Return nil, a string, a vector, a symbol, an integer, or a cons
   that CONS_TO_INTEGER could plausibly handle.
Kenichi Handa's avatar
Kenichi Handa committed
384 385
   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
386 387 388 389

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

static Lisp_Object
Chong Yidong's avatar
Chong Yidong committed
390 391
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
		       int local_request, struct x_display_info *dpyinfo)
Richard M. Stallman's avatar
Richard M. Stallman committed
392 393
{
  Lisp_Object local_value;
394
  Lisp_Object handler_fn, value, check;
Richard M. Stallman's avatar
Richard M. Stallman committed
395 396
  int count;

Chong Yidong's avatar
Chong Yidong committed
397
  local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
398 399 400

  if (NILP (local_value)) return Qnil;

Chong Yidong's avatar
Chong Yidong committed
401
  /* TIMESTAMP is a special case.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
402 403 404
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
405
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
406 407 408 409 410 411
    }
  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
412
      count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
413 414
      specbind (Qinhibit_quit, Qt);

415
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
416
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
417 418 419
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

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

Richard M. Stallman's avatar
Richard M. Stallman committed
432 433
  check = value;
  if (CONSP (value)
434 435
      && SYMBOLP (XCAR (value)))
    check = XCDR (value);
436

Richard M. Stallman's avatar
Richard M. Stallman committed
437 438 439
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
440
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
441 442
      || NILP (value))
    return value;
443
  /* Check for a value that CONS_TO_INTEGER could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
444
  else if (CONSP (check)
445 446
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
447
	       ||
448 449 450
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
451
    return value;
452 453 454

  signal_error ("Invalid data returned by selection-conversion function",
		list2 (handler_fn, value));
Richard M. Stallman's avatar
Richard M. Stallman committed
455 456 457 458
}

/* Subroutines of x_reply_selection_request.  */

459
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
460 461 462
   meaning we were unable to do what they wanted.  */

static void
463
x_decline_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
464
{
465 466
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
467

468 469 470 471 472 473 474
  reply->type = SelectionNotify;
  reply->display = SELECTION_EVENT_DISPLAY (event);
  reply->requestor = SELECTION_EVENT_REQUESTOR (event);
  reply->selection = SELECTION_EVENT_SELECTION (event);
  reply->time = SELECTION_EVENT_TIME (event);
  reply->target = SELECTION_EVENT_TARGET (event);
  reply->property = None;
Richard M. Stallman's avatar
Richard M. Stallman committed
475

476 477
  /* 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
478
  BLOCK_INPUT;
479 480 481
  x_catch_errors (reply->display);
  XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
  XFlush (reply->display);
482
  x_uncatch_errors ();
Richard M. Stallman's avatar
Richard M. Stallman committed
483 484 485 486 487 488 489
  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;

490 491 492 493
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

494 495 496 497 498
/* Raw selection data, for sending to a requestor window.  */

struct selection_data
{
  unsigned char *data;
499
  ptrdiff_t size;
500 501 502 503 504 505 506 507 508 509 510 511 512
  int format;
  Atom type;
  int nofree;
  Atom property;
  /* This can be set to non-NULL during x_reply_selection_request, if
     the selection is waiting for an INCR transfer to complete.  Don't
     free these; that's done by unexpect_property_change.  */
  struct prop_location *wait_object;
  struct selection_data *next;
};

/* Linked list of the above (in support of MULTIPLE targets).  */

513
static struct selection_data *converted_selections;
514 515

/* "Data" to send a requestor for a failed MULTIPLE subtarget.  */
516
static Atom conversion_fail_tag;
517

Richard M. Stallman's avatar
Richard M. Stallman committed
518
/* Used as an unwind-protect clause so that, if a selection-converter signals
Paul Eggert's avatar
Paul Eggert committed
519
   an error, we tell the requestor that we were unable to do what they wanted
Richard M. Stallman's avatar
Richard M. Stallman committed
520 521 522
   before we throw to top-level or go into the debugger or whatever.  */

static Lisp_Object
523
x_selection_request_lisp_error (Lisp_Object ignore)
Richard M. Stallman's avatar
Richard M. Stallman committed
524
{
525 526 527 528 529 530 531 532 533 534 535
  struct selection_data *cs, *next;

  for (cs = converted_selections; cs; cs = next)
    {
      next = cs->next;
      if (cs->nofree == 0 && cs->data)
	xfree (cs->data);
      xfree (cs);
    }
  converted_selections = NULL;

536 537
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
Richard M. Stallman's avatar
Richard M. Stallman committed
538 539 540
    x_decline_selection_request (x_selection_current_request);
  return Qnil;
}
541 542

static Lisp_Object
543
x_catch_errors_unwind (Lisp_Object dummy)
544 545 546 547
{
  BLOCK_INPUT;
  x_uncatch_errors ();
  UNBLOCK_INPUT;
548
  return Qnil;
549
}
Richard M. Stallman's avatar
Richard M. Stallman committed
550

551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568

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

569 570 571 572
static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state);
static void wait_for_property_change (struct prop_location *location);
static void unexpect_property_change (struct prop_location *location);
static int waiting_for_other_props_on_window (Display *display, Window window);
573 574 575 576 577 578 579 580

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;
581 582

static Lisp_Object
583
queue_selection_requests_unwind (Lisp_Object tem)
584
{
585
  x_stop_queuing_selection_requests ();
586
  return Qnil;
587 588
}

589

590
/* Send the reply to a selection request event EVENT.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
591

592
#ifdef TRACE_SELECTION
593
static int x_reply_selection_request_cnt;
594 595
#endif  /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
596
static void
Juanma Barranquero's avatar
Juanma Barranquero committed
597 598
x_reply_selection_request (struct input_event *event,
                           struct x_display_info *dpyinfo)
Richard M. Stallman's avatar
Richard M. Stallman committed
599
{
600 601
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
Richard M. Stallman's avatar
Richard M. Stallman committed
602
  Display *display = SELECTION_EVENT_DISPLAY (event);
603
  Window window = SELECTION_EVENT_REQUESTOR (event);
604 605
  ptrdiff_t bytes_remaining;
  int max_bytes = selection_quantum (display);
606
  int count = SPECPDL_INDEX ();
607
  struct selection_data *cs;
Richard M. Stallman's avatar
Richard M. Stallman committed
608

609 610 611 612 613 614 615 616 617
  reply->type = SelectionNotify;
  reply->display = display;
  reply->requestor = window;
  reply->selection = SELECTION_EVENT_SELECTION (event);
  reply->time = SELECTION_EVENT_TIME (event);
  reply->target = SELECTION_EVENT_TARGET (event);
  reply->property = SELECTION_EVENT_PROPERTY (event);
  if (reply->property == None)
    reply->property = reply->target;
Richard M. Stallman's avatar
Richard M. Stallman committed
618

619
  BLOCK_INPUT;
620 621 622 623
  /* The protected block contains wait_for_property_change, which can
     run random lisp code (process handlers) or signal.  Therefore, we
     put the x_uncatch_errors call in an unwind.  */
  record_unwind_protect (x_catch_errors_unwind, Qnil);
624
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
625

626 627 628 629 630 631 632
  /* Loop over converted selections, storing them in the requested
     properties.  If data is large, only store the first N bytes
     (section 2.7.2 of ICCCM).  Note that we store the data for a
     MULTIPLE request in the opposite order; the ICCM says only that
     the conversion itself must be done in the same order. */
  for (cs = converted_selections; cs; cs = cs->next)
    {
Chong Yidong's avatar
Chong Yidong committed
633 634 635
      if (cs->property == None)
	continue;

636 637
      bytes_remaining = cs->size;
      bytes_remaining *= cs->format >> 3;
Chong Yidong's avatar
Chong Yidong committed
638
      if (bytes_remaining <= max_bytes)
639
	{
Chong Yidong's avatar
Chong Yidong committed
640
	  /* Send all the data at once, with minimal handshaking.  */
641
	  TRACE1 ("Sending all %"pD"d bytes", bytes_remaining);
Chong Yidong's avatar
Chong Yidong committed
642 643 644 645 646 647 648
	  XChangeProperty (display, window, cs->property,
			   cs->type, cs->format, PropModeReplace,
			   cs->data, cs->size);
	}
      else
	{
	  /* Send an INCR tag to initiate incremental transfer.  */
649
	  long value[1];
Chong Yidong's avatar
Chong Yidong committed
650

651
	  TRACE2 ("Start sending %"pD"d bytes incrementally (%s)",
Chong Yidong's avatar
Chong Yidong committed
652 653 654 655 656 657 658
		  bytes_remaining, XGetAtomName (display, cs->property));
	  cs->wait_object
	    = expect_property_change (display, window, cs->property,
				      PropertyDelete);

	  /* XChangeProperty expects an array of long even if long is
	     more than 32 bits.  */
659
	  value[0] = min (bytes_remaining, X_LONG_MAX);
Chong Yidong's avatar
Chong Yidong committed
660 661 662 663
	  XChangeProperty (display, window, cs->property,
			   dpyinfo->Xatom_INCR, 32, PropModeReplace,
			   (unsigned char *) value, 1);
	  XSelectInput (display, window, PropertyChangeMask);
664 665 666 667 668 669 670
	}
    }

  /* Now issue the SelectionNotify event.  */
  XSendEvent (display, window, False, 0L, &reply_base);
  XFlush (display);

671 672
#ifdef TRACE_SELECTION
  {
673 674
    char *sel = XGetAtomName (display, reply->selection);
    char *tgt = XGetAtomName (display, reply->target);
675 676
    TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
	    sel, tgt, ++x_reply_selection_request_cnt);
677 678 679 680 681
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

682 683 684 685 686 687
  /* Finish sending the rest of each of the INCR values.  This should
     be improved; there's a chance of deadlock if more than one
     subtarget in a MULTIPLE selection requires an INCR transfer, and
     the requestor and Emacs loop waiting on different transfers.  */
  for (cs = converted_selections; cs; cs = cs->next)
    if (cs->wait_object)
688
      {
689 690 691
	int format_bytes = cs->format / 8;
	int had_errors = x_had_errors_p (display);
	UNBLOCK_INPUT;
692

693 694
	bytes_remaining = cs->size;
	bytes_remaining *= format_bytes;
Richard M. Stallman's avatar
Richard M. Stallman committed
695

Paul Eggert's avatar
Paul Eggert committed
696
	/* Wait for the requestor to ack by deleting the property.
697 698 699 700 701 702 703 704 705
	   This can run Lisp code (process handlers) or signal.  */
	if (! had_errors)
	  {
	    TRACE1 ("Waiting for ACK (deletion of %s)",
		    XGetAtomName (display, cs->property));
	    wait_for_property_change (cs->wait_object);
	  }
	else
	  unexpect_property_change (cs->wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
706

707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726
	while (bytes_remaining)
	  {
	    int i = ((bytes_remaining < max_bytes)
		     ? bytes_remaining
		     : max_bytes) / format_bytes;
	    BLOCK_INPUT;

	    cs->wait_object
	      = expect_property_change (display, window, cs->property,
					PropertyDelete);

	    TRACE1 ("Sending increment of %d elements", i);
	    TRACE1 ("Set %s to increment data",
		    XGetAtomName (display, cs->property));

	    /* Append the next chunk of data to the property.  */
	    XChangeProperty (display, window, cs->property,
			     cs->type, cs->format, PropModeAppend,
			     cs->data, i);
	    bytes_remaining -= i * format_bytes;
Chong Yidong's avatar
Chong Yidong committed
727 728
	    cs->data += i * ((cs->format == 32) ? sizeof (long)
			     : format_bytes);
729 730 731
	    XFlush (display);
	    had_errors = x_had_errors_p (display);
	    UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
732

733
	    if (had_errors) break;
734

Paul Eggert's avatar
Paul Eggert committed
735
	    /* Wait for the requestor to ack this chunk by deleting
736 737 738 739 740
	       the property.  This can run Lisp code or signal.  */
	    TRACE1 ("Waiting for increment ACK (deletion of %s)",
		    XGetAtomName (display, cs->property));
	    wait_for_property_change (cs->wait_object);
	  }
741

742
	/* Now write a zero-length chunk to the property to tell the
Paul Eggert's avatar
Paul Eggert committed
743
	   requestor that we're done.  */
744 745 746 747 748 749 750 751 752 753 754
	BLOCK_INPUT;
	if (! waiting_for_other_props_on_window (display, window))
	  XSelectInput (display, window, 0L);

	TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
		XGetAtomName (display, cs->property));
	XChangeProperty (display, window, cs->property,
			 cs->type, cs->format, PropModeReplace,
			 cs->data, 0);
	TRACE0 ("Done sending incrementally");
      }
755

Richard M. Stallman's avatar
Richard M. Stallman committed
756
  /* rms, 2003-01-03: I think I have fixed this bug.  */
757 758 759
  /* 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
Paul Eggert's avatar
Paul Eggert committed
760
     referring to the deleted window, and we'll get a BadWindow error
761 762
     in XTread_socket when processing the events.  I don't have
     an idea how to fix that.  gerd, 2001-01-98.   */
763 764 765
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
766
  UNBLOCK_INPUT;
767 768 769 770 771

  /* GTK queues events in addition to the queue in Xlib.  So we
     UNBLOCK to enter the event loop and get possible errors delivered,
     and then BLOCK again because x_uncatch_errors requires it.  */
  BLOCK_INPUT;
772
  /* This calls x_uncatch_errors.  */
773
  unbind_to (count, Qnil);
774
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
775 776 777 778 779
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

780
static void
781
x_handle_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
782
{
783
  struct gcpro gcpro1, gcpro2;
Richard M. Stallman's avatar
Richard M. Stallman committed
784
  Time local_selection_time;
785 786 787 788 789 790 791 792

  Display *display = SELECTION_EVENT_DISPLAY (event);
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
  Atom selection = SELECTION_EVENT_SELECTION (event);
  Lisp_Object selection_symbol = x_atom_to_symbol (display, selection);
  Atom target = SELECTION_EVENT_TARGET (event);
  Lisp_Object target_symbol = x_atom_to_symbol (display, target);
  Atom property = SELECTION_EVENT_PROPERTY (event);
Chong Yidong's avatar
Chong Yidong committed
793
  Lisp_Object local_selection_data;
794 795 796
  int success = 0;
  int count = SPECPDL_INDEX ();
  GCPRO2 (local_selection_data, target_symbol);
Richard M. Stallman's avatar
Richard M. Stallman committed
797

Chong Yidong's avatar
Chong Yidong committed
798 799 800 801
  if (!dpyinfo) goto DONE;

  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);

802 803
  /* Decline if we don't own any selections.  */
  if (NILP (local_selection_data)) goto DONE;
Richard M. Stallman's avatar
Richard M. Stallman committed
804

805
  /* Decline requests issued prior to our acquiring the selection.  */
806 807
  CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
		   Time, local_selection_time);
Richard M. Stallman's avatar
Richard M. Stallman committed
808
  if (SELECTION_EVENT_TIME (event) != CurrentTime
809
      && local_selection_time > SELECTION_EVENT_TIME (event))
810
    goto DONE;
Richard M. Stallman's avatar
Richard M. Stallman committed
811 812

  x_selection_current_request = event;
813
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
814 815
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

816 817 818 819
  /* We might be able to handle nested x_handle_selection_requests,
     but this is difficult to test, and seems unimportant.  */
  x_start_queuing_selection_requests ();
  record_unwind_protect (queue_selection_requests_unwind, Qnil);
Richard M. Stallman's avatar
Richard M. Stallman committed
820

821 822 823 824
  TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
	  SDATA (SYMBOL_NAME (selection_symbol)),
	  SDATA (SYMBOL_NAME (target_symbol)));

Richard M. Stallman's avatar
Richard M. Stallman committed
825
  if (EQ (target_symbol, QMULTIPLE))
826 827 828 829 830 831
    {
      /* For MULTIPLE targets, the event property names a list of atom
	 pairs; the first atom names a target and the second names a
	 non-None property.  */
      Window requestor = SELECTION_EVENT_REQUESTOR (event);
      Lisp_Object multprop;
832
      ptrdiff_t j, nselections;
833 834

      if (property == None) goto DONE;
Chong Yidong's avatar
Chong Yidong committed
835 836 837
      multprop
	= x_get_window_property_as_lisp_data (display, requestor, property,
					      QMULTIPLE, selection);
838

839
      if (!VECTORP (multprop) || ASIZE (multprop) % 2)
840 841 842 843 844 845 846
	goto DONE;

      nselections = ASIZE (multprop) / 2;
      /* Perform conversions.  This can signal.  */
      for (j = 0; j < nselections; j++)
	{
	  Lisp_Object subtarget = AREF (multprop, 2*j);
Chong Yidong's avatar
Chong Yidong committed
847
	  Atom subproperty = symbol_to_x_atom (dpyinfo,
848 849 850 851
					       AREF (multprop, 2*j+1));

	  if (subproperty != None)
	    x_convert_selection (event, selection_symbol, subtarget,
Chong Yidong's avatar
Chong Yidong committed
852
				 subproperty, 1, dpyinfo);
853 854 855 856 857 858 859 860
	}
      success = 1;
    }
  else
    {
      if (property == None)
	property = SELECTION_EVENT_TARGET (event);
      success = x_convert_selection (event, selection_symbol,
Chong Yidong's avatar
Chong Yidong committed
861 862
				     target_symbol, property,
				     0, dpyinfo);
863
    }
864

865
 DONE:
866

867 868 869 870 871
  if (success)
    x_reply_selection_request (event, dpyinfo);
  else
    x_decline_selection_request (event);
  x_selection_current_request = 0;
872

873 874 875
  /* Run the `x-sent-selection-functions' abnormal hook.  */
  if (!NILP (Vx_sent_selection_functions)
      && !EQ (Vx_sent_selection_functions, Qunbound))
Richard M. Stallman's avatar
Richard M. Stallman committed
876
    {
877
      Lisp_Object args[4];
878
      args[0] = Qx_sent_selection_functions;
879 880 881 882 883
      args[1] = selection_symbol;
      args[2] = target_symbol;
      args[3] = success ? Qt : Qnil;
      Frun_hook_with_args (4, args);
    }
884

885 886 887
  unbind_to (count, Qnil);
  UNGCPRO;
}
888

889 890 891 892
/* Perform the requested selection conversion, and write the data to
   the converted_selections linked list, where it can be accessed by
   x_reply_selection_request.  If FOR_MULTIPLE is non-zero, write out
   the data even if conversion fails, using conversion_fail_tag.
Richard M. Stallman's avatar
Richard M. Stallman committed
893

894
   Return 0 if the selection failed to convert, 1 otherwise.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
895

896
static int
Chong Yidong's avatar
Chong Yidong committed
897 898 899
x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
		     Lisp_Object target_symbol, Atom property,
		     int for_multiple, struct x_display_info *dpyinfo)
900 901 902 903 904
{
  struct gcpro gcpro1;
  Lisp_Object lisp_selection;
  struct selection_data *cs;
  GCPRO1 (lisp_selection);
905

906
  lisp_selection