xselect.c 85.8 KB
Newer Older
1
/* X Selection processing for Emacs.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1993-1997, 2000-2020 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 <https://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>
24 25 26 27

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

29 30
#include <unistd.h>

Richard M. Stallman's avatar
Richard M. Stallman committed
31 32
#include "lisp.h"
#include "xterm.h"	/* for all of the X includes */
33
#include "frame.h"	/* Need this to get the X window of selected_frame */
34
#include "blockinput.h"
35
#include "sysstdio.h"	/* TRACE_SELECTION needs this.  */
36
#include "termhooks.h"
37
#include "keyboard.h"
Daniel Colascione's avatar
Daniel Colascione committed
38
#include "pdumper.h"
39 40

#include <X11/Xproto.h>
41

42
struct prop_location;
43
struct selection_data;
44

45 46
static void x_decline_selection_request (struct selection_input_event *);
static bool x_convert_selection (Lisp_Object, Lisp_Object, Atom, bool,
47 48
				 struct x_display_info *);
static bool waiting_for_other_props_on_window (Display *, Window);
49 50 51 52
static struct prop_location *expect_property_change (Display *, Window,
                                                     Atom, int);
static void unexpect_property_change (struct prop_location *);
static void wait_for_property_change (struct prop_location *);
53
static Lisp_Object x_get_window_property_as_lisp_data (struct x_display_info *,
54 55
                                                       Window, Atom,
                                                       Lisp_Object, Atom);
56
static Lisp_Object selection_data_to_lisp_data (struct x_display_info *,
57
						const unsigned char *,
58
						ptrdiff_t, Atom, int);
59 60
static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object,
					 struct selection_data *);
61 62 63 64 65

/* Printing traces to stderr.  */

#ifdef TRACE_SELECTION
#define TRACE0(fmt) \
Paul Eggert's avatar
Paul Eggert committed
66
  fprintf (stderr, "%"PRIdMAX": " fmt "\n", (intmax_t) getpid ())
67
#define TRACE1(fmt, a0) \
Paul Eggert's avatar
Paul Eggert committed
68
  fprintf (stderr, "%"PRIdMAX": " fmt "\n", (intmax_t) getpid (), a0)
69
#define TRACE2(fmt, a0, a1) \
Paul Eggert's avatar
Paul Eggert committed
70
  fprintf (stderr, "%"PRIdMAX": " fmt "\n", (intmax_t) getpid (), a0, a1)
71
#define TRACE3(fmt, a0, a1, a2) \
Paul Eggert's avatar
Paul Eggert committed
72
  fprintf (stderr, "%"PRIdMAX": " fmt "\n", (intmax_t) getpid (), a0, a1, a2)
73 74 75 76 77 78
#else
#define TRACE0(fmt)		(void) 0
#define TRACE1(fmt, a0)		(void) 0
#define TRACE2(fmt, a0, a1)	(void) 0
#endif

79 80 81 82
/* Bytes needed to represent 'long' data.  This is as per libX11; it
   is not necessarily sizeof (long).  */
#define X_LONG_SIZE 4

Richard M. Stallman's avatar
Richard M. Stallman committed
83 84 85
/* 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
86
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
87
   smaller than that, set this.  I added this mostly for debugging the
88 89 90 91 92 93 94 95 96
   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
97

98 99 100 101 102 103 104 105
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
106

Chong Yidong's avatar
Chong Yidong committed
107 108
#define LOCAL_SELECTION(selection_symbol,dpyinfo)			\
  assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
109 110


111 112
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */
113 114 115

struct selection_event_queue
  {
116
    struct selection_input_event event;
117 118 119 120 121
    struct selection_event_queue *next;
  };

static struct selection_event_queue *selection_queue;

122
/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
123 124 125

static int x_queue_selection_requests;

126 127 128 129 130 131 132 133 134 135 136 137
/* True if the input events are duplicates.  */

static bool
selection_input_event_equal (struct selection_input_event *a,
			     struct selection_input_event *b)
{
  return (a->kind == b->kind && a->dpyinfo == b->dpyinfo
	  && a->requestor == b->requestor && a->selection == b->selection
	  && a->target == b->target && a->property == b->property
	  && a->time == b->time);
}

138
/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
139 140

