xselect.c 92 KB
Newer Older
1
/* X Selection processing for Emacs.
Kim F. Storm's avatar
Kim F. Storm committed
2
   Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004
3
   Free Software Foundation.
Richard M. Stallman's avatar
Richard M. Stallman committed
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

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
along with GNU Emacs; see the file COPYING.  If not, write to
Lute Kamstra's avatar
Lute Kamstra committed
19 20
the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
21

Jim Blandy's avatar
Jim Blandy committed
22

Richard M. Stallman's avatar
Richard M. Stallman committed
23 24
/* Rewritten by jwz */

25
#include <config.h>
Jan Djärv's avatar
Jan Djärv committed
26
#include <stdio.h>      /* termhooks.h needs this */
27 28 29 30 31 32 33 34

#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

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

#include <X11/Xproto.h>
46

47 48 49 50 51 52
struct prop_location;

static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
				  Lisp_Object));
static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
Kenichi Handa's avatar
Kenichi Handa committed
53
static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
54 55 56 57 58 59 60 61 62 63 64 65
static void x_decline_selection_request P_ ((struct input_event *));
static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
static void x_reply_selection_request P_ ((struct input_event *, int,
					   unsigned char *, int, Atom));
static int waiting_for_other_props_on_window P_ ((Display *, Window));
static struct prop_location *expect_property_change P_ ((Display *, Window,
							 Atom, int));
static void unexpect_property_change P_ ((struct prop_location *));
static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
static void wait_for_property_change P_ ((struct prop_location *));
66 67 68
static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
                                                Lisp_Object,
                                                Lisp_Object));
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
static void x_get_window_property P_ ((Display *, Window, Atom,
				       unsigned char **, int *,
				       Atom *, int *, unsigned long *, int));
static void receive_incremental_selection P_ ((Display *, Window, Atom,
					       Lisp_Object, unsigned,
					       unsigned char **, int *,
					       Atom *, int *, unsigned long *));
static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
							   Window, Atom,
							   Lisp_Object, Atom));
static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
						    int, Atom, int));
static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
					     unsigned char **, Atom *,
					     unsigned *, int *, int *));
static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
static void initialize_cut_buffers P_ ((Display *, Window));


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


Richard M. Stallman's avatar
Richard M. Stallman committed
107 108 109 110 111 112
#define CUT_BUFFER_SUPPORT

Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
  QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
  QATOM_PAIR;

Karl Heuer's avatar
Karl Heuer committed
113
Lisp_Object QCOMPOUND_TEXT;	/* This is a type of selection.  */
Kenichi Handa's avatar
Kenichi Handa committed
114
Lisp_Object QUTF8_STRING;	/* This is a type of selection.  */
Karl Heuer's avatar
Karl Heuer committed
115

116
Lisp_Object Qcompound_text_with_extensions;
117

Richard M. Stallman's avatar
Richard M. Stallman committed
118 119 120 121 122
#ifdef CUT_BUFFER_SUPPORT
Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
  QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
#endif

123 124
static Lisp_Object Vx_lost_selection_functions;
static Lisp_Object Vx_sent_selection_functions;
125 126
/* Coding system for communicating with other X clients via cutbuffer,
   selection, and clipboard.  */
127
static Lisp_Object Vselection_coding_system;
Richard M. Stallman's avatar
Richard M. Stallman committed
128

129 130 131
/* Coding system for the next communicating with other X clients.  */
static Lisp_Object Vnext_selection_coding_system;

132 133
static Lisp_Object Qforeign_selection;

Richard M. Stallman's avatar
Richard M. Stallman committed
134 135 136
/* 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
137
   emacs to use incremental selection transfers when the selection is
Richard M. Stallman's avatar
Richard M. Stallman committed
138
   smaller than that, set this.  I added this mostly for debugging the
139
   incremental transfer stuff, but it might improve server performance.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
140 141
#define MAX_SELECTION_QUANTUM 0xFFFFFF

142 143 144 145 146
#ifdef HAVE_X11R4
#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
#else
#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
#endif
Richard M. Stallman's avatar
Richard M. Stallman committed
147

148
/* The timestamp of the last input event Emacs received from the X server.  */
149 150
/* Defined in keyboard.c.  */
extern unsigned long last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
151 152

