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