static void
141
x_queue_event (struct selection_input_event *event)
142 143 144
{
  struct selection_event_queue *queue_tmp;

145 146
  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
147 148
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
149
      if (selection_input_event_equal (event, &queue_tmp->event))
150
	{
151
	  TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
152
	  x_decline_selection_request (event);
153 154 155 156
	  return;
	}
    }

157
  queue_tmp = xmalloc (sizeof *queue_tmp);
Dmitry Antipov's avatar
Dmitry Antipov committed
158 159 160 161
  TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
  queue_tmp->event = *event;
  queue_tmp->next = selection_queue;
  selection_queue = queue_tmp;
162 163
}

164
/* Start queuing SELECTION_REQUEST_EVENT events.  */
165 166

static void
167
x_start_queuing_selection_requests (void)
168 169
{
  if (x_queue_selection_requests)
170
    emacs_abort ();
171 172 173 174 175

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

176
/* Stop queuing SELECTION_REQUEST_EVENT events.  */
177 178

static void
179
x_stop_queuing_selection_requests (void)
180 181 182 183 184 185 186 187 188 189
{
  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;
190
      TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
191 192
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
193
      xfree (queue_tmp);
194 195 196 197
    }
}


198
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
199 200 201
   roundtrip whenever possible.  */

static Atom
Chong Yidong's avatar
Chong Yidong committed
202
symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
Richard M. Stallman's avatar
Richard M. Stallman committed
203 204 205 206 207 208 209 210
{
  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;
211 212 213
  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
214
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
215
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
216 217 218
  if (EQ (sym, QDELETE))    return dpyinfo->Xatom_DELETE;
  if (EQ (sym, QMULTIPLE))  return dpyinfo->Xatom_MULTIPLE;
  if (EQ (sym, QINCR))	    return dpyinfo->Xatom_INCR;
219
  if (EQ (sym, Q_EMACS_TMP_)) return dpyinfo->Xatom_EMACS_TMP;
220 221
  if (EQ (sym, QTARGETS))   return dpyinfo->Xatom_TARGETS;
  if (EQ (sym, QNULL))	    return dpyinfo->Xatom_NULL;
222
  if (!SYMBOLP (sym)) emacs_abort ();
Richard M. Stallman's avatar
Richard M. Stallman committed
223

224
  TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
225
  block_input ();
Chong Yidong's avatar
Chong Yidong committed
226
  val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
227
  unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
228 229 230 231 232 233 234 235
  return val;
}


/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
   and calls to intern whenever possible.  */

static Lisp_Object
236
x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom)
Richard M. Stallman's avatar
Richard M. Stallman committed
237 238 239
{
  char *str;
  Lisp_Object val;
240

241 242
  if (! atom)
    return Qnil;
243

244 245 246 247 248 249 250 251 252 253 254 255 256 257
  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;
    }

Chong Yidong's avatar
Chong Yidong committed
258 259
  if (dpyinfo == NULL)
    return Qnil;
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 Q_EMACS_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 (dpyinfo->display, atom);
285
  unblock_input ();
286
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
287 288
  if (! str) return Qnil;
  val = intern (str);
289
  block_input ();
290
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
291
  XFree (str);
292
  unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
293 294
  return val;
}
295

Richard M. Stallman's avatar
Richard M. Stallman committed
296
/* Do protocol to assert ourself as a selection owner.
Chong Yidong's avatar
Chong Yidong committed
297
   FRAME shall be the owner; it must be a valid X frame.
298
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
299 300 301
   our selection.  */

static void
Chong Yidong's avatar
Chong Yidong committed
302 303
x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
		 Lisp_Object frame)
