Fix doc-string of pop-to-buffer-same-window. (Bug#15492)
[bpt/emacs.git] / src / xselect.c
CommitLineData
2408b3a1 1/* X Selection processing for Emacs.
ab422c4d 2 Copyright (C) 1993-1997, 2000-2013 Free Software Foundation, Inc.
ede4db72
RS
3
4This file is part of GNU Emacs.
5
9ec0b715 6GNU Emacs is free software: you can redistribute it and/or modify
ede4db72 7it under the terms of the GNU General Public License as published by
9ec0b715
GM
8the Free Software Foundation, either version 3 of the License, or
9(at your option) any later version.
ede4db72
RS
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
9ec0b715 17along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
ede4db72 18
c6c5df7f 19
ede4db72
RS
20/* Rewritten by jwz */
21
18160b98 22#include <config.h>
be44ca6c 23#include <limits.h>
5b698285 24#include <stdio.h> /* termhooks.h needs this */
678b3958
KS
25
26#ifdef HAVE_SYS_TYPES_H
27#include <sys/types.h>
28#endif
4004364e 29
678b3958 30#include <unistd.h>
678b3958 31
ede4db72
RS
32#include "lisp.h"
33#include "xterm.h" /* for all of the X includes */
7da64e5c
RS
34#include "dispextern.h" /* frame.h seems to want this */
35#include "frame.h" /* Need this to get the X window of selected_frame */
9ac0d9e0 36#include "blockinput.h"
e5560ff7 37#include "character.h"
5faa9b45 38#include "buffer.h"
dfcf069d 39#include "process.h"
1fb3821b 40#include "termhooks.h"
dd0fe424 41#include "keyboard.h"
1fb3821b
JD
42
43#include <X11/Xproto.h>
7da64e5c 44
d9c0d4a3 45struct prop_location;
e067f0c1 46struct selection_data;
d9c0d4a3 47
f57e2426 48static void x_decline_selection_request (struct input_event *);
e067f0c1 49static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
a9f737ee 50 Atom, int, struct x_display_info *);
f57e2426
J
51static int waiting_for_other_props_on_window (Display *, Window);
52static struct prop_location *expect_property_change (Display *, Window,
53 Atom, int);
54static void unexpect_property_change (struct prop_location *);
f57e2426 55static void wait_for_property_change (struct prop_location *);
f57e2426
J
56static Lisp_Object x_get_window_property_as_lisp_data (Display *,
57 Window, Atom,
58 Lisp_Object, Atom);
eec47d6b
DN
59static Lisp_Object selection_data_to_lisp_data (Display *,
60 const unsigned char *,
864d7ce7 61 ptrdiff_t, Atom, int);
f57e2426
J
62static void lisp_data_to_selection_data (Display *, Lisp_Object,
63 unsigned char **, Atom *,
864d7ce7 64 ptrdiff_t *, int *, int *);
d9c0d4a3
GM
65
66/* Printing traces to stderr. */
67
68#ifdef TRACE_SELECTION
69#define TRACE0(fmt) \
d311d28c 70 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
d9c0d4a3 71#define TRACE1(fmt, a0) \
d311d28c 72 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
d9c0d4a3 73#define TRACE2(fmt, a0, a1) \
d311d28c 74 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
9c3ad9e1 75#define TRACE3(fmt, a0, a1, a2) \
d311d28c 76 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
d9c0d4a3
GM
77#else
78#define TRACE0(fmt) (void) 0
79#define TRACE1(fmt, a0) (void) 0
80#define TRACE2(fmt, a0, a1) (void) 0
81#endif
82
83
955cbe7b 84static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
ede4db72 85 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
a9f737ee 86 QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;
ede4db72 87
955cbe7b
PE
88static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
89static Lisp_Object QUTF8_STRING; /* This is a type of selection. */
e6c7c988 90
955cbe7b 91static Lisp_Object Qcompound_text_with_extensions;
fbbe0ace 92
e57ad4d8 93static Lisp_Object Qforeign_selection;
cd18e7e3 94static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions;
e57ad4d8 95
864d7ce7
PE
96/* Bytes needed to represent 'long' data. This is as per libX11; it
97 is not necessarily sizeof (long). */
98#define X_LONG_SIZE 4
99
252c5ee1
PE
100/* Extreme 'short' and 'long' values suitable for libX11. */
101#define X_SHRT_MAX 0x7fff
102#define X_SHRT_MIN (-1 - X_SHRT_MAX)
103#define X_LONG_MAX 0x7fffffff
104#define X_LONG_MIN (-1 - X_LONG_MAX)
2e621251 105#define X_ULONG_MAX 0xffffffffUL
864d7ce7 106
ede4db72
RS
107/* If this is a smaller number than the max-request-size of the display,
108 emacs will use INCR selection transfer when the selection is larger
109 than this. The max-request-size is usually around 64k, so if you want
1b65481e 110 emacs to use incremental selection transfers when the selection is
ede4db72 111 smaller than that, set this. I added this mostly for debugging the
864d7ce7
PE
112 incremental transfer stuff, but it might improve server performance.
113
114 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
115 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
116 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
117 - 1 in place of INT_MAX. */
118#define MAX_SELECTION_QUANTUM \
119 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
120 / max (X_LONG_SIZE, sizeof (long)))))
ede4db72 121
864d7ce7
PE
122static int
123selection_quantum (Display *display)
124{
125 long mrs = XMaxRequestSize (display);
126 return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25
127 ? (mrs - 25) * X_LONG_SIZE
128 : MAX_SELECTION_QUANTUM);
129}
ede4db72 130
a9f737ee
CY
131#define LOCAL_SELECTION(selection_symbol,dpyinfo) \
132 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
dd0fe424
KS
133
134\f
678b3958
KS
135/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
136 handling. */
dd0fe424
KS
137
138struct selection_event_queue
139 {
140 struct input_event event;
141 struct selection_event_queue *next;
142 };
143
144static struct selection_event_queue *selection_queue;
145
678b3958 146/* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
147
148static int x_queue_selection_requests;
149
678b3958 150/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
dd0fe424
KS
151
152static void
971de7fb 153x_queue_event (struct input_event *event)
dd0fe424
KS
154{
155 struct selection_event_queue *queue_tmp;
156
678b3958
KS
157 /* Don't queue repeated requests.
158 This only happens for large requests which uses the incremental protocol. */
dd0fe424
KS
159 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
160 {
72af86bd 161 if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
dd0fe424 162 {
6f04d126 163 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
678b3958 164 x_decline_selection_request (event);
dd0fe424
KS
165 return;
166 }
167 }
168
38182d90 169 queue_tmp = xmalloc (sizeof *queue_tmp);
23f86fce
DA
170 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
171 queue_tmp->event = *event;
172 queue_tmp->next = selection_queue;
173 selection_queue = queue_tmp;
dd0fe424
KS
174}
175
678b3958 176/* Start queuing SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
177
178static void
971de7fb 179x_start_queuing_selection_requests (void)
dd0fe424
KS
180{
181 if (x_queue_selection_requests)
1088b922 182 emacs_abort ();
dd0fe424
KS
183
184 x_queue_selection_requests++;
185 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
186}
187
678b3958 188/* Stop queuing SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
189
190static void
971de7fb 191x_stop_queuing_selection_requests (void)
dd0fe424
KS
192{
193 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
194 --x_queue_selection_requests;
195
196 /* Take all the queued events and put them back
197 so that they get processed afresh. */
198
199 while (selection_queue != NULL)
200 {
201 struct selection_event_queue *queue_tmp = selection_queue;
6f04d126 202 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
dd0fe424
KS
203 kbd_buffer_unget_event (&queue_tmp->event);
204 selection_queue = queue_tmp->next;
98c6f1e3 205 xfree (queue_tmp);
dd0fe424
KS
206 }
207}
208\f
209
1b65481e 210/* This converts a Lisp symbol to a server Atom, avoiding a server
ede4db72
RS
211 roundtrip whenever possible. */
212
213static Atom
a9f737ee 214symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
ede4db72
RS
215{
216 Atom val;
217 if (NILP (sym)) return 0;
218 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
219 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
220 if (EQ (sym, QSTRING)) return XA_STRING;
221 if (EQ (sym, QINTEGER)) return XA_INTEGER;
222 if (EQ (sym, QATOM)) return XA_ATOM;
5c3a351a
RS
223 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
224 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
225 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
e6c7c988 226 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
5109c8dd 227 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
5c3a351a
RS
228 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
229 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
230 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
231 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
232 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
233 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
1088b922 234 if (!SYMBOLP (sym)) emacs_abort ();
ede4db72 235
51b59d79 236 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
4d7e6e51 237 block_input ();
a9f737ee 238 val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
4d7e6e51 239 unblock_input ();
ede4db72
RS
240 return val;
241}
242
243
244/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
245 and calls to intern whenever possible. */
246
247static Lisp_Object
971de7fb 248x_atom_to_symbol (Display *dpy, Atom atom)
ede4db72 249{
d9c0d4a3 250 struct x_display_info *dpyinfo;
ede4db72
RS
251 char *str;
252 Lisp_Object val;
1b65481e 253
d9c0d4a3
GM
254 if (! atom)
255 return Qnil;
1b65481e 256
7da64e5c
RS
257 switch (atom)
258 {
259 case XA_PRIMARY:
260 return QPRIMARY;
261 case XA_SECONDARY:
262 return QSECONDARY;
263 case XA_STRING:
264 return QSTRING;
265 case XA_INTEGER:
266 return QINTEGER;
267 case XA_ATOM:
268 return QATOM;
7da64e5c
RS
269 }
270
d9c0d4a3 271 dpyinfo = x_display_info_for_display (dpy);
a9f737ee
CY
272 if (dpyinfo == NULL)
273 return Qnil;
5c3a351a 274 if (atom == dpyinfo->Xatom_CLIPBOARD)
7da64e5c 275 return QCLIPBOARD;
5c3a351a 276 if (atom == dpyinfo->Xatom_TIMESTAMP)
7da64e5c 277 return QTIMESTAMP;
5c3a351a 278 if (atom == dpyinfo->Xatom_TEXT)
7da64e5c 279 return QTEXT;
e6c7c988
KH
280 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
281 return QCOMPOUND_TEXT;
5109c8dd
KH
282 if (atom == dpyinfo->Xatom_UTF8_STRING)
283 return QUTF8_STRING;
5c3a351a 284 if (atom == dpyinfo->Xatom_DELETE)
7da64e5c 285 return QDELETE;
5c3a351a 286 if (atom == dpyinfo->Xatom_MULTIPLE)
7da64e5c 287 return QMULTIPLE;
5c3a351a 288 if (atom == dpyinfo->Xatom_INCR)
7da64e5c 289 return QINCR;
5c3a351a 290 if (atom == dpyinfo->Xatom_EMACS_TMP)
7da64e5c 291 return QEMACS_TMP;
5c3a351a 292 if (atom == dpyinfo->Xatom_TARGETS)
7da64e5c 293 return QTARGETS;
5c3a351a 294 if (atom == dpyinfo->Xatom_NULL)
7da64e5c 295 return QNULL;
ede4db72 296
4d7e6e51 297 block_input ();
d9c0d4a3 298 str = XGetAtomName (dpy, atom);
4d7e6e51 299 unblock_input ();
d9c0d4a3 300 TRACE1 ("XGetAtomName --> %s", str);
ede4db72
RS
301 if (! str) return Qnil;
302 val = intern (str);
4d7e6e51 303 block_input ();
0158abbc 304 /* This was allocated by Xlib, so use XFree. */
ede4db72 305 XFree (str);
4d7e6e51 306 unblock_input ();
ede4db72
RS
307 return val;
308}
8a89415e 309\f
ede4db72 310/* Do protocol to assert ourself as a selection owner.
a9f737ee 311 FRAME shall be the owner; it must be a valid X frame.
1b65481e 312 Update the Vselection_alist so that we can reply to later requests for
ede4db72
RS
313 our selection. */
314
315static void
a9f737ee
CY
316x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
317 Lisp_Object frame)
ede4db72 318{
a9f737ee
CY
319 struct frame *f = XFRAME (frame);
320 Window selecting_window = FRAME_X_WINDOW (f);
aad3612f 321 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee 322 Display *display = dpyinfo->display;
aa0daa9f 323 Time timestamp = last_event_timestamp;
a9f737ee 324 Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
ede4db72 325
4d7e6e51 326 block_input ();
9ba8e10d 327 x_catch_errors (display);
aa0daa9f 328 XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
a7b24d46 329 x_check_errors (display, "Can't set selection: %s");
4545fa20 330 x_uncatch_errors ();
4d7e6e51 331 unblock_input ();
ede4db72
RS
332
333 /* Now update the local cache */
334 {
ede4db72
RS
335 Lisp_Object selection_data;
336 Lisp_Object prev_value;
337
16041401 338 selection_data = list4 (selection_name, selection_value,
be44ca6c 339 INTEGER_TO_CONS (timestamp), frame);
a9f737ee 340 prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
ede4db72 341
3f22b86f
PE
342 tset_selection_alist
343 (dpyinfo->terminal,
344 Fcons (selection_data, dpyinfo->terminal->Vselection_alist));
ede4db72 345
a9f737ee
CY
346 /* If we already owned the selection, remove the old selection
347 data. Don't use Fdelq as that may QUIT. */
ede4db72
RS
348 if (!NILP (prev_value))
349 {
a9f737ee
CY
350 /* We know it's not the CAR, so it's easy. */
351 Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
352 for (; CONSP (rest); rest = XCDR (rest))
8e713be6 353 if (EQ (prev_value, Fcar (XCDR (rest))))
ede4db72 354 {
a9f737ee 355 XSETCDR (rest, XCDR (XCDR (rest)));
ede4db72
RS
356 break;
357 }
358 }
359 }
360}
361\f
362/* Given a selection-name and desired type, look up our local copy of
363 the selection value and convert it to the type.
2e621251
PE
364 Return nil, a string, a vector, a symbol, an integer, or a cons
365 that CONS_TO_INTEGER could plausibly handle.
5109c8dd
KH
366 This function is used both for remote requests (LOCAL_REQUEST is zero)
367 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
ede4db72
RS
368
369 This calls random Lisp code, and may signal or gc. */
370
371static Lisp_Object
a9f737ee
CY
372x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
373 int local_request, struct x_display_info *dpyinfo)
ede4db72
RS
374{
375 Lisp_Object local_value;
6abdaa4a 376 Lisp_Object handler_fn, value, check;
ede4db72 377
a9f737ee 378 local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
ede4db72
RS
379
380 if (NILP (local_value)) return Qnil;
381
a9f737ee 382 /* TIMESTAMP is a special case. */
ede4db72
RS
383 if (EQ (target_type, QTIMESTAMP))
384 {
385 handler_fn = Qnil;
8e713be6 386 value = XCAR (XCDR (XCDR (local_value)));
ede4db72 387 }
ede4db72
RS
388 else
389 {
390 /* Don't allow a quit within the converter.
391 When the user types C-g, he would be surprised
392 if by luck it came during a converter. */
d311d28c 393 ptrdiff_t count = SPECPDL_INDEX ();
ede4db72
RS
394 specbind (Qinhibit_quit, Qt);
395
b7826503 396 CHECK_SYMBOL (target_type);
ede4db72 397 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
4f06187f
RS
398 /* gcpro is not needed here since nothing but HANDLER_FN
399 is live, and that ought to be a symbol. */
400
1eb4d468
RS
401 if (!NILP (handler_fn))
402 value = call3 (handler_fn,
5109c8dd 403 selection_symbol, (local_request ? Qnil : target_type),
8e713be6 404 XCAR (XCDR (local_value)));
1eb4d468
RS
405 else
406 value = Qnil;
ede4db72
RS
407 unbind_to (count, Qnil);
408 }
409
410 /* Make sure this value is of a type that we could transmit
411 to another X client. */
a87ed99c 412
ede4db72
RS
413 check = value;
414 if (CONSP (value)
8e713be6 415 && SYMBOLP (XCAR (value)))
8e713be6 416 check = XCDR (value);
1b65481e 417
ede4db72
RS
418 if (STRINGP (check)
419 || VECTORP (check)
420 || SYMBOLP (check)
7da64e5c 421 || INTEGERP (check)
ede4db72
RS
422 || NILP (value))
423 return value;
be44ca6c 424 /* Check for a value that CONS_TO_INTEGER could handle. */
ede4db72 425 else if (CONSP (check)
8e713be6
KR
426 && INTEGERP (XCAR (check))
427 && (INTEGERP (XCDR (check))
ede4db72 428 ||
8e713be6
KR
429 (CONSP (XCDR (check))
430 && INTEGERP (XCAR (XCDR (check)))
431 && NILP (XCDR (XCDR (check))))))
ede4db72 432 return value;
4d30ce50
KS
433
434 signal_error ("Invalid data returned by selection-conversion function",
435 list2 (handler_fn, value));
ede4db72
RS
436}
437\f
438/* Subroutines of x_reply_selection_request. */
439
5d0ba25b 440/* Send a SelectionNotify event to the requestor with property=None,
ede4db72
RS
441 meaning we were unable to do what they wanted. */
442
443static void
971de7fb 444x_decline_selection_request (struct input_event *event)
ede4db72 445{
65969f63
CY
446 XEvent reply_base;
447 XSelectionEvent *reply = &(reply_base.xselection);
1b65481e 448
65969f63
CY
449 reply->type = SelectionNotify;
450 reply->display = SELECTION_EVENT_DISPLAY (event);
451 reply->requestor = SELECTION_EVENT_REQUESTOR (event);
452 reply->selection = SELECTION_EVENT_SELECTION (event);
453 reply->time = SELECTION_EVENT_TIME (event);
454 reply->target = SELECTION_EVENT_TARGET (event);
455 reply->property = None;
ede4db72 456
d9c0d4a3
GM
457 /* The reason for the error may be that the receiver has
458 died in the meantime. Handle that case. */
4d7e6e51 459 block_input ();
65969f63
CY
460 x_catch_errors (reply->display);
461 XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
462 XFlush (reply->display);
4545fa20 463 x_uncatch_errors ();
4d7e6e51 464 unblock_input ();
ede4db72
RS
465}
466
467/* This is the selection request currently being processed.
468 It is set to zero when the request is fully processed. */
469static struct input_event *x_selection_current_request;
470
ca29f2b8
GM
471/* Display info in x_selection_request. */
472
473static struct x_display_info *selection_request_dpyinfo;
474
e067f0c1
CY
475/* Raw selection data, for sending to a requestor window. */
476
477struct selection_data
478{
479 unsigned char *data;
864d7ce7 480 ptrdiff_t size;
e067f0c1
CY
481 int format;
482 Atom type;
483 int nofree;
484 Atom property;
485 /* This can be set to non-NULL during x_reply_selection_request, if
486 the selection is waiting for an INCR transfer to complete. Don't
487 free these; that's done by unexpect_property_change. */
488 struct prop_location *wait_object;
489 struct selection_data *next;
490};
491
492/* Linked list of the above (in support of MULTIPLE targets). */
493
0196f88a 494static struct selection_data *converted_selections;
e067f0c1
CY
495
496/* "Data" to send a requestor for a failed MULTIPLE subtarget. */
0196f88a 497static Atom conversion_fail_tag;
e067f0c1 498
ede4db72 499/* Used as an unwind-protect clause so that, if a selection-converter signals
fa463103 500 an error, we tell the requestor that we were unable to do what they wanted
ede4db72
RS
501 before we throw to top-level or go into the debugger or whatever. */
502
27e498e6
PE
503static void
504x_selection_request_lisp_error (void)
ede4db72 505{
e067f0c1
CY
506 struct selection_data *cs, *next;
507
508 for (cs = converted_selections; cs; cs = next)
509 {
510 next = cs->next;
511 if (cs->nofree == 0 && cs->data)
512 xfree (cs->data);
513 xfree (cs);
514 }
515 converted_selections = NULL;
516
ca29f2b8
GM
517 if (x_selection_current_request != 0
518 && selection_request_dpyinfo->display)
ede4db72 519 x_decline_selection_request (x_selection_current_request);
ede4db72 520}
c525d842 521
27e498e6
PE
522static void
523x_catch_errors_unwind (void)
c525d842 524{
4d7e6e51 525 block_input ();
c525d842 526 x_uncatch_errors ();
4d7e6e51 527 unblock_input ();
c525d842 528}
ede4db72 529\f
d1f21a66
RS
530
531/* This stuff is so that INCR selections are reentrant (that is, so we can
532 be servicing multiple INCR selection requests simultaneously.) I haven't
533 actually tested that yet. */
534
535/* Keep a list of the property changes that are awaited. */
536
537struct prop_location
538{
539 int identifier;
540 Display *display;
541 Window window;
542 Atom property;
543 int desired_state;
544 int arrived;
545 struct prop_location *next;
546};
547
d1f21a66
RS
548static int prop_location_identifier;
549
550static Lisp_Object property_change_reply;
551
552static struct prop_location *property_change_reply_object;
553
554static struct prop_location *property_change_wait_list;
55b2d45d 555
d1f21a66 556\f
e067f0c1 557/* Send the reply to a selection request event EVENT. */
ede4db72 558
46d47e41 559#ifdef TRACE_SELECTION
ca7af97a 560static int x_reply_selection_request_cnt;
46d47e41
GM
561#endif /* TRACE_SELECTION */
562
ede4db72 563static void
5e617bc2
JB
564x_reply_selection_request (struct input_event *event,
565 struct x_display_info *dpyinfo)
ede4db72 566{
65969f63
CY
567 XEvent reply_base;
568 XSelectionEvent *reply = &(reply_base.xselection);
ede4db72 569 Display *display = SELECTION_EVENT_DISPLAY (event);
5d0ba25b 570 Window window = SELECTION_EVENT_REQUESTOR (event);
864d7ce7
PE
571 ptrdiff_t bytes_remaining;
572 int max_bytes = selection_quantum (display);
d311d28c 573 ptrdiff_t count = SPECPDL_INDEX ();
e067f0c1 574 struct selection_data *cs;
ede4db72 575
65969f63
CY
576 reply->type = SelectionNotify;
577 reply->display = display;
578 reply->requestor = window;
579 reply->selection = SELECTION_EVENT_SELECTION (event);
580 reply->time = SELECTION_EVENT_TIME (event);
581 reply->target = SELECTION_EVENT_TARGET (event);
582 reply->property = SELECTION_EVENT_PROPERTY (event);
583 if (reply->property == None)
584 reply->property = reply->target;
ede4db72 585
4d7e6e51 586 block_input ();
c525d842
CY
587 /* The protected block contains wait_for_property_change, which can
588 run random lisp code (process handlers) or signal. Therefore, we
589 put the x_uncatch_errors call in an unwind. */
27e498e6 590 record_unwind_protect_void (x_catch_errors_unwind);
9ba8e10d 591 x_catch_errors (display);
ede4db72 592
e067f0c1
CY
593 /* Loop over converted selections, storing them in the requested
594 properties. If data is large, only store the first N bytes
595 (section 2.7.2 of ICCCM). Note that we store the data for a
596 MULTIPLE request in the opposite order; the ICCM says only that
597 the conversion itself must be done in the same order. */
598 for (cs = converted_selections; cs; cs = cs->next)
599 {
a9f737ee
CY
600 if (cs->property == None)
601 continue;
602
864d7ce7
PE
603 bytes_remaining = cs->size;
604 bytes_remaining *= cs->format >> 3;
a9f737ee 605 if (bytes_remaining <= max_bytes)
e067f0c1 606 {
a9f737ee 607 /* Send all the data at once, with minimal handshaking. */
864d7ce7 608 TRACE1 ("Sending all %"pD"d bytes", bytes_remaining);
a9f737ee
CY
609 XChangeProperty (display, window, cs->property,
610 cs->type, cs->format, PropModeReplace,
611 cs->data, cs->size);
612 }
613 else
614 {
615 /* Send an INCR tag to initiate incremental transfer. */
252c5ee1 616 long value[1];
a9f737ee 617
864d7ce7 618 TRACE2 ("Start sending %"pD"d bytes incrementally (%s)",
a9f737ee
CY
619 bytes_remaining, XGetAtomName (display, cs->property));
620 cs->wait_object
621 = expect_property_change (display, window, cs->property,
622 PropertyDelete);
623
624 /* XChangeProperty expects an array of long even if long is
625 more than 32 bits. */
252c5ee1 626 value[0] = min (bytes_remaining, X_LONG_MAX);
a9f737ee
CY
627 XChangeProperty (display, window, cs->property,
628 dpyinfo->Xatom_INCR, 32, PropModeReplace,
629 (unsigned char *) value, 1);
630 XSelectInput (display, window, PropertyChangeMask);
e067f0c1
CY
631 }
632 }
633
634 /* Now issue the SelectionNotify event. */
635 XSendEvent (display, window, False, 0L, &reply_base);
636 XFlush (display);
637
9c3ad9e1
JD
638#ifdef TRACE_SELECTION
639 {
65969f63
CY
640 char *sel = XGetAtomName (display, reply->selection);
641 char *tgt = XGetAtomName (display, reply->target);
e067f0c1
CY
642 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
643 sel, tgt, ++x_reply_selection_request_cnt);
9c3ad9e1
JD
644 if (sel) XFree (sel);
645 if (tgt) XFree (tgt);
646 }
647#endif /* TRACE_SELECTION */
648
e067f0c1
CY
649 /* Finish sending the rest of each of the INCR values. This should
650 be improved; there's a chance of deadlock if more than one
651 subtarget in a MULTIPLE selection requires an INCR transfer, and
652 the requestor and Emacs loop waiting on different transfers. */
653 for (cs = converted_selections; cs; cs = cs->next)
654 if (cs->wait_object)
e22cf39c 655 {
e067f0c1 656 int format_bytes = cs->format / 8;
d7e6881a 657 bool had_errors_p = x_had_errors_p (display);
4d7e6e51 658 unblock_input ();
1b65481e 659
864d7ce7
PE
660 bytes_remaining = cs->size;
661 bytes_remaining *= format_bytes;
ede4db72 662
fa463103 663 /* Wait for the requestor to ack by deleting the property.
e067f0c1 664 This can run Lisp code (process handlers) or signal. */
d7e6881a 665 if (! had_errors_p)
e067f0c1
CY
666 {
667 TRACE1 ("Waiting for ACK (deletion of %s)",
668 XGetAtomName (display, cs->property));
669 wait_for_property_change (cs->wait_object);
670 }
671 else
672 unexpect_property_change (cs->wait_object);
ede4db72 673
e067f0c1
CY
674 while (bytes_remaining)
675 {
676 int i = ((bytes_remaining < max_bytes)
677 ? bytes_remaining
678 : max_bytes) / format_bytes;
4d7e6e51 679 block_input ();
e067f0c1
CY
680
681 cs->wait_object
682 = expect_property_change (display, window, cs->property,
683 PropertyDelete);
684
685 TRACE1 ("Sending increment of %d elements", i);
686 TRACE1 ("Set %s to increment data",
687 XGetAtomName (display, cs->property));
688
689 /* Append the next chunk of data to the property. */
690 XChangeProperty (display, window, cs->property,
691 cs->type, cs->format, PropModeAppend,
692 cs->data, i);
693 bytes_remaining -= i * format_bytes;
a9f737ee
CY
694 cs->data += i * ((cs->format == 32) ? sizeof (long)
695 : format_bytes);
e067f0c1 696 XFlush (display);
d7e6881a 697 had_errors_p = x_had_errors_p (display);
4d7e6e51 698 unblock_input ();
ede4db72 699
d7e6881a 700 if (had_errors_p) break;
afe1529d 701
fa463103 702 /* Wait for the requestor to ack this chunk by deleting
e067f0c1
CY
703 the property. This can run Lisp code or signal. */
704 TRACE1 ("Waiting for increment ACK (deletion of %s)",
705 XGetAtomName (display, cs->property));
706 wait_for_property_change (cs->wait_object);
707 }
1b65481e 708
e067f0c1 709 /* Now write a zero-length chunk to the property to tell the
fa463103 710 requestor that we're done. */
4d7e6e51 711 block_input ();
e067f0c1
CY
712 if (! waiting_for_other_props_on_window (display, window))
713 XSelectInput (display, window, 0L);
714
715 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
716 XGetAtomName (display, cs->property));
717 XChangeProperty (display, window, cs->property,
718 cs->type, cs->format, PropModeReplace,
719 cs->data, 0);
720 TRACE0 ("Done sending incrementally");
721 }
afe1529d 722
ceabd272 723 /* rms, 2003-01-03: I think I have fixed this bug. */
47a6ac17
GM
724 /* The window we're communicating with may have been deleted
725 in the meantime (that's a real situation from a bug report).
726 In this case, there may be events in the event queue still
fac916bf 727 referring to the deleted window, and we'll get a BadWindow error
47a6ac17
GM
728 in XTread_socket when processing the events. I don't have
729 an idea how to fix that. gerd, 2001-01-98. */
844fc085
JD
730 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
731 delivered before uncatch errors. */
732 XSync (display, False);
4d7e6e51 733 unblock_input ();
0608b1a0
JD
734
735 /* GTK queues events in addition to the queue in Xlib. So we
736 UNBLOCK to enter the event loop and get possible errors delivered,
737 and then BLOCK again because x_uncatch_errors requires it. */
4d7e6e51 738 block_input ();
c525d842 739 /* This calls x_uncatch_errors. */
9ba8e10d 740 unbind_to (count, Qnil);
4d7e6e51 741 unblock_input ();
ede4db72
RS
742}
743\f
744/* Handle a SelectionRequest event EVENT.
745 This is called from keyboard.c when such an event is found in the queue. */
746
dd0fe424 747static void
971de7fb 748x_handle_selection_request (struct input_event *event)
ede4db72 749{
e067f0c1 750 struct gcpro gcpro1, gcpro2;
ede4db72 751 Time local_selection_time;
e067f0c1
CY
752
753 Display *display = SELECTION_EVENT_DISPLAY (event);
754 struct x_display_info *dpyinfo = x_display_info_for_display (display);
e067f0c1
CY
755 Atom selection = SELECTION_EVENT_SELECTION (event);
756 Lisp_Object selection_symbol = x_atom_to_symbol (display, selection);
757 Atom target = SELECTION_EVENT_TARGET (event);
758 Lisp_Object target_symbol = x_atom_to_symbol (display, target);
759 Atom property = SELECTION_EVENT_PROPERTY (event);
a9f737ee 760 Lisp_Object local_selection_data;
e067f0c1 761 int success = 0;
d311d28c 762 ptrdiff_t count = SPECPDL_INDEX ();
e067f0c1 763 GCPRO2 (local_selection_data, target_symbol);
ede4db72 764
a9f737ee
CY
765 if (!dpyinfo) goto DONE;
766
767 local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
768
e067f0c1
CY
769 /* Decline if we don't own any selections. */
770 if (NILP (local_selection_data)) goto DONE;
ede4db72 771
e067f0c1 772 /* Decline requests issued prior to our acquiring the selection. */
be44ca6c
PE
773 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
774 Time, local_selection_time);
ede4db72 775 if (SELECTION_EVENT_TIME (event) != CurrentTime
7da64e5c 776 && local_selection_time > SELECTION_EVENT_TIME (event))
e067f0c1 777 goto DONE;
ede4db72 778
ede4db72 779 x_selection_current_request = event;
ca29f2b8 780 selection_request_dpyinfo = dpyinfo;
27e498e6 781 record_unwind_protect_void (x_selection_request_lisp_error);
ede4db72 782
e067f0c1
CY
783 /* We might be able to handle nested x_handle_selection_requests,
784 but this is difficult to test, and seems unimportant. */
785 x_start_queuing_selection_requests ();
27e498e6 786 record_unwind_protect_void (x_stop_queuing_selection_requests);
ede4db72 787
757c9275
CY
788 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
789 SDATA (SYMBOL_NAME (selection_symbol)),
790 SDATA (SYMBOL_NAME (target_symbol)));
791
ede4db72 792 if (EQ (target_symbol, QMULTIPLE))
e067f0c1
CY
793 {
794 /* For MULTIPLE targets, the event property names a list of atom
795 pairs; the first atom names a target and the second names a
796 non-None property. */
797 Window requestor = SELECTION_EVENT_REQUESTOR (event);
798 Lisp_Object multprop;
864d7ce7 799 ptrdiff_t j, nselections;
e067f0c1
CY
800
801 if (property == None) goto DONE;
a9f737ee
CY
802 multprop
803 = x_get_window_property_as_lisp_data (display, requestor, property,
804 QMULTIPLE, selection);
e067f0c1 805
757c9275 806 if (!VECTORP (multprop) || ASIZE (multprop) % 2)
e067f0c1
CY
807 goto DONE;
808
809 nselections = ASIZE (multprop) / 2;
810 /* Perform conversions. This can signal. */
811 for (j = 0; j < nselections; j++)
812 {
e067f0c1 813 Lisp_Object subtarget = AREF (multprop, 2*j);
a9f737ee 814 Atom subproperty = symbol_to_x_atom (dpyinfo,
e067f0c1
CY
815 AREF (multprop, 2*j+1));
816
817 if (subproperty != None)
818 x_convert_selection (event, selection_symbol, subtarget,
a9f737ee 819 subproperty, 1, dpyinfo);
e067f0c1
CY
820 }
821 success = 1;
822 }
823 else
824 {
825 if (property == None)
826 property = SELECTION_EVENT_TARGET (event);
827 success = x_convert_selection (event, selection_symbol,
a9f737ee
CY
828 target_symbol, property,
829 0, dpyinfo);
e067f0c1 830 }
1b65481e 831
e067f0c1 832 DONE:
1b65481e 833
e067f0c1
CY
834 if (success)
835 x_reply_selection_request (event, dpyinfo);
836 else
837 x_decline_selection_request (event);
838 x_selection_current_request = 0;
1b65481e 839
e067f0c1
CY
840 /* Run the `x-sent-selection-functions' abnormal hook. */
841 if (!NILP (Vx_sent_selection_functions)
842 && !EQ (Vx_sent_selection_functions, Qunbound))
ede4db72 843 {
e067f0c1 844 Lisp_Object args[4];
cd18e7e3 845 args[0] = Qx_sent_selection_functions;
e067f0c1
CY
846 args[1] = selection_symbol;
847 args[2] = target_symbol;
848 args[3] = success ? Qt : Qnil;
849 Frun_hook_with_args (4, args);
850 }
866f8518 851
e067f0c1
CY
852 unbind_to (count, Qnil);
853 UNGCPRO;
854}
1b65481e 855
e067f0c1
CY
856/* Perform the requested selection conversion, and write the data to
857 the converted_selections linked list, where it can be accessed by
858 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
859 the data even if conversion fails, using conversion_fail_tag.
ede4db72 860
e067f0c1 861 Return 0 if the selection failed to convert, 1 otherwise. */
ede4db72 862
e067f0c1 863static int
a9f737ee
CY
864x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
865 Lisp_Object target_symbol, Atom property,
866 int for_multiple, struct x_display_info *dpyinfo)
e067f0c1
CY
867{
868 struct gcpro gcpro1;
869 Lisp_Object lisp_selection;
870 struct selection_data *cs;
871 GCPRO1 (lisp_selection);
866f8518 872
e067f0c1 873 lisp_selection
a9f737ee
CY
874 = x_get_local_selection (selection_symbol, target_symbol,
875 0, dpyinfo);
ede4db72 876
e067f0c1
CY
877 /* A nil return value means we can't perform the conversion. */
878 if (NILP (lisp_selection)
879 || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection))))
880 {
881 if (for_multiple)
882 {
38182d90 883 cs = xmalloc (sizeof *cs);
e067f0c1
CY
884 cs->data = (unsigned char *) &conversion_fail_tag;
885 cs->size = 1;
886 cs->format = 32;
887 cs->type = XA_ATOM;
888 cs->nofree = 1;
889 cs->property = property;
890 cs->wait_object = NULL;
891 cs->next = converted_selections;
892 converted_selections = cs;
893 }
ede4db72 894
18480f8f
SM
895 UNGCPRO;
896 return 0;
e067f0c1 897 }
4f06187f 898
e067f0c1 899 /* Otherwise, record the converted selection to binary. */
38182d90 900 cs = xmalloc (sizeof *cs);
9be2fd9b 901 cs->data = NULL;
e067f0c1
CY
902 cs->nofree = 1;
903 cs->property = property;
904 cs->wait_object = NULL;
905 cs->next = converted_selections;
906 converted_selections = cs;
907 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
908 lisp_selection,
909 &(cs->data), &(cs->type),
910 &(cs->size), &(cs->format),
911 &(cs->nofree));
18480f8f
SM
912 UNGCPRO;
913 return 1;
ede4db72
RS
914}
915\f
e18e6130 916/* Handle a SelectionClear event EVENT, which indicates that some
ede4db72
RS
917 client cleared out our previously asserted selection.
918 This is called from keyboard.c when such an event is found in the queue. */
919
dd0fe424 920static void
971de7fb 921x_handle_selection_clear (struct input_event *event)
ede4db72
RS
922{
923 Display *display = SELECTION_EVENT_DISPLAY (event);
924 Atom selection = SELECTION_EVENT_SELECTION (event);
925 Time changed_owner_time = SELECTION_EVENT_TIME (event);
1b65481e 926
ede4db72
RS
927 Lisp_Object selection_symbol, local_selection_data;
928 Time local_selection_time;
5c3a351a 929 struct x_display_info *dpyinfo = x_display_info_for_display (display);
a9f737ee 930 Lisp_Object Vselection_alist;
e18e6130 931
dd0fe424
KS
932 TRACE0 ("x_handle_selection_clear");
933
a9f737ee 934 if (!dpyinfo) return;
16041401 935
d9c0d4a3 936 selection_symbol = x_atom_to_symbol (display, selection);
a9f737ee 937 local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
ede4db72
RS
938
939 /* Well, we already believe that we don't own it, so that's just fine. */
940 if (NILP (local_selection_data)) return;
941
be44ca6c
PE
942 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
943 Time, local_selection_time);
ede4db72 944
a9f737ee
CY
945 /* We have reasserted the selection since this SelectionClear was
946 generated, so we can disregard it. */
ede4db72
RS
947 if (changed_owner_time != CurrentTime
948 && local_selection_time > changed_owner_time)
949 return;
950
a9f737ee
CY
951 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
952 Vselection_alist = dpyinfo->terminal->Vselection_alist;
953 if (EQ (local_selection_data, CAR (Vselection_alist)))
954 Vselection_alist = XCDR (Vselection_alist);
ede4db72
RS
955 else
956 {
957 Lisp_Object rest;
99784d63 958 for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
a9f737ee 959 if (EQ (local_selection_data, CAR (XCDR (rest))))
ede4db72 960 {
a9f737ee 961 XSETCDR (rest, XCDR (XCDR (rest)));
ede4db72
RS
962 break;
963 }
964 }
3f22b86f 965 tset_selection_alist (dpyinfo->terminal, Vselection_alist);
ede4db72 966
a9f737ee 967 /* Run the `x-lost-selection-functions' abnormal hook. */
ede4db72 968 {
a9f737ee 969 Lisp_Object args[2];
cd18e7e3 970 args[0] = Qx_lost_selection_functions;
a9f737ee
CY
971 args[1] = selection_symbol;
972 Frun_hook_with_args (2, args);
ede4db72 973 }
a9f737ee
CY
974
975 prepare_menu_bars ();
976 redisplay_preserve_echo_area (20);
ede4db72
RS
977}
978
dd0fe424 979void
971de7fb 980x_handle_selection_event (struct input_event *event)
dd0fe424
KS
981{
982 TRACE0 ("x_handle_selection_event");
e067f0c1 983 if (event->kind != SELECTION_REQUEST_EVENT)
dd0fe424 984 x_handle_selection_clear (event);
e067f0c1
CY
985 else if (x_queue_selection_requests)
986 x_queue_event (event);
987 else
988 x_handle_selection_request (event);
dd0fe424
KS
989}
990
991
118bd841
RS
992/* Clear all selections that were made from frame F.
993 We do this when about to delete a frame. */
994
995void
a10c8269 996x_clear_frame_selections (struct frame *f)
118bd841
RS
997{
998 Lisp_Object frame;
999 Lisp_Object rest;
aad3612f 1000 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee 1001 struct terminal *t = dpyinfo->terminal;
118bd841 1002
90851bbe 1003 XSETFRAME (frame, f);
118bd841 1004
0d199f9c 1005 /* Delete elements from the beginning of Vselection_alist. */
a9f737ee
CY
1006 while (CONSP (t->Vselection_alist)
1007 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist)))))))
0d199f9c 1008 {
a9f737ee
CY
1009 /* Run the `x-lost-selection-functions' abnormal hook. */
1010 Lisp_Object args[2];
cd18e7e3 1011 args[0] = Qx_lost_selection_functions;
a9f737ee
CY
1012 args[1] = Fcar (Fcar (t->Vselection_alist));
1013 Frun_hook_with_args (2, args);
0d199f9c 1014
3f22b86f 1015 tset_selection_alist (t, XCDR (t->Vselection_alist));
0d199f9c
RS
1016 }
1017
1018 /* Delete elements after the beginning of Vselection_alist. */
a9f737ee
CY
1019 for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest))
1020 if (CONSP (XCDR (rest))
1021 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest))))))))
118bd841 1022 {
a9f737ee 1023 Lisp_Object args[2];
cd18e7e3 1024 args[0] = Qx_lost_selection_functions;
a9f737ee
CY
1025 args[1] = XCAR (XCAR (XCDR (rest)));
1026 Frun_hook_with_args (2, args);
1027 XSETCDR (rest, XCDR (XCDR (rest)));
118bd841
RS
1028 break;
1029 }
1030}
ede4db72 1031\f
ede4db72
RS
1032/* Nonzero if any properties for DISPLAY and WINDOW
1033 are on the list of what we are waiting for. */
1034
1035static int
971de7fb 1036waiting_for_other_props_on_window (Display *display, Window window)
ede4db72
RS
1037{
1038 struct prop_location *rest = property_change_wait_list;
1039 while (rest)
1040 if (rest->display == display && rest->window == window)
1041 return 1;
1042 else
1043 rest = rest->next;
1044 return 0;
1045}
1046
1047/* Add an entry to the list of property changes we are waiting for.
1048 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1049 The return value is a number that uniquely identifies
1050 this awaited property change. */
1051
d1f21a66 1052static struct prop_location *
5e617bc2
JB
1053expect_property_change (Display *display, Window window,
1054 Atom property, int state)
ede4db72 1055{
23f86fce 1056 struct prop_location *pl = xmalloc (sizeof *pl);
2f65feb6 1057 pl->identifier = ++prop_location_identifier;
ede4db72
RS
1058 pl->display = display;
1059 pl->window = window;
1060 pl->property = property;
1061 pl->desired_state = state;
1062 pl->next = property_change_wait_list;
d1f21a66 1063 pl->arrived = 0;
ede4db72 1064 property_change_wait_list = pl;
d1f21a66 1065 return pl;
ede4db72
RS
1066}
1067
1068/* Delete an entry from the list of property changes we are waiting for.
2f65feb6 1069 IDENTIFIER is the number that uniquely identifies the entry. */
ede4db72
RS
1070
1071static void
971de7fb 1072unexpect_property_change (struct prop_location *location)
ede4db72
RS
1073{
1074 struct prop_location *prev = 0, *rest = property_change_wait_list;
1075 while (rest)
1076 {
d1f21a66 1077 if (rest == location)
ede4db72
RS
1078 {
1079 if (prev)
1080 prev->next = rest->next;
1081 else
1082 property_change_wait_list = rest->next;
4feb31b2 1083 xfree (rest);
ede4db72
RS
1084 return;
1085 }
1086 prev = rest;
1087 rest = rest->next;
1088 }
1089}
1090
2f65feb6
RS
1091/* Remove the property change expectation element for IDENTIFIER. */
1092
27e498e6
PE
1093static void
1094wait_for_property_change_unwind (void *loc)
2f65feb6 1095{
27e498e6 1096 struct prop_location *location = loc;
dd0fe424
KS
1097
1098 unexpect_property_change (location);
1099 if (location == property_change_reply_object)
1100 property_change_reply_object = 0;
2f65feb6
RS
1101}
1102
ede4db72 1103/* Actually wait for a property change.
2f65feb6 1104 IDENTIFIER should be the value that expect_property_change returned. */
ede4db72
RS
1105
1106static void
971de7fb 1107wait_for_property_change (struct prop_location *location)
ede4db72 1108{
d311d28c 1109 ptrdiff_t count = SPECPDL_INDEX ();
d1f21a66 1110
dd0fe424 1111 if (property_change_reply_object)
1088b922 1112 emacs_abort ();
2f65feb6
RS
1113
1114 /* Make sure to do unexpect_property_change if we quit or err. */
27e498e6 1115 record_unwind_protect_ptr (wait_for_property_change_unwind, location);
2f65feb6 1116
f3fbd155 1117 XSETCAR (property_change_reply, Qnil);
afe1529d 1118 property_change_reply_object = location;
dd0fe424 1119
afe1529d
RS
1120 /* If the event we are waiting for arrives beyond here, it will set
1121 property_change_reply, because property_change_reply_object says so. */
d1f21a66
RS
1122 if (! location->arrived)
1123 {
d35af63c
PE
1124 EMACS_INT timeout = max (0, x_selection_timeout);
1125 EMACS_INT secs = timeout / 1000;
1126 int nsecs = (timeout % 1000) * 1000000;
1127 TRACE2 (" Waiting %"pI"d secs, %d nsecs", secs, nsecs);
1128 wait_reading_process_output (secs, nsecs, 0, 0,
d64b707c 1129 property_change_reply, NULL, 0);
d1f21a66 1130
8e713be6 1131 if (NILP (XCAR (property_change_reply)))
d9c0d4a3
GM
1132 {
1133 TRACE0 (" Timed out");
1134 error ("Timed out waiting for property-notify event");
1135 }
d1f21a66 1136 }
2f65feb6
RS
1137
1138 unbind_to (count, Qnil);
ede4db72
RS
1139}
1140
1141/* Called from XTread_socket in response to a PropertyNotify event. */
1142
1143void
b7ad2f74 1144x_handle_property_notify (const XPropertyEvent *event)
ede4db72 1145{
6abdaa4a 1146 struct prop_location *rest;
d9c0d4a3 1147
6abdaa4a 1148 for (rest = property_change_wait_list; rest; rest = rest->next)
ede4db72 1149 {
dd0fe424
KS
1150 if (!rest->arrived
1151 && rest->property == event->atom
ede4db72
RS
1152 && rest->window == event->window
1153 && rest->display == event->display
1154 && rest->desired_state == event->state)
1155 {
d9c0d4a3
GM
1156 TRACE2 ("Expected %s of property %s",
1157 (event->state == PropertyDelete ? "deletion" : "change"),
1158 XGetAtomName (event->display, event->atom));
ede4db72 1159
d1f21a66
RS
1160 rest->arrived = 1;
1161
ede4db72
RS
1162 /* If this is the one wait_for_property_change is waiting for,
1163 tell it to wake up. */
d1f21a66 1164 if (rest == property_change_reply_object)
f3fbd155 1165 XSETCAR (property_change_reply, Qt);
ede4db72 1166
ede4db72
RS
1167 return;
1168 }
ede4db72 1169 }
ede4db72
RS
1170}
1171
1172
1173\f
ede4db72
RS
1174/* Variables for communication with x_handle_selection_notify. */
1175static Atom reading_which_selection;
1176static Lisp_Object reading_selection_reply;
1177static Window reading_selection_window;
1178
1179/* Do protocol to read selection-data from the server.
a9f737ee
CY
1180 Converts this to Lisp data and returns it.
1181 FRAME is the frame whose X window shall request the selection. */
ede4db72
RS
1182
1183static Lisp_Object
a9f737ee
CY
1184x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
1185 Lisp_Object time_stamp, Lisp_Object frame)
ede4db72 1186{
a9f737ee 1187 struct frame *f = XFRAME (frame);
aad3612f 1188 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
1189 Display *display = dpyinfo->display;
1190 Window requestor_window = FRAME_X_WINDOW (f);
5d0ba25b 1191 Time requestor_time = last_event_timestamp;
a9f737ee
CY
1192 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1193 Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_symbol);
1194 Atom type_atom = (CONSP (target_type)
1195 ? symbol_to_x_atom (dpyinfo, XCAR (target_type))
1196 : symbol_to_x_atom (dpyinfo, target_type));
d35af63c
PE
1197 EMACS_INT timeout, secs;
1198 int nsecs;
ede4db72 1199
a9f737ee 1200 if (!FRAME_LIVE_P (f))
428a555e
KL
1201 return Qnil;
1202
3a42401d 1203 if (! NILP (time_stamp))
be44ca6c 1204 CONS_TO_INTEGER (time_stamp, Time, requestor_time);
3a42401d 1205
4d7e6e51 1206 block_input ();
d9c0d4a3
GM
1207 TRACE2 ("Get selection %s, type %s",
1208 XGetAtomName (display, type_atom),
1209 XGetAtomName (display, target_property));
1210
de65b42c 1211 x_catch_errors (display);
ede4db72 1212 XConvertSelection (display, selection_atom, type_atom, target_property,
5d0ba25b 1213 requestor_window, requestor_time);
de65b42c
CY
1214 x_check_errors (display, "Can't convert selection: %s");
1215 x_uncatch_errors ();
ede4db72
RS
1216
1217 /* Prepare to block until the reply has been read. */
5d0ba25b 1218 reading_selection_window = requestor_window;
ede4db72 1219 reading_which_selection = selection_atom;
f3fbd155 1220 XSETCAR (reading_selection_reply, Qnil);
55b2d45d 1221
e067f0c1
CY
1222 /* It should not be necessary to stop handling selection requests
1223 during this time. In fact, the SAVE_TARGETS mechanism requires
1224 us to handle a clipboard manager's requests before it returns
1225 SelectionNotify. */
1226#if 0
a9f737ee 1227 x_start_queuing_selection_requests ();
27e498e6 1228 record_unwind_protect_void (x_stop_queuing_selection_requests);
e067f0c1
CY
1229#endif
1230
4d7e6e51 1231 unblock_input ();
ede4db72 1232
80da0190 1233 /* This allows quits. Also, don't wait forever. */
d35af63c
PE
1234 timeout = max (0, x_selection_timeout);
1235 secs = timeout / 1000;
1236 nsecs = (timeout % 1000) * 1000000;
1237 TRACE1 (" Start waiting %"pI"d secs for SelectionNotify", secs);
1238 wait_reading_process_output (secs, nsecs, 0, 0,
d64b707c 1239 reading_selection_reply, NULL, 0);
d9c0d4a3 1240 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
ede4db72 1241
8e713be6 1242 if (NILP (XCAR (reading_selection_reply)))
606140dd 1243 error ("Timed out waiting for reply from selection owner");
8e713be6 1244 if (EQ (XCAR (reading_selection_reply), Qlambda))
12061f06 1245 return Qnil;
ede4db72
RS
1246
1247 /* Otherwise, the selection is waiting for us on the requested property. */
1248 return
5d0ba25b 1249 x_get_window_property_as_lisp_data (display, requestor_window,
ede4db72
RS
1250 target_property, target_type,
1251 selection_atom);
1252}
1253\f
1254/* Subroutines of x_get_window_property_as_lisp_data */
1255
4feb31b2 1256/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1257
ede4db72 1258static void
d5a3eaaf 1259x_get_window_property (Display *display, Window window, Atom property,
864d7ce7 1260 unsigned char **data_ret, ptrdiff_t *bytes_ret,
d5a3eaaf
AS
1261 Atom *actual_type_ret, int *actual_format_ret,
1262 unsigned long *actual_size_ret, int delete_p)
ede4db72 1263{
864d7ce7 1264 ptrdiff_t total_size;
ede4db72 1265 unsigned long bytes_remaining;
864d7ce7
PE
1266 ptrdiff_t offset = 0;
1267 unsigned char *data = 0;
ede4db72
RS
1268 unsigned char *tmp_data = 0;
1269 int result;
864d7ce7
PE
1270 int buffer_size = selection_quantum (display);
1271
1272 /* Wide enough to avoid overflow in expressions using it. */
1273 ptrdiff_t x_long_size = X_LONG_SIZE;
1b65481e 1274
864d7ce7
PE
1275 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1276 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1277 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1278 ptrdiff_t total_size_max =
1279 ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX
1280 ? min (PTRDIFF_MAX, SIZE_MAX) - 1
1281 : LONG_MAX * x_long_size);
1b65481e 1282
4d7e6e51 1283 block_input ();
1b65481e 1284
ede4db72
RS
1285 /* First probe the thing to find out how big it is. */
1286 result = XGetWindowProperty (display, window, property,
137edb72 1287 0L, 0L, False, AnyPropertyType,
ede4db72
RS
1288 actual_type_ret, actual_format_ret,
1289 actual_size_ret,
1290 &bytes_remaining, &tmp_data);
ede4db72 1291 if (result != Success)
864d7ce7 1292 goto done;
1b65481e 1293
0158abbc 1294 /* This was allocated by Xlib, so use XFree. */
98c6f1e3 1295 XFree (tmp_data);
1b65481e 1296
ede4db72 1297 if (*actual_type_ret == None || *actual_format_ret == 0)
864d7ce7 1298 goto done;
ede4db72 1299
864d7ce7
PE
1300 if (total_size_max < bytes_remaining)
1301 goto size_overflow;
1302 total_size = bytes_remaining;
1303 data = malloc (total_size + 1);
1304 if (! data)
1305 goto memory_exhausted;
1b65481e 1306
2a1a4c9d 1307 /* Now read, until we've gotten it all. */
ede4db72
RS
1308 while (bytes_remaining)
1309 {
864d7ce7
PE
1310 ptrdiff_t bytes_gotten;
1311 int bytes_per_item;
ede4db72
RS
1312 result
1313 = XGetWindowProperty (display, window, property,
864d7ce7
PE
1314 offset / X_LONG_SIZE,
1315 buffer_size / X_LONG_SIZE,
2f65feb6 1316 False,
ede4db72
RS
1317 AnyPropertyType,
1318 actual_type_ret, actual_format_ret,
1319 actual_size_ret, &bytes_remaining, &tmp_data);
d9c0d4a3 1320
ede4db72
RS
1321 /* If this doesn't return Success at this point, it means that
1322 some clod deleted the selection while we were in the midst of
d9c0d4a3
GM
1323 reading it. Deal with that, I guess.... */
1324 if (result != Success)
1325 break;
e22cf39c 1326
864d7ce7 1327 bytes_per_item = *actual_format_ret >> 3;
a54e2c05 1328 eassert (*actual_size_ret <= buffer_size / bytes_per_item);
864d7ce7 1329
e22cf39c
JD
1330 /* The man page for XGetWindowProperty says:
1331 "If the returned format is 32, the returned data is represented
1332 as a long array and should be cast to that type to obtain the
1333 elements."
1334 This applies even if long is more than 32 bits, the X library
1335 converts from 32 bit elements received from the X server to long
72af86bd 1336 and passes the long array to us. Thus, for that case memcpy can not
e22cf39c
JD
1337 be used. We convert to a 32 bit type here, because so much code
1338 assume on that.
1339
1340 The bytes and offsets passed to XGetWindowProperty refers to the
1341 property and those are indeed in 32 bit quantities if format is 32. */
1342
864d7ce7
PE
1343 bytes_gotten = *actual_size_ret;
1344 bytes_gotten *= bytes_per_item;
1345
1346 TRACE2 ("Read %"pD"d bytes from property %s",
1347 bytes_gotten, XGetAtomName (display, property));
1348
1349 if (total_size - offset < bytes_gotten)
1350 {
1351 unsigned char *data1;
1352 ptrdiff_t remaining_lim = total_size_max - offset - bytes_gotten;
1353 if (remaining_lim < 0 || remaining_lim < bytes_remaining)
1354 goto size_overflow;
1355 total_size = offset + bytes_gotten + bytes_remaining;
1356 data1 = realloc (data, total_size + 1);
1357 if (! data1)
1358 goto memory_exhausted;
1359 data = data1;
1360 }
1361
908589fd 1362 if (BITS_PER_LONG > 32 && *actual_format_ret == 32)
e22cf39c
JD
1363 {
1364 unsigned long i;
864d7ce7 1365 int *idata = (int *) (data + offset);
e22cf39c
JD
1366 long *ldata = (long *) tmp_data;
1367
1368 for (i = 0; i < *actual_size_ret; ++i)
864d7ce7 1369 idata[i] = ldata[i];
e22cf39c
JD
1370 }
1371 else
864d7ce7
PE
1372 memcpy (data + offset, tmp_data, bytes_gotten);
1373
1374 offset += bytes_gotten;
1b65481e 1375
0158abbc 1376 /* This was allocated by Xlib, so use XFree. */
98c6f1e3 1377 XFree (tmp_data);
ede4db72 1378 }
2f65feb6 1379
5c3a351a 1380 XFlush (display);
864d7ce7
PE
1381 data[offset] = '\0';
1382
1383 done:
4d7e6e51 1384 unblock_input ();
864d7ce7 1385 *data_ret = data;
ede4db72 1386 *bytes_ret = offset;
864d7ce7
PE
1387 return;
1388
1389 size_overflow:
1390 free (data);
4d7e6e51 1391 unblock_input ();
864d7ce7
PE
1392 memory_full (SIZE_MAX);
1393
1394 memory_exhausted:
1395 free (data);
4d7e6e51 1396 unblock_input ();
864d7ce7 1397 memory_full (total_size + 1);
ede4db72
RS
1398}
1399\f
4feb31b2 1400/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1401
ede4db72 1402static void
d5a3eaaf
AS
1403receive_incremental_selection (Display *display, Window window, Atom property,
1404 Lisp_Object target_type,
1405 unsigned int min_size_bytes,
864d7ce7
PE
1406 unsigned char **data_ret,
1407 ptrdiff_t *size_bytes_ret,
d5a3eaaf
AS
1408 Atom *type_ret, int *format_ret,
1409 unsigned long *size_ret)
ede4db72 1410{
864d7ce7 1411 ptrdiff_t offset = 0;
d1f21a66 1412 struct prop_location *wait_object;
864d7ce7
PE
1413 if (min (PTRDIFF_MAX, SIZE_MAX) < min_size_bytes)
1414 memory_full (SIZE_MAX);
23f86fce 1415 *data_ret = xmalloc (min_size_bytes);
ede4db72 1416 *size_bytes_ret = min_size_bytes;
d9c0d4a3 1417
864d7ce7 1418 TRACE1 ("Read %u bytes incrementally", min_size_bytes);
2f65feb6
RS
1419
1420 /* At this point, we have read an INCR property.
1421 Delete the property to ack it.
1422 (But first, prepare to receive the next event in this handshake.)
ede4db72
RS
1423
1424 Now, we must loop, waiting for the sending window to put a value on
1425 that property, then reading the property, then deleting it to ack.
1426 We are done when the sender places a property of length 0.
1427 */
4d7e6e51 1428 block_input ();
2f65feb6 1429 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
d9c0d4a3 1430 TRACE1 (" Delete property %s",
dd0fe424 1431 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
2f65feb6 1432 XDeleteProperty (display, window, property);
d9c0d4a3 1433 TRACE1 (" Expect new value of property %s",
dd0fe424 1434 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
d1f21a66
RS
1435 wait_object = expect_property_change (display, window, property,
1436 PropertyNewValue);
5c3a351a 1437 XFlush (display);
4d7e6e51 1438 unblock_input ();
2f65feb6 1439
ede4db72
RS
1440 while (1)
1441 {
1442 unsigned char *tmp_data;
864d7ce7 1443 ptrdiff_t tmp_size_bytes;
d9c0d4a3
GM
1444
1445 TRACE0 (" Wait for property change");
d1f21a66 1446 wait_for_property_change (wait_object);
1b65481e 1447
ede4db72 1448 /* expect it again immediately, because x_get_window_property may
2a1a4c9d 1449 .. no it won't, I don't get it.
d9c0d4a3
GM
1450 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1451 TRACE0 (" Get property value");
ede4db72
RS
1452 x_get_window_property (display, window, property,
1453 &tmp_data, &tmp_size_bytes,
1454 type_ret, format_ret, size_ret, 1);
1455
864d7ce7 1456 TRACE1 (" Read increment of %"pD"d bytes", tmp_size_bytes);
d9c0d4a3 1457
ede4db72
RS
1458 if (tmp_size_bytes == 0) /* we're done */
1459 {
d9c0d4a3
GM
1460 TRACE0 ("Done reading incrementally");
1461
2f65feb6
RS
1462 if (! waiting_for_other_props_on_window (display, window))
1463 XSelectInput (display, window, STANDARD_EVENT_SET);
4feb31b2 1464 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1465 calls xmalloc itself. */
70fdbb46 1466 xfree (tmp_data);
ede4db72
RS
1467 break;
1468 }
2f65feb6 1469
4d7e6e51 1470 block_input ();
d9c0d4a3
GM
1471 TRACE1 (" ACK by deleting property %s",
1472 XGetAtomName (display, property));
2f65feb6 1473 XDeleteProperty (display, window, property);
d1f21a66
RS
1474 wait_object = expect_property_change (display, window, property,
1475 PropertyNewValue);
5c3a351a 1476 XFlush (display);
4d7e6e51 1477 unblock_input ();
2f65feb6 1478
864d7ce7 1479 if (*size_bytes_ret - offset < tmp_size_bytes)
0065d054
PE
1480 *data_ret = xpalloc (*data_ret, size_bytes_ret,
1481 tmp_size_bytes - (*size_bytes_ret - offset),
1482 -1, 1);
1b65481e 1483
72af86bd 1484 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
ede4db72 1485 offset += tmp_size_bytes;
1b65481e 1486
4feb31b2 1487 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1488 calls xmalloc itself. */
4feb31b2 1489 xfree (tmp_data);
ede4db72
RS
1490 }
1491}
d9c0d4a3 1492
ede4db72 1493\f
e067f0c1
CY
1494/* Fetch a value from property PROPERTY of X window WINDOW on display
1495 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1496 if this fails. */
ede4db72
RS
1497
1498static Lisp_Object
d5a3eaaf
AS
1499x_get_window_property_as_lisp_data (Display *display, Window window,
1500 Atom property,
1501 Lisp_Object target_type,
1502 Atom selection_atom)
ede4db72
RS
1503{
1504 Atom actual_type;
1505 int actual_format;
1506 unsigned long actual_size;
1507 unsigned char *data = 0;
864d7ce7 1508 ptrdiff_t bytes = 0;
ede4db72 1509 Lisp_Object val;
5c3a351a 1510 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1511
d9c0d4a3
GM
1512 TRACE0 ("Reading selection data");
1513
ede4db72
RS
1514 x_get_window_property (display, window, property, &data, &bytes,
1515 &actual_type, &actual_format, &actual_size, 1);
1516 if (! data)
1517 {
1518 int there_is_a_selection_owner;
4d7e6e51 1519 block_input ();
ede4db72
RS
1520 there_is_a_selection_owner
1521 = XGetSelectionOwner (display, selection_atom);
4d7e6e51 1522 unblock_input ();
4d30ce50
KS
1523 if (there_is_a_selection_owner)
1524 signal_error ("Selection owner couldn't convert",
1525 actual_type
1526 ? list2 (target_type,
1527 x_atom_to_symbol (display, actual_type))
1528 : target_type);
1529 else
1530 signal_error ("No selection",
1531 x_atom_to_symbol (display, selection_atom));
ede4db72 1532 }
1b65481e 1533
5c3a351a 1534 if (actual_type == dpyinfo->Xatom_INCR)
ede4db72
RS
1535 {
1536 /* That wasn't really the data, just the beginning. */
1537
1538 unsigned int min_size_bytes = * ((unsigned int *) data);
4d7e6e51 1539 block_input ();
4feb31b2 1540 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1541 calls xmalloc itself. */
98c6f1e3 1542 xfree (data);
4d7e6e51 1543 unblock_input ();
ede4db72
RS
1544 receive_incremental_selection (display, window, property, target_type,
1545 min_size_bytes, &data, &bytes,
1546 &actual_type, &actual_format,
1547 &actual_size);
1548 }
1549
4d7e6e51 1550 block_input ();
d9c0d4a3 1551 TRACE1 (" Delete property %s", XGetAtomName (display, property));
2f65feb6 1552 XDeleteProperty (display, window, property);
5c3a351a 1553 XFlush (display);
4d7e6e51 1554 unblock_input ();
2f65feb6 1555
ede4db72
RS
1556 /* It's been read. Now convert it to a lisp object in some semi-rational
1557 manner. */
1558 val = selection_data_to_lisp_data (display, data, bytes,
1559 actual_type, actual_format);
1b65481e 1560
4feb31b2 1561 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1562 calls xmalloc itself. */
98c6f1e3 1563 xfree (data);
ede4db72
RS
1564 return val;
1565}
1566\f
1567/* These functions convert from the selection data read from the server into
1568 something that we can use from Lisp, and vice versa.
1569
1570 Type: Format: Size: Lisp Type:
1571 ----- ------- ----- -----------
1572 * 8 * String
1573 ATOM 32 1 Symbol
1574 ATOM 32 > 1 Vector of Symbols
1575 * 16 1 Integer
1576 * 16 > 1 Vector of Integers
1577 * 32 1 if <=16 bits: Integer
1578 if > 16 bits: Cons of top16, bot16
1579 * 32 > 1 Vector of the above
1580
1581 When converting a Lisp number to C, it is assumed to be of format 16 if
1582 it is an integer, and of format 32 if it is a cons of two integers.
1583
1584 When converting a vector of numbers from Lisp to C, it is assumed to be
1585 of format 16 if every element in the vector is an integer, and is assumed
1586 to be of format 32 if any element is a cons of two integers.
1587
1588 When converting an object to C, it may be of the form (SYMBOL . <data>)
1589 where SYMBOL is what we should claim that the type is. Format and
b8d6f4af
JD
1590 representation are as above.
1591
1592 Important: When format is 32, data should contain an array of int,
1593 not an array of long as the X library returns. This makes a difference
1594 when sizeof(long) != sizeof(int). */
ede4db72
RS
1595
1596
1597
1598static Lisp_Object
eec47d6b 1599selection_data_to_lisp_data (Display *display, const unsigned char *data,
864d7ce7 1600 ptrdiff_t size, Atom type, int format)
ede4db72 1601{
5c3a351a 1602 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1603
5c3a351a 1604 if (type == dpyinfo->Xatom_NULL)
ede4db72
RS
1605 return QNULL;
1606
1607 /* Convert any 8-bit data to a string, for compactness. */
1608 else if (format == 8)
e6c7c988 1609 {
e57ad4d8
KH
1610 Lisp_Object str, lispy_type;
1611
1612 str = make_unibyte_string ((char *) data, size);
1613 /* Indicate that this string is from foreign selection by a text
1614 property `foreign-selection' so that the caller of
1615 x-get-selection-internal (usually x-get-selection) can know
1616 that the string must be decode. */
1617 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1618 lispy_type = QCOMPOUND_TEXT;
1619 else if (type == dpyinfo->Xatom_UTF8_STRING)
1620 lispy_type = QUTF8_STRING;
e6c7c988 1621 else
e57ad4d8
KH
1622 lispy_type = QSTRING;
1623 Fput_text_property (make_number (0), make_number (size),
1624 Qforeign_selection, lispy_type, str);
e6c7c988
KH
1625 return str;
1626 }
ede4db72 1627 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
e067f0c1
CY
1628 a vector of symbols. */
1629 else if (type == XA_ATOM
1630 /* Treat ATOM_PAIR type similar to list of atoms. */
1631 || type == dpyinfo->Xatom_ATOM_PAIR)
ede4db72 1632 {
864d7ce7 1633 ptrdiff_t i;
b8d6f4af
JD
1634 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1635 But the callers of these function has made sure the data for
1636 format == 32 is an array of int. Thus, use int instead
1637 of Atom. */
1638 int *idata = (int *) data;
1639
1640 if (size == sizeof (int))
1641 return x_atom_to_symbol (display, (Atom) idata[0]);
ede4db72
RS
1642 else
1643 {
25721f5b
DA
1644 Lisp_Object v = make_uninit_vector (size / sizeof (int));
1645
b8d6f4af 1646 for (i = 0; i < size / sizeof (int); i++)
9a9d91d9 1647 ASET (v, i, x_atom_to_symbol (display, (Atom) idata[i]));
ede4db72
RS
1648 return v;
1649 }
1650 }
1651
1ad08acd
RS
1652 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1653 If the number is 32 bits and won't fit in a Lisp_Int,
1654 convert it to a cons of integers, 16 bits in each half.
ede4db72 1655 */
2f51feb8 1656 else if (format == 32 && size == sizeof (int))
d2eea5b5 1657 return INTEGER_TO_CONS (((int *) data) [0]);
ede4db72 1658 else if (format == 16 && size == sizeof (short))
d2eea5b5 1659 return make_number (((short *) data) [0]);
ede4db72
RS
1660
1661 /* Convert any other kind of data to a vector of numbers, represented
1662 as above (as an integer, or a cons of two 16 bit integers.)
1663 */
1664 else if (format == 16)
1665 {
864d7ce7 1666 ptrdiff_t i;
25721f5b
DA
1667 Lisp_Object v = make_uninit_vector (size / 2);
1668
937a3875 1669 for (i = 0; i < size / 2; i++)
ede4db72 1670 {
d311d28c 1671 short j = ((short *) data) [i];
9a9d91d9 1672 ASET (v, i, make_number (j));
ede4db72
RS
1673 }
1674 return v;
1675 }
1676 else
1677 {
864d7ce7 1678 ptrdiff_t i;
25721f5b
DA
1679 Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
1680
864d7ce7 1681 for (i = 0; i < size / X_LONG_SIZE; i++)
ede4db72 1682 {
d2eea5b5 1683 int j = ((int *) data) [i];
9a9d91d9 1684 ASET (v, i, INTEGER_TO_CONS (j));
ede4db72
RS
1685 }
1686 return v;
1687 }
1688}
1689
2e621251
PE
1690/* Convert OBJ to an X long value, and return it as unsigned long.
1691 OBJ should be an integer or a cons representing an integer.
1692 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1693 unsigned long values: in theory these values are supposed to be
1694 signed but in practice unsigned 32-bit data are communicated via X
1695 selections and we need to support that. */
1696static unsigned long
1697cons_to_x_long (Lisp_Object obj)
1698{
1699 if (X_ULONG_MAX <= INTMAX_MAX
1700 || XINT (INTEGERP (obj) ? obj : XCAR (obj)) < 0)
1701 return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX));
1702 else
1703 return cons_to_unsigned (obj, X_ULONG_MAX);
1704}
ede4db72 1705
4feb31b2 1706/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1707
ede4db72 1708static void
d5a3eaaf
AS
1709lisp_data_to_selection_data (Display *display, Lisp_Object obj,
1710 unsigned char **data_ret, Atom *type_ret,
864d7ce7 1711 ptrdiff_t *size_ret,
d5a3eaaf 1712 int *format_ret, int *nofree_ret)
ede4db72
RS
1713{
1714 Lisp_Object type = Qnil;
5c3a351a 1715 struct x_display_info *dpyinfo = x_display_info_for_display (display);
aca39f42
RS
1716
1717 *nofree_ret = 0;
1718
8e713be6 1719 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
ede4db72 1720 {
8e713be6
KR
1721 type = XCAR (obj);
1722 obj = XCDR (obj);
1723 if (CONSP (obj) && NILP (XCDR (obj)))
1724 obj = XCAR (obj);
ede4db72
RS
1725 }
1726
1727 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1728 { /* This is not the same as declining */
1729 *format_ret = 32;
1730 *size_ret = 0;
1731 *data_ret = 0;
1732 type = QNULL;
1733 }
1734 else if (STRINGP (obj))
1735 {
1bd70c6e
KH
1736 if (SCHARS (obj) < SBYTES (obj))
1737 /* OBJ is a multibyte string containing a non-ASCII char. */
4d30ce50 1738 signal_error ("Non-ASCII string must be encoded in advance", obj);
7b9ae523 1739 if (NILP (type))
5109c8dd
KH
1740 type = QSTRING;
1741 *format_ret = 8;
1742 *size_ret = SBYTES (obj);
1743 *data_ret = SDATA (obj);
1744 *nofree_ret = 1;
ede4db72
RS
1745 }
1746 else if (SYMBOLP (obj))
1747 {
38182d90
PE
1748 void *data = xmalloc (sizeof (Atom) + 1);
1749 Atom *x_atom_ptr = data;
1750 *data_ret = data;
ede4db72
RS
1751 *format_ret = 32;
1752 *size_ret = 1;
ede4db72 1753 (*data_ret) [sizeof (Atom)] = 0;
38182d90 1754 *x_atom_ptr = symbol_to_x_atom (dpyinfo, obj);
ede4db72
RS
1755 if (NILP (type)) type = QATOM;
1756 }
252c5ee1 1757 else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX))
ede4db72 1758 {
38182d90
PE
1759 void *data = xmalloc (sizeof (short) + 1);
1760 short *short_ptr = data;
1761 *data_ret = data;
ede4db72
RS
1762 *format_ret = 16;
1763 *size_ret = 1;
ede4db72 1764 (*data_ret) [sizeof (short)] = 0;
38182d90 1765 *short_ptr = XINT (obj);
ede4db72
RS
1766 if (NILP (type)) type = QINTEGER;
1767 }
a87ed99c 1768 else if (INTEGERP (obj)
8e713be6
KR
1769 || (CONSP (obj) && INTEGERP (XCAR (obj))
1770 && (INTEGERP (XCDR (obj))
1771 || (CONSP (XCDR (obj))
1772 && INTEGERP (XCAR (XCDR (obj)))))))
ede4db72 1773 {
38182d90
PE
1774 void *data = xmalloc (sizeof (unsigned long) + 1);
1775 unsigned long *x_long_ptr = data;
1776 *data_ret = data;
ede4db72
RS
1777 *format_ret = 32;
1778 *size_ret = 1;
2e621251 1779 (*data_ret) [sizeof (unsigned long)] = 0;
38182d90 1780 *x_long_ptr = cons_to_x_long (obj);
ede4db72
RS
1781 if (NILP (type)) type = QINTEGER;
1782 }
1783 else if (VECTORP (obj))
1784 {
1785 /* Lisp_Vectors may represent a set of ATOMs;
1786 a set of 16 or 32 bit INTEGERs;
1787 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1788 */
864d7ce7
PE
1789 ptrdiff_t i;
1790 ptrdiff_t size = ASIZE (obj);
ede4db72 1791
28be1ada 1792 if (SYMBOLP (AREF (obj, 0)))
ede4db72
RS
1793 /* This vector is an ATOM set */
1794 {
38182d90
PE
1795 void *data;
1796 Atom *x_atoms;
ede4db72 1797 if (NILP (type)) type = QATOM;
864d7ce7 1798 for (i = 0; i < size; i++)
28be1ada 1799 if (!SYMBOLP (AREF (obj, i)))
4d30ce50 1800 signal_error ("All elements of selection vector must have same type", obj);
1b65481e 1801
38182d90
PE
1802 *data_ret = data = xnmalloc (size, sizeof *x_atoms);
1803 x_atoms = data;
864d7ce7
PE
1804 *format_ret = 32;
1805 *size_ret = size;
1806 for (i = 0; i < size; i++)
38182d90 1807 x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i));
ede4db72 1808 }
ede4db72
RS
1809 else
1810 /* This vector is an INTEGER set, or something like it */
1811 {
864d7ce7 1812 int format = 16;
0065d054 1813 int data_size = sizeof (short);
38182d90
PE
1814 void *data;
1815 unsigned long *x_atoms;
1816 short *shorts;
ede4db72 1817 if (NILP (type)) type = QINTEGER;
864d7ce7 1818 for (i = 0; i < size; i++)
252c5ee1 1819 {
28be1ada 1820 if (! RANGED_INTEGERP (X_SHRT_MIN, AREF (obj, i),
2e621251 1821 X_SHRT_MAX))
252c5ee1
PE
1822 {
1823 /* Use sizeof (long) even if it is more than 32 bits.
1824 See comment in x_get_window_property and
1825 x_fill_property_data. */
1826 data_size = sizeof (long);
1827 format = 32;
2e621251 1828 break;
252c5ee1
PE
1829 }
1830 }
38182d90
PE
1831 *data_ret = data = xnmalloc (size, data_size);
1832 x_atoms = data;
1833 shorts = data;
864d7ce7
PE
1834 *format_ret = format;
1835 *size_ret = size;
1836 for (i = 0; i < size; i++)
252c5ee1 1837 {
252c5ee1 1838 if (format == 32)
38182d90 1839 x_atoms[i] = cons_to_x_long (AREF (obj, i));
252c5ee1 1840 else
38182d90 1841 shorts[i] = XINT (AREF (obj, i));
252c5ee1 1842 }
ede4db72
RS
1843 }
1844 }
1845 else
4d30ce50 1846 signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
ede4db72 1847
a9f737ee 1848 *type_ret = symbol_to_x_atom (dpyinfo, type);
ede4db72
RS
1849}
1850
1851static Lisp_Object
971de7fb 1852clean_local_selection_data (Lisp_Object obj)
ede4db72
RS
1853{
1854 if (CONSP (obj)
8e713be6
KR
1855 && INTEGERP (XCAR (obj))
1856 && CONSP (XCDR (obj))
1857 && INTEGERP (XCAR (XCDR (obj)))
1858 && NILP (XCDR (XCDR (obj))))
1859 obj = Fcons (XCAR (obj), XCDR (obj));
ede4db72
RS
1860
1861 if (CONSP (obj)
8e713be6
KR
1862 && INTEGERP (XCAR (obj))
1863 && INTEGERP (XCDR (obj)))
ede4db72 1864 {
8e713be6
KR
1865 if (XINT (XCAR (obj)) == 0)
1866 return XCDR (obj);
1867 if (XINT (XCAR (obj)) == -1)
1868 return make_number (- XINT (XCDR (obj)));
ede4db72
RS
1869 }
1870 if (VECTORP (obj))
1871 {
864d7ce7
PE
1872 ptrdiff_t i;
1873 ptrdiff_t size = ASIZE (obj);
ede4db72
RS
1874 Lisp_Object copy;
1875 if (size == 1)
28be1ada 1876 return clean_local_selection_data (AREF (obj, 0));
3bfc46eb 1877 copy = make_uninit_vector (size);
ede4db72 1878 for (i = 0; i < size; i++)
28be1ada 1879 ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
ede4db72
RS
1880 return copy;
1881 }
1882 return obj;
1883}
1884\f
1885/* Called from XTread_socket to handle SelectionNotify events.
606140dd
KH
1886 If it's the selection we are waiting for, stop waiting
1887 by setting the car of reading_selection_reply to non-nil.
1888 We store t there if the reply is successful, lambda if not. */
ede4db72
RS
1889
1890void
b7ad2f74 1891x_handle_selection_notify (const XSelectionEvent *event)
ede4db72 1892{
5d0ba25b 1893 if (event->requestor != reading_selection_window)
ede4db72
RS
1894 return;
1895 if (event->selection != reading_which_selection)
1896 return;
1897
d9c0d4a3 1898 TRACE0 ("Received SelectionNotify");
f3fbd155
KR
1899 XSETCAR (reading_selection_reply,
1900 (event->property != 0 ? Qt : Qlambda));
ede4db72
RS
1901}
1902
1903\f
a9f737ee
CY
1904/* From a Lisp_Object, return a suitable frame for selection
1905 operations. OBJECT may be a frame, a terminal object, or nil
1906 (which stands for the selected frame--or, if that is not an X
1907 frame, the first X display on the list). If no suitable frame can
1908 be found, return NULL. */
1909
1910static struct frame *
1911frame_for_x_selection (Lisp_Object object)
1912{
5b04e9f9 1913 Lisp_Object tail, frame;
a9f737ee
CY
1914 struct frame *f;
1915
1916 if (NILP (object))
1917 {
1918 f = XFRAME (selected_frame);
1919 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1920 return f;
1921
5b04e9f9 1922 FOR_EACH_FRAME (tail, frame)
a9f737ee 1923 {
5b04e9f9 1924 f = XFRAME (frame);
a9f737ee
CY
1925 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1926 return f;
1927 }
1928 }
1929 else if (TERMINALP (object))
1930 {
1931 struct terminal *t = get_terminal (object, 1);
5b04e9f9 1932
a9f737ee 1933 if (t->type == output_x_window)
5b04e9f9
DA
1934 FOR_EACH_FRAME (tail, frame)
1935 {
1936 f = XFRAME (frame);
1937 if (FRAME_LIVE_P (f) && f->terminal == t)
1938 return f;
1939 }
a9f737ee
CY
1940 }
1941 else if (FRAMEP (object))
1942 {
1943 f = XFRAME (object);
1944 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1945 return f;
1946 }
1947
1948 return NULL;
1949}
1950
1951
a0d76c27 1952DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
a9f737ee 1953 Sx_own_selection_internal, 2, 3, 0,
abb71cf4
CY
1954 doc: /* Assert an X selection of type SELECTION and value VALUE.
1955SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
8c1a1077
PJ
1956\(Those are literal upper-case symbol names, since that's what X expects.)
1957VALUE is typically a string, or a cons of two markers, but may be
a9f737ee
CY
1958anything that the functions on `selection-converter-alist' know about.
1959
1960FRAME should be a frame that should own the selection. If omitted or
bd7da63e
GM
1961nil, it defaults to the selected frame.
1962
1963On Nextstep, FRAME is unused. */)
a9f737ee 1964 (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
ede4db72 1965{
a9f737ee
CY
1966 if (NILP (frame)) frame = selected_frame;
1967 if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_X_P (XFRAME (frame)))
1968 error ("X selection unavailable for this frame");
1969
abb71cf4
CY
1970 CHECK_SYMBOL (selection);
1971 if (NILP (value)) error ("VALUE may not be nil");
a9f737ee 1972 x_own_selection (selection, value, frame);
abb71cf4 1973 return value;
ede4db72
RS
1974}
1975
1976
1977/* Request the selection value from the owner. If we are the owner,
1978 simply return our selection value. If we are not the owner, this
1979 will block until all of the data has arrived. */
1980
a0d76c27 1981DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
a9f737ee 1982 Sx_get_selection_internal, 2, 4, 0,
8c1a1077 1983 doc: /* Return text selected from some X window.
bd7da63e 1984SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
8c1a1077 1985\(Those are literal upper-case symbol names, since that's what X expects.)
bd7da63e
GM
1986TARGET-TYPE is the type of data desired, typically `STRING'.
1987
1988TIME-STAMP is the time to use in the XConvertSelection call for foreign
a9f737ee
CY
1989selections. If omitted, defaults to the time for the last event.
1990
1991TERMINAL should be a terminal object or a frame specifying the X
1992server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
1993frame's display, or the first available X display.
1994
1995On Nextstep, TIME-STAMP and TERMINAL are unused. */)
a9f737ee
CY
1996 (Lisp_Object selection_symbol, Lisp_Object target_type,
1997 Lisp_Object time_stamp, Lisp_Object terminal)
ede4db72
RS
1998{
1999 Lisp_Object val = Qnil;
2000 struct gcpro gcpro1, gcpro2;
a9f737ee 2001 struct frame *f = frame_for_x_selection (terminal);
ede4db72 2002 GCPRO2 (target_type, val); /* we store newly consed data into these */
a9f737ee 2003
b7826503 2004 CHECK_SYMBOL (selection_symbol);
a9f737ee
CY
2005 CHECK_SYMBOL (target_type);
2006 if (EQ (target_type, QMULTIPLE))
2007 error ("Retrieving MULTIPLE selections is currently unimplemented");
2008 if (!f)
2009 error ("X selection unavailable for this frame");
2010
2011 val = x_get_local_selection (selection_symbol, target_type, 1,
aad3612f 2012 FRAME_DISPLAY_INFO (f));
ede4db72 2013
a9f737ee 2014 if (NILP (val) && FRAME_LIVE_P (f))
ede4db72 2015 {
a9f737ee
CY
2016 Lisp_Object frame;
2017 XSETFRAME (frame, f);
2018 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type,
2019 time_stamp, frame));
ede4db72 2020 }
ede4db72 2021
abb71cf4 2022 if (CONSP (val) && SYMBOLP (XCAR (val)))
ede4db72 2023 {
8e713be6
KR
2024 val = XCDR (val);
2025 if (CONSP (val) && NILP (XCDR (val)))
2026 val = XCAR (val);
ede4db72 2027 }
abb71cf4 2028 RETURN_UNGCPRO (clean_local_selection_data (val));
ede4db72
RS
2029}
2030
a0d76c27 2031DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
a9f737ee 2032 Sx_disown_selection_internal, 1, 3, 0,
8c1a1077 2033 doc: /* If we own the selection SELECTION, disown it.
a9f737ee
CY
2034Disowning it means there is no such selection.
2035
bd7da63e
GM
2036Sets the last-change time for the selection to TIME-OBJECT (by default
2037the time of the last event).
2038
a9f737ee
CY
2039TERMINAL should be a terminal object or a frame specifying the X
2040server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2041frame's display, or the first available X display.
2042
2043On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2044On MS-DOS, all this does is return non-nil if we own the selection. */)
a9f737ee 2045 (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
ede4db72 2046{
ede4db72
RS
2047 Time timestamp;
2048 Atom selection_atom;
31df61d6
AS
2049 union {
2050 struct selection_input_event sie;
2051 struct input_event ie;
2052 } event;
a9f737ee 2053 struct frame *f = frame_for_x_selection (terminal);
5c3a351a 2054 struct x_display_info *dpyinfo;
ede4db72 2055
a9f737ee 2056 if (!f)
428a555e
KL
2057 return Qnil;
2058
aad3612f 2059 dpyinfo = FRAME_DISPLAY_INFO (f);
b7826503 2060 CHECK_SYMBOL (selection);
ede4db72 2061
a9f737ee
CY
2062 /* Don't disown the selection when we're not the owner. */
2063 if (NILP (LOCAL_SELECTION (selection, dpyinfo)))
2064 return Qnil;
ede4db72 2065
a9f737ee 2066 selection_atom = symbol_to_x_atom (dpyinfo, selection);
ede4db72 2067
4d7e6e51 2068 block_input ();
be44ca6c
PE
2069 if (NILP (time_object))
2070 timestamp = last_event_timestamp;
2071 else
2072 CONS_TO_INTEGER (time_object, Time, timestamp);
a9f737ee 2073 XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
4d7e6e51 2074 unblock_input ();
ede4db72 2075
eb8c3be9 2076 /* It doesn't seem to be guaranteed that a SelectionClear event will be
ede4db72
RS
2077 generated for a window which owns the selection when that window sets
2078 the selection owner to None. The NCD server does, the MIT Sun4 server
2079 doesn't. So we synthesize one; this means we might get two, but
2080 that's ok, because the second one won't have any effect. */
a9f737ee 2081 SELECTION_EVENT_DISPLAY (&event.sie) = dpyinfo->display;
31df61d6
AS
2082 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2083 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2084 x_handle_selection_clear (&event.ie);
ede4db72
RS
2085
2086 return Qt;
2087}
2088
ede4db72 2089DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
a9f737ee 2090 0, 2, 0,
8c1a1077
PJ
2091 doc: /* Whether the current Emacs process owns the given X Selection.
2092The arg should be the name of the selection in question, typically one of
2093the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2094\(Those are literal upper-case symbol names, since that's what X expects.)
2095For convenience, the symbol nil is the same as `PRIMARY',
a9f737ee
CY
2096and t is the same as `SECONDARY'.
2097
2098TERMINAL should be a terminal object or a frame specifying the X
2099server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2100frame's display, or the first available X display.
2101
2102On Nextstep, TERMINAL is unused. */)
a9f737ee 2103 (Lisp_Object selection, Lisp_Object terminal)
ede4db72 2104{
a9f737ee
CY
2105 struct frame *f = frame_for_x_selection (terminal);
2106
b7826503 2107 CHECK_SYMBOL (selection);
ede4db72
RS
2108 if (EQ (selection, Qnil)) selection = QPRIMARY;
2109 if (EQ (selection, Qt)) selection = QSECONDARY;
1b65481e 2110
aad3612f 2111 if (f && !NILP (LOCAL_SELECTION (selection, FRAME_DISPLAY_INFO (f))))
a9f737ee
CY
2112 return Qt;
2113 else
ede4db72 2114 return Qnil;
ede4db72
RS
2115}
2116
2117DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
a9f737ee
CY
2118 0, 2, 0,
2119 doc: /* Whether there is an owner for the given X selection.
2120SELECTION should be the name of the selection in question, typically
3c9dfce6
CY
2121one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2122`CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2123symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
a9f737ee
CY
2124
2125TERMINAL should be a terminal object or a frame specifying the X
2126server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2127frame's display, or the first available X display.
2128
2129On Nextstep, TERMINAL is unused. */)
a9f737ee 2130 (Lisp_Object selection, Lisp_Object terminal)
ede4db72
RS
2131{
2132 Window owner;
356ba514 2133 Atom atom;
a9f737ee
CY
2134 struct frame *f = frame_for_x_selection (terminal);
2135 struct x_display_info *dpyinfo;
b8c70430 2136
b7826503 2137 CHECK_SYMBOL (selection);
356ba514
RS
2138 if (EQ (selection, Qnil)) selection = QPRIMARY;
2139 if (EQ (selection, Qt)) selection = QSECONDARY;
a9f737ee
CY
2140
2141 if (!f)
356ba514 2142 return Qnil;
a9f737ee 2143
aad3612f 2144 dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
2145
2146 if (!NILP (LOCAL_SELECTION (selection, dpyinfo)))
2147 return Qt;
2148
2149 atom = symbol_to_x_atom (dpyinfo, selection);
2150 if (atom == 0) return Qnil;
4d7e6e51 2151 block_input ();
a9f737ee 2152 owner = XGetSelectionOwner (dpyinfo->display, atom);
4d7e6e51 2153 unblock_input ();
ede4db72
RS
2154 return (owner ? Qt : Qnil);
2155}
2156
1dd3c2d9 2157\f
4b80f674
CY
2158/* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2159 property (http://www.freedesktop.org/wiki/ClipboardManager). */
a9f737ee 2160
4b80f674
CY
2161static Lisp_Object
2162x_clipboard_manager_save (Lisp_Object frame)
a9f737ee
CY
2163{
2164 struct frame *f = XFRAME (frame);
aad3612f 2165 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
2166 Atom data = dpyinfo->Xatom_UTF8_STRING;
2167
2168 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2169 dpyinfo->Xatom_EMACS_TMP,
2170 dpyinfo->Xatom_ATOM, 32, PropModeReplace,
2171 (unsigned char *) &data, 1);
2172 x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS,
2173 Qnil, frame);
4b80f674
CY
2174 return Qt;
2175}
2176
2177/* Error handler for x_clipboard_manager_save_frame. */
2178
2179static Lisp_Object
2180x_clipboard_manager_error_1 (Lisp_Object err)
2181{
2182 Lisp_Object args[2];
2183 args[0] = build_string ("X clipboard manager error: %s\n\
2184If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2185 args[1] = CAR (CDR (err));
2186 Fmessage (2, args);
2187 return Qnil;
2188}
2189
2190/* Error handler for x_clipboard_manager_save_all. */
2191
2192static Lisp_Object
2193x_clipboard_manager_error_2 (Lisp_Object err)
2194{
2195 fprintf (stderr, "Error saving to X clipboard manager.\n\
2196If the problem persists, set `x-select-enable-clipboard-manager' \
2197to nil.\n");
2198 return Qnil;
a9f737ee
CY
2199}
2200
1dd3c2d9
CY
2201/* Called from delete_frame: save any clipboard owned by FRAME to the
2202 clipboard manager. Do nothing if FRAME does not own the clipboard,
2203 or if no clipboard manager is present. */
2204
2205void
2206x_clipboard_manager_save_frame (Lisp_Object frame)
a9f737ee 2207{
1dd3c2d9
CY
2208 struct frame *f;
2209
4b80f674
CY
2210 if (!NILP (Vx_select_enable_clipboard_manager)
2211 && FRAMEP (frame)
1dd3c2d9
CY
2212 && (f = XFRAME (frame), FRAME_X_P (f))
2213 && FRAME_LIVE_P (f))
a9f737ee 2214 {
aad3612f 2215 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1dd3c2d9
CY
2216 Lisp_Object local_selection
2217 = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2218
2219 if (!NILP (local_selection)
2220 && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection)))))
2221 && XGetSelectionOwner (dpyinfo->display,
2222 dpyinfo->Xatom_CLIPBOARD_MANAGER))
4b80f674
CY
2223 internal_condition_case_1 (x_clipboard_manager_save, frame, Qt,
2224 x_clipboard_manager_error_1);
a9f737ee 2225 }
1dd3c2d9
CY
2226}
2227
2228/* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2229 clipboard manager. Do nothing if FRAME does not own the clipboard,
2230 or if no clipboard manager is present. */
2231
2232void
2233x_clipboard_manager_save_all (void)
2234{
2235 /* Loop through all X displays, saving owned clipboards. */
2236 struct x_display_info *dpyinfo;
2237 Lisp_Object local_selection, local_frame;
4b80f674
CY
2238
2239 if (NILP (Vx_select_enable_clipboard_manager))
2240 return;
2241
1dd3c2d9 2242 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
a9f737ee 2243 {
1dd3c2d9
CY
2244 local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2245 if (NILP (local_selection)
2246 || !XGetSelectionOwner (dpyinfo->display,
2247 dpyinfo->Xatom_CLIPBOARD_MANAGER))
2248 continue;
a9f737ee 2249
1dd3c2d9
CY
2250 local_frame = XCAR (XCDR (XCDR (XCDR (local_selection))));
2251 if (FRAME_LIVE_P (XFRAME (local_frame)))
3c9dfce6
CY
2252 {
2253 Lisp_Object args[1];
2254 args[0] = build_string ("Saving clipboard to X clipboard manager...");
2255 Fmessage (1, args);
2256
2257 internal_condition_case_1 (x_clipboard_manager_save, local_frame,
2258 Qt, x_clipboard_manager_error_2);
2259 }
1dd3c2d9 2260 }
a9f737ee
CY
2261}
2262
ede4db72 2263\f
1fb3821b
JD
2264/***********************************************************************
2265 Drag and drop support
2266***********************************************************************/
2267/* Check that lisp values are of correct type for x_fill_property_data.
2268 That is, number, string or a cons with two numbers (low and high 16
44f730c8
PE
2269 bit parts of a 32 bit number). Return the number of items in DATA,
2270 or -1 if there is an error. */
1fb3821b
JD
2271
2272int
971de7fb 2273x_check_property_data (Lisp_Object data)
1fb3821b
JD
2274{
2275 Lisp_Object iter;
2276 int size = 0;
2277
44f730c8 2278 for (iter = data; CONSP (iter); iter = XCDR (iter))
1fb3821b
JD
2279 {
2280 Lisp_Object o = XCAR (iter);
2281
2282 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
44f730c8 2283 return -1;
1fb3821b
JD
2284 else if (CONSP (o) &&
2285 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
44f730c8 2286 return -1;
864d7ce7
PE
2287 if (size == INT_MAX)
2288 return -1;
44f730c8 2289 size++;
1fb3821b
JD
2290 }
2291
2292 return size;
2293}
2294
2295/* Convert lisp values to a C array. Values may be a number, a string
2296 which is taken as an X atom name and converted to the atom value, or
2297 a cons containing the two 16 bit parts of a 32 bit number.
2298
2299 DPY is the display use to look up X atoms.
2300 DATA is a Lisp list of values to be converted.
2301 RET is the C array that contains the converted values. It is assumed
ff59904a 2302 it is big enough to hold all values.
e22cf39c
JD
2303 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2304 be stored in RET. Note that long is used for 32 even if long is more
2305 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2306 XClientMessageEvent). */
1fb3821b
JD
2307
2308void
971de7fb 2309x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
1fb3821b 2310{
e22cf39c
JD
2311 long val;
2312 long *d32 = (long *) ret;
2313 short *d16 = (short *) ret;
2314 char *d08 = (char *) ret;
1fb3821b
JD
2315 Lisp_Object iter;
2316
2317 for (iter = data; CONSP (iter); iter = XCDR (iter))
2318 {
2319 Lisp_Object o = XCAR (iter);
2320
be44ca6c
PE
2321 if (INTEGERP (o) || FLOATP (o) || CONSP (o))
2322 val = cons_to_signed (o, LONG_MIN, LONG_MAX);
1fb3821b
JD
2323 else if (STRINGP (o))
2324 {
4d7e6e51 2325 block_input ();
51b59d79 2326 val = (long) XInternAtom (dpy, SSDATA (o), False);
4d7e6e51 2327 unblock_input ();
1fb3821b
JD
2328 }
2329 else
2330 error ("Wrong type, must be string, number or cons");
2331
2332 if (format == 8)
be44ca6c
PE
2333 {
2334 if (CHAR_MIN <= val && val <= CHAR_MAX)
2335 *d08++ = val;
2336 else
2337 error ("Out of 'char' range");
2338 }
1fb3821b 2339 else if (format == 16)
be44ca6c
PE
2340 {
2341 if (SHRT_MIN <= val && val <= SHRT_MAX)
2342 *d16++ = val;
2343 else
2344 error ("Out of 'short' range");
2345 }
1fb3821b
JD
2346 else
2347 *d32++ = val;
2348 }
2349}
2350
2351/* Convert an array of C values to a Lisp list.
2352 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2353 DATA is a C array of values to be converted.
2354 TYPE is the type of the data. Only XA_ATOM is special, it converts
da6062e6 2355 each number in DATA to its corresponding X atom as a symbol.
1fb3821b
JD
2356 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2357 be stored in RET.
2358 SIZE is the number of elements in DATA.
2359
b8d6f4af
JD
2360 Important: When format is 32, data should contain an array of int,
2361 not an array of long as the X library returns. This makes a difference
2362 when sizeof(long) != sizeof(int).
2363
1fb3821b
JD
2364 Also see comment for selection_data_to_lisp_data above. */
2365
2366Lisp_Object
eec47d6b
DN
2367x_property_data_to_lisp (struct frame *f, const unsigned char *data,
2368 Atom type, int format, long unsigned int size)
1fb3821b 2369{
864d7ce7
PE
2370 ptrdiff_t format_bytes = format >> 3;
2371 if (PTRDIFF_MAX / format_bytes < size)
2372 memory_full (SIZE_MAX);
1fb3821b 2373 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
864d7ce7 2374 data, size * format_bytes, type, format);
1fb3821b
JD
2375}
2376
31f16913 2377/* Get the mouse position in frame relative coordinates. */
1fb3821b
JD
2378
2379static void
a10c8269 2380mouse_position_for_drop (struct frame *f, int *x, int *y)
1fb3821b
JD
2381{
2382 Window root, dummy_window;
2383 int dummy;
2384
4d7e6e51 2385 block_input ();
1fb3821b
JD
2386
2387 XQueryPointer (FRAME_X_DISPLAY (f),
2388 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2389
2390 /* The root window which contains the pointer. */
2391 &root,
2392
2393 /* Window pointer is on, not used */
2394 &dummy_window,
2395
2396 /* The position on that root window. */
2397 x, y,
2398
2399 /* x/y in dummy_window coordinates, not used. */
2400 &dummy, &dummy,
2401
2402 /* Modifier keys and pointer buttons, about which
2403 we don't care. */
2404 (unsigned int *) &dummy);
2405
2406
2407 /* Absolute to relative. */
2408 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2409 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2410
4d7e6e51 2411 unblock_input ();
1fb3821b
JD
2412}
2413
2414DEFUN ("x-get-atom-name", Fx_get_atom_name,
2415 Sx_get_atom_name, 1, 2, 0,
2416 doc: /* Return the X atom name for VALUE as a string.
2417VALUE may be a number or a cons where the car is the upper 16 bits and
2418the cdr is the lower 16 bits of a 32 bit value.
2419Use the display for FRAME or the current frame if FRAME is not given or nil.
2420
2421If the value is 0 or the atom is not known, return the empty string. */)
5842a27b 2422 (Lisp_Object value, Lisp_Object frame)
1fb3821b 2423{
7452b7bd 2424 struct frame *f = decode_window_system_frame (frame);
1fb3821b 2425 char *name = 0;
42ca4633 2426 char empty[] = "";
1fb3821b 2427 Lisp_Object ret = Qnil;
1fb3821b
JD
2428 Display *dpy = FRAME_X_DISPLAY (f);
2429 Atom atom;
d7e6881a 2430 bool had_errors_p;
1fb3821b 2431
be44ca6c 2432 CONS_TO_INTEGER (value, Atom, atom);
1fb3821b 2433
4d7e6e51 2434 block_input ();
9ba8e10d 2435 x_catch_errors (dpy);
42ca4633 2436 name = atom ? XGetAtomName (dpy, atom) : empty;
d7e6881a 2437 had_errors_p = x_had_errors_p (dpy);
c525d842 2438 x_uncatch_errors ();
1fb3821b 2439
d7e6881a 2440 if (!had_errors_p)
3a5077c5 2441 ret = build_string (name);
1fb3821b 2442
1fb3821b 2443 if (atom && name) XFree (name);
8b3ad112 2444 if (NILP (ret)) ret = empty_unibyte_string;
1fb3821b 2445
4d7e6e51 2446 unblock_input ();
1fb3821b
JD
2447
2448 return ret;
2449}
2450
9fc68699
JD
2451DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
2452 Sx_register_dnd_atom, 1, 2, 0,
2453 doc: /* Request that dnd events are made for ClientMessages with ATOM.
2454ATOM can be a symbol or a string. The ATOM is interned on the display that
2455FRAME is on. If FRAME is nil, the selected frame is used. */)
5842a27b 2456 (Lisp_Object atom, Lisp_Object frame)
9fc68699
JD
2457{
2458 Atom x_atom;
7452b7bd 2459 struct frame *f = decode_window_system_frame (frame);
ac82cc6a 2460 ptrdiff_t i;
aad3612f 2461 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
9fc68699
JD
2462
2463
2464 if (SYMBOLP (atom))
a9f737ee 2465 x_atom = symbol_to_x_atom (dpyinfo, atom);
9fc68699
JD
2466 else if (STRINGP (atom))
2467 {
4d7e6e51 2468 block_input ();
51b59d79 2469 x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False);
4d7e6e51 2470 unblock_input ();
9fc68699
JD
2471 }
2472 else
2473 error ("ATOM must be a symbol or a string");
2474
db9cd97a 2475 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
9fc68699
JD
2476 if (dpyinfo->x_dnd_atoms[i] == x_atom)
2477 return Qnil;
2478
db9cd97a 2479 if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
a69fbedb
PE
2480 dpyinfo->x_dnd_atoms =
2481 xpalloc (dpyinfo->x_dnd_atoms, &dpyinfo->x_dnd_atoms_size,
2482 1, -1, sizeof *dpyinfo->x_dnd_atoms);
9fc68699
JD
2483
2484 dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
2485 return Qnil;
2486}
2487
2488/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
1fb3821b
JD
2489
2490int
b7ad2f74 2491x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event,
5e617bc2 2492 struct x_display_info *dpyinfo, struct input_event *bufp)
1fb3821b
JD
2493{
2494 Lisp_Object vec;
2495 Lisp_Object frame;
e22cf39c
JD
2496 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2497 unsigned long size = 160/event->format;
1fb3821b 2498 int x, y;
31f16913 2499 unsigned char *data = (unsigned char *) event->data.b;
252c5ee1 2500 int idata[5];
ac82cc6a 2501 ptrdiff_t i;
9fc68699 2502
db9cd97a 2503 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
9fc68699
JD
2504 if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
2505
2506 if (i == dpyinfo->x_dnd_atoms_length) return 0;
1fb3821b
JD
2507
2508 XSETFRAME (frame, f);
2509
31f16913
JD
2510 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2511 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2512 function expects them to be of size int (i.e. 32). So to be able to
2513 use that function, put the data in the form it expects if format is 32. */
2514
908589fd 2515 if (BITS_PER_LONG > 32 && event->format == 32)
31f16913 2516 {
31f16913 2517 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
864d7ce7 2518 idata[i] = event->data.l[i];
31f16913
JD
2519 data = (unsigned char *) idata;
2520 }
2521
d2f14999 2522 vec = Fmake_vector (make_number (4), Qnil);
3ae565b3
SM
2523 ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2524 event->message_type)));
2525 ASET (vec, 1, frame);
2526 ASET (vec, 2, make_number (event->format));
2527 ASET (vec, 3, x_property_data_to_lisp (f,
2528 data,
2529 event->message_type,
2530 event->format,
2531 size));
1fb3821b
JD
2532
2533 mouse_position_for_drop (f, &x, &y);
2534 bufp->kind = DRAG_N_DROP_EVENT;
862c94ca 2535 bufp->frame_or_window = frame;
1fb3821b
JD
2536 bufp->timestamp = CurrentTime;
2537 bufp->x = make_number (x);
2538 bufp->y = make_number (y);
862c94ca 2539 bufp->arg = vec;
1fb3821b
JD
2540 bufp->modifiers = 0;
2541
2542 return 1;
2543}
2544
2bf7d27a 2545DEFUN ("x-send-client-message", Fx_send_client_message,
1fb3821b
JD
2546 Sx_send_client_message, 6, 6, 0,
2547 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2548
2549For DISPLAY, specify either a frame or a display name (a string).
2550If DISPLAY is nil, that stands for the selected frame's display.
2551DEST may be a number, in which case it is a Window id. The value 0 may
2552be used to send to the root window of the DISPLAY.
2553If DEST is a cons, it is converted to a 32 bit number
2554with the high 16 bits from the car and the lower 16 bit from the cdr. That
2555number is then used as a window id.
2556If DEST is a frame the event is sent to the outer window of that frame.
69785ad0 2557A value of nil means the currently selected frame.
1fb3821b
JD
2558If DEST is the string "PointerWindow" the event is sent to the window that
2559contains the pointer. If DEST is the string "InputFocus" the event is
2560sent to the window that has the input focus.
2561FROM is the frame sending the event. Use nil for currently selected frame.
2562MESSAGE-TYPE is the name of an Atom as a string.
2563FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2564bits. VALUES is a list of numbers, cons and/or strings containing the values
2565to send. If a value is a string, it is converted to an Atom and the value of
2566the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2567with the high 16 bits from the car and the lower 16 bit from the cdr.
2568If more values than fits into the event is given, the excessive values
2569are ignored. */)
5e617bc2
JB
2570 (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2571 Lisp_Object message_type, Lisp_Object format, Lisp_Object values)
2d9074ba
JD
2572{
2573 struct x_display_info *dpyinfo = check_x_display_info (display);
2574
933e29ff 2575 CHECK_STRING (message_type);
5e617bc2
JB
2576 x_send_client_event (display, dest, from,
2577 XInternAtom (dpyinfo->display,
2578 SSDATA (message_type),
2579 False),
2580 format, values);
2d9074ba
JD
2581
2582 return Qnil;
2583}
2584
2585void
5e617bc2
JB
2586x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2587 Atom message_type, Lisp_Object format, Lisp_Object values)
1fb3821b
JD
2588{
2589 struct x_display_info *dpyinfo = check_x_display_info (display);
2590 Window wdest;
2591 XEvent event;
7452b7bd 2592 struct frame *f = decode_window_system_frame (from);
1fb3821b
JD
2593 int to_root;
2594
1fb3821b
JD
2595 CHECK_NUMBER (format);
2596 CHECK_CONS (values);
2597
2598 if (x_check_property_data (values) == -1)
2599 error ("Bad data in VALUES, must be number, cons or string");
2600
d311d28c 2601 if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32)
1fb3821b 2602 error ("FORMAT must be one of 8, 16 or 32");
a0ecb2ac 2603
d311d28c
PE
2604 event.xclient.type = ClientMessage;
2605 event.xclient.format = XINT (format);
2606
1fb3821b
JD
2607 if (FRAMEP (dest) || NILP (dest))
2608 {
7452b7bd 2609 struct frame *fdest = decode_window_system_frame (dest);
1fb3821b
JD
2610 wdest = FRAME_OUTER_WINDOW (fdest);
2611 }
2612 else if (STRINGP (dest))
2613 {
42a5b22f 2614 if (strcmp (SSDATA (dest), "PointerWindow") == 0)
1fb3821b 2615 wdest = PointerWindow;
42a5b22f 2616 else if (strcmp (SSDATA (dest), "InputFocus") == 0)
1fb3821b
JD
2617 wdest = InputFocus;
2618 else
2619 error ("DEST as a string must be one of PointerWindow or InputFocus");
2620 }
be44ca6c
PE
2621 else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest))
2622 CONS_TO_INTEGER (dest, Window, wdest);
1fb3821b
JD
2623 else
2624 error ("DEST must be a frame, nil, string, number or cons");
2625
2626 if (wdest == 0) wdest = dpyinfo->root_window;
2627 to_root = wdest == dpyinfo->root_window;
2628
4d7e6e51 2629 block_input ();
1fb3821b 2630
8fd9c92e
JD
2631 event.xclient.send_event = True;
2632 event.xclient.serial = 0;
2d9074ba 2633 event.xclient.message_type = message_type;
1fb3821b
JD
2634 event.xclient.display = dpyinfo->display;
2635
2636 /* Some clients (metacity for example) expects sending window to be here
2637 when sending to the root window. */
2638 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2639
8fd9c92e 2640 memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l));
1fb3821b
JD
2641 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2642 event.xclient.format);
2643
2644 /* If event mask is 0 the event is sent to the client that created
2645 the destination window. But if we are sending to the root window,
8fd9c92e 2646 there is no such client. Then we set the event mask to 0xffffff. The
1fb3821b 2647 event then goes to clients selecting for events on the root window. */
9ba8e10d 2648 x_catch_errors (dpyinfo->display);
1fb3821b
JD
2649 {
2650 int propagate = to_root ? False : True;
8fd9c92e
JD
2651 long mask = to_root ? 0xffffff : 0;
2652
1fb3821b
JD
2653 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2654 XFlush (dpyinfo->display);
2655 }
4545fa20 2656 x_uncatch_errors ();
4d7e6e51 2657 unblock_input ();
1fb3821b
JD
2658}
2659
2660\f
ede4db72 2661void
971de7fb 2662syms_of_xselect (void)
ede4db72 2663{
ede4db72
RS
2664 defsubr (&Sx_get_selection_internal);
2665 defsubr (&Sx_own_selection_internal);
2666 defsubr (&Sx_disown_selection_internal);
2667 defsubr (&Sx_selection_owner_p);
2668 defsubr (&Sx_selection_exists_p);
2669
1fb3821b
JD
2670 defsubr (&Sx_get_atom_name);
2671 defsubr (&Sx_send_client_message);
9fc68699 2672 defsubr (&Sx_register_dnd_atom);
1fb3821b 2673
ede4db72
RS
2674 reading_selection_reply = Fcons (Qnil, Qnil);
2675 staticpro (&reading_selection_reply);
2676 reading_selection_window = 0;
2677 reading_which_selection = 0;
2678
2679 property_change_wait_list = 0;
2f65feb6 2680 prop_location_identifier = 0;
ede4db72
RS
2681 property_change_reply = Fcons (Qnil, Qnil);
2682 staticpro (&property_change_reply);
2683
e067f0c1
CY
2684 converted_selections = NULL;
2685 conversion_fail_tag = None;
2686
29208e82 2687 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
8c1a1077
PJ
2688 doc: /* An alist associating X Windows selection-types with functions.
2689These functions are called to convert the selection, with three args:
2690the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2691a desired type to which the selection should be converted;
2692and the local selection value (whatever was given to `x-own-selection').
2693
2694The function should return the value to send to the X server
2695\(typically a string). A return value of nil
2696means that the conversion could not be done.
2697A return value which is the symbol `NULL'
2698means that a side-effect was executed,
2699and there is no meaningful selection value. */);
ede4db72
RS
2700 Vselection_converter_alist = Qnil;
2701
29208e82 2702 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions,
8c1a1077
PJ
2703 doc: /* A list of functions to be called when Emacs loses an X selection.
2704\(This happens when some other X client makes its own selection
2705or when a Lisp program explicitly clears the selection.)
2706The functions are called with one argument, the selection type
2707\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
c917a8de 2708 Vx_lost_selection_functions = Qnil;
ede4db72 2709
29208e82 2710 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions,
8c1a1077 2711 doc: /* A list of functions to be called when Emacs answers a selection request.
e067f0c1 2712The functions are called with three arguments:
8c1a1077
PJ
2713 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2714 - the selection-type which Emacs was asked to convert the
2715 selection into before sending (for example, `STRING' or `LENGTH');
2716 - a flag indicating success or failure for responding to the request.
2717We might have failed (and declined the request) for any number of reasons,
2718including being asked for a selection that we no longer own, or being asked
2719to convert into a type that we don't know about or that is inappropriate.
2720This hook doesn't let you change the behavior of Emacs's selection replies,
2721it merely informs you that they have happened. */);
c917a8de 2722 Vx_sent_selection_functions = Qnil;
ede4db72 2723
4b80f674
CY
2724 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2725 Vx_select_enable_clipboard_manager,
2726 doc: /* Whether to enable X clipboard manager support.
2727If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2728while owning the X clipboard, the clipboard contents are saved to the
2729clipboard manager if one is present. */);
2730 Vx_select_enable_clipboard_manager = Qt;
2731
29208e82 2732 DEFVAR_INT ("x-selection-timeout", x_selection_timeout,
8c1a1077
PJ
2733 doc: /* Number of milliseconds to wait for a selection reply.
2734If the selection owner doesn't reply in this time, we give up.
2735A value of 0 means wait as long as necessary. This is initialized from the
2736\"*selectionTimeout\" resource. */);
ede4db72
RS
2737 x_selection_timeout = 0;
2738
9852377f 2739 /* QPRIMARY is defined in keyboard.c. */
f3d4e0a4
CY
2740 DEFSYM (QSECONDARY, "SECONDARY");
2741 DEFSYM (QSTRING, "STRING");
2742 DEFSYM (QINTEGER, "INTEGER");
2743 DEFSYM (QCLIPBOARD, "CLIPBOARD");
2744 DEFSYM (QTIMESTAMP, "TIMESTAMP");
2745 DEFSYM (QTEXT, "TEXT");
2746 DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT");
2747 DEFSYM (QUTF8_STRING, "UTF8_STRING");
2748 DEFSYM (QDELETE, "DELETE");
2749 DEFSYM (QMULTIPLE, "MULTIPLE");
2750 DEFSYM (QINCR, "INCR");
2751 DEFSYM (QEMACS_TMP, "_EMACS_TMP_");
2752 DEFSYM (QTARGETS, "TARGETS");
2753 DEFSYM (QATOM, "ATOM");
2754 DEFSYM (QATOM_PAIR, "ATOM_PAIR");
a9f737ee
CY
2755 DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER");
2756 DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS");
f3d4e0a4
CY
2757 DEFSYM (QNULL, "NULL");
2758 DEFSYM (Qcompound_text_with_extensions, "compound-text-with-extensions");
2759 DEFSYM (Qforeign_selection, "foreign-selection");
cd18e7e3
JB
2760 DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions");
2761 DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions");
ede4db72 2762}