xselect.c 84.8 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>
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 72 73 74 75 76 77 78
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);
79 80
static Lisp_Object selection_data_to_lisp_data (Display *,
						const unsigned char *,
81 82 83 84 85
                                                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);
86 87 88 89 90 91 92 93 94 95

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


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

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

112
static Lisp_Object Qcompound_text_with_extensions;
113

114 115
static Lisp_Object Qforeign_selection;

Richard M. Stallman's avatar
Richard M. Stallman committed
116 117 118
/* If this is a smaller number than the max-request-size of the display,
   emacs will use INCR selection transfer when the selection is larger
   than this.  The max-request-size is usually around 64k, so if you want
119
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
120
   smaller than that, set this.  I added this mostly for debugging the
121
   incremental transfer stuff, but it might improve server performance.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
122 123
#define MAX_SELECTION_QUANTUM 0xFFFFFF

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

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

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

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

static struct selection_event_queue *selection_queue;

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

static int x_queue_selection_requests;

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

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

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

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

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

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

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

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

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

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

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

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

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

254 255
  if (! atom)
    return Qnil;
256

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

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

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

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

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

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

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

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

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

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

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

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

  if (NILP (local_value)) return Qnil;

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

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

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

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

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

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

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

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

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

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

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

static struct x_display_info *selection_request_dpyinfo;

474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492
/* 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).  */

493
static struct selection_data *converted_selections;
494 495

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

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

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

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

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

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

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

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

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

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

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

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

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

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

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

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

      bytes_remaining = cs->size * (cs->format / 8);
      if (bytes_remaining <= max_bytes)
620
	{
Chong Yidong's avatar
Chong Yidong committed
621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644
	  /* 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);
645 646 647 648 649 650 651
	}
    }

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

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

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

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

676 677 678 679 680 681 682 683 684 685
	/* 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
686

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

713
	    if (had_errors) break;
714

715 716 717 718 719 720
	    /* 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);
	  }
721

722 723 724 725 726 727 728 729 730 731 732 733 734
	/* 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");
      }
735

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

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

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

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

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

  local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);

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

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

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

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

801 802 803 804
  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
805
  if (EQ (target_symbol, QMULTIPLE))
806 807 808 809 810 811 812 813 814
    {
      /* 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
815 816 817
      multprop
	= x_get_window_property_as_lisp_data (display, requestor, property,
					      QMULTIPLE, selection);
818

819
      if (!VECTORP (multprop) || ASIZE (multprop) % 2)
820 821 822 823 824 825 826
	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
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
      UNGCPRO;
      return 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));
924 925
  UNGCPRO;
  return 1;
Richard M. Stallman's avatar
Richard M. Stallman committed
926 927
}

928
/* Handle a SelectionClear event EVENT, which indicates that some
Richard M. Stallman's avatar
Richard M. Stallman committed
929 930 931
   client cleared out our previously asserted selection.
   This is called from keyboard.c when such an event is found in the queue.  */

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

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