xselect.c 84.7 KB
Newer Older
1
/* X Selection processing for Emacs.
2
   Copyright (C) 1993-1997, 2000-2011 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>
Jan Djärv's avatar
Jan Djärv committed
23
#include <stdio.h>      /* termhooks.h needs this */
24
#include <setjmp.h>
25 26 27 28

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

30 31
#include <unistd.h>

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

#include <X11/Xproto.h>
44

45
struct prop_location;
46
struct selection_data;
47

48
static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
Chong Yidong's avatar
Chong Yidong committed
49 50 51 52
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 *);
53 54 55 56
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);
57 58
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
59
				Atom, int, struct x_display_info *);
60 61 62 63 64 65
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
66 67
static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
					    Lisp_Object, Lisp_Object);
68 69 70 71 72 73 74 75 76 77
static void x_get_window_property (Display *, Window, Atom,
                                   unsigned char **, int *,
                                   Atom *, int *, unsigned long *, int);
static void receive_incremental_selection (Display *, Window, Atom,
                                           Lisp_Object, unsigned,
                                           unsigned char **, int *,
                                           Atom *, int *, unsigned long *);
static Lisp_Object x_get_window_property_as_lisp_data (Display *,
                                                       Window, Atom,
                                                       Lisp_Object, Atom);
78 79
static Lisp_Object selection_data_to_lisp_data (Display *,
						const unsigned char *,
80 81 82 83 84
                                                int, Atom, int);
static void lisp_data_to_selection_data (Display *, Lisp_Object,
                                         unsigned char **, Atom *,
                                         unsigned *, int *, int *);
static Lisp_Object clean_local_selection_data (Lisp_Object);
85 86 87 88 89 90 91 92 93 94

/* 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)
95 96
#define TRACE3(fmt, a0, a1, a2) \
  fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
97 98 99 100 101 102 103
#else
#define TRACE0(fmt)		(void) 0
#define TRACE1(fmt, a0)		(void) 0
#define TRACE2(fmt, a0, a1)	(void) 0
#endif


104
static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
Richard M. Stallman's avatar
Richard M. Stallman committed
105
  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
Chong Yidong's avatar
Chong Yidong committed
106
  QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;
Richard M. Stallman's avatar
Richard M. Stallman committed
107

108 109
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
110

111
static Lisp_Object Qcompound_text_with_extensions;
112

113 114
static Lisp_Object Qforeign_selection;

Richard M. Stallman's avatar
Richard M. Stallman committed
115 116 117
/* 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
118
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
119
   smaller than that, set this.  I added this mostly for debugging the
120
   incremental transfer stuff, but it might improve server performance.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
121 122
#define MAX_SELECTION_QUANTUM 0xFFFFFF

123
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
Richard M. Stallman's avatar
Richard M. Stallman committed
124

Chong Yidong's avatar
Chong Yidong committed
125 126
#define LOCAL_SELECTION(selection_symbol,dpyinfo)			\
  assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
127 128


129 130
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */
131 132 133 134 135 136 137 138 139

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

static struct selection_event_queue *selection_queue;

140
/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
141 142 143

static int x_queue_selection_requests;

144
/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
145 146

static void
147
x_queue_event (struct input_event *event)
148 149 150
{
  struct selection_event_queue *queue_tmp;

151 152
  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
153 154
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
155
      if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
156
	{
157
	  TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
158
	  x_decline_selection_request (event);
159 160 161 162 163 164 165 166 167
	  return;
	}
    }

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

  if (queue_tmp != NULL)
    {
168
      TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
169 170 171 172 173 174
      queue_tmp->event = *event;
      queue_tmp->next = selection_queue;
      selection_queue = queue_tmp;
    }
}

175
/* Start queuing SELECTION_REQUEST_EVENT events.  */
176 177

static void
178
x_start_queuing_selection_requests (void)
179 180 181 182 183 184 185 186
{
  if (x_queue_selection_requests)
    abort ();

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

187
/* Stop queuing SELECTION_REQUEST_EVENT events.  */
188 189

static void
190
x_stop_queuing_selection_requests (void)
191 192 193 194 195 196 197 198 199 200
{
  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;
201
      TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
202 203 204 205 206 207 208
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
      xfree ((char *)queue_tmp);
    }
}


209
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
210 211 212
   roundtrip whenever possible.  */