/* This is an association list whose elements are of the form
153 154 155
     ( 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
156
     It may be any kind of Lisp object.
157
   SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
Richard M. Stallman's avatar
Richard M. Stallman committed
158
     as a cons of two 16-bit numbers (making a 32 bit time.)
159 160
   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
Richard M. Stallman's avatar
Richard M. Stallman committed
161 162
    that selection.
   The only (eq) parts of this list that are visible from Lisp are the
163 164
    selection-values.  */
static Lisp_Object Vselection_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
165 166 167

/* This is an alist whose CARs are selection-types (whose names are the same
   as the names of X Atoms) and whose CDRs are the names of Lisp functions to
168
   call to convert the given Emacs selection value to a string representing
Richard M. Stallman's avatar
Richard M. Stallman committed
169
   the given selection type.  This is for Lisp-level extension of the emacs
170 171
   selection handling.  */
static Lisp_Object Vselection_converter_alist;
Richard M. Stallman's avatar
Richard M. Stallman committed
172 173

/* If the selection owner takes too long to reply to a selection request,
174
   we give up on it.  This is in milliseconds (0 = no timeout.)  */
175
static EMACS_INT x_selection_timeout;
Richard M. Stallman's avatar
Richard M. Stallman committed
176

177 178


179 180
/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
   handling.  */
181 182 183 184 185 186 187 188 189

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

static struct selection_event_queue *selection_queue;

190
/* Nonzero means queue up SELECTION_REQUEST_EVENT events.  */
191 192 193

static int x_queue_selection_requests;

194
/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later.  */
195 196 197 198 199 200 201

static void
x_queue_event (event)
     struct input_event *event;
{
  struct selection_event_queue *queue_tmp;

202 203
  /* Don't queue repeated requests.
     This only happens for large requests which uses the incremental protocol.  */
204 205 206 207
  for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
    {
      if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
	{
208 209
	  TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
	  x_decline_selection_request (event);
210 211 212 213 214 215 216 217 218
	  return;
	}
    }

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

  if (queue_tmp != NULL)
    {
219
      TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
220 221 222 223 224 225
      queue_tmp->event = *event;
      queue_tmp->next = selection_queue;
      selection_queue = queue_tmp;
    }
}

226
/* Start queuing SELECTION_REQUEST_EVENT events.  */
227 228 229 230 231 232 233 234 235 236 237

static void
x_start_queuing_selection_requests ()
{
  if (x_queue_selection_requests)
    abort ();

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

238
/* Stop queuing SELECTION_REQUEST_EVENT events.  */
239 240 241 242 243 244 245 246 247 248 249 250 251

static void
x_stop_queuing_selection_requests ()
{
  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;
252
      TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
253 254 255 256 257 258 259
      kbd_buffer_unget_event (&queue_tmp->event);
      selection_queue = queue_tmp->next;
      xfree ((char *)queue_tmp);
    }
}


260
/* This converts a Lisp symbol to a server Atom, avoiding a server
Richard M. Stallman's avatar
Richard M. Stallman committed
261 262 263
   roundtrip whenever possible.  */

static Atom
264 265
symbol_to_x_atom (dpyinfo, display, sym)
     struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
