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