static Atom
Chong Yidong's avatar
Chong Yidong committed
213
symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
Richard M. Stallman's avatar
Richard M. Stallman committed
214 215 216 217 218 219 220 221
{
  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;
222 223 224
  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
225
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
226
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
227 228 229 230 231 232
  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
233 234
  if (!SYMBOLP (sym)) abort ();

235
  TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
Richard M. Stallman's avatar
Richard M. Stallman committed
236
  BLOCK_INPUT;
Chong Yidong's avatar
Chong Yidong committed
237
  val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
Richard M. Stallman's avatar
Richard M. Stallman committed
238 239 240 241 242 243 244 245 246
  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
247
x_atom_to_symbol (Display *dpy, Atom atom)
Richard M. Stallman's avatar
Richard M. Stallman committed
248
{
249
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
250 251
  char *str;
  Lisp_Object val;
252

253 254
  if (! atom)
    return Qnil;
255

256 257 258 259 260 261 262 263 264 265 266 267 268 269
  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;
    }

270
  dpyinfo = x_display_info_for_display (dpy);
Chong Yidong's avatar
Chong Yidong committed
271 272
  if (dpyinfo == NULL)
    return Qnil;
273
  if (atom == dpyinfo->Xatom_CLIPBOARD)
274
    return QCLIPBOARD;
275
  if (atom == dpyinfo->Xatom_TIMESTAMP)
276
    return QTIMESTAMP;
277
  if (atom == dpyinfo->Xatom_TEXT)
278
    return QTEXT;
Karl Heuer's avatar
Karl Heuer committed
279 280
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
281 282
  if (atom == dpyinfo->Xatom_UTF8_STRING)
    return QUTF8_STRING;
283
  if (atom == dpyinfo->Xatom_DELETE)
284
    return QDELETE;
285
  if (atom == dpyinfo->Xatom_MULTIPLE)
286
    return QMULTIPLE;
287
  if (atom == dpyinfo->Xatom_INCR)
288
    return QINCR;
289
  if (atom == dpyinfo->Xatom_EMACS_TMP)
290
    return QEMACS_TMP;
291
  if (atom == dpyinfo->Xatom_TARGETS)
292
    return QTARGETS;
293
  if (atom == dpyinfo->Xatom_NULL)
294
    return QNULL;
Richard M. Stallman's avatar
Richard M. Stallman committed
295 296

  BLOCK_INPUT;
297
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
298
  UNBLOCK_INPUT;
299
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
300 301 302
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
303
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
304 305 306 307
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
308

Richard M. Stallman's avatar
Richard M. Stallman committed
309
/* Do protocol to assert ourself as a selection owner.
Chong Yidong's avatar
Chong Yidong committed
310
   FRAME shall be the owner; it must be a valid X frame.
311
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
312 313 314
   our selection.  */

static void
Chong Yidong's avatar
Chong Yidong committed
315 316
x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
		 Lisp_Object frame)