Richard M. Stallman's avatar
Richard M. Stallman committed
304
{
Chong Yidong's avatar
Chong Yidong committed
305 306
  struct frame *f = XFRAME (frame);
  Window selecting_window = FRAME_X_WINDOW (f);
307
  struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
Chong Yidong's avatar
Chong Yidong committed
308
  Display *display = dpyinfo->display;
309
  Time timestamp = dpyinfo->last_user_time;
Chong Yidong's avatar
Chong Yidong committed
310
  Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
311

312
  block_input ();
313
  x_catch_errors (display);
314
  XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
315
  x_check_errors (display, "Can't set selection: %s");
316
  x_uncatch_errors_after_check ();
317
  unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
318 319 320 321 322 323

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

324
    selection_data = list4 (selection_name, selection_value,
325
			    INT_TO_INTEGER (timestamp), frame);
Chong Yidong's avatar
Chong Yidong committed
326
    prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
327

Paul Eggert's avatar
Paul Eggert committed
328 329 330
    tset_selection_alist
      (dpyinfo->terminal,
       Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
Richard M. Stallman's avatar
Richard M. Stallman committed
331

Chong Yidong's avatar
Chong Yidong committed
332
    /* If we already owned the selection, remove the old selection
Paul Eggert's avatar
Paul Eggert committed
333
       data.  Don't use Fdelq as that may quit.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
334 335
    if (!NILP (prev_value))
      {
Chong Yidong's avatar
Chong Yidong committed
336 337 338
	/* We know it's not the CAR, so it's easy.  */
	Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
	for (; CONSP (rest); rest = XCDR (rest))
339
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
340
	    {
Chong Yidong's avatar
Chong Yidong committed
341
	      XSETCDR (rest, XCDR (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
342 343 344 345 346 347 348 349
	      break;
	    }
      }
  }
}

/* Given a selection-name and desired type, look up our local copy of
   the selection value and convert it to the type.
350 351
   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
352 353
   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
354 355 356 357

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

static Lisp_Object
Chong Yidong's avatar
Chong Yidong committed
358
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
359
		       bool local_request, struct x_display_info *dpyinfo)
Richard M. Stallman's avatar
Richard M. Stallman committed
360 361
{
  Lisp_Object local_value;
362
  Lisp_Object handler_fn, value, check;
Richard M. Stallman's avatar
Richard M. Stallman committed
363

Chong Yidong's avatar
Chong Yidong committed
364
  local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
365 366 367

  if (NILP (local_value)) return Qnil;

Chong Yidong's avatar
Chong Yidong committed
368
  /* TIMESTAMP is a special case.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
369 370 371
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
372
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
373 374 375 376 377 378
    }
  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.  */
379
      ptrdiff_t count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
380 381
      specbind (Qinhibit_quit, Qt);

382
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
383
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
384

385 386
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
Kenichi Handa's avatar
Kenichi Handa committed
387
		       selection_symbol, (local_request ? Qnil : target_type),
388
		       XCAR (XCDR (local_value)));
389 390
      else
	value = Qnil;
Paul Eggert's avatar
Paul Eggert committed
391
      value = unbind_to (count, value);
Richard M. Stallman's avatar
Richard M. Stallman committed
392 393 394 395
    }

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

Richard M. Stallman's avatar
Richard M. Stallman committed
397 398
  check = value;
  if (CONSP (value)
399 400
      && SYMBOLP (XCAR (value)))
    check = XCDR (value);
401

Richard M. Stallman's avatar
Richard M. Stallman committed
402 403 404
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
405
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
406 407
      || NILP (value))
    return value;
408
  /* Check for a value that CONS_TO_INTEGER could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
409
  else if (CONSP (check)
410 411
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
412
	       ||
413
	       (CONSP (XCDR (check))
414
		&& INTEGERP (XCAR (XCDR (check)))
415
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
416
    return value;
417 418 419

  signal_error ("Invalid data returned by selection-conversion function",
		list2 (handler_fn, value));
Richard M. Stallman's avatar
Richard M. Stallman committed
420 421 422 423
}

/* Subroutines of x_reply_selection_request.  */

424
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
425 426 427
   meaning we were unable to do what they wanted.  */

