(gdb-location-list): New variable.
[emacs.git] / src / xselect.c
blobf54e685873a162cef0020c80a030d82c52eefb7a
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004
3 Free Software Foundation.
5 This file is part of GNU Emacs.
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 2, or (at your option)
10 any later version.
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.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Rewritten by jwz */
25 #include <config.h>
26 #include <stdio.h> /* termhooks.h needs this */
28 #ifdef HAVE_SYS_TYPES_H
29 #include <sys/types.h>
30 #endif
31 #ifdef HAVE_UNISTD_H
32 #include <unistd.h>
33 #endif
35 #include "lisp.h"
36 #include "xterm.h" /* for all of the X includes */
37 #include "dispextern.h" /* frame.h seems to want this */
38 #include "frame.h" /* Need this to get the X window of selected_frame */
39 #include "blockinput.h"
40 #include "buffer.h"
41 #include "process.h"
42 #include "termhooks.h"
43 #include "keyboard.h"
45 #include <X11/Xproto.h>
47 struct prop_location;
49 static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
50 static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
51 Lisp_Object));
52 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
53 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
54 static void x_decline_selection_request P_ ((struct input_event *));
55 static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
56 static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
57 static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
58 static void x_reply_selection_request P_ ((struct input_event *, int,
59 unsigned char *, int, Atom));
60 static int waiting_for_other_props_on_window P_ ((Display *, Window));
61 static struct prop_location *expect_property_change P_ ((Display *, Window,
62 Atom, int));
63 static void unexpect_property_change P_ ((struct prop_location *));
64 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
65 static void wait_for_property_change P_ ((struct prop_location *));
66 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
67 Lisp_Object,
68 Lisp_Object));
69 static void x_get_window_property P_ ((Display *, Window, Atom,
70 unsigned char **, int *,
71 Atom *, int *, unsigned long *, int));
72 static void receive_incremental_selection P_ ((Display *, Window, Atom,
73 Lisp_Object, unsigned,
74 unsigned char **, int *,
75 Atom *, int *, unsigned long *));
76 static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
77 Window, Atom,
78 Lisp_Object, Atom));
79 static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
80 int, Atom, int));
81 static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
82 unsigned char **, Atom *,
83 unsigned *, int *, int *));
84 static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
85 static void initialize_cut_buffers P_ ((Display *, Window));
88 /* Printing traces to stderr. */
90 #ifdef TRACE_SELECTION
91 #define TRACE0(fmt) \
92 fprintf (stderr, "%d: " fmt "\n", getpid ())
93 #define TRACE1(fmt, a0) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
95 #define TRACE2(fmt, a0, a1) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
97 #define TRACE3(fmt, a0, a1, a2) \
98 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
99 #else
100 #define TRACE0(fmt) (void) 0
101 #define TRACE1(fmt, a0) (void) 0
102 #define TRACE2(fmt, a0, a1) (void) 0
103 #define TRACE3(fmt, a0, a1) (void) 0
104 #endif
107 #define CUT_BUFFER_SUPPORT
109 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
110 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
111 QATOM_PAIR;
113 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
114 Lisp_Object QUTF8_STRING; /* This is a type of selection. */
116 Lisp_Object Qcompound_text_with_extensions;
118 #ifdef CUT_BUFFER_SUPPORT
119 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
120 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
121 #endif
123 static Lisp_Object Vx_lost_selection_functions;
124 static Lisp_Object Vx_sent_selection_functions;
125 /* Coding system for communicating with other X clients via cutbuffer,
126 selection, and clipboard. */
127 static Lisp_Object Vselection_coding_system;
129 /* Coding system for the next communicating with other X clients. */
130 static Lisp_Object Vnext_selection_coding_system;
132 static Lisp_Object Qforeign_selection;
134 /* If this is a smaller number than the max-request-size of the display,
135 emacs will use INCR selection transfer when the selection is larger
136 than this. The max-request-size is usually around 64k, so if you want
137 emacs to use incremental selection transfers when the selection is
138 smaller than that, set this. I added this mostly for debugging the
139 incremental transfer stuff, but it might improve server performance. */
140 #define MAX_SELECTION_QUANTUM 0xFFFFFF
142 #ifdef HAVE_X11R4
143 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
144 #else
145 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
146 #endif
148 /* The timestamp of the last input event Emacs received from the X server. */
149 /* Defined in keyboard.c. */
150 extern unsigned long last_event_timestamp;
152 /* This is an association list whose elements are of the form
153 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
154 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
155 SELECTION-VALUE is the value that emacs owns for that selection.
156 It may be any kind of Lisp object.
157 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
158 as a cons of two 16-bit numbers (making a 32 bit time.)
159 FRAME is the frame for which we made the selection.
160 If there is an entry in this alist, then it can be assumed that Emacs owns
161 that selection.
162 The only (eq) parts of this list that are visible from Lisp are the
163 selection-values. */
164 static Lisp_Object Vselection_alist;
166 /* This is an alist whose CARs are selection-types (whose names are the same
167 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
168 call to convert the given Emacs selection value to a string representing
169 the given selection type. This is for Lisp-level extension of the emacs
170 selection handling. */
171 static Lisp_Object Vselection_converter_alist;
173 /* If the selection owner takes too long to reply to a selection request,
174 we give up on it. This is in milliseconds (0 = no timeout.) */
175 static EMACS_INT x_selection_timeout;
179 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
180 handling. */
182 struct selection_event_queue
184 struct input_event event;
185 struct selection_event_queue *next;
188 static struct selection_event_queue *selection_queue;
190 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
192 static int x_queue_selection_requests;
194 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
196 static void
197 x_queue_event (event)
198 struct input_event *event;
200 struct selection_event_queue *queue_tmp;
202 /* Don't queue repeated requests.
203 This only happens for large requests which uses the incremental protocol. */
204 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
206 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
208 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
209 x_decline_selection_request (event);
210 return;
214 queue_tmp
215 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
217 if (queue_tmp != NULL)
219 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
220 queue_tmp->event = *event;
221 queue_tmp->next = selection_queue;
222 selection_queue = queue_tmp;
226 /* Start queuing SELECTION_REQUEST_EVENT events. */
228 static void
229 x_start_queuing_selection_requests ()
231 if (x_queue_selection_requests)
232 abort ();
234 x_queue_selection_requests++;
235 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
238 /* Stop queuing SELECTION_REQUEST_EVENT events. */
240 static void
241 x_stop_queuing_selection_requests ()
243 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
244 --x_queue_selection_requests;
246 /* Take all the queued events and put them back
247 so that they get processed afresh. */
249 while (selection_queue != NULL)
251 struct selection_event_queue *queue_tmp = selection_queue;
252 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
253 kbd_buffer_unget_event (&queue_tmp->event);
254 selection_queue = queue_tmp->next;
255 xfree ((char *)queue_tmp);
260 /* This converts a Lisp symbol to a server Atom, avoiding a server
261 roundtrip whenever possible. */
263 static Atom
264 symbol_to_x_atom (dpyinfo, display, sym)
265 struct x_display_info *dpyinfo;
266 Display *display;
267 Lisp_Object sym;
269 Atom val;
270 if (NILP (sym)) return 0;
271 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
272 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
273 if (EQ (sym, QSTRING)) return XA_STRING;
274 if (EQ (sym, QINTEGER)) return XA_INTEGER;
275 if (EQ (sym, QATOM)) return XA_ATOM;
276 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
277 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
278 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
279 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
280 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
281 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
282 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
283 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
284 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
285 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
286 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
287 #ifdef CUT_BUFFER_SUPPORT
288 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
289 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
290 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
291 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
292 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
293 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
294 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
295 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
296 #endif
297 if (!SYMBOLP (sym)) abort ();
299 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
300 BLOCK_INPUT;
301 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
302 UNBLOCK_INPUT;
303 return val;
307 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
308 and calls to intern whenever possible. */
310 static Lisp_Object
311 x_atom_to_symbol (dpy, atom)
312 Display *dpy;
313 Atom atom;
315 struct x_display_info *dpyinfo;
316 char *str;
317 Lisp_Object val;
319 if (! atom)
320 return Qnil;
322 switch (atom)
324 case XA_PRIMARY:
325 return QPRIMARY;
326 case XA_SECONDARY:
327 return QSECONDARY;
328 case XA_STRING:
329 return QSTRING;
330 case XA_INTEGER:
331 return QINTEGER;
332 case XA_ATOM:
333 return QATOM;
334 #ifdef CUT_BUFFER_SUPPORT
335 case XA_CUT_BUFFER0:
336 return QCUT_BUFFER0;
337 case XA_CUT_BUFFER1:
338 return QCUT_BUFFER1;
339 case XA_CUT_BUFFER2:
340 return QCUT_BUFFER2;
341 case XA_CUT_BUFFER3:
342 return QCUT_BUFFER3;
343 case XA_CUT_BUFFER4:
344 return QCUT_BUFFER4;
345 case XA_CUT_BUFFER5:
346 return QCUT_BUFFER5;
347 case XA_CUT_BUFFER6:
348 return QCUT_BUFFER6;
349 case XA_CUT_BUFFER7:
350 return QCUT_BUFFER7;
351 #endif
354 dpyinfo = x_display_info_for_display (dpy);
355 if (atom == dpyinfo->Xatom_CLIPBOARD)
356 return QCLIPBOARD;
357 if (atom == dpyinfo->Xatom_TIMESTAMP)
358 return QTIMESTAMP;
359 if (atom == dpyinfo->Xatom_TEXT)
360 return QTEXT;
361 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
362 return QCOMPOUND_TEXT;
363 if (atom == dpyinfo->Xatom_UTF8_STRING)
364 return QUTF8_STRING;
365 if (atom == dpyinfo->Xatom_DELETE)
366 return QDELETE;
367 if (atom == dpyinfo->Xatom_MULTIPLE)
368 return QMULTIPLE;
369 if (atom == dpyinfo->Xatom_INCR)
370 return QINCR;
371 if (atom == dpyinfo->Xatom_EMACS_TMP)
372 return QEMACS_TMP;
373 if (atom == dpyinfo->Xatom_TARGETS)
374 return QTARGETS;
375 if (atom == dpyinfo->Xatom_NULL)
376 return QNULL;
378 BLOCK_INPUT;
379 str = XGetAtomName (dpy, atom);
380 UNBLOCK_INPUT;
381 TRACE1 ("XGetAtomName --> %s", str);
382 if (! str) return Qnil;
383 val = intern (str);
384 BLOCK_INPUT;
385 /* This was allocated by Xlib, so use XFree. */
386 XFree (str);
387 UNBLOCK_INPUT;
388 return val;
391 /* Do protocol to assert ourself as a selection owner.
392 Update the Vselection_alist so that we can reply to later requests for
393 our selection. */
395 static void
396 x_own_selection (selection_name, selection_value)
397 Lisp_Object selection_name, selection_value;
399 struct frame *sf = SELECTED_FRAME ();
400 Window selecting_window = FRAME_X_WINDOW (sf);
401 Display *display = FRAME_X_DISPLAY (sf);
402 Time time = last_event_timestamp;
403 Atom selection_atom;
404 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
405 int count;
407 CHECK_SYMBOL (selection_name);
408 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
410 BLOCK_INPUT;
411 count = x_catch_errors (display);
412 XSetSelectionOwner (display, selection_atom, selecting_window, time);
413 x_check_errors (display, "Can't set selection: %s");
414 x_uncatch_errors (display, count);
415 UNBLOCK_INPUT;
417 /* Now update the local cache */
419 Lisp_Object selection_time;
420 Lisp_Object selection_data;
421 Lisp_Object prev_value;
423 selection_time = long_to_cons ((unsigned long) time);
424 selection_data = Fcons (selection_name,
425 Fcons (selection_value,
426 Fcons (selection_time,
427 Fcons (selected_frame, Qnil))));
428 prev_value = assq_no_quit (selection_name, Vselection_alist);
430 Vselection_alist = Fcons (selection_data, Vselection_alist);
432 /* If we already owned the selection, remove the old selection data.
433 Perhaps we should destructively modify it instead.
434 Don't use Fdelq as that may QUIT. */
435 if (!NILP (prev_value))
437 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
438 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
439 if (EQ (prev_value, Fcar (XCDR (rest))))
441 XSETCDR (rest, Fcdr (XCDR (rest)));
442 break;
448 /* Given a selection-name and desired type, look up our local copy of
449 the selection value and convert it to the type.
450 The value is nil or a string.
451 This function is used both for remote requests (LOCAL_REQUEST is zero)
452 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
454 This calls random Lisp code, and may signal or gc. */
456 static Lisp_Object
457 x_get_local_selection (selection_symbol, target_type, local_request)
458 Lisp_Object selection_symbol, target_type;
459 int local_request;
461 Lisp_Object local_value;
462 Lisp_Object handler_fn, value, type, check;
463 int count;
465 local_value = assq_no_quit (selection_symbol, Vselection_alist);
467 if (NILP (local_value)) return Qnil;
469 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
470 if (EQ (target_type, QTIMESTAMP))
472 handler_fn = Qnil;
473 value = XCAR (XCDR (XCDR (local_value)));
475 #if 0
476 else if (EQ (target_type, QDELETE))
478 handler_fn = Qnil;
479 Fx_disown_selection_internal
480 (selection_symbol,
481 XCAR (XCDR (XCDR (local_value))));
482 value = QNULL;
484 #endif
486 #if 0 /* #### MULTIPLE doesn't work yet */
487 else if (CONSP (target_type)
488 && XCAR (target_type) == QMULTIPLE)
490 Lisp_Object pairs;
491 int size;
492 int i;
493 pairs = XCDR (target_type);
494 size = XVECTOR (pairs)->size;
495 /* If the target is MULTIPLE, then target_type looks like
496 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
497 We modify the second element of each pair in the vector and
498 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
500 for (i = 0; i < size; i++)
502 Lisp_Object pair;
503 pair = XVECTOR (pairs)->contents [i];
504 XVECTOR (pair)->contents [1]
505 = x_get_local_selection (XVECTOR (pair)->contents [0],
506 XVECTOR (pair)->contents [1],
507 local_request);
509 return pairs;
511 #endif
512 else
514 /* Don't allow a quit within the converter.
515 When the user types C-g, he would be surprised
516 if by luck it came during a converter. */
517 count = SPECPDL_INDEX ();
518 specbind (Qinhibit_quit, Qt);
520 CHECK_SYMBOL (target_type);
521 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
522 /* gcpro is not needed here since nothing but HANDLER_FN
523 is live, and that ought to be a symbol. */
525 if (!NILP (handler_fn))
526 value = call3 (handler_fn,
527 selection_symbol, (local_request ? Qnil : target_type),
528 XCAR (XCDR (local_value)));
529 else
530 value = Qnil;
531 unbind_to (count, Qnil);
534 /* Make sure this value is of a type that we could transmit
535 to another X client. */
537 check = value;
538 if (CONSP (value)
539 && SYMBOLP (XCAR (value)))
540 type = XCAR (value),
541 check = XCDR (value);
543 if (STRINGP (check)
544 || VECTORP (check)
545 || SYMBOLP (check)
546 || INTEGERP (check)
547 || NILP (value))
548 return value;
549 /* Check for a value that cons_to_long could handle. */
550 else if (CONSP (check)
551 && INTEGERP (XCAR (check))
552 && (INTEGERP (XCDR (check))
554 (CONSP (XCDR (check))
555 && INTEGERP (XCAR (XCDR (check)))
556 && NILP (XCDR (XCDR (check))))))
557 return value;
558 else
559 return
560 Fsignal (Qerror,
561 Fcons (build_string ("invalid data returned by selection-conversion function"),
562 Fcons (handler_fn, Fcons (value, Qnil))));
565 /* Subroutines of x_reply_selection_request. */
567 /* Send a SelectionNotify event to the requestor with property=None,
568 meaning we were unable to do what they wanted. */
570 static void
571 x_decline_selection_request (event)
572 struct input_event *event;
574 XSelectionEvent reply;
575 int count;
577 reply.type = SelectionNotify;
578 reply.display = SELECTION_EVENT_DISPLAY (event);
579 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
580 reply.selection = SELECTION_EVENT_SELECTION (event);
581 reply.time = SELECTION_EVENT_TIME (event);
582 reply.target = SELECTION_EVENT_TARGET (event);
583 reply.property = None;
585 /* The reason for the error may be that the receiver has
586 died in the meantime. Handle that case. */
587 BLOCK_INPUT;
588 count = x_catch_errors (reply.display);
589 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
590 XFlush (reply.display);
591 x_uncatch_errors (reply.display, count);
592 UNBLOCK_INPUT;
595 /* This is the selection request currently being processed.
596 It is set to zero when the request is fully processed. */
597 static struct input_event *x_selection_current_request;
599 /* Display info in x_selection_request. */
601 static struct x_display_info *selection_request_dpyinfo;
603 /* Used as an unwind-protect clause so that, if a selection-converter signals
604 an error, we tell the requester that we were unable to do what they wanted
605 before we throw to top-level or go into the debugger or whatever. */
607 static Lisp_Object
608 x_selection_request_lisp_error (ignore)
609 Lisp_Object ignore;
611 if (x_selection_current_request != 0
612 && selection_request_dpyinfo->display)
613 x_decline_selection_request (x_selection_current_request);
614 return Qnil;
618 /* This stuff is so that INCR selections are reentrant (that is, so we can
619 be servicing multiple INCR selection requests simultaneously.) I haven't
620 actually tested that yet. */
622 /* Keep a list of the property changes that are awaited. */
624 struct prop_location
626 int identifier;
627 Display *display;
628 Window window;
629 Atom property;
630 int desired_state;
631 int arrived;
632 struct prop_location *next;
635 static struct prop_location *expect_property_change ();
636 static void wait_for_property_change ();
637 static void unexpect_property_change ();
638 static int waiting_for_other_props_on_window ();
640 static int prop_location_identifier;
642 static Lisp_Object property_change_reply;
644 static struct prop_location *property_change_reply_object;
646 static struct prop_location *property_change_wait_list;
648 static Lisp_Object
649 queue_selection_requests_unwind (tem)
650 Lisp_Object tem;
652 x_stop_queuing_selection_requests ();
653 return Qnil;
656 /* Return some frame whose display info is DPYINFO.
657 Return nil if there is none. */
659 static Lisp_Object
660 some_frame_on_display (dpyinfo)
661 struct x_display_info *dpyinfo;
663 Lisp_Object list, frame;
665 FOR_EACH_FRAME (list, frame)
667 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
668 return frame;
671 return Qnil;
674 /* Send the reply to a selection request event EVENT.
675 TYPE is the type of selection data requested.
676 DATA and SIZE describe the data to send, already converted.
677 FORMAT is the unit-size (in bits) of the data to be transmitted. */
679 static void
680 x_reply_selection_request (event, format, data, size, type)
681 struct input_event *event;
682 int format, size;
683 unsigned char *data;
684 Atom type;
686 XSelectionEvent reply;
687 Display *display = SELECTION_EVENT_DISPLAY (event);
688 Window window = SELECTION_EVENT_REQUESTOR (event);
689 int bytes_remaining;
690 int format_bytes = format/8;
691 int max_bytes = SELECTION_QUANTUM (display);
692 struct x_display_info *dpyinfo = x_display_info_for_display (display);
693 int count;
695 if (max_bytes > MAX_SELECTION_QUANTUM)
696 max_bytes = MAX_SELECTION_QUANTUM;
698 reply.type = SelectionNotify;
699 reply.display = display;
700 reply.requestor = window;
701 reply.selection = SELECTION_EVENT_SELECTION (event);
702 reply.time = SELECTION_EVENT_TIME (event);
703 reply.target = SELECTION_EVENT_TARGET (event);
704 reply.property = SELECTION_EVENT_PROPERTY (event);
705 if (reply.property == None)
706 reply.property = reply.target;
708 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
709 BLOCK_INPUT;
710 count = x_catch_errors (display);
712 #ifdef TRACE_SELECTION
714 static int cnt;
715 char *sel = XGetAtomName (display, reply.selection);
716 char *tgt = XGetAtomName (display, reply.target);
717 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
718 if (sel) XFree (sel);
719 if (tgt) XFree (tgt);
721 #endif /* TRACE_SELECTION */
723 /* Store the data on the requested property.
724 If the selection is large, only store the first N bytes of it.
726 bytes_remaining = size * format_bytes;
727 if (bytes_remaining <= max_bytes)
729 /* Send all the data at once, with minimal handshaking. */
730 TRACE1 ("Sending all %d bytes", bytes_remaining);
731 XChangeProperty (display, window, reply.property, type, format,
732 PropModeReplace, data, size);
733 /* At this point, the selection was successfully stored; ack it. */
734 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
736 else
738 /* Send an INCR selection. */
739 struct prop_location *wait_object;
740 int had_errors;
741 Lisp_Object frame;
743 frame = some_frame_on_display (dpyinfo);
745 /* If the display no longer has frames, we can't expect
746 to get many more selection requests from it, so don't
747 bother trying to queue them. */
748 if (!NILP (frame))
750 x_start_queuing_selection_requests ();
752 record_unwind_protect (queue_selection_requests_unwind,
753 Qnil);
756 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
757 error ("Attempt to transfer an INCR to ourself!");
759 TRACE2 ("Start sending %d bytes incrementally (%s)",
760 bytes_remaining, XGetAtomName (display, reply.property));
761 wait_object = expect_property_change (display, window, reply.property,
762 PropertyDelete);
764 TRACE1 ("Set %s to number of bytes to send",
765 XGetAtomName (display, reply.property));
767 /* XChangeProperty expects an array of long even if long is more than
768 32 bits. */
769 long value[1];
771 value[0] = bytes_remaining;
772 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
773 32, PropModeReplace,
774 (unsigned char *) value, 1);
777 XSelectInput (display, window, PropertyChangeMask);
779 /* Tell 'em the INCR data is there... */
780 TRACE0 ("Send SelectionNotify event");
781 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
782 XFlush (display);
784 had_errors = x_had_errors_p (display);
785 UNBLOCK_INPUT;
787 /* First, wait for the requester to ack by deleting the property.
788 This can run random lisp code (process handlers) or signal. */
789 if (! had_errors)
791 TRACE1 ("Waiting for ACK (deletion of %s)",
792 XGetAtomName (display, reply.property));
793 wait_for_property_change (wait_object);
795 else
796 unexpect_property_change (wait_object);
798 TRACE0 ("Got ACK");
799 while (bytes_remaining)
801 int i = ((bytes_remaining < max_bytes)
802 ? bytes_remaining
803 : max_bytes);
805 BLOCK_INPUT;
807 wait_object
808 = expect_property_change (display, window, reply.property,
809 PropertyDelete);
811 TRACE1 ("Sending increment of %d bytes", i);
812 TRACE1 ("Set %s to increment data",
813 XGetAtomName (display, reply.property));
815 /* Append the next chunk of data to the property. */
816 XChangeProperty (display, window, reply.property, type, format,
817 PropModeAppend, data, i / format_bytes);
818 bytes_remaining -= i;
819 data += i;
820 XFlush (display);
821 had_errors = x_had_errors_p (display);
822 UNBLOCK_INPUT;
824 if (had_errors)
825 break;
827 /* Now wait for the requester to ack this chunk by deleting the
828 property. This can run random lisp code or signal. */
829 TRACE1 ("Waiting for increment ACK (deletion of %s)",
830 XGetAtomName (display, reply.property));
831 wait_for_property_change (wait_object);
834 /* Now write a zero-length chunk to the property to tell the
835 requester that we're done. */
836 BLOCK_INPUT;
837 if (! waiting_for_other_props_on_window (display, window))
838 XSelectInput (display, window, 0L);
840 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
841 XGetAtomName (display, reply.property));
842 XChangeProperty (display, window, reply.property, type, format,
843 PropModeReplace, data, 0);
844 TRACE0 ("Done sending incrementally");
847 /* rms, 2003-01-03: I think I have fixed this bug. */
848 /* The window we're communicating with may have been deleted
849 in the meantime (that's a real situation from a bug report).
850 In this case, there may be events in the event queue still
851 refering to the deleted window, and we'll get a BadWindow error
852 in XTread_socket when processing the events. I don't have
853 an idea how to fix that. gerd, 2001-01-98. */
854 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
855 delivered before uncatch errors. */
856 XSync (display, False);
857 UNBLOCK_INPUT;
859 /* GTK queues events in addition to the queue in Xlib. So we
860 UNBLOCK to enter the event loop and get possible errors delivered,
861 and then BLOCK again because x_uncatch_errors requires it. */
862 BLOCK_INPUT;
863 x_uncatch_errors (display, count);
864 UNBLOCK_INPUT;
867 /* Handle a SelectionRequest event EVENT.
868 This is called from keyboard.c when such an event is found in the queue. */
870 static void
871 x_handle_selection_request (event)
872 struct input_event *event;
874 struct gcpro gcpro1, gcpro2, gcpro3;
875 Lisp_Object local_selection_data;
876 Lisp_Object selection_symbol;
877 Lisp_Object target_symbol;
878 Lisp_Object converted_selection;
879 Time local_selection_time;
880 Lisp_Object successful_p;
881 int count;
882 struct x_display_info *dpyinfo
883 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
885 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
886 (unsigned long) SELECTION_EVENT_REQUESTOR (event),
887 (unsigned long) SELECTION_EVENT_TIME (event));
889 local_selection_data = Qnil;
890 target_symbol = Qnil;
891 converted_selection = Qnil;
892 successful_p = Qnil;
894 GCPRO3 (local_selection_data, converted_selection, target_symbol);
896 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
897 SELECTION_EVENT_SELECTION (event));
899 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
901 if (NILP (local_selection_data))
903 /* Someone asked for the selection, but we don't have it any more.
905 x_decline_selection_request (event);
906 goto DONE;
909 local_selection_time = (Time)
910 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
912 if (SELECTION_EVENT_TIME (event) != CurrentTime
913 && local_selection_time > SELECTION_EVENT_TIME (event))
915 /* Someone asked for the selection, and we have one, but not the one
916 they're looking for.
918 x_decline_selection_request (event);
919 goto DONE;
922 x_selection_current_request = event;
923 count = SPECPDL_INDEX ();
924 selection_request_dpyinfo = dpyinfo;
925 record_unwind_protect (x_selection_request_lisp_error, Qnil);
927 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
928 SELECTION_EVENT_TARGET (event));
930 #if 0 /* #### MULTIPLE doesn't work yet */
931 if (EQ (target_symbol, QMULTIPLE))
932 target_symbol = fetch_multiple_target (event);
933 #endif
935 /* Convert lisp objects back into binary data */
937 converted_selection
938 = x_get_local_selection (selection_symbol, target_symbol, 0);
940 if (! NILP (converted_selection))
942 unsigned char *data;
943 unsigned int size;
944 int format;
945 Atom type;
946 int nofree;
948 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
949 converted_selection,
950 &data, &type, &size, &format, &nofree);
952 x_reply_selection_request (event, format, data, size, type);
953 successful_p = Qt;
955 /* Indicate we have successfully processed this event. */
956 x_selection_current_request = 0;
958 /* Use xfree, not XFree, because lisp_data_to_selection_data
959 calls xmalloc itself. */
960 if (!nofree)
961 xfree (data);
963 unbind_to (count, Qnil);
965 DONE:
967 /* Let random lisp code notice that the selection has been asked for. */
969 Lisp_Object rest;
970 rest = Vx_sent_selection_functions;
971 if (!EQ (rest, Qunbound))
972 for (; CONSP (rest); rest = Fcdr (rest))
973 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
976 UNGCPRO;
979 /* Handle a SelectionClear event EVENT, which indicates that some
980 client cleared out our previously asserted selection.
981 This is called from keyboard.c when such an event is found in the queue. */
983 static void
984 x_handle_selection_clear (event)
985 struct input_event *event;
987 Display *display = SELECTION_EVENT_DISPLAY (event);
988 Atom selection = SELECTION_EVENT_SELECTION (event);
989 Time changed_owner_time = SELECTION_EVENT_TIME (event);
991 Lisp_Object selection_symbol, local_selection_data;
992 Time local_selection_time;
993 struct x_display_info *dpyinfo = x_display_info_for_display (display);
994 struct x_display_info *t_dpyinfo;
996 TRACE0 ("x_handle_selection_clear");
998 /* If the new selection owner is also Emacs,
999 don't clear the new selection. */
1000 BLOCK_INPUT;
1001 /* Check each display on the same terminal,
1002 to see if this Emacs job now owns the selection
1003 through that display. */
1004 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1005 if (t_dpyinfo->kboard == dpyinfo->kboard)
1007 Window owner_window
1008 = XGetSelectionOwner (t_dpyinfo->display, selection);
1009 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1011 UNBLOCK_INPUT;
1012 return;
1015 UNBLOCK_INPUT;
1017 selection_symbol = x_atom_to_symbol (display, selection);
1019 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1021 /* Well, we already believe that we don't own it, so that's just fine. */
1022 if (NILP (local_selection_data)) return;
1024 local_selection_time = (Time)
1025 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
1027 /* This SelectionClear is for a selection that we no longer own, so we can
1028 disregard it. (That is, we have reasserted the selection since this
1029 request was generated.) */
1031 if (changed_owner_time != CurrentTime
1032 && local_selection_time > changed_owner_time)
1033 return;
1035 /* Otherwise, we're really honest and truly being told to drop it.
1036 Don't use Fdelq as that may QUIT;. */
1038 if (EQ (local_selection_data, Fcar (Vselection_alist)))
1039 Vselection_alist = Fcdr (Vselection_alist);
1040 else
1042 Lisp_Object rest;
1043 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1044 if (EQ (local_selection_data, Fcar (XCDR (rest))))
1046 XSETCDR (rest, Fcdr (XCDR (rest)));
1047 break;
1051 /* Let random lisp code notice that the selection has been stolen. */
1054 Lisp_Object rest;
1055 rest = Vx_lost_selection_functions;
1056 if (!EQ (rest, Qunbound))
1058 for (; CONSP (rest); rest = Fcdr (rest))
1059 call1 (Fcar (rest), selection_symbol);
1060 prepare_menu_bars ();
1061 redisplay_preserve_echo_area (20);
1066 void
1067 x_handle_selection_event (event)
1068 struct input_event *event;
1070 TRACE0 ("x_handle_selection_event");
1072 if (event->kind == SELECTION_REQUEST_EVENT)
1074 if (x_queue_selection_requests)
1075 x_queue_event (event);
1076 else
1077 x_handle_selection_request (event);
1079 else
1080 x_handle_selection_clear (event);
1084 /* Clear all selections that were made from frame F.
1085 We do this when about to delete a frame. */
1087 void
1088 x_clear_frame_selections (f)
1089 FRAME_PTR f;
1091 Lisp_Object frame;
1092 Lisp_Object rest;
1094 XSETFRAME (frame, f);
1096 /* Otherwise, we're really honest and truly being told to drop it.
1097 Don't use Fdelq as that may QUIT;. */
1099 /* Delete elements from the beginning of Vselection_alist. */
1100 while (!NILP (Vselection_alist)
1101 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1103 /* Let random Lisp code notice that the selection has been stolen. */
1104 Lisp_Object hooks, selection_symbol;
1106 hooks = Vx_lost_selection_functions;
1107 selection_symbol = Fcar (Fcar (Vselection_alist));
1109 if (!EQ (hooks, Qunbound))
1111 for (; CONSP (hooks); hooks = Fcdr (hooks))
1112 call1 (Fcar (hooks), selection_symbol);
1113 #if 0 /* This can crash when deleting a frame
1114 from x_connection_closed. Anyway, it seems unnecessary;
1115 something else should cause a redisplay. */
1116 redisplay_preserve_echo_area (21);
1117 #endif
1120 Vselection_alist = Fcdr (Vselection_alist);
1123 /* Delete elements after the beginning of Vselection_alist. */
1124 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1125 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
1127 /* Let random Lisp code notice that the selection has been stolen. */
1128 Lisp_Object hooks, selection_symbol;
1130 hooks = Vx_lost_selection_functions;
1131 selection_symbol = Fcar (Fcar (XCDR (rest)));
1133 if (!EQ (hooks, Qunbound))
1135 for (; CONSP (hooks); hooks = Fcdr (hooks))
1136 call1 (Fcar (hooks), selection_symbol);
1137 #if 0 /* See above */
1138 redisplay_preserve_echo_area (22);
1139 #endif
1141 XSETCDR (rest, Fcdr (XCDR (rest)));
1142 break;
1146 /* Nonzero if any properties for DISPLAY and WINDOW
1147 are on the list of what we are waiting for. */
1149 static int
1150 waiting_for_other_props_on_window (display, window)
1151 Display *display;
1152 Window window;
1154 struct prop_location *rest = property_change_wait_list;
1155 while (rest)
1156 if (rest->display == display && rest->window == window)
1157 return 1;
1158 else
1159 rest = rest->next;
1160 return 0;
1163 /* Add an entry to the list of property changes we are waiting for.
1164 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1165 The return value is a number that uniquely identifies
1166 this awaited property change. */
1168 static struct prop_location *
1169 expect_property_change (display, window, property, state)
1170 Display *display;
1171 Window window;
1172 Atom property;
1173 int state;
1175 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1176 pl->identifier = ++prop_location_identifier;
1177 pl->display = display;
1178 pl->window = window;
1179 pl->property = property;
1180 pl->desired_state = state;
1181 pl->next = property_change_wait_list;
1182 pl->arrived = 0;
1183 property_change_wait_list = pl;
1184 return pl;
1187 /* Delete an entry from the list of property changes we are waiting for.
1188 IDENTIFIER is the number that uniquely identifies the entry. */
1190 static void
1191 unexpect_property_change (location)
1192 struct prop_location *location;
1194 struct prop_location *prev = 0, *rest = property_change_wait_list;
1195 while (rest)
1197 if (rest == location)
1199 if (prev)
1200 prev->next = rest->next;
1201 else
1202 property_change_wait_list = rest->next;
1203 xfree (rest);
1204 return;
1206 prev = rest;
1207 rest = rest->next;
1211 /* Remove the property change expectation element for IDENTIFIER. */
1213 static Lisp_Object
1214 wait_for_property_change_unwind (loc)
1215 Lisp_Object loc;
1217 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1219 unexpect_property_change (location);
1220 if (location == property_change_reply_object)
1221 property_change_reply_object = 0;
1222 return Qnil;
1225 /* Actually wait for a property change.
1226 IDENTIFIER should be the value that expect_property_change returned. */
1228 static void
1229 wait_for_property_change (location)
1230 struct prop_location *location;
1232 int secs, usecs;
1233 int count = SPECPDL_INDEX ();
1235 if (property_change_reply_object)
1236 abort ();
1238 /* Make sure to do unexpect_property_change if we quit or err. */
1239 record_unwind_protect (wait_for_property_change_unwind,
1240 make_save_value (location, 0));
1242 XSETCAR (property_change_reply, Qnil);
1243 property_change_reply_object = location;
1245 /* If the event we are waiting for arrives beyond here, it will set
1246 property_change_reply, because property_change_reply_object says so. */
1247 if (! location->arrived)
1249 secs = x_selection_timeout / 1000;
1250 usecs = (x_selection_timeout % 1000) * 1000;
1251 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1252 wait_reading_process_output (secs, usecs, 0, 0,
1253 property_change_reply, NULL, 0);
1255 if (NILP (XCAR (property_change_reply)))
1257 TRACE0 (" Timed out");
1258 error ("Timed out waiting for property-notify event");
1262 unbind_to (count, Qnil);
1265 /* Called from XTread_socket in response to a PropertyNotify event. */
1267 void
1268 x_handle_property_notify (event)
1269 XPropertyEvent *event;
1271 struct prop_location *prev = 0, *rest = property_change_wait_list;
1273 while (rest)
1275 if (!rest->arrived
1276 && rest->property == event->atom
1277 && rest->window == event->window
1278 && rest->display == event->display
1279 && rest->desired_state == event->state)
1281 TRACE2 ("Expected %s of property %s",
1282 (event->state == PropertyDelete ? "deletion" : "change"),
1283 XGetAtomName (event->display, event->atom));
1285 rest->arrived = 1;
1287 /* If this is the one wait_for_property_change is waiting for,
1288 tell it to wake up. */
1289 if (rest == property_change_reply_object)
1290 XSETCAR (property_change_reply, Qt);
1292 return;
1295 prev = rest;
1296 rest = rest->next;
1302 #if 0 /* #### MULTIPLE doesn't work yet */
1304 static Lisp_Object
1305 fetch_multiple_target (event)
1306 XSelectionRequestEvent *event;
1308 Display *display = event->display;
1309 Window window = event->requestor;
1310 Atom target = event->target;
1311 Atom selection_atom = event->selection;
1312 int result;
1314 return
1315 Fcons (QMULTIPLE,
1316 x_get_window_property_as_lisp_data (display, window, target,
1317 QMULTIPLE, selection_atom));
1320 static Lisp_Object
1321 copy_multiple_data (obj)
1322 Lisp_Object obj;
1324 Lisp_Object vec;
1325 int i;
1326 int size;
1327 if (CONSP (obj))
1328 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1330 CHECK_VECTOR (obj);
1331 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1332 for (i = 0; i < size; i++)
1334 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1335 CHECK_VECTOR (vec2);
1336 if (XVECTOR (vec2)->size != 2)
1337 /* ??? Confusing error message */
1338 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1339 Fcons (vec2, Qnil)));
1340 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1341 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1342 = XVECTOR (vec2)->contents [0];
1343 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1344 = XVECTOR (vec2)->contents [1];
1346 return vec;
1349 #endif
1352 /* Variables for communication with x_handle_selection_notify. */
1353 static Atom reading_which_selection;
1354 static Lisp_Object reading_selection_reply;
1355 static Window reading_selection_window;
1357 /* Do protocol to read selection-data from the server.
1358 Converts this to Lisp data and returns it. */
1360 static Lisp_Object
1361 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1362 Lisp_Object selection_symbol, target_type, time_stamp;
1364 struct frame *sf = SELECTED_FRAME ();
1365 Window requestor_window = FRAME_X_WINDOW (sf);
1366 Display *display = FRAME_X_DISPLAY (sf);
1367 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1368 Time requestor_time = last_event_timestamp;
1369 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1370 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1371 Atom type_atom;
1372 int secs, usecs;
1373 int count;
1374 Lisp_Object frame;
1376 if (CONSP (target_type))
1377 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1378 else
1379 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1381 if (! NILP (time_stamp))
1383 if (CONSP (time_stamp))
1384 requestor_time = (Time) cons_to_long (time_stamp);
1385 else if (INTEGERP (time_stamp))
1386 requestor_time = (Time) XUINT (time_stamp);
1387 else if (FLOATP (time_stamp))
1388 requestor_time = (Time) XFLOAT_DATA (time_stamp);
1389 else
1390 error ("TIME_STAMP must be cons or number");
1393 BLOCK_INPUT;
1395 count = x_catch_errors (display);
1397 TRACE2 ("Get selection %s, type %s",
1398 XGetAtomName (display, type_atom),
1399 XGetAtomName (display, target_property));
1401 XConvertSelection (display, selection_atom, type_atom, target_property,
1402 requestor_window, requestor_time);
1403 XFlush (display);
1405 /* Prepare to block until the reply has been read. */
1406 reading_selection_window = requestor_window;
1407 reading_which_selection = selection_atom;
1408 XSETCAR (reading_selection_reply, Qnil);
1410 frame = some_frame_on_display (dpyinfo);
1412 /* If the display no longer has frames, we can't expect
1413 to get many more selection requests from it, so don't
1414 bother trying to queue them. */
1415 if (!NILP (frame))
1417 x_start_queuing_selection_requests ();
1419 record_unwind_protect (queue_selection_requests_unwind,
1420 Qnil);
1422 UNBLOCK_INPUT;
1424 /* This allows quits. Also, don't wait forever. */
1425 secs = x_selection_timeout / 1000;
1426 usecs = (x_selection_timeout % 1000) * 1000;
1427 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1428 wait_reading_process_output (secs, usecs, 0, 0,
1429 reading_selection_reply, NULL, 0);
1430 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1432 BLOCK_INPUT;
1433 x_check_errors (display, "Cannot get selection: %s");
1434 x_uncatch_errors (display, count);
1435 UNBLOCK_INPUT;
1437 if (NILP (XCAR (reading_selection_reply)))
1438 error ("Timed out waiting for reply from selection owner");
1439 if (EQ (XCAR (reading_selection_reply), Qlambda))
1440 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
1442 /* Otherwise, the selection is waiting for us on the requested property. */
1443 return
1444 x_get_window_property_as_lisp_data (display, requestor_window,
1445 target_property, target_type,
1446 selection_atom);
1449 /* Subroutines of x_get_window_property_as_lisp_data */
1451 /* Use xfree, not XFree, to free the data obtained with this function. */
1453 static void
1454 x_get_window_property (display, window, property, data_ret, bytes_ret,
1455 actual_type_ret, actual_format_ret, actual_size_ret,
1456 delete_p)
1457 Display *display;
1458 Window window;
1459 Atom property;
1460 unsigned char **data_ret;
1461 int *bytes_ret;
1462 Atom *actual_type_ret;
1463 int *actual_format_ret;
1464 unsigned long *actual_size_ret;
1465 int delete_p;
1467 int total_size;
1468 unsigned long bytes_remaining;
1469 int offset = 0;
1470 unsigned char *tmp_data = 0;
1471 int result;
1472 int buffer_size = SELECTION_QUANTUM (display);
1474 if (buffer_size > MAX_SELECTION_QUANTUM)
1475 buffer_size = MAX_SELECTION_QUANTUM;
1477 BLOCK_INPUT;
1479 /* First probe the thing to find out how big it is. */
1480 result = XGetWindowProperty (display, window, property,
1481 0L, 0L, False, AnyPropertyType,
1482 actual_type_ret, actual_format_ret,
1483 actual_size_ret,
1484 &bytes_remaining, &tmp_data);
1485 if (result != Success)
1487 UNBLOCK_INPUT;
1488 *data_ret = 0;
1489 *bytes_ret = 0;
1490 return;
1493 /* This was allocated by Xlib, so use XFree. */
1494 XFree ((char *) tmp_data);
1496 if (*actual_type_ret == None || *actual_format_ret == 0)
1498 UNBLOCK_INPUT;
1499 return;
1502 total_size = bytes_remaining + 1;
1503 *data_ret = (unsigned char *) xmalloc (total_size);
1505 /* Now read, until we've gotten it all. */
1506 while (bytes_remaining)
1508 #ifdef TRACE_SELECTION
1509 int last = bytes_remaining;
1510 #endif
1511 result
1512 = XGetWindowProperty (display, window, property,
1513 (long)offset/4, (long)buffer_size/4,
1514 False,
1515 AnyPropertyType,
1516 actual_type_ret, actual_format_ret,
1517 actual_size_ret, &bytes_remaining, &tmp_data);
1519 TRACE2 ("Read %ld bytes from property %s",
1520 last - bytes_remaining,
1521 XGetAtomName (display, property));
1523 /* If this doesn't return Success at this point, it means that
1524 some clod deleted the selection while we were in the midst of
1525 reading it. Deal with that, I guess.... */
1526 if (result != Success)
1527 break;
1529 /* The man page for XGetWindowProperty says:
1530 "If the returned format is 32, the returned data is represented
1531 as a long array and should be cast to that type to obtain the
1532 elements."
1533 This applies even if long is more than 32 bits, the X library
1534 converts from 32 bit elements received from the X server to long
1535 and passes the long array to us. Thus, for that case bcopy can not
1536 be used. We convert to a 32 bit type here, because so much code
1537 assume on that.
1539 The bytes and offsets passed to XGetWindowProperty refers to the
1540 property and those are indeed in 32 bit quantities if format is 32. */
1542 if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1544 unsigned long i;
1545 int *idata = (int *) ((*data_ret) + offset);
1546 long *ldata = (long *) tmp_data;
1548 for (i = 0; i < *actual_size_ret; ++i)
1550 idata[i]= (int) ldata[i];
1551 offset += 4;
1554 else
1556 *actual_size_ret *= *actual_format_ret / 8;
1557 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1558 offset += *actual_size_ret;
1561 /* This was allocated by Xlib, so use XFree. */
1562 XFree ((char *) tmp_data);
1565 XFlush (display);
1566 UNBLOCK_INPUT;
1567 *bytes_ret = offset;
1570 /* Use xfree, not XFree, to free the data obtained with this function. */
1572 static void
1573 receive_incremental_selection (display, window, property, target_type,
1574 min_size_bytes, data_ret, size_bytes_ret,
1575 type_ret, format_ret, size_ret)
1576 Display *display;
1577 Window window;
1578 Atom property;
1579 Lisp_Object target_type; /* for error messages only */
1580 unsigned int min_size_bytes;
1581 unsigned char **data_ret;
1582 int *size_bytes_ret;
1583 Atom *type_ret;
1584 unsigned long *size_ret;
1585 int *format_ret;
1587 int offset = 0;
1588 struct prop_location *wait_object;
1589 *size_bytes_ret = min_size_bytes;
1590 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1592 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1594 /* At this point, we have read an INCR property.
1595 Delete the property to ack it.
1596 (But first, prepare to receive the next event in this handshake.)
1598 Now, we must loop, waiting for the sending window to put a value on
1599 that property, then reading the property, then deleting it to ack.
1600 We are done when the sender places a property of length 0.
1602 BLOCK_INPUT;
1603 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1604 TRACE1 (" Delete property %s",
1605 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1606 XDeleteProperty (display, window, property);
1607 TRACE1 (" Expect new value of property %s",
1608 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1609 wait_object = expect_property_change (display, window, property,
1610 PropertyNewValue);
1611 XFlush (display);
1612 UNBLOCK_INPUT;
1614 while (1)
1616 unsigned char *tmp_data;
1617 int tmp_size_bytes;
1619 TRACE0 (" Wait for property change");
1620 wait_for_property_change (wait_object);
1622 /* expect it again immediately, because x_get_window_property may
1623 .. no it won't, I don't get it.
1624 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1625 TRACE0 (" Get property value");
1626 x_get_window_property (display, window, property,
1627 &tmp_data, &tmp_size_bytes,
1628 type_ret, format_ret, size_ret, 1);
1630 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1632 if (tmp_size_bytes == 0) /* we're done */
1634 TRACE0 ("Done reading incrementally");
1636 if (! waiting_for_other_props_on_window (display, window))
1637 XSelectInput (display, window, STANDARD_EVENT_SET);
1638 /* Use xfree, not XFree, because x_get_window_property
1639 calls xmalloc itself. */
1640 if (tmp_data) xfree (tmp_data);
1641 break;
1644 BLOCK_INPUT;
1645 TRACE1 (" ACK by deleting property %s",
1646 XGetAtomName (display, property));
1647 XDeleteProperty (display, window, property);
1648 wait_object = expect_property_change (display, window, property,
1649 PropertyNewValue);
1650 XFlush (display);
1651 UNBLOCK_INPUT;
1653 if (*size_bytes_ret < offset + tmp_size_bytes)
1655 *size_bytes_ret = offset + tmp_size_bytes;
1656 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1659 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1660 offset += tmp_size_bytes;
1662 /* Use xfree, not XFree, because x_get_window_property
1663 calls xmalloc itself. */
1664 xfree (tmp_data);
1669 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1670 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1671 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1673 static Lisp_Object
1674 x_get_window_property_as_lisp_data (display, window, property, target_type,
1675 selection_atom)
1676 Display *display;
1677 Window window;
1678 Atom property;
1679 Lisp_Object target_type; /* for error messages only */
1680 Atom selection_atom; /* for error messages only */
1682 Atom actual_type;
1683 int actual_format;
1684 unsigned long actual_size;
1685 unsigned char *data = 0;
1686 int bytes = 0;
1687 Lisp_Object val;
1688 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1690 TRACE0 ("Reading selection data");
1692 x_get_window_property (display, window, property, &data, &bytes,
1693 &actual_type, &actual_format, &actual_size, 1);
1694 if (! data)
1696 int there_is_a_selection_owner;
1697 BLOCK_INPUT;
1698 there_is_a_selection_owner
1699 = XGetSelectionOwner (display, selection_atom);
1700 UNBLOCK_INPUT;
1701 Fsignal (Qerror,
1702 there_is_a_selection_owner
1703 ? Fcons (build_string ("selection owner couldn't convert"),
1704 actual_type
1705 ? Fcons (target_type,
1706 Fcons (x_atom_to_symbol (display,
1707 actual_type),
1708 Qnil))
1709 : Fcons (target_type, Qnil))
1710 : Fcons (build_string ("no selection"),
1711 Fcons (x_atom_to_symbol (display,
1712 selection_atom),
1713 Qnil)));
1716 if (actual_type == dpyinfo->Xatom_INCR)
1718 /* That wasn't really the data, just the beginning. */
1720 unsigned int min_size_bytes = * ((unsigned int *) data);
1721 BLOCK_INPUT;
1722 /* Use xfree, not XFree, because x_get_window_property
1723 calls xmalloc itself. */
1724 xfree ((char *) data);
1725 UNBLOCK_INPUT;
1726 receive_incremental_selection (display, window, property, target_type,
1727 min_size_bytes, &data, &bytes,
1728 &actual_type, &actual_format,
1729 &actual_size);
1732 BLOCK_INPUT;
1733 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1734 XDeleteProperty (display, window, property);
1735 XFlush (display);
1736 UNBLOCK_INPUT;
1738 /* It's been read. Now convert it to a lisp object in some semi-rational
1739 manner. */
1740 val = selection_data_to_lisp_data (display, data, bytes,
1741 actual_type, actual_format);
1743 /* Use xfree, not XFree, because x_get_window_property
1744 calls xmalloc itself. */
1745 xfree ((char *) data);
1746 return val;
1749 /* These functions convert from the selection data read from the server into
1750 something that we can use from Lisp, and vice versa.
1752 Type: Format: Size: Lisp Type:
1753 ----- ------- ----- -----------
1754 * 8 * String
1755 ATOM 32 1 Symbol
1756 ATOM 32 > 1 Vector of Symbols
1757 * 16 1 Integer
1758 * 16 > 1 Vector of Integers
1759 * 32 1 if <=16 bits: Integer
1760 if > 16 bits: Cons of top16, bot16
1761 * 32 > 1 Vector of the above
1763 When converting a Lisp number to C, it is assumed to be of format 16 if
1764 it is an integer, and of format 32 if it is a cons of two integers.
1766 When converting a vector of numbers from Lisp to C, it is assumed to be
1767 of format 16 if every element in the vector is an integer, and is assumed
1768 to be of format 32 if any element is a cons of two integers.
1770 When converting an object to C, it may be of the form (SYMBOL . <data>)
1771 where SYMBOL is what we should claim that the type is. Format and
1772 representation are as above. */
1776 static Lisp_Object
1777 selection_data_to_lisp_data (display, data, size, type, format)
1778 Display *display;
1779 unsigned char *data;
1780 Atom type;
1781 int size, format;
1783 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1785 if (type == dpyinfo->Xatom_NULL)
1786 return QNULL;
1788 /* Convert any 8-bit data to a string, for compactness. */
1789 else if (format == 8)
1791 Lisp_Object str, lispy_type;
1793 str = make_unibyte_string ((char *) data, size);
1794 /* Indicate that this string is from foreign selection by a text
1795 property `foreign-selection' so that the caller of
1796 x-get-selection-internal (usually x-get-selection) can know
1797 that the string must be decode. */
1798 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1799 lispy_type = QCOMPOUND_TEXT;
1800 else if (type == dpyinfo->Xatom_UTF8_STRING)
1801 lispy_type = QUTF8_STRING;
1802 else
1803 lispy_type = QSTRING;
1804 Fput_text_property (make_number (0), make_number (size),
1805 Qforeign_selection, lispy_type, str);
1806 return str;
1808 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1809 a vector of symbols.
1811 else if (type == XA_ATOM)
1813 int i;
1814 if (size == sizeof (Atom))
1815 return x_atom_to_symbol (display, *((Atom *) data));
1816 else
1818 Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
1819 make_number (0));
1820 for (i = 0; i < size / sizeof (Atom); i++)
1821 Faset (v, make_number (i),
1822 x_atom_to_symbol (display, ((Atom *) data) [i]));
1823 return v;
1827 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1828 If the number is > 16 bits, convert it to a cons of integers,
1829 16 bits in each half.
1831 else if (format == 32 && size == sizeof (int))
1832 return long_to_cons (((unsigned int *) data) [0]);
1833 else if (format == 16 && size == sizeof (short))
1834 return make_number ((int) (((unsigned short *) data) [0]));
1836 /* Convert any other kind of data to a vector of numbers, represented
1837 as above (as an integer, or a cons of two 16 bit integers.)
1839 else if (format == 16)
1841 int i;
1842 Lisp_Object v;
1843 v = Fmake_vector (make_number (size / 2), make_number (0));
1844 for (i = 0; i < size / 2; i++)
1846 int j = (int) ((unsigned short *) data) [i];
1847 Faset (v, make_number (i), make_number (j));
1849 return v;
1851 else
1853 int i;
1854 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1855 for (i = 0; i < size / 4; i++)
1857 unsigned int j = ((unsigned int *) data) [i];
1858 Faset (v, make_number (i), long_to_cons (j));
1860 return v;
1865 /* Use xfree, not XFree, to free the data obtained with this function. */
1867 static void
1868 lisp_data_to_selection_data (display, obj,
1869 data_ret, type_ret, size_ret,
1870 format_ret, nofree_ret)
1871 Display *display;
1872 Lisp_Object obj;
1873 unsigned char **data_ret;
1874 Atom *type_ret;
1875 unsigned int *size_ret;
1876 int *format_ret;
1877 int *nofree_ret;
1879 Lisp_Object type = Qnil;
1880 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1882 *nofree_ret = 0;
1884 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1886 type = XCAR (obj);
1887 obj = XCDR (obj);
1888 if (CONSP (obj) && NILP (XCDR (obj)))
1889 obj = XCAR (obj);
1892 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1893 { /* This is not the same as declining */
1894 *format_ret = 32;
1895 *size_ret = 0;
1896 *data_ret = 0;
1897 type = QNULL;
1899 else if (STRINGP (obj))
1901 xassert (! STRING_MULTIBYTE (obj));
1902 if (NILP (type))
1903 type = QSTRING;
1904 *format_ret = 8;
1905 *size_ret = SBYTES (obj);
1906 *data_ret = SDATA (obj);
1907 *nofree_ret = 1;
1909 else if (SYMBOLP (obj))
1911 *format_ret = 32;
1912 *size_ret = 1;
1913 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1914 (*data_ret) [sizeof (Atom)] = 0;
1915 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1916 if (NILP (type)) type = QATOM;
1918 else if (INTEGERP (obj)
1919 && XINT (obj) < 0xFFFF
1920 && XINT (obj) > -0xFFFF)
1922 *format_ret = 16;
1923 *size_ret = 1;
1924 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1925 (*data_ret) [sizeof (short)] = 0;
1926 (*(short **) data_ret) [0] = (short) XINT (obj);
1927 if (NILP (type)) type = QINTEGER;
1929 else if (INTEGERP (obj)
1930 || (CONSP (obj) && INTEGERP (XCAR (obj))
1931 && (INTEGERP (XCDR (obj))
1932 || (CONSP (XCDR (obj))
1933 && INTEGERP (XCAR (XCDR (obj)))))))
1935 *format_ret = 32;
1936 *size_ret = 1;
1937 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1938 (*data_ret) [sizeof (long)] = 0;
1939 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1940 if (NILP (type)) type = QINTEGER;
1942 else if (VECTORP (obj))
1944 /* Lisp_Vectors may represent a set of ATOMs;
1945 a set of 16 or 32 bit INTEGERs;
1946 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1948 int i;
1950 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1951 /* This vector is an ATOM set */
1953 if (NILP (type)) type = QATOM;
1954 *size_ret = XVECTOR (obj)->size;
1955 *format_ret = 32;
1956 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1957 for (i = 0; i < *size_ret; i++)
1958 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1959 (*(Atom **) data_ret) [i]
1960 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1961 else
1962 Fsignal (Qerror, /* Qselection_error */
1963 Fcons (build_string
1964 ("all elements of selection vector must have same type"),
1965 Fcons (obj, Qnil)));
1967 #if 0 /* #### MULTIPLE doesn't work yet */
1968 else if (VECTORP (XVECTOR (obj)->contents [0]))
1969 /* This vector is an ATOM_PAIR set */
1971 if (NILP (type)) type = QATOM_PAIR;
1972 *size_ret = XVECTOR (obj)->size;
1973 *format_ret = 32;
1974 *data_ret = (unsigned char *)
1975 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1976 for (i = 0; i < *size_ret; i++)
1977 if (VECTORP (XVECTOR (obj)->contents [i]))
1979 Lisp_Object pair = XVECTOR (obj)->contents [i];
1980 if (XVECTOR (pair)->size != 2)
1981 Fsignal (Qerror,
1982 Fcons (build_string
1983 ("elements of the vector must be vectors of exactly two elements"),
1984 Fcons (pair, Qnil)));
1986 (*(Atom **) data_ret) [i * 2]
1987 = symbol_to_x_atom (dpyinfo, display,
1988 XVECTOR (pair)->contents [0]);
1989 (*(Atom **) data_ret) [(i * 2) + 1]
1990 = symbol_to_x_atom (dpyinfo, display,
1991 XVECTOR (pair)->contents [1]);
1993 else
1994 Fsignal (Qerror,
1995 Fcons (build_string
1996 ("all elements of the vector must be of the same type"),
1997 Fcons (obj, Qnil)));
2000 #endif
2001 else
2002 /* This vector is an INTEGER set, or something like it */
2004 int data_size = 2;
2005 *size_ret = XVECTOR (obj)->size;
2006 if (NILP (type)) type = QINTEGER;
2007 *format_ret = 16;
2008 for (i = 0; i < *size_ret; i++)
2009 if (CONSP (XVECTOR (obj)->contents [i]))
2010 *format_ret = 32;
2011 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2012 Fsignal (Qerror, /* Qselection_error */
2013 Fcons (build_string
2014 ("elements of selection vector must be integers or conses of integers"),
2015 Fcons (obj, Qnil)));
2017 /* Use sizeof(long) even if it is more than 32 bits. See comment
2018 in x_get_window_property and x_fill_property_data. */
2020 if (*format_ret == 32) data_size = sizeof(long);
2021 *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
2022 for (i = 0; i < *size_ret; i++)
2023 if (*format_ret == 32)
2024 (*((unsigned long **) data_ret)) [i]
2025 = cons_to_long (XVECTOR (obj)->contents [i]);
2026 else
2027 (*((unsigned short **) data_ret)) [i]
2028 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2031 else
2032 Fsignal (Qerror, /* Qselection_error */
2033 Fcons (build_string ("unrecognised selection data"),
2034 Fcons (obj, Qnil)));
2036 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2039 static Lisp_Object
2040 clean_local_selection_data (obj)
2041 Lisp_Object obj;
2043 if (CONSP (obj)
2044 && INTEGERP (XCAR (obj))
2045 && CONSP (XCDR (obj))
2046 && INTEGERP (XCAR (XCDR (obj)))
2047 && NILP (XCDR (XCDR (obj))))
2048 obj = Fcons (XCAR (obj), XCDR (obj));
2050 if (CONSP (obj)
2051 && INTEGERP (XCAR (obj))
2052 && INTEGERP (XCDR (obj)))
2054 if (XINT (XCAR (obj)) == 0)
2055 return XCDR (obj);
2056 if (XINT (XCAR (obj)) == -1)
2057 return make_number (- XINT (XCDR (obj)));
2059 if (VECTORP (obj))
2061 int i;
2062 int size = XVECTOR (obj)->size;
2063 Lisp_Object copy;
2064 if (size == 1)
2065 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2066 copy = Fmake_vector (make_number (size), Qnil);
2067 for (i = 0; i < size; i++)
2068 XVECTOR (copy)->contents [i]
2069 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2070 return copy;
2072 return obj;
2075 /* Called from XTread_socket to handle SelectionNotify events.
2076 If it's the selection we are waiting for, stop waiting
2077 by setting the car of reading_selection_reply to non-nil.
2078 We store t there if the reply is successful, lambda if not. */
2080 void
2081 x_handle_selection_notify (event)
2082 XSelectionEvent *event;
2084 if (event->requestor != reading_selection_window)
2085 return;
2086 if (event->selection != reading_which_selection)
2087 return;
2089 TRACE0 ("Received SelectionNotify");
2090 XSETCAR (reading_selection_reply,
2091 (event->property != 0 ? Qt : Qlambda));
2095 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2096 Sx_own_selection_internal, 2, 2, 0,
2097 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2098 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2099 \(Those are literal upper-case symbol names, since that's what X expects.)
2100 VALUE is typically a string, or a cons of two markers, but may be
2101 anything that the functions on `selection-converter-alist' know about. */)
2102 (selection_name, selection_value)
2103 Lisp_Object selection_name, selection_value;
2105 check_x ();
2106 CHECK_SYMBOL (selection_name);
2107 if (NILP (selection_value)) error ("selection-value may not be nil");
2108 x_own_selection (selection_name, selection_value);
2109 return selection_value;
2113 /* Request the selection value from the owner. If we are the owner,
2114 simply return our selection value. If we are not the owner, this
2115 will block until all of the data has arrived. */
2117 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2118 Sx_get_selection_internal, 2, 3, 0,
2119 doc: /* Return text selected from some X window.
2120 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2121 \(Those are literal upper-case symbol names, since that's what X expects.)
2122 TYPE is the type of data desired, typically `STRING'.
2123 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2124 selections. If omitted, defaults to the time for the last event. */)
2125 (selection_symbol, target_type, time_stamp)
2126 Lisp_Object selection_symbol, target_type, time_stamp;
2128 Lisp_Object val = Qnil;
2129 struct gcpro gcpro1, gcpro2;
2130 GCPRO2 (target_type, val); /* we store newly consed data into these */
2131 check_x ();
2132 CHECK_SYMBOL (selection_symbol);
2134 #if 0 /* #### MULTIPLE doesn't work yet */
2135 if (CONSP (target_type)
2136 && XCAR (target_type) == QMULTIPLE)
2138 CHECK_VECTOR (XCDR (target_type));
2139 /* So we don't destructively modify this... */
2140 target_type = copy_multiple_data (target_type);
2142 else
2143 #endif
2144 CHECK_SYMBOL (target_type);
2146 val = x_get_local_selection (selection_symbol, target_type, 1);
2148 if (NILP (val))
2150 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2151 goto DONE;
2154 if (CONSP (val)
2155 && SYMBOLP (XCAR (val)))
2157 val = XCDR (val);
2158 if (CONSP (val) && NILP (XCDR (val)))
2159 val = XCAR (val);
2161 val = clean_local_selection_data (val);
2162 DONE:
2163 UNGCPRO;
2164 return val;
2167 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2168 Sx_disown_selection_internal, 1, 2, 0,
2169 doc: /* If we own the selection SELECTION, disown it.
2170 Disowning it means there is no such selection. */)
2171 (selection, time)
2172 Lisp_Object selection;
2173 Lisp_Object time;
2175 Time timestamp;
2176 Atom selection_atom;
2177 struct selection_input_event event;
2178 Display *display;
2179 struct x_display_info *dpyinfo;
2180 struct frame *sf = SELECTED_FRAME ();
2182 check_x ();
2183 display = FRAME_X_DISPLAY (sf);
2184 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2185 CHECK_SYMBOL (selection);
2186 if (NILP (time))
2187 timestamp = last_event_timestamp;
2188 else
2189 timestamp = cons_to_long (time);
2191 if (NILP (assq_no_quit (selection, Vselection_alist)))
2192 return Qnil; /* Don't disown the selection when we're not the owner. */
2194 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2196 BLOCK_INPUT;
2197 XSetSelectionOwner (display, selection_atom, None, timestamp);
2198 UNBLOCK_INPUT;
2200 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2201 generated for a window which owns the selection when that window sets
2202 the selection owner to None. The NCD server does, the MIT Sun4 server
2203 doesn't. So we synthesize one; this means we might get two, but
2204 that's ok, because the second one won't have any effect. */
2205 SELECTION_EVENT_DISPLAY (&event) = display;
2206 SELECTION_EVENT_SELECTION (&event) = selection_atom;
2207 SELECTION_EVENT_TIME (&event) = timestamp;
2208 x_handle_selection_clear ((struct input_event *) &event);
2210 return Qt;
2213 /* Get rid of all the selections in buffer BUFFER.
2214 This is used when we kill a buffer. */
2216 void
2217 x_disown_buffer_selections (buffer)
2218 Lisp_Object buffer;
2220 Lisp_Object tail;
2221 struct buffer *buf = XBUFFER (buffer);
2223 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2225 Lisp_Object elt, value;
2226 elt = XCAR (tail);
2227 value = XCDR (elt);
2228 if (CONSP (value) && MARKERP (XCAR (value))
2229 && XMARKER (XCAR (value))->buffer == buf)
2230 Fx_disown_selection_internal (XCAR (elt), Qnil);
2234 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2235 0, 1, 0,
2236 doc: /* Whether the current Emacs process owns the given X Selection.
2237 The arg should be the name of the selection in question, typically one of
2238 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2239 \(Those are literal upper-case symbol names, since that's what X expects.)
2240 For convenience, the symbol nil is the same as `PRIMARY',
2241 and t is the same as `SECONDARY'. */)
2242 (selection)
2243 Lisp_Object selection;
2245 check_x ();
2246 CHECK_SYMBOL (selection);
2247 if (EQ (selection, Qnil)) selection = QPRIMARY;
2248 if (EQ (selection, Qt)) selection = QSECONDARY;
2250 if (NILP (Fassq (selection, Vselection_alist)))
2251 return Qnil;
2252 return Qt;
2255 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2256 0, 1, 0,
2257 doc: /* Whether there is an owner for the given X Selection.
2258 The arg should be the name of the selection in question, typically one of
2259 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2260 \(Those are literal upper-case symbol names, since that's what X expects.)
2261 For convenience, the symbol nil is the same as `PRIMARY',
2262 and t is the same as `SECONDARY'. */)
2263 (selection)
2264 Lisp_Object selection;
2266 Window owner;
2267 Atom atom;
2268 Display *dpy;
2269 struct frame *sf = SELECTED_FRAME ();
2271 /* It should be safe to call this before we have an X frame. */
2272 if (! FRAME_X_P (sf))
2273 return Qnil;
2275 dpy = FRAME_X_DISPLAY (sf);
2276 CHECK_SYMBOL (selection);
2277 if (!NILP (Fx_selection_owner_p (selection)))
2278 return Qt;
2279 if (EQ (selection, Qnil)) selection = QPRIMARY;
2280 if (EQ (selection, Qt)) selection = QSECONDARY;
2281 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2282 if (atom == 0)
2283 return Qnil;
2284 BLOCK_INPUT;
2285 owner = XGetSelectionOwner (dpy, atom);
2286 UNBLOCK_INPUT;
2287 return (owner ? Qt : Qnil);
2291 #ifdef CUT_BUFFER_SUPPORT
2293 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2294 static void
2295 initialize_cut_buffers (display, window)
2296 Display *display;
2297 Window window;
2299 unsigned char *data = (unsigned char *) "";
2300 BLOCK_INPUT;
2301 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2302 PropModeAppend, data, 0)
2303 FROB (XA_CUT_BUFFER0);
2304 FROB (XA_CUT_BUFFER1);
2305 FROB (XA_CUT_BUFFER2);
2306 FROB (XA_CUT_BUFFER3);
2307 FROB (XA_CUT_BUFFER4);
2308 FROB (XA_CUT_BUFFER5);
2309 FROB (XA_CUT_BUFFER6);
2310 FROB (XA_CUT_BUFFER7);
2311 #undef FROB
2312 UNBLOCK_INPUT;
2316 #define CHECK_CUT_BUFFER(symbol) \
2317 { CHECK_SYMBOL ((symbol)); \
2318 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2319 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2320 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2321 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2322 Fsignal (Qerror, \
2323 Fcons (build_string ("doesn't name a cut buffer"), \
2324 Fcons ((symbol), Qnil))); \
2327 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2328 Sx_get_cut_buffer_internal, 1, 1, 0,
2329 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2330 (buffer)
2331 Lisp_Object buffer;
2333 Window window;
2334 Atom buffer_atom;
2335 unsigned char *data;
2336 int bytes;
2337 Atom type;
2338 int format;
2339 unsigned long size;
2340 Lisp_Object ret;
2341 Display *display;
2342 struct x_display_info *dpyinfo;
2343 struct frame *sf = SELECTED_FRAME ();
2345 check_x ();
2346 display = FRAME_X_DISPLAY (sf);
2347 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2348 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2349 CHECK_CUT_BUFFER (buffer);
2350 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2352 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2353 &type, &format, &size, 0);
2354 if (!data || !format)
2355 return Qnil;
2357 if (format != 8 || type != XA_STRING)
2358 Fsignal (Qerror,
2359 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2360 Fcons (x_atom_to_symbol (display, type),
2361 Fcons (make_number (format), Qnil))));
2363 ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
2364 /* Use xfree, not XFree, because x_get_window_property
2365 calls xmalloc itself. */
2366 xfree (data);
2367 return ret;
2371 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2372 Sx_store_cut_buffer_internal, 2, 2, 0,
2373 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2374 (buffer, string)
2375 Lisp_Object buffer, string;
2377 Window window;
2378 Atom buffer_atom;
2379 unsigned char *data;
2380 int bytes;
2381 int bytes_remaining;
2382 int max_bytes;
2383 Display *display;
2384 struct frame *sf = SELECTED_FRAME ();
2386 check_x ();
2387 display = FRAME_X_DISPLAY (sf);
2388 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2390 max_bytes = SELECTION_QUANTUM (display);
2391 if (max_bytes > MAX_SELECTION_QUANTUM)
2392 max_bytes = MAX_SELECTION_QUANTUM;
2394 CHECK_CUT_BUFFER (buffer);
2395 CHECK_STRING (string);
2396 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2397 display, buffer);
2398 data = (unsigned char *) SDATA (string);
2399 bytes = SBYTES (string);
2400 bytes_remaining = bytes;
2402 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2404 initialize_cut_buffers (display, window);
2405 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2408 BLOCK_INPUT;
2410 /* Don't mess up with an empty value. */
2411 if (!bytes_remaining)
2412 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2413 PropModeReplace, data, 0);
2415 while (bytes_remaining)
2417 int chunk = (bytes_remaining < max_bytes
2418 ? bytes_remaining : max_bytes);
2419 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2420 (bytes_remaining == bytes
2421 ? PropModeReplace
2422 : PropModeAppend),
2423 data, chunk);
2424 data += chunk;
2425 bytes_remaining -= chunk;
2427 UNBLOCK_INPUT;
2428 return string;
2432 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2433 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2434 doc: /* Rotate the values of the cut buffers by the given number of step.
2435 Positive means shift the values forward, negative means backward. */)
2437 Lisp_Object n;
2439 Window window;
2440 Atom props[8];
2441 Display *display;
2442 struct frame *sf = SELECTED_FRAME ();
2444 check_x ();
2445 display = FRAME_X_DISPLAY (sf);
2446 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2447 CHECK_NUMBER (n);
2448 if (XINT (n) == 0)
2449 return n;
2450 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2452 initialize_cut_buffers (display, window);
2453 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2456 props[0] = XA_CUT_BUFFER0;
2457 props[1] = XA_CUT_BUFFER1;
2458 props[2] = XA_CUT_BUFFER2;
2459 props[3] = XA_CUT_BUFFER3;
2460 props[4] = XA_CUT_BUFFER4;
2461 props[5] = XA_CUT_BUFFER5;
2462 props[6] = XA_CUT_BUFFER6;
2463 props[7] = XA_CUT_BUFFER7;
2464 BLOCK_INPUT;
2465 XRotateWindowProperties (display, window, props, 8, XINT (n));
2466 UNBLOCK_INPUT;
2467 return n;
2470 #endif
2472 /***********************************************************************
2473 Drag and drop support
2474 ***********************************************************************/
2475 /* Check that lisp values are of correct type for x_fill_property_data.
2476 That is, number, string or a cons with two numbers (low and high 16
2477 bit parts of a 32 bit number). */
2480 x_check_property_data (data)
2481 Lisp_Object data;
2483 Lisp_Object iter;
2484 int size = 0;
2486 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2488 Lisp_Object o = XCAR (iter);
2490 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2491 size = -1;
2492 else if (CONSP (o) &&
2493 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2494 size = -1;
2497 return size;
2500 /* Convert lisp values to a C array. Values may be a number, a string
2501 which is taken as an X atom name and converted to the atom value, or
2502 a cons containing the two 16 bit parts of a 32 bit number.
2504 DPY is the display use to look up X atoms.
2505 DATA is a Lisp list of values to be converted.
2506 RET is the C array that contains the converted values. It is assumed
2507 it is big enough to hold all values.
2508 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2509 be stored in RET. Note that long is used for 32 even if long is more
2510 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2511 XClientMessageEvent). */
2513 void
2514 x_fill_property_data (dpy, data, ret, format)
2515 Display *dpy;
2516 Lisp_Object data;
2517 void *ret;
2518 int format;
2520 long val;
2521 long *d32 = (long *) ret;
2522 short *d16 = (short *) ret;
2523 char *d08 = (char *) ret;
2524 Lisp_Object iter;
2526 for (iter = data; CONSP (iter); iter = XCDR (iter))
2528 Lisp_Object o = XCAR (iter);
2530 if (INTEGERP (o))
2531 val = (long) XFASTINT (o);
2532 else if (FLOATP (o))
2533 val = (long) XFLOAT_DATA (o);
2534 else if (CONSP (o))
2535 val = (long) cons_to_long (o);
2536 else if (STRINGP (o))
2538 BLOCK_INPUT;
2539 val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
2540 UNBLOCK_INPUT;
2542 else
2543 error ("Wrong type, must be string, number or cons");
2545 if (format == 8)
2546 *d08++ = (char) val;
2547 else if (format == 16)
2548 *d16++ = (short) val;
2549 else
2550 *d32++ = val;
2554 /* Convert an array of C values to a Lisp list.
2555 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2556 DATA is a C array of values to be converted.
2557 TYPE is the type of the data. Only XA_ATOM is special, it converts
2558 each number in DATA to its corresponfing X atom as a symbol.
2559 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2560 be stored in RET.
2561 SIZE is the number of elements in DATA.
2563 Also see comment for selection_data_to_lisp_data above. */
2565 Lisp_Object
2566 x_property_data_to_lisp (f, data, type, format, size)
2567 struct frame *f;
2568 unsigned char *data;
2569 Atom type;
2570 int format;
2571 unsigned long size;
2573 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2574 data, size*format/8, type, format);
2577 /* Get the mouse position in frame relative coordinates. */
2579 static void
2580 mouse_position_for_drop (f, x, y)
2581 FRAME_PTR f;
2582 int *x;
2583 int *y;
2585 Window root, dummy_window;
2586 int dummy;
2588 BLOCK_INPUT;
2590 XQueryPointer (FRAME_X_DISPLAY (f),
2591 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2593 /* The root window which contains the pointer. */
2594 &root,
2596 /* Window pointer is on, not used */
2597 &dummy_window,
2599 /* The position on that root window. */
2600 x, y,
2602 /* x/y in dummy_window coordinates, not used. */
2603 &dummy, &dummy,
2605 /* Modifier keys and pointer buttons, about which
2606 we don't care. */
2607 (unsigned int *) &dummy);
2610 /* Absolute to relative. */
2611 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2612 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2614 UNBLOCK_INPUT;
2617 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2618 Sx_get_atom_name, 1, 2, 0,
2619 doc: /* Return the X atom name for VALUE as a string.
2620 VALUE may be a number or a cons where the car is the upper 16 bits and
2621 the cdr is the lower 16 bits of a 32 bit value.
2622 Use the display for FRAME or the current frame if FRAME is not given or nil.
2624 If the value is 0 or the atom is not known, return the empty string. */)
2625 (value, frame)
2626 Lisp_Object value, frame;
2628 struct frame *f = check_x_frame (frame);
2629 char *name = 0;
2630 Lisp_Object ret = Qnil;
2631 int count;
2632 Display *dpy = FRAME_X_DISPLAY (f);
2633 Atom atom;
2635 if (INTEGERP (value))
2636 atom = (Atom) XUINT (value);
2637 else if (FLOATP (value))
2638 atom = (Atom) XFLOAT_DATA (value);
2639 else if (CONSP (value))
2640 atom = (Atom) cons_to_long (value);
2641 else
2642 error ("Wrong type, value must be number or cons");
2644 BLOCK_INPUT;
2645 count = x_catch_errors (dpy);
2647 name = atom ? XGetAtomName (dpy, atom) : "";
2649 if (! x_had_errors_p (dpy))
2650 ret = make_string (name, strlen (name));
2652 x_uncatch_errors (dpy, count);
2654 if (atom && name) XFree (name);
2655 if (NILP (ret)) ret = make_string ("", 0);
2657 UNBLOCK_INPUT;
2659 return ret;
2662 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2663 TODO: Check if this client event really is a DND event? */
2666 x_handle_dnd_message (f, event, dpyinfo, bufp)
2667 struct frame *f;
2668 XClientMessageEvent *event;
2669 struct x_display_info *dpyinfo;
2670 struct input_event *bufp;
2672 Lisp_Object vec;
2673 Lisp_Object frame;
2674 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2675 unsigned long size = 160/event->format;
2676 int x, y;
2677 unsigned char *data = (unsigned char *) event->data.b;
2678 int idata[5];
2680 XSETFRAME (frame, f);
2682 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2683 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2684 function expects them to be of size int (i.e. 32). So to be able to
2685 use that function, put the data in the form it expects if format is 32. */
2687 if (event->format == 32 && event->format < BITS_PER_LONG)
2689 int i;
2690 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2691 idata[i] = (int) event->data.l[i];
2692 data = (unsigned char *) idata;
2695 vec = Fmake_vector (make_number (4), Qnil);
2696 AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2697 event->message_type));
2698 AREF (vec, 1) = frame;
2699 AREF (vec, 2) = make_number (event->format);
2700 AREF (vec, 3) = x_property_data_to_lisp (f,
2701 data,
2702 event->message_type,
2703 event->format,
2704 size);
2706 mouse_position_for_drop (f, &x, &y);
2707 bufp->kind = DRAG_N_DROP_EVENT;
2708 bufp->frame_or_window = Fcons (frame, vec);
2709 bufp->timestamp = CurrentTime;
2710 bufp->x = make_number (x);
2711 bufp->y = make_number (y);
2712 bufp->arg = Qnil;
2713 bufp->modifiers = 0;
2715 return 1;
2718 DEFUN ("x-send-client-message", Fx_send_client_event,
2719 Sx_send_client_message, 6, 6, 0,
2720 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2722 For DISPLAY, specify either a frame or a display name (a string).
2723 If DISPLAY is nil, that stands for the selected frame's display.
2724 DEST may be a number, in which case it is a Window id. The value 0 may
2725 be used to send to the root window of the DISPLAY.
2726 If DEST is a cons, it is converted to a 32 bit number
2727 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2728 number is then used as a window id.
2729 If DEST is a frame the event is sent to the outer window of that frame.
2730 Nil means the currently selected frame.
2731 If DEST is the string "PointerWindow" the event is sent to the window that
2732 contains the pointer. If DEST is the string "InputFocus" the event is
2733 sent to the window that has the input focus.
2734 FROM is the frame sending the event. Use nil for currently selected frame.
2735 MESSAGE-TYPE is the name of an Atom as a string.
2736 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2737 bits. VALUES is a list of numbers, cons and/or strings containing the values
2738 to send. If a value is a string, it is converted to an Atom and the value of
2739 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2740 with the high 16 bits from the car and the lower 16 bit from the cdr.
2741 If more values than fits into the event is given, the excessive values
2742 are ignored. */)
2743 (display, dest, from, message_type, format, values)
2744 Lisp_Object display, dest, from, message_type, format, values;
2746 struct x_display_info *dpyinfo = check_x_display_info (display);
2747 Window wdest;
2748 XEvent event;
2749 Lisp_Object cons;
2750 int size;
2751 struct frame *f = check_x_frame (from);
2752 int count;
2753 int to_root;
2755 CHECK_STRING (message_type);
2756 CHECK_NUMBER (format);
2757 CHECK_CONS (values);
2759 if (x_check_property_data (values) == -1)
2760 error ("Bad data in VALUES, must be number, cons or string");
2762 event.xclient.type = ClientMessage;
2763 event.xclient.format = XFASTINT (format);
2765 if (event.xclient.format != 8 && event.xclient.format != 16
2766 && event.xclient.format != 32)
2767 error ("FORMAT must be one of 8, 16 or 32");
2769 if (FRAMEP (dest) || NILP (dest))
2771 struct frame *fdest = check_x_frame (dest);
2772 wdest = FRAME_OUTER_WINDOW (fdest);
2774 else if (STRINGP (dest))
2776 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2777 wdest = PointerWindow;
2778 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2779 wdest = InputFocus;
2780 else
2781 error ("DEST as a string must be one of PointerWindow or InputFocus");
2783 else if (INTEGERP (dest))
2784 wdest = (Window) XFASTINT (dest);
2785 else if (FLOATP (dest))
2786 wdest = (Window) XFLOAT_DATA (dest);
2787 else if (CONSP (dest))
2789 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2790 error ("Both car and cdr for DEST must be numbers");
2791 else
2792 wdest = (Window) cons_to_long (dest);
2794 else
2795 error ("DEST must be a frame, nil, string, number or cons");
2797 if (wdest == 0) wdest = dpyinfo->root_window;
2798 to_root = wdest == dpyinfo->root_window;
2800 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2803 BLOCK_INPUT;
2805 event.xclient.message_type
2806 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2807 event.xclient.display = dpyinfo->display;
2809 /* Some clients (metacity for example) expects sending window to be here
2810 when sending to the root window. */
2811 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2814 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2815 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2816 event.xclient.format);
2818 /* If event mask is 0 the event is sent to the client that created
2819 the destination window. But if we are sending to the root window,
2820 there is no such client. Then we set the event mask to 0xffff. The
2821 event then goes to clients selecting for events on the root window. */
2822 count = x_catch_errors (dpyinfo->display);
2824 int propagate = to_root ? False : True;
2825 unsigned mask = to_root ? 0xffff : 0;
2826 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2827 XFlush (dpyinfo->display);
2829 x_uncatch_errors (dpyinfo->display, count);
2830 UNBLOCK_INPUT;
2832 return Qnil;
2836 void
2837 syms_of_xselect ()
2839 defsubr (&Sx_get_selection_internal);
2840 defsubr (&Sx_own_selection_internal);
2841 defsubr (&Sx_disown_selection_internal);
2842 defsubr (&Sx_selection_owner_p);
2843 defsubr (&Sx_selection_exists_p);
2845 #ifdef CUT_BUFFER_SUPPORT
2846 defsubr (&Sx_get_cut_buffer_internal);
2847 defsubr (&Sx_store_cut_buffer_internal);
2848 defsubr (&Sx_rotate_cut_buffers_internal);
2849 #endif
2851 defsubr (&Sx_get_atom_name);
2852 defsubr (&Sx_send_client_message);
2854 reading_selection_reply = Fcons (Qnil, Qnil);
2855 staticpro (&reading_selection_reply);
2856 reading_selection_window = 0;
2857 reading_which_selection = 0;
2859 property_change_wait_list = 0;
2860 prop_location_identifier = 0;
2861 property_change_reply = Fcons (Qnil, Qnil);
2862 staticpro (&property_change_reply);
2864 Vselection_alist = Qnil;
2865 staticpro (&Vselection_alist);
2867 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2868 doc: /* An alist associating X Windows selection-types with functions.
2869 These functions are called to convert the selection, with three args:
2870 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2871 a desired type to which the selection should be converted;
2872 and the local selection value (whatever was given to `x-own-selection').
2874 The function should return the value to send to the X server
2875 \(typically a string). A return value of nil
2876 means that the conversion could not be done.
2877 A return value which is the symbol `NULL'
2878 means that a side-effect was executed,
2879 and there is no meaningful selection value. */);
2880 Vselection_converter_alist = Qnil;
2882 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2883 doc: /* A list of functions to be called when Emacs loses an X selection.
2884 \(This happens when some other X client makes its own selection
2885 or when a Lisp program explicitly clears the selection.)
2886 The functions are called with one argument, the selection type
2887 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2888 Vx_lost_selection_functions = Qnil;
2890 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2891 doc: /* A list of functions to be called when Emacs answers a selection request.
2892 The functions are called with four arguments:
2893 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2894 - the selection-type which Emacs was asked to convert the
2895 selection into before sending (for example, `STRING' or `LENGTH');
2896 - a flag indicating success or failure for responding to the request.
2897 We might have failed (and declined the request) for any number of reasons,
2898 including being asked for a selection that we no longer own, or being asked
2899 to convert into a type that we don't know about or that is inappropriate.
2900 This hook doesn't let you change the behavior of Emacs's selection replies,
2901 it merely informs you that they have happened. */);
2902 Vx_sent_selection_functions = Qnil;
2904 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2905 doc: /* Coding system for communicating with other X clients.
2906 When sending or receiving text via cut_buffer, selection, and clipboard,
2907 the text is encoded or decoded by this coding system.
2908 The default value is `compound-text-with-extensions'. */);
2909 Vselection_coding_system = intern ("compound-text-with-extensions");
2911 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2912 doc: /* Coding system for the next communication with other X clients.
2913 Usually, `selection-coding-system' is used for communicating with
2914 other X clients. But, if this variable is set, it is used for the
2915 next communication only. After the communication, this variable is
2916 set to nil. */);
2917 Vnext_selection_coding_system = Qnil;
2919 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2920 doc: /* Number of milliseconds to wait for a selection reply.
2921 If the selection owner doesn't reply in this time, we give up.
2922 A value of 0 means wait as long as necessary. This is initialized from the
2923 \"*selectionTimeout\" resource. */);
2924 x_selection_timeout = 0;
2926 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2927 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2928 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2929 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2930 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2931 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2932 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2933 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2934 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
2935 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2936 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2937 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2938 QINCR = intern ("INCR"); staticpro (&QINCR);
2939 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2940 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2941 QATOM = intern ("ATOM"); staticpro (&QATOM);
2942 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2943 QNULL = intern ("NULL"); staticpro (&QNULL);
2944 Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
2945 staticpro (&Qcompound_text_with_extensions);
2947 #ifdef CUT_BUFFER_SUPPORT
2948 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2949 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2950 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2951 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2952 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2953 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2954 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2955 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2956 #endif
2958 Qforeign_selection = intern ("foreign-selection");
2959 staticpro (&Qforeign_selection);
2962 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2963 (do not change this comment) */