Richard M. Stallman's avatar
Richard M. Stallman committed
317
{
Chong Yidong's avatar
Chong Yidong committed
318 319 320 321
  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;
322
  Time timestamp = last_event_timestamp;
Chong Yidong's avatar
Chong Yidong committed
323
  Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
324 325

  BLOCK_INPUT;
326
  x_catch_errors (display);
327
  XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
328
  x_check_errors (display, "Can't set selection: %s");
329
  x_uncatch_errors ();
Richard M. Stallman's avatar
Richard M. Stallman committed
330 331 332 333 334 335 336
  UNBLOCK_INPUT;

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

337
    selection_data = list4 (selection_name, selection_value,
Chong Yidong's avatar
Chong Yidong committed
338 339
			    long_to_cons (timestamp), frame);
    prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
340

Chong Yidong's avatar
Chong Yidong committed
341 342
    dpyinfo->terminal->Vselection_alist
      = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
Richard M. Stallman's avatar
Richard M. Stallman committed
343

Chong Yidong's avatar
Chong Yidong committed
344 345
    /* 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
346 347
    if (!NILP (prev_value))
      {
Chong Yidong's avatar
Chong Yidong committed
348 349 350
	/* We know it's not the CAR, so it's easy.  */
	Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
	for (; CONSP (rest); rest = XCDR (rest))
351
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
352
	    {
Chong Yidong's avatar
Chong Yidong committed
353
	      XSETCDR (rest, XCDR (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
354 355 356 357 358 359 360 361 362
	      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
363 364
   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
365 366 367 368

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

static Lisp_Object
Chong Yidong's avatar
Chong Yidong committed
369 370
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
371 372
{
  Lisp_Object local_value;
373
  Lisp_Object handler_fn, value, check;
Richard M. Stallman's avatar
Richard M. Stallman committed
374 375
  int count;

Chong Yidong's avatar
Chong Yidong committed
376
  local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
377 378 379

  if (NILP (local_value)) return Qnil;

Chong Yidong's avatar
Chong Yidong committed
380
  /* TIMESTAMP is a special case.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
381 382 383
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
384
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
385 386 387 388 389 390
    }
  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
391
      count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
392 393
      specbind (Qinhibit_quit, Qt);

394
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
395
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
396 397 398
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

399 400
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
Kenichi Handa's avatar
Kenichi Handa committed
401
		       selection_symbol, (local_request ? Qnil : target_type),
402
		       XCAR (XCDR (local_value)));
403 404
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
405 406 407 408 409
      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
410

Richard M. Stallman's avatar
Richard M. Stallman committed
411 412
  check = value;
  if (CONSP (value)
413 414
      && SYMBOLP (XCAR (value)))
    check = XCDR (value);
415

Richard M. Stallman's avatar
Richard M. Stallman committed
416 417 418
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
419
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
420 421
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
422
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
423
  else if (CONSP (check)
424 425
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
426
	       ||
427 428 429
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
430
    return value;
431 432 433

  signal_error ("Invalid data returned by selection-conversion function",
		list2 (handler_fn, value));
Richard M. Stallman's avatar
Richard M. Stallman committed
434 435 436 437
}

/* Subroutines of x_reply_selection_request.  */

438
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
439 440 441
   meaning we were unable to do what they wanted.  */

static void
442
x_decline_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
443
{
444 445
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
446

447 448 449 450 451 452 453
  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
454

455 456
  /* 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
457
  BLOCK_INPUT;
458 459 460
  x_catch_errors (reply->display);
  XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
  XFlush (reply->display);
461
  x_uncatch_errors ();
Richard M. Stallman's avatar
Richard M. Stallman committed
462 463 464 465 466 467 468
  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;

469 470 471 472
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496
/* Raw selection data, for sending to a requestor window.  */

struct selection_data
{
  unsigned char *data;
  unsigned int size;
  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).  */

struct selection_data *converted_selections;

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

Richard M. Stallman's avatar
Richard M. Stallman committed
497
/* Used as an unwind-protect clause so that, if a selection-converter signals
498
   an error, we tell the requester that we were unable to do what they wanted
Richard M. Stallman's avatar
Richard M. Stallman committed
499 500 501
   before we throw to top-level or go into the debugger or whatever.  */

static Lisp_Object
502
x_selection_request_lisp_error (Lisp_Object ignore)
Richard M. Stallman's avatar
Richard M. Stallman committed
503
{
504 505 506 507 508 509 510 511 512 513 514
  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;

515 516
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
Richard M. Stallman's avatar
Richard M. Stallman committed
517 518 519
    x_decline_selection_request (x_selection_current_request);
  return Qnil;
}
520 521

static Lisp_Object
522
x_catch_errors_unwind (Lisp_Object dummy)
523 524 525 526
{
  BLOCK_INPUT;
  x_uncatch_errors ();
  UNBLOCK_INPUT;
527
  return Qnil;
528
}
Richard M. Stallman's avatar
Richard M. Stallman committed
529

530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547

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

548 549 550 551
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);
552 553 554 555 556 557 558 559

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;
560 561

static Lisp_Object
562
queue_selection_requests_unwind (Lisp_Object tem)
563
{
564
  x_stop_queuing_selection_requests ();
565
  return Qnil;
566 567
}

568

569
/* Send the reply to a selection request event EVENT.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
570

571
#ifdef TRACE_SELECTION
572
static int x_reply_selection_request_cnt;
573 574
#endif  /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
575
static void
576
x_reply_selection_request (struct input_event *event, struct x_display_info *dpyinfo)
Richard M. Stallman's avatar
Richard M. Stallman committed
577
{
578 579
  XEvent reply_base;
  XSelectionEvent *reply = &(reply_base.xselection);
Richard M. Stallman's avatar
Richard M. Stallman committed
580
  Display *display = SELECTION_EVENT_DISPLAY (event);
581
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
582 583
  int bytes_remaining;
  int max_bytes = SELECTION_QUANTUM (display);
584
  int count = SPECPDL_INDEX ();
585
  struct selection_data *cs;
Richard M. Stallman's avatar
Richard M. Stallman committed
586 587 588 589

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

590 591 592 593 594 595 596 597 598
  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
599

600
  BLOCK_INPUT;
601 602 603 604
  /* 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);
605
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
606

607 608 609 610 611 612 613
  /* 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
614 615 616 617 618
      if (cs->property == None)
	continue;

      bytes_remaining = cs->size * (cs->format / 8);
      if (bytes_remaining <= max_bytes)
619
	{
Chong Yidong's avatar
Chong Yidong committed
620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643
	  /* Send all the data at once, with minimal handshaking.  */
	  TRACE1 ("Sending all %d bytes", bytes_remaining);
	  XChangeProperty (display, window, cs->property,
			   cs->type, cs->format, PropModeReplace,
			   cs->data, cs->size);
	}
      else
	{
	  /* Send an INCR tag to initiate incremental transfer.  */
	  long value[1];

	  TRACE2 ("Start sending %d bytes incrementally (%s)",
		  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.  */
	  value[0] = bytes_remaining;
	  XChangeProperty (display, window, cs->property,
			   dpyinfo->Xatom_INCR, 32, PropModeReplace,
			   (unsigned char *) value, 1);
	  XSelectInput (display, window, PropertyChangeMask);
644 645 646 647 648 649 650
	}
    }

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

651 652
#ifdef TRACE_SELECTION
  {
653 654
    char *sel = XGetAtomName (display, reply->selection);
    char *tgt = XGetAtomName (display, reply->target);
655 656
    TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
	    sel, tgt, ++x_reply_selection_request_cnt);
657 658 659 660 661
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

662 663 664 665 666 667
  /* 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)
668
      {
669 670 671
	int format_bytes = cs->format / 8;
	int had_errors = x_had_errors_p (display);
	UNBLOCK_INPUT;
672

673
	bytes_remaining = cs->size * format_bytes;
Richard M. Stallman's avatar
Richard M. Stallman committed
674

675 676 677 678 679 680 681 682 683 684
	/* Wait for the requester to ack by deleting the property.
	   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
685

686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705
	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
706 707
	    cs->data += i * ((cs->format == 32) ? sizeof (long)
			     : format_bytes);
708 709 710
	    XFlush (display);
	    had_errors = x_had_errors_p (display);
	    UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
711

712
	    if (had_errors) break;
713

714 715 716 717 718 719
	    /* Wait for the requester to ack this chunk by deleting
	       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);
	  }
720

721 722 723 724 725 726 727 728 729 730 731 732 733
	/* Now write a zero-length chunk to the property to tell the
	   requester that we're done.  */
	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");
      }
734

Richard M. Stallman's avatar
Richard M. Stallman committed
735
  /* rms, 2003-01-03: I think I have fixed this bug.  */
736 737 738 739 740 741
  /* 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.   */
742 743 744
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
745
  UNBLOCK_INPUT;
746 747 748 749 750

  /* 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;
751
  /* This calls x_uncatch_errors.  */
752
  unbind_to (count, Qnil);
753
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
754 755 756 757 758
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

759
static void
760
x_handle_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
761
{
762
  struct gcpro gcpro1, gcpro2;
Richard M. Stallman's avatar
Richard M. Stallman committed
763
  Time local_selection_time;
764 765 766 767 768 769 770 771

  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
772
  Lisp_Object local_selection_data;
773 774 775
  int success = 0;
  int count = SPECPDL_INDEX ();
  GCPRO2 (local_selection_data, target_symbol);
Richard M. Stallman's avatar
Richard M. Stallman committed
776

Chong Yidong's avatar
Chong Yidong committed
777 778 779 780
  if (!dpyinfo) goto DONE;

  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);

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

784 785 786
  /* Decline requests issued prior to our acquiring the selection.  */
  local_selection_time
    = (Time) cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
787
  if (SELECTION_EVENT_TIME (event) != CurrentTime
788
      && local_selection_time > SELECTION_EVENT_TIME (event))
789
    goto DONE;
Richard M. Stallman's avatar
Richard M. Stallman committed
790 791

  x_selection_current_request = event;
792
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
793 794
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

795 796 797 798
  /* 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
799

800 801 802 803
  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
804
  if (EQ (target_symbol, QMULTIPLE))
805 806 807 808 809 810 811 812 813
    {
      /* 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;
      int j, nselections;

      if (property == None) goto DONE;
Chong Yidong's avatar
Chong Yidong committed
814 815 816
      multprop
	= x_get_window_property_as_lisp_data (display, requestor, property,
					      QMULTIPLE, selection);
817

818
      if (!VECTORP (multprop) || ASIZE (multprop) % 2)
819 820 821 822 823 824 825 826
	goto DONE;

      nselections = ASIZE (multprop) / 2;
      /* Perform conversions.  This can signal.  */
      for (j = 0; j < nselections; j++)
	{
	  struct selection_data *cs = converted_selections + j;
	  Lisp_Object subtarget = AREF (multprop, 2*j);
Chong Yidong's avatar
Chong Yidong committed
827
	  Atom subproperty = symbol_to_x_atom (dpyinfo,
828 829 830 831
					       AREF (multprop, 2*j+1));

	  if (subproperty != None)
	    x_convert_selection (event, selection_symbol, subtarget,
Chong Yidong's avatar
Chong Yidong committed
832
				 subproperty, 1, dpyinfo);
833 834 835 836 837 838 839 840
	}
      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
841 842
				     target_symbol, property,
				     0, dpyinfo);
843
    }
844

845
 DONE:
846

847 848 849 850 851
  if (success)
    x_reply_selection_request (event, dpyinfo);
  else
    x_decline_selection_request (event);
  x_selection_current_request = 0;
852

853 854 855
  /* 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
856
    {
857 858 859 860 861 862 863
      Lisp_Object args[4];
      args[0] = Vx_sent_selection_functions;
      args[1] = selection_symbol;
      args[2] = target_symbol;
      args[3] = success ? Qt : Qnil;
      Frun_hook_with_args (4, args);
    }
864

865 866 867
  unbind_to (count, Qnil);
  UNGCPRO;
}
868

869 870 871 872
/* 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
873

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

876
static int
Chong Yidong's avatar
Chong Yidong committed
877 878 879
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)
880 881 882 883 884
{
  struct gcpro gcpro1;
  Lisp_Object lisp_selection;
  struct selection_data *cs;
  GCPRO1 (lisp_selection);
885

886
  lisp_selection
Chong Yidong's avatar
Chong Yidong committed
887 888
    = x_get_local_selection (selection_symbol, target_symbol,
			     0, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
889

890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906
  /* 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)
	{
	  cs = xmalloc (sizeof (struct selection_data));
	  cs->data = (unsigned char *) &conversion_fail_tag;
	  cs->size = 1;
	  cs->format = 32;
	  cs->type = XA_ATOM;
	  cs->nofree = 1;
	  cs->property = property;
	  cs->wait_object = NULL;
	  cs->next = converted_selections;
	  converted_selections = cs;
	}
Richard M. Stallman's avatar
Richard M. Stallman committed
907

908 909
      RETURN_UNGCPRO (0);
    }
910

911 912 913 914 915 916 917 918 919 920 921 922 923
  /* Otherwise, record the converted selection to binary.  */
  cs = xmalloc (sizeof (struct selection_data));
  cs->nofree = 1;
  cs->property = property;
  cs->wait_object = NULL;
  cs->next = converted_selections;
  converted_selections = cs;
  lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
			       lisp_selection,
			       &(cs->data), &(cs->type),
			       &(cs->size), &(cs->format),
			       &(cs->nofree));
  RETURN_UNGCPRO (1);