static void
428
x_decline_selection_request (struct selection_input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
429
{
430 431
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
432

433 434 435 436 437 438 439
  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
440

441 442
  /* The reason for the error may be that the receiver has
     died in the meantime.  Handle that case.  */
443
  block_input ();
444
  x_catch_errors (reply->display);
445
  XSendEvent (reply->display, reply->requestor, False, 0, &reply_base);
446
  XFlush (reply->display);
447
  x_uncatch_errors ();
448
  unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
449 450 451 452
}

/* This is the selection request currently being processed.
   It is set to zero when the request is fully processed.  */
453
static struct selection_input_event *x_selection_current_request;
Richard M. Stallman's avatar
Richard M. Stallman committed
454

455 456 457 458
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

459 460 461 462 463
/* Raw selection data, for sending to a requestor window.  */

struct selection_data
{
  unsigned char *data;
464
  ptrdiff_t size;
465 466
  int format;
  Atom type;
467
  bool nofree;
468 469 470 471 472 473 474 475 476 477
  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).  */

478
static struct selection_data *converted_selections;
479 480

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

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

487 488
static void
x_selection_request_lisp_error (void)
Richard M. Stallman's avatar
Richard M. Stallman committed
489
{
490 491 492 493 494
  struct selection_data *cs, *next;

  for (cs = converted_selections; cs; cs = next)
    {
      next = cs->next;
495
      if (! cs->nofree && cs->data)
496 497 498 499 500
	xfree (cs->data);
      xfree (cs);
    }
  converted_selections = NULL;

501 502
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
Richard M. Stallman's avatar
Richard M. Stallman committed
503 504
    x_decline_selection_request (x_selection_current_request);
}
505

506 507
static void
x_catch_errors_unwind (void)
508
{
509
  block_input ();
510
  x_uncatch_errors ();
511
  unblock_input ();
512
}
Richard M. Stallman's avatar
Richard M. Stallman committed
513

514 515 516 517 518 519 520 521 522 523 524 525 526 527

/* 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;
528
  bool arrived;
529 530 531 532 533 534 535 536 537 538
  struct prop_location *next;
};

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;
539

Jan D's avatar
Jan D committed
540 541 542 543 544 545 546 547 548 549
static void
set_property_change_object (struct prop_location *location)
{
  /* Input must be blocked so we don't get the event before we set these.  */
  if (! input_blocked_p ())
    emacs_abort ();
  XSETCAR (property_change_reply, Qnil);
  property_change_reply_object = location;
}

550

551
/* Send the reply to a selection request event EVENT.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
552

553
#ifdef TRACE_SELECTION
554
static int x_reply_selection_request_cnt;
555 556
#endif  /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
557
static void
558
x_reply_selection_request (struct selection_input_event *event,
Juanma Barranquero's avatar
Juanma Barranquero committed
559
                           struct x_display_info *dpyinfo)
Richard M. Stallman's avatar
Richard M. Stallman committed
560
{
561 562
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
Richard M. Stallman's avatar
Richard M. Stallman committed
563
  Display *display = SELECTION_EVENT_DISPLAY (event);
564
  Window window = SELECTION_EVENT_REQUESTOR (event);
565 566
  ptrdiff_t bytes_remaining;
  int max_bytes = selection_quantum (display);
567
  ptrdiff_t count = SPECPDL_INDEX ();
568
  struct selection_data *cs;
Richard M. Stallman's avatar
Richard M. Stallman committed
569

570 571 572 573 574 575 576 577 578
  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
579

580
  block_input ();
581 582 583
  /* 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.  */
584
  record_unwind_protect_void (x_catch_errors_unwind);
585
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
586

587 588 589 590 591 592 593
  /* 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
594 595 596
      if (cs->property == None)
	continue;

597 598
      bytes_remaining = cs->size;
      bytes_remaining *= cs->format >> 3;
Chong Yidong's avatar
Chong Yidong committed
599
      if (bytes_remaining <= max_bytes)
600
	{
Chong Yidong's avatar
Chong Yidong committed
601
	  /* Send all the data at once, with minimal handshaking.  */
602
	  TRACE1 ("Sending all %"pD"d bytes", bytes_remaining);
Chong Yidong's avatar
Chong Yidong committed
603 604 605 606 607 608 609
	  XChangeProperty (display, window, cs->property,
			   cs->type, cs->format, PropModeReplace,
			   cs->data, cs->size);
	}
      else
	{
	  /* Send an INCR tag to initiate incremental transfer.  */
610
	  long value[1];
Chong Yidong's avatar
Chong Yidong committed
611

612
	  TRACE2 ("Start sending %"pD"d bytes incrementally (%s)",
Chong Yidong's avatar
Chong Yidong committed
613 614 615 616 617 618 619
		  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.  */
620
	  value[0] = min (bytes_remaining, X_LONG_MAX);
Chong Yidong's avatar
Chong Yidong committed
621 622 623 624
	  XChangeProperty (display, window, cs->property,
			   dpyinfo->Xatom_INCR, 32, PropModeReplace,
			   (unsigned char *) value, 1);
	  XSelectInput (display, window, PropertyChangeMask);
625 626 627 628
	}
    }

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

