xselect.c 84 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 42

#include <X11/Xproto.h>
43

44 45
struct prop_location;

46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
static Atom symbol_to_x_atom (struct x_display_info *, Display *,
                              Lisp_Object);
static void x_own_selection (Lisp_Object, Lisp_Object);
static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int);
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 some_frame_on_display (struct x_display_info *);
static Lisp_Object x_catch_errors_unwind (Lisp_Object);
static void x_reply_selection_request (struct input_event *, int,
                                       unsigned char *, int, Atom);
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 *);
static Lisp_Object x_get_foreign_selection (Lisp_Object,
                                            Lisp_Object,
                                            Lisp_Object);
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);
77 78
static Lisp_Object selection_data_to_lisp_data (Display *,
						const unsigned char *,
79 80 81 82 83
                                                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);
84 85 86 87 88 89 90 91 92 93

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


Jan Djärv's avatar
Jan Djärv committed
103
Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
Richard M. Stallman's avatar
Richard M. Stallman committed
104 105 106
  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  QATOM_PAIR;

Karl Heuer's avatar
Karl Heuer committed
107
Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */
Kenichi Handa's avatar
Kenichi Handa committed
108
Lisp_Object QUTF8_STRING;	/* This is a type of selection.  */
Karl Heuer's avatar
Karl Heuer committed
109

110
Lisp_Object Qcompound_text_with_extensions;
111

112 113
static Lisp_Object Qforeign_selection;

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

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

124
/* The timestamp of the last input event Emacs received from the X server.  */
125 126
/* Defined in keyboard.c.  */
extern unsigned long last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
127

Tom Tromey's avatar
Tom Tromey committed
128 129 130 131 132 133 134 135 136 137 138 139 140 141
/* This is an association list whose elements are of the form
     ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
   SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
   SELECTION-VALUE is the value that emacs owns for that selection.
     It may be any kind of Lisp object.
   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
     as a cons of two 16-bit numbers (making a 32 bit time.)
   FRAME is the frame for which we made the selection.
   If there is an entry in this alist, then it can be assumed that Emacs owns
    that selection.
   The only (eq) parts of this list that are visible from Lisp are the
    selection-values.  */
static Lisp_Object Vselection_alist;

142 143


144 145
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */
146 147 148 149 150 151 152 153 154

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

static struct selection_event_queue *selection_queue;

155
/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
156 157 158

static int x_queue_selection_requests;

159
/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
160 161

static void
162
x_queue_event (struct input_event *event)
163 164 165
{
  struct selection_event_queue *queue_tmp;

166 167
  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
168 169
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
170
      if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
171
	{
172 173
	  TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
	  x_decline_selection_request (event);
174 175 176 177 178 179 180 181 182
	  return;
	}
    }

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

  if (queue_tmp != NULL)
    {
183
      TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
184 185 186 187 188 189
      queue_tmp->event = *event;
      queue_tmp->next = selection_queue;
      selection_queue = queue_tmp;
    }
}

190
/* Start queuing SELECTION_REQUEST_EVENT events.  */
191 192

static void
193
x_start_queuing_selection_requests (void)
194 195 196 197 198 199 200 201
{
  if (x_queue_selection_requests)
    abort ();

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

202
/* Stop queuing SELECTION_REQUEST_EVENT events.  */
203 204

static void
205
x_stop_queuing_selection_requests (void)
206 207 208 209 210 211 212 213 214 215
{
  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;
216
      TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
217 218 219 220 221 222 223
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
      xfree ((char *)queue_tmp);
    }
}


224
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
225 226 227
   roundtrip whenever possible.  */

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

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

268 269
  if (! atom)
    return Qnil;
270

271 272 273 274 275 276 277 278 279 280 281 282 283 284
  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;
    }

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

  BLOCK_INPUT;
310
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
311
  UNBLOCK_INPUT;
312
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
316
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319 320
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
321