266 267 268 269 270 271 272 273 274 275
     Display *display;
     Lisp_Object sym;
{
  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;
276 277 278
  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
279
  if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
280
  if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
281 282 283 284 285 286
  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
287 288 289 290 291 292 293 294 295 296 297 298
#ifdef CUT_BUFFER_SUPPORT
  if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
  if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
  if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
  if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
  if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
  if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
  if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
  if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
#endif
  if (!SYMBOLP (sym)) abort ();

299
  TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
Richard M. Stallman's avatar
Richard M. Stallman committed
300
  BLOCK_INPUT;
301
  val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
Richard M. Stallman's avatar
Richard M. Stallman committed
302 303 304 305 306 307 308 309 310
  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
311 312
x_atom_to_symbol (dpy, atom)
     Display *dpy;
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314
     Atom atom;
{
315
  struct x_display_info *dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
316 317
  char *str;
  Lisp_Object val;
318

319 320
  if (! atom)
    return Qnil;
321

322 323 324 325 326 327 328 329 330 331 332 333
  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;
Richard M. Stallman's avatar
Richard M. Stallman committed
334
#ifdef CUT_BUFFER_SUPPORT
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350
    case XA_CUT_BUFFER0:
      return QCUT_BUFFER0;
    case XA_CUT_BUFFER1:
      return QCUT_BUFFER1;
    case XA_CUT_BUFFER2:
      return QCUT_BUFFER2;
    case XA_CUT_BUFFER3:
      return QCUT_BUFFER3;
    case XA_CUT_BUFFER4:
      return QCUT_BUFFER4;
    case XA_CUT_BUFFER5:
      return QCUT_BUFFER5;
    case XA_CUT_BUFFER6:
      return QCUT_BUFFER6;
    case XA_CUT_BUFFER7:
      return QCUT_BUFFER7;
Richard M. Stallman's avatar
Richard M. Stallman committed
351
#endif
352 353
    }

354
  dpyinfo = x_display_info_for_display (dpy);
355
  if (atom == dpyinfo->Xatom_CLIPBOARD)
356
    return QCLIPBOARD;
357
  if (atom == dpyinfo->Xatom_TIMESTAMP)
358
    return QTIMESTAMP;
359
  if (atom == dpyinfo->Xatom_TEXT)
360
    return QTEXT;
Karl Heuer's avatar
Karl Heuer committed
361 362
  if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
    return QCOMPOUND_TEXT;
Kenichi Handa's avatar
Kenichi Handa committed
363 364
  if (atom == dpyinfo->Xatom_UTF8_STRING)
    return QUTF8_STRING;
365
  if (atom == dpyinfo->Xatom_DELETE)
366
    return QDELETE;
367
  if (atom == dpyinfo->Xatom_MULTIPLE)
368
    return QMULTIPLE;
369
  if (atom == dpyinfo->Xatom_INCR)
370
    return QINCR;
371
  if (atom == dpyinfo->Xatom_EMACS_TMP)
372
    return QEMACS_TMP;
373
  if (atom == dpyinfo->Xatom_TARGETS)
374
    return QTARGETS;
375
  if (atom == dpyinfo->Xatom_NULL)
376
    return QNULL;
Richard M. Stallman's avatar
Richard M. Stallman committed
377 378

  BLOCK_INPUT;
379
  str = XGetAtomName (dpy, atom);
Richard M. Stallman's avatar
Richard M. Stallman committed
380
  UNBLOCK_INPUT;
381
  TRACE1 ("XGetAtomName --> %s", str);
Richard M. Stallman's avatar
Richard M. Stallman committed
382 383 384
  if (! str) return Qnil;
  val = intern (str);
  BLOCK_INPUT;
385
  /* This was allocated by Xlib, so use XFree.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
386 387 388 389
  XFree (str);
  UNBLOCK_INPUT;
  return val;
}
390

Richard M. Stallman's avatar
Richard M. Stallman committed
391
/* Do protocol to assert ourself as a selection owner.
392
   Update the Vselection_alist so that we can reply to later requests for
Richard M. Stallman's avatar
Richard M. Stallman committed
393 394 395 396 397 398
   our selection.  */

static void
x_own_selection (selection_name, selection_value)
     Lisp_Object selection_name, selection_value;
{
399 400 401
  struct frame *sf = SELECTED_FRAME ();
  Window selecting_window = FRAME_X_WINDOW (sf);
  Display *display = FRAME_X_DISPLAY (sf);
402
  Time time = last_event_timestamp;
Richard M. Stallman's avatar
Richard M. Stallman committed
403
  Atom selection_atom;
404
  struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
405
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
406

407
  CHECK_SYMBOL (selection_name);
408
  selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
Richard M. Stallman's avatar
Richard M. Stallman committed
409 410

  BLOCK_INPUT;
411
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
412
  XSetSelectionOwner (display, selection_atom, selecting_window, time);
413
  x_check_errors (display, "Can't set selection: %s");
414
  x_uncatch_errors (display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
415 416 417 418 419 420 421 422 423 424 425
  UNBLOCK_INPUT;

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

    selection_time = long_to_cons ((unsigned long) time);
    selection_data = Fcons (selection_name,
			    Fcons (selection_value,
426
				   Fcons (selection_time,
427
					  Fcons (selected_frame, Qnil))));
Richard M. Stallman's avatar
Richard M. Stallman committed
428 429 430 431 432 433 434 435 436 437 438
    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.  */
	for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
439
	  if (EQ (prev_value, Fcar (XCDR (rest))))
Richard M. Stallman's avatar
Richard M. Stallman committed
440
	    {
441
	      XSETCDR (rest, Fcdr (XCDR (rest)));
Richard M. Stallman's avatar
Richard M. Stallman committed
442 443 444 445 446 447 448 449 450
	      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
451 452
   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
453 454 455 456

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

static Lisp_Object
Kenichi Handa's avatar
Kenichi Handa committed
457
x_get_local_selection (selection_symbol, target_type, local_request)
Richard M. Stallman's avatar
Richard M. Stallman committed
458
     Lisp_Object selection_symbol, target_type;
Kenichi Handa's avatar
Kenichi Handa committed
459
     int local_request;
Richard M. Stallman's avatar
Richard M. Stallman committed
460 461 462 463 464 465 466 467 468 469 470 471 472
{
  Lisp_Object local_value;
  Lisp_Object handler_fn, value, type, check;
  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;
473
      value = XCAR (XCDR (XCDR (local_value)));
Richard M. Stallman's avatar
Richard M. Stallman committed
474 475 476 477 478 479 480
    }
#if 0
  else if (EQ (target_type, QDELETE))
    {
      handler_fn = Qnil;
      Fx_disown_selection_internal
	(selection_symbol,
481
	 XCAR (XCDR (XCDR (local_value))));
Richard M. Stallman's avatar
Richard M. Stallman committed
482 483 484 485 486 487
      value = QNULL;
    }
#endif

#if 0 /* #### MULTIPLE doesn't work yet */
  else if (CONSP (target_type)
488
	   && XCAR (target_type) == QMULTIPLE)
Richard M. Stallman's avatar
Richard M. Stallman committed
489
    {
490 491
      Lisp_Object pairs;
      int size;
Richard M. Stallman's avatar
Richard M. Stallman committed
492
      int i;
493
      pairs = XCDR (target_type);
494
      size = XVECTOR (pairs)->size;
Richard M. Stallman's avatar
Richard M. Stallman committed
495 496 497 498 499 500 501
      /* 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++)
	{
502 503
	  Lisp_Object pair;
	  pair = XVECTOR (pairs)->contents [i];
Richard M. Stallman's avatar
Richard M. Stallman committed
504 505
	  XVECTOR (pair)->contents [1]
	    = x_get_local_selection (XVECTOR (pair)->contents [0],
Kenichi Handa's avatar
Kenichi Handa committed
506 507
				     XVECTOR (pair)->contents [1],
				     local_request);
Richard M. Stallman's avatar
Richard M. Stallman committed
508 509 510 511 512 513 514 515 516
	}
      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
517
      count = SPECPDL_INDEX ();
Richard M. Stallman's avatar
Richard M. Stallman committed
518 519
      specbind (Qinhibit_quit, Qt);

520
      CHECK_SYMBOL (target_type);
Richard M. Stallman's avatar
Richard M. Stallman committed
521
      handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
522 523 524
      /* gcpro is not needed here since nothing but HANDLER_FN
	 is live, and that ought to be a symbol.  */

525 526
      if (!NILP (handler_fn))
	value = call3 (handler_fn,
Kenichi Handa's avatar
Kenichi Handa committed
527
		       selection_symbol, (local_request ? Qnil : target_type),
528
		       XCAR (XCDR (local_value)));
529 530
      else
	value = Qnil;
Richard M. Stallman's avatar
Richard M. Stallman committed
531 532 533 534 535
      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
536

Richard M. Stallman's avatar
Richard M. Stallman committed
537 538
  check = value;
  if (CONSP (value)
539 540 541
      && SYMBOLP (XCAR (value)))
    type = XCAR (value),
    check = XCDR (value);
542

Richard M. Stallman's avatar
Richard M. Stallman committed
543 544 545
  if (STRINGP (check)
      || VECTORP (check)
      || SYMBOLP (check)
546
      || INTEGERP (check)
Richard M. Stallman's avatar
Richard M. Stallman committed
547 548
      || NILP (value))
    return value;
Richard M. Stallman's avatar
Richard M. Stallman committed
549
  /* Check for a value that cons_to_long could handle.  */
Richard M. Stallman's avatar
Richard M. Stallman committed
550
  else if (CONSP (check)
551 552
	   && INTEGERP (XCAR (check))
	   && (INTEGERP (XCDR (check))
Richard M. Stallman's avatar
Richard M. Stallman committed
553
	       ||
554 555 556
	       (CONSP (XCDR (check))
		&& INTEGERP (XCAR (XCDR (check)))
		&& NILP (XCDR (XCDR (check))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
557 558 559 560
    return value;
  else
    return
      Fsignal (Qerror,
Richard M. Stallman's avatar
Richard M. Stallman committed
561
	       Fcons (build_string ("invalid data returned by selection-conversion function"),
Richard M. Stallman's avatar
Richard M. Stallman committed
562 563 564 565 566
		      Fcons (handler_fn, Fcons (value, Qnil))));
}

/* Subroutines of x_reply_selection_request.  */

567
/* Send a SelectionNotify event to the requestor with property=None,
Richard M. Stallman's avatar
Richard M. Stallman committed
568 569 570 571 572 573 574
   meaning we were unable to do what they wanted.  */

static void
x_decline_selection_request (event)
     struct input_event *event;
{
  XSelectionEvent reply;
575
  int count;
576

Richard M. Stallman's avatar
Richard M. Stallman committed
577 578
  reply.type = SelectionNotify;
  reply.display = SELECTION_EVENT_DISPLAY (event);
579
  reply.requestor = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
580 581 582 583 584
  reply.selection = SELECTION_EVENT_SELECTION (event);
  reply.time = SELECTION_EVENT_TIME (event);
  reply.target = SELECTION_EVENT_TARGET (event);
  reply.property = None;

585 586
  /* 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
587
  BLOCK_INPUT;
588 589
  count = x_catch_errors (reply.display);
  XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
590
  XFlush (reply.display);
591
  x_uncatch_errors (reply.display, count);
Richard M. Stallman's avatar
Richard M. Stallman committed
592 593 594 595 596 597 598
  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;

599 600 601 602
/* Display info in x_selection_request.  */

static struct x_display_info *selection_request_dpyinfo;

Richard M. Stallman's avatar
Richard M. Stallman committed
603
/* Used as an unwind-protect clause so that, if a selection-converter signals
604
   an error, we tell the requester that we were unable to do what they wanted
Richard M. Stallman's avatar
Richard M. Stallman committed
605 606 607 608 609 610
   before we throw to top-level or go into the debugger or whatever.  */

static Lisp_Object
x_selection_request_lisp_error (ignore)
     Lisp_Object ignore;
{
611 612
  if (x_selection_current_request != 0
      && selection_request_dpyinfo->display)
Richard M. Stallman's avatar
Richard M. Stallman committed
613 614 615 616
    x_decline_selection_request (x_selection_current_request);
  return Qnil;
}

617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646

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

static struct prop_location *expect_property_change ();
static void wait_for_property_change ();
static void unexpect_property_change ();
static int waiting_for_other_props_on_window ();

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;
647 648

static Lisp_Object
649 650
queue_selection_requests_unwind (tem)
     Lisp_Object tem;
651
{
652
  x_stop_queuing_selection_requests ();
653
  return Qnil;
654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672
}

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

static Lisp_Object
some_frame_on_display (dpyinfo)
     struct x_display_info *dpyinfo;
{
  Lisp_Object list, frame;

  FOR_EACH_FRAME (list, frame)
    {
      if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
	return frame;
    }

  return Qnil;
}
673

Richard M. Stallman's avatar
Richard M. Stallman committed
674 675 676 677 678 679 680 681 682 683 684 685 686 687
/* 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.  */

static void
x_reply_selection_request (event, format, data, size, type)
     struct input_event *event;
     int format, size;
     unsigned char *data;
     Atom type;
{
  XSelectionEvent reply;
  Display *display = SELECTION_EVENT_DISPLAY (event);
688
  Window window = SELECTION_EVENT_REQUESTOR (event);
Richard M. Stallman's avatar
Richard M. Stallman committed
689 690 691
  int bytes_remaining;
  int format_bytes = format/8;
  int max_bytes = SELECTION_QUANTUM (display);
692
  struct x_display_info *dpyinfo = x_display_info_for_display (display);
693
  int count;
Richard M. Stallman's avatar
Richard M. Stallman committed
694 695 696 697 698 699

  if (max_bytes > MAX_SELECTION_QUANTUM)
    max_bytes = MAX_SELECTION_QUANTUM;

  reply.type = SelectionNotify;
  reply.display = display;
700
  reply.requestor = window;
Richard M. Stallman's avatar
Richard M. Stallman committed
701 702 703 704 705 706 707 708
  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;

  /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
709
  BLOCK_INPUT;
710
  count = x_catch_errors (display);
Richard M. Stallman's avatar
Richard M. Stallman committed
711

712 713 714 715 716 717 718 719 720 721 722
#ifdef TRACE_SELECTION
  {
    static int cnt;
    char *sel = XGetAtomName (display, reply.selection);
    char *tgt = XGetAtomName (display, reply.target);
    TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
    if (sel) XFree (sel);
    if (tgt) XFree (tgt);
  }
#endif /* TRACE_SELECTION */

Richard M. Stallman's avatar
Richard M. Stallman committed
723 724 725 726 727 728 729
  /* 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.  */
730
      TRACE1 ("Sending all %d bytes", bytes_remaining);
Richard M. Stallman's avatar
Richard M. Stallman committed
731 732 733
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, size);
      /* At this point, the selection was successfully stored; ack it.  */
734
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
Richard M. Stallman's avatar
Richard M. Stallman committed
735 736 737 738
    }
  else
    {
      /* Send an INCR selection.  */
739
      struct prop_location *wait_object;
740
      int had_errors;
741
      Lisp_Object frame;
Richard M. Stallman's avatar
Richard M. Stallman committed
742

743 744 745 746 747 748 749
      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))
	{
750
	  x_start_queuing_selection_requests ();
751 752

	  record_unwind_protect (queue_selection_requests_unwind,
753
				 Qnil);
754
	}
755

756
      if (x_window_to_frame (dpyinfo, window)) /* #### debug */
757
	error ("Attempt to transfer an INCR to ourself!");
758

759 760
      TRACE2 ("Start sending %d bytes incrementally (%s)",
	      bytes_remaining,  XGetAtomName (display, reply.property));
761 762
      wait_object = expect_property_change (display, window, reply.property,
					    PropertyDelete);
Richard M. Stallman's avatar
Richard M. Stallman committed
763

764 765
      TRACE1 ("Set %s to number of bytes to send",
	      XGetAtomName (display, reply.property));
766 767 768 769 770 771 772 773 774 775 776
      {
        /* 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
777
      XSelectInput (display, window, PropertyChangeMask);
778

Richard M. Stallman's avatar
Richard M. Stallman committed
779
      /* Tell 'em the INCR data is there...  */
780
      TRACE0 ("Send SelectionNotify event");
781
      XSendEvent (display, window, False, 0L, (XEvent *) &reply);
782
      XFlush (display);
783 784

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

787
      /* First, wait for the requester to ack by deleting the property.
Richard M. Stallman's avatar
Richard M. Stallman committed
788
	 This can run random lisp code (process handlers) or signal.  */
789
      if (! had_errors)
790 791 792 793 794
	{
	  TRACE1 ("Waiting for ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
	  wait_for_property_change (wait_object);
	}
795 796
      else
	unexpect_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
797

798
      TRACE0 ("Got ACK");
Richard M. Stallman's avatar
Richard M. Stallman committed
799 800
      while (bytes_remaining)
	{
801 802 803
          int i = ((bytes_remaining < max_bytes)
                   ? bytes_remaining
                   : max_bytes);
804 805 806

	  BLOCK_INPUT;

807 808 809
	  wait_object
	    = expect_property_change (display, window, reply.property,
				      PropertyDelete);
810 811 812 813

	  TRACE1 ("Sending increment of %d bytes", i);
	  TRACE1 ("Set %s to increment data",
		  XGetAtomName (display, reply.property));
814

Richard M. Stallman's avatar
Richard M. Stallman committed
815 816 817 818 819
	  /* Append the next chunk of data to the property.  */
	  XChangeProperty (display, window, reply.property, type, format,
			   PropModeAppend, data, i / format_bytes);
	  bytes_remaining -= i;
	  data += i;
820
	  XFlush (display);
821
	  had_errors = x_had_errors_p (display);
822
	  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
823

824 825 826
	  if (had_errors)
	    break;

827
	  /* Now wait for the requester to ack this chunk by deleting the
828 829 830
	     property.	 This can run random lisp code or signal.  */
	  TRACE1 ("Waiting for increment ACK (deletion of %s)",
		  XGetAtomName (display, reply.property));
831
	  wait_for_property_change (wait_object);
Richard M. Stallman's avatar
Richard M. Stallman committed
832
	}
833

834 835
      /* Now write a zero-length chunk to the property to tell the
	 requester that we're done.  */
836
      BLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
837 838 839
      if (! waiting_for_other_props_on_window (display, window))
	XSelectInput (display, window, 0L);

840 841
      TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
	      XGetAtomName (display, reply.property));
Richard M. Stallman's avatar
Richard M. Stallman committed
842 843
      XChangeProperty (display, window, reply.property, type, format,
		       PropModeReplace, data, 0);
844
      TRACE0 ("Done sending incrementally");
Richard M. Stallman's avatar
Richard M. Stallman committed
845
    }
846

Richard M. Stallman's avatar
Richard M. Stallman committed
847
  /* rms, 2003-01-03: I think I have fixed this bug.  */
848 849 850 851 852 853
  /* 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.   */
854 855 856
  /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
     delivered before uncatch errors.  */
  XSync (display, False);
857
  UNBLOCK_INPUT;
858 859 860 861 862

  /* 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;
863
  x_uncatch_errors (display, count);
864
  UNBLOCK_INPUT;
Richard M. Stallman's avatar
Richard M. Stallman committed
865 866 867 868 869
}

/* Handle a SelectionRequest event EVENT.
   This is called from keyboard.c when such an event is found in the queue.  */

870
static void
Richard M. Stallman's avatar
Richard M. Stallman committed
871 872 873 874
x_handle_selection_request (event)
     struct input_event *event;
{
  struct gcpro gcpro1, gcpro2, gcpro3;
875
  Lisp_Object local_selection_data;
Richard M. Stallman's avatar
Richard M. Stallman committed
876
  Lisp_Object selection_symbol;
877 878
  Lisp_Object target_symbol;
  Lisp_Object converted_selection;
Richard M. Stallman's avatar
Richard M. Stallman committed
879
  Time local_selection_time;
880
  Lisp_Object successful_p;
Richard M. Stallman's avatar
Richard M. Stallman committed
881
  int count;
882 883
  struct x_display_info *dpyinfo
    = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
Richard M. Stallman's avatar
Richard M. Stallman committed
884

885 886 887
  TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
	  (unsigned long) SELECTION_EVENT_REQUESTOR (event),
	  (unsigned long) SELECTION_EVENT_TIME (event));
888

889 890 891 892 893
  local_selection_data = Qnil;
  target_symbol = Qnil;
  converted_selection = Qnil;
  successful_p = Qnil;

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

896
  selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
897 898 899 900 901 902 903 904 905 906 907 908 909
				       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)
910
    cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
Richard M. Stallman's avatar
Richard M. Stallman committed
911 912

  if (SELECTION_EVENT_TIME (event) != CurrentTime
913
      && local_selection_time > SELECTION_EVENT_TIME (event))
Richard M. Stallman's avatar
Richard M. Stallman committed
914 915 916 917 918 919 920 921 922
    {
      /* 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;
923
  count = SPECPDL_INDEX ();
924
  selection_request_dpyinfo = dpyinfo;
Richard M. Stallman's avatar
Richard M. Stallman committed
925 926
  record_unwind_protect (x_selection_request_lisp_error, Qnil);

927
  target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
Richard M. Stallman's avatar
Richard M. Stallman committed
928 929 930 931 932 933
				    SELECTION_EVENT_TARGET (event));

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

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

Richard M. Stallman's avatar
Richard M. Stallman committed
937
  converted_selection
Kenichi Handa's avatar
Kenichi Handa committed
938
    = x_get_local_selection (selection_symbol, target_symbol, 0);
939

Richard M. Stallman's avatar
Richard M. Stallman committed
940 941 942 943 944 945
  if (! NILP (converted_selection))
    {
      unsigned char *data;
      unsigned int size;
      int format;
      Atom type;
946 947
      int nofree;

948 949
      lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
				   converted_selection,
950
				   &data, &type, &size, &format, &nofree);
951

Richard M. Stallman's avatar
Richard M. Stallman committed
952 953 954 955
      x_reply_selection_request (event, format, data, size, type);
      successful_p = Qt;

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

958
      /* Use xfree, not XFree, because lisp_data_to_selection_data
959
	 calls xmalloc itself.  */
960
      if (!nofree)
961
	xfree (data);
Richard M. Stallman's avatar
Richard M. Stallman committed
962 963 964 965 966 967 968
    }
  unbind_to (count, Qnil);

 DONE:

  /* Let random lisp code notice that the selection has been asked for.  */
  {
969
    Lisp_Object rest;
970
    rest = Vx_sent_selection_functions;
Richard M. Stallman's avatar
Richard M. Stallman committed
971 972 973 974
    if (!EQ (rest, Qunbound))
      for (; CONSP (rest); rest = Fcdr (rest))
	call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
  }
975 976

  UNGCPRO;
Richard M. Stallman's avatar
Richard M. Stallman committed
977 978
}

979
/* Handle a SelectionClear event EVENT, which indicates that some
Richard M. Stallman's avatar
Richard M. Stallman committed
980 981 982
   client cleared out our previously asserted selection.
   This is called from keyboard.c when such an event is found in the queue.  */

983
static void
Richard M. Stallman's avatar
Richard M. Stallman committed
984 985 986 987 988