(map-keymap): Definition deleted.
[emacs.git] / src / xselect.c
blobc89347be2cd87a57b0276c32727303a497fe563e
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;
177 /* Utility functions */
179 static void lisp_data_to_selection_data ();
180 static Lisp_Object selection_data_to_lisp_data ();
181 static Lisp_Object x_get_window_property_as_lisp_data ();
185 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
186 handling. */
188 struct selection_event_queue
190 struct input_event event;
191 struct selection_event_queue *next;
194 static struct selection_event_queue *selection_queue;
196 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
198 static int x_queue_selection_requests;
200 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
202 static void
203 x_queue_event (event)
204 struct input_event *event;
206 struct selection_event_queue *queue_tmp;
208 /* Don't queue repeated requests.
209 This only happens for large requests which uses the incremental protocol. */
210 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
212 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
214 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
215 x_decline_selection_request (event);
216 return;
220 queue_tmp
221 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
223 if (queue_tmp != NULL)
225 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
226 queue_tmp->event = *event;
227 queue_tmp->next = selection_queue;
228 selection_queue = queue_tmp;
232 /* Start queuing SELECTION_REQUEST_EVENT events. */
234 static void
235 x_start_queuing_selection_requests ()
237 if (x_queue_selection_requests)
238 abort ();
240 x_queue_selection_requests++;
241 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
244 /* Stop queuing SELECTION_REQUEST_EVENT events. */
246 static void
247 x_stop_queuing_selection_requests ()
249 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
250 --x_queue_selection_requests;
252 /* Take all the queued events and put them back
253 so that they get processed afresh. */
255 while (selection_queue != NULL)
257 struct selection_event_queue *queue_tmp = selection_queue;
258 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
259 kbd_buffer_unget_event (&queue_tmp->event);
260 selection_queue = queue_tmp->next;
261 xfree ((char *)queue_tmp);
266 /* This converts a Lisp symbol to a server Atom, avoiding a server
267 roundtrip whenever possible. */
269 static Atom
270 symbol_to_x_atom (dpyinfo, display, sym)
271 struct x_display_info *dpyinfo;
272 Display *display;
273 Lisp_Object sym;
275 Atom val;
276 if (NILP (sym)) return 0;
277 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
278 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
279 if (EQ (sym, QSTRING)) return XA_STRING;
280 if (EQ (sym, QINTEGER)) return XA_INTEGER;
281 if (EQ (sym, QATOM)) return XA_ATOM;
282 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
283 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
284 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
285 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
286 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
287 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
288 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
289 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
290 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
291 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
292 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
293 #ifdef CUT_BUFFER_SUPPORT
294 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
295 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
296 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
297 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
298 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
299 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
300 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
301 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
302 #endif
303 if (!SYMBOLP (sym)) abort ();
305 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
306 BLOCK_INPUT;
307 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
308 UNBLOCK_INPUT;
309 return val;
313 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
314 and calls to intern whenever possible. */
316 static Lisp_Object
317 x_atom_to_symbol (dpy, atom)
318 Display *dpy;
319 Atom atom;
321 struct x_display_info *dpyinfo;
322 char *str;
323 Lisp_Object val;
325 if (! atom)
326 return Qnil;
328 switch (atom)
330 case XA_PRIMARY:
331 return QPRIMARY;
332 case XA_SECONDARY:
333 return QSECONDARY;
334 case XA_STRING:
335 return QSTRING;
336 case XA_INTEGER:
337 return QINTEGER;
338 case XA_ATOM:
339 return QATOM;
340 #ifdef CUT_BUFFER_SUPPORT
341 case XA_CUT_BUFFER0:
342 return QCUT_BUFFER0;
343 case XA_CUT_BUFFER1:
344 return QCUT_BUFFER1;
345 case XA_CUT_BUFFER2:
346 return QCUT_BUFFER2;
347 case XA_CUT_BUFFER3:
348 return QCUT_BUFFER3;
349 case XA_CUT_BUFFER4:
350 return QCUT_BUFFER4;
351 case XA_CUT_BUFFER5:
352 return QCUT_BUFFER5;
353 case XA_CUT_BUFFER6:
354 return QCUT_BUFFER6;
355 case XA_CUT_BUFFER7:
356 return QCUT_BUFFER7;
357 #endif
360 dpyinfo = x_display_info_for_display (dpy);
361 if (atom == dpyinfo->Xatom_CLIPBOARD)
362 return QCLIPBOARD;
363 if (atom == dpyinfo->Xatom_TIMESTAMP)
364 return QTIMESTAMP;
365 if (atom == dpyinfo->Xatom_TEXT)
366 return QTEXT;
367 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
368 return QCOMPOUND_TEXT;
369 if (atom == dpyinfo->Xatom_UTF8_STRING)
370 return QUTF8_STRING;
371 if (atom == dpyinfo->Xatom_DELETE)
372 return QDELETE;
373 if (atom == dpyinfo->Xatom_MULTIPLE)
374 return QMULTIPLE;
375 if (atom == dpyinfo->Xatom_INCR)
376 return QINCR;
377 if (atom == dpyinfo->Xatom_EMACS_TMP)
378 return QEMACS_TMP;
379 if (atom == dpyinfo->Xatom_TARGETS)
380 return QTARGETS;
381 if (atom == dpyinfo->Xatom_NULL)
382 return QNULL;
384 BLOCK_INPUT;
385 str = XGetAtomName (dpy, atom);
386 UNBLOCK_INPUT;
387 TRACE1 ("XGetAtomName --> %s", str);
388 if (! str) return Qnil;
389 val = intern (str);
390 BLOCK_INPUT;
391 /* This was allocated by Xlib, so use XFree. */
392 XFree (str);
393 UNBLOCK_INPUT;
394 return val;
397 /* Do protocol to assert ourself as a selection owner.
398 Update the Vselection_alist so that we can reply to later requests for
399 our selection. */
401 static void
402 x_own_selection (selection_name, selection_value)
403 Lisp_Object selection_name, selection_value;
405 struct frame *sf = SELECTED_FRAME ();
406 Window selecting_window = FRAME_X_WINDOW (sf);
407 Display *display = FRAME_X_DISPLAY (sf);
408 Time time = last_event_timestamp;
409 Atom selection_atom;
410 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
411 int count;
413 CHECK_SYMBOL (selection_name);
414 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
416 BLOCK_INPUT;
417 count = x_catch_errors (display);
418 XSetSelectionOwner (display, selection_atom, selecting_window, time);
419 x_check_errors (display, "Can't set selection: %s");
420 x_uncatch_errors (display, count);
421 UNBLOCK_INPUT;
423 /* Now update the local cache */
425 Lisp_Object selection_time;
426 Lisp_Object selection_data;
427 Lisp_Object prev_value;
429 selection_time = long_to_cons ((unsigned long) time);
430 selection_data = Fcons (selection_name,
431 Fcons (selection_value,
432 Fcons (selection_time,
433 Fcons (selected_frame, Qnil))));
434 prev_value = assq_no_quit (selection_name, Vselection_alist);
436 Vselection_alist = Fcons (selection_data, Vselection_alist);
438 /* If we already owned the selection, remove the old selection data.
439 Perhaps we should destructively modify it instead.
440 Don't use Fdelq as that may QUIT. */
441 if (!NILP (prev_value))
443 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
444 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
445 if (EQ (prev_value, Fcar (XCDR (rest))))
447 XSETCDR (rest, Fcdr (XCDR (rest)));
448 break;
454 /* Given a selection-name and desired type, look up our local copy of
455 the selection value and convert it to the type.
456 The value is nil or a string.
457 This function is used both for remote requests (LOCAL_REQUEST is zero)
458 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
460 This calls random Lisp code, and may signal or gc. */
462 static Lisp_Object
463 x_get_local_selection (selection_symbol, target_type, local_request)
464 Lisp_Object selection_symbol, target_type;
465 int local_request;
467 Lisp_Object local_value;
468 Lisp_Object handler_fn, value, type, check;
469 int count;
471 local_value = assq_no_quit (selection_symbol, Vselection_alist);
473 if (NILP (local_value)) return Qnil;
475 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
476 if (EQ (target_type, QTIMESTAMP))
478 handler_fn = Qnil;
479 value = XCAR (XCDR (XCDR (local_value)));
481 #if 0
482 else if (EQ (target_type, QDELETE))
484 handler_fn = Qnil;
485 Fx_disown_selection_internal
486 (selection_symbol,
487 XCAR (XCDR (XCDR (local_value))));
488 value = QNULL;
490 #endif
492 #if 0 /* #### MULTIPLE doesn't work yet */
493 else if (CONSP (target_type)
494 && XCAR (target_type) == QMULTIPLE)
496 Lisp_Object pairs;
497 int size;
498 int i;
499 pairs = XCDR (target_type);
500 size = XVECTOR (pairs)->size;
501 /* If the target is MULTIPLE, then target_type looks like
502 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
503 We modify the second element of each pair in the vector and
504 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
506 for (i = 0; i < size; i++)
508 Lisp_Object pair;
509 pair = XVECTOR (pairs)->contents [i];
510 XVECTOR (pair)->contents [1]
511 = x_get_local_selection (XVECTOR (pair)->contents [0],
512 XVECTOR (pair)->contents [1],
513 local_request);
515 return pairs;
517 #endif
518 else
520 /* Don't allow a quit within the converter.
521 When the user types C-g, he would be surprised
522 if by luck it came during a converter. */
523 count = SPECPDL_INDEX ();
524 specbind (Qinhibit_quit, Qt);
526 CHECK_SYMBOL (target_type);
527 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
528 /* gcpro is not needed here since nothing but HANDLER_FN
529 is live, and that ought to be a symbol. */
531 if (!NILP (handler_fn))
532 value = call3 (handler_fn,
533 selection_symbol, (local_request ? Qnil : target_type),
534 XCAR (XCDR (local_value)));
535 else
536 value = Qnil;
537 unbind_to (count, Qnil);
540 /* Make sure this value is of a type that we could transmit
541 to another X client. */
543 check = value;
544 if (CONSP (value)
545 && SYMBOLP (XCAR (value)))
546 type = XCAR (value),
547 check = XCDR (value);
549 if (STRINGP (check)
550 || VECTORP (check)
551 || SYMBOLP (check)
552 || INTEGERP (check)
553 || NILP (value))
554 return value;
555 /* Check for a value that cons_to_long could handle. */
556 else if (CONSP (check)
557 && INTEGERP (XCAR (check))
558 && (INTEGERP (XCDR (check))
560 (CONSP (XCDR (check))
561 && INTEGERP (XCAR (XCDR (check)))
562 && NILP (XCDR (XCDR (check))))))
563 return value;
564 else
565 return
566 Fsignal (Qerror,
567 Fcons (build_string ("invalid data returned by selection-conversion function"),
568 Fcons (handler_fn, Fcons (value, Qnil))));
571 /* Subroutines of x_reply_selection_request. */
573 /* Send a SelectionNotify event to the requestor with property=None,
574 meaning we were unable to do what they wanted. */
576 static void
577 x_decline_selection_request (event)
578 struct input_event *event;
580 XSelectionEvent reply;
581 int count;
583 reply.type = SelectionNotify;
584 reply.display = SELECTION_EVENT_DISPLAY (event);
585 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
586 reply.selection = SELECTION_EVENT_SELECTION (event);
587 reply.time = SELECTION_EVENT_TIME (event);
588 reply.target = SELECTION_EVENT_TARGET (event);
589 reply.property = None;
591 /* The reason for the error may be that the receiver has
592 died in the meantime. Handle that case. */
593 BLOCK_INPUT;
594 count = x_catch_errors (reply.display);
595 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
596 XFlush (reply.display);
597 x_uncatch_errors (reply.display, count);
598 UNBLOCK_INPUT;
601 /* This is the selection request currently being processed.
602 It is set to zero when the request is fully processed. */
603 static struct input_event *x_selection_current_request;
605 /* Display info in x_selection_request. */
607 static struct x_display_info *selection_request_dpyinfo;
609 /* Used as an unwind-protect clause so that, if a selection-converter signals
610 an error, we tell the requester that we were unable to do what they wanted
611 before we throw to top-level or go into the debugger or whatever. */
613 static Lisp_Object
614 x_selection_request_lisp_error (ignore)
615 Lisp_Object ignore;
617 if (x_selection_current_request != 0
618 && selection_request_dpyinfo->display)
619 x_decline_selection_request (x_selection_current_request);
620 return Qnil;
624 /* This stuff is so that INCR selections are reentrant (that is, so we can
625 be servicing multiple INCR selection requests simultaneously.) I haven't
626 actually tested that yet. */
628 /* Keep a list of the property changes that are awaited. */
630 struct prop_location
632 int identifier;
633 Display *display;
634 Window window;
635 Atom property;
636 int desired_state;
637 int arrived;
638 struct prop_location *next;
641 static struct prop_location *expect_property_change ();
642 static void wait_for_property_change ();
643 static void unexpect_property_change ();
644 static int waiting_for_other_props_on_window ();
646 static int prop_location_identifier;
648 static Lisp_Object property_change_reply;
650 static struct prop_location *property_change_reply_object;
652 static struct prop_location *property_change_wait_list;
654 static Lisp_Object
655 queue_selection_requests_unwind (tem)
656 Lisp_Object tem;
658 x_stop_queuing_selection_requests ();
659 return Qnil;
662 /* Return some frame whose display info is DPYINFO.
663 Return nil if there is none. */
665 static Lisp_Object
666 some_frame_on_display (dpyinfo)
667 struct x_display_info *dpyinfo;
669 Lisp_Object list, frame;
671 FOR_EACH_FRAME (list, frame)
673 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
674 return frame;
677 return Qnil;
680 /* Send the reply to a selection request event EVENT.
681 TYPE is the type of selection data requested.
682 DATA and SIZE describe the data to send, already converted.
683 FORMAT is the unit-size (in bits) of the data to be transmitted. */
685 static void
686 x_reply_selection_request (event, format, data, size, type)
687 struct input_event *event;
688 int format, size;
689 unsigned char *data;
690 Atom type;
692 XSelectionEvent reply;
693 Display *display = SELECTION_EVENT_DISPLAY (event);
694 Window window = SELECTION_EVENT_REQUESTOR (event);
695 int bytes_remaining;
696 int format_bytes = format/8;
697 int max_bytes = SELECTION_QUANTUM (display);
698 struct x_display_info *dpyinfo = x_display_info_for_display (display);
699 int count;
701 if (max_bytes > MAX_SELECTION_QUANTUM)
702 max_bytes = MAX_SELECTION_QUANTUM;
704 reply.type = SelectionNotify;
705 reply.display = display;
706 reply.requestor = window;
707 reply.selection = SELECTION_EVENT_SELECTION (event);
708 reply.time = SELECTION_EVENT_TIME (event);
709 reply.target = SELECTION_EVENT_TARGET (event);
710 reply.property = SELECTION_EVENT_PROPERTY (event);
711 if (reply.property == None)
712 reply.property = reply.target;
714 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
715 BLOCK_INPUT;
716 count = x_catch_errors (display);
718 #ifdef TRACE_SELECTION
720 static int cnt;
721 char *sel = XGetAtomName (display, reply.selection);
722 char *tgt = XGetAtomName (display, reply.target);
723 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
724 if (sel) XFree (sel);
725 if (tgt) XFree (tgt);
727 #endif /* TRACE_SELECTION */
729 /* Store the data on the requested property.
730 If the selection is large, only store the first N bytes of it.
732 bytes_remaining = size * format_bytes;
733 if (bytes_remaining <= max_bytes)
735 /* Send all the data at once, with minimal handshaking. */
736 TRACE1 ("Sending all %d bytes", bytes_remaining);
737 XChangeProperty (display, window, reply.property, type, format,
738 PropModeReplace, data, size);
739 /* At this point, the selection was successfully stored; ack it. */
740 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
742 else
744 /* Send an INCR selection. */
745 struct prop_location *wait_object;
746 int had_errors;
747 Lisp_Object frame;
749 frame = some_frame_on_display (dpyinfo);
751 /* If the display no longer has frames, we can't expect
752 to get many more selection requests from it, so don't
753 bother trying to queue them. */
754 if (!NILP (frame))
756 x_start_queuing_selection_requests ();
758 record_unwind_protect (queue_selection_requests_unwind,
759 Qnil);
762 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
763 error ("Attempt to transfer an INCR to ourself!");
765 TRACE2 ("Start sending %d bytes incrementally (%s)",
766 bytes_remaining, XGetAtomName (display, reply.property));
767 wait_object = expect_property_change (display, window, reply.property,
768 PropertyDelete);
770 TRACE1 ("Set %s to number of bytes to send",
771 XGetAtomName (display, reply.property));
772 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
773 32, PropModeReplace,
774 (unsigned char *) &bytes_remaining, 1);
775 XSelectInput (display, window, PropertyChangeMask);
777 /* Tell 'em the INCR data is there... */
778 TRACE0 ("Send SelectionNotify event");
779 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
780 XFlush (display);
782 had_errors = x_had_errors_p (display);
783 UNBLOCK_INPUT;
785 /* First, wait for the requester to ack by deleting the property.
786 This can run random lisp code (process handlers) or signal. */
787 if (! had_errors)
789 TRACE1 ("Waiting for ACK (deletion of %s)",
790 XGetAtomName (display, reply.property));
791 wait_for_property_change (wait_object);
793 else
794 unexpect_property_change (wait_object);
796 TRACE0 ("Got ACK");
797 while (bytes_remaining)
799 int i = ((bytes_remaining < max_bytes)
800 ? bytes_remaining
801 : max_bytes);
803 BLOCK_INPUT;
805 wait_object
806 = expect_property_change (display, window, reply.property,
807 PropertyDelete);
809 TRACE1 ("Sending increment of %d bytes", i);
810 TRACE1 ("Set %s to increment data",
811 XGetAtomName (display, reply.property));
813 /* Append the next chunk of data to the property. */
814 XChangeProperty (display, window, reply.property, type, format,
815 PropModeAppend, data, i / format_bytes);
816 bytes_remaining -= i;
817 data += i;
818 XFlush (display);
819 had_errors = x_had_errors_p (display);
820 UNBLOCK_INPUT;
822 if (had_errors)
823 break;
825 /* Now wait for the requester to ack this chunk by deleting the
826 property. This can run random lisp code or signal. */
827 TRACE1 ("Waiting for increment ACK (deletion of %s)",
828 XGetAtomName (display, reply.property));
829 wait_for_property_change (wait_object);
832 /* Now write a zero-length chunk to the property to tell the
833 requester that we're done. */
834 BLOCK_INPUT;
835 if (! waiting_for_other_props_on_window (display, window))
836 XSelectInput (display, window, 0L);
838 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
839 XGetAtomName (display, reply.property));
840 XChangeProperty (display, window, reply.property, type, format,
841 PropModeReplace, data, 0);
842 TRACE0 ("Done sending incrementally");
845 /* rms, 2003-01-03: I think I have fixed this bug. */
846 /* The window we're communicating with may have been deleted
847 in the meantime (that's a real situation from a bug report).
848 In this case, there may be events in the event queue still
849 refering to the deleted window, and we'll get a BadWindow error
850 in XTread_socket when processing the events. I don't have
851 an idea how to fix that. gerd, 2001-01-98. */
852 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
853 delivered before uncatch errors. */
854 XSync (display, False);
855 UNBLOCK_INPUT;
857 /* GTK queues events in addition to the queue in Xlib. So we
858 UNBLOCK to enter the event loop and get possible errors delivered,
859 and then BLOCK again because x_uncatch_errors requires it. */
860 BLOCK_INPUT;
861 x_uncatch_errors (display, count);
862 UNBLOCK_INPUT;
865 /* Handle a SelectionRequest event EVENT.
866 This is called from keyboard.c when such an event is found in the queue. */
868 static void
869 x_handle_selection_request (event)
870 struct input_event *event;
872 struct gcpro gcpro1, gcpro2, gcpro3;
873 Lisp_Object local_selection_data;
874 Lisp_Object selection_symbol;
875 Lisp_Object target_symbol;
876 Lisp_Object converted_selection;
877 Time local_selection_time;
878 Lisp_Object successful_p;
879 int count;
880 struct x_display_info *dpyinfo
881 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
883 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
884 (unsigned long) SELECTION_EVENT_REQUESTOR (event),
885 (unsigned long) SELECTION_EVENT_TIME (event));
887 local_selection_data = Qnil;
888 target_symbol = Qnil;
889 converted_selection = Qnil;
890 successful_p = Qnil;
892 GCPRO3 (local_selection_data, converted_selection, target_symbol);
894 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
895 SELECTION_EVENT_SELECTION (event));
897 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
899 if (NILP (local_selection_data))
901 /* Someone asked for the selection, but we don't have it any more.
903 x_decline_selection_request (event);
904 goto DONE;
907 local_selection_time = (Time)
908 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
910 if (SELECTION_EVENT_TIME (event) != CurrentTime
911 && local_selection_time > SELECTION_EVENT_TIME (event))
913 /* Someone asked for the selection, and we have one, but not the one
914 they're looking for.
916 x_decline_selection_request (event);
917 goto DONE;
920 x_selection_current_request = event;
921 count = SPECPDL_INDEX ();
922 selection_request_dpyinfo = dpyinfo;
923 record_unwind_protect (x_selection_request_lisp_error, Qnil);
925 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
926 SELECTION_EVENT_TARGET (event));
928 #if 0 /* #### MULTIPLE doesn't work yet */
929 if (EQ (target_symbol, QMULTIPLE))
930 target_symbol = fetch_multiple_target (event);
931 #endif
933 /* Convert lisp objects back into binary data */
935 converted_selection
936 = x_get_local_selection (selection_symbol, target_symbol, 0);
938 if (! NILP (converted_selection))
940 unsigned char *data;
941 unsigned int size;
942 int format;
943 Atom type;
944 int nofree;
946 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
947 converted_selection,
948 &data, &type, &size, &format, &nofree);
950 x_reply_selection_request (event, format, data, size, type);
951 successful_p = Qt;
953 /* Indicate we have successfully processed this event. */
954 x_selection_current_request = 0;
956 /* Use xfree, not XFree, because lisp_data_to_selection_data
957 calls xmalloc itself. */
958 if (!nofree)
959 xfree (data);
961 unbind_to (count, Qnil);
963 DONE:
965 /* Let random lisp code notice that the selection has been asked for. */
967 Lisp_Object rest;
968 rest = Vx_sent_selection_functions;
969 if (!EQ (rest, Qunbound))
970 for (; CONSP (rest); rest = Fcdr (rest))
971 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
974 UNGCPRO;
977 /* Handle a SelectionClear event EVENT, which indicates that some
978 client cleared out our previously asserted selection.
979 This is called from keyboard.c when such an event is found in the queue. */
981 static void
982 x_handle_selection_clear (event)
983 struct input_event *event;
985 Display *display = SELECTION_EVENT_DISPLAY (event);
986 Atom selection = SELECTION_EVENT_SELECTION (event);
987 Time changed_owner_time = SELECTION_EVENT_TIME (event);
989 Lisp_Object selection_symbol, local_selection_data;
990 Time local_selection_time;
991 struct x_display_info *dpyinfo = x_display_info_for_display (display);
992 struct x_display_info *t_dpyinfo;
994 TRACE0 ("x_handle_selection_clear");
996 /* If the new selection owner is also Emacs,
997 don't clear the new selection. */
998 BLOCK_INPUT;
999 /* Check each display on the same terminal,
1000 to see if this Emacs job now owns the selection
1001 through that display. */
1002 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1003 if (t_dpyinfo->kboard == dpyinfo->kboard)
1005 Window owner_window
1006 = XGetSelectionOwner (t_dpyinfo->display, selection);
1007 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1009 UNBLOCK_INPUT;
1010 return;
1013 UNBLOCK_INPUT;
1015 selection_symbol = x_atom_to_symbol (display, selection);
1017 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1019 /* Well, we already believe that we don't own it, so that's just fine. */
1020 if (NILP (local_selection_data)) return;
1022 local_selection_time = (Time)
1023 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
1025 /* This SelectionClear is for a selection that we no longer own, so we can
1026 disregard it. (That is, we have reasserted the selection since this
1027 request was generated.) */
1029 if (changed_owner_time != CurrentTime
1030 && local_selection_time > changed_owner_time)
1031 return;
1033 /* Otherwise, we're really honest and truly being told to drop it.
1034 Don't use Fdelq as that may QUIT;. */
1036 if (EQ (local_selection_data, Fcar (Vselection_alist)))
1037 Vselection_alist = Fcdr (Vselection_alist);
1038 else
1040 Lisp_Object rest;
1041 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1042 if (EQ (local_selection_data, Fcar (XCDR (rest))))
1044 XSETCDR (rest, Fcdr (XCDR (rest)));
1045 break;
1049 /* Let random lisp code notice that the selection has been stolen. */
1052 Lisp_Object rest;
1053 rest = Vx_lost_selection_functions;
1054 if (!EQ (rest, Qunbound))
1056 for (; CONSP (rest); rest = Fcdr (rest))
1057 call1 (Fcar (rest), selection_symbol);
1058 prepare_menu_bars ();
1059 redisplay_preserve_echo_area (20);
1064 void
1065 x_handle_selection_event (event)
1066 struct input_event *event;
1068 TRACE0 ("x_handle_selection_event");
1070 if (event->kind == SELECTION_REQUEST_EVENT)
1072 if (x_queue_selection_requests)
1073 x_queue_event (event);
1074 else
1075 x_handle_selection_request (event);
1077 else
1078 x_handle_selection_clear (event);
1082 /* Clear all selections that were made from frame F.
1083 We do this when about to delete a frame. */
1085 void
1086 x_clear_frame_selections (f)
1087 FRAME_PTR f;
1089 Lisp_Object frame;
1090 Lisp_Object rest;
1092 XSETFRAME (frame, f);
1094 /* Otherwise, we're really honest and truly being told to drop it.
1095 Don't use Fdelq as that may QUIT;. */
1097 /* Delete elements from the beginning of Vselection_alist. */
1098 while (!NILP (Vselection_alist)
1099 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1101 /* Let random Lisp code notice that the selection has been stolen. */
1102 Lisp_Object hooks, selection_symbol;
1104 hooks = Vx_lost_selection_functions;
1105 selection_symbol = Fcar (Fcar (Vselection_alist));
1107 if (!EQ (hooks, Qunbound))
1109 for (; CONSP (hooks); hooks = Fcdr (hooks))
1110 call1 (Fcar (hooks), selection_symbol);
1111 #if 0 /* This can crash when deleting a frame
1112 from x_connection_closed. Anyway, it seems unnecessary;
1113 something else should cause a redisplay. */
1114 redisplay_preserve_echo_area (21);
1115 #endif
1118 Vselection_alist = Fcdr (Vselection_alist);
1121 /* Delete elements after the beginning of Vselection_alist. */
1122 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1123 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
1125 /* Let random Lisp code notice that the selection has been stolen. */
1126 Lisp_Object hooks, selection_symbol;
1128 hooks = Vx_lost_selection_functions;
1129 selection_symbol = Fcar (Fcar (XCDR (rest)));
1131 if (!EQ (hooks, Qunbound))
1133 for (; CONSP (hooks); hooks = Fcdr (hooks))
1134 call1 (Fcar (hooks), selection_symbol);
1135 #if 0 /* See above */
1136 redisplay_preserve_echo_area (22);
1137 #endif
1139 XSETCDR (rest, Fcdr (XCDR (rest)));
1140 break;
1144 /* Nonzero if any properties for DISPLAY and WINDOW
1145 are on the list of what we are waiting for. */
1147 static int
1148 waiting_for_other_props_on_window (display, window)
1149 Display *display;
1150 Window window;
1152 struct prop_location *rest = property_change_wait_list;
1153 while (rest)
1154 if (rest->display == display && rest->window == window)
1155 return 1;
1156 else
1157 rest = rest->next;
1158 return 0;
1161 /* Add an entry to the list of property changes we are waiting for.
1162 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1163 The return value is a number that uniquely identifies
1164 this awaited property change. */
1166 static struct prop_location *
1167 expect_property_change (display, window, property, state)
1168 Display *display;
1169 Window window;
1170 Atom property;
1171 int state;
1173 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1174 pl->identifier = ++prop_location_identifier;
1175 pl->display = display;
1176 pl->window = window;
1177 pl->property = property;
1178 pl->desired_state = state;
1179 pl->next = property_change_wait_list;
1180 pl->arrived = 0;
1181 property_change_wait_list = pl;
1182 return pl;
1185 /* Delete an entry from the list of property changes we are waiting for.
1186 IDENTIFIER is the number that uniquely identifies the entry. */
1188 static void
1189 unexpect_property_change (location)
1190 struct prop_location *location;
1192 struct prop_location *prev = 0, *rest = property_change_wait_list;
1193 while (rest)
1195 if (rest == location)
1197 if (prev)
1198 prev->next = rest->next;
1199 else
1200 property_change_wait_list = rest->next;
1201 xfree (rest);
1202 return;
1204 prev = rest;
1205 rest = rest->next;
1209 /* Remove the property change expectation element for IDENTIFIER. */
1211 static Lisp_Object
1212 wait_for_property_change_unwind (loc)
1213 Lisp_Object loc;
1215 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1217 unexpect_property_change (location);
1218 if (location == property_change_reply_object)
1219 property_change_reply_object = 0;
1220 return Qnil;
1223 /* Actually wait for a property change.
1224 IDENTIFIER should be the value that expect_property_change returned. */
1226 static void
1227 wait_for_property_change (location)
1228 struct prop_location *location;
1230 int secs, usecs;
1231 int count = SPECPDL_INDEX ();
1233 if (property_change_reply_object)
1234 abort ();
1236 /* Make sure to do unexpect_property_change if we quit or err. */
1237 record_unwind_protect (wait_for_property_change_unwind,
1238 make_save_value (location, 0));
1240 XSETCAR (property_change_reply, Qnil);
1241 property_change_reply_object = location;
1243 /* If the event we are waiting for arrives beyond here, it will set
1244 property_change_reply, because property_change_reply_object says so. */
1245 if (! location->arrived)
1247 secs = x_selection_timeout / 1000;
1248 usecs = (x_selection_timeout % 1000) * 1000;
1249 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1250 wait_reading_process_output (secs, usecs, 0, 0,
1251 property_change_reply, NULL, 0);
1253 if (NILP (XCAR (property_change_reply)))
1255 TRACE0 (" Timed out");
1256 error ("Timed out waiting for property-notify event");
1260 unbind_to (count, Qnil);
1263 /* Called from XTread_socket in response to a PropertyNotify event. */
1265 void
1266 x_handle_property_notify (event)
1267 XPropertyEvent *event;
1269 struct prop_location *prev = 0, *rest = property_change_wait_list;
1271 while (rest)
1273 if (!rest->arrived
1274 && rest->property == event->atom
1275 && rest->window == event->window
1276 && rest->display == event->display
1277 && rest->desired_state == event->state)
1279 TRACE2 ("Expected %s of property %s",
1280 (event->state == PropertyDelete ? "deletion" : "change"),
1281 XGetAtomName (event->display, event->atom));
1283 rest->arrived = 1;
1285 /* If this is the one wait_for_property_change is waiting for,
1286 tell it to wake up. */
1287 if (rest == property_change_reply_object)
1288 XSETCAR (property_change_reply, Qt);
1290 return;
1293 prev = rest;
1294 rest = rest->next;
1300 #if 0 /* #### MULTIPLE doesn't work yet */
1302 static Lisp_Object
1303 fetch_multiple_target (event)
1304 XSelectionRequestEvent *event;
1306 Display *display = event->display;
1307 Window window = event->requestor;
1308 Atom target = event->target;
1309 Atom selection_atom = event->selection;
1310 int result;
1312 return
1313 Fcons (QMULTIPLE,
1314 x_get_window_property_as_lisp_data (display, window, target,
1315 QMULTIPLE, selection_atom));
1318 static Lisp_Object
1319 copy_multiple_data (obj)
1320 Lisp_Object obj;
1322 Lisp_Object vec;
1323 int i;
1324 int size;
1325 if (CONSP (obj))
1326 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1328 CHECK_VECTOR (obj);
1329 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1330 for (i = 0; i < size; i++)
1332 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1333 CHECK_VECTOR (vec2);
1334 if (XVECTOR (vec2)->size != 2)
1335 /* ??? Confusing error message */
1336 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1337 Fcons (vec2, Qnil)));
1338 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1339 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1340 = XVECTOR (vec2)->contents [0];
1341 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1342 = XVECTOR (vec2)->contents [1];
1344 return vec;
1347 #endif
1350 /* Variables for communication with x_handle_selection_notify. */
1351 static Atom reading_which_selection;
1352 static Lisp_Object reading_selection_reply;
1353 static Window reading_selection_window;
1355 /* Do protocol to read selection-data from the server.
1356 Converts this to Lisp data and returns it. */
1358 static Lisp_Object
1359 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1360 Lisp_Object selection_symbol, target_type, time_stamp;
1362 struct frame *sf = SELECTED_FRAME ();
1363 Window requestor_window = FRAME_X_WINDOW (sf);
1364 Display *display = FRAME_X_DISPLAY (sf);
1365 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1366 Time requestor_time = last_event_timestamp;
1367 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1368 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1369 Atom type_atom;
1370 int secs, usecs;
1371 int count;
1372 Lisp_Object frame;
1374 if (CONSP (target_type))
1375 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1376 else
1377 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1379 if (! NILP (time_stamp))
1381 if (CONSP (time_stamp))
1382 requestor_time = (Time) cons_to_long (time_stamp);
1383 else if (INTEGERP (time_stamp))
1384 requestor_time = (Time) XUINT (time_stamp);
1385 else if (FLOATP (time_stamp))
1386 requestor_time = (Time) XFLOAT (time_stamp);
1387 else
1388 error ("TIME_STAMP must be cons or number");
1391 BLOCK_INPUT;
1393 count = x_catch_errors (display);
1395 TRACE2 ("Get selection %s, type %s",
1396 XGetAtomName (display, type_atom),
1397 XGetAtomName (display, target_property));
1399 XConvertSelection (display, selection_atom, type_atom, target_property,
1400 requestor_window, requestor_time);
1401 XFlush (display);
1403 /* Prepare to block until the reply has been read. */
1404 reading_selection_window = requestor_window;
1405 reading_which_selection = selection_atom;
1406 XSETCAR (reading_selection_reply, Qnil);
1408 frame = some_frame_on_display (dpyinfo);
1410 /* If the display no longer has frames, we can't expect
1411 to get many more selection requests from it, so don't
1412 bother trying to queue them. */
1413 if (!NILP (frame))
1415 x_start_queuing_selection_requests ();
1417 record_unwind_protect (queue_selection_requests_unwind,
1418 Qnil);
1420 UNBLOCK_INPUT;
1422 /* This allows quits. Also, don't wait forever. */
1423 secs = x_selection_timeout / 1000;
1424 usecs = (x_selection_timeout % 1000) * 1000;
1425 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1426 wait_reading_process_output (secs, usecs, 0, 0,
1427 reading_selection_reply, NULL, 0);
1428 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1430 BLOCK_INPUT;
1431 x_check_errors (display, "Cannot get selection: %s");
1432 x_uncatch_errors (display, count);
1433 UNBLOCK_INPUT;
1435 if (NILP (XCAR (reading_selection_reply)))
1436 error ("Timed out waiting for reply from selection owner");
1437 if (EQ (XCAR (reading_selection_reply), Qlambda))
1438 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
1440 /* Otherwise, the selection is waiting for us on the requested property. */
1441 return
1442 x_get_window_property_as_lisp_data (display, requestor_window,
1443 target_property, target_type,
1444 selection_atom);
1447 /* Subroutines of x_get_window_property_as_lisp_data */
1449 /* Use xfree, not XFree, to free the data obtained with this function. */
1451 static void
1452 x_get_window_property (display, window, property, data_ret, bytes_ret,
1453 actual_type_ret, actual_format_ret, actual_size_ret,
1454 delete_p)
1455 Display *display;
1456 Window window;
1457 Atom property;
1458 unsigned char **data_ret;
1459 int *bytes_ret;
1460 Atom *actual_type_ret;
1461 int *actual_format_ret;
1462 unsigned long *actual_size_ret;
1463 int delete_p;
1465 int total_size;
1466 unsigned long bytes_remaining;
1467 int offset = 0;
1468 unsigned char *tmp_data = 0;
1469 int result;
1470 int buffer_size = SELECTION_QUANTUM (display);
1472 if (buffer_size > MAX_SELECTION_QUANTUM)
1473 buffer_size = MAX_SELECTION_QUANTUM;
1475 BLOCK_INPUT;
1477 /* First probe the thing to find out how big it is. */
1478 result = XGetWindowProperty (display, window, property,
1479 0L, 0L, False, AnyPropertyType,
1480 actual_type_ret, actual_format_ret,
1481 actual_size_ret,
1482 &bytes_remaining, &tmp_data);
1483 if (result != Success)
1485 UNBLOCK_INPUT;
1486 *data_ret = 0;
1487 *bytes_ret = 0;
1488 return;
1491 /* This was allocated by Xlib, so use XFree. */
1492 XFree ((char *) tmp_data);
1494 if (*actual_type_ret == None || *actual_format_ret == 0)
1496 UNBLOCK_INPUT;
1497 return;
1500 total_size = bytes_remaining + 1;
1501 *data_ret = (unsigned char *) xmalloc (total_size);
1503 /* Now read, until we've gotten it all. */
1504 while (bytes_remaining)
1506 #ifdef TRACE_SELECTION
1507 int last = bytes_remaining;
1508 #endif
1509 result
1510 = XGetWindowProperty (display, window, property,
1511 (long)offset/4, (long)buffer_size/4,
1512 False,
1513 AnyPropertyType,
1514 actual_type_ret, actual_format_ret,
1515 actual_size_ret, &bytes_remaining, &tmp_data);
1517 TRACE2 ("Read %ld bytes from property %s",
1518 last - bytes_remaining,
1519 XGetAtomName (display, property));
1521 /* If this doesn't return Success at this point, it means that
1522 some clod deleted the selection while we were in the midst of
1523 reading it. Deal with that, I guess.... */
1524 if (result != Success)
1525 break;
1526 *actual_size_ret *= *actual_format_ret / 8;
1527 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1528 offset += *actual_size_ret;
1530 /* This was allocated by Xlib, so use XFree. */
1531 XFree ((char *) tmp_data);
1534 XFlush (display);
1535 UNBLOCK_INPUT;
1536 *bytes_ret = offset;
1539 /* Use xfree, not XFree, to free the data obtained with this function. */
1541 static void
1542 receive_incremental_selection (display, window, property, target_type,
1543 min_size_bytes, data_ret, size_bytes_ret,
1544 type_ret, format_ret, size_ret)
1545 Display *display;
1546 Window window;
1547 Atom property;
1548 Lisp_Object target_type; /* for error messages only */
1549 unsigned int min_size_bytes;
1550 unsigned char **data_ret;
1551 int *size_bytes_ret;
1552 Atom *type_ret;
1553 unsigned long *size_ret;
1554 int *format_ret;
1556 int offset = 0;
1557 struct prop_location *wait_object;
1558 *size_bytes_ret = min_size_bytes;
1559 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1561 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1563 /* At this point, we have read an INCR property.
1564 Delete the property to ack it.
1565 (But first, prepare to receive the next event in this handshake.)
1567 Now, we must loop, waiting for the sending window to put a value on
1568 that property, then reading the property, then deleting it to ack.
1569 We are done when the sender places a property of length 0.
1571 BLOCK_INPUT;
1572 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1573 TRACE1 (" Delete property %s",
1574 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1575 XDeleteProperty (display, window, property);
1576 TRACE1 (" Expect new value of property %s",
1577 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1578 wait_object = expect_property_change (display, window, property,
1579 PropertyNewValue);
1580 XFlush (display);
1581 UNBLOCK_INPUT;
1583 while (1)
1585 unsigned char *tmp_data;
1586 int tmp_size_bytes;
1588 TRACE0 (" Wait for property change");
1589 wait_for_property_change (wait_object);
1591 /* expect it again immediately, because x_get_window_property may
1592 .. no it won't, I don't get it.
1593 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1594 TRACE0 (" Get property value");
1595 x_get_window_property (display, window, property,
1596 &tmp_data, &tmp_size_bytes,
1597 type_ret, format_ret, size_ret, 1);
1599 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1601 if (tmp_size_bytes == 0) /* we're done */
1603 TRACE0 ("Done reading incrementally");
1605 if (! waiting_for_other_props_on_window (display, window))
1606 XSelectInput (display, window, STANDARD_EVENT_SET);
1607 /* Use xfree, not XFree, because x_get_window_property
1608 calls xmalloc itself. */
1609 if (tmp_data) xfree (tmp_data);
1610 break;
1613 BLOCK_INPUT;
1614 TRACE1 (" ACK by deleting property %s",
1615 XGetAtomName (display, property));
1616 XDeleteProperty (display, window, property);
1617 wait_object = expect_property_change (display, window, property,
1618 PropertyNewValue);
1619 XFlush (display);
1620 UNBLOCK_INPUT;
1622 if (*size_bytes_ret < offset + tmp_size_bytes)
1624 *size_bytes_ret = offset + tmp_size_bytes;
1625 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1628 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1629 offset += tmp_size_bytes;
1631 /* Use xfree, not XFree, because x_get_window_property
1632 calls xmalloc itself. */
1633 xfree (tmp_data);
1638 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1639 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1640 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1642 static Lisp_Object
1643 x_get_window_property_as_lisp_data (display, window, property, target_type,
1644 selection_atom)
1645 Display *display;
1646 Window window;
1647 Atom property;
1648 Lisp_Object target_type; /* for error messages only */
1649 Atom selection_atom; /* for error messages only */
1651 Atom actual_type;
1652 int actual_format;
1653 unsigned long actual_size;
1654 unsigned char *data = 0;
1655 int bytes = 0;
1656 Lisp_Object val;
1657 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1659 TRACE0 ("Reading selection data");
1661 x_get_window_property (display, window, property, &data, &bytes,
1662 &actual_type, &actual_format, &actual_size, 1);
1663 if (! data)
1665 int there_is_a_selection_owner;
1666 BLOCK_INPUT;
1667 there_is_a_selection_owner
1668 = XGetSelectionOwner (display, selection_atom);
1669 UNBLOCK_INPUT;
1670 Fsignal (Qerror,
1671 there_is_a_selection_owner
1672 ? Fcons (build_string ("selection owner couldn't convert"),
1673 actual_type
1674 ? Fcons (target_type,
1675 Fcons (x_atom_to_symbol (display,
1676 actual_type),
1677 Qnil))
1678 : Fcons (target_type, Qnil))
1679 : Fcons (build_string ("no selection"),
1680 Fcons (x_atom_to_symbol (display,
1681 selection_atom),
1682 Qnil)));
1685 if (actual_type == dpyinfo->Xatom_INCR)
1687 /* That wasn't really the data, just the beginning. */
1689 unsigned int min_size_bytes = * ((unsigned int *) data);
1690 BLOCK_INPUT;
1691 /* Use xfree, not XFree, because x_get_window_property
1692 calls xmalloc itself. */
1693 xfree ((char *) data);
1694 UNBLOCK_INPUT;
1695 receive_incremental_selection (display, window, property, target_type,
1696 min_size_bytes, &data, &bytes,
1697 &actual_type, &actual_format,
1698 &actual_size);
1701 BLOCK_INPUT;
1702 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1703 XDeleteProperty (display, window, property);
1704 XFlush (display);
1705 UNBLOCK_INPUT;
1707 /* It's been read. Now convert it to a lisp object in some semi-rational
1708 manner. */
1709 val = selection_data_to_lisp_data (display, data, bytes,
1710 actual_type, actual_format);
1712 /* Use xfree, not XFree, because x_get_window_property
1713 calls xmalloc itself. */
1714 xfree ((char *) data);
1715 return val;
1718 /* These functions convert from the selection data read from the server into
1719 something that we can use from Lisp, and vice versa.
1721 Type: Format: Size: Lisp Type:
1722 ----- ------- ----- -----------
1723 * 8 * String
1724 ATOM 32 1 Symbol
1725 ATOM 32 > 1 Vector of Symbols
1726 * 16 1 Integer
1727 * 16 > 1 Vector of Integers
1728 * 32 1 if <=16 bits: Integer
1729 if > 16 bits: Cons of top16, bot16
1730 * 32 > 1 Vector of the above
1732 When converting a Lisp number to C, it is assumed to be of format 16 if
1733 it is an integer, and of format 32 if it is a cons of two integers.
1735 When converting a vector of numbers from Lisp to C, it is assumed to be
1736 of format 16 if every element in the vector is an integer, and is assumed
1737 to be of format 32 if any element is a cons of two integers.
1739 When converting an object to C, it may be of the form (SYMBOL . <data>)
1740 where SYMBOL is what we should claim that the type is. Format and
1741 representation are as above. */
1745 static Lisp_Object
1746 selection_data_to_lisp_data (display, data, size, type, format)
1747 Display *display;
1748 unsigned char *data;
1749 Atom type;
1750 int size, format;
1752 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1754 if (type == dpyinfo->Xatom_NULL)
1755 return QNULL;
1757 /* Convert any 8-bit data to a string, for compactness. */
1758 else if (format == 8)
1760 Lisp_Object str, lispy_type;
1762 str = make_unibyte_string ((char *) data, size);
1763 /* Indicate that this string is from foreign selection by a text
1764 property `foreign-selection' so that the caller of
1765 x-get-selection-internal (usually x-get-selection) can know
1766 that the string must be decode. */
1767 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1768 lispy_type = QCOMPOUND_TEXT;
1769 else if (type == dpyinfo->Xatom_UTF8_STRING)
1770 lispy_type = QUTF8_STRING;
1771 else
1772 lispy_type = QSTRING;
1773 Fput_text_property (make_number (0), make_number (size),
1774 Qforeign_selection, lispy_type, str);
1775 return str;
1777 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1778 a vector of symbols.
1780 else if (type == XA_ATOM)
1782 int i;
1783 if (size == sizeof (Atom))
1784 return x_atom_to_symbol (display, *((Atom *) data));
1785 else
1787 Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
1788 make_number (0));
1789 for (i = 0; i < size / sizeof (Atom); i++)
1790 Faset (v, make_number (i),
1791 x_atom_to_symbol (display, ((Atom *) data) [i]));
1792 return v;
1796 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1797 If the number is > 16 bits, convert it to a cons of integers,
1798 16 bits in each half.
1800 else if (format == 32 && size == sizeof (int))
1801 return long_to_cons (((unsigned int *) data) [0]);
1802 else if (format == 16 && size == sizeof (short))
1803 return make_number ((int) (((unsigned short *) data) [0]));
1805 /* Convert any other kind of data to a vector of numbers, represented
1806 as above (as an integer, or a cons of two 16 bit integers.)
1808 else if (format == 16)
1810 int i;
1811 Lisp_Object v;
1812 v = Fmake_vector (make_number (size / 2), make_number (0));
1813 for (i = 0; i < size / 2; i++)
1815 int j = (int) ((unsigned short *) data) [i];
1816 Faset (v, make_number (i), make_number (j));
1818 return v;
1820 else
1822 int i;
1823 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1824 for (i = 0; i < size / 4; i++)
1826 unsigned int j = ((unsigned int *) data) [i];
1827 Faset (v, make_number (i), long_to_cons (j));
1829 return v;
1834 /* Use xfree, not XFree, to free the data obtained with this function. */
1836 static void
1837 lisp_data_to_selection_data (display, obj,
1838 data_ret, type_ret, size_ret,
1839 format_ret, nofree_ret)
1840 Display *display;
1841 Lisp_Object obj;
1842 unsigned char **data_ret;
1843 Atom *type_ret;
1844 unsigned int *size_ret;
1845 int *format_ret;
1846 int *nofree_ret;
1848 Lisp_Object type = Qnil;
1849 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1851 *nofree_ret = 0;
1853 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1855 type = XCAR (obj);
1856 obj = XCDR (obj);
1857 if (CONSP (obj) && NILP (XCDR (obj)))
1858 obj = XCAR (obj);
1861 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1862 { /* This is not the same as declining */
1863 *format_ret = 32;
1864 *size_ret = 0;
1865 *data_ret = 0;
1866 type = QNULL;
1868 else if (STRINGP (obj))
1870 xassert (! STRING_MULTIBYTE (obj));
1871 if (NILP (type))
1872 type = QSTRING;
1873 *format_ret = 8;
1874 *size_ret = SBYTES (obj);
1875 *data_ret = SDATA (obj);
1876 *nofree_ret = 1;
1878 else if (SYMBOLP (obj))
1880 *format_ret = 32;
1881 *size_ret = 1;
1882 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1883 (*data_ret) [sizeof (Atom)] = 0;
1884 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1885 if (NILP (type)) type = QATOM;
1887 else if (INTEGERP (obj)
1888 && XINT (obj) < 0xFFFF
1889 && XINT (obj) > -0xFFFF)
1891 *format_ret = 16;
1892 *size_ret = 1;
1893 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1894 (*data_ret) [sizeof (short)] = 0;
1895 (*(short **) data_ret) [0] = (short) XINT (obj);
1896 if (NILP (type)) type = QINTEGER;
1898 else if (INTEGERP (obj)
1899 || (CONSP (obj) && INTEGERP (XCAR (obj))
1900 && (INTEGERP (XCDR (obj))
1901 || (CONSP (XCDR (obj))
1902 && INTEGERP (XCAR (XCDR (obj)))))))
1904 *format_ret = 32;
1905 *size_ret = 1;
1906 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1907 (*data_ret) [sizeof (long)] = 0;
1908 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1909 if (NILP (type)) type = QINTEGER;
1911 else if (VECTORP (obj))
1913 /* Lisp_Vectors may represent a set of ATOMs;
1914 a set of 16 or 32 bit INTEGERs;
1915 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1917 int i;
1919 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1920 /* This vector is an ATOM set */
1922 if (NILP (type)) type = QATOM;
1923 *size_ret = XVECTOR (obj)->size;
1924 *format_ret = 32;
1925 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1926 for (i = 0; i < *size_ret; i++)
1927 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1928 (*(Atom **) data_ret) [i]
1929 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1930 else
1931 Fsignal (Qerror, /* Qselection_error */
1932 Fcons (build_string
1933 ("all elements of selection vector must have same type"),
1934 Fcons (obj, Qnil)));
1936 #if 0 /* #### MULTIPLE doesn't work yet */
1937 else if (VECTORP (XVECTOR (obj)->contents [0]))
1938 /* This vector is an ATOM_PAIR set */
1940 if (NILP (type)) type = QATOM_PAIR;
1941 *size_ret = XVECTOR (obj)->size;
1942 *format_ret = 32;
1943 *data_ret = (unsigned char *)
1944 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1945 for (i = 0; i < *size_ret; i++)
1946 if (VECTORP (XVECTOR (obj)->contents [i]))
1948 Lisp_Object pair = XVECTOR (obj)->contents [i];
1949 if (XVECTOR (pair)->size != 2)
1950 Fsignal (Qerror,
1951 Fcons (build_string
1952 ("elements of the vector must be vectors of exactly two elements"),
1953 Fcons (pair, Qnil)));
1955 (*(Atom **) data_ret) [i * 2]
1956 = symbol_to_x_atom (dpyinfo, display,
1957 XVECTOR (pair)->contents [0]);
1958 (*(Atom **) data_ret) [(i * 2) + 1]
1959 = symbol_to_x_atom (dpyinfo, display,
1960 XVECTOR (pair)->contents [1]);
1962 else
1963 Fsignal (Qerror,
1964 Fcons (build_string
1965 ("all elements of the vector must be of the same type"),
1966 Fcons (obj, Qnil)));
1969 #endif
1970 else
1971 /* This vector is an INTEGER set, or something like it */
1973 *size_ret = XVECTOR (obj)->size;
1974 if (NILP (type)) type = QINTEGER;
1975 *format_ret = 16;
1976 for (i = 0; i < *size_ret; i++)
1977 if (CONSP (XVECTOR (obj)->contents [i]))
1978 *format_ret = 32;
1979 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1980 Fsignal (Qerror, /* Qselection_error */
1981 Fcons (build_string
1982 ("elements of selection vector must be integers or conses of integers"),
1983 Fcons (obj, Qnil)));
1985 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1986 for (i = 0; i < *size_ret; i++)
1987 if (*format_ret == 32)
1988 (*((unsigned long **) data_ret)) [i]
1989 = cons_to_long (XVECTOR (obj)->contents [i]);
1990 else
1991 (*((unsigned short **) data_ret)) [i]
1992 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1995 else
1996 Fsignal (Qerror, /* Qselection_error */
1997 Fcons (build_string ("unrecognised selection data"),
1998 Fcons (obj, Qnil)));
2000 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2003 static Lisp_Object
2004 clean_local_selection_data (obj)
2005 Lisp_Object obj;
2007 if (CONSP (obj)
2008 && INTEGERP (XCAR (obj))
2009 && CONSP (XCDR (obj))
2010 && INTEGERP (XCAR (XCDR (obj)))
2011 && NILP (XCDR (XCDR (obj))))
2012 obj = Fcons (XCAR (obj), XCDR (obj));
2014 if (CONSP (obj)
2015 && INTEGERP (XCAR (obj))
2016 && INTEGERP (XCDR (obj)))
2018 if (XINT (XCAR (obj)) == 0)
2019 return XCDR (obj);
2020 if (XINT (XCAR (obj)) == -1)
2021 return make_number (- XINT (XCDR (obj)));
2023 if (VECTORP (obj))
2025 int i;
2026 int size = XVECTOR (obj)->size;
2027 Lisp_Object copy;
2028 if (size == 1)
2029 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2030 copy = Fmake_vector (make_number (size), Qnil);
2031 for (i = 0; i < size; i++)
2032 XVECTOR (copy)->contents [i]
2033 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2034 return copy;
2036 return obj;
2039 /* Called from XTread_socket to handle SelectionNotify events.
2040 If it's the selection we are waiting for, stop waiting
2041 by setting the car of reading_selection_reply to non-nil.
2042 We store t there if the reply is successful, lambda if not. */
2044 void
2045 x_handle_selection_notify (event)
2046 XSelectionEvent *event;
2048 if (event->requestor != reading_selection_window)
2049 return;
2050 if (event->selection != reading_which_selection)
2051 return;
2053 TRACE0 ("Received SelectionNotify");
2054 XSETCAR (reading_selection_reply,
2055 (event->property != 0 ? Qt : Qlambda));
2059 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2060 Sx_own_selection_internal, 2, 2, 0,
2061 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2062 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2063 \(Those are literal upper-case symbol names, since that's what X expects.)
2064 VALUE is typically a string, or a cons of two markers, but may be
2065 anything that the functions on `selection-converter-alist' know about. */)
2066 (selection_name, selection_value)
2067 Lisp_Object selection_name, selection_value;
2069 check_x ();
2070 CHECK_SYMBOL (selection_name);
2071 if (NILP (selection_value)) error ("selection-value may not be nil");
2072 x_own_selection (selection_name, selection_value);
2073 return selection_value;
2077 /* Request the selection value from the owner. If we are the owner,
2078 simply return our selection value. If we are not the owner, this
2079 will block until all of the data has arrived. */
2081 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2082 Sx_get_selection_internal, 2, 3, 0,
2083 doc: /* Return text selected from some X window.
2084 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2085 \(Those are literal upper-case symbol names, since that's what X expects.)
2086 TYPE is the type of data desired, typically `STRING'.
2087 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2088 selections. If omitted, defaults to the time for the last event. */)
2089 (selection_symbol, target_type, time_stamp)
2090 Lisp_Object selection_symbol, target_type, time_stamp;
2092 Lisp_Object val = Qnil;
2093 struct gcpro gcpro1, gcpro2;
2094 GCPRO2 (target_type, val); /* we store newly consed data into these */
2095 check_x ();
2096 CHECK_SYMBOL (selection_symbol);
2098 #if 0 /* #### MULTIPLE doesn't work yet */
2099 if (CONSP (target_type)
2100 && XCAR (target_type) == QMULTIPLE)
2102 CHECK_VECTOR (XCDR (target_type));
2103 /* So we don't destructively modify this... */
2104 target_type = copy_multiple_data (target_type);
2106 else
2107 #endif
2108 CHECK_SYMBOL (target_type);
2110 val = x_get_local_selection (selection_symbol, target_type, 1);
2112 if (NILP (val))
2114 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2115 goto DONE;
2118 if (CONSP (val)
2119 && SYMBOLP (XCAR (val)))
2121 val = XCDR (val);
2122 if (CONSP (val) && NILP (XCDR (val)))
2123 val = XCAR (val);
2125 val = clean_local_selection_data (val);
2126 DONE:
2127 UNGCPRO;
2128 return val;
2131 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2132 Sx_disown_selection_internal, 1, 2, 0,
2133 doc: /* If we own the selection SELECTION, disown it.
2134 Disowning it means there is no such selection. */)
2135 (selection, time)
2136 Lisp_Object selection;
2137 Lisp_Object time;
2139 Time timestamp;
2140 Atom selection_atom;
2141 struct selection_input_event event;
2142 Display *display;
2143 struct x_display_info *dpyinfo;
2144 struct frame *sf = SELECTED_FRAME ();
2146 check_x ();
2147 display = FRAME_X_DISPLAY (sf);
2148 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2149 CHECK_SYMBOL (selection);
2150 if (NILP (time))
2151 timestamp = last_event_timestamp;
2152 else
2153 timestamp = cons_to_long (time);
2155 if (NILP (assq_no_quit (selection, Vselection_alist)))
2156 return Qnil; /* Don't disown the selection when we're not the owner. */
2158 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2160 BLOCK_INPUT;
2161 XSetSelectionOwner (display, selection_atom, None, timestamp);
2162 UNBLOCK_INPUT;
2164 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2165 generated for a window which owns the selection when that window sets
2166 the selection owner to None. The NCD server does, the MIT Sun4 server
2167 doesn't. So we synthesize one; this means we might get two, but
2168 that's ok, because the second one won't have any effect. */
2169 SELECTION_EVENT_DISPLAY (&event) = display;
2170 SELECTION_EVENT_SELECTION (&event) = selection_atom;
2171 SELECTION_EVENT_TIME (&event) = timestamp;
2172 x_handle_selection_clear ((struct input_event *) &event);
2174 return Qt;
2177 /* Get rid of all the selections in buffer BUFFER.
2178 This is used when we kill a buffer. */
2180 void
2181 x_disown_buffer_selections (buffer)
2182 Lisp_Object buffer;
2184 Lisp_Object tail;
2185 struct buffer *buf = XBUFFER (buffer);
2187 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2189 Lisp_Object elt, value;
2190 elt = XCAR (tail);
2191 value = XCDR (elt);
2192 if (CONSP (value) && MARKERP (XCAR (value))
2193 && XMARKER (XCAR (value))->buffer == buf)
2194 Fx_disown_selection_internal (XCAR (elt), Qnil);
2198 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2199 0, 1, 0,
2200 doc: /* Whether the current Emacs process owns the given X Selection.
2201 The arg should be the name of the selection in question, typically one of
2202 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2203 \(Those are literal upper-case symbol names, since that's what X expects.)
2204 For convenience, the symbol nil is the same as `PRIMARY',
2205 and t is the same as `SECONDARY'. */)
2206 (selection)
2207 Lisp_Object selection;
2209 check_x ();
2210 CHECK_SYMBOL (selection);
2211 if (EQ (selection, Qnil)) selection = QPRIMARY;
2212 if (EQ (selection, Qt)) selection = QSECONDARY;
2214 if (NILP (Fassq (selection, Vselection_alist)))
2215 return Qnil;
2216 return Qt;
2219 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2220 0, 1, 0,
2221 doc: /* Whether there is an owner for the given X Selection.
2222 The arg should be the name of the selection in question, typically one of
2223 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2224 \(Those are literal upper-case symbol names, since that's what X expects.)
2225 For convenience, the symbol nil is the same as `PRIMARY',
2226 and t is the same as `SECONDARY'. */)
2227 (selection)
2228 Lisp_Object selection;
2230 Window owner;
2231 Atom atom;
2232 Display *dpy;
2233 struct frame *sf = SELECTED_FRAME ();
2235 /* It should be safe to call this before we have an X frame. */
2236 if (! FRAME_X_P (sf))
2237 return Qnil;
2239 dpy = FRAME_X_DISPLAY (sf);
2240 CHECK_SYMBOL (selection);
2241 if (!NILP (Fx_selection_owner_p (selection)))
2242 return Qt;
2243 if (EQ (selection, Qnil)) selection = QPRIMARY;
2244 if (EQ (selection, Qt)) selection = QSECONDARY;
2245 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2246 if (atom == 0)
2247 return Qnil;
2248 BLOCK_INPUT;
2249 owner = XGetSelectionOwner (dpy, atom);
2250 UNBLOCK_INPUT;
2251 return (owner ? Qt : Qnil);
2255 #ifdef CUT_BUFFER_SUPPORT
2257 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2258 static void
2259 initialize_cut_buffers (display, window)
2260 Display *display;
2261 Window window;
2263 unsigned char *data = (unsigned char *) "";
2264 BLOCK_INPUT;
2265 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2266 PropModeAppend, data, 0)
2267 FROB (XA_CUT_BUFFER0);
2268 FROB (XA_CUT_BUFFER1);
2269 FROB (XA_CUT_BUFFER2);
2270 FROB (XA_CUT_BUFFER3);
2271 FROB (XA_CUT_BUFFER4);
2272 FROB (XA_CUT_BUFFER5);
2273 FROB (XA_CUT_BUFFER6);
2274 FROB (XA_CUT_BUFFER7);
2275 #undef FROB
2276 UNBLOCK_INPUT;
2280 #define CHECK_CUT_BUFFER(symbol) \
2281 { CHECK_SYMBOL ((symbol)); \
2282 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2283 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2284 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2285 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2286 Fsignal (Qerror, \
2287 Fcons (build_string ("doesn't name a cut buffer"), \
2288 Fcons ((symbol), Qnil))); \
2291 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2292 Sx_get_cut_buffer_internal, 1, 1, 0,
2293 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2294 (buffer)
2295 Lisp_Object buffer;
2297 Window window;
2298 Atom buffer_atom;
2299 unsigned char *data;
2300 int bytes;
2301 Atom type;
2302 int format;
2303 unsigned long size;
2304 Lisp_Object ret;
2305 Display *display;
2306 struct x_display_info *dpyinfo;
2307 struct frame *sf = SELECTED_FRAME ();
2309 check_x ();
2310 display = FRAME_X_DISPLAY (sf);
2311 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2312 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2313 CHECK_CUT_BUFFER (buffer);
2314 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2316 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2317 &type, &format, &size, 0);
2318 if (!data || !format)
2319 return Qnil;
2321 if (format != 8 || type != XA_STRING)
2322 Fsignal (Qerror,
2323 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2324 Fcons (x_atom_to_symbol (display, type),
2325 Fcons (make_number (format), Qnil))));
2327 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2328 /* Use xfree, not XFree, because x_get_window_property
2329 calls xmalloc itself. */
2330 xfree (data);
2331 return ret;
2335 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2336 Sx_store_cut_buffer_internal, 2, 2, 0,
2337 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2338 (buffer, string)
2339 Lisp_Object buffer, string;
2341 Window window;
2342 Atom buffer_atom;
2343 unsigned char *data;
2344 int bytes;
2345 int bytes_remaining;
2346 int max_bytes;
2347 Display *display;
2348 struct frame *sf = SELECTED_FRAME ();
2350 check_x ();
2351 display = FRAME_X_DISPLAY (sf);
2352 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2354 max_bytes = SELECTION_QUANTUM (display);
2355 if (max_bytes > MAX_SELECTION_QUANTUM)
2356 max_bytes = MAX_SELECTION_QUANTUM;
2358 CHECK_CUT_BUFFER (buffer);
2359 CHECK_STRING (string);
2360 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2361 display, buffer);
2362 data = (unsigned char *) SDATA (string);
2363 bytes = SBYTES (string);
2364 bytes_remaining = bytes;
2366 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2368 initialize_cut_buffers (display, window);
2369 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2372 BLOCK_INPUT;
2374 /* Don't mess up with an empty value. */
2375 if (!bytes_remaining)
2376 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2377 PropModeReplace, data, 0);
2379 while (bytes_remaining)
2381 int chunk = (bytes_remaining < max_bytes
2382 ? bytes_remaining : max_bytes);
2383 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2384 (bytes_remaining == bytes
2385 ? PropModeReplace
2386 : PropModeAppend),
2387 data, chunk);
2388 data += chunk;
2389 bytes_remaining -= chunk;
2391 UNBLOCK_INPUT;
2392 return string;
2396 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2397 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2398 doc: /* Rotate the values of the cut buffers by the given number of step.
2399 Positive means shift the values forward, negative means backward. */)
2401 Lisp_Object n;
2403 Window window;
2404 Atom props[8];
2405 Display *display;
2406 struct frame *sf = SELECTED_FRAME ();
2408 check_x ();
2409 display = FRAME_X_DISPLAY (sf);
2410 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2411 CHECK_NUMBER (n);
2412 if (XINT (n) == 0)
2413 return n;
2414 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2416 initialize_cut_buffers (display, window);
2417 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2420 props[0] = XA_CUT_BUFFER0;
2421 props[1] = XA_CUT_BUFFER1;
2422 props[2] = XA_CUT_BUFFER2;
2423 props[3] = XA_CUT_BUFFER3;
2424 props[4] = XA_CUT_BUFFER4;
2425 props[5] = XA_CUT_BUFFER5;
2426 props[6] = XA_CUT_BUFFER6;
2427 props[7] = XA_CUT_BUFFER7;
2428 BLOCK_INPUT;
2429 XRotateWindowProperties (display, window, props, 8, XINT (n));
2430 UNBLOCK_INPUT;
2431 return n;
2434 #endif
2436 /***********************************************************************
2437 Drag and drop support
2438 ***********************************************************************/
2439 /* Check that lisp values are of correct type for x_fill_property_data.
2440 That is, number, string or a cons with two numbers (low and high 16
2441 bit parts of a 32 bit number). */
2444 x_check_property_data (data)
2445 Lisp_Object data;
2447 Lisp_Object iter;
2448 int size = 0;
2450 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2452 Lisp_Object o = XCAR (iter);
2454 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2455 size = -1;
2456 else if (CONSP (o) &&
2457 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2458 size = -1;
2461 return size;
2464 /* Convert lisp values to a C array. Values may be a number, a string
2465 which is taken as an X atom name and converted to the atom value, or
2466 a cons containing the two 16 bit parts of a 32 bit number.
2468 DPY is the display use to look up X atoms.
2469 DATA is a Lisp list of values to be converted.
2470 RET is the C array that contains the converted values. It is assumed
2471 it is big enough to hol all values.
2472 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2473 be stored in RET. */
2475 void
2476 x_fill_property_data (dpy, data, ret, format)
2477 Display *dpy;
2478 Lisp_Object data;
2479 void *ret;
2480 int format;
2482 CARD32 val;
2483 CARD32 *d32 = (CARD32 *) ret;
2484 CARD16 *d16 = (CARD16 *) ret;
2485 CARD8 *d08 = (CARD8 *) ret;
2486 Lisp_Object iter;
2488 for (iter = data; CONSP (iter); iter = XCDR (iter))
2490 Lisp_Object o = XCAR (iter);
2492 if (INTEGERP (o))
2493 val = (CARD32) XFASTINT (o);
2494 else if (FLOATP (o))
2495 val = (CARD32) XFLOAT (o);
2496 else if (CONSP (o))
2497 val = (CARD32) cons_to_long (o);
2498 else if (STRINGP (o))
2500 BLOCK_INPUT;
2501 val = XInternAtom (dpy, (char *) SDATA (o), False);
2502 UNBLOCK_INPUT;
2504 else
2505 error ("Wrong type, must be string, number or cons");
2507 if (format == 8)
2508 *d08++ = (CARD8) val;
2509 else if (format == 16)
2510 *d16++ = (CARD16) val;
2511 else
2512 *d32++ = val;
2516 /* Convert an array of C values to a Lisp list.
2517 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2518 DATA is a C array of values to be converted.
2519 TYPE is the type of the data. Only XA_ATOM is special, it converts
2520 each number in DATA to its corresponfing X atom as a symbol.
2521 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2522 be stored in RET.
2523 SIZE is the number of elements in DATA.
2525 Also see comment for selection_data_to_lisp_data above. */
2527 Lisp_Object
2528 x_property_data_to_lisp (f, data, type, format, size)
2529 struct frame *f;
2530 unsigned char *data;
2531 Atom type;
2532 int format;
2533 unsigned long size;
2535 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2536 data, size*format/8, type, format);
2539 /* Get the mouse position frame relative coordinates. */
2541 static void
2542 mouse_position_for_drop (f, x, y)
2543 FRAME_PTR f;
2544 int *x;
2545 int *y;
2547 Window root, dummy_window;
2548 int dummy;
2550 BLOCK_INPUT;
2552 XQueryPointer (FRAME_X_DISPLAY (f),
2553 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2555 /* The root window which contains the pointer. */
2556 &root,
2558 /* Window pointer is on, not used */
2559 &dummy_window,
2561 /* The position on that root window. */
2562 x, y,
2564 /* x/y in dummy_window coordinates, not used. */
2565 &dummy, &dummy,
2567 /* Modifier keys and pointer buttons, about which
2568 we don't care. */
2569 (unsigned int *) &dummy);
2572 /* Absolute to relative. */
2573 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2574 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2576 UNBLOCK_INPUT;
2579 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2580 Sx_get_atom_name, 1, 2, 0,
2581 doc: /* Return the X atom name for VALUE as a string.
2582 VALUE may be a number or a cons where the car is the upper 16 bits and
2583 the cdr is the lower 16 bits of a 32 bit value.
2584 Use the display for FRAME or the current frame if FRAME is not given or nil.
2586 If the value is 0 or the atom is not known, return the empty string. */)
2587 (value, frame)
2588 Lisp_Object value, frame;
2590 struct frame *f = check_x_frame (frame);
2591 char *name = 0;
2592 Lisp_Object ret = Qnil;
2593 int count;
2594 Display *dpy = FRAME_X_DISPLAY (f);
2595 Atom atom;
2597 if (INTEGERP (value))
2598 atom = (Atom) XUINT (value);
2599 else if (FLOATP (value))
2600 atom = (Atom) XFLOAT (value);
2601 else if (CONSP (value))
2602 atom = (Atom) cons_to_long (value);
2603 else
2604 error ("Wrong type, value must be number or cons");
2606 BLOCK_INPUT;
2607 count = x_catch_errors (dpy);
2609 name = atom ? XGetAtomName (dpy, atom) : "";
2611 if (! x_had_errors_p (dpy))
2612 ret = make_string (name, strlen (name));
2614 x_uncatch_errors (dpy, count);
2616 if (atom && name) XFree (name);
2617 if (NILP (ret)) ret = make_string ("", 0);
2619 UNBLOCK_INPUT;
2621 return ret;
2624 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2625 TODO: Check if this client event really is a DND event? */
2628 x_handle_dnd_message (f, event, dpyinfo, bufp)
2629 struct frame *f;
2630 XClientMessageEvent *event;
2631 struct x_display_info *dpyinfo;
2632 struct input_event *bufp;
2634 Lisp_Object vec;
2635 Lisp_Object frame;
2636 unsigned long size = (8*sizeof (event->data))/event->format;
2637 int x, y;
2639 XSETFRAME (frame, f);
2641 vec = Fmake_vector (make_number (4), Qnil);
2642 AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2643 event->message_type));
2644 AREF (vec, 1) = frame;
2645 AREF (vec, 2) = make_number (event->format);
2646 AREF (vec, 3) = x_property_data_to_lisp (f,
2647 event->data.b,
2648 event->message_type,
2649 event->format,
2650 size);
2652 mouse_position_for_drop (f, &x, &y);
2653 bufp->kind = DRAG_N_DROP_EVENT;
2654 bufp->frame_or_window = Fcons (frame, vec);
2655 bufp->timestamp = CurrentTime;
2656 bufp->x = make_number (x);
2657 bufp->y = make_number (y);
2658 bufp->arg = Qnil;
2659 bufp->modifiers = 0;
2661 return 1;
2664 DEFUN ("x-send-client-message", Fx_send_client_event,
2665 Sx_send_client_message, 6, 6, 0,
2666 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2668 For DISPLAY, specify either a frame or a display name (a string).
2669 If DISPLAY is nil, that stands for the selected frame's display.
2670 DEST may be a number, in which case it is a Window id. The value 0 may
2671 be used to send to the root window of the DISPLAY.
2672 If DEST is a cons, it is converted to a 32 bit number
2673 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2674 number is then used as a window id.
2675 If DEST is a frame the event is sent to the outer window of that frame.
2676 Nil means the currently selected frame.
2677 If DEST is the string "PointerWindow" the event is sent to the window that
2678 contains the pointer. If DEST is the string "InputFocus" the event is
2679 sent to the window that has the input focus.
2680 FROM is the frame sending the event. Use nil for currently selected frame.
2681 MESSAGE-TYPE is the name of an Atom as a string.
2682 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2683 bits. VALUES is a list of numbers, cons and/or strings containing the values
2684 to send. If a value is a string, it is converted to an Atom and the value of
2685 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2686 with the high 16 bits from the car and the lower 16 bit from the cdr.
2687 If more values than fits into the event is given, the excessive values
2688 are ignored. */)
2689 (display, dest, from, message_type, format, values)
2690 Lisp_Object display, dest, from, message_type, format, values;
2692 struct x_display_info *dpyinfo = check_x_display_info (display);
2693 Window wdest;
2694 XEvent event;
2695 Lisp_Object cons;
2696 int size;
2697 struct frame *f = check_x_frame (from);
2698 int count;
2699 int to_root;
2701 CHECK_STRING (message_type);
2702 CHECK_NUMBER (format);
2703 CHECK_CONS (values);
2705 if (x_check_property_data (values) == -1)
2706 error ("Bad data in VALUES, must be number, cons or string");
2708 event.xclient.type = ClientMessage;
2709 event.xclient.format = XFASTINT (format);
2711 if (event.xclient.format != 8 && event.xclient.format != 16
2712 && event.xclient.format != 32)
2713 error ("FORMAT must be one of 8, 16 or 32");
2715 if (FRAMEP (dest) || NILP (dest))
2717 struct frame *fdest = check_x_frame (dest);
2718 wdest = FRAME_OUTER_WINDOW (fdest);
2720 else if (STRINGP (dest))
2722 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2723 wdest = PointerWindow;
2724 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2725 wdest = InputFocus;
2726 else
2727 error ("DEST as a string must be one of PointerWindow or InputFocus");
2729 else if (INTEGERP (dest))
2730 wdest = (Window) XFASTINT (dest);
2731 else if (FLOATP (dest))
2732 wdest = (Window) XFLOAT (dest);
2733 else if (CONSP (dest))
2735 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2736 error ("Both car and cdr for DEST must be numbers");
2737 else
2738 wdest = (Window) cons_to_long (dest);
2740 else
2741 error ("DEST must be a frame, nil, string, number or cons");
2743 if (wdest == 0) wdest = dpyinfo->root_window;
2744 to_root = wdest == dpyinfo->root_window;
2746 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2749 BLOCK_INPUT;
2751 event.xclient.message_type
2752 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2753 event.xclient.display = dpyinfo->display;
2755 /* Some clients (metacity for example) expects sending window to be here
2756 when sending to the root window. */
2757 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2759 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2760 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2761 event.xclient.format);
2763 /* If event mask is 0 the event is sent to the client that created
2764 the destination window. But if we are sending to the root window,
2765 there is no such client. Then we set the event mask to 0xffff. The
2766 event then goes to clients selecting for events on the root window. */
2767 count = x_catch_errors (dpyinfo->display);
2769 int propagate = to_root ? False : True;
2770 unsigned mask = to_root ? 0xffff : 0;
2771 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2772 XFlush (dpyinfo->display);
2774 x_uncatch_errors (dpyinfo->display, count);
2775 UNBLOCK_INPUT;
2777 return Qnil;
2781 void
2782 syms_of_xselect ()
2784 defsubr (&Sx_get_selection_internal);
2785 defsubr (&Sx_own_selection_internal);
2786 defsubr (&Sx_disown_selection_internal);
2787 defsubr (&Sx_selection_owner_p);
2788 defsubr (&Sx_selection_exists_p);
2790 #ifdef CUT_BUFFER_SUPPORT
2791 defsubr (&Sx_get_cut_buffer_internal);
2792 defsubr (&Sx_store_cut_buffer_internal);
2793 defsubr (&Sx_rotate_cut_buffers_internal);
2794 #endif
2796 defsubr (&Sx_get_atom_name);
2797 defsubr (&Sx_send_client_message);
2799 reading_selection_reply = Fcons (Qnil, Qnil);
2800 staticpro (&reading_selection_reply);
2801 reading_selection_window = 0;
2802 reading_which_selection = 0;
2804 property_change_wait_list = 0;
2805 prop_location_identifier = 0;
2806 property_change_reply = Fcons (Qnil, Qnil);
2807 staticpro (&property_change_reply);
2809 Vselection_alist = Qnil;
2810 staticpro (&Vselection_alist);
2812 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2813 doc: /* An alist associating X Windows selection-types with functions.
2814 These functions are called to convert the selection, with three args:
2815 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2816 a desired type to which the selection should be converted;
2817 and the local selection value (whatever was given to `x-own-selection').
2819 The function should return the value to send to the X server
2820 \(typically a string). A return value of nil
2821 means that the conversion could not be done.
2822 A return value which is the symbol `NULL'
2823 means that a side-effect was executed,
2824 and there is no meaningful selection value. */);
2825 Vselection_converter_alist = Qnil;
2827 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2828 doc: /* A list of functions to be called when Emacs loses an X selection.
2829 \(This happens when some other X client makes its own selection
2830 or when a Lisp program explicitly clears the selection.)
2831 The functions are called with one argument, the selection type
2832 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2833 Vx_lost_selection_functions = Qnil;
2835 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2836 doc: /* A list of functions to be called when Emacs answers a selection request.
2837 The functions are called with four arguments:
2838 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2839 - the selection-type which Emacs was asked to convert the
2840 selection into before sending (for example, `STRING' or `LENGTH');
2841 - a flag indicating success or failure for responding to the request.
2842 We might have failed (and declined the request) for any number of reasons,
2843 including being asked for a selection that we no longer own, or being asked
2844 to convert into a type that we don't know about or that is inappropriate.
2845 This hook doesn't let you change the behavior of Emacs's selection replies,
2846 it merely informs you that they have happened. */);
2847 Vx_sent_selection_functions = Qnil;
2849 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2850 doc: /* Coding system for communicating with other X clients.
2851 When sending or receiving text via cut_buffer, selection, and clipboard,
2852 the text is encoded or decoded by this coding system.
2853 The default value is `compound-text-with-extensions'. */);
2854 Vselection_coding_system = intern ("compound-text-with-extensions");
2856 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2857 doc: /* Coding system for the next communication with other X clients.
2858 Usually, `selection-coding-system' is used for communicating with
2859 other X clients. But, if this variable is set, it is used for the
2860 next communication only. After the communication, this variable is
2861 set to nil. */);
2862 Vnext_selection_coding_system = Qnil;
2864 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2865 doc: /* Number of milliseconds to wait for a selection reply.
2866 If the selection owner doesn't reply in this time, we give up.
2867 A value of 0 means wait as long as necessary. This is initialized from the
2868 \"*selectionTimeout\" resource. */);
2869 x_selection_timeout = 0;
2871 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2872 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2873 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2874 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2875 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2876 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2877 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2878 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2879 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
2880 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2881 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2882 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2883 QINCR = intern ("INCR"); staticpro (&QINCR);
2884 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2885 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2886 QATOM = intern ("ATOM"); staticpro (&QATOM);
2887 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2888 QNULL = intern ("NULL"); staticpro (&QNULL);
2889 Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
2890 staticpro (&Qcompound_text_with_extensions);
2892 #ifdef CUT_BUFFER_SUPPORT
2893 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2894 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2895 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2896 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2897 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2898 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2899 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2900 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2901 #endif
2903 Qforeign_selection = intern ("foreign-selection");
2904 staticpro (&Qforeign_selection);
2907 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2908 (do not change this comment) */