Richard M. Stallman's avatar
Richard M. Stallman committed
322
/* Do protocol to assert ourself as a selection owner.
323
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
324 325 326
   our selection.  */

static void
327
x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
Richard M. Stallman's avatar
Richard M. Stallman committed
328
{
329
  struct frame *sf = SELECTED_FRAME ();
330 331
  Window selecting_window;
  Display *display;
332
  Time timestamp = last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
333
  Atom selection_atom;
334
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
335

336 337 338 339 340 341
  if (! FRAME_X_P (sf))
    return;

  selecting_window = FRAME_X_WINDOW (sf);
  display = FRAME_X_DISPLAY (sf);
  dpyinfo = FRAME_X_DISPLAY_INFO (sf);
342

343
  CHECK_SYMBOL (selection_name);
344
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
345 346

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

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

359
    selection_time = long_to_cons ((unsigned long) timestamp);
360 361
    selection_data = list4 (selection_name, selection_value,
			    selection_time, selected_frame);
Richard M. Stallman's avatar
Richard M. Stallman committed
362 363 364 365 366 367 368 369 370 371
    prev_value = assq_no_quit (selection_name, Vselection_alist);

    Vselection_alist = Fcons (selection_data, Vselection_alist);

    /* If we already owned the selection, remove the old selection data.
       Perhaps we should destructively modify it instead.
       Don't use Fdelq as that may QUIT.  */
    if (!NILP (prev_value))
      {
	Lisp_Object rest;	/* we know it's not the CAR, so it's easy.  */
372
	for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
373
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
374
	    {
375
	      XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
376 377 378 379 380 381 382 383 384
	      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
385 386
   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
387 388 389 390

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

static Lisp_Object
391
x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, int local_request)
Richard M. Stallman's avatar
Richard M. Stallman committed
392 393
{
  Lisp_Object local_value;
394
  Lisp_Object handler_fn, value, check;
Richard M. Stallman's avatar
Richard M. Stallman committed
395 396 397 398 399 400 401 402 403 404
  int count;

  local_value = assq_no_quit (selection_symbol, Vselection_alist);

  if (NILP (local_value)) return Qnil;

  /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest.  */
  if (EQ (target_type, QTIMESTAMP))
    {
      handler_fn = Qnil;
405
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
406 407 408 409 410 411 412
    }
#if 0
  else if (EQ (target_type, QDELETE))
    {
      handler_fn = Qnil;
      Fx_disown_selection_internal
	(selection_symbol,
413
	 XCAR (XCDR (XCDR (local_value))));
Richard M. Stallman's avatar
Richard M. Stallman committed
414 415 416 417 418 419
      value = QNULL;
    }
#endif

#if 0 /* #### MULTIPLE doesn't work yet */
  else if (CONSP (target_type)
420
	   && XCAR (target_type) == QMULTIPLE)
Richard M. Stallman's avatar
Richard M. Stallman committed
421
    {
422 423
      Lisp_Object pairs;
      int size;
Richard M. Stallman's avatar
Richard M. Stallman committed
424
      int i;
425
      pairs = XCDR (target_type);
426
      size = XVECTOR (pairs)->size;
Richard M. Stallman's avatar
Richard M. Stallman committed
427 428 429 430 431 432 433
      /* If the target is MULTIPLE, then target_type looks like
	  (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
	 We modify the second element of each pair in the vector and
	 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
       */
      for (i = 0; i < size; i++)
	{
434 435
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
Richard M. Stallman's avatar
Richard M. Stallman committed
436 437
	  XVECTOR (pair)->contents [1]
	    = x_get_local_selection (XVECTOR (pair)->contents [0],
Kenichi Handa's avatar
Kenichi Handa committed
438 439
				     XVECTOR (pair)->contents [1],
				     local_request);
Richard M. Stallman's avatar
Richard M. Stallman committed
440 441 442 443 444 445 446 447 448
	}
      return pairs;
    }
#endif
  else
    {
      /* Don't allow a quit within the converter.
	 When the user types C-g, he would be surprised
	 if by luck it came during a converter.  */
Juanma Barranquero's avatar
Juanma Barranquero committed
449
      count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
450 451
      specbind (Qinhibit_quit, Qt);

452
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
453
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
454 455 456
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

457 458
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
Kenichi Handa's avatar
Kenichi Handa committed
459
		       selection_symbol, (local_request ? Qnil : target_type),
460
		       XCAR (XCDR (local_value)));
461 462
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
463 464 465 466 467
      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
468

Richard M. Stallman's avatar
Richard M. Stallman committed
469 470
  check = value;
  if (CONSP (value)
471 472
      && SYMBOLP (XCAR (value)))
    check = XCDR (value);
473

Richard M. Stallman's avatar
Richard M. Stallman committed
474 475 476
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
477
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
478 479
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
480
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
481
  else if (CONSP (check)
482 483
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
484
	       ||
485 486 487
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
488
    return value;
489 490 491

  signal_error ("Invalid data returned by selection-conversion function",
		list2 (handler_fn, value));
Richard M. Stallman's avatar
Richard M. Stallman committed
492 493 494 495
}

/* Subroutines of x_reply_selection_request.  */

496
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
497 498 499
   meaning we were unable to do what they wanted.  */

static void
500
x_decline_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
501 502
{
  XSelectionEvent reply;
503

Richard M. Stallman's avatar
Richard M. Stallman committed
504 505
  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
506
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
507 508 509 510 511
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = None;

512 513
  /* 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
514
  BLOCK_INPUT;
515
  x_catch_errors (reply.display);
516
  XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
517
  XFlush (reply.display);
518
  x_uncatch_errors ();
Richard M. Stallman's avatar
Richard M. Stallman committed
519 520 521 522 523 524 525
  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;

526 527 528 529
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

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

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

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

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

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

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

static Lisp_Object
584
queue_selection_requests_unwind (Lisp_Object tem)
585
{
586
  x_stop_queuing_selection_requests ();
587
  return Qnil;
588 589 590 591 592 593
}

/* Return some frame whose display info is DPYINFO.
   Return nil if there is none.  */

static Lisp_Object
594
some_frame_on_display (struct x_display_info *dpyinfo)
595 596 597 598 599
{
  Lisp_Object list, frame;

  FOR_EACH_FRAME (list, frame)
    {
600 601
      if (FRAME_X_P (XFRAME (frame))
          && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
602 603 604 605 606
	return frame;
    }

  return Qnil;
}
607

Richard M. Stallman's avatar
Richard M. Stallman committed
608 609 610 611 612
/* Send the reply to a selection request event EVENT.
   TYPE is the type of selection data requested.
   DATA and SIZE describe the data to send, already converted.
   FORMAT is the unit-size (in bits) of the data to be transmitted.  */

613
#ifdef TRACE_SELECTION
614
static int x_reply_selection_request_cnt;
615 616
#endif  /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
617
static void
618
x_reply_selection_request (struct input_event *event, int format, unsigned char *data, int size, Atom type)
Richard M. Stallman's avatar
Richard M. Stallman committed
619 620 621
{
  XSelectionEvent reply;
  Display *display = SELECTION_EVENT_DISPLAY (event);
622
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
623 624 625
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
626
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
627
  int count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
628 629 630 631 632 633

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  reply.type = SelectionNotify;
  reply.display = display;
634
  reply.requestor = window;
Richard M. Stallman's avatar
Richard M. Stallman committed
635 636 637 638 639 640 641
  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;

642
  BLOCK_INPUT;
643 644 645 646
  /* 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);
647
  x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
648

649 650 651 652
#ifdef TRACE_SELECTION
  {
    char *sel = XGetAtomName (display, reply.selection);
    char *tgt = XGetAtomName (display, reply.target);
653
    TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
654 655 656 657 658
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
659 660 661 662 663 664 665
  /* Store the data on the requested property.
     If the selection is large, only store the first N bytes of it.
   */
  bytes_remaining = size * format_bytes;
  if (bytes_remaining <= max_bytes)
    {
      /* Send all the data at once, with minimal handshaking.  */
666
      TRACE1 ("Sending all %d bytes", bytes_remaining);
Richard M. Stallman's avatar
Richard M. Stallman committed
667 668 669
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, size);
      /* At this point, the selection was successfully stored; ack it.  */
670
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
Richard M. Stallman's avatar
Richard M. Stallman committed
671 672 673 674
    }
  else
    {
      /* Send an INCR selection.  */
675
      struct prop_location *wait_object;
676
      int had_errors;
677
      Lisp_Object frame;
Richard M. Stallman's avatar
Richard M. Stallman committed
678

679 680 681 682 683 684 685
      frame = some_frame_on_display (dpyinfo);

      /* If the display no longer has frames, we can't expect
	 to get many more selection requests from it, so don't
	 bother trying to queue them.  */
      if (!NILP (frame))
	{
686
	  x_start_queuing_selection_requests ();
687 688

	  record_unwind_protect (queue_selection_requests_unwind,
689
				 Qnil);
690
	}
691

692
      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
693
	error ("Attempt to transfer an INCR to ourself!");
694

695 696
      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
697 698
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
699

700 701
      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
702 703 704 705 706 707 708 709 710 711 712
      {
        /* XChangeProperty expects an array of long even if long is more than
           32 bits.  */
        long value[1];

        value[0] = bytes_remaining;
        XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
                         32, PropModeReplace,
                         (unsigned char *) value, 1);
      }

Richard M. Stallman's avatar
Richard M. Stallman committed
713
      XSelectInput (display, window, PropertyChangeMask);
714

Richard M. Stallman's avatar
Richard M. Stallman committed
715
      /* Tell 'em the INCR data is there...  */
716
      TRACE0 ("Send SelectionNotify event");
717
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
718
      XFlush (display);
719 720

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

723
      /* First, wait for the requester to ack by deleting the property.
Richard M. Stallman's avatar
Richard M. Stallman committed
724
	 This can run random lisp code (process handlers) or signal.  */
725
      if (! had_errors)
726 727 728 729 730
	{
	  TRACE1 ("Waiting for ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_property_change (wait_object);
	}
731 732
      else
	unexpect_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
733

734
      TRACE0 ("Got ACK");
Richard M. Stallman's avatar
Richard M. Stallman committed
735 736
      while (bytes_remaining)
	{
737 738
          int i = ((bytes_remaining < max_bytes)
                   ? bytes_remaining
739
                   : max_bytes) / format_bytes;
740 741 742

	  BLOCK_INPUT;

743 744 745
	  wait_object
	    = expect_property_change (display, window, reply.property,
				      PropertyDelete);
746

747
	  TRACE1 ("Sending increment of %d elements", i);
748 749
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));
750

Richard M. Stallman's avatar
Richard M. Stallman committed
751 752
	  /* Append the next chunk of data to the property.  */
	  XChangeProperty (display, window, reply.property, type, format,
753 754 755 756 757 758
			   PropModeAppend, data, i);
	  bytes_remaining -= i * format_bytes;
	  if (format == 32)
	    data += i * sizeof (long);
	  else
	    data += i * format_bytes;
759
	  XFlush (display);
760
	  had_errors = x_had_errors_p (display);
761
	  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
762

763 764 765
	  if (had_errors)
	    break;

766
	  /* Now wait for the requester to ack this chunk by deleting the
Juanma Barranquero's avatar
Juanma Barranquero committed
767
	     property.  This can run random lisp code or signal.  */
768 769
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
770
	  wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
771
	}
772

773 774
      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
775
      BLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
776 777 778
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

779 780
      TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
	      XGetAtomName (display, reply.property));
Richard M. Stallman's avatar
Richard M. Stallman committed
781 782
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
783
      TRACE0 ("Done sending incrementally");
Richard M. Stallman's avatar
Richard M. Stallman committed
784
    }
785

Richard M. Stallman's avatar
Richard M. Stallman committed
786
  /* rms, 2003-01-03: I think I have fixed this bug.  */
787 788 789 790 791 792
  /* 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.   */
793 794 795
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
796
  UNBLOCK_INPUT;
797 798 799 800 801

  /* 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;
802
  /* This calls x_uncatch_errors.  */
803
  unbind_to (count, Qnil);
804
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
805 806 807 808 809
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

810
static void
811
x_handle_selection_request (struct input_event *event)
Richard M. Stallman's avatar
Richard M. Stallman committed
812 813
{
  struct gcpro gcpro1, gcpro2, gcpro3;
814
  Lisp_Object local_selection_data;
Richard M. Stallman's avatar
Richard M. Stallman committed
815
  Lisp_Object selection_symbol;
816 817
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
Richard M. Stallman's avatar
Richard M. Stallman committed
818
  Time local_selection_time;
819
  Lisp_Object successful_p;
Richard M. Stallman's avatar
Richard M. Stallman committed
820
  int count;
821 822
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
Richard M. Stallman's avatar
Richard M. Stallman committed
823

824 825 826
  TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
	  (unsigned long) SELECTION_EVENT_REQUESTOR (event),
	  (unsigned long) SELECTION_EVENT_TIME (event));
827

828 829 830 831 832
  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

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

835
  selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
836 837 838 839 840 841 842 843 844 845 846 847 848
				       SELECTION_EVENT_SELECTION (event));

  local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);

  if (NILP (local_selection_data))
    {
      /* Someone asked for the selection, but we don't have it any more.
       */
      x_decline_selection_request (event);
      goto DONE;
    }

  local_selection_time = (Time)
