* lisp/progmodes/sh-script.el (sh-syntax-propertize-function): Fix last
[emacs.git] / src / xselect.c
blob15ce8d487fa04c798f2af9c5e64de10d9c93d4d5
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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/>. */
20 /* Rewritten by jwz */
22 #include <config.h>
23 #include <limits.h>
24 #include <stdio.h> /* termhooks.h needs this */
25 #include <setjmp.h>
27 #ifdef HAVE_SYS_TYPES_H
28 #include <sys/types.h>
29 #endif
31 #include <unistd.h>
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 #include "character.h"
44 #include <X11/Xproto.h>
46 struct prop_location;
47 struct selection_data;
49 static Lisp_Object x_atom_to_symbol (Display *dpy, Atom atom);
50 static Atom symbol_to_x_atom (struct x_display_info *, Lisp_Object);
51 static void x_own_selection (Lisp_Object, Lisp_Object, Lisp_Object);
52 static Lisp_Object x_get_local_selection (Lisp_Object, Lisp_Object, int,
53 struct x_display_info *);
54 static void x_decline_selection_request (struct input_event *);
55 static Lisp_Object x_selection_request_lisp_error (Lisp_Object);
56 static Lisp_Object queue_selection_requests_unwind (Lisp_Object);
57 static Lisp_Object x_catch_errors_unwind (Lisp_Object);
58 static void x_reply_selection_request (struct input_event *, struct x_display_info *);
59 static int x_convert_selection (struct input_event *, Lisp_Object, Lisp_Object,
60 Atom, int, struct x_display_info *);
61 static int waiting_for_other_props_on_window (Display *, Window);
62 static struct prop_location *expect_property_change (Display *, Window,
63 Atom, int);
64 static void unexpect_property_change (struct prop_location *);
65 static Lisp_Object wait_for_property_change_unwind (Lisp_Object);
66 static void wait_for_property_change (struct prop_location *);
67 static Lisp_Object x_get_foreign_selection (Lisp_Object, Lisp_Object,
68 Lisp_Object, Lisp_Object);
69 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
70 Window, Atom,
71 Lisp_Object, Atom);
72 static Lisp_Object selection_data_to_lisp_data (Display *,
73 const unsigned char *,
74 ptrdiff_t, Atom, int);
75 static void lisp_data_to_selection_data (Display *, Lisp_Object,
76 unsigned char **, Atom *,
77 ptrdiff_t *, int *, int *);
78 static Lisp_Object clean_local_selection_data (Lisp_Object);
80 /* Printing traces to stderr. */
82 #ifdef TRACE_SELECTION
83 #define TRACE0(fmt) \
84 fprintf (stderr, "%d: " fmt "\n", getpid ())
85 #define TRACE1(fmt, a0) \
86 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
87 #define TRACE2(fmt, a0, a1) \
88 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
89 #define TRACE3(fmt, a0, a1, a2) \
90 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
91 #else
92 #define TRACE0(fmt) (void) 0
93 #define TRACE1(fmt, a0) (void) 0
94 #define TRACE2(fmt, a0, a1) (void) 0
95 #endif
98 static Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
99 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
100 QATOM_PAIR, QCLIPBOARD_MANAGER, QSAVE_TARGETS;
102 static Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
103 static Lisp_Object QUTF8_STRING; /* This is a type of selection. */
105 static Lisp_Object Qcompound_text_with_extensions;
107 static Lisp_Object Qforeign_selection;
108 static Lisp_Object Qx_lost_selection_functions, Qx_sent_selection_functions;
110 /* Bytes needed to represent 'long' data. This is as per libX11; it
111 is not necessarily sizeof (long). */
112 #define X_LONG_SIZE 4
114 /* Extreme 'short' and 'long' values suitable for libX11. */
115 #define X_SHRT_MAX 0x7fff
116 #define X_SHRT_MIN (-1 - X_SHRT_MAX)
117 #define X_LONG_MAX 0x7fffffff
118 #define X_LONG_MIN (-1 - X_LONG_MAX)
119 #define X_ULONG_MAX 0xffffffffUL
121 /* If this is a smaller number than the max-request-size of the display,
122 emacs will use INCR selection transfer when the selection is larger
123 than this. The max-request-size is usually around 64k, so if you want
124 emacs to use incremental selection transfers when the selection is
125 smaller than that, set this. I added this mostly for debugging the
126 incremental transfer stuff, but it might improve server performance.
128 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
129 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
130 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
131 - 1 in place of INT_MAX. */
132 #define MAX_SELECTION_QUANTUM \
133 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
134 / max (X_LONG_SIZE, sizeof (long)))))
136 static int
137 selection_quantum (Display *display)
139 long mrs = XMaxRequestSize (display);
140 return (mrs < MAX_SELECTION_QUANTUM / X_LONG_SIZE + 25
141 ? (mrs - 25) * X_LONG_SIZE
142 : MAX_SELECTION_QUANTUM);
145 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
146 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
149 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
150 handling. */
152 struct selection_event_queue
154 struct input_event event;
155 struct selection_event_queue *next;
158 static struct selection_event_queue *selection_queue;
160 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
162 static int x_queue_selection_requests;
164 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
166 static void
167 x_queue_event (struct input_event *event)
169 struct selection_event_queue *queue_tmp;
171 /* Don't queue repeated requests.
172 This only happens for large requests which uses the incremental protocol. */
173 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
175 if (!memcmp (&queue_tmp->event, event, sizeof (*event)))
177 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp);
178 x_decline_selection_request (event);
179 return;
183 queue_tmp
184 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
186 if (queue_tmp != NULL)
188 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp);
189 queue_tmp->event = *event;
190 queue_tmp->next = selection_queue;
191 selection_queue = queue_tmp;
195 /* Start queuing SELECTION_REQUEST_EVENT events. */
197 static void
198 x_start_queuing_selection_requests (void)
200 if (x_queue_selection_requests)
201 abort ();
203 x_queue_selection_requests++;
204 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
207 /* Stop queuing SELECTION_REQUEST_EVENT events. */
209 static void
210 x_stop_queuing_selection_requests (void)
212 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
213 --x_queue_selection_requests;
215 /* Take all the queued events and put them back
216 so that they get processed afresh. */
218 while (selection_queue != NULL)
220 struct selection_event_queue *queue_tmp = selection_queue;
221 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp);
222 kbd_buffer_unget_event (&queue_tmp->event);
223 selection_queue = queue_tmp->next;
224 xfree ((char *)queue_tmp);
229 /* This converts a Lisp symbol to a server Atom, avoiding a server
230 roundtrip whenever possible. */
232 static Atom
233 symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym)
235 Atom val;
236 if (NILP (sym)) return 0;
237 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
238 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
239 if (EQ (sym, QSTRING)) return XA_STRING;
240 if (EQ (sym, QINTEGER)) return XA_INTEGER;
241 if (EQ (sym, QATOM)) return XA_ATOM;
242 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
243 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
244 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
245 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
246 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
247 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
248 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
249 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
250 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
251 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
252 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
253 if (!SYMBOLP (sym)) abort ();
255 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym)));
256 BLOCK_INPUT;
257 val = XInternAtom (dpyinfo->display, SSDATA (SYMBOL_NAME (sym)), False);
258 UNBLOCK_INPUT;
259 return val;
263 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
264 and calls to intern whenever possible. */
266 static Lisp_Object
267 x_atom_to_symbol (Display *dpy, Atom atom)
269 struct x_display_info *dpyinfo;
270 char *str;
271 Lisp_Object val;
273 if (! atom)
274 return Qnil;
276 switch (atom)
278 case XA_PRIMARY:
279 return QPRIMARY;
280 case XA_SECONDARY:
281 return QSECONDARY;
282 case XA_STRING:
283 return QSTRING;
284 case XA_INTEGER:
285 return QINTEGER;
286 case XA_ATOM:
287 return QATOM;
290 dpyinfo = x_display_info_for_display (dpy);
291 if (dpyinfo == NULL)
292 return Qnil;
293 if (atom == dpyinfo->Xatom_CLIPBOARD)
294 return QCLIPBOARD;
295 if (atom == dpyinfo->Xatom_TIMESTAMP)
296 return QTIMESTAMP;
297 if (atom == dpyinfo->Xatom_TEXT)
298 return QTEXT;
299 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
300 return QCOMPOUND_TEXT;
301 if (atom == dpyinfo->Xatom_UTF8_STRING)
302 return QUTF8_STRING;
303 if (atom == dpyinfo->Xatom_DELETE)
304 return QDELETE;
305 if (atom == dpyinfo->Xatom_MULTIPLE)
306 return QMULTIPLE;
307 if (atom == dpyinfo->Xatom_INCR)
308 return QINCR;
309 if (atom == dpyinfo->Xatom_EMACS_TMP)
310 return QEMACS_TMP;
311 if (atom == dpyinfo->Xatom_TARGETS)
312 return QTARGETS;
313 if (atom == dpyinfo->Xatom_NULL)
314 return QNULL;
316 BLOCK_INPUT;
317 str = XGetAtomName (dpy, atom);
318 UNBLOCK_INPUT;
319 TRACE1 ("XGetAtomName --> %s", str);
320 if (! str) return Qnil;
321 val = intern (str);
322 BLOCK_INPUT;
323 /* This was allocated by Xlib, so use XFree. */
324 XFree (str);
325 UNBLOCK_INPUT;
326 return val;
329 /* Do protocol to assert ourself as a selection owner.
330 FRAME shall be the owner; it must be a valid X frame.
331 Update the Vselection_alist so that we can reply to later requests for
332 our selection. */
334 static void
335 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
336 Lisp_Object frame)
338 struct frame *f = XFRAME (frame);
339 Window selecting_window = FRAME_X_WINDOW (f);
340 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
341 Display *display = dpyinfo->display;
342 Time timestamp = last_event_timestamp;
343 Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_name);
345 BLOCK_INPUT;
346 x_catch_errors (display);
347 XSetSelectionOwner (display, selection_atom, selecting_window, timestamp);
348 x_check_errors (display, "Can't set selection: %s");
349 x_uncatch_errors ();
350 UNBLOCK_INPUT;
352 /* Now update the local cache */
354 Lisp_Object selection_data;
355 Lisp_Object prev_value;
357 selection_data = list4 (selection_name, selection_value,
358 INTEGER_TO_CONS (timestamp), frame);
359 prev_value = LOCAL_SELECTION (selection_name, dpyinfo);
361 dpyinfo->terminal->Vselection_alist
362 = Fcons (selection_data, dpyinfo->terminal->Vselection_alist);
364 /* If we already owned the selection, remove the old selection
365 data. Don't use Fdelq as that may QUIT. */
366 if (!NILP (prev_value))
368 /* We know it's not the CAR, so it's easy. */
369 Lisp_Object rest = dpyinfo->terminal->Vselection_alist;
370 for (; CONSP (rest); rest = XCDR (rest))
371 if (EQ (prev_value, Fcar (XCDR (rest))))
373 XSETCDR (rest, XCDR (XCDR (rest)));
374 break;
380 /* Given a selection-name and desired type, look up our local copy of
381 the selection value and convert it to the type.
382 Return nil, a string, a vector, a symbol, an integer, or a cons
383 that CONS_TO_INTEGER could plausibly handle.
384 This function is used both for remote requests (LOCAL_REQUEST is zero)
385 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
387 This calls random Lisp code, and may signal or gc. */
389 static Lisp_Object
390 x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
391 int local_request, struct x_display_info *dpyinfo)
393 Lisp_Object local_value;
394 Lisp_Object handler_fn, value, check;
395 int count;
397 local_value = LOCAL_SELECTION (selection_symbol, dpyinfo);
399 if (NILP (local_value)) return Qnil;
401 /* TIMESTAMP is a special case. */
402 if (EQ (target_type, QTIMESTAMP))
404 handler_fn = Qnil;
405 value = XCAR (XCDR (XCDR (local_value)));
407 else
409 /* Don't allow a quit within the converter.
410 When the user types C-g, he would be surprised
411 if by luck it came during a converter. */
412 count = SPECPDL_INDEX ();
413 specbind (Qinhibit_quit, Qt);
415 CHECK_SYMBOL (target_type);
416 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
417 /* gcpro is not needed here since nothing but HANDLER_FN
418 is live, and that ought to be a symbol. */
420 if (!NILP (handler_fn))
421 value = call3 (handler_fn,
422 selection_symbol, (local_request ? Qnil : target_type),
423 XCAR (XCDR (local_value)));
424 else
425 value = Qnil;
426 unbind_to (count, Qnil);
429 /* Make sure this value is of a type that we could transmit
430 to another X client. */
432 check = value;
433 if (CONSP (value)
434 && SYMBOLP (XCAR (value)))
435 check = XCDR (value);
437 if (STRINGP (check)
438 || VECTORP (check)
439 || SYMBOLP (check)
440 || INTEGERP (check)
441 || NILP (value))
442 return value;
443 /* Check for a value that CONS_TO_INTEGER could handle. */
444 else if (CONSP (check)
445 && INTEGERP (XCAR (check))
446 && (INTEGERP (XCDR (check))
448 (CONSP (XCDR (check))
449 && INTEGERP (XCAR (XCDR (check)))
450 && NILP (XCDR (XCDR (check))))))
451 return value;
453 signal_error ("Invalid data returned by selection-conversion function",
454 list2 (handler_fn, value));
457 /* Subroutines of x_reply_selection_request. */
459 /* Send a SelectionNotify event to the requestor with property=None,
460 meaning we were unable to do what they wanted. */
462 static void
463 x_decline_selection_request (struct input_event *event)
465 XEvent reply_base;
466 XSelectionEvent *reply = &(reply_base.xselection);
468 reply->type = SelectionNotify;
469 reply->display = SELECTION_EVENT_DISPLAY (event);
470 reply->requestor = SELECTION_EVENT_REQUESTOR (event);
471 reply->selection = SELECTION_EVENT_SELECTION (event);
472 reply->time = SELECTION_EVENT_TIME (event);
473 reply->target = SELECTION_EVENT_TARGET (event);
474 reply->property = None;
476 /* The reason for the error may be that the receiver has
477 died in the meantime. Handle that case. */
478 BLOCK_INPUT;
479 x_catch_errors (reply->display);
480 XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
481 XFlush (reply->display);
482 x_uncatch_errors ();
483 UNBLOCK_INPUT;
486 /* This is the selection request currently being processed.
487 It is set to zero when the request is fully processed. */
488 static struct input_event *x_selection_current_request;
490 /* Display info in x_selection_request. */
492 static struct x_display_info *selection_request_dpyinfo;
494 /* Raw selection data, for sending to a requestor window. */
496 struct selection_data
498 unsigned char *data;
499 ptrdiff_t size;
500 int format;
501 Atom type;
502 int nofree;
503 Atom property;
504 /* This can be set to non-NULL during x_reply_selection_request, if
505 the selection is waiting for an INCR transfer to complete. Don't
506 free these; that's done by unexpect_property_change. */
507 struct prop_location *wait_object;
508 struct selection_data *next;
511 /* Linked list of the above (in support of MULTIPLE targets). */
513 static struct selection_data *converted_selections;
515 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
516 static Atom conversion_fail_tag;
518 /* Used as an unwind-protect clause so that, if a selection-converter signals
519 an error, we tell the requestor that we were unable to do what they wanted
520 before we throw to top-level or go into the debugger or whatever. */
522 static Lisp_Object
523 x_selection_request_lisp_error (Lisp_Object ignore)
525 struct selection_data *cs, *next;
527 for (cs = converted_selections; cs; cs = next)
529 next = cs->next;
530 if (cs->nofree == 0 && cs->data)
531 xfree (cs->data);
532 xfree (cs);
534 converted_selections = NULL;
536 if (x_selection_current_request != 0
537 && selection_request_dpyinfo->display)
538 x_decline_selection_request (x_selection_current_request);
539 return Qnil;
542 static Lisp_Object
543 x_catch_errors_unwind (Lisp_Object dummy)
545 BLOCK_INPUT;
546 x_uncatch_errors ();
547 UNBLOCK_INPUT;
548 return Qnil;
552 /* This stuff is so that INCR selections are reentrant (that is, so we can
553 be servicing multiple INCR selection requests simultaneously.) I haven't
554 actually tested that yet. */
556 /* Keep a list of the property changes that are awaited. */
558 struct prop_location
560 int identifier;
561 Display *display;
562 Window window;
563 Atom property;
564 int desired_state;
565 int arrived;
566 struct prop_location *next;
569 static struct prop_location *expect_property_change (Display *display, Window window, Atom property, int state);
570 static void wait_for_property_change (struct prop_location *location);
571 static void unexpect_property_change (struct prop_location *location);
572 static int waiting_for_other_props_on_window (Display *display, Window window);
574 static int prop_location_identifier;
576 static Lisp_Object property_change_reply;
578 static struct prop_location *property_change_reply_object;
580 static struct prop_location *property_change_wait_list;
582 static Lisp_Object
583 queue_selection_requests_unwind (Lisp_Object tem)
585 x_stop_queuing_selection_requests ();
586 return Qnil;
590 /* Send the reply to a selection request event EVENT. */
592 #ifdef TRACE_SELECTION
593 static int x_reply_selection_request_cnt;
594 #endif /* TRACE_SELECTION */
596 static void
597 x_reply_selection_request (struct input_event *event,
598 struct x_display_info *dpyinfo)
600 XEvent reply_base;
601 XSelectionEvent *reply = &(reply_base.xselection);
602 Display *display = SELECTION_EVENT_DISPLAY (event);
603 Window window = SELECTION_EVENT_REQUESTOR (event);
604 ptrdiff_t bytes_remaining;
605 int max_bytes = selection_quantum (display);
606 int count = SPECPDL_INDEX ();
607 struct selection_data *cs;
609 reply->type = SelectionNotify;
610 reply->display = display;
611 reply->requestor = window;
612 reply->selection = SELECTION_EVENT_SELECTION (event);
613 reply->time = SELECTION_EVENT_TIME (event);
614 reply->target = SELECTION_EVENT_TARGET (event);
615 reply->property = SELECTION_EVENT_PROPERTY (event);
616 if (reply->property == None)
617 reply->property = reply->target;
619 BLOCK_INPUT;
620 /* The protected block contains wait_for_property_change, which can
621 run random lisp code (process handlers) or signal. Therefore, we
622 put the x_uncatch_errors call in an unwind. */
623 record_unwind_protect (x_catch_errors_unwind, Qnil);
624 x_catch_errors (display);
626 /* Loop over converted selections, storing them in the requested
627 properties. If data is large, only store the first N bytes
628 (section 2.7.2 of ICCCM). Note that we store the data for a
629 MULTIPLE request in the opposite order; the ICCM says only that
630 the conversion itself must be done in the same order. */
631 for (cs = converted_selections; cs; cs = cs->next)
633 if (cs->property == None)
634 continue;
636 bytes_remaining = cs->size;
637 bytes_remaining *= cs->format >> 3;
638 if (bytes_remaining <= max_bytes)
640 /* Send all the data at once, with minimal handshaking. */
641 TRACE1 ("Sending all %"pD"d bytes", bytes_remaining);
642 XChangeProperty (display, window, cs->property,
643 cs->type, cs->format, PropModeReplace,
644 cs->data, cs->size);
646 else
648 /* Send an INCR tag to initiate incremental transfer. */
649 long value[1];
651 TRACE2 ("Start sending %"pD"d bytes incrementally (%s)",
652 bytes_remaining, XGetAtomName (display, cs->property));
653 cs->wait_object
654 = expect_property_change (display, window, cs->property,
655 PropertyDelete);
657 /* XChangeProperty expects an array of long even if long is
658 more than 32 bits. */
659 value[0] = min (bytes_remaining, X_LONG_MAX);
660 XChangeProperty (display, window, cs->property,
661 dpyinfo->Xatom_INCR, 32, PropModeReplace,
662 (unsigned char *) value, 1);
663 XSelectInput (display, window, PropertyChangeMask);
667 /* Now issue the SelectionNotify event. */
668 XSendEvent (display, window, False, 0L, &reply_base);
669 XFlush (display);
671 #ifdef TRACE_SELECTION
673 char *sel = XGetAtomName (display, reply->selection);
674 char *tgt = XGetAtomName (display, reply->target);
675 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
676 sel, tgt, ++x_reply_selection_request_cnt);
677 if (sel) XFree (sel);
678 if (tgt) XFree (tgt);
680 #endif /* TRACE_SELECTION */
682 /* Finish sending the rest of each of the INCR values. This should
683 be improved; there's a chance of deadlock if more than one
684 subtarget in a MULTIPLE selection requires an INCR transfer, and
685 the requestor and Emacs loop waiting on different transfers. */
686 for (cs = converted_selections; cs; cs = cs->next)
687 if (cs->wait_object)
689 int format_bytes = cs->format / 8;
690 int had_errors = x_had_errors_p (display);
691 UNBLOCK_INPUT;
693 bytes_remaining = cs->size;
694 bytes_remaining *= format_bytes;
696 /* Wait for the requestor to ack by deleting the property.
697 This can run Lisp code (process handlers) or signal. */
698 if (! had_errors)
700 TRACE1 ("Waiting for ACK (deletion of %s)",
701 XGetAtomName (display, cs->property));
702 wait_for_property_change (cs->wait_object);
704 else
705 unexpect_property_change (cs->wait_object);
707 while (bytes_remaining)
709 int i = ((bytes_remaining < max_bytes)
710 ? bytes_remaining
711 : max_bytes) / format_bytes;
712 BLOCK_INPUT;
714 cs->wait_object
715 = expect_property_change (display, window, cs->property,
716 PropertyDelete);
718 TRACE1 ("Sending increment of %d elements", i);
719 TRACE1 ("Set %s to increment data",
720 XGetAtomName (display, cs->property));
722 /* Append the next chunk of data to the property. */
723 XChangeProperty (display, window, cs->property,
724 cs->type, cs->format, PropModeAppend,
725 cs->data, i);
726 bytes_remaining -= i * format_bytes;
727 cs->data += i * ((cs->format == 32) ? sizeof (long)
728 : format_bytes);
729 XFlush (display);
730 had_errors = x_had_errors_p (display);
731 UNBLOCK_INPUT;
733 if (had_errors) break;
735 /* Wait for the requestor to ack this chunk by deleting
736 the property. This can run Lisp code or signal. */
737 TRACE1 ("Waiting for increment ACK (deletion of %s)",
738 XGetAtomName (display, cs->property));
739 wait_for_property_change (cs->wait_object);
742 /* Now write a zero-length chunk to the property to tell the
743 requestor that we're done. */
744 BLOCK_INPUT;
745 if (! waiting_for_other_props_on_window (display, window))
746 XSelectInput (display, window, 0L);
748 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
749 XGetAtomName (display, cs->property));
750 XChangeProperty (display, window, cs->property,
751 cs->type, cs->format, PropModeReplace,
752 cs->data, 0);
753 TRACE0 ("Done sending incrementally");
756 /* rms, 2003-01-03: I think I have fixed this bug. */
757 /* The window we're communicating with may have been deleted
758 in the meantime (that's a real situation from a bug report).
759 In this case, there may be events in the event queue still
760 referring to the deleted window, and we'll get a BadWindow error
761 in XTread_socket when processing the events. I don't have
762 an idea how to fix that. gerd, 2001-01-98. */
763 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
764 delivered before uncatch errors. */
765 XSync (display, False);
766 UNBLOCK_INPUT;
768 /* GTK queues events in addition to the queue in Xlib. So we
769 UNBLOCK to enter the event loop and get possible errors delivered,
770 and then BLOCK again because x_uncatch_errors requires it. */
771 BLOCK_INPUT;
772 /* This calls x_uncatch_errors. */
773 unbind_to (count, Qnil);
774 UNBLOCK_INPUT;
777 /* Handle a SelectionRequest event EVENT.
778 This is called from keyboard.c when such an event is found in the queue. */
780 static void
781 x_handle_selection_request (struct input_event *event)
783 struct gcpro gcpro1, gcpro2;
784 Time local_selection_time;
786 Display *display = SELECTION_EVENT_DISPLAY (event);
787 struct x_display_info *dpyinfo = x_display_info_for_display (display);
788 Atom selection = SELECTION_EVENT_SELECTION (event);
789 Lisp_Object selection_symbol = x_atom_to_symbol (display, selection);
790 Atom target = SELECTION_EVENT_TARGET (event);
791 Lisp_Object target_symbol = x_atom_to_symbol (display, target);
792 Atom property = SELECTION_EVENT_PROPERTY (event);
793 Lisp_Object local_selection_data;
794 int success = 0;
795 int count = SPECPDL_INDEX ();
796 GCPRO2 (local_selection_data, target_symbol);
798 if (!dpyinfo) goto DONE;
800 local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
802 /* Decline if we don't own any selections. */
803 if (NILP (local_selection_data)) goto DONE;
805 /* Decline requests issued prior to our acquiring the selection. */
806 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
807 Time, local_selection_time);
808 if (SELECTION_EVENT_TIME (event) != CurrentTime
809 && local_selection_time > SELECTION_EVENT_TIME (event))
810 goto DONE;
812 x_selection_current_request = event;
813 selection_request_dpyinfo = dpyinfo;
814 record_unwind_protect (x_selection_request_lisp_error, Qnil);
816 /* We might be able to handle nested x_handle_selection_requests,
817 but this is difficult to test, and seems unimportant. */
818 x_start_queuing_selection_requests ();
819 record_unwind_protect (queue_selection_requests_unwind, Qnil);
821 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
822 SDATA (SYMBOL_NAME (selection_symbol)),
823 SDATA (SYMBOL_NAME (target_symbol)));
825 if (EQ (target_symbol, QMULTIPLE))
827 /* For MULTIPLE targets, the event property names a list of atom
828 pairs; the first atom names a target and the second names a
829 non-None property. */
830 Window requestor = SELECTION_EVENT_REQUESTOR (event);
831 Lisp_Object multprop;
832 ptrdiff_t j, nselections;
834 if (property == None) goto DONE;
835 multprop
836 = x_get_window_property_as_lisp_data (display, requestor, property,
837 QMULTIPLE, selection);
839 if (!VECTORP (multprop) || ASIZE (multprop) % 2)
840 goto DONE;
842 nselections = ASIZE (multprop) / 2;
843 /* Perform conversions. This can signal. */
844 for (j = 0; j < nselections; j++)
846 Lisp_Object subtarget = AREF (multprop, 2*j);
847 Atom subproperty = symbol_to_x_atom (dpyinfo,
848 AREF (multprop, 2*j+1));
850 if (subproperty != None)
851 x_convert_selection (event, selection_symbol, subtarget,
852 subproperty, 1, dpyinfo);
854 success = 1;
856 else
858 if (property == None)
859 property = SELECTION_EVENT_TARGET (event);
860 success = x_convert_selection (event, selection_symbol,
861 target_symbol, property,
862 0, dpyinfo);
865 DONE:
867 if (success)
868 x_reply_selection_request (event, dpyinfo);
869 else
870 x_decline_selection_request (event);
871 x_selection_current_request = 0;
873 /* Run the `x-sent-selection-functions' abnormal hook. */
874 if (!NILP (Vx_sent_selection_functions)
875 && !EQ (Vx_sent_selection_functions, Qunbound))
877 Lisp_Object args[4];
878 args[0] = Qx_sent_selection_functions;
879 args[1] = selection_symbol;
880 args[2] = target_symbol;
881 args[3] = success ? Qt : Qnil;
882 Frun_hook_with_args (4, args);
885 unbind_to (count, Qnil);
886 UNGCPRO;
889 /* Perform the requested selection conversion, and write the data to
890 the converted_selections linked list, where it can be accessed by
891 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
892 the data even if conversion fails, using conversion_fail_tag.
894 Return 0 if the selection failed to convert, 1 otherwise. */
896 static int
897 x_convert_selection (struct input_event *event, Lisp_Object selection_symbol,
898 Lisp_Object target_symbol, Atom property,
899 int for_multiple, struct x_display_info *dpyinfo)
901 struct gcpro gcpro1;
902 Lisp_Object lisp_selection;
903 struct selection_data *cs;
904 GCPRO1 (lisp_selection);
906 lisp_selection
907 = x_get_local_selection (selection_symbol, target_symbol,
908 0, dpyinfo);
910 /* A nil return value means we can't perform the conversion. */
911 if (NILP (lisp_selection)
912 || (CONSP (lisp_selection) && NILP (XCDR (lisp_selection))))
914 if (for_multiple)
916 cs = xmalloc (sizeof (struct selection_data));
917 cs->data = (unsigned char *) &conversion_fail_tag;
918 cs->size = 1;
919 cs->format = 32;
920 cs->type = XA_ATOM;
921 cs->nofree = 1;
922 cs->property = property;
923 cs->wait_object = NULL;
924 cs->next = converted_selections;
925 converted_selections = cs;
928 UNGCPRO;
929 return 0;
932 /* Otherwise, record the converted selection to binary. */
933 cs = xmalloc (sizeof (struct selection_data));
934 cs->data = NULL;
935 cs->nofree = 1;
936 cs->property = property;
937 cs->wait_object = NULL;
938 cs->next = converted_selections;
939 converted_selections = cs;
940 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
941 lisp_selection,
942 &(cs->data), &(cs->type),
943 &(cs->size), &(cs->format),
944 &(cs->nofree));
945 UNGCPRO;
946 return 1;
949 /* Handle a SelectionClear event EVENT, which indicates that some
950 client cleared out our previously asserted selection.
951 This is called from keyboard.c when such an event is found in the queue. */
953 static void
954 x_handle_selection_clear (struct input_event *event)
956 Display *display = SELECTION_EVENT_DISPLAY (event);
957 Atom selection = SELECTION_EVENT_SELECTION (event);
958 Time changed_owner_time = SELECTION_EVENT_TIME (event);
960 Lisp_Object selection_symbol, local_selection_data;
961 Time local_selection_time;
962 struct x_display_info *dpyinfo = x_display_info_for_display (display);
963 Lisp_Object Vselection_alist;
965 TRACE0 ("x_handle_selection_clear");
967 if (!dpyinfo) return;
969 selection_symbol = x_atom_to_symbol (display, selection);
970 local_selection_data = LOCAL_SELECTION (selection_symbol, dpyinfo);
972 /* Well, we already believe that we don't own it, so that's just fine. */
973 if (NILP (local_selection_data)) return;
975 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data))),
976 Time, local_selection_time);
978 /* We have reasserted the selection since this SelectionClear was
979 generated, so we can disregard it. */
980 if (changed_owner_time != CurrentTime
981 && local_selection_time > changed_owner_time)
982 return;
984 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
985 Vselection_alist = dpyinfo->terminal->Vselection_alist;
986 if (EQ (local_selection_data, CAR (Vselection_alist)))
987 Vselection_alist = XCDR (Vselection_alist);
988 else
990 Lisp_Object rest;
991 for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
992 if (EQ (local_selection_data, CAR (XCDR (rest))))
994 XSETCDR (rest, XCDR (XCDR (rest)));
995 break;
998 dpyinfo->terminal->Vselection_alist = Vselection_alist;
1000 /* Run the `x-lost-selection-functions' abnormal hook. */
1002 Lisp_Object args[2];
1003 args[0] = Qx_lost_selection_functions;
1004 args[1] = selection_symbol;
1005 Frun_hook_with_args (2, args);
1008 prepare_menu_bars ();
1009 redisplay_preserve_echo_area (20);
1012 void
1013 x_handle_selection_event (struct input_event *event)
1015 TRACE0 ("x_handle_selection_event");
1016 if (event->kind != SELECTION_REQUEST_EVENT)
1017 x_handle_selection_clear (event);
1018 else if (x_queue_selection_requests)
1019 x_queue_event (event);
1020 else
1021 x_handle_selection_request (event);
1025 /* Clear all selections that were made from frame F.
1026 We do this when about to delete a frame. */
1028 void
1029 x_clear_frame_selections (FRAME_PTR f)
1031 Lisp_Object frame;
1032 Lisp_Object rest;
1033 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1034 struct terminal *t = dpyinfo->terminal;
1036 XSETFRAME (frame, f);
1038 /* Delete elements from the beginning of Vselection_alist. */
1039 while (CONSP (t->Vselection_alist)
1040 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (t->Vselection_alist)))))))
1042 /* Run the `x-lost-selection-functions' abnormal hook. */
1043 Lisp_Object args[2];
1044 args[0] = Qx_lost_selection_functions;
1045 args[1] = Fcar (Fcar (t->Vselection_alist));
1046 Frun_hook_with_args (2, args);
1048 t->Vselection_alist = XCDR (t->Vselection_alist);
1051 /* Delete elements after the beginning of Vselection_alist. */
1052 for (rest = t->Vselection_alist; CONSP (rest); rest = XCDR (rest))
1053 if (CONSP (XCDR (rest))
1054 && EQ (frame, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest))))))))
1056 Lisp_Object args[2];
1057 args[0] = Qx_lost_selection_functions;
1058 args[1] = XCAR (XCAR (XCDR (rest)));
1059 Frun_hook_with_args (2, args);
1060 XSETCDR (rest, XCDR (XCDR (rest)));
1061 break;
1065 /* Nonzero if any properties for DISPLAY and WINDOW
1066 are on the list of what we are waiting for. */
1068 static int
1069 waiting_for_other_props_on_window (Display *display, Window window)
1071 struct prop_location *rest = property_change_wait_list;
1072 while (rest)
1073 if (rest->display == display && rest->window == window)
1074 return 1;
1075 else
1076 rest = rest->next;
1077 return 0;
1080 /* Add an entry to the list of property changes we are waiting for.
1081 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1082 The return value is a number that uniquely identifies
1083 this awaited property change. */
1085 static struct prop_location *
1086 expect_property_change (Display *display, Window window,
1087 Atom property, int state)
1089 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1090 pl->identifier = ++prop_location_identifier;
1091 pl->display = display;
1092 pl->window = window;
1093 pl->property = property;
1094 pl->desired_state = state;
1095 pl->next = property_change_wait_list;
1096 pl->arrived = 0;
1097 property_change_wait_list = pl;
1098 return pl;
1101 /* Delete an entry from the list of property changes we are waiting for.
1102 IDENTIFIER is the number that uniquely identifies the entry. */
1104 static void
1105 unexpect_property_change (struct prop_location *location)
1107 struct prop_location *prev = 0, *rest = property_change_wait_list;
1108 while (rest)
1110 if (rest == location)
1112 if (prev)
1113 prev->next = rest->next;
1114 else
1115 property_change_wait_list = rest->next;
1116 xfree (rest);
1117 return;
1119 prev = rest;
1120 rest = rest->next;
1124 /* Remove the property change expectation element for IDENTIFIER. */
1126 static Lisp_Object
1127 wait_for_property_change_unwind (Lisp_Object loc)
1129 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1131 unexpect_property_change (location);
1132 if (location == property_change_reply_object)
1133 property_change_reply_object = 0;
1134 return Qnil;
1137 /* Actually wait for a property change.
1138 IDENTIFIER should be the value that expect_property_change returned. */
1140 static void
1141 wait_for_property_change (struct prop_location *location)
1143 int secs, usecs;
1144 int count = SPECPDL_INDEX ();
1146 if (property_change_reply_object)
1147 abort ();
1149 /* Make sure to do unexpect_property_change if we quit or err. */
1150 record_unwind_protect (wait_for_property_change_unwind,
1151 make_save_value (location, 0));
1153 XSETCAR (property_change_reply, Qnil);
1154 property_change_reply_object = location;
1156 /* If the event we are waiting for arrives beyond here, it will set
1157 property_change_reply, because property_change_reply_object says so. */
1158 if (! location->arrived)
1160 secs = x_selection_timeout / 1000;
1161 usecs = (x_selection_timeout % 1000) * 1000;
1162 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1163 wait_reading_process_output (secs, usecs, 0, 0,
1164 property_change_reply, NULL, 0);
1166 if (NILP (XCAR (property_change_reply)))
1168 TRACE0 (" Timed out");
1169 error ("Timed out waiting for property-notify event");
1173 unbind_to (count, Qnil);
1176 /* Called from XTread_socket in response to a PropertyNotify event. */
1178 void
1179 x_handle_property_notify (XPropertyEvent *event)
1181 struct prop_location *rest;
1183 for (rest = property_change_wait_list; rest; rest = rest->next)
1185 if (!rest->arrived
1186 && rest->property == event->atom
1187 && rest->window == event->window
1188 && rest->display == event->display
1189 && rest->desired_state == event->state)
1191 TRACE2 ("Expected %s of property %s",
1192 (event->state == PropertyDelete ? "deletion" : "change"),
1193 XGetAtomName (event->display, event->atom));
1195 rest->arrived = 1;
1197 /* If this is the one wait_for_property_change is waiting for,
1198 tell it to wake up. */
1199 if (rest == property_change_reply_object)
1200 XSETCAR (property_change_reply, Qt);
1202 return;
1209 /* Variables for communication with x_handle_selection_notify. */
1210 static Atom reading_which_selection;
1211 static Lisp_Object reading_selection_reply;
1212 static Window reading_selection_window;
1214 /* Do protocol to read selection-data from the server.
1215 Converts this to Lisp data and returns it.
1216 FRAME is the frame whose X window shall request the selection. */
1218 static Lisp_Object
1219 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type,
1220 Lisp_Object time_stamp, Lisp_Object frame)
1222 struct frame *f = XFRAME (frame);
1223 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
1224 Display *display = dpyinfo->display;
1225 Window requestor_window = FRAME_X_WINDOW (f);
1226 Time requestor_time = last_event_timestamp;
1227 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1228 Atom selection_atom = symbol_to_x_atom (dpyinfo, selection_symbol);
1229 Atom type_atom = (CONSP (target_type)
1230 ? symbol_to_x_atom (dpyinfo, XCAR (target_type))
1231 : symbol_to_x_atom (dpyinfo, target_type));
1232 int secs, usecs;
1234 if (!FRAME_LIVE_P (f))
1235 return Qnil;
1237 if (! NILP (time_stamp))
1238 CONS_TO_INTEGER (time_stamp, Time, requestor_time);
1240 BLOCK_INPUT;
1241 TRACE2 ("Get selection %s, type %s",
1242 XGetAtomName (display, type_atom),
1243 XGetAtomName (display, target_property));
1245 x_catch_errors (display);
1246 XConvertSelection (display, selection_atom, type_atom, target_property,
1247 requestor_window, requestor_time);
1248 x_check_errors (display, "Can't convert selection: %s");
1249 x_uncatch_errors ();
1251 /* Prepare to block until the reply has been read. */
1252 reading_selection_window = requestor_window;
1253 reading_which_selection = selection_atom;
1254 XSETCAR (reading_selection_reply, Qnil);
1256 /* It should not be necessary to stop handling selection requests
1257 during this time. In fact, the SAVE_TARGETS mechanism requires
1258 us to handle a clipboard manager's requests before it returns
1259 SelectionNotify. */
1260 #if 0
1261 x_start_queuing_selection_requests ();
1262 record_unwind_protect (queue_selection_requests_unwind, Qnil);
1263 #endif
1265 UNBLOCK_INPUT;
1267 /* This allows quits. Also, don't wait forever. */
1268 secs = x_selection_timeout / 1000;
1269 usecs = (x_selection_timeout % 1000) * 1000;
1270 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1271 wait_reading_process_output (secs, usecs, 0, 0,
1272 reading_selection_reply, NULL, 0);
1273 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1275 if (NILP (XCAR (reading_selection_reply)))
1276 error ("Timed out waiting for reply from selection owner");
1277 if (EQ (XCAR (reading_selection_reply), Qlambda))
1278 return Qnil;
1280 /* Otherwise, the selection is waiting for us on the requested property. */
1281 return
1282 x_get_window_property_as_lisp_data (display, requestor_window,
1283 target_property, target_type,
1284 selection_atom);
1287 /* Subroutines of x_get_window_property_as_lisp_data */
1289 /* Use xfree, not XFree, to free the data obtained with this function. */
1291 static void
1292 x_get_window_property (Display *display, Window window, Atom property,
1293 unsigned char **data_ret, ptrdiff_t *bytes_ret,
1294 Atom *actual_type_ret, int *actual_format_ret,
1295 unsigned long *actual_size_ret, int delete_p)
1297 ptrdiff_t total_size;
1298 unsigned long bytes_remaining;
1299 ptrdiff_t offset = 0;
1300 unsigned char *data = 0;
1301 unsigned char *tmp_data = 0;
1302 int result;
1303 int buffer_size = selection_quantum (display);
1305 /* Wide enough to avoid overflow in expressions using it. */
1306 ptrdiff_t x_long_size = X_LONG_SIZE;
1308 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1309 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1310 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1311 ptrdiff_t total_size_max =
1312 ((min (PTRDIFF_MAX, SIZE_MAX) - 1) / x_long_size < LONG_MAX
1313 ? min (PTRDIFF_MAX, SIZE_MAX) - 1
1314 : LONG_MAX * x_long_size);
1316 BLOCK_INPUT;
1318 /* First probe the thing to find out how big it is. */
1319 result = XGetWindowProperty (display, window, property,
1320 0L, 0L, False, AnyPropertyType,
1321 actual_type_ret, actual_format_ret,
1322 actual_size_ret,
1323 &bytes_remaining, &tmp_data);
1324 if (result != Success)
1325 goto done;
1327 /* This was allocated by Xlib, so use XFree. */
1328 XFree ((char *) tmp_data);
1330 if (*actual_type_ret == None || *actual_format_ret == 0)
1331 goto done;
1333 if (total_size_max < bytes_remaining)
1334 goto size_overflow;
1335 total_size = bytes_remaining;
1336 data = malloc (total_size + 1);
1337 if (! data)
1338 goto memory_exhausted;
1340 /* Now read, until we've gotten it all. */
1341 while (bytes_remaining)
1343 ptrdiff_t bytes_gotten;
1344 int bytes_per_item;
1345 result
1346 = XGetWindowProperty (display, window, property,
1347 offset / X_LONG_SIZE,
1348 buffer_size / X_LONG_SIZE,
1349 False,
1350 AnyPropertyType,
1351 actual_type_ret, actual_format_ret,
1352 actual_size_ret, &bytes_remaining, &tmp_data);
1354 /* If this doesn't return Success at this point, it means that
1355 some clod deleted the selection while we were in the midst of
1356 reading it. Deal with that, I guess.... */
1357 if (result != Success)
1358 break;
1360 bytes_per_item = *actual_format_ret >> 3;
1361 xassert (*actual_size_ret <= buffer_size / bytes_per_item);
1363 /* The man page for XGetWindowProperty says:
1364 "If the returned format is 32, the returned data is represented
1365 as a long array and should be cast to that type to obtain the
1366 elements."
1367 This applies even if long is more than 32 bits, the X library
1368 converts from 32 bit elements received from the X server to long
1369 and passes the long array to us. Thus, for that case memcpy can not
1370 be used. We convert to a 32 bit type here, because so much code
1371 assume on that.
1373 The bytes and offsets passed to XGetWindowProperty refers to the
1374 property and those are indeed in 32 bit quantities if format is 32. */
1376 bytes_gotten = *actual_size_ret;
1377 bytes_gotten *= bytes_per_item;
1379 TRACE2 ("Read %"pD"d bytes from property %s",
1380 bytes_gotten, XGetAtomName (display, property));
1382 if (total_size - offset < bytes_gotten)
1384 unsigned char *data1;
1385 ptrdiff_t remaining_lim = total_size_max - offset - bytes_gotten;
1386 if (remaining_lim < 0 || remaining_lim < bytes_remaining)
1387 goto size_overflow;
1388 total_size = offset + bytes_gotten + bytes_remaining;
1389 data1 = realloc (data, total_size + 1);
1390 if (! data1)
1391 goto memory_exhausted;
1392 data = data1;
1395 if (32 < BITS_PER_LONG && *actual_format_ret == 32)
1397 unsigned long i;
1398 int *idata = (int *) (data + offset);
1399 long *ldata = (long *) tmp_data;
1401 for (i = 0; i < *actual_size_ret; ++i)
1402 idata[i] = ldata[i];
1404 else
1405 memcpy (data + offset, tmp_data, bytes_gotten);
1407 offset += bytes_gotten;
1409 /* This was allocated by Xlib, so use XFree. */
1410 XFree ((char *) tmp_data);
1413 XFlush (display);
1414 data[offset] = '\0';
1416 done:
1417 UNBLOCK_INPUT;
1418 *data_ret = data;
1419 *bytes_ret = offset;
1420 return;
1422 size_overflow:
1423 free (data);
1424 UNBLOCK_INPUT;
1425 memory_full (SIZE_MAX);
1427 memory_exhausted:
1428 free (data);
1429 UNBLOCK_INPUT;
1430 memory_full (total_size + 1);
1433 /* Use xfree, not XFree, to free the data obtained with this function. */
1435 static void
1436 receive_incremental_selection (Display *display, Window window, Atom property,
1437 Lisp_Object target_type,
1438 unsigned int min_size_bytes,
1439 unsigned char **data_ret,
1440 ptrdiff_t *size_bytes_ret,
1441 Atom *type_ret, int *format_ret,
1442 unsigned long *size_ret)
1444 ptrdiff_t offset = 0;
1445 struct prop_location *wait_object;
1446 if (min (PTRDIFF_MAX, SIZE_MAX) < min_size_bytes)
1447 memory_full (SIZE_MAX);
1448 *data_ret = (unsigned char *) xmalloc (min_size_bytes);
1449 *size_bytes_ret = min_size_bytes;
1451 TRACE1 ("Read %u bytes incrementally", min_size_bytes);
1453 /* At this point, we have read an INCR property.
1454 Delete the property to ack it.
1455 (But first, prepare to receive the next event in this handshake.)
1457 Now, we must loop, waiting for the sending window to put a value on
1458 that property, then reading the property, then deleting it to ack.
1459 We are done when the sender places a property of length 0.
1461 BLOCK_INPUT;
1462 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1463 TRACE1 (" Delete property %s",
1464 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1465 XDeleteProperty (display, window, property);
1466 TRACE1 (" Expect new value of property %s",
1467 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1468 wait_object = expect_property_change (display, window, property,
1469 PropertyNewValue);
1470 XFlush (display);
1471 UNBLOCK_INPUT;
1473 while (1)
1475 unsigned char *tmp_data;
1476 ptrdiff_t tmp_size_bytes;
1478 TRACE0 (" Wait for property change");
1479 wait_for_property_change (wait_object);
1481 /* expect it again immediately, because x_get_window_property may
1482 .. no it won't, I don't get it.
1483 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1484 TRACE0 (" Get property value");
1485 x_get_window_property (display, window, property,
1486 &tmp_data, &tmp_size_bytes,
1487 type_ret, format_ret, size_ret, 1);
1489 TRACE1 (" Read increment of %"pD"d bytes", tmp_size_bytes);
1491 if (tmp_size_bytes == 0) /* we're done */
1493 TRACE0 ("Done reading incrementally");
1495 if (! waiting_for_other_props_on_window (display, window))
1496 XSelectInput (display, window, STANDARD_EVENT_SET);
1497 /* Use xfree, not XFree, because x_get_window_property
1498 calls xmalloc itself. */
1499 xfree (tmp_data);
1500 break;
1503 BLOCK_INPUT;
1504 TRACE1 (" ACK by deleting property %s",
1505 XGetAtomName (display, property));
1506 XDeleteProperty (display, window, property);
1507 wait_object = expect_property_change (display, window, property,
1508 PropertyNewValue);
1509 XFlush (display);
1510 UNBLOCK_INPUT;
1512 if (*size_bytes_ret - offset < tmp_size_bytes)
1513 *data_ret = xpalloc (*data_ret, size_bytes_ret,
1514 tmp_size_bytes - (*size_bytes_ret - offset),
1515 -1, 1);
1517 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1518 offset += tmp_size_bytes;
1520 /* Use xfree, not XFree, because x_get_window_property
1521 calls xmalloc itself. */
1522 xfree (tmp_data);
1527 /* Fetch a value from property PROPERTY of X window WINDOW on display
1528 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1529 if this fails. */
1531 static Lisp_Object
1532 x_get_window_property_as_lisp_data (Display *display, Window window,
1533 Atom property,
1534 Lisp_Object target_type,
1535 Atom selection_atom)
1537 Atom actual_type;
1538 int actual_format;
1539 unsigned long actual_size;
1540 unsigned char *data = 0;
1541 ptrdiff_t bytes = 0;
1542 Lisp_Object val;
1543 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1545 TRACE0 ("Reading selection data");
1547 x_get_window_property (display, window, property, &data, &bytes,
1548 &actual_type, &actual_format, &actual_size, 1);
1549 if (! data)
1551 int there_is_a_selection_owner;
1552 BLOCK_INPUT;
1553 there_is_a_selection_owner
1554 = XGetSelectionOwner (display, selection_atom);
1555 UNBLOCK_INPUT;
1556 if (there_is_a_selection_owner)
1557 signal_error ("Selection owner couldn't convert",
1558 actual_type
1559 ? list2 (target_type,
1560 x_atom_to_symbol (display, actual_type))
1561 : target_type);
1562 else
1563 signal_error ("No selection",
1564 x_atom_to_symbol (display, selection_atom));
1567 if (actual_type == dpyinfo->Xatom_INCR)
1569 /* That wasn't really the data, just the beginning. */
1571 unsigned int min_size_bytes = * ((unsigned int *) data);
1572 BLOCK_INPUT;
1573 /* Use xfree, not XFree, because x_get_window_property
1574 calls xmalloc itself. */
1575 xfree ((char *) data);
1576 UNBLOCK_INPUT;
1577 receive_incremental_selection (display, window, property, target_type,
1578 min_size_bytes, &data, &bytes,
1579 &actual_type, &actual_format,
1580 &actual_size);
1583 BLOCK_INPUT;
1584 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1585 XDeleteProperty (display, window, property);
1586 XFlush (display);
1587 UNBLOCK_INPUT;
1589 /* It's been read. Now convert it to a lisp object in some semi-rational
1590 manner. */
1591 val = selection_data_to_lisp_data (display, data, bytes,
1592 actual_type, actual_format);
1594 /* Use xfree, not XFree, because x_get_window_property
1595 calls xmalloc itself. */
1596 xfree ((char *) data);
1597 return val;
1600 /* These functions convert from the selection data read from the server into
1601 something that we can use from Lisp, and vice versa.
1603 Type: Format: Size: Lisp Type:
1604 ----- ------- ----- -----------
1605 * 8 * String
1606 ATOM 32 1 Symbol
1607 ATOM 32 > 1 Vector of Symbols
1608 * 16 1 Integer
1609 * 16 > 1 Vector of Integers
1610 * 32 1 if <=16 bits: Integer
1611 if > 16 bits: Cons of top16, bot16
1612 * 32 > 1 Vector of the above
1614 When converting a Lisp number to C, it is assumed to be of format 16 if
1615 it is an integer, and of format 32 if it is a cons of two integers.
1617 When converting a vector of numbers from Lisp to C, it is assumed to be
1618 of format 16 if every element in the vector is an integer, and is assumed
1619 to be of format 32 if any element is a cons of two integers.
1621 When converting an object to C, it may be of the form (SYMBOL . <data>)
1622 where SYMBOL is what we should claim that the type is. Format and
1623 representation are as above.
1625 Important: When format is 32, data should contain an array of int,
1626 not an array of long as the X library returns. This makes a difference
1627 when sizeof(long) != sizeof(int). */
1631 static Lisp_Object
1632 selection_data_to_lisp_data (Display *display, const unsigned char *data,
1633 ptrdiff_t size, Atom type, int format)
1635 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1637 if (type == dpyinfo->Xatom_NULL)
1638 return QNULL;
1640 /* Convert any 8-bit data to a string, for compactness. */
1641 else if (format == 8)
1643 Lisp_Object str, lispy_type;
1645 str = make_unibyte_string ((char *) data, size);
1646 /* Indicate that this string is from foreign selection by a text
1647 property `foreign-selection' so that the caller of
1648 x-get-selection-internal (usually x-get-selection) can know
1649 that the string must be decode. */
1650 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1651 lispy_type = QCOMPOUND_TEXT;
1652 else if (type == dpyinfo->Xatom_UTF8_STRING)
1653 lispy_type = QUTF8_STRING;
1654 else
1655 lispy_type = QSTRING;
1656 Fput_text_property (make_number (0), make_number (size),
1657 Qforeign_selection, lispy_type, str);
1658 return str;
1660 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1661 a vector of symbols. */
1662 else if (type == XA_ATOM
1663 /* Treat ATOM_PAIR type similar to list of atoms. */
1664 || type == dpyinfo->Xatom_ATOM_PAIR)
1666 ptrdiff_t i;
1667 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1668 But the callers of these function has made sure the data for
1669 format == 32 is an array of int. Thus, use int instead
1670 of Atom. */
1671 int *idata = (int *) data;
1673 if (size == sizeof (int))
1674 return x_atom_to_symbol (display, (Atom) idata[0]);
1675 else
1677 Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
1678 make_number (0));
1679 for (i = 0; i < size / sizeof (int); i++)
1680 Faset (v, make_number (i),
1681 x_atom_to_symbol (display, (Atom) idata[i]));
1682 return v;
1686 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1687 If the number is 32 bits and won't fit in a Lisp_Int,
1688 convert it to a cons of integers, 16 bits in each half.
1690 else if (format == 32 && size == sizeof (int))
1691 return INTEGER_TO_CONS (((int *) data) [0]);
1692 else if (format == 16 && size == sizeof (short))
1693 return make_number (((short *) data) [0]);
1695 /* Convert any other kind of data to a vector of numbers, represented
1696 as above (as an integer, or a cons of two 16 bit integers.)
1698 else if (format == 16)
1700 ptrdiff_t i;
1701 Lisp_Object v;
1702 v = Fmake_vector (make_number (size / 2), make_number (0));
1703 for (i = 0; i < size / 2; i++)
1705 EMACS_INT j = ((short *) data) [i];
1706 Faset (v, make_number (i), make_number (j));
1708 return v;
1710 else
1712 ptrdiff_t i;
1713 Lisp_Object v = Fmake_vector (make_number (size / X_LONG_SIZE),
1714 make_number (0));
1715 for (i = 0; i < size / X_LONG_SIZE; i++)
1717 int j = ((int *) data) [i];
1718 Faset (v, make_number (i), INTEGER_TO_CONS (j));
1720 return v;
1724 /* Convert OBJ to an X long value, and return it as unsigned long.
1725 OBJ should be an integer or a cons representing an integer.
1726 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1727 unsigned long values: in theory these values are supposed to be
1728 signed but in practice unsigned 32-bit data are communicated via X
1729 selections and we need to support that. */
1730 static unsigned long
1731 cons_to_x_long (Lisp_Object obj)
1733 if (X_ULONG_MAX <= INTMAX_MAX
1734 || XINT (INTEGERP (obj) ? obj : XCAR (obj)) < 0)
1735 return cons_to_signed (obj, X_LONG_MIN, min (X_ULONG_MAX, INTMAX_MAX));
1736 else
1737 return cons_to_unsigned (obj, X_ULONG_MAX);
1740 /* Use xfree, not XFree, to free the data obtained with this function. */
1742 static void
1743 lisp_data_to_selection_data (Display *display, Lisp_Object obj,
1744 unsigned char **data_ret, Atom *type_ret,
1745 ptrdiff_t *size_ret,
1746 int *format_ret, int *nofree_ret)
1748 Lisp_Object type = Qnil;
1749 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1751 *nofree_ret = 0;
1753 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1755 type = XCAR (obj);
1756 obj = XCDR (obj);
1757 if (CONSP (obj) && NILP (XCDR (obj)))
1758 obj = XCAR (obj);
1761 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1762 { /* This is not the same as declining */
1763 *format_ret = 32;
1764 *size_ret = 0;
1765 *data_ret = 0;
1766 type = QNULL;
1768 else if (STRINGP (obj))
1770 if (SCHARS (obj) < SBYTES (obj))
1771 /* OBJ is a multibyte string containing a non-ASCII char. */
1772 signal_error ("Non-ASCII string must be encoded in advance", obj);
1773 if (NILP (type))
1774 type = QSTRING;
1775 *format_ret = 8;
1776 *size_ret = SBYTES (obj);
1777 *data_ret = SDATA (obj);
1778 *nofree_ret = 1;
1780 else if (SYMBOLP (obj))
1782 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1783 *format_ret = 32;
1784 *size_ret = 1;
1785 (*data_ret) [sizeof (Atom)] = 0;
1786 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, obj);
1787 if (NILP (type)) type = QATOM;
1789 else if (RANGED_INTEGERP (X_SHRT_MIN, obj, X_SHRT_MAX))
1791 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1792 *format_ret = 16;
1793 *size_ret = 1;
1794 (*data_ret) [sizeof (short)] = 0;
1795 (*(short **) data_ret) [0] = XINT (obj);
1796 if (NILP (type)) type = QINTEGER;
1798 else if (INTEGERP (obj)
1799 || (CONSP (obj) && INTEGERP (XCAR (obj))
1800 && (INTEGERP (XCDR (obj))
1801 || (CONSP (XCDR (obj))
1802 && INTEGERP (XCAR (XCDR (obj)))))))
1804 *data_ret = (unsigned char *) xmalloc (sizeof (unsigned long) + 1);
1805 *format_ret = 32;
1806 *size_ret = 1;
1807 (*data_ret) [sizeof (unsigned long)] = 0;
1808 (*(unsigned long **) data_ret) [0] = cons_to_x_long (obj);
1809 if (NILP (type)) type = QINTEGER;
1811 else if (VECTORP (obj))
1813 /* Lisp_Vectors may represent a set of ATOMs;
1814 a set of 16 or 32 bit INTEGERs;
1815 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1817 ptrdiff_t i;
1818 ptrdiff_t size = ASIZE (obj);
1820 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1821 /* This vector is an ATOM set */
1823 if (NILP (type)) type = QATOM;
1824 for (i = 0; i < size; i++)
1825 if (!SYMBOLP (XVECTOR (obj)->contents [i]))
1826 signal_error ("All elements of selection vector must have same type", obj);
1828 *data_ret = xnmalloc (size, sizeof (Atom));
1829 *format_ret = 32;
1830 *size_ret = size;
1831 for (i = 0; i < size; i++)
1832 (*(Atom **) data_ret) [i]
1833 = symbol_to_x_atom (dpyinfo, XVECTOR (obj)->contents [i]);
1835 else
1836 /* This vector is an INTEGER set, or something like it */
1838 int format = 16;
1839 int data_size = sizeof (short);
1840 if (NILP (type)) type = QINTEGER;
1841 for (i = 0; i < size; i++)
1843 if (! RANGED_INTEGERP (X_SHRT_MIN, XVECTOR (obj)->contents[i],
1844 X_SHRT_MAX))
1846 /* Use sizeof (long) even if it is more than 32 bits.
1847 See comment in x_get_window_property and
1848 x_fill_property_data. */
1849 data_size = sizeof (long);
1850 format = 32;
1851 break;
1854 *data_ret = xnmalloc (size, data_size);
1855 *format_ret = format;
1856 *size_ret = size;
1857 for (i = 0; i < size; i++)
1859 if (format == 32)
1860 (*((unsigned long **) data_ret)) [i] =
1861 cons_to_x_long (XVECTOR (obj)->contents[i]);
1862 else
1863 (*((short **) data_ret)) [i] =
1864 XINT (XVECTOR (obj)->contents[i]);
1868 else
1869 signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
1871 *type_ret = symbol_to_x_atom (dpyinfo, type);
1874 static Lisp_Object
1875 clean_local_selection_data (Lisp_Object obj)
1877 if (CONSP (obj)
1878 && INTEGERP (XCAR (obj))
1879 && CONSP (XCDR (obj))
1880 && INTEGERP (XCAR (XCDR (obj)))
1881 && NILP (XCDR (XCDR (obj))))
1882 obj = Fcons (XCAR (obj), XCDR (obj));
1884 if (CONSP (obj)
1885 && INTEGERP (XCAR (obj))
1886 && INTEGERP (XCDR (obj)))
1888 if (XINT (XCAR (obj)) == 0)
1889 return XCDR (obj);
1890 if (XINT (XCAR (obj)) == -1)
1891 return make_number (- XINT (XCDR (obj)));
1893 if (VECTORP (obj))
1895 ptrdiff_t i;
1896 ptrdiff_t size = ASIZE (obj);
1897 Lisp_Object copy;
1898 if (size == 1)
1899 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1900 copy = Fmake_vector (make_number (size), Qnil);
1901 for (i = 0; i < size; i++)
1902 XVECTOR (copy)->contents [i]
1903 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1904 return copy;
1906 return obj;
1909 /* Called from XTread_socket to handle SelectionNotify events.
1910 If it's the selection we are waiting for, stop waiting
1911 by setting the car of reading_selection_reply to non-nil.
1912 We store t there if the reply is successful, lambda if not. */
1914 void
1915 x_handle_selection_notify (XSelectionEvent *event)
1917 if (event->requestor != reading_selection_window)
1918 return;
1919 if (event->selection != reading_which_selection)
1920 return;
1922 TRACE0 ("Received SelectionNotify");
1923 XSETCAR (reading_selection_reply,
1924 (event->property != 0 ? Qt : Qlambda));
1928 /* From a Lisp_Object, return a suitable frame for selection
1929 operations. OBJECT may be a frame, a terminal object, or nil
1930 (which stands for the selected frame--or, if that is not an X
1931 frame, the first X display on the list). If no suitable frame can
1932 be found, return NULL. */
1934 static struct frame *
1935 frame_for_x_selection (Lisp_Object object)
1937 Lisp_Object tail;
1938 struct frame *f;
1940 if (NILP (object))
1942 f = XFRAME (selected_frame);
1943 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1944 return f;
1946 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1948 f = XFRAME (XCAR (tail));
1949 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1950 return f;
1953 else if (TERMINALP (object))
1955 struct terminal *t = get_terminal (object, 1);
1956 if (t->type == output_x_window)
1958 for (tail = Vframe_list; CONSP (tail); tail = XCDR (tail))
1960 f = XFRAME (XCAR (tail));
1961 if (FRAME_LIVE_P (f) && f->terminal == t)
1962 return f;
1966 else if (FRAMEP (object))
1968 f = XFRAME (object);
1969 if (FRAME_X_P (f) && FRAME_LIVE_P (f))
1970 return f;
1973 return NULL;
1977 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
1978 Sx_own_selection_internal, 2, 3, 0,
1979 doc: /* Assert an X selection of type SELECTION and value VALUE.
1980 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1981 \(Those are literal upper-case symbol names, since that's what X expects.)
1982 VALUE is typically a string, or a cons of two markers, but may be
1983 anything that the functions on `selection-converter-alist' know about.
1985 FRAME should be a frame that should own the selection. If omitted or
1986 nil, it defaults to the selected frame.
1988 On Nextstep, FRAME is unused. */)
1989 (Lisp_Object selection, Lisp_Object value, Lisp_Object frame)
1991 if (NILP (frame)) frame = selected_frame;
1992 if (!FRAME_LIVE_P (XFRAME (frame)) || !FRAME_X_P (XFRAME (frame)))
1993 error ("X selection unavailable for this frame");
1995 CHECK_SYMBOL (selection);
1996 if (NILP (value)) error ("VALUE may not be nil");
1997 x_own_selection (selection, value, frame);
1998 return value;
2002 /* Request the selection value from the owner. If we are the owner,
2003 simply return our selection value. If we are not the owner, this
2004 will block until all of the data has arrived. */
2006 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2007 Sx_get_selection_internal, 2, 4, 0,
2008 doc: /* Return text selected from some X window.
2009 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2010 \(Those are literal upper-case symbol names, since that's what X expects.)
2011 TARGET-TYPE is the type of data desired, typically `STRING'.
2013 TIME-STAMP is the time to use in the XConvertSelection call for foreign
2014 selections. If omitted, defaults to the time for the last event.
2016 TERMINAL should be a terminal object or a frame specifying the X
2017 server to query. If omitted or nil, that stands for the selected
2018 frame's display, or the first available X display.
2020 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
2021 (Lisp_Object selection_symbol, Lisp_Object target_type,
2022 Lisp_Object time_stamp, Lisp_Object terminal)
2024 Lisp_Object val = Qnil;
2025 struct gcpro gcpro1, gcpro2;
2026 struct frame *f = frame_for_x_selection (terminal);
2027 GCPRO2 (target_type, val); /* we store newly consed data into these */
2029 CHECK_SYMBOL (selection_symbol);
2030 CHECK_SYMBOL (target_type);
2031 if (EQ (target_type, QMULTIPLE))
2032 error ("Retrieving MULTIPLE selections is currently unimplemented");
2033 if (!f)
2034 error ("X selection unavailable for this frame");
2036 val = x_get_local_selection (selection_symbol, target_type, 1,
2037 FRAME_X_DISPLAY_INFO (f));
2039 if (NILP (val) && FRAME_LIVE_P (f))
2041 Lisp_Object frame;
2042 XSETFRAME (frame, f);
2043 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol, target_type,
2044 time_stamp, frame));
2047 if (CONSP (val) && SYMBOLP (XCAR (val)))
2049 val = XCDR (val);
2050 if (CONSP (val) && NILP (XCDR (val)))
2051 val = XCAR (val);
2053 RETURN_UNGCPRO (clean_local_selection_data (val));
2056 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2057 Sx_disown_selection_internal, 1, 3, 0,
2058 doc: /* If we own the selection SELECTION, disown it.
2059 Disowning it means there is no such selection.
2061 Sets the last-change time for the selection to TIME-OBJECT (by default
2062 the time of the last event).
2064 TERMINAL should be a terminal object or a frame specifying the X
2065 server to query. If omitted or nil, that stands for the selected
2066 frame's display, or the first available X display.
2068 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2069 On MS-DOS, all this does is return non-nil if we own the selection. */)
2070 (Lisp_Object selection, Lisp_Object time_object, Lisp_Object terminal)
2072 Time timestamp;
2073 Atom selection_atom;
2074 union {
2075 struct selection_input_event sie;
2076 struct input_event ie;
2077 } event;
2078 struct frame *f = frame_for_x_selection (terminal);
2079 struct x_display_info *dpyinfo;
2081 if (!f)
2082 return Qnil;
2084 dpyinfo = FRAME_X_DISPLAY_INFO (f);
2085 CHECK_SYMBOL (selection);
2087 /* Don't disown the selection when we're not the owner. */
2088 if (NILP (LOCAL_SELECTION (selection, dpyinfo)))
2089 return Qnil;
2091 selection_atom = symbol_to_x_atom (dpyinfo, selection);
2093 BLOCK_INPUT;
2094 if (NILP (time_object))
2095 timestamp = last_event_timestamp;
2096 else
2097 CONS_TO_INTEGER (time_object, Time, timestamp);
2098 XSetSelectionOwner (dpyinfo->display, selection_atom, None, timestamp);
2099 UNBLOCK_INPUT;
2101 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2102 generated for a window which owns the selection when that window sets
2103 the selection owner to None. The NCD server does, the MIT Sun4 server
2104 doesn't. So we synthesize one; this means we might get two, but
2105 that's ok, because the second one won't have any effect. */
2106 SELECTION_EVENT_DISPLAY (&event.sie) = dpyinfo->display;
2107 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2108 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2109 x_handle_selection_clear (&event.ie);
2111 return Qt;
2114 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2115 0, 2, 0,
2116 doc: /* Whether the current Emacs process owns the given X Selection.
2117 The arg should be the name of the selection in question, typically one of
2118 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2119 \(Those are literal upper-case symbol names, since that's what X expects.)
2120 For convenience, the symbol nil is the same as `PRIMARY',
2121 and t is the same as `SECONDARY'.
2123 TERMINAL should be a terminal object or a frame specifying the X
2124 server to query. If omitted or nil, that stands for the selected
2125 frame's display, or the first available X display.
2127 On Nextstep, TERMINAL is unused. */)
2128 (Lisp_Object selection, Lisp_Object terminal)
2130 struct frame *f = frame_for_x_selection (terminal);
2132 CHECK_SYMBOL (selection);
2133 if (EQ (selection, Qnil)) selection = QPRIMARY;
2134 if (EQ (selection, Qt)) selection = QSECONDARY;
2136 if (f && !NILP (LOCAL_SELECTION (selection, FRAME_X_DISPLAY_INFO (f))))
2137 return Qt;
2138 else
2139 return Qnil;
2142 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2143 0, 2, 0,
2144 doc: /* Whether there is an owner for the given X selection.
2145 SELECTION should be the name of the selection in question, typically
2146 one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2147 `CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2148 symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
2150 TERMINAL should be a terminal object or a frame specifying the X
2151 server to query. If omitted or nil, that stands for the selected
2152 frame's display, or the first available X display.
2154 On Nextstep, TERMINAL is unused. */)
2155 (Lisp_Object selection, Lisp_Object terminal)
2157 Window owner;
2158 Atom atom;
2159 struct frame *f = frame_for_x_selection (terminal);
2160 struct x_display_info *dpyinfo;
2162 CHECK_SYMBOL (selection);
2163 if (EQ (selection, Qnil)) selection = QPRIMARY;
2164 if (EQ (selection, Qt)) selection = QSECONDARY;
2166 if (!f)
2167 return Qnil;
2169 dpyinfo = FRAME_X_DISPLAY_INFO (f);
2171 if (!NILP (LOCAL_SELECTION (selection, dpyinfo)))
2172 return Qt;
2174 atom = symbol_to_x_atom (dpyinfo, selection);
2175 if (atom == 0) return Qnil;
2176 BLOCK_INPUT;
2177 owner = XGetSelectionOwner (dpyinfo->display, atom);
2178 UNBLOCK_INPUT;
2179 return (owner ? Qt : Qnil);
2183 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2184 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2186 static Lisp_Object
2187 x_clipboard_manager_save (Lisp_Object frame)
2189 struct frame *f = XFRAME (frame);
2190 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2191 Atom data = dpyinfo->Xatom_UTF8_STRING;
2193 XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
2194 dpyinfo->Xatom_EMACS_TMP,
2195 dpyinfo->Xatom_ATOM, 32, PropModeReplace,
2196 (unsigned char *) &data, 1);
2197 x_get_foreign_selection (QCLIPBOARD_MANAGER, QSAVE_TARGETS,
2198 Qnil, frame);
2199 return Qt;
2202 /* Error handler for x_clipboard_manager_save_frame. */
2204 static Lisp_Object
2205 x_clipboard_manager_error_1 (Lisp_Object err)
2207 Lisp_Object args[2];
2208 args[0] = build_string ("X clipboard manager error: %s\n\
2209 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2210 args[1] = CAR (CDR (err));
2211 Fmessage (2, args);
2212 return Qnil;
2215 /* Error handler for x_clipboard_manager_save_all. */
2217 static Lisp_Object
2218 x_clipboard_manager_error_2 (Lisp_Object err)
2220 fprintf (stderr, "Error saving to X clipboard manager.\n\
2221 If the problem persists, set `x-select-enable-clipboard-manager' \
2222 to nil.\n");
2223 return Qnil;
2226 /* Called from delete_frame: save any clipboard owned by FRAME to the
2227 clipboard manager. Do nothing if FRAME does not own the clipboard,
2228 or if no clipboard manager is present. */
2230 void
2231 x_clipboard_manager_save_frame (Lisp_Object frame)
2233 struct frame *f;
2235 if (!NILP (Vx_select_enable_clipboard_manager)
2236 && FRAMEP (frame)
2237 && (f = XFRAME (frame), FRAME_X_P (f))
2238 && FRAME_LIVE_P (f))
2240 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2241 Lisp_Object local_selection
2242 = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2244 if (!NILP (local_selection)
2245 && EQ (frame, XCAR (XCDR (XCDR (XCDR (local_selection)))))
2246 && XGetSelectionOwner (dpyinfo->display,
2247 dpyinfo->Xatom_CLIPBOARD_MANAGER))
2248 internal_condition_case_1 (x_clipboard_manager_save, frame, Qt,
2249 x_clipboard_manager_error_1);
2253 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2254 clipboard manager. Do nothing if FRAME does not own the clipboard,
2255 or if no clipboard manager is present. */
2257 void
2258 x_clipboard_manager_save_all (void)
2260 /* Loop through all X displays, saving owned clipboards. */
2261 struct x_display_info *dpyinfo;
2262 Lisp_Object local_selection, local_frame;
2264 if (NILP (Vx_select_enable_clipboard_manager))
2265 return;
2267 for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
2269 local_selection = LOCAL_SELECTION (QCLIPBOARD, dpyinfo);
2270 if (NILP (local_selection)
2271 || !XGetSelectionOwner (dpyinfo->display,
2272 dpyinfo->Xatom_CLIPBOARD_MANAGER))
2273 continue;
2275 local_frame = XCAR (XCDR (XCDR (XCDR (local_selection))));
2276 if (FRAME_LIVE_P (XFRAME (local_frame)))
2278 Lisp_Object args[1];
2279 args[0] = build_string ("Saving clipboard to X clipboard manager...");
2280 Fmessage (1, args);
2282 internal_condition_case_1 (x_clipboard_manager_save, local_frame,
2283 Qt, x_clipboard_manager_error_2);
2289 /***********************************************************************
2290 Drag and drop support
2291 ***********************************************************************/
2292 /* Check that lisp values are of correct type for x_fill_property_data.
2293 That is, number, string or a cons with two numbers (low and high 16
2294 bit parts of a 32 bit number). Return the number of items in DATA,
2295 or -1 if there is an error. */
2298 x_check_property_data (Lisp_Object data)
2300 Lisp_Object iter;
2301 int size = 0;
2303 for (iter = data; CONSP (iter); iter = XCDR (iter))
2305 Lisp_Object o = XCAR (iter);
2307 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2308 return -1;
2309 else if (CONSP (o) &&
2310 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2311 return -1;
2312 if (size == INT_MAX)
2313 return -1;
2314 size++;
2317 return size;
2320 /* Convert lisp values to a C array. Values may be a number, a string
2321 which is taken as an X atom name and converted to the atom value, or
2322 a cons containing the two 16 bit parts of a 32 bit number.
2324 DPY is the display use to look up X atoms.
2325 DATA is a Lisp list of values to be converted.
2326 RET is the C array that contains the converted values. It is assumed
2327 it is big enough to hold all values.
2328 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2329 be stored in RET. Note that long is used for 32 even if long is more
2330 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2331 XClientMessageEvent). */
2333 void
2334 x_fill_property_data (Display *dpy, Lisp_Object data, void *ret, int format)
2336 long val;
2337 long *d32 = (long *) ret;
2338 short *d16 = (short *) ret;
2339 char *d08 = (char *) ret;
2340 Lisp_Object iter;
2342 for (iter = data; CONSP (iter); iter = XCDR (iter))
2344 Lisp_Object o = XCAR (iter);
2346 if (INTEGERP (o) || FLOATP (o) || CONSP (o))
2347 val = cons_to_signed (o, LONG_MIN, LONG_MAX);
2348 else if (STRINGP (o))
2350 BLOCK_INPUT;
2351 val = (long) XInternAtom (dpy, SSDATA (o), False);
2352 UNBLOCK_INPUT;
2354 else
2355 error ("Wrong type, must be string, number or cons");
2357 if (format == 8)
2359 if (CHAR_MIN <= val && val <= CHAR_MAX)
2360 *d08++ = val;
2361 else
2362 error ("Out of 'char' range");
2364 else if (format == 16)
2366 if (SHRT_MIN <= val && val <= SHRT_MAX)
2367 *d16++ = val;
2368 else
2369 error ("Out of 'short' range");
2371 else
2372 *d32++ = val;
2376 /* Convert an array of C values to a Lisp list.
2377 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2378 DATA is a C array of values to be converted.
2379 TYPE is the type of the data. Only XA_ATOM is special, it converts
2380 each number in DATA to its corresponding X atom as a symbol.
2381 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2382 be stored in RET.
2383 SIZE is the number of elements in DATA.
2385 Important: When format is 32, data should contain an array of int,
2386 not an array of long as the X library returns. This makes a difference
2387 when sizeof(long) != sizeof(int).
2389 Also see comment for selection_data_to_lisp_data above. */
2391 Lisp_Object
2392 x_property_data_to_lisp (struct frame *f, const unsigned char *data,
2393 Atom type, int format, long unsigned int size)
2395 ptrdiff_t format_bytes = format >> 3;
2396 if (PTRDIFF_MAX / format_bytes < size)
2397 memory_full (SIZE_MAX);
2398 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2399 data, size * format_bytes, type, format);
2402 /* Get the mouse position in frame relative coordinates. */
2404 static void
2405 mouse_position_for_drop (FRAME_PTR f, int *x, int *y)
2407 Window root, dummy_window;
2408 int dummy;
2410 BLOCK_INPUT;
2412 XQueryPointer (FRAME_X_DISPLAY (f),
2413 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2415 /* The root window which contains the pointer. */
2416 &root,
2418 /* Window pointer is on, not used */
2419 &dummy_window,
2421 /* The position on that root window. */
2422 x, y,
2424 /* x/y in dummy_window coordinates, not used. */
2425 &dummy, &dummy,
2427 /* Modifier keys and pointer buttons, about which
2428 we don't care. */
2429 (unsigned int *) &dummy);
2432 /* Absolute to relative. */
2433 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2434 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2436 UNBLOCK_INPUT;
2439 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2440 Sx_get_atom_name, 1, 2, 0,
2441 doc: /* Return the X atom name for VALUE as a string.
2442 VALUE may be a number or a cons where the car is the upper 16 bits and
2443 the cdr is the lower 16 bits of a 32 bit value.
2444 Use the display for FRAME or the current frame if FRAME is not given or nil.
2446 If the value is 0 or the atom is not known, return the empty string. */)
2447 (Lisp_Object value, Lisp_Object frame)
2449 struct frame *f = check_x_frame (frame);
2450 char *name = 0;
2451 char empty[] = "";
2452 Lisp_Object ret = Qnil;
2453 Display *dpy = FRAME_X_DISPLAY (f);
2454 Atom atom;
2455 int had_errors;
2457 CONS_TO_INTEGER (value, Atom, atom);
2459 BLOCK_INPUT;
2460 x_catch_errors (dpy);
2461 name = atom ? XGetAtomName (dpy, atom) : empty;
2462 had_errors = x_had_errors_p (dpy);
2463 x_uncatch_errors ();
2465 if (!had_errors)
2466 ret = build_string (name);
2468 if (atom && name) XFree (name);
2469 if (NILP (ret)) ret = empty_unibyte_string;
2471 UNBLOCK_INPUT;
2473 return ret;
2476 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
2477 Sx_register_dnd_atom, 1, 2, 0,
2478 doc: /* Request that dnd events are made for ClientMessages with ATOM.
2479 ATOM can be a symbol or a string. The ATOM is interned on the display that
2480 FRAME is on. If FRAME is nil, the selected frame is used. */)
2481 (Lisp_Object atom, Lisp_Object frame)
2483 Atom x_atom;
2484 struct frame *f = check_x_frame (frame);
2485 ptrdiff_t i;
2486 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2489 if (SYMBOLP (atom))
2490 x_atom = symbol_to_x_atom (dpyinfo, atom);
2491 else if (STRINGP (atom))
2493 BLOCK_INPUT;
2494 x_atom = XInternAtom (FRAME_X_DISPLAY (f), SSDATA (atom), False);
2495 UNBLOCK_INPUT;
2497 else
2498 error ("ATOM must be a symbol or a string");
2500 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2501 if (dpyinfo->x_dnd_atoms[i] == x_atom)
2502 return Qnil;
2504 if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
2505 dpyinfo->x_dnd_atoms =
2506 xpalloc (dpyinfo->x_dnd_atoms, &dpyinfo->x_dnd_atoms_size,
2507 1, -1, sizeof *dpyinfo->x_dnd_atoms);
2509 dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
2510 return Qnil;
2513 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2516 x_handle_dnd_message (struct frame *f, XClientMessageEvent *event,
2517 struct x_display_info *dpyinfo, struct input_event *bufp)
2519 Lisp_Object vec;
2520 Lisp_Object frame;
2521 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2522 unsigned long size = 160/event->format;
2523 int x, y;
2524 unsigned char *data = (unsigned char *) event->data.b;
2525 int idata[5];
2526 ptrdiff_t i;
2528 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2529 if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
2531 if (i == dpyinfo->x_dnd_atoms_length) return 0;
2533 XSETFRAME (frame, f);
2535 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2536 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2537 function expects them to be of size int (i.e. 32). So to be able to
2538 use that function, put the data in the form it expects if format is 32. */
2540 if (32 < BITS_PER_LONG && event->format == 32)
2542 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2543 idata[i] = event->data.l[i];
2544 data = (unsigned char *) idata;
2547 vec = Fmake_vector (make_number (4), Qnil);
2548 ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2549 event->message_type)));
2550 ASET (vec, 1, frame);
2551 ASET (vec, 2, make_number (event->format));
2552 ASET (vec, 3, x_property_data_to_lisp (f,
2553 data,
2554 event->message_type,
2555 event->format,
2556 size));
2558 mouse_position_for_drop (f, &x, &y);
2559 bufp->kind = DRAG_N_DROP_EVENT;
2560 bufp->frame_or_window = frame;
2561 bufp->timestamp = CurrentTime;
2562 bufp->x = make_number (x);
2563 bufp->y = make_number (y);
2564 bufp->arg = vec;
2565 bufp->modifiers = 0;
2567 return 1;
2570 DEFUN ("x-send-client-message", Fx_send_client_event,
2571 Sx_send_client_message, 6, 6, 0,
2572 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2574 For DISPLAY, specify either a frame or a display name (a string).
2575 If DISPLAY is nil, that stands for the selected frame's display.
2576 DEST may be a number, in which case it is a Window id. The value 0 may
2577 be used to send to the root window of the DISPLAY.
2578 If DEST is a cons, it is converted to a 32 bit number
2579 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2580 number is then used as a window id.
2581 If DEST is a frame the event is sent to the outer window of that frame.
2582 A value of nil means the currently selected frame.
2583 If DEST is the string "PointerWindow" the event is sent to the window that
2584 contains the pointer. If DEST is the string "InputFocus" the event is
2585 sent to the window that has the input focus.
2586 FROM is the frame sending the event. Use nil for currently selected frame.
2587 MESSAGE-TYPE is the name of an Atom as a string.
2588 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2589 bits. VALUES is a list of numbers, cons and/or strings containing the values
2590 to send. If a value is a string, it is converted to an Atom and the value of
2591 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2592 with the high 16 bits from the car and the lower 16 bit from the cdr.
2593 If more values than fits into the event is given, the excessive values
2594 are ignored. */)
2595 (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2596 Lisp_Object message_type, Lisp_Object format, Lisp_Object values)
2598 struct x_display_info *dpyinfo = check_x_display_info (display);
2600 CHECK_STRING (message_type);
2601 x_send_client_event (display, dest, from,
2602 XInternAtom (dpyinfo->display,
2603 SSDATA (message_type),
2604 False),
2605 format, values);
2607 return Qnil;
2610 void
2611 x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from,
2612 Atom message_type, Lisp_Object format, Lisp_Object values)
2614 struct x_display_info *dpyinfo = check_x_display_info (display);
2615 Window wdest;
2616 XEvent event;
2617 struct frame *f = check_x_frame (from);
2618 int to_root;
2620 CHECK_NUMBER (format);
2621 CHECK_CONS (values);
2623 if (x_check_property_data (values) == -1)
2624 error ("Bad data in VALUES, must be number, cons or string");
2626 event.xclient.type = ClientMessage;
2627 event.xclient.format = XFASTINT (format);
2629 if (event.xclient.format != 8 && event.xclient.format != 16
2630 && event.xclient.format != 32)
2631 error ("FORMAT must be one of 8, 16 or 32");
2633 if (FRAMEP (dest) || NILP (dest))
2635 struct frame *fdest = check_x_frame (dest);
2636 wdest = FRAME_OUTER_WINDOW (fdest);
2638 else if (STRINGP (dest))
2640 if (strcmp (SSDATA (dest), "PointerWindow") == 0)
2641 wdest = PointerWindow;
2642 else if (strcmp (SSDATA (dest), "InputFocus") == 0)
2643 wdest = InputFocus;
2644 else
2645 error ("DEST as a string must be one of PointerWindow or InputFocus");
2647 else if (INTEGERP (dest) || FLOATP (dest) || CONSP (dest))
2648 CONS_TO_INTEGER (dest, Window, wdest);
2649 else
2650 error ("DEST must be a frame, nil, string, number or cons");
2652 if (wdest == 0) wdest = dpyinfo->root_window;
2653 to_root = wdest == dpyinfo->root_window;
2655 BLOCK_INPUT;
2657 event.xclient.message_type = message_type;
2658 event.xclient.display = dpyinfo->display;
2660 /* Some clients (metacity for example) expects sending window to be here
2661 when sending to the root window. */
2662 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2665 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2666 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2667 event.xclient.format);
2669 /* If event mask is 0 the event is sent to the client that created
2670 the destination window. But if we are sending to the root window,
2671 there is no such client. Then we set the event mask to 0xffff. The
2672 event then goes to clients selecting for events on the root window. */
2673 x_catch_errors (dpyinfo->display);
2675 int propagate = to_root ? False : True;
2676 unsigned mask = to_root ? 0xffff : 0;
2677 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2678 XFlush (dpyinfo->display);
2680 x_uncatch_errors ();
2681 UNBLOCK_INPUT;
2685 void
2686 syms_of_xselect (void)
2688 defsubr (&Sx_get_selection_internal);
2689 defsubr (&Sx_own_selection_internal);
2690 defsubr (&Sx_disown_selection_internal);
2691 defsubr (&Sx_selection_owner_p);
2692 defsubr (&Sx_selection_exists_p);
2694 defsubr (&Sx_get_atom_name);
2695 defsubr (&Sx_send_client_message);
2696 defsubr (&Sx_register_dnd_atom);
2698 reading_selection_reply = Fcons (Qnil, Qnil);
2699 staticpro (&reading_selection_reply);
2700 reading_selection_window = 0;
2701 reading_which_selection = 0;
2703 property_change_wait_list = 0;
2704 prop_location_identifier = 0;
2705 property_change_reply = Fcons (Qnil, Qnil);
2706 staticpro (&property_change_reply);
2708 converted_selections = NULL;
2709 conversion_fail_tag = None;
2711 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist,
2712 doc: /* An alist associating X Windows selection-types with functions.
2713 These functions are called to convert the selection, with three args:
2714 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2715 a desired type to which the selection should be converted;
2716 and the local selection value (whatever was given to `x-own-selection').
2718 The function should return the value to send to the X server
2719 \(typically a string). A return value of nil
2720 means that the conversion could not be done.
2721 A return value which is the symbol `NULL'
2722 means that a side-effect was executed,
2723 and there is no meaningful selection value. */);
2724 Vselection_converter_alist = Qnil;
2726 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions,
2727 doc: /* A list of functions to be called when Emacs loses an X selection.
2728 \(This happens when some other X client makes its own selection
2729 or when a Lisp program explicitly clears the selection.)
2730 The functions are called with one argument, the selection type
2731 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2732 Vx_lost_selection_functions = Qnil;
2734 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions,
2735 doc: /* A list of functions to be called when Emacs answers a selection request.
2736 The functions are called with three arguments:
2737 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2738 - the selection-type which Emacs was asked to convert the
2739 selection into before sending (for example, `STRING' or `LENGTH');
2740 - a flag indicating success or failure for responding to the request.
2741 We might have failed (and declined the request) for any number of reasons,
2742 including being asked for a selection that we no longer own, or being asked
2743 to convert into a type that we don't know about or that is inappropriate.
2744 This hook doesn't let you change the behavior of Emacs's selection replies,
2745 it merely informs you that they have happened. */);
2746 Vx_sent_selection_functions = Qnil;
2748 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2749 Vx_select_enable_clipboard_manager,
2750 doc: /* Whether to enable X clipboard manager support.
2751 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2752 while owning the X clipboard, the clipboard contents are saved to the
2753 clipboard manager if one is present. */);
2754 Vx_select_enable_clipboard_manager = Qt;
2756 DEFVAR_INT ("x-selection-timeout", x_selection_timeout,
2757 doc: /* Number of milliseconds to wait for a selection reply.
2758 If the selection owner doesn't reply in this time, we give up.
2759 A value of 0 means wait as long as necessary. This is initialized from the
2760 \"*selectionTimeout\" resource. */);
2761 x_selection_timeout = 0;
2763 /* QPRIMARY is defined in keyboard.c. */
2764 DEFSYM (QSECONDARY, "SECONDARY");
2765 DEFSYM (QSTRING, "STRING");
2766 DEFSYM (QINTEGER, "INTEGER");
2767 DEFSYM (QCLIPBOARD, "CLIPBOARD");
2768 DEFSYM (QTIMESTAMP, "TIMESTAMP");
2769 DEFSYM (QTEXT, "TEXT");
2770 DEFSYM (QCOMPOUND_TEXT, "COMPOUND_TEXT");
2771 DEFSYM (QUTF8_STRING, "UTF8_STRING");
2772 DEFSYM (QDELETE, "DELETE");
2773 DEFSYM (QMULTIPLE, "MULTIPLE");
2774 DEFSYM (QINCR, "INCR");
2775 DEFSYM (QEMACS_TMP, "_EMACS_TMP_");
2776 DEFSYM (QTARGETS, "TARGETS");
2777 DEFSYM (QATOM, "ATOM");
2778 DEFSYM (QATOM_PAIR, "ATOM_PAIR");
2779 DEFSYM (QCLIPBOARD_MANAGER, "CLIPBOARD_MANAGER");
2780 DEFSYM (QSAVE_TARGETS, "SAVE_TARGETS");
2781 DEFSYM (QNULL, "NULL");
2782 DEFSYM (Qcompound_text_with_extensions, "compound-text-with-extensions");
2783 DEFSYM (Qforeign_selection, "foreign-selection");
2784 DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions");
2785 DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions");