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