632 633
#ifdef TRACE_SELECTION
  {
634 635
    char *sel = XGetAtomName (display, reply->selection);
    char *tgt = XGetAtomName (display, reply->target);
636 637
    TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
	    sel, tgt, ++x_reply_selection_request_cnt);
638 639 640 641 642
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

643 644 645 646 647 648
  /* 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)
649
      {
650
	int format_bytes = cs->format / 8;
651
	bool had_errors_p = x_had_errors_p (display);
Jan D's avatar
Jan D committed
652 653 654 655 656

        /* Must set this inside block_input ().  unblock_input may read
           events and setting property_change_reply in
           wait_for_property_change is then too late.  */
        set_property_change_object (cs->wait_object);
657
	unblock_input ();
658

659 660
	bytes_remaining = cs->size;
	bytes_remaining *= format_bytes;
Richard M. Stallman's avatar
Richard M. Stallman committed
661

Paul Eggert's avatar
Paul Eggert committed
662
	/* Wait for the requestor to ack by deleting the property.
663
	   This can run Lisp code (process handlers) or signal.  */
664
	if (! had_errors_p)
665 666 667 668 669 670 671
	  {
	    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
672

673 674 675 676 677
	while (bytes_remaining)
	  {
	    int i = ((bytes_remaining < max_bytes)
		     ? bytes_remaining
		     : max_bytes) / format_bytes;
678
	    block_input ();
679 680 681 682 683 684 685 686 687 688 689 690 691 692

	    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
693 694
	    cs->data += i * ((cs->format == 32) ? sizeof (long)
			     : format_bytes);
695
	    XFlush (display);
696
	    had_errors_p = x_had_errors_p (display);
697
            /* See comment above about property_change_reply.  */
Jan D's avatar
Jan D committed
698
            set_property_change_object (cs->wait_object);
699
	    unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
700

701
	    if (had_errors_p) break;
702

Paul Eggert's avatar
Paul Eggert committed
703
	    /* Wait for the requestor to ack this chunk by deleting
704 705 706 707 708
	       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);
	  }
709

710
	/* Now write a zero-length chunk to the property to tell the
Paul Eggert's avatar
Paul Eggert committed
711
	   requestor that we're done.  */
712
	block_input ();
713
	if (! waiting_for_other_props_on_window (display, window))
714
	  XSelectInput (display, window, 0);
715 716 717 718 719 720 721 722

	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");
      }
723

Richard M. Stallman's avatar
Richard M. Stallman committed
724
  /* rms, 2003-01-03: I think I have fixed this bug.  */
725 726 727
  /* 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
728
     referring to the deleted window, and we'll get a BadWindow error
729 730
     in XTread_socket when processing the events.  I don't have
     an idea how to fix that.  gerd, 2001-01-98.   */
731 732 733
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
734
  unblock_input ();
735 736 737 738

  /* 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.  */
739
  block_input ();
740
  /* This calls x_uncatch_errors.  */
741
  unbind_to (count, Qnil);
742
  unblock_input ();
Richard M. Stallman's avatar
Richard M. Stallman committed
743 744 745 746 747
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

748
static void
749
x_handle_selection_request (struct selection_input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
750 751
{
  Time local_selection_time;
752

753
  struct x_display_info *dpyinfo = SELECTION_EVENT_DPYINFO (event);
754
  Atom selection = SELECTION_EVENT_SELECTION (event);
755
  Lisp_Object selection_symbol = x_atom_to_symbol (dpyinfo, selection);
756
  Atom target = SELECTION_EVENT_TARGET (event);
757
  Lisp_Object target_symbol = x_atom_to_symbol (dpyinfo, target);
758
  Atom property = SELECTION_EVENT_PROPERTY (event);
Chong Yidong's avatar
Chong Yidong committed
759
  Lisp_Object local_selection_data;
760
  bool success = false;
761
  ptrdiff_t count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
762

Chong Yidong's avatar
Chong Yidong committed
763 764 765 766
  if (!dpyinfo) goto DONE;

  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);

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

770
  /* Decline requests issued prior to our acquiring the selection.  */
771 772
  CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
		   Time, local_selection_time);
Richard M. Stallman's avatar
Richard M. Stallman committed
773
  if (SELECTION_EVENT_TIME (event) != CurrentTime
774
      && local_selection_time > SELECTION_EVENT_TIME (event))
775
    goto DONE;
Richard M. Stallman's avatar
Richard M. Stallman committed
776 777

  x_selection_current_request = event;
778
  selection_request_dpyinfo = dpyinfo;
779
  record_unwind_protect_void (x_selection_request_lisp_error);
Richard M. Stallman's avatar
Richard M. Stallman committed
780

781 782 783
  /* 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 ();
784
  record_unwind_protect_void (x_stop_queuing_selection_requests);
Richard M. Stallman's avatar
Richard M. Stallman committed
785

786 787 788 789
  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
790
  if (EQ (target_symbol, QMULTIPLE))
791 792 793 794 795 796
    {
      /* 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;
797
      ptrdiff_t j, nselections;
798 799

      if (property == None) goto DONE;
Chong Yidong's avatar
Chong Yidong committed
800
      multprop
801
	= x_get_window_property_as_lisp_data (dpyinfo, requestor, property,
Chong Yidong's avatar
Chong Yidong committed
802
					      QMULTIPLE, selection);
803

804
      if (!VECTORP (multprop) || ASIZE (multprop) % 2)
805 806 807 808 809 810 811
	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
812
	  Atom subproperty = symbol_to_x_atom (dpyinfo,
813 814 815
					       AREF (multprop, 2*j+1));

	  if (subproperty != None)
816
	    x_convert_selection (selection_symbol, subtarget,
817
				 subproperty, true, dpyinfo);
818
	}
819
      success = true;
820 821 822 823 824
    }
  else
    {
      if (property == None)
	property = SELECTION_EVENT_TARGET (event);
825
      success = x_convert_selection (selection_symbol,
Chong Yidong's avatar
Chong Yidong committed
826
				     target_symbol, property,
827
				     false, dpyinfo);
828
    }
829

830
 DONE:
831

832 833 834 835 836
  if (success)
    x_reply_selection_request (event, dpyinfo);
  else
    x_decline_selection_request (event);
  x_selection_current_request = 0;
837

838 839 840
  /* Run the `x-sent-selection-functions' abnormal hook.  */
  if (!NILP (Vx_sent_selection_functions)
      && !EQ (Vx_sent_selection_functions, Qunbound))
841 842
    CALLN (Frun_hook_with_args, Qx_sent_selection_functions,
	   selection_symbol, target_symbol, success ? Qt : Qnil);
843

844 845
  unbind_to (count, Qnil);
}
846

