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