849
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
850 851

  if (SELECTION_EVENT_TIME (event) != CurrentTime
852
      && local_selection_time > SELECTION_EVENT_TIME (event))
Richard M. Stallman's avatar
Richard M. Stallman committed
853 854 855 856 857 858 859 860 861
    {
      /* Someone asked for the selection, and we have one, but not the one
	 they're looking for.
       */
      x_decline_selection_request (event);
      goto DONE;
    }

  x_selection_current_request = event;
862
  count = SPECPDL_INDEX ();
863
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
864 865
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

866
  target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
867 868 869 870 871 872
				    SELECTION_EVENT_TARGET (event));

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

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

Richard M. Stallman's avatar
Richard M. Stallman committed
876
  converted_selection
Kenichi Handa's avatar
Kenichi Handa committed
877
    = x_get_local_selection (selection_symbol, target_symbol, 0);
878

Richard M. Stallman's avatar
Richard M. Stallman committed
879 880 881 882 883 884
  if (! NILP (converted_selection))
    {
      unsigned char *data;
      unsigned int size;
      int format;
      Atom type;
885 886
      int nofree;

887 888 889 890 891 892
      if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
        {
          x_decline_selection_request (event);
          goto DONE2;
        }

893 894
      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
895
				   &data, &type, &size, &format, &nofree);
896

Richard M. Stallman's avatar
Richard M. Stallman committed
897 898 899 900
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

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

903
      /* Use xfree, not XFree, because lisp_data_to_selection_data
904
	 calls xmalloc itself.  */
905
      if (!nofree)
906
	xfree (data);
Richard M. Stallman's avatar
Richard M. Stallman committed
907
    }
908 909

 DONE2:
Richard M. Stallman's avatar
Richard M. Stallman committed
910 911 912 913 914 915
  unbind_to (count, Qnil);

 DONE:

  /* Let random lisp code notice that the selection has been asked for.  */
  {
Karl Heuer's avatar