847 848
/* Perform the requested selection conversion, and write the data to
   the converted_selections linked list, where it can be accessed by
849
   x_reply_selection_request.  If FOR_MULTIPLE, write out
850
   the data even if conversion fails, using conversion_fail_tag.
Richard M. Stallman's avatar
Richard M. Stallman committed
851

852
   Return true iff successful.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
853

854
static bool
855
x_convert_selection (Lisp_Object selection_symbol,
Chong Yidong's avatar
Chong Yidong committed
856
		     Lisp_Object target_symbol, Atom property,
857
		     bool for_multiple, struct x_display_info *dpyinfo)
858 859 860
{
  Lisp_Object lisp_selection;
  struct selection_data *cs;
861

862
  lisp_selection
Chong Yidong's avatar
Chong Yidong committed
863
    = x_get_local_selection (selection_symbol, target_symbol,
864
			     false, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
865

866 867 868 869 870 871
  /* A nil return value means we can't perform the conversion.  */
  if (NILP (lisp_selection)
      || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection))))
    {
      if (for_multiple)
	{
872
	  cs = xmalloc (sizeof *cs);
873 874 875 876
	  cs->data = (unsigned char *) &conversion_fail_tag;
	  cs->size = 1;
	  cs->format = 32;
	  cs->type = XA_ATOM;
877
	  cs->nofree = true;
878 879 880 881 882
	  cs->property = property;
	  cs->wait_object = NULL;
	  cs->next = converted_selections;
	  converted_selections = cs;
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
883

884
      return false;