Richard M. Stallman's avatar
Richard M. Stallman committed
924 925
}

926
/* Handle a SelectionClear event EVENT, which indicates that some
Richard M. Stallman's avatar
Richard M. Stallman committed
927 928 929
   client cleared out our previously asserted selection.
   This is called from keyboard.c when such an event is found in the queue.  */

930
static void
931
x_handle_selection_clear (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
932 933 934 935
{
  Display *display = SELECTION_EVENT_DISPLAY (event);
  Atom selection = SELECTION_EVENT_SELECTION (event);
  Time changed_owner_time = SELECTION_EVENT_TIME (event);
936

Richard M. Stallman's avatar
Richard M. Stallman committed
937 938
  Lisp_Object selection_symbol, local_selection_data;
  Time local_selection_time;
939
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
Chong Yidong's avatar
Chong Yidong committed
940
  Lisp_Object Vselection_alist;
941

942 943
  TRACE0 ("x_handle_selection_clear");

Chong Yidong's avatar
Chong Yidong committed
944
  if (!dpyinfo) return;
945

946
  selection_symbol = x_atom_to_symbol (display, selection);
Chong Yidong's avatar
Chong Yidong committed
947
  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
Richard M. Stallman's avatar
Richard M. Stallman committed
948 949 950 951 952

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