Update copyright year to 2014 by running admin/update-copyright.
[bpt/emacs.git] / src / xselect.c
CommitLineData
2408b3a1 1/* X Selection processing for Emacs.
ba318903 2 Copyright (C) 1993-1997, 2000-2014 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;
6bbe6da8 323 Time timestamp = dpyinfo->last_user_time;
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 974
a9f737ee 975 redisplay_preserve_echo_area (20);
ede4db72
RS
976}
977
dd0fe424 978void
971de7fb 979x_handle_selection_event (struct input_event *event)
dd0fe424
KS
980{
981 TRACE0 ("x_handle_selection_event");
e067f0c1 982 if (event->kind != SELECTION_REQUEST_EVENT)
dd0fe424 983 x_handle_selection_clear (event);
e067f0c1
CY
984 else if (x_queue_selection_requests)
985 x_queue_event (event);
986 else
987 x_handle_selection_request (event);
dd0fe424
KS
988}
989
990
118bd841
RS
991/* Clear all selections that were made from frame F.
992 We do this when about to delete a frame. */
993
994void
a10c8269 995x_clear_frame_selections (struct frame *f)
118bd841
RS
996{
997 Lisp_Object frame;
998 Lisp_Object rest;
aad3612f 999 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee 1000 struct terminal *t = dpyinfo->terminal;
118bd841 1001
90851bbe 1002 XSETFRAME (frame, f);
118bd841 1003
0d199f9c 1004 /* Delete elements from the beginning of Vselection_alist. */
a9f737ee
CY
1005 while (CONSP (t->Vselection_alist)
1006 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist)))))))
0d199f9c 1007 {
a9f737ee
CY
1008 /* Run the `x-lost-selection-functions' abnormal hook. */
1009 Lisp_Object args[2];
cd18e7e3 1010 args[0] = Qx_lost_selection_functions;
a9f737ee
CY
1011 args[1] = Fcar (Fcar (t->Vselection_alist));
1012 Frun_hook_with_args (2, args);
0d199f9c 1013
3f22b86f 1014 tset_selection_alist (t, XCDR (t->Vselection_alist));
0d199f9c
RS
1015 }
1016
1017 /* Delete elements after the beginning of Vselection_alist. */
a9f737ee
CY
1018 for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest))
1019 if (CONSP (XCDR (rest))
1020 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest))))))))
118bd841 1021 {
a9f737ee 1022 Lisp_Object args[2];
cd18e7e3 1023 args[0] = Qx_lost_selection_functions;
a9f737ee
CY
1024 args[1] = XCAR (XCAR (XCDR (rest)));
1025 Frun_hook_with_args (2, args);
1026 XSETCDR (rest, XCDR (XCDR (rest)));
118bd841
RS
1027 break;
1028 }
1029}
ede4db72 1030\f
ede4db72
RS
1031/* Nonzero if any properties for DISPLAY and WINDOW
1032 are on the list of what we are waiting for. */
1033
1034static int
971de7fb 1035waiting_for_other_props_on_window (Display *display, Window window)
ede4db72
RS
1036{
1037 struct prop_location *rest = property_change_wait_list;
1038 while (rest)
1039 if (rest->display == display && rest->window == window)
1040 return 1;
1041 else
1042 rest = rest->next;
1043 return 0;
1044}
1045
1046/* Add an entry to the list of property changes we are waiting for.
1047 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1048 The return value is a number that uniquely identifies
1049 this awaited property change. */
1050
d1f21a66 1051static struct prop_location *
5e617bc2
JB
1052expect_property_change (Display *display, Window window,
1053 Atom property, int state)
ede4db72 1054{
23f86fce 1055 struct prop_location *pl = xmalloc (sizeof *pl);
2f65feb6 1056 pl->identifier = ++prop_location_identifier;
ede4db72
RS
1057 pl->display = display;
1058 pl->window = window;
1059 pl->property = property;
1060 pl->desired_state = state;
1061 pl->next = property_change_wait_list;
d1f21a66 1062 pl->arrived = 0;
ede4db72 1063 property_change_wait_list = pl;
d1f21a66 1064 return pl;
ede4db72
RS
1065}
1066
1067/* Delete an entry from the list of property changes we are waiting for.
2f65feb6 1068 IDENTIFIER is the number that uniquely identifies the entry. */
ede4db72
RS
1069
1070static void
971de7fb 1071unexpect_property_change (struct prop_location *location)
ede4db72
RS
1072{
1073 struct prop_location *prev = 0, *rest = property_change_wait_list;
1074 while (rest)
1075 {
d1f21a66 1076 if (rest == location)
ede4db72
RS
1077 {
1078 if (prev)
1079 prev->next = rest->next;
1080 else
1081 property_change_wait_list = rest->next;
4feb31b2 1082 xfree (rest);
ede4db72
RS
1083 return;
1084 }
1085 prev = rest;
1086 rest = rest->next;
1087 }
1088}
1089
2f65feb6
RS
1090/* Remove the property change expectation element for IDENTIFIER. */
1091
27e498e6
PE
1092static void
1093wait_for_property_change_unwind (void *loc)
2f65feb6 1094{
27e498e6 1095 struct prop_location *location = loc;
dd0fe424
KS
1096
1097 unexpect_property_change (location);
1098 if (location == property_change_reply_object)
1099 property_change_reply_object = 0;
2f65feb6
RS
1100}
1101
ede4db72 1102/* Actually wait for a property change.
2f65feb6 1103 IDENTIFIER should be the value that expect_property_change returned. */
ede4db72
RS
1104
1105static void
971de7fb 1106wait_for_property_change (struct prop_location *location)
ede4db72 1107{
d311d28c 1108 ptrdiff_t count = SPECPDL_INDEX ();
d1f21a66 1109
dd0fe424 1110 if (property_change_reply_object)
1088b922 1111 emacs_abort ();
2f65feb6
RS
1112
1113 /* Make sure to do unexpect_property_change if we quit or err. */
27e498e6 1114 record_unwind_protect_ptr (wait_for_property_change_unwind, location);
2f65feb6 1115
f3fbd155 1116 XSETCAR (property_change_reply, Qnil);
afe1529d 1117 property_change_reply_object = location;
dd0fe424 1118
afe1529d
RS
1119 /* If the event we are waiting for arrives beyond here, it will set
1120 property_change_reply, because property_change_reply_object says so. */
d1f21a66
RS
1121 if (! location->arrived)
1122 {
d35af63c
PE
1123 EMACS_INT timeout = max (0, x_selection_timeout);
1124 EMACS_INT secs = timeout / 1000;
1125 int nsecs = (timeout % 1000) * 1000000;
1126 TRACE2 (" Waiting %"pI"d secs, %d nsecs", secs, nsecs);
1127 wait_reading_process_output (secs, nsecs, 0, 0,
d64b707c 1128 property_change_reply, NULL, 0);
d1f21a66 1129
8e713be6 1130 if (NILP (XCAR (property_change_reply)))
d9c0d4a3
GM
1131 {
1132 TRACE0 (" Timed out");
1133 error ("Timed out waiting for property-notify event");
1134 }
d1f21a66 1135 }
2f65feb6
RS
1136
1137 unbind_to (count, Qnil);
ede4db72
RS
1138}
1139
1140/* Called from XTread_socket in response to a PropertyNotify event. */
1141
1142void
b7ad2f74 1143x_handle_property_notify (const XPropertyEvent *event)
ede4db72 1144{
6abdaa4a 1145 struct prop_location *rest;
d9c0d4a3 1146
6abdaa4a 1147 for (rest = property_change_wait_list; rest; rest = rest->next)
ede4db72 1148 {
dd0fe424
KS
1149 if (!rest->arrived
1150 && rest->property == event->atom
ede4db72
RS
1151 && rest->window == event->window
1152 && rest->display == event->display
1153 && rest->desired_state == event->state)
1154 {
d9c0d4a3
GM
1155 TRACE2 ("Expected %s of property %s",
1156 (event->state == PropertyDelete ? "deletion" : "change"),
1157 XGetAtomName (event->display, event->atom));
ede4db72 1158
d1f21a66
RS
1159 rest->arrived = 1;
1160
ede4db72
RS
1161 /* If this is the one wait_for_property_change is waiting for,
1162 tell it to wake up. */
d1f21a66 1163 if (rest == property_change_reply_object)
f3fbd155 1164 XSETCAR (property_change_reply, Qt);
ede4db72 1165
ede4db72
RS
1166 return;
1167 }
ede4db72 1168 }
ede4db72
RS
1169}
1170
1171
1172\f
ede4db72
RS
1173/* Variables for communication with x_handle_selection_notify. */
1174static Atom reading_which_selection;
1175static Lisp_Object reading_selection_reply;
1176static Window reading_selection_window;
1177
1178/* Do protocol to read selection-data from the server.
a9f737ee
CY
1179 Converts this to Lisp data and returns it.
1180 FRAME is the frame whose X window shall request the selection. */
ede4db72
RS
1181
1182static Lisp_Object
a9f737ee
CY
1183x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
1184 Lisp_Object time_stamp, Lisp_Object frame)
ede4db72 1185{
a9f737ee 1186 struct frame *f = XFRAME (frame);
aad3612f 1187 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
1188 Display *display = dpyinfo->display;
1189 Window requestor_window = FRAME_X_WINDOW (f);
6bbe6da8 1190 Time requestor_time = dpyinfo->last_user_time;
a9f737ee
CY
1191 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1192 Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_symbol);
1193 Atom type_atom = (CONSP (target_type)
1194 ? symbol_to_x_atom (dpyinfo, XCAR (target_type))
1195 : symbol_to_x_atom (dpyinfo, target_type));
d35af63c
PE
1196 EMACS_INT timeout, secs;
1197 int nsecs;
ede4db72 1198
a9f737ee 1199 if (!FRAME_LIVE_P (f))
428a555e
KL
1200 return Qnil;
1201
3a42401d 1202 if (! NILP (time_stamp))
be44ca6c 1203 CONS_TO_INTEGER (time_stamp, Time, requestor_time);
3a42401d 1204
4d7e6e51 1205 block_input ();
d9c0d4a3
GM
1206 TRACE2 ("Get selection %s, type %s",
1207 XGetAtomName (display, type_atom),
1208 XGetAtomName (display, target_property));
1209
de65b42c 1210 x_catch_errors (display);
ede4db72 1211 XConvertSelection (display, selection_atom, type_atom, target_property,
5d0ba25b 1212 requestor_window, requestor_time);
de65b42c
CY
1213 x_check_errors (display, "Can't convert selection: %s");
1214 x_uncatch_errors ();
ede4db72
RS
1215
1216 /* Prepare to block until the reply has been read. */
5d0ba25b 1217 reading_selection_window = requestor_window;
ede4db72 1218 reading_which_selection = selection_atom;
f3fbd155 1219 XSETCAR (reading_selection_reply, Qnil);
55b2d45d 1220
e067f0c1
CY
1221 /* It should not be necessary to stop handling selection requests
1222 during this time. In fact, the SAVE_TARGETS mechanism requires
1223 us to handle a clipboard manager's requests before it returns
1224 SelectionNotify. */
1225#if 0
a9f737ee 1226 x_start_queuing_selection_requests ();
27e498e6 1227 record_unwind_protect_void (x_stop_queuing_selection_requests);
e067f0c1
CY
1228#endif
1229
4d7e6e51 1230 unblock_input ();
ede4db72 1231
80da0190 1232 /* This allows quits. Also, don't wait forever. */
d35af63c
PE
1233 timeout = max (0, x_selection_timeout);
1234 secs = timeout / 1000;
1235 nsecs = (timeout % 1000) * 1000000;
1236 TRACE1 (" Start waiting %"pI"d secs for SelectionNotify", secs);
1237 wait_reading_process_output (secs, nsecs, 0, 0,
d64b707c 1238 reading_selection_reply, NULL, 0);
d9c0d4a3 1239 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
ede4db72 1240
8e713be6 1241 if (NILP (XCAR (reading_selection_reply)))
606140dd 1242 error ("Timed out waiting for reply from selection owner");
8e713be6 1243 if (EQ (XCAR (reading_selection_reply), Qlambda))
12061f06 1244 return Qnil;
ede4db72
RS
1245
1246 /* Otherwise, the selection is waiting for us on the requested property. */
1247 return
5d0ba25b 1248 x_get_window_property_as_lisp_data (display, requestor_window,
ede4db72
RS
1249 target_property, target_type,
1250 selection_atom);
1251}
1252\f
1253/* Subroutines of x_get_window_property_as_lisp_data */
1254
4feb31b2 1255/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1256
ede4db72 1257static void
d5a3eaaf 1258x_get_window_property (Display *display, Window window, Atom property,
864d7ce7 1259 unsigned char **data_ret, ptrdiff_t *bytes_ret,
d5a3eaaf
AS
1260 Atom *actual_type_ret, int *actual_format_ret,
1261 unsigned long *actual_size_ret, int delete_p)
ede4db72 1262{
864d7ce7 1263 ptrdiff_t total_size;
ede4db72 1264 unsigned long bytes_remaining;
864d7ce7
PE
1265 ptrdiff_t offset = 0;
1266 unsigned char *data = 0;
ede4db72
RS
1267 unsigned char *tmp_data = 0;
1268 int result;
864d7ce7
PE
1269 int buffer_size = selection_quantum (display);
1270
1271 /* Wide enough to avoid overflow in expressions using it. */
1272 ptrdiff_t x_long_size = X_LONG_SIZE;
1b65481e 1273
864d7ce7
PE
1274 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1275 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1276 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1277 ptrdiff_t total_size_max =
1278 ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX
1279 ? min (PTRDIFF_MAX, SIZE_MAX) - 1
1280 : LONG_MAX * x_long_size);
1b65481e 1281
4d7e6e51 1282 block_input ();
1b65481e 1283
ede4db72
RS
1284 /* First probe the thing to find out how big it is. */
1285 result = XGetWindowProperty (display, window, property,
137edb72 1286 0L, 0L, False, AnyPropertyType,
ede4db72
RS
1287 actual_type_ret, actual_format_ret,
1288 actual_size_ret,
1289 &bytes_remaining, &tmp_data);
ede4db72 1290 if (result != Success)
864d7ce7 1291 goto done;
1b65481e 1292
0158abbc 1293 /* This was allocated by Xlib, so use XFree. */
98c6f1e3 1294 XFree (tmp_data);
1b65481e 1295
ede4db72 1296 if (*actual_type_ret == None || *actual_format_ret == 0)
864d7ce7 1297 goto done;
ede4db72 1298
864d7ce7
PE
1299 if (total_size_max < bytes_remaining)
1300 goto size_overflow;
1301 total_size = bytes_remaining;
1302 data = malloc (total_size + 1);
1303 if (! data)
1304 goto memory_exhausted;
1b65481e 1305
2a1a4c9d 1306 /* Now read, until we've gotten it all. */
ede4db72
RS
1307 while (bytes_remaining)
1308 {
864d7ce7
PE
1309 ptrdiff_t bytes_gotten;
1310 int bytes_per_item;
ede4db72
RS
1311 result
1312 = XGetWindowProperty (display, window, property,
864d7ce7
PE
1313 offset / X_LONG_SIZE,
1314 buffer_size / X_LONG_SIZE,
2f65feb6 1315 False,
ede4db72
RS
1316 AnyPropertyType,
1317 actual_type_ret, actual_format_ret,
1318 actual_size_ret, &bytes_remaining, &tmp_data);
d9c0d4a3 1319
ede4db72
RS
1320 /* If this doesn't return Success at this point, it means that
1321 some clod deleted the selection while we were in the midst of
d9c0d4a3
GM
1322 reading it. Deal with that, I guess.... */
1323 if (result != Success)
1324 break;
e22cf39c 1325
864d7ce7 1326 bytes_per_item = *actual_format_ret >> 3;
a54e2c05 1327 eassert (*actual_size_ret <= buffer_size / bytes_per_item);
864d7ce7 1328
e22cf39c
JD
1329 /* The man page for XGetWindowProperty says:
1330 "If the returned format is 32, the returned data is represented
1331 as a long array and should be cast to that type to obtain the
1332 elements."
1333 This applies even if long is more than 32 bits, the X library
1334 converts from 32 bit elements received from the X server to long
72af86bd 1335 and passes the long array to us. Thus, for that case memcpy can not
e22cf39c
JD
1336 be used. We convert to a 32 bit type here, because so much code
1337 assume on that.
1338
1339 The bytes and offsets passed to XGetWindowProperty refers to the
1340 property and those are indeed in 32 bit quantities if format is 32. */
1341
864d7ce7
PE
1342 bytes_gotten = *actual_size_ret;
1343 bytes_gotten *= bytes_per_item;
1344
1345 TRACE2 ("Read %"pD"d bytes from property %s",
1346 bytes_gotten, XGetAtomName (display, property));
1347
1348 if (total_size - offset < bytes_gotten)
1349 {
1350 unsigned char *data1;
1351 ptrdiff_t remaining_lim = total_size_max - offset - bytes_gotten;
1352 if (remaining_lim < 0 || remaining_lim < bytes_remaining)
1353 goto size_overflow;
1354 total_size = offset + bytes_gotten + bytes_remaining;
1355 data1 = realloc (data, total_size + 1);
1356 if (! data1)
1357 goto memory_exhausted;
1358 data = data1;
1359 }
1360
908589fd 1361 if (BITS_PER_LONG > 32 && *actual_format_ret == 32)
e22cf39c
JD
1362 {
1363 unsigned long i;
864d7ce7 1364 int *idata = (int *) (data + offset);
e22cf39c
JD
1365 long *ldata = (long *) tmp_data;
1366
1367 for (i = 0; i < *actual_size_ret; ++i)
864d7ce7 1368 idata[i] = ldata[i];
e22cf39c
JD
1369 }
1370 else
864d7ce7
PE
1371 memcpy (data + offset, tmp_data, bytes_gotten);
1372
1373 offset += bytes_gotten;
1b65481e 1374
0158abbc 1375 /* This was allocated by Xlib, so use XFree. */
98c6f1e3 1376 XFree (tmp_data);
ede4db72 1377 }
2f65feb6 1378
5c3a351a 1379 XFlush (display);
864d7ce7
PE
1380 data[offset] = '\0';
1381
1382 done:
4d7e6e51 1383 unblock_input ();
864d7ce7 1384 *data_ret = data;
ede4db72 1385 *bytes_ret = offset;
864d7ce7
PE
1386 return;
1387
1388 size_overflow:
1389 free (data);
4d7e6e51 1390 unblock_input ();
864d7ce7
PE
1391 memory_full (SIZE_MAX);
1392
1393 memory_exhausted:
1394 free (data);
4d7e6e51 1395 unblock_input ();
864d7ce7 1396 memory_full (total_size + 1);
ede4db72
RS
1397}
1398\f
4feb31b2 1399/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1400
ede4db72 1401static void
d5a3eaaf
AS
1402receive_incremental_selection (Display *display, Window window, Atom property,
1403 Lisp_Object target_type,
1404 unsigned int min_size_bytes,
864d7ce7
PE
1405 unsigned char **data_ret,
1406 ptrdiff_t *size_bytes_ret,
d5a3eaaf
AS
1407 Atom *type_ret, int *format_ret,
1408 unsigned long *size_ret)
ede4db72 1409{
864d7ce7 1410 ptrdiff_t offset = 0;
d1f21a66 1411 struct prop_location *wait_object;
864d7ce7
PE
1412 if (min (PTRDIFF_MAX, SIZE_MAX) < min_size_bytes)
1413 memory_full (SIZE_MAX);
23f86fce 1414 *data_ret = xmalloc (min_size_bytes);
ede4db72 1415 *size_bytes_ret = min_size_bytes;
d9c0d4a3 1416
864d7ce7 1417 TRACE1 ("Read %u bytes incrementally", min_size_bytes);
2f65feb6
RS
1418
1419 /* At this point, we have read an INCR property.
1420 Delete the property to ack it.
1421 (But first, prepare to receive the next event in this handshake.)
ede4db72
RS
1422
1423 Now, we must loop, waiting for the sending window to put a value on
1424 that property, then reading the property, then deleting it to ack.
1425 We are done when the sender places a property of length 0.
1426 */
4d7e6e51 1427 block_input ();
2f65feb6 1428 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
d9c0d4a3 1429 TRACE1 (" Delete property %s",
dd0fe424 1430 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
2f65feb6 1431 XDeleteProperty (display, window, property);
d9c0d4a3 1432 TRACE1 (" Expect new value of property %s",
dd0fe424 1433 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
d1f21a66
RS
1434 wait_object = expect_property_change (display, window, property,
1435 PropertyNewValue);
5c3a351a 1436 XFlush (display);
4d7e6e51 1437 unblock_input ();
2f65feb6 1438
ede4db72
RS
1439 while (1)
1440 {
1441 unsigned char *tmp_data;
864d7ce7 1442 ptrdiff_t tmp_size_bytes;
d9c0d4a3
GM
1443
1444 TRACE0 (" Wait for property change");
d1f21a66 1445 wait_for_property_change (wait_object);
1b65481e 1446
ede4db72 1447 /* expect it again immediately, because x_get_window_property may
2a1a4c9d 1448 .. no it won't, I don't get it.
d9c0d4a3
GM
1449 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1450 TRACE0 (" Get property value");
ede4db72
RS
1451 x_get_window_property (display, window, property,
1452 &tmp_data, &tmp_size_bytes,
1453 type_ret, format_ret, size_ret, 1);
1454
864d7ce7 1455 TRACE1 (" Read increment of %"pD"d bytes", tmp_size_bytes);
d9c0d4a3 1456
ede4db72
RS
1457 if (tmp_size_bytes == 0) /* we're done */
1458 {
d9c0d4a3
GM
1459 TRACE0 ("Done reading incrementally");
1460
2f65feb6
RS
1461 if (! waiting_for_other_props_on_window (display, window))
1462 XSelectInput (display, window, STANDARD_EVENT_SET);
4feb31b2 1463 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1464 calls xmalloc itself. */
70fdbb46 1465 xfree (tmp_data);
ede4db72
RS
1466 break;
1467 }
2f65feb6 1468
4d7e6e51 1469 block_input ();
d9c0d4a3
GM
1470 TRACE1 (" ACK by deleting property %s",
1471 XGetAtomName (display, property));
2f65feb6 1472 XDeleteProperty (display, window, property);
d1f21a66
RS
1473 wait_object = expect_property_change (display, window, property,
1474 PropertyNewValue);
5c3a351a 1475 XFlush (display);
4d7e6e51 1476 unblock_input ();
2f65feb6 1477
864d7ce7 1478 if (*size_bytes_ret - offset < tmp_size_bytes)
0065d054
PE
1479 *data_ret = xpalloc (*data_ret, size_bytes_ret,
1480 tmp_size_bytes - (*size_bytes_ret - offset),
1481 -1, 1);
1b65481e 1482
72af86bd 1483 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
ede4db72 1484 offset += tmp_size_bytes;
1b65481e 1485
4feb31b2 1486 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1487 calls xmalloc itself. */
4feb31b2 1488 xfree (tmp_data);
ede4db72
RS
1489 }
1490}
d9c0d4a3 1491
ede4db72 1492\f
e067f0c1
CY
1493/* Fetch a value from property PROPERTY of X window WINDOW on display
1494 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1495 if this fails. */
ede4db72
RS
1496
1497static Lisp_Object
d5a3eaaf
AS
1498x_get_window_property_as_lisp_data (Display *display, Window window,
1499 Atom property,
1500 Lisp_Object target_type,
1501 Atom selection_atom)
ede4db72
RS
1502{
1503 Atom actual_type;
1504 int actual_format;
1505 unsigned long actual_size;
1506 unsigned char *data = 0;
864d7ce7 1507 ptrdiff_t bytes = 0;
ede4db72 1508 Lisp_Object val;
5c3a351a 1509 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1510
d9c0d4a3
GM
1511 TRACE0 ("Reading selection data");
1512
ede4db72
RS
1513 x_get_window_property (display, window, property, &data, &bytes,
1514 &actual_type, &actual_format, &actual_size, 1);
1515 if (! data)
1516 {
1517 int there_is_a_selection_owner;
4d7e6e51 1518 block_input ();
ede4db72
RS
1519 there_is_a_selection_owner
1520 = XGetSelectionOwner (display, selection_atom);
4d7e6e51 1521 unblock_input ();
4d30ce50
KS
1522 if (there_is_a_selection_owner)
1523 signal_error ("Selection owner couldn't convert",
1524 actual_type
1525 ? list2 (target_type,
1526 x_atom_to_symbol (display, actual_type))
1527 : target_type);
1528 else
1529 signal_error ("No selection",
1530 x_atom_to_symbol (display, selection_atom));
ede4db72 1531 }
1b65481e 1532
5c3a351a 1533 if (actual_type == dpyinfo->Xatom_INCR)
ede4db72
RS
1534 {
1535 /* That wasn't really the data, just the beginning. */
1536
1537 unsigned int min_size_bytes = * ((unsigned int *) data);
4d7e6e51 1538 block_input ();
4feb31b2 1539 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1540 calls xmalloc itself. */
98c6f1e3 1541 xfree (data);
4d7e6e51 1542 unblock_input ();
ede4db72
RS
1543 receive_incremental_selection (display, window, property, target_type,
1544 min_size_bytes, &data, &bytes,
1545 &actual_type, &actual_format,
1546 &actual_size);
1547 }
1548
4d7e6e51 1549 block_input ();
d9c0d4a3 1550 TRACE1 (" Delete property %s", XGetAtomName (display, property));
2f65feb6 1551 XDeleteProperty (display, window, property);
5c3a351a 1552 XFlush (display);
4d7e6e51 1553 unblock_input ();
2f65feb6 1554
ede4db72
RS
1555 /* It's been read. Now convert it to a lisp object in some semi-rational
1556 manner. */
1557 val = selection_data_to_lisp_data (display, data, bytes,
1558 actual_type, actual_format);
1b65481e 1559
4feb31b2 1560 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1561 calls xmalloc itself. */
98c6f1e3 1562 xfree (data);
ede4db72
RS
1563 return val;
1564}
1565\f
1566/* These functions convert from the selection data read from the server into
1567 something that we can use from Lisp, and vice versa.
1568
1569 Type: Format: Size: Lisp Type:
1570 ----- ------- ----- -----------
1571 * 8 * String
1572 ATOM 32 1 Symbol
1573 ATOM 32 > 1 Vector of Symbols
1574 * 16 1 Integer
1575 * 16 > 1 Vector of Integers
1576 * 32 1 if <=16 bits: Integer
1577 if > 16 bits: Cons of top16, bot16
1578 * 32 > 1 Vector of the above
1579
1580 When converting a Lisp number to C, it is assumed to be of format 16 if
1581 it is an integer, and of format 32 if it is a cons of two integers.
1582
1583 When converting a vector of numbers from Lisp to C, it is assumed to be
1584 of format 16 if every element in the vector is an integer, and is assumed
1585 to be of format 32 if any element is a cons of two integers.
1586
1587 When converting an object to C, it may be of the form (SYMBOL . <data>)
1588 where SYMBOL is what we should claim that the type is. Format and
b8d6f4af
JD
1589 representation are as above.
1590
1591 Important: When format is 32, data should contain an array of int,
1592 not an array of long as the X library returns. This makes a difference
1593 when sizeof(long) != sizeof(int). */
ede4db72
RS
1594
1595
1596
1597static Lisp_Object
eec47d6b 1598selection_data_to_lisp_data (Display *display, const unsigned char *data,
864d7ce7 1599 ptrdiff_t size, Atom type, int format)
ede4db72 1600{
5c3a351a 1601 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1602
5c3a351a 1603 if (type == dpyinfo->Xatom_NULL)
ede4db72
RS
1604 return QNULL;
1605
1606 /* Convert any 8-bit data to a string, for compactness. */
1607 else if (format == 8)
e6c7c988 1608 {
e57ad4d8
KH
1609 Lisp_Object str, lispy_type;
1610
1611 str = make_unibyte_string ((char *) data, size);
1612 /* Indicate that this string is from foreign selection by a text
1613 property `foreign-selection' so that the caller of
1614 x-get-selection-internal (usually x-get-selection) can know
1615 that the string must be decode. */
1616 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1617 lispy_type = QCOMPOUND_TEXT;
1618 else if (type == dpyinfo->Xatom_UTF8_STRING)
1619 lispy_type = QUTF8_STRING;
e6c7c988 1620 else
e57ad4d8
KH
1621 lispy_type = QSTRING;
1622 Fput_text_property (make_number (0), make_number (size),
1623 Qforeign_selection, lispy_type, str);
e6c7c988
KH
1624 return str;
1625 }
ede4db72 1626 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
e067f0c1
CY
1627 a vector of symbols. */
1628 else if (type == XA_ATOM
1629 /* Treat ATOM_PAIR type similar to list of atoms. */
1630 || type == dpyinfo->Xatom_ATOM_PAIR)
ede4db72 1631 {
864d7ce7 1632 ptrdiff_t i;
b8d6f4af
JD
1633 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1634 But the callers of these function has made sure the data for
1635 format == 32 is an array of int. Thus, use int instead
1636 of Atom. */
1637 int *idata = (int *) data;
1638
1639 if (size == sizeof (int))
1640 return x_atom_to_symbol (display, (Atom) idata[0]);
ede4db72
RS
1641 else
1642 {
25721f5b
DA
1643 Lisp_Object v = make_uninit_vector (size / sizeof (int));
1644
b8d6f4af 1645 for (i = 0; i < size / sizeof (int); i++)
9a9d91d9 1646 ASET (v, i, x_atom_to_symbol (display, (Atom) idata[i]));
ede4db72
RS
1647 return v;
1648 }
1649 }
1650
1ad08acd
RS
1651 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1652 If the number is 32 bits and won't fit in a Lisp_Int,
1653 convert it to a cons of integers, 16 bits in each half.
ede4db72 1654 */
2f51feb8 1655 else if (format == 32 && size == sizeof (int))
d2eea5b5 1656 return INTEGER_TO_CONS (((int *) data) [0]);
ede4db72 1657 else if (format == 16 && size == sizeof (short))
d2eea5b5 1658 return make_number (((short *) data) [0]);
ede4db72
RS
1659
1660 /* Convert any other kind of data to a vector of numbers, represented
1661 as above (as an integer, or a cons of two 16 bit integers.)
1662 */
1663 else if (format == 16)
1664 {
864d7ce7 1665 ptrdiff_t i;
25721f5b
DA
1666 Lisp_Object v = make_uninit_vector (size / 2);
1667
937a3875 1668 for (i = 0; i < size / 2; i++)
ede4db72 1669 {
d311d28c 1670 short j = ((short *) data) [i];
9a9d91d9 1671 ASET (v, i, make_number (j));
ede4db72
RS
1672 }
1673 return v;
1674 }
1675 else
1676 {
864d7ce7 1677 ptrdiff_t i;
25721f5b
DA
1678 Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
1679
864d7ce7 1680 for (i = 0; i < size / X_LONG_SIZE; i++)
ede4db72 1681 {
d2eea5b5 1682 int j = ((int *) data) [i];
9a9d91d9 1683 ASET (v, i, INTEGER_TO_CONS (j));
ede4db72
RS
1684 }
1685 return v;
1686 }
1687}
1688
2e621251
PE
1689/* Convert OBJ to an X long value, and return it as unsigned long.
1690 OBJ should be an integer or a cons representing an integer.
1691 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1692 unsigned long values: in theory these values are supposed to be
1693 signed but in practice unsigned 32-bit data are communicated via X
1694 selections and we need to support that. */
1695static unsigned long
1696cons_to_x_long (Lisp_Object obj)
1697{
1698 if (X_ULONG_MAX <= INTMAX_MAX
1699 || XINT (INTEGERP (obj) ? obj : XCAR (obj)) < 0)
1700 return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX));
1701 else
1702 return cons_to_unsigned (obj, X_ULONG_MAX);
1703}
ede4db72 1704
4feb31b2 1705/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1706
ede4db72 1707static void
d5a3eaaf
AS
1708lisp_data_to_selection_data (Display *display, Lisp_Object obj,
1709 unsigned char **data_ret, Atom *type_ret,
864d7ce7 1710 ptrdiff_t *size_ret,
d5a3eaaf 1711 int *format_ret, int *nofree_ret)
ede4db72
RS
1712{
1713 Lisp_Object type = Qnil;
5c3a351a 1714 struct x_display_info *dpyinfo = x_display_info_for_display (display);
aca39f42
RS
1715
1716 *nofree_ret = 0;
1717
8e713be6 1718 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
ede4db72 1719 {
8e713be6
KR
1720 type = XCAR (obj);
1721 obj = XCDR (obj);
1722 if (CONSP (obj) && NILP (XCDR (obj)))
1723 obj = XCAR (obj);
ede4db72
RS
1724 }
1725
1726 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1727 { /* This is not the same as declining */
1728 *format_ret = 32;
1729 *size_ret = 0;
1730 *data_ret = 0;
1731 type = QNULL;
1732 }
1733 else if (STRINGP (obj))
1734 {
1bd70c6e
KH
1735 if (SCHARS (obj) < SBYTES (obj))
1736 /* OBJ is a multibyte string containing a non-ASCII char. */
4d30ce50 1737 signal_error ("Non-ASCII string must be encoded in advance", obj);
7b9ae523 1738 if (NILP (type))
5109c8dd
KH
1739 type = QSTRING;
1740 *format_ret = 8;
1741 *size_ret = SBYTES (obj);
1742 *data_ret = SDATA (obj);
1743 *nofree_ret = 1;
ede4db72
RS
1744 }
1745 else if (SYMBOLP (obj))
1746 {
38182d90
PE
1747 void *data = xmalloc (sizeof (Atom) + 1);
1748 Atom *x_atom_ptr = data;
1749 *data_ret = data;
ede4db72
RS
1750 *format_ret = 32;
1751 *size_ret = 1;
ede4db72 1752 (*data_ret) [sizeof (Atom)] = 0;
38182d90 1753 *x_atom_ptr = symbol_to_x_atom (dpyinfo, obj);
ede4db72
RS
1754 if (NILP (type)) type = QATOM;
1755 }
252c5ee1 1756 else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX))
ede4db72 1757 {
38182d90
PE
1758 void *data = xmalloc (sizeof (short) + 1);
1759 short *short_ptr = data;
1760 *data_ret = data;
ede4db72
RS
1761 *format_ret = 16;
1762 *size_ret = 1;
ede4db72 1763 (*data_ret) [sizeof (short)] = 0;
38182d90 1764 *short_ptr = XINT (obj);
ede4db72
RS
1765 if (NILP (type)) type = QINTEGER;
1766 }
a87ed99c 1767 else if (INTEGERP (obj)
8e713be6
KR
1768 || (CONSP (obj) && INTEGERP (XCAR (obj))
1769 && (INTEGERP (XCDR (obj))
1770 || (CONSP (XCDR (obj))
1771 && INTEGERP (XCAR (XCDR (obj)))))))
ede4db72 1772 {
38182d90
PE
1773 void *data = xmalloc (sizeof (unsigned long) + 1);
1774 unsigned long *x_long_ptr = data;
1775 *data_ret = data;
ede4db72
RS
1776 *format_ret = 32;
1777 *size_ret = 1;
2e621251 1778 (*data_ret) [sizeof (unsigned long)] = 0;
38182d90 1779 *x_long_ptr = cons_to_x_long (obj);
ede4db72
RS
1780 if (NILP (type)) type = QINTEGER;
1781 }
1782 else if (VECTORP (obj))
1783 {
1784 /* Lisp_Vectors may represent a set of ATOMs;
1785 a set of 16 or 32 bit INTEGERs;
1786 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1787 */
864d7ce7
PE
1788 ptrdiff_t i;
1789 ptrdiff_t size = ASIZE (obj);
ede4db72 1790
28be1ada 1791 if (SYMBOLP (AREF (obj, 0)))
ede4db72
RS
1792 /* This vector is an ATOM set */
1793 {
38182d90
PE
1794 void *data;
1795 Atom *x_atoms;
ede4db72 1796 if (NILP (type)) type = QATOM;
864d7ce7 1797 for (i = 0; i < size; i++)
28be1ada 1798 if (!SYMBOLP (AREF (obj, i)))
4d30ce50 1799 signal_error ("All elements of selection vector must have same type", obj);
1b65481e 1800
38182d90
PE
1801 *data_ret = data = xnmalloc (size, sizeof *x_atoms);
1802 x_atoms = data;
864d7ce7
PE
1803 *format_ret = 32;
1804 *size_ret = size;
1805 for (i = 0; i < size; i++)
38182d90 1806 x_atoms[i] = symbol_to_x_atom (dpyinfo, AREF (obj, i));
ede4db72 1807 }
ede4db72
RS
1808 else
1809 /* This vector is an INTEGER set, or something like it */
1810 {
864d7ce7 1811 int format = 16;
0065d054 1812 int data_size = sizeof (short);
38182d90
PE
1813 void *data;
1814 unsigned long *x_atoms;
1815 short *shorts;
ede4db72 1816 if (NILP (type)) type = QINTEGER;
864d7ce7 1817 for (i = 0; i < size; i++)
252c5ee1 1818 {
28be1ada 1819 if (! RANGED_INTEGERP (X_SHRT_MIN, AREF (obj, i),
2e621251 1820 X_SHRT_MAX))
252c5ee1
PE
1821 {
1822 /* Use sizeof (long) even if it is more than 32 bits.
1823 See comment in x_get_window_property and
1824 x_fill_property_data. */
1825 data_size = sizeof (long);
1826 format = 32;
2e621251 1827 break;
252c5ee1
PE
1828 }
1829 }
38182d90
PE
1830 *data_ret = data = xnmalloc (size, data_size);
1831 x_atoms = data;
1832 shorts = data;
864d7ce7
PE
1833 *format_ret = format;
1834 *size_ret = size;
1835 for (i = 0; i < size; i++)
252c5ee1 1836 {
252c5ee1 1837 if (format == 32)
38182d90 1838 x_atoms[i] = cons_to_x_long (AREF (obj, i));
252c5ee1 1839 else
38182d90 1840 shorts[i] = XINT (AREF (obj, i));
252c5ee1 1841 }
ede4db72
RS
1842 }
1843 }
1844 else
4d30ce50 1845 signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
ede4db72 1846
a9f737ee 1847 *type_ret = symbol_to_x_atom (dpyinfo, type);
ede4db72
RS
1848}
1849
1850static Lisp_Object
971de7fb 1851clean_local_selection_data (Lisp_Object obj)
ede4db72
RS
1852{
1853 if (CONSP (obj)
8e713be6
KR
1854 && INTEGERP (XCAR (obj))
1855 && CONSP (XCDR (obj))
1856 && INTEGERP (XCAR (XCDR (obj)))
1857 && NILP (XCDR (XCDR (obj))))
1858 obj = Fcons (XCAR (obj), XCDR (obj));
ede4db72
RS
1859
1860 if (CONSP (obj)
8e713be6
KR
1861 && INTEGERP (XCAR (obj))
1862 && INTEGERP (XCDR (obj)))
ede4db72 1863 {
8e713be6
KR
1864 if (XINT (XCAR (obj)) == 0)
1865 return XCDR (obj);
1866 if (XINT (XCAR (obj)) == -1)
1867 return make_number (- XINT (XCDR (obj)));
ede4db72
RS
1868 }
1869 if (VECTORP (obj))
1870 {
864d7ce7
PE
1871 ptrdiff_t i;
1872 ptrdiff_t size = ASIZE (obj);
ede4db72
RS
1873 Lisp_Object copy;
1874 if (size == 1)
28be1ada 1875 return clean_local_selection_data (AREF (obj, 0));
3bfc46eb 1876 copy = make_uninit_vector (size);
ede4db72 1877 for (i = 0; i < size; i++)
28be1ada 1878 ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
ede4db72
RS
1879 return copy;
1880 }
1881 return obj;
1882}
1883\f
1884/* Called from XTread_socket to handle SelectionNotify events.
606140dd
KH
1885 If it's the selection we are waiting for, stop waiting
1886 by setting the car of reading_selection_reply to non-nil.
1887 We store t there if the reply is successful, lambda if not. */
ede4db72
RS
1888
1889void
b7ad2f74 1890x_handle_selection_notify (const XSelectionEvent *event)
ede4db72 1891{
5d0ba25b 1892 if (event->requestor != reading_selection_window)
ede4db72
RS
1893 return;
1894 if (event->selection != reading_which_selection)
1895 return;
1896
d9c0d4a3 1897 TRACE0 ("Received SelectionNotify");
f3fbd155
KR
1898 XSETCAR (reading_selection_reply,
1899 (event->property != 0 ? Qt : Qlambda));
ede4db72
RS
1900}
1901
1902\f
a9f737ee
CY
1903/* From a Lisp_Object, return a suitable frame for selection
1904 operations. OBJECT may be a frame, a terminal object, or nil
1905 (which stands for the selected frame--or, if that is not an X
1906 frame, the first X display on the list). If no suitable frame can
1907 be found, return NULL. */
1908
1909static struct frame *
1910frame_for_x_selection (Lisp_Object object)
1911{
5b04e9f9 1912 Lisp_Object tail, frame;
a9f737ee
CY
1913 struct frame *f;
1914
1915 if (NILP (object))
1916 {
1917 f = XFRAME (selected_frame);
1918 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1919 return f;
1920
5b04e9f9 1921 FOR_EACH_FRAME (tail, frame)
a9f737ee 1922 {
5b04e9f9 1923 f = XFRAME (frame);
a9f737ee
CY
1924 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1925 return f;
1926 }
1927 }
1928 else if (TERMINALP (object))
1929 {
1930 struct terminal *t = get_terminal (object, 1);
5b04e9f9 1931
a9f737ee 1932 if (t->type == output_x_window)
5b04e9f9
DA
1933 FOR_EACH_FRAME (tail, frame)
1934 {
1935 f = XFRAME (frame);
1936 if (FRAME_LIVE_P (f) && f->terminal == t)
1937 return f;
1938 }
a9f737ee
CY
1939 }
1940 else if (FRAMEP (object))
1941 {
1942 f = XFRAME (object);
1943 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1944 return f;
1945 }
1946
1947 return NULL;
1948}
1949
1950
a0d76c27 1951DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
a9f737ee 1952 Sx_own_selection_internal, 2, 3, 0,
abb71cf4
CY
1953 doc: /* Assert an X selection of type SELECTION and value VALUE.
1954SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
8c1a1077
PJ
1955\(Those are literal upper-case symbol names, since that's what X expects.)
1956VALUE is typically a string, or a cons of two markers, but may be
a9f737ee
CY
1957anything that the functions on `selection-converter-alist' know about.
1958
1959FRAME should be a frame that should own the selection. If omitted or
bd7da63e
GM
1960nil, it defaults to the selected frame.
1961
1962On Nextstep, FRAME is unused. */)
a9f737ee 1963 (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
ede4db72 1964{
a9f737ee
CY
1965 if (NILP (frame)) frame = selected_frame;
1966 if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_X_P (XFRAME (frame)))
1967 error ("X selection unavailable for this frame");
1968
abb71cf4
CY
1969 CHECK_SYMBOL (selection);
1970 if (NILP (value)) error ("VALUE may not be nil");
a9f737ee 1971 x_own_selection (selection, value, frame);
abb71cf4 1972 return value;
ede4db72
RS
1973}
1974
1975
1976/* Request the selection value from the owner. If we are the owner,
1977 simply return our selection value. If we are not the owner, this
1978 will block until all of the data has arrived. */
1979
a0d76c27 1980DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
a9f737ee 1981 Sx_get_selection_internal, 2, 4, 0,
8c1a1077 1982 doc: /* Return text selected from some X window.
bd7da63e 1983SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
8c1a1077 1984\(Those are literal upper-case symbol names, since that's what X expects.)
bd7da63e
GM
1985TARGET-TYPE is the type of data desired, typically `STRING'.
1986
1987TIME-STAMP is the time to use in the XConvertSelection call for foreign
a9f737ee
CY
1988selections. If omitted, defaults to the time for the last event.
1989
1990TERMINAL should be a terminal object or a frame specifying the X
1991server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
1992frame's display, or the first available X display.
1993
1994On Nextstep, TIME-STAMP and TERMINAL are unused. */)
a9f737ee
CY
1995 (Lisp_Object selection_symbol, Lisp_Object target_type,
1996 Lisp_Object time_stamp, Lisp_Object terminal)
ede4db72
RS
1997{
1998 Lisp_Object val = Qnil;
1999 struct gcpro gcpro1, gcpro2;
a9f737ee 2000 struct frame *f = frame_for_x_selection (terminal);
ede4db72 2001 GCPRO2 (target_type, val); /* we store newly consed data into these */
a9f737ee 2002
b7826503 2003 CHECK_SYMBOL (selection_symbol);
a9f737ee
CY
2004 CHECK_SYMBOL (target_type);
2005 if (EQ (target_type, QMULTIPLE))
2006 error ("Retrieving MULTIPLE selections is currently unimplemented");
2007 if (!f)
2008 error ("X selection unavailable for this frame");
2009
2010 val = x_get_local_selection (selection_symbol, target_type, 1,
aad3612f 2011 FRAME_DISPLAY_INFO (f));
ede4db72 2012
a9f737ee 2013 if (NILP (val) && FRAME_LIVE_P (f))
ede4db72 2014 {
a9f737ee
CY
2015 Lisp_Object frame;
2016 XSETFRAME (frame, f);
2017 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type,
2018 time_stamp, frame));
ede4db72 2019 }
ede4db72 2020
abb71cf4 2021 if (CONSP (val) && SYMBOLP (XCAR (val)))
ede4db72 2022 {
8e713be6
KR
2023 val = XCDR (val);
2024 if (CONSP (val) && NILP (XCDR (val)))
2025 val = XCAR (val);
ede4db72 2026 }
abb71cf4 2027 RETURN_UNGCPRO (clean_local_selection_data (val));
ede4db72
RS
2028}
2029
a0d76c27 2030DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
a9f737ee 2031 Sx_disown_selection_internal, 1, 3, 0,
8c1a1077 2032 doc: /* If we own the selection SELECTION, disown it.
a9f737ee
CY
2033Disowning it means there is no such selection.
2034
bd7da63e
GM
2035Sets the last-change time for the selection to TIME-OBJECT (by default
2036the time of the last event).
2037
a9f737ee
CY
2038TERMINAL should be a terminal object or a frame specifying the X
2039server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2040frame's display, or the first available X display.
2041
2042On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2043On MS-DOS, all this does is return non-nil if we own the selection. */)
a9f737ee 2044 (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
ede4db72 2045{
ede4db72
RS
2046 Time timestamp;
2047 Atom selection_atom;
31df61d6
AS
2048 union {
2049 struct selection_input_event sie;
2050 struct input_event ie;
2051 } event;
a9f737ee 2052 struct frame *f = frame_for_x_selection (terminal);
5c3a351a 2053 struct x_display_info *dpyinfo;
ede4db72 2054
a9f737ee 2055 if (!f)
428a555e
KL
2056 return Qnil;
2057
aad3612f 2058 dpyinfo = FRAME_DISPLAY_INFO (f);
b7826503 2059 CHECK_SYMBOL (selection);
ede4db72 2060
a9f737ee
CY
2061 /* Don't disown the selection when we're not the owner. */
2062 if (NILP (LOCAL_SELECTION (selection, dpyinfo)))
2063 return Qnil;
ede4db72 2064
a9f737ee 2065 selection_atom = symbol_to_x_atom (dpyinfo, selection);
ede4db72 2066
4d7e6e51 2067 block_input ();
be44ca6c 2068 if (NILP (time_object))
6bbe6da8 2069 timestamp = dpyinfo->last_user_time;
be44ca6c
PE
2070 else
2071 CONS_TO_INTEGER (time_object, Time, timestamp);
a9f737ee 2072 XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
4d7e6e51 2073 unblock_input ();
ede4db72 2074
eb8c3be9 2075 /* It doesn't seem to be guaranteed that a SelectionClear event will be
ede4db72
RS
2076 generated for a window which owns the selection when that window sets
2077 the selection owner to None. The NCD server does, the MIT Sun4 server
2078 doesn't. So we synthesize one; this means we might get two, but
2079 that's ok, because the second one won't have any effect. */
a9f737ee 2080 SELECTION_EVENT_DISPLAY (&event.sie) = dpyinfo->display;
31df61d6
AS
2081 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2082 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2083 x_handle_selection_clear (&event.ie);
ede4db72
RS
2084
2085 return Qt;
2086}
2087
ede4db72 2088DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
a9f737ee 2089 0, 2, 0,
8c1a1077
PJ
2090 doc: /* Whether the current Emacs process owns the given X Selection.
2091The arg should be the name of the selection in question, typically one of
2092the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2093\(Those are literal upper-case symbol names, since that's what X expects.)
2094For convenience, the symbol nil is the same as `PRIMARY',
a9f737ee
CY
2095and t is the same as `SECONDARY'.
2096
2097TERMINAL should be a terminal object or a frame specifying the X
2098server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2099frame's display, or the first available X display.
2100
2101On Nextstep, TERMINAL is unused. */)
a9f737ee 2102 (Lisp_Object selection, Lisp_Object terminal)
ede4db72 2103{
a9f737ee
CY
2104 struct frame *f = frame_for_x_selection (terminal);
2105
b7826503 2106 CHECK_SYMBOL (selection);
ede4db72
RS
2107 if (EQ (selection, Qnil)) selection = QPRIMARY;
2108 if (EQ (selection, Qt)) selection = QSECONDARY;
1b65481e 2109
aad3612f 2110 if (f && !NILP (LOCAL_SELECTION (selection, FRAME_DISPLAY_INFO (f))))
a9f737ee
CY
2111 return Qt;
2112 else
ede4db72 2113 return Qnil;
ede4db72
RS
2114}
2115
2116DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
a9f737ee
CY
2117 0, 2, 0,
2118 doc: /* Whether there is an owner for the given X selection.
2119SELECTION should be the name of the selection in question, typically
3c9dfce6
CY
2120one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2121`CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2122symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
a9f737ee
CY
2123
2124TERMINAL should be a terminal object or a frame specifying the X
2125server to query. If omitted or nil, that stands for the selected
bd7da63e
GM
2126frame's display, or the first available X display.
2127
2128On Nextstep, TERMINAL is unused. */)
a9f737ee 2129 (Lisp_Object selection, Lisp_Object terminal)
ede4db72
RS
2130{
2131 Window owner;
356ba514 2132 Atom atom;
a9f737ee
CY
2133 struct frame *f = frame_for_x_selection (terminal);
2134 struct x_display_info *dpyinfo;
b8c70430 2135
b7826503 2136 CHECK_SYMBOL (selection);
356ba514
RS
2137 if (EQ (selection, Qnil)) selection = QPRIMARY;
2138 if (EQ (selection, Qt)) selection = QSECONDARY;
a9f737ee
CY
2139
2140 if (!f)
356ba514 2141 return Qnil;
a9f737ee 2142
aad3612f 2143 dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
2144
2145 if (!NILP (LOCAL_SELECTION (selection, dpyinfo)))
2146 return Qt;
2147
2148 atom = symbol_to_x_atom (dpyinfo, selection);
2149 if (atom == 0) return Qnil;
4d7e6e51 2150 block_input ();
a9f737ee 2151 owner = XGetSelectionOwner (dpyinfo->display, atom);
4d7e6e51 2152 unblock_input ();
ede4db72
RS
2153 return (owner ? Qt : Qnil);
2154}
2155
1dd3c2d9 2156\f
4b80f674
CY
2157/* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2158 property (http://www.freedesktop.org/wiki/ClipboardManager). */
a9f737ee 2159
4b80f674
CY
2160static Lisp_Object
2161x_clipboard_manager_save (Lisp_Object frame)
a9f737ee
CY
2162{
2163 struct frame *f = XFRAME (frame);
aad3612f 2164 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
a9f737ee
CY
2165 Atom data = dpyinfo->Xatom_UTF8_STRING;
2166
2167 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2168 dpyinfo->Xatom_EMACS_TMP,
2169 dpyinfo->Xatom_ATOM, 32, PropModeReplace,
2170 (unsigned char *) &data, 1);
2171 x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS,
2172 Qnil, frame);
4b80f674
CY
2173 return Qt;
2174}
2175
2176/* Error handler for x_clipboard_manager_save_frame. */
2177
2178static Lisp_Object
2179x_clipboard_manager_error_1 (Lisp_Object err)
2180{
2181 Lisp_Object args[2];
2182 args[0] = build_string ("X clipboard manager error: %s\n\
2183If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2184 args[1] = CAR (CDR (err));
2185 Fmessage (2, args);
2186 return Qnil;
2187}
2188
2189/* Error handler for x_clipboard_manager_save_all. */
2190
2191static Lisp_Object
2192x_clipboard_manager_error_2 (Lisp_Object err)
2193{
2194 fprintf (stderr, "Error saving to X clipboard manager.\n\
2195If the problem persists, set `x-select-enable-clipboard-manager' \
2196to nil.\n");
2197 return Qnil;
a9f737ee
CY
2198}
2199
1dd3c2d9
CY
2200/* Called from delete_frame: save any clipboard owned by FRAME to the
2201 clipboard manager. Do nothing if FRAME does not own the clipboard,
2202 or if no clipboard manager is present. */
2203
2204void
2205x_clipboard_manager_save_frame (Lisp_Object frame)
a9f737ee 2206{
1dd3c2d9
CY
2207 struct frame *f;
2208
4b80f674
CY
2209 if (!NILP (Vx_select_enable_clipboard_manager)
2210 && FRAMEP (frame)
1dd3c2d9
CY
2211 && (f = XFRAME (frame), FRAME_X_P (f))
2212 && FRAME_LIVE_P (f))
a9f737ee 2213 {
aad3612f 2214 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
1dd3c2d9
CY
2215 Lisp_Object local_selection
2216 = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2217
2218 if (!NILP (local_selection)
2219 && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection)))))
2220 && XGetSelectionOwner (dpyinfo->display,
2221 dpyinfo->Xatom_CLIPBOARD_MANAGER))
4b80f674
CY
2222 internal_condition_case_1 (x_clipboard_manager_save, frame, Qt,
2223 x_clipboard_manager_error_1);
a9f737ee 2224 }
1dd3c2d9
CY
2225}
2226
2227/* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2228 clipboard manager. Do nothing if FRAME does not own the clipboard,
2229 or if no clipboard manager is present. */
2230
2231void
2232x_clipboard_manager_save_all (void)
2233{
2234 /* Loop through all X displays, saving owned clipboards. */
2235 struct x_display_info *dpyinfo;
2236 Lisp_Object local_selection, local_frame;
4b80f674
CY
2237
2238 if (NILP (Vx_select_enable_clipboard_manager))
2239 return;
2240
1dd3c2d9 2241 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
a9f737ee 2242 {
1dd3c2d9
CY
2243 local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2244 if (NILP (local_selection)
2245 || !XGetSelectionOwner (dpyinfo->display,
2246 dpyinfo->Xatom_CLIPBOARD_MANAGER))
2247 continue;
a9f737ee 2248
1dd3c2d9
CY
2249 local_frame = XCAR (XCDR (XCDR (XCDR (local_selection))));
2250 if (FRAME_LIVE_P (XFRAME (local_frame)))
3c9dfce6
CY
2251 {
2252 Lisp_Object args[1];
2253 args[0] = build_string ("Saving clipboard to X clipboard manager...");
2254 Fmessage (1, args);
2255
2256 internal_condition_case_1 (x_clipboard_manager_save, local_frame,
2257 Qt, x_clipboard_manager_error_2);
2258 }
1dd3c2d9 2259 }
a9f737ee
CY
2260}
2261
ede4db72 2262\f
1fb3821b
JD
2263/***********************************************************************
2264 Drag and drop support
2265***********************************************************************/
2266/* Check that lisp values are of correct type for x_fill_property_data.
2267 That is, number, string or a cons with two numbers (low and high 16
44f730c8
PE
2268 bit parts of a 32 bit number). Return the number of items in DATA,
2269 or -1 if there is an error. */
1fb3821b
JD
2270
2271int
971de7fb 2272x_check_property_data (Lisp_Object data)
1fb3821b
JD
2273{
2274 Lisp_Object iter;
2275 int size = 0;
2276
44f730c8 2277 for (iter = data; CONSP (iter); iter = XCDR (iter))
1fb3821b
JD
2278 {
2279 Lisp_Object o = XCAR (iter);
2280
2281 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
44f730c8 2282 return -1;
1fb3821b
JD
2283 else if (CONSP (o) &&
2284 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
44f730c8 2285 return -1;
864d7ce7
PE
2286 if (size == INT_MAX)
2287 return -1;
44f730c8 2288 size++;
1fb3821b
JD
2289 }
2290
2291 return size;
2292}
2293
2294/* Convert lisp values to a C array. Values may be a number, a string
2295 which is taken as an X atom name and converted to the atom value, or
2296 a cons containing the two 16 bit parts of a 32 bit number.
2297
2298 DPY is the display use to look up X atoms.
2299 DATA is a Lisp list of values to be converted.
2300 RET is the C array that contains the converted values. It is assumed
ff59904a 2301 it is big enough to hold all values.
e22cf39c
JD
2302 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2303 be stored in RET. Note that long is used for 32 even if long is more
2304 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2305 XClientMessageEvent). */
1fb3821b
JD
2306
2307void
971de7fb 2308x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
1fb3821b 2309{
e22cf39c
JD
2310 long val;
2311 long *d32 = (long *) ret;
2312 short *d16 = (short *) ret;
2313 char *d08 = (char *) ret;
1fb3821b
JD
2314 Lisp_Object iter;
2315
2316 for (iter = data; CONSP (iter); iter = XCDR (iter))
2317 {
2318 Lisp_Object o = XCAR (iter);
2319
be44ca6c
PE
2320 if (INTEGERP (o) || FLOATP (o) || CONSP (o))
2321 val = cons_to_signed (o, LONG_MIN, LONG_MAX);
1fb3821b
JD
2322 else if (STRINGP (o))
2323 {
4d7e6e51 2324 block_input ();
51b59d79 2325 val = (long) XInternAtom (dpy, SSDATA (o), False);
4d7e6e51 2326 unblock_input ();
1fb3821b
JD
2327 }
2328 else
2329 error ("Wrong type, must be string, number or cons");
2330
2331 if (format == 8)
be44ca6c
PE
2332 {
2333 if (CHAR_MIN <= val && val <= CHAR_MAX)
2334 *d08++ = val;
2335 else
2336 error ("Out of 'char' range");
2337 }
1fb3821b 2338 else if (format == 16)
be44ca6c
PE
2339 {
2340 if (SHRT_MIN <= val && val <= SHRT_MAX)
2341 *d16++ = val;
2342 else
2343 error ("Out of 'short' range");
2344 }
1fb3821b
JD
2345 else
2346 *d32++ = val;
2347 }
2348}
2349
2350/* Convert an array of C values to a Lisp list.
2351 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2352 DATA is a C array of values to be converted.
2353 TYPE is the type of the data. Only XA_ATOM is special, it converts
da6062e6 2354 each number in DATA to its corresponding X atom as a symbol.
1fb3821b
JD
2355 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2356 be stored in RET.
2357 SIZE is the number of elements in DATA.
2358
b8d6f4af
JD
2359 Important: When format is 32, data should contain an array of int,
2360 not an array of long as the X library returns. This makes a difference
2361 when sizeof(long) != sizeof(int).
2362
1fb3821b
JD
2363 Also see comment for selection_data_to_lisp_data above. */
2364
2365Lisp_Object
eec47d6b 2366x_property_data_to_lisp (struct frame *f, const unsigned char *data,
2d9783e0 2367 Atom type, int format, unsigned long size)
1fb3821b 2368{
864d7ce7
PE
2369 ptrdiff_t format_bytes = format >> 3;
2370 if (PTRDIFF_MAX / format_bytes < size)
2371 memory_full (SIZE_MAX);
1fb3821b 2372 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
864d7ce7 2373 data, size * format_bytes, type, format);
1fb3821b
JD
2374}
2375
31f16913 2376/* Get the mouse position in frame relative coordinates. */
1fb3821b
JD
2377
2378static void
a10c8269 2379mouse_position_for_drop (struct frame *f, int *x, int *y)
1fb3821b
JD
2380{
2381 Window root, dummy_window;
2382 int dummy;
2383
4d7e6e51 2384 block_input ();
1fb3821b
JD
2385
2386 XQueryPointer (FRAME_X_DISPLAY (f),
2387 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2388
2389 /* The root window which contains the pointer. */
2390 &root,
2391
2392 /* Window pointer is on, not used */
2393 &dummy_window,
2394
2395 /* The position on that root window. */
2396 x, y,
2397
2398 /* x/y in dummy_window coordinates, not used. */
2399 &dummy, &dummy,
2400
2401 /* Modifier keys and pointer buttons, about which
2402 we don't care. */
2403 (unsigned int *) &dummy);
2404
2405
2406 /* Absolute to relative. */
2407 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2408 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2409
4d7e6e51 2410 unblock_input ();
1fb3821b
JD
2411}
2412
2413DEFUN ("x-get-atom-name", Fx_get_atom_name,
2414 Sx_get_atom_name, 1, 2, 0,
2415 doc: /* Return the X atom name for VALUE as a string.
2416VALUE may be a number or a cons where the car is the upper 16 bits and
2417the cdr is the lower 16 bits of a 32 bit value.
2418Use the display for FRAME or the current frame if FRAME is not given or nil.
2419
2420If the value is 0 or the atom is not known, return the empty string. */)
5842a27b 2421 (Lisp_Object value, Lisp_Object frame)
1fb3821b 2422{
7452b7bd 2423 struct frame *f = decode_window_system_frame (frame);
1fb3821b 2424 char *name = 0;
42ca4633 2425 char empty[] = "";
1fb3821b 2426 Lisp_Object ret = Qnil;
1fb3821b
JD
2427 Display *dpy = FRAME_X_DISPLAY (f);
2428 Atom atom;
d7e6881a 2429 bool had_errors_p;
1fb3821b 2430
be44ca6c 2431 CONS_TO_INTEGER (value, Atom, atom);
1fb3821b 2432
4d7e6e51 2433 block_input ();
9ba8e10d 2434 x_catch_errors (dpy);
42ca4633 2435 name = atom ? XGetAtomName (dpy, atom) : empty;
d7e6881a 2436 had_errors_p = x_had_errors_p (dpy);
c525d842 2437 x_uncatch_errors ();
1fb3821b 2438
d7e6881a 2439 if (!had_errors_p)
3a5077c5 2440 ret = build_string (name);
1fb3821b 2441
1fb3821b 2442 if (atom && name) XFree (name);
8b3ad112 2443 if (NILP (ret)) ret = empty_unibyte_string;
1fb3821b 2444
4d7e6e51 2445 unblock_input ();
1fb3821b
JD
2446
2447 return ret;
2448}
2449
9fc68699
JD
2450DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
2451 Sx_register_dnd_atom, 1, 2, 0,
2452 doc: /* Request that dnd events are made for ClientMessages with ATOM.
2453ATOM can be a symbol or a string. The ATOM is interned on the display that
2454FRAME is on. If FRAME is nil, the selected frame is used. */)
5842a27b 2455 (Lisp_Object atom, Lisp_Object frame)
9fc68699
JD
2456{
2457 Atom x_atom;
7452b7bd 2458 struct frame *f = decode_window_system_frame (frame);
ac82cc6a 2459 ptrdiff_t i;
aad3612f 2460 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
9fc68699
JD
2461
2462
2463 if (SYMBOLP (atom))
a9f737ee 2464 x_atom = symbol_to_x_atom (dpyinfo, atom);
9fc68699
JD
2465 else if (STRINGP (atom))
2466 {
4d7e6e51 2467 block_input ();
51b59d79 2468 x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False);
4d7e6e51 2469 unblock_input ();
9fc68699
JD
2470 }
2471 else
2472 error ("ATOM must be a symbol or a string");
2473
db9cd97a 2474 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
9fc68699
JD
2475 if (dpyinfo->x_dnd_atoms[i] == x_atom)
2476 return Qnil;
2477
db9cd97a 2478 if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
a69fbedb
PE
2479 dpyinfo->x_dnd_atoms =
2480 xpalloc (dpyinfo->x_dnd_atoms, &dpyinfo->x_dnd_atoms_size,
2481 1, -1, sizeof *dpyinfo->x_dnd_atoms);
9fc68699
JD
2482
2483 dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
2484 return Qnil;
2485}
2486
2487/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
1fb3821b
JD
2488
2489int
b7ad2f74 2490x_handle_dnd_message (struct frame *f, const XClientMessageEvent *event,
5e617bc2 2491 struct x_display_info *dpyinfo, struct input_event *bufp)
1fb3821b
JD
2492{
2493 Lisp_Object vec;
2494 Lisp_Object frame;
e22cf39c
JD
2495 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2496 unsigned long size = 160/event->format;
1fb3821b 2497 int x, y;
31f16913 2498 unsigned char *data = (unsigned char *) event->data.b;
252c5ee1 2499 int idata[5];
ac82cc6a 2500 ptrdiff_t i;
9fc68699 2501
db9cd97a 2502 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
9fc68699
JD
2503 if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
2504
2505 if (i == dpyinfo->x_dnd_atoms_length) return 0;
1fb3821b
JD
2506
2507 XSETFRAME (frame, f);
2508
31f16913
JD
2509 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2510 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2511 function expects them to be of size int (i.e. 32). So to be able to
2512 use that function, put the data in the form it expects if format is 32. */
2513
908589fd 2514 if (BITS_PER_LONG > 32 && event->format == 32)
31f16913 2515 {
31f16913 2516 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
864d7ce7 2517 idata[i] = event->data.l[i];
31f16913
JD
2518 data = (unsigned char *) idata;
2519 }
2520
d2f14999 2521 vec = Fmake_vector (make_number (4), Qnil);
3ae565b3
SM
2522 ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2523 event->message_type)));
2524 ASET (vec, 1, frame);
2525 ASET (vec, 2, make_number (event->format));
2526 ASET (vec, 3, x_property_data_to_lisp (f,
2527 data,
2528 event->message_type,
2529 event->format,
2530 size));
1fb3821b
JD
2531
2532 mouse_position_for_drop (f, &x, &y);
2533 bufp->kind = DRAG_N_DROP_EVENT;
862c94ca 2534 bufp->frame_or_window = frame;
1fb3821b
JD
2535 bufp->timestamp = CurrentTime;
2536 bufp->x = make_number (x);
2537 bufp->y = make_number (y);
862c94ca 2538 bufp->arg = vec;
1fb3821b
JD
2539 bufp->modifiers = 0;
2540
2541 return 1;
2542}
2543
2bf7d27a 2544DEFUN ("x-send-client-message", Fx_send_client_message,
1fb3821b
JD
2545 Sx_send_client_message, 6, 6, 0,
2546 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2547
2548For DISPLAY, specify either a frame or a display name (a string).
2549If DISPLAY is nil, that stands for the selected frame's display.
2550DEST may be a number, in which case it is a Window id. The value 0 may
2551be used to send to the root window of the DISPLAY.
2552If DEST is a cons, it is converted to a 32 bit number
2553with the high 16 bits from the car and the lower 16 bit from the cdr. That
2554number is then used as a window id.
2555If DEST is a frame the event is sent to the outer window of that frame.
69785ad0 2556A value of nil means the currently selected frame.
1fb3821b
JD
2557If DEST is the string "PointerWindow" the event is sent to the window that
2558contains the pointer. If DEST is the string "InputFocus" the event is
2559sent to the window that has the input focus.
2560FROM is the frame sending the event. Use nil for currently selected frame.
2561MESSAGE-TYPE is the name of an Atom as a string.
2562FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2563bits. VALUES is a list of numbers, cons and/or strings containing the values
2564to send. If a value is a string, it is converted to an Atom and the value of
2565the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2566with the high 16 bits from the car and the lower 16 bit from the cdr.
2567If more values than fits into the event is given, the excessive values
2568are ignored. */)
5e617bc2
JB
2569 (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2570 Lisp_Object message_type, Lisp_Object format, Lisp_Object values)
2d9074ba
JD
2571{
2572 struct x_display_info *dpyinfo = check_x_display_info (display);
2573
933e29ff 2574 CHECK_STRING (message_type);
5e617bc2
JB
2575 x_send_client_event (display, dest, from,
2576 XInternAtom (dpyinfo->display,
2577 SSDATA (message_type),
2578 False),
2579 format, values);
2d9074ba
JD
2580
2581 return Qnil;
2582}
2583
2584void
5e617bc2
JB
2585x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2586 Atom message_type, Lisp_Object format, Lisp_Object values)
1fb3821b
JD
2587{
2588 struct x_display_info *dpyinfo = check_x_display_info (display);
2589 Window wdest;
2590 XEvent event;
7452b7bd 2591 struct frame *f = decode_window_system_frame (from);
1fb3821b
JD
2592 int to_root;
2593
1fb3821b
JD
2594 CHECK_NUMBER (format);
2595 CHECK_CONS (values);
2596
2597 if (x_check_property_data (values) == -1)
2598 error ("Bad data in VALUES, must be number, cons or string");
2599
d311d28c 2600 if (XINT (format) != 8 && XINT (format) != 16 && XINT (format) != 32)
1fb3821b 2601 error ("FORMAT must be one of 8, 16 or 32");
a0ecb2ac 2602
d311d28c
PE
2603 event.xclient.type = ClientMessage;
2604 event.xclient.format = XINT (format);
2605
1fb3821b
JD
2606 if (FRAMEP (dest) || NILP (dest))
2607 {
7452b7bd 2608 struct frame *fdest = decode_window_system_frame (dest);
1fb3821b
JD
2609 wdest = FRAME_OUTER_WINDOW (fdest);
2610 }
2611 else if (STRINGP (dest))
2612 {
42a5b22f 2613 if (strcmp (SSDATA (dest), "PointerWindow") == 0)
1fb3821b 2614 wdest = PointerWindow;
42a5b22f 2615 else if (strcmp (SSDATA (dest), "InputFocus") == 0)
1fb3821b
JD
2616 wdest = InputFocus;
2617 else
2618 error ("DEST as a string must be one of PointerWindow or InputFocus");
2619 }
be44ca6c
PE
2620 else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest))
2621 CONS_TO_INTEGER (dest, Window, wdest);
1fb3821b
JD
2622 else
2623 error ("DEST must be a frame, nil, string, number or cons");
2624
2625 if (wdest == 0) wdest = dpyinfo->root_window;
2626 to_root = wdest == dpyinfo->root_window;
2627
4d7e6e51 2628 block_input ();
1fb3821b 2629
8fd9c92e
JD
2630 event.xclient.send_event = True;
2631 event.xclient.serial = 0;
2d9074ba 2632 event.xclient.message_type = message_type;
1fb3821b
JD
2633 event.xclient.display = dpyinfo->display;
2634
2635 /* Some clients (metacity for example) expects sending window to be here
2636 when sending to the root window. */
2637 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2638
8fd9c92e 2639 memset (event.xclient.data.l, 0, sizeof (event.xclient.data.l));
1fb3821b
JD
2640 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2641 event.xclient.format);
2642
2643 /* If event mask is 0 the event is sent to the client that created
2644 the destination window. But if we are sending to the root window,
8fd9c92e 2645 there is no such client. Then we set the event mask to 0xffffff. The
1fb3821b 2646 event then goes to clients selecting for events on the root window. */
9ba8e10d 2647 x_catch_errors (dpyinfo->display);
1fb3821b
JD
2648 {
2649 int propagate = to_root ? False : True;
8fd9c92e
JD
2650 long mask = to_root ? 0xffffff : 0;
2651
1fb3821b
JD
2652 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2653 XFlush (dpyinfo->display);
2654 }
4545fa20 2655 x_uncatch_errors ();
4d7e6e51 2656 unblock_input ();
1fb3821b
JD
2657}
2658
2659\f
ede4db72 2660void
971de7fb 2661syms_of_xselect (void)
ede4db72 2662{
ede4db72
RS
2663 defsubr (&Sx_get_selection_internal);
2664 defsubr (&Sx_own_selection_internal);
2665 defsubr (&Sx_disown_selection_internal);
2666 defsubr (&Sx_selection_owner_p);
2667 defsubr (&Sx_selection_exists_p);
2668
1fb3821b
JD
2669 defsubr (&Sx_get_atom_name);
2670 defsubr (&Sx_send_client_message);
9fc68699 2671 defsubr (&Sx_register_dnd_atom);
1fb3821b 2672
ede4db72
RS
2673 reading_selection_reply = Fcons (Qnil, Qnil);
2674 staticpro (&reading_selection_reply);
2675 reading_selection_window = 0;
2676 reading_which_selection = 0;
2677
2678 property_change_wait_list = 0;
2f65feb6 2679 prop_location_identifier = 0;
ede4db72
RS
2680 property_change_reply = Fcons (Qnil, Qnil);
2681 staticpro (&property_change_reply);
2682
e067f0c1
CY
2683 converted_selections = NULL;
2684 conversion_fail_tag = None;
2685
29208e82 2686 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
8c1a1077
PJ
2687 doc: /* An alist associating X Windows selection-types with functions.
2688These functions are called to convert the selection, with three args:
2689the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2690a desired type to which the selection should be converted;
2691and the local selection value (whatever was given to `x-own-selection').
2692
2693The function should return the value to send to the X server
2694\(typically a string). A return value of nil
2695means that the conversion could not be done.
2696A return value which is the symbol `NULL'
2697means that a side-effect was executed,
2698and there is no meaningful selection value. */);
ede4db72
RS
2699 Vselection_converter_alist = Qnil;
2700
29208e82 2701 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions,
8c1a1077
PJ
2702 doc: /* A list of functions to be called when Emacs loses an X selection.
2703\(This happens when some other X client makes its own selection
2704or when a Lisp program explicitly clears the selection.)
2705The functions are called with one argument, the selection type
2706\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
c917a8de 2707 Vx_lost_selection_functions = Qnil;
ede4db72 2708
29208e82 2709 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions,
8c1a1077 2710 doc: /* A list of functions to be called when Emacs answers a selection request.
e067f0c1 2711The functions are called with three arguments:
8c1a1077
PJ
2712 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2713 - the selection-type which Emacs was asked to convert the
2714 selection into before sending (for example, `STRING' or `LENGTH');
2715 - a flag indicating success or failure for responding to the request.
2716We might have failed (and declined the request) for any number of reasons,
2717including being asked for a selection that we no longer own, or being asked
2718to convert into a type that we don't know about or that is inappropriate.
2719This hook doesn't let you change the behavior of Emacs's selection replies,
2720it merely informs you that they have happened. */);
c917a8de 2721 Vx_sent_selection_functions = Qnil;
ede4db72 2722
4b80f674
CY
2723 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2724 Vx_select_enable_clipboard_manager,
2725 doc: /* Whether to enable X clipboard manager support.
2726If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2727while owning the X clipboard, the clipboard contents are saved to the
2728clipboard manager if one is present. */);
2729 Vx_select_enable_clipboard_manager = Qt;
2730
29208e82 2731 DEFVAR_INT ("x-selection-timeout", x_selection_timeout,
8c1a1077
PJ
2732 doc: /* Number of milliseconds to wait for a selection reply.
2733If the selection owner doesn't reply in this time, we give up.
2734A value of 0 means wait as long as necessary. This is initialized from the
2735\"*selectionTimeout\" resource. */);
ede4db72
RS
2736 x_selection_timeout = 0;
2737
9852377f 2738 /* QPRIMARY is defined in keyboard.c. */
f3d4e0a4
CY
2739 DEFSYM (QSECONDARY, "SECONDARY");
2740 DEFSYM (QSTRING, "STRING");
2741 DEFSYM (QINTEGER, "INTEGER");
2742 DEFSYM (QCLIPBOARD, "CLIPBOARD");
2743 DEFSYM (QTIMESTAMP, "TIMESTAMP");
2744 DEFSYM (QTEXT, "TEXT");
2745 DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT");
2746 DEFSYM (QUTF8_STRING, "UTF8_STRING");
2747 DEFSYM (QDELETE, "DELETE");
2748 DEFSYM (QMULTIPLE, "MULTIPLE");
2749 DEFSYM (QINCR, "INCR");
2750 DEFSYM (QEMACS_TMP, "_EMACS_TMP_");
2751 DEFSYM (QTARGETS, "TARGETS");
2752 DEFSYM (QATOM, "ATOM");
2753 DEFSYM (QATOM_PAIR, "ATOM_PAIR");
a9f737ee
CY
2754 DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER");
2755 DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS");
f3d4e0a4
CY
2756 DEFSYM (QNULL, "NULL");
2757 DEFSYM (Qcompound_text_with_extensions, "compound-text-with-extensions");
2758 DEFSYM (Qforeign_selection, "foreign-selection");
cd18e7e3
JB
2759 DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions");
2760 DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions");
ede4db72 2761}