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