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