(Thumbnails): Minor cleanup.
[emacs.git] / src / xselect.c
blob9c2c221c02190d0e80c8b2e1d50f3075fb10e081
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 Free Software Foundation, Inc.
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., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, 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 Lisp_Object x_catch_errors_unwind P_ ((Lisp_Object));
59 static void x_reply_selection_request P_ ((struct input_event *, int,
60 unsigned char *, int, Atom));
61 static int waiting_for_other_props_on_window P_ ((Display *, Window));
62 static struct prop_location *expect_property_change P_ ((Display *, Window,
63 Atom, int));
64 static void unexpect_property_change P_ ((struct prop_location *));
65 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
66 static void wait_for_property_change P_ ((struct prop_location *));
67 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
68 Lisp_Object,
69 Lisp_Object));
70 static void x_get_window_property P_ ((Display *, Window, Atom,
71 unsigned char **, int *,
72 Atom *, int *, unsigned long *, int));
73 static void receive_incremental_selection P_ ((Display *, Window, Atom,
74 Lisp_Object, unsigned,
75 unsigned char **, int *,
76 Atom *, int *, unsigned long *));
77 static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
78 Window, Atom,
79 Lisp_Object, Atom));
80 static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
81 int, Atom, int));
82 static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
83 unsigned char **, Atom *,
84 unsigned *, int *, int *));
85 static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
86 static void initialize_cut_buffers P_ ((Display *, Window));
89 /* Printing traces to stderr. */
91 #ifdef TRACE_SELECTION
92 #define TRACE0(fmt) \
93 fprintf (stderr, "%d: " fmt "\n", getpid ())
94 #define TRACE1(fmt, a0) \
95 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
96 #define TRACE2(fmt, a0, a1) \
97 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
98 #define TRACE3(fmt, a0, a1, a2) \
99 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
100 #else
101 #define TRACE0(fmt) (void) 0
102 #define TRACE1(fmt, a0) (void) 0
103 #define TRACE2(fmt, a0, a1) (void) 0
104 #define TRACE3(fmt, a0, a1) (void) 0
105 #endif
108 #define CUT_BUFFER_SUPPORT
110 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
111 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
112 QATOM_PAIR;
114 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
115 Lisp_Object QUTF8_STRING; /* This is a type of selection. */
117 Lisp_Object Qcompound_text_with_extensions;
119 #ifdef CUT_BUFFER_SUPPORT
120 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
121 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
122 #endif
124 static Lisp_Object Vx_lost_selection_functions;
125 static Lisp_Object Vx_sent_selection_functions;
126 /* Coding system for communicating with other X clients via cutbuffer,
127 selection, and clipboard. */
128 static Lisp_Object Vselection_coding_system;
130 /* Coding system for the next communicating with other X clients. */
131 static Lisp_Object Vnext_selection_coding_system;
133 static Lisp_Object Qforeign_selection;
135 /* If this is a smaller number than the max-request-size of the display,
136 emacs will use INCR selection transfer when the selection is larger
137 than this. The max-request-size is usually around 64k, so if you want
138 emacs to use incremental selection transfers when the selection is
139 smaller than that, set this. I added this mostly for debugging the
140 incremental transfer stuff, but it might improve server performance. */
141 #define MAX_SELECTION_QUANTUM 0xFFFFFF
143 #ifdef HAVE_X11R4
144 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
145 #else
146 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
147 #endif
149 /* The timestamp of the last input event Emacs received from the X server. */
150 /* Defined in keyboard.c. */
151 extern unsigned long last_event_timestamp;
153 /* This is an association list whose elements are of the form
154 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
155 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
156 SELECTION-VALUE is the value that emacs owns for that selection.
157 It may be any kind of Lisp object.
158 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
159 as a cons of two 16-bit numbers (making a 32 bit time.)
160 FRAME is the frame for which we made the selection.
161 If there is an entry in this alist, then it can be assumed that Emacs owns
162 that selection.
163 The only (eq) parts of this list that are visible from Lisp are the
164 selection-values. */
165 static Lisp_Object Vselection_alist;
167 /* This is an alist whose CARs are selection-types (whose names are the same
168 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
169 call to convert the given Emacs selection value to a string representing
170 the given selection type. This is for Lisp-level extension of the emacs
171 selection handling. */
172 static Lisp_Object Vselection_converter_alist;
174 /* If the selection owner takes too long to reply to a selection request,
175 we give up on it. This is in milliseconds (0 = no timeout.) */
176 static EMACS_INT x_selection_timeout;
180 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
181 handling. */
183 struct selection_event_queue
185 struct input_event event;
186 struct selection_event_queue *next;
189 static struct selection_event_queue *selection_queue;
191 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
193 static int x_queue_selection_requests;
195 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
197 static void
198 x_queue_event (event)
199 struct input_event *event;
201 struct selection_event_queue *queue_tmp;
203 /* Don't queue repeated requests.
204 This only happens for large requests which uses the incremental protocol. */
205 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
207 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
209 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
210 x_decline_selection_request (event);
211 return;
215 queue_tmp
216 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
218 if (queue_tmp != NULL)
220 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
221 queue_tmp->event = *event;
222 queue_tmp->next = selection_queue;
223 selection_queue = queue_tmp;
227 /* Start queuing SELECTION_REQUEST_EVENT events. */
229 static void
230 x_start_queuing_selection_requests ()
232 if (x_queue_selection_requests)
233 abort ();
235 x_queue_selection_requests++;
236 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
239 /* Stop queuing SELECTION_REQUEST_EVENT events. */
241 static void
242 x_stop_queuing_selection_requests ()
244 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
245 --x_queue_selection_requests;
247 /* Take all the queued events and put them back
248 so that they get processed afresh. */
250 while (selection_queue != NULL)
252 struct selection_event_queue *queue_tmp = selection_queue;
253 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
254 kbd_buffer_unget_event (&queue_tmp->event);
255 selection_queue = queue_tmp->next;
256 xfree ((char *)queue_tmp);
261 /* This converts a Lisp symbol to a server Atom, avoiding a server
262 roundtrip whenever possible. */
264 static Atom
265 symbol_to_x_atom (dpyinfo, display, sym)
266 struct x_display_info *dpyinfo;
267 Display *display;
268 Lisp_Object sym;
270 Atom val;
271 if (NILP (sym)) return 0;
272 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
273 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
274 if (EQ (sym, QSTRING)) return XA_STRING;
275 if (EQ (sym, QINTEGER)) return XA_INTEGER;
276 if (EQ (sym, QATOM)) return XA_ATOM;
277 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
278 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
279 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
280 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
281 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
282 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
283 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
284 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
285 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
286 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
287 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
288 #ifdef CUT_BUFFER_SUPPORT
289 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
290 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
291 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
292 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
293 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
294 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
295 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
296 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
297 #endif
298 if (!SYMBOLP (sym)) abort ();
300 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
301 BLOCK_INPUT;
302 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
303 UNBLOCK_INPUT;
304 return val;
308 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
309 and calls to intern whenever possible. */
311 static Lisp_Object
312 x_atom_to_symbol (dpy, atom)
313 Display *dpy;
314 Atom atom;
316 struct x_display_info *dpyinfo;
317 char *str;
318 Lisp_Object val;
320 if (! atom)
321 return Qnil;
323 switch (atom)
325 case XA_PRIMARY:
326 return QPRIMARY;
327 case XA_SECONDARY:
328 return QSECONDARY;
329 case XA_STRING:
330 return QSTRING;
331 case XA_INTEGER:
332 return QINTEGER;
333 case XA_ATOM:
334 return QATOM;
335 #ifdef CUT_BUFFER_SUPPORT
336 case XA_CUT_BUFFER0:
337 return QCUT_BUFFER0;
338 case XA_CUT_BUFFER1:
339 return QCUT_BUFFER1;
340 case XA_CUT_BUFFER2:
341 return QCUT_BUFFER2;
342 case XA_CUT_BUFFER3:
343 return QCUT_BUFFER3;
344 case XA_CUT_BUFFER4:
345 return QCUT_BUFFER4;
346 case XA_CUT_BUFFER5:
347 return QCUT_BUFFER5;
348 case XA_CUT_BUFFER6:
349 return QCUT_BUFFER6;
350 case XA_CUT_BUFFER7:
351 return QCUT_BUFFER7;
352 #endif
355 dpyinfo = x_display_info_for_display (dpy);
356 if (atom == dpyinfo->Xatom_CLIPBOARD)
357 return QCLIPBOARD;
358 if (atom == dpyinfo->Xatom_TIMESTAMP)
359 return QTIMESTAMP;
360 if (atom == dpyinfo->Xatom_TEXT)
361 return QTEXT;
362 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
363 return QCOMPOUND_TEXT;
364 if (atom == dpyinfo->Xatom_UTF8_STRING)
365 return QUTF8_STRING;
366 if (atom == dpyinfo->Xatom_DELETE)
367 return QDELETE;
368 if (atom == dpyinfo->Xatom_MULTIPLE)
369 return QMULTIPLE;
370 if (atom == dpyinfo->Xatom_INCR)
371 return QINCR;
372 if (atom == dpyinfo->Xatom_EMACS_TMP)
373 return QEMACS_TMP;
374 if (atom == dpyinfo->Xatom_TARGETS)
375 return QTARGETS;
376 if (atom == dpyinfo->Xatom_NULL)
377 return QNULL;
379 BLOCK_INPUT;
380 str = XGetAtomName (dpy, atom);
381 UNBLOCK_INPUT;
382 TRACE1 ("XGetAtomName --> %s", str);
383 if (! str) return Qnil;
384 val = intern (str);
385 BLOCK_INPUT;
386 /* This was allocated by Xlib, so use XFree. */
387 XFree (str);
388 UNBLOCK_INPUT;
389 return val;
392 /* Do protocol to assert ourself as a selection owner.
393 Update the Vselection_alist so that we can reply to later requests for
394 our selection. */
396 static void
397 x_own_selection (selection_name, selection_value)
398 Lisp_Object selection_name, selection_value;
400 struct frame *sf = SELECTED_FRAME ();
401 Window selecting_window = FRAME_X_WINDOW (sf);
402 Display *display = FRAME_X_DISPLAY (sf);
403 Time time = last_event_timestamp;
404 Atom selection_atom;
405 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
407 CHECK_SYMBOL (selection_name);
408 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
410 BLOCK_INPUT;
411 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 ();
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;
576 reply.type = SelectionNotify;
577 reply.display = SELECTION_EVENT_DISPLAY (event);
578 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
579 reply.selection = SELECTION_EVENT_SELECTION (event);
580 reply.time = SELECTION_EVENT_TIME (event);
581 reply.target = SELECTION_EVENT_TARGET (event);
582 reply.property = None;
584 /* The reason for the error may be that the receiver has
585 died in the meantime. Handle that case. */
586 BLOCK_INPUT;
587 x_catch_errors (reply.display);
588 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
589 XFlush (reply.display);
590 x_uncatch_errors ();
591 UNBLOCK_INPUT;
594 /* This is the selection request currently being processed.
595 It is set to zero when the request is fully processed. */
596 static struct input_event *x_selection_current_request;
598 /* Display info in x_selection_request. */
600 static struct x_display_info *selection_request_dpyinfo;
602 /* Used as an unwind-protect clause so that, if a selection-converter signals
603 an error, we tell the requester that we were unable to do what they wanted
604 before we throw to top-level or go into the debugger or whatever. */
606 static Lisp_Object
607 x_selection_request_lisp_error (ignore)
608 Lisp_Object ignore;
610 if (x_selection_current_request != 0
611 && selection_request_dpyinfo->display)
612 x_decline_selection_request (x_selection_current_request);
613 return Qnil;
616 static Lisp_Object
617 x_catch_errors_unwind (dummy)
618 Lisp_Object dummy;
620 BLOCK_INPUT;
621 x_uncatch_errors ();
622 UNBLOCK_INPUT;
623 return Qnil;
627 /* This stuff is so that INCR selections are reentrant (that is, so we can
628 be servicing multiple INCR selection requests simultaneously.) I haven't
629 actually tested that yet. */
631 /* Keep a list of the property changes that are awaited. */
633 struct prop_location
635 int identifier;
636 Display *display;
637 Window window;
638 Atom property;
639 int desired_state;
640 int arrived;
641 struct prop_location *next;
644 static struct prop_location *expect_property_change ();
645 static void wait_for_property_change ();
646 static void unexpect_property_change ();
647 static int waiting_for_other_props_on_window ();
649 static int prop_location_identifier;
651 static Lisp_Object property_change_reply;
653 static struct prop_location *property_change_reply_object;
655 static struct prop_location *property_change_wait_list;
657 static Lisp_Object
658 queue_selection_requests_unwind (tem)
659 Lisp_Object tem;
661 x_stop_queuing_selection_requests ();
662 return Qnil;
665 /* Return some frame whose display info is DPYINFO.
666 Return nil if there is none. */
668 static Lisp_Object
669 some_frame_on_display (dpyinfo)
670 struct x_display_info *dpyinfo;
672 Lisp_Object list, frame;
674 FOR_EACH_FRAME (list, frame)
676 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
677 return frame;
680 return Qnil;
683 /* Send the reply to a selection request event EVENT.
684 TYPE is the type of selection data requested.
685 DATA and SIZE describe the data to send, already converted.
686 FORMAT is the unit-size (in bits) of the data to be transmitted. */
688 static void
689 x_reply_selection_request (event, format, data, size, type)
690 struct input_event *event;
691 int format, size;
692 unsigned char *data;
693 Atom type;
695 XSelectionEvent reply;
696 Display *display = SELECTION_EVENT_DISPLAY (event);
697 Window window = SELECTION_EVENT_REQUESTOR (event);
698 int bytes_remaining;
699 int format_bytes = format/8;
700 int max_bytes = SELECTION_QUANTUM (display);
701 struct x_display_info *dpyinfo = x_display_info_for_display (display);
702 int count = SPECPDL_INDEX ();
704 if (max_bytes > MAX_SELECTION_QUANTUM)
705 max_bytes = MAX_SELECTION_QUANTUM;
707 reply.type = SelectionNotify;
708 reply.display = display;
709 reply.requestor = window;
710 reply.selection = SELECTION_EVENT_SELECTION (event);
711 reply.time = SELECTION_EVENT_TIME (event);
712 reply.target = SELECTION_EVENT_TARGET (event);
713 reply.property = SELECTION_EVENT_PROPERTY (event);
714 if (reply.property == None)
715 reply.property = reply.target;
717 BLOCK_INPUT;
718 /* The protected block contains wait_for_property_change, which can
719 run random lisp code (process handlers) or signal. Therefore, we
720 put the x_uncatch_errors call in an unwind. */
721 record_unwind_protect (x_catch_errors_unwind, Qnil);
722 x_catch_errors (display);
724 #ifdef TRACE_SELECTION
726 static int cnt;
727 char *sel = XGetAtomName (display, reply.selection);
728 char *tgt = XGetAtomName (display, reply.target);
729 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
730 if (sel) XFree (sel);
731 if (tgt) XFree (tgt);
733 #endif /* TRACE_SELECTION */
735 /* Store the data on the requested property.
736 If the selection is large, only store the first N bytes of it.
738 bytes_remaining = size * format_bytes;
739 if (bytes_remaining <= max_bytes)
741 /* Send all the data at once, with minimal handshaking. */
742 TRACE1 ("Sending all %d bytes", bytes_remaining);
743 XChangeProperty (display, window, reply.property, type, format,
744 PropModeReplace, data, size);
745 /* At this point, the selection was successfully stored; ack it. */
746 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
748 else
750 /* Send an INCR selection. */
751 struct prop_location *wait_object;
752 int had_errors;
753 Lisp_Object frame;
755 frame = some_frame_on_display (dpyinfo);
757 /* If the display no longer has frames, we can't expect
758 to get many more selection requests from it, so don't
759 bother trying to queue them. */
760 if (!NILP (frame))
762 x_start_queuing_selection_requests ();
764 record_unwind_protect (queue_selection_requests_unwind,
765 Qnil);
768 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
769 error ("Attempt to transfer an INCR to ourself!");
771 TRACE2 ("Start sending %d bytes incrementally (%s)",
772 bytes_remaining, XGetAtomName (display, reply.property));
773 wait_object = expect_property_change (display, window, reply.property,
774 PropertyDelete);
776 TRACE1 ("Set %s to number of bytes to send",
777 XGetAtomName (display, reply.property));
779 /* XChangeProperty expects an array of long even if long is more than
780 32 bits. */
781 long value[1];
783 value[0] = bytes_remaining;
784 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
785 32, PropModeReplace,
786 (unsigned char *) value, 1);
789 XSelectInput (display, window, PropertyChangeMask);
791 /* Tell 'em the INCR data is there... */
792 TRACE0 ("Send SelectionNotify event");
793 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
794 XFlush (display);
796 had_errors = x_had_errors_p (display);
797 UNBLOCK_INPUT;
799 /* First, wait for the requester to ack by deleting the property.
800 This can run random lisp code (process handlers) or signal. */
801 if (! had_errors)
803 TRACE1 ("Waiting for ACK (deletion of %s)",
804 XGetAtomName (display, reply.property));
805 wait_for_property_change (wait_object);
807 else
808 unexpect_property_change (wait_object);
810 TRACE0 ("Got ACK");
811 while (bytes_remaining)
813 int i = ((bytes_remaining < max_bytes)
814 ? bytes_remaining
815 : max_bytes);
817 BLOCK_INPUT;
819 wait_object
820 = expect_property_change (display, window, reply.property,
821 PropertyDelete);
823 TRACE1 ("Sending increment of %d bytes", i);
824 TRACE1 ("Set %s to increment data",
825 XGetAtomName (display, reply.property));
827 /* Append the next chunk of data to the property. */
828 XChangeProperty (display, window, reply.property, type, format,
829 PropModeAppend, data, i / format_bytes);
830 bytes_remaining -= i;
831 data += i;
832 XFlush (display);
833 had_errors = x_had_errors_p (display);
834 UNBLOCK_INPUT;
836 if (had_errors)
837 break;
839 /* Now wait for the requester to ack this chunk by deleting the
840 property. This can run random lisp code or signal. */
841 TRACE1 ("Waiting for increment ACK (deletion of %s)",
842 XGetAtomName (display, reply.property));
843 wait_for_property_change (wait_object);
846 /* Now write a zero-length chunk to the property to tell the
847 requester that we're done. */
848 BLOCK_INPUT;
849 if (! waiting_for_other_props_on_window (display, window))
850 XSelectInput (display, window, 0L);
852 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
853 XGetAtomName (display, reply.property));
854 XChangeProperty (display, window, reply.property, type, format,
855 PropModeReplace, data, 0);
856 TRACE0 ("Done sending incrementally");
859 /* rms, 2003-01-03: I think I have fixed this bug. */
860 /* The window we're communicating with may have been deleted
861 in the meantime (that's a real situation from a bug report).
862 In this case, there may be events in the event queue still
863 refering to the deleted window, and we'll get a BadWindow error
864 in XTread_socket when processing the events. I don't have
865 an idea how to fix that. gerd, 2001-01-98. */
866 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
867 delivered before uncatch errors. */
868 XSync (display, False);
869 UNBLOCK_INPUT;
871 /* GTK queues events in addition to the queue in Xlib. So we
872 UNBLOCK to enter the event loop and get possible errors delivered,
873 and then BLOCK again because x_uncatch_errors requires it. */
874 BLOCK_INPUT;
875 /* This calls x_uncatch_errors. */
876 unbind_to (count, Qnil);
877 UNBLOCK_INPUT;
880 /* Handle a SelectionRequest event EVENT.
881 This is called from keyboard.c when such an event is found in the queue. */
883 static void
884 x_handle_selection_request (event)
885 struct input_event *event;
887 struct gcpro gcpro1, gcpro2, gcpro3;
888 Lisp_Object local_selection_data;
889 Lisp_Object selection_symbol;
890 Lisp_Object target_symbol;
891 Lisp_Object converted_selection;
892 Time local_selection_time;
893 Lisp_Object successful_p;
894 int count;
895 struct x_display_info *dpyinfo
896 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
898 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
899 (unsigned long) SELECTION_EVENT_REQUESTOR (event),
900 (unsigned long) SELECTION_EVENT_TIME (event));
902 local_selection_data = Qnil;
903 target_symbol = Qnil;
904 converted_selection = Qnil;
905 successful_p = Qnil;
907 GCPRO3 (local_selection_data, converted_selection, target_symbol);
909 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
910 SELECTION_EVENT_SELECTION (event));
912 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
914 if (NILP (local_selection_data))
916 /* Someone asked for the selection, but we don't have it any more.
918 x_decline_selection_request (event);
919 goto DONE;
922 local_selection_time = (Time)
923 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
925 if (SELECTION_EVENT_TIME (event) != CurrentTime
926 && local_selection_time > SELECTION_EVENT_TIME (event))
928 /* Someone asked for the selection, and we have one, but not the one
929 they're looking for.
931 x_decline_selection_request (event);
932 goto DONE;
935 x_selection_current_request = event;
936 count = SPECPDL_INDEX ();
937 selection_request_dpyinfo = dpyinfo;
938 record_unwind_protect (x_selection_request_lisp_error, Qnil);
940 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
941 SELECTION_EVENT_TARGET (event));
943 #if 0 /* #### MULTIPLE doesn't work yet */
944 if (EQ (target_symbol, QMULTIPLE))
945 target_symbol = fetch_multiple_target (event);
946 #endif
948 /* Convert lisp objects back into binary data */
950 converted_selection
951 = x_get_local_selection (selection_symbol, target_symbol, 0);
953 if (! NILP (converted_selection))
955 unsigned char *data;
956 unsigned int size;
957 int format;
958 Atom type;
959 int nofree;
961 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
962 converted_selection,
963 &data, &type, &size, &format, &nofree);
965 x_reply_selection_request (event, format, data, size, type);
966 successful_p = Qt;
968 /* Indicate we have successfully processed this event. */
969 x_selection_current_request = 0;
971 /* Use xfree, not XFree, because lisp_data_to_selection_data
972 calls xmalloc itself. */
973 if (!nofree)
974 xfree (data);
976 unbind_to (count, Qnil);
978 DONE:
980 /* Let random lisp code notice that the selection has been asked for. */
982 Lisp_Object rest;
983 rest = Vx_sent_selection_functions;
984 if (!EQ (rest, Qunbound))
985 for (; CONSP (rest); rest = Fcdr (rest))
986 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
989 UNGCPRO;
992 /* Handle a SelectionClear event EVENT, which indicates that some
993 client cleared out our previously asserted selection.
994 This is called from keyboard.c when such an event is found in the queue. */
996 static void
997 x_handle_selection_clear (event)
998 struct input_event *event;
1000 Display *display = SELECTION_EVENT_DISPLAY (event);
1001 Atom selection = SELECTION_EVENT_SELECTION (event);
1002 Time changed_owner_time = SELECTION_EVENT_TIME (event);
1004 Lisp_Object selection_symbol, local_selection_data;
1005 Time local_selection_time;
1006 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1007 struct x_display_info *t_dpyinfo;
1009 TRACE0 ("x_handle_selection_clear");
1011 /* If the new selection owner is also Emacs,
1012 don't clear the new selection. */
1013 BLOCK_INPUT;
1014 /* Check each display on the same terminal,
1015 to see if this Emacs job now owns the selection
1016 through that display. */
1017 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1018 if (t_dpyinfo->kboard == dpyinfo->kboard)
1020 Window owner_window
1021 = XGetSelectionOwner (t_dpyinfo->display, selection);
1022 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1024 UNBLOCK_INPUT;
1025 return;
1028 UNBLOCK_INPUT;
1030 selection_symbol = x_atom_to_symbol (display, selection);
1032 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1034 /* Well, we already believe that we don't own it, so that's just fine. */
1035 if (NILP (local_selection_data)) return;
1037 local_selection_time = (Time)
1038 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
1040 /* This SelectionClear is for a selection that we no longer own, so we can
1041 disregard it. (That is, we have reasserted the selection since this
1042 request was generated.) */
1044 if (changed_owner_time != CurrentTime
1045 && local_selection_time > changed_owner_time)
1046 return;
1048 /* Otherwise, we're really honest and truly being told to drop it.
1049 Don't use Fdelq as that may QUIT;. */
1051 if (EQ (local_selection_data, Fcar (Vselection_alist)))
1052 Vselection_alist = Fcdr (Vselection_alist);
1053 else
1055 Lisp_Object rest;
1056 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1057 if (EQ (local_selection_data, Fcar (XCDR (rest))))
1059 XSETCDR (rest, Fcdr (XCDR (rest)));
1060 break;
1064 /* Let random lisp code notice that the selection has been stolen. */
1067 Lisp_Object rest;
1068 rest = Vx_lost_selection_functions;
1069 if (!EQ (rest, Qunbound))
1071 for (; CONSP (rest); rest = Fcdr (rest))
1072 call1 (Fcar (rest), selection_symbol);
1073 prepare_menu_bars ();
1074 redisplay_preserve_echo_area (20);
1079 void
1080 x_handle_selection_event (event)
1081 struct input_event *event;
1083 TRACE0 ("x_handle_selection_event");
1085 if (event->kind == SELECTION_REQUEST_EVENT)
1087 if (x_queue_selection_requests)
1088 x_queue_event (event);
1089 else
1090 x_handle_selection_request (event);
1092 else
1093 x_handle_selection_clear (event);
1097 /* Clear all selections that were made from frame F.
1098 We do this when about to delete a frame. */
1100 void
1101 x_clear_frame_selections (f)
1102 FRAME_PTR f;
1104 Lisp_Object frame;
1105 Lisp_Object rest;
1107 XSETFRAME (frame, f);
1109 /* Otherwise, we're really honest and truly being told to drop it.
1110 Don't use Fdelq as that may QUIT;. */
1112 /* Delete elements from the beginning of Vselection_alist. */
1113 while (!NILP (Vselection_alist)
1114 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1116 /* Let random Lisp code notice that the selection has been stolen. */
1117 Lisp_Object hooks, selection_symbol;
1119 hooks = Vx_lost_selection_functions;
1120 selection_symbol = Fcar (Fcar (Vselection_alist));
1122 if (!EQ (hooks, Qunbound))
1124 for (; CONSP (hooks); hooks = Fcdr (hooks))
1125 call1 (Fcar (hooks), selection_symbol);
1126 #if 0 /* This can crash when deleting a frame
1127 from x_connection_closed. Anyway, it seems unnecessary;
1128 something else should cause a redisplay. */
1129 redisplay_preserve_echo_area (21);
1130 #endif
1133 Vselection_alist = Fcdr (Vselection_alist);
1136 /* Delete elements after the beginning of Vselection_alist. */
1137 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
1138 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
1140 /* Let random Lisp code notice that the selection has been stolen. */
1141 Lisp_Object hooks, selection_symbol;
1143 hooks = Vx_lost_selection_functions;
1144 selection_symbol = Fcar (Fcar (XCDR (rest)));
1146 if (!EQ (hooks, Qunbound))
1148 for (; CONSP (hooks); hooks = Fcdr (hooks))
1149 call1 (Fcar (hooks), selection_symbol);
1150 #if 0 /* See above */
1151 redisplay_preserve_echo_area (22);
1152 #endif
1154 XSETCDR (rest, Fcdr (XCDR (rest)));
1155 break;
1159 /* Nonzero if any properties for DISPLAY and WINDOW
1160 are on the list of what we are waiting for. */
1162 static int
1163 waiting_for_other_props_on_window (display, window)
1164 Display *display;
1165 Window window;
1167 struct prop_location *rest = property_change_wait_list;
1168 while (rest)
1169 if (rest->display == display && rest->window == window)
1170 return 1;
1171 else
1172 rest = rest->next;
1173 return 0;
1176 /* Add an entry to the list of property changes we are waiting for.
1177 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1178 The return value is a number that uniquely identifies
1179 this awaited property change. */
1181 static struct prop_location *
1182 expect_property_change (display, window, property, state)
1183 Display *display;
1184 Window window;
1185 Atom property;
1186 int state;
1188 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1189 pl->identifier = ++prop_location_identifier;
1190 pl->display = display;
1191 pl->window = window;
1192 pl->property = property;
1193 pl->desired_state = state;
1194 pl->next = property_change_wait_list;
1195 pl->arrived = 0;
1196 property_change_wait_list = pl;
1197 return pl;
1200 /* Delete an entry from the list of property changes we are waiting for.
1201 IDENTIFIER is the number that uniquely identifies the entry. */
1203 static void
1204 unexpect_property_change (location)
1205 struct prop_location *location;
1207 struct prop_location *prev = 0, *rest = property_change_wait_list;
1208 while (rest)
1210 if (rest == location)
1212 if (prev)
1213 prev->next = rest->next;
1214 else
1215 property_change_wait_list = rest->next;
1216 xfree (rest);
1217 return;
1219 prev = rest;
1220 rest = rest->next;
1224 /* Remove the property change expectation element for IDENTIFIER. */
1226 static Lisp_Object
1227 wait_for_property_change_unwind (loc)
1228 Lisp_Object loc;
1230 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1232 unexpect_property_change (location);
1233 if (location == property_change_reply_object)
1234 property_change_reply_object = 0;
1235 return Qnil;
1238 /* Actually wait for a property change.
1239 IDENTIFIER should be the value that expect_property_change returned. */
1241 static void
1242 wait_for_property_change (location)
1243 struct prop_location *location;
1245 int secs, usecs;
1246 int count = SPECPDL_INDEX ();
1248 if (property_change_reply_object)
1249 abort ();
1251 /* Make sure to do unexpect_property_change if we quit or err. */
1252 record_unwind_protect (wait_for_property_change_unwind,
1253 make_save_value (location, 0));
1255 XSETCAR (property_change_reply, Qnil);
1256 property_change_reply_object = location;
1258 /* If the event we are waiting for arrives beyond here, it will set
1259 property_change_reply, because property_change_reply_object says so. */
1260 if (! location->arrived)
1262 secs = x_selection_timeout / 1000;
1263 usecs = (x_selection_timeout % 1000) * 1000;
1264 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1265 wait_reading_process_output (secs, usecs, 0, 0,
1266 property_change_reply, NULL, 0);
1268 if (NILP (XCAR (property_change_reply)))
1270 TRACE0 (" Timed out");
1271 error ("Timed out waiting for property-notify event");
1275 unbind_to (count, Qnil);
1278 /* Called from XTread_socket in response to a PropertyNotify event. */
1280 void
1281 x_handle_property_notify (event)
1282 XPropertyEvent *event;
1284 struct prop_location *prev = 0, *rest = property_change_wait_list;
1286 while (rest)
1288 if (!rest->arrived
1289 && rest->property == event->atom
1290 && rest->window == event->window
1291 && rest->display == event->display
1292 && rest->desired_state == event->state)
1294 TRACE2 ("Expected %s of property %s",
1295 (event->state == PropertyDelete ? "deletion" : "change"),
1296 XGetAtomName (event->display, event->atom));
1298 rest->arrived = 1;
1300 /* If this is the one wait_for_property_change is waiting for,
1301 tell it to wake up. */
1302 if (rest == property_change_reply_object)
1303 XSETCAR (property_change_reply, Qt);
1305 return;
1308 prev = rest;
1309 rest = rest->next;
1315 #if 0 /* #### MULTIPLE doesn't work yet */
1317 static Lisp_Object
1318 fetch_multiple_target (event)
1319 XSelectionRequestEvent *event;
1321 Display *display = event->display;
1322 Window window = event->requestor;
1323 Atom target = event->target;
1324 Atom selection_atom = event->selection;
1325 int result;
1327 return
1328 Fcons (QMULTIPLE,
1329 x_get_window_property_as_lisp_data (display, window, target,
1330 QMULTIPLE, selection_atom));
1333 static Lisp_Object
1334 copy_multiple_data (obj)
1335 Lisp_Object obj;
1337 Lisp_Object vec;
1338 int i;
1339 int size;
1340 if (CONSP (obj))
1341 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1343 CHECK_VECTOR (obj);
1344 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1345 for (i = 0; i < size; i++)
1347 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1348 CHECK_VECTOR (vec2);
1349 if (XVECTOR (vec2)->size != 2)
1350 /* ??? Confusing error message */
1351 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1352 Fcons (vec2, Qnil)));
1353 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1354 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1355 = XVECTOR (vec2)->contents [0];
1356 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1357 = XVECTOR (vec2)->contents [1];
1359 return vec;
1362 #endif
1365 /* Variables for communication with x_handle_selection_notify. */
1366 static Atom reading_which_selection;
1367 static Lisp_Object reading_selection_reply;
1368 static Window reading_selection_window;
1370 /* Do protocol to read selection-data from the server.
1371 Converts this to Lisp data and returns it. */
1373 static Lisp_Object
1374 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1375 Lisp_Object selection_symbol, target_type, time_stamp;
1377 struct frame *sf = SELECTED_FRAME ();
1378 Window requestor_window = FRAME_X_WINDOW (sf);
1379 Display *display = FRAME_X_DISPLAY (sf);
1380 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1381 Time requestor_time = last_event_timestamp;
1382 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1383 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1384 Atom type_atom;
1385 int secs, usecs;
1386 int count = SPECPDL_INDEX ();
1387 Lisp_Object frame;
1389 if (CONSP (target_type))
1390 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1391 else
1392 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1394 if (! NILP (time_stamp))
1396 if (CONSP (time_stamp))
1397 requestor_time = (Time) cons_to_long (time_stamp);
1398 else if (INTEGERP (time_stamp))
1399 requestor_time = (Time) XUINT (time_stamp);
1400 else if (FLOATP (time_stamp))
1401 requestor_time = (Time) XFLOAT_DATA (time_stamp);
1402 else
1403 error ("TIME_STAMP must be cons or number");
1406 BLOCK_INPUT;
1408 /* The protected block contains wait_reading_process_output, which
1409 can run random lisp code (process handlers) or signal.
1410 Therefore, we put the x_uncatch_errors call in an unwind. */
1411 record_unwind_protect (x_catch_errors_unwind, Qnil);
1412 x_catch_errors (display);
1414 TRACE2 ("Get selection %s, type %s",
1415 XGetAtomName (display, type_atom),
1416 XGetAtomName (display, target_property));
1418 XConvertSelection (display, selection_atom, type_atom, target_property,
1419 requestor_window, requestor_time);
1420 XFlush (display);
1422 /* Prepare to block until the reply has been read. */
1423 reading_selection_window = requestor_window;
1424 reading_which_selection = selection_atom;
1425 XSETCAR (reading_selection_reply, Qnil);
1427 frame = some_frame_on_display (dpyinfo);
1429 /* If the display no longer has frames, we can't expect
1430 to get many more selection requests from it, so don't
1431 bother trying to queue them. */
1432 if (!NILP (frame))
1434 x_start_queuing_selection_requests ();
1436 record_unwind_protect (queue_selection_requests_unwind,
1437 Qnil);
1439 UNBLOCK_INPUT;
1441 /* This allows quits. Also, don't wait forever. */
1442 secs = x_selection_timeout / 1000;
1443 usecs = (x_selection_timeout % 1000) * 1000;
1444 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1445 wait_reading_process_output (secs, usecs, 0, 0,
1446 reading_selection_reply, NULL, 0);
1447 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1449 BLOCK_INPUT;
1450 if (x_had_errors_p (display))
1451 error ("Cannot get selection");
1452 /* This calls x_uncatch_errors. */
1453 unbind_to (count, Qnil);
1454 UNBLOCK_INPUT;
1456 if (NILP (XCAR (reading_selection_reply)))
1457 error ("Timed out waiting for reply from selection owner");
1458 if (EQ (XCAR (reading_selection_reply), Qlambda))
1459 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
1461 /* Otherwise, the selection is waiting for us on the requested property. */
1462 return
1463 x_get_window_property_as_lisp_data (display, requestor_window,
1464 target_property, target_type,
1465 selection_atom);
1468 /* Subroutines of x_get_window_property_as_lisp_data */
1470 /* Use xfree, not XFree, to free the data obtained with this function. */
1472 static void
1473 x_get_window_property (display, window, property, data_ret, bytes_ret,
1474 actual_type_ret, actual_format_ret, actual_size_ret,
1475 delete_p)
1476 Display *display;
1477 Window window;
1478 Atom property;
1479 unsigned char **data_ret;
1480 int *bytes_ret;
1481 Atom *actual_type_ret;
1482 int *actual_format_ret;
1483 unsigned long *actual_size_ret;
1484 int delete_p;
1486 int total_size;
1487 unsigned long bytes_remaining;
1488 int offset = 0;
1489 unsigned char *tmp_data = 0;
1490 int result;
1491 int buffer_size = SELECTION_QUANTUM (display);
1493 if (buffer_size > MAX_SELECTION_QUANTUM)
1494 buffer_size = MAX_SELECTION_QUANTUM;
1496 BLOCK_INPUT;
1498 /* First probe the thing to find out how big it is. */
1499 result = XGetWindowProperty (display, window, property,
1500 0L, 0L, False, AnyPropertyType,
1501 actual_type_ret, actual_format_ret,
1502 actual_size_ret,
1503 &bytes_remaining, &tmp_data);
1504 if (result != Success)
1506 UNBLOCK_INPUT;
1507 *data_ret = 0;
1508 *bytes_ret = 0;
1509 return;
1512 /* This was allocated by Xlib, so use XFree. */
1513 XFree ((char *) tmp_data);
1515 if (*actual_type_ret == None || *actual_format_ret == 0)
1517 UNBLOCK_INPUT;
1518 return;
1521 total_size = bytes_remaining + 1;
1522 *data_ret = (unsigned char *) xmalloc (total_size);
1524 /* Now read, until we've gotten it all. */
1525 while (bytes_remaining)
1527 #ifdef TRACE_SELECTION
1528 int last = bytes_remaining;
1529 #endif
1530 result
1531 = XGetWindowProperty (display, window, property,
1532 (long)offset/4, (long)buffer_size/4,
1533 False,
1534 AnyPropertyType,
1535 actual_type_ret, actual_format_ret,
1536 actual_size_ret, &bytes_remaining, &tmp_data);
1538 TRACE2 ("Read %ld bytes from property %s",
1539 last - bytes_remaining,
1540 XGetAtomName (display, property));
1542 /* If this doesn't return Success at this point, it means that
1543 some clod deleted the selection while we were in the midst of
1544 reading it. Deal with that, I guess.... */
1545 if (result != Success)
1546 break;
1548 /* The man page for XGetWindowProperty says:
1549 "If the returned format is 32, the returned data is represented
1550 as a long array and should be cast to that type to obtain the
1551 elements."
1552 This applies even if long is more than 32 bits, the X library
1553 converts from 32 bit elements received from the X server to long
1554 and passes the long array to us. Thus, for that case bcopy can not
1555 be used. We convert to a 32 bit type here, because so much code
1556 assume on that.
1558 The bytes and offsets passed to XGetWindowProperty refers to the
1559 property and those are indeed in 32 bit quantities if format is 32. */
1561 if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1563 unsigned long i;
1564 int *idata = (int *) ((*data_ret) + offset);
1565 long *ldata = (long *) tmp_data;
1567 for (i = 0; i < *actual_size_ret; ++i)
1569 idata[i]= (int) ldata[i];
1570 offset += 4;
1573 else
1575 *actual_size_ret *= *actual_format_ret / 8;
1576 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1577 offset += *actual_size_ret;
1580 /* This was allocated by Xlib, so use XFree. */
1581 XFree ((char *) tmp_data);
1584 XFlush (display);
1585 UNBLOCK_INPUT;
1586 *bytes_ret = offset;
1589 /* Use xfree, not XFree, to free the data obtained with this function. */
1591 static void
1592 receive_incremental_selection (display, window, property, target_type,
1593 min_size_bytes, data_ret, size_bytes_ret,
1594 type_ret, format_ret, size_ret)
1595 Display *display;
1596 Window window;
1597 Atom property;
1598 Lisp_Object target_type; /* for error messages only */
1599 unsigned int min_size_bytes;
1600 unsigned char **data_ret;
1601 int *size_bytes_ret;
1602 Atom *type_ret;
1603 unsigned long *size_ret;
1604 int *format_ret;
1606 int offset = 0;
1607 struct prop_location *wait_object;
1608 *size_bytes_ret = min_size_bytes;
1609 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1611 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1613 /* At this point, we have read an INCR property.
1614 Delete the property to ack it.
1615 (But first, prepare to receive the next event in this handshake.)
1617 Now, we must loop, waiting for the sending window to put a value on
1618 that property, then reading the property, then deleting it to ack.
1619 We are done when the sender places a property of length 0.
1621 BLOCK_INPUT;
1622 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1623 TRACE1 (" Delete property %s",
1624 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1625 XDeleteProperty (display, window, property);
1626 TRACE1 (" Expect new value of property %s",
1627 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1628 wait_object = expect_property_change (display, window, property,
1629 PropertyNewValue);
1630 XFlush (display);
1631 UNBLOCK_INPUT;
1633 while (1)
1635 unsigned char *tmp_data;
1636 int tmp_size_bytes;
1638 TRACE0 (" Wait for property change");
1639 wait_for_property_change (wait_object);
1641 /* expect it again immediately, because x_get_window_property may
1642 .. no it won't, I don't get it.
1643 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1644 TRACE0 (" Get property value");
1645 x_get_window_property (display, window, property,
1646 &tmp_data, &tmp_size_bytes,
1647 type_ret, format_ret, size_ret, 1);
1649 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1651 if (tmp_size_bytes == 0) /* we're done */
1653 TRACE0 ("Done reading incrementally");
1655 if (! waiting_for_other_props_on_window (display, window))
1656 XSelectInput (display, window, STANDARD_EVENT_SET);
1657 /* Use xfree, not XFree, because x_get_window_property
1658 calls xmalloc itself. */
1659 if (tmp_data) xfree (tmp_data);
1660 break;
1663 BLOCK_INPUT;
1664 TRACE1 (" ACK by deleting property %s",
1665 XGetAtomName (display, property));
1666 XDeleteProperty (display, window, property);
1667 wait_object = expect_property_change (display, window, property,
1668 PropertyNewValue);
1669 XFlush (display);
1670 UNBLOCK_INPUT;
1672 if (*size_bytes_ret < offset + tmp_size_bytes)
1674 *size_bytes_ret = offset + tmp_size_bytes;
1675 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1678 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1679 offset += tmp_size_bytes;
1681 /* Use xfree, not XFree, because x_get_window_property
1682 calls xmalloc itself. */
1683 xfree (tmp_data);
1688 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1689 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1690 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1692 static Lisp_Object
1693 x_get_window_property_as_lisp_data (display, window, property, target_type,
1694 selection_atom)
1695 Display *display;
1696 Window window;
1697 Atom property;
1698 Lisp_Object target_type; /* for error messages only */
1699 Atom selection_atom; /* for error messages only */
1701 Atom actual_type;
1702 int actual_format;
1703 unsigned long actual_size;
1704 unsigned char *data = 0;
1705 int bytes = 0;
1706 Lisp_Object val;
1707 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1709 TRACE0 ("Reading selection data");
1711 x_get_window_property (display, window, property, &data, &bytes,
1712 &actual_type, &actual_format, &actual_size, 1);
1713 if (! data)
1715 int there_is_a_selection_owner;
1716 BLOCK_INPUT;
1717 there_is_a_selection_owner
1718 = XGetSelectionOwner (display, selection_atom);
1719 UNBLOCK_INPUT;
1720 Fsignal (Qerror,
1721 there_is_a_selection_owner
1722 ? Fcons (build_string ("selection owner couldn't convert"),
1723 actual_type
1724 ? Fcons (target_type,
1725 Fcons (x_atom_to_symbol (display,
1726 actual_type),
1727 Qnil))
1728 : Fcons (target_type, Qnil))
1729 : Fcons (build_string ("no selection"),
1730 Fcons (x_atom_to_symbol (display,
1731 selection_atom),
1732 Qnil)));
1735 if (actual_type == dpyinfo->Xatom_INCR)
1737 /* That wasn't really the data, just the beginning. */
1739 unsigned int min_size_bytes = * ((unsigned int *) data);
1740 BLOCK_INPUT;
1741 /* Use xfree, not XFree, because x_get_window_property
1742 calls xmalloc itself. */
1743 xfree ((char *) data);
1744 UNBLOCK_INPUT;
1745 receive_incremental_selection (display, window, property, target_type,
1746 min_size_bytes, &data, &bytes,
1747 &actual_type, &actual_format,
1748 &actual_size);
1751 BLOCK_INPUT;
1752 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1753 XDeleteProperty (display, window, property);
1754 XFlush (display);
1755 UNBLOCK_INPUT;
1757 /* It's been read. Now convert it to a lisp object in some semi-rational
1758 manner. */
1759 val = selection_data_to_lisp_data (display, data, bytes,
1760 actual_type, actual_format);
1762 /* Use xfree, not XFree, because x_get_window_property
1763 calls xmalloc itself. */
1764 xfree ((char *) data);
1765 return val;
1768 /* These functions convert from the selection data read from the server into
1769 something that we can use from Lisp, and vice versa.
1771 Type: Format: Size: Lisp Type:
1772 ----- ------- ----- -----------
1773 * 8 * String
1774 ATOM 32 1 Symbol
1775 ATOM 32 > 1 Vector of Symbols
1776 * 16 1 Integer
1777 * 16 > 1 Vector of Integers
1778 * 32 1 if <=16 bits: Integer
1779 if > 16 bits: Cons of top16, bot16
1780 * 32 > 1 Vector of the above
1782 When converting a Lisp number to C, it is assumed to be of format 16 if
1783 it is an integer, and of format 32 if it is a cons of two integers.
1785 When converting a vector of numbers from Lisp to C, it is assumed to be
1786 of format 16 if every element in the vector is an integer, and is assumed
1787 to be of format 32 if any element is a cons of two integers.
1789 When converting an object to C, it may be of the form (SYMBOL . <data>)
1790 where SYMBOL is what we should claim that the type is. Format and
1791 representation are as above.
1793 Important: When format is 32, data should contain an array of int,
1794 not an array of long as the X library returns. This makes a difference
1795 when sizeof(long) != sizeof(int). */
1799 static Lisp_Object
1800 selection_data_to_lisp_data (display, data, size, type, format)
1801 Display *display;
1802 unsigned char *data;
1803 Atom type;
1804 int size, format;
1806 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1808 if (type == dpyinfo->Xatom_NULL)
1809 return QNULL;
1811 /* Convert any 8-bit data to a string, for compactness. */
1812 else if (format == 8)
1814 Lisp_Object str, lispy_type;
1816 str = make_unibyte_string ((char *) data, size);
1817 /* Indicate that this string is from foreign selection by a text
1818 property `foreign-selection' so that the caller of
1819 x-get-selection-internal (usually x-get-selection) can know
1820 that the string must be decode. */
1821 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1822 lispy_type = QCOMPOUND_TEXT;
1823 else if (type == dpyinfo->Xatom_UTF8_STRING)
1824 lispy_type = QUTF8_STRING;
1825 else
1826 lispy_type = QSTRING;
1827 Fput_text_property (make_number (0), make_number (size),
1828 Qforeign_selection, lispy_type, str);
1829 return str;
1831 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1832 a vector of symbols.
1834 else if (type == XA_ATOM)
1836 int i;
1837 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1838 But the callers of these function has made sure the data for
1839 format == 32 is an array of int. Thus, use int instead
1840 of Atom. */
1841 int *idata = (int *) data;
1843 if (size == sizeof (int))
1844 return x_atom_to_symbol (display, (Atom) idata[0]);
1845 else
1847 Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
1848 make_number (0));
1849 for (i = 0; i < size / sizeof (int); i++)
1850 Faset (v, make_number (i),
1851 x_atom_to_symbol (display, (Atom) idata[i]));
1852 return v;
1856 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1857 If the number is > 16 bits, convert it to a cons of integers,
1858 16 bits in each half.
1860 else if (format == 32 && size == sizeof (int))
1861 return long_to_cons (((unsigned int *) data) [0]);
1862 else if (format == 16 && size == sizeof (short))
1863 return make_number ((int) (((unsigned short *) data) [0]));
1865 /* Convert any other kind of data to a vector of numbers, represented
1866 as above (as an integer, or a cons of two 16 bit integers.)
1868 else if (format == 16)
1870 int i;
1871 Lisp_Object v;
1872 v = Fmake_vector (make_number (size / 2), make_number (0));
1873 for (i = 0; i < size / 2; i++)
1875 int j = (int) ((unsigned short *) data) [i];
1876 Faset (v, make_number (i), make_number (j));
1878 return v;
1880 else
1882 int i;
1883 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1884 for (i = 0; i < size / 4; i++)
1886 unsigned int j = ((unsigned int *) data) [i];
1887 Faset (v, make_number (i), long_to_cons (j));
1889 return v;
1894 /* Use xfree, not XFree, to free the data obtained with this function. */
1896 static void
1897 lisp_data_to_selection_data (display, obj,
1898 data_ret, type_ret, size_ret,
1899 format_ret, nofree_ret)
1900 Display *display;
1901 Lisp_Object obj;
1902 unsigned char **data_ret;
1903 Atom *type_ret;
1904 unsigned int *size_ret;
1905 int *format_ret;
1906 int *nofree_ret;
1908 Lisp_Object type = Qnil;
1909 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1911 *nofree_ret = 0;
1913 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1915 type = XCAR (obj);
1916 obj = XCDR (obj);
1917 if (CONSP (obj) && NILP (XCDR (obj)))
1918 obj = XCAR (obj);
1921 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1922 { /* This is not the same as declining */
1923 *format_ret = 32;
1924 *size_ret = 0;
1925 *data_ret = 0;
1926 type = QNULL;
1928 else if (STRINGP (obj))
1930 if (SCHARS (obj) < SBYTES (obj))
1931 /* OBJ is a multibyte string containing a non-ASCII char. */
1932 Fsignal (Qerror, /* Qselection_error */
1933 Fcons (build_string
1934 ("Non-ASCII string must be encoded in advance"),
1935 Fcons (obj, Qnil)));
1936 if (NILP (type))
1937 type = QSTRING;
1938 *format_ret = 8;
1939 *size_ret = SBYTES (obj);
1940 *data_ret = SDATA (obj);
1941 *nofree_ret = 1;
1943 else if (SYMBOLP (obj))
1945 *format_ret = 32;
1946 *size_ret = 1;
1947 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1948 (*data_ret) [sizeof (Atom)] = 0;
1949 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1950 if (NILP (type)) type = QATOM;
1952 else if (INTEGERP (obj)
1953 && XINT (obj) < 0xFFFF
1954 && XINT (obj) > -0xFFFF)
1956 *format_ret = 16;
1957 *size_ret = 1;
1958 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1959 (*data_ret) [sizeof (short)] = 0;
1960 (*(short **) data_ret) [0] = (short) XINT (obj);
1961 if (NILP (type)) type = QINTEGER;
1963 else if (INTEGERP (obj)
1964 || (CONSP (obj) && INTEGERP (XCAR (obj))
1965 && (INTEGERP (XCDR (obj))
1966 || (CONSP (XCDR (obj))
1967 && INTEGERP (XCAR (XCDR (obj)))))))
1969 *format_ret = 32;
1970 *size_ret = 1;
1971 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1972 (*data_ret) [sizeof (long)] = 0;
1973 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1974 if (NILP (type)) type = QINTEGER;
1976 else if (VECTORP (obj))
1978 /* Lisp_Vectors may represent a set of ATOMs;
1979 a set of 16 or 32 bit INTEGERs;
1980 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1982 int i;
1984 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1985 /* This vector is an ATOM set */
1987 if (NILP (type)) type = QATOM;
1988 *size_ret = XVECTOR (obj)->size;
1989 *format_ret = 32;
1990 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1991 for (i = 0; i < *size_ret; i++)
1992 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1993 (*(Atom **) data_ret) [i]
1994 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1995 else
1996 Fsignal (Qerror, /* Qselection_error */
1997 Fcons (build_string
1998 ("all elements of selection vector must have same type"),
1999 Fcons (obj, Qnil)));
2001 #if 0 /* #### MULTIPLE doesn't work yet */
2002 else if (VECTORP (XVECTOR (obj)->contents [0]))
2003 /* This vector is an ATOM_PAIR set */
2005 if (NILP (type)) type = QATOM_PAIR;
2006 *size_ret = XVECTOR (obj)->size;
2007 *format_ret = 32;
2008 *data_ret = (unsigned char *)
2009 xmalloc ((*size_ret) * sizeof (Atom) * 2);
2010 for (i = 0; i < *size_ret; i++)
2011 if (VECTORP (XVECTOR (obj)->contents [i]))
2013 Lisp_Object pair = XVECTOR (obj)->contents [i];
2014 if (XVECTOR (pair)->size != 2)
2015 Fsignal (Qerror,
2016 Fcons (build_string
2017 ("elements of the vector must be vectors of exactly two elements"),
2018 Fcons (pair, Qnil)));
2020 (*(Atom **) data_ret) [i * 2]
2021 = symbol_to_x_atom (dpyinfo, display,
2022 XVECTOR (pair)->contents [0]);
2023 (*(Atom **) data_ret) [(i * 2) + 1]
2024 = symbol_to_x_atom (dpyinfo, display,
2025 XVECTOR (pair)->contents [1]);
2027 else
2028 Fsignal (Qerror,
2029 Fcons (build_string
2030 ("all elements of the vector must be of the same type"),
2031 Fcons (obj, Qnil)));
2034 #endif
2035 else
2036 /* This vector is an INTEGER set, or something like it */
2038 int data_size = 2;
2039 *size_ret = XVECTOR (obj)->size;
2040 if (NILP (type)) type = QINTEGER;
2041 *format_ret = 16;
2042 for (i = 0; i < *size_ret; i++)
2043 if (CONSP (XVECTOR (obj)->contents [i]))
2044 *format_ret = 32;
2045 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2046 Fsignal (Qerror, /* Qselection_error */
2047 Fcons (build_string
2048 ("elements of selection vector must be integers or conses of integers"),
2049 Fcons (obj, Qnil)));
2051 /* Use sizeof(long) even if it is more than 32 bits. See comment
2052 in x_get_window_property and x_fill_property_data. */
2054 if (*format_ret == 32) data_size = sizeof(long);
2055 *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
2056 for (i = 0; i < *size_ret; i++)
2057 if (*format_ret == 32)
2058 (*((unsigned long **) data_ret)) [i]
2059 = cons_to_long (XVECTOR (obj)->contents [i]);
2060 else
2061 (*((unsigned short **) data_ret)) [i]
2062 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2065 else
2066 Fsignal (Qerror, /* Qselection_error */
2067 Fcons (build_string ("unrecognized selection data"),
2068 Fcons (obj, Qnil)));
2070 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2073 static Lisp_Object
2074 clean_local_selection_data (obj)
2075 Lisp_Object obj;
2077 if (CONSP (obj)
2078 && INTEGERP (XCAR (obj))
2079 && CONSP (XCDR (obj))
2080 && INTEGERP (XCAR (XCDR (obj)))
2081 && NILP (XCDR (XCDR (obj))))
2082 obj = Fcons (XCAR (obj), XCDR (obj));
2084 if (CONSP (obj)
2085 && INTEGERP (XCAR (obj))
2086 && INTEGERP (XCDR (obj)))
2088 if (XINT (XCAR (obj)) == 0)
2089 return XCDR (obj);
2090 if (XINT (XCAR (obj)) == -1)
2091 return make_number (- XINT (XCDR (obj)));
2093 if (VECTORP (obj))
2095 int i;
2096 int size = XVECTOR (obj)->size;
2097 Lisp_Object copy;
2098 if (size == 1)
2099 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2100 copy = Fmake_vector (make_number (size), Qnil);
2101 for (i = 0; i < size; i++)
2102 XVECTOR (copy)->contents [i]
2103 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2104 return copy;
2106 return obj;
2109 /* Called from XTread_socket to handle SelectionNotify events.
2110 If it's the selection we are waiting for, stop waiting
2111 by setting the car of reading_selection_reply to non-nil.
2112 We store t there if the reply is successful, lambda if not. */
2114 void
2115 x_handle_selection_notify (event)
2116 XSelectionEvent *event;
2118 if (event->requestor != reading_selection_window)
2119 return;
2120 if (event->selection != reading_which_selection)
2121 return;
2123 TRACE0 ("Received SelectionNotify");
2124 XSETCAR (reading_selection_reply,
2125 (event->property != 0 ? Qt : Qlambda));
2129 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2130 Sx_own_selection_internal, 2, 2, 0,
2131 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2132 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2133 \(Those are literal upper-case symbol names, since that's what X expects.)
2134 VALUE is typically a string, or a cons of two markers, but may be
2135 anything that the functions on `selection-converter-alist' know about. */)
2136 (selection_name, selection_value)
2137 Lisp_Object selection_name, selection_value;
2139 check_x ();
2140 CHECK_SYMBOL (selection_name);
2141 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
2142 x_own_selection (selection_name, selection_value);
2143 return selection_value;
2147 /* Request the selection value from the owner. If we are the owner,
2148 simply return our selection value. If we are not the owner, this
2149 will block until all of the data has arrived. */
2151 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2152 Sx_get_selection_internal, 2, 3, 0,
2153 doc: /* Return text selected from some X window.
2154 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2155 \(Those are literal upper-case symbol names, since that's what X expects.)
2156 TYPE is the type of data desired, typically `STRING'.
2157 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2158 selections. If omitted, defaults to the time for the last event. */)
2159 (selection_symbol, target_type, time_stamp)
2160 Lisp_Object selection_symbol, target_type, time_stamp;
2162 Lisp_Object val = Qnil;
2163 struct gcpro gcpro1, gcpro2;
2164 GCPRO2 (target_type, val); /* we store newly consed data into these */
2165 check_x ();
2166 CHECK_SYMBOL (selection_symbol);
2168 #if 0 /* #### MULTIPLE doesn't work yet */
2169 if (CONSP (target_type)
2170 && XCAR (target_type) == QMULTIPLE)
2172 CHECK_VECTOR (XCDR (target_type));
2173 /* So we don't destructively modify this... */
2174 target_type = copy_multiple_data (target_type);
2176 else
2177 #endif
2178 CHECK_SYMBOL (target_type);
2180 val = x_get_local_selection (selection_symbol, target_type, 1);
2182 if (NILP (val))
2184 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2185 goto DONE;
2188 if (CONSP (val)
2189 && SYMBOLP (XCAR (val)))
2191 val = XCDR (val);
2192 if (CONSP (val) && NILP (XCDR (val)))
2193 val = XCAR (val);
2195 val = clean_local_selection_data (val);
2196 DONE:
2197 UNGCPRO;
2198 return val;
2201 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2202 Sx_disown_selection_internal, 1, 2, 0,
2203 doc: /* If we own the selection SELECTION, disown it.
2204 Disowning it means there is no such selection. */)
2205 (selection, time)
2206 Lisp_Object selection;
2207 Lisp_Object time;
2209 Time timestamp;
2210 Atom selection_atom;
2211 union {
2212 struct selection_input_event sie;
2213 struct input_event ie;
2214 } event;
2215 Display *display;
2216 struct x_display_info *dpyinfo;
2217 struct frame *sf = SELECTED_FRAME ();
2219 check_x ();
2220 display = FRAME_X_DISPLAY (sf);
2221 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2222 CHECK_SYMBOL (selection);
2223 if (NILP (time))
2224 timestamp = last_event_timestamp;
2225 else
2226 timestamp = cons_to_long (time);
2228 if (NILP (assq_no_quit (selection, Vselection_alist)))
2229 return Qnil; /* Don't disown the selection when we're not the owner. */
2231 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2233 BLOCK_INPUT;
2234 XSetSelectionOwner (display, selection_atom, None, timestamp);
2235 UNBLOCK_INPUT;
2237 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2238 generated for a window which owns the selection when that window sets
2239 the selection owner to None. The NCD server does, the MIT Sun4 server
2240 doesn't. So we synthesize one; this means we might get two, but
2241 that's ok, because the second one won't have any effect. */
2242 SELECTION_EVENT_DISPLAY (&event.sie) = display;
2243 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2244 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2245 x_handle_selection_clear (&event.ie);
2247 return Qt;
2250 /* Get rid of all the selections in buffer BUFFER.
2251 This is used when we kill a buffer. */
2253 void
2254 x_disown_buffer_selections (buffer)
2255 Lisp_Object buffer;
2257 Lisp_Object tail;
2258 struct buffer *buf = XBUFFER (buffer);
2260 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2262 Lisp_Object elt, value;
2263 elt = XCAR (tail);
2264 value = XCDR (elt);
2265 if (CONSP (value) && MARKERP (XCAR (value))
2266 && XMARKER (XCAR (value))->buffer == buf)
2267 Fx_disown_selection_internal (XCAR (elt), Qnil);
2271 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2272 0, 1, 0,
2273 doc: /* Whether the current Emacs process owns the given X Selection.
2274 The arg should be the name of the selection in question, typically one of
2275 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2276 \(Those are literal upper-case symbol names, since that's what X expects.)
2277 For convenience, the symbol nil is the same as `PRIMARY',
2278 and t is the same as `SECONDARY'. */)
2279 (selection)
2280 Lisp_Object selection;
2282 check_x ();
2283 CHECK_SYMBOL (selection);
2284 if (EQ (selection, Qnil)) selection = QPRIMARY;
2285 if (EQ (selection, Qt)) selection = QSECONDARY;
2287 if (NILP (Fassq (selection, Vselection_alist)))
2288 return Qnil;
2289 return Qt;
2292 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2293 0, 1, 0,
2294 doc: /* Whether there is an owner for the given X Selection.
2295 The arg should be the name of the selection in question, typically one of
2296 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2297 \(Those are literal upper-case symbol names, since that's what X expects.)
2298 For convenience, the symbol nil is the same as `PRIMARY',
2299 and t is the same as `SECONDARY'. */)
2300 (selection)
2301 Lisp_Object selection;
2303 Window owner;
2304 Atom atom;
2305 Display *dpy;
2306 struct frame *sf = SELECTED_FRAME ();
2308 /* It should be safe to call this before we have an X frame. */
2309 if (! FRAME_X_P (sf))
2310 return Qnil;
2312 dpy = FRAME_X_DISPLAY (sf);
2313 CHECK_SYMBOL (selection);
2314 if (!NILP (Fx_selection_owner_p (selection)))
2315 return Qt;
2316 if (EQ (selection, Qnil)) selection = QPRIMARY;
2317 if (EQ (selection, Qt)) selection = QSECONDARY;
2318 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2319 if (atom == 0)
2320 return Qnil;
2321 BLOCK_INPUT;
2322 owner = XGetSelectionOwner (dpy, atom);
2323 UNBLOCK_INPUT;
2324 return (owner ? Qt : Qnil);
2328 #ifdef CUT_BUFFER_SUPPORT
2330 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2331 static void
2332 initialize_cut_buffers (display, window)
2333 Display *display;
2334 Window window;
2336 unsigned char *data = (unsigned char *) "";
2337 BLOCK_INPUT;
2338 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2339 PropModeAppend, data, 0)
2340 FROB (XA_CUT_BUFFER0);
2341 FROB (XA_CUT_BUFFER1);
2342 FROB (XA_CUT_BUFFER2);
2343 FROB (XA_CUT_BUFFER3);
2344 FROB (XA_CUT_BUFFER4);
2345 FROB (XA_CUT_BUFFER5);
2346 FROB (XA_CUT_BUFFER6);
2347 FROB (XA_CUT_BUFFER7);
2348 #undef FROB
2349 UNBLOCK_INPUT;
2353 #define CHECK_CUT_BUFFER(symbol) \
2354 { CHECK_SYMBOL ((symbol)); \
2355 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2356 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2357 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2358 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2359 Fsignal (Qerror, \
2360 Fcons (build_string ("doesn't name a cut buffer"), \
2361 Fcons ((symbol), Qnil))); \
2364 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2365 Sx_get_cut_buffer_internal, 1, 1, 0,
2366 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2367 (buffer)
2368 Lisp_Object buffer;
2370 Window window;
2371 Atom buffer_atom;
2372 unsigned char *data;
2373 int bytes;
2374 Atom type;
2375 int format;
2376 unsigned long size;
2377 Lisp_Object ret;
2378 Display *display;
2379 struct x_display_info *dpyinfo;
2380 struct frame *sf = SELECTED_FRAME ();
2382 check_x ();
2383 display = FRAME_X_DISPLAY (sf);
2384 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2385 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2386 CHECK_CUT_BUFFER (buffer);
2387 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2389 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2390 &type, &format, &size, 0);
2391 if (!data || !format)
2392 return Qnil;
2394 if (format != 8 || type != XA_STRING)
2395 Fsignal (Qerror,
2396 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2397 Fcons (x_atom_to_symbol (display, type),
2398 Fcons (make_number (format), Qnil))));
2400 ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
2401 /* Use xfree, not XFree, because x_get_window_property
2402 calls xmalloc itself. */
2403 xfree (data);
2404 return ret;
2408 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2409 Sx_store_cut_buffer_internal, 2, 2, 0,
2410 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2411 (buffer, string)
2412 Lisp_Object buffer, string;
2414 Window window;
2415 Atom buffer_atom;
2416 unsigned char *data;
2417 int bytes;
2418 int bytes_remaining;
2419 int max_bytes;
2420 Display *display;
2421 struct frame *sf = SELECTED_FRAME ();
2423 check_x ();
2424 display = FRAME_X_DISPLAY (sf);
2425 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2427 max_bytes = SELECTION_QUANTUM (display);
2428 if (max_bytes > MAX_SELECTION_QUANTUM)
2429 max_bytes = MAX_SELECTION_QUANTUM;
2431 CHECK_CUT_BUFFER (buffer);
2432 CHECK_STRING (string);
2433 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2434 display, buffer);
2435 data = (unsigned char *) SDATA (string);
2436 bytes = SBYTES (string);
2437 bytes_remaining = bytes;
2439 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2441 initialize_cut_buffers (display, window);
2442 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2445 BLOCK_INPUT;
2447 /* Don't mess up with an empty value. */
2448 if (!bytes_remaining)
2449 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2450 PropModeReplace, data, 0);
2452 while (bytes_remaining)
2454 int chunk = (bytes_remaining < max_bytes
2455 ? bytes_remaining : max_bytes);
2456 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2457 (bytes_remaining == bytes
2458 ? PropModeReplace
2459 : PropModeAppend),
2460 data, chunk);
2461 data += chunk;
2462 bytes_remaining -= chunk;
2464 UNBLOCK_INPUT;
2465 return string;
2469 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2470 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2471 doc: /* Rotate the values of the cut buffers by the given number of step.
2472 Positive means shift the values forward, negative means backward. */)
2474 Lisp_Object n;
2476 Window window;
2477 Atom props[8];
2478 Display *display;
2479 struct frame *sf = SELECTED_FRAME ();
2481 check_x ();
2482 display = FRAME_X_DISPLAY (sf);
2483 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2484 CHECK_NUMBER (n);
2485 if (XINT (n) == 0)
2486 return n;
2487 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2489 initialize_cut_buffers (display, window);
2490 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2493 props[0] = XA_CUT_BUFFER0;
2494 props[1] = XA_CUT_BUFFER1;
2495 props[2] = XA_CUT_BUFFER2;
2496 props[3] = XA_CUT_BUFFER3;
2497 props[4] = XA_CUT_BUFFER4;
2498 props[5] = XA_CUT_BUFFER5;
2499 props[6] = XA_CUT_BUFFER6;
2500 props[7] = XA_CUT_BUFFER7;
2501 BLOCK_INPUT;
2502 XRotateWindowProperties (display, window, props, 8, XINT (n));
2503 UNBLOCK_INPUT;
2504 return n;
2507 #endif
2509 /***********************************************************************
2510 Drag and drop support
2511 ***********************************************************************/
2512 /* Check that lisp values are of correct type for x_fill_property_data.
2513 That is, number, string or a cons with two numbers (low and high 16
2514 bit parts of a 32 bit number). */
2517 x_check_property_data (data)
2518 Lisp_Object data;
2520 Lisp_Object iter;
2521 int size = 0;
2523 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2525 Lisp_Object o = XCAR (iter);
2527 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2528 size = -1;
2529 else if (CONSP (o) &&
2530 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2531 size = -1;
2534 return size;
2537 /* Convert lisp values to a C array. Values may be a number, a string
2538 which is taken as an X atom name and converted to the atom value, or
2539 a cons containing the two 16 bit parts of a 32 bit number.
2541 DPY is the display use to look up X atoms.
2542 DATA is a Lisp list of values to be converted.
2543 RET is the C array that contains the converted values. It is assumed
2544 it is big enough to hold all values.
2545 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2546 be stored in RET. Note that long is used for 32 even if long is more
2547 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2548 XClientMessageEvent). */
2550 void
2551 x_fill_property_data (dpy, data, ret, format)
2552 Display *dpy;
2553 Lisp_Object data;
2554 void *ret;
2555 int format;
2557 long val;
2558 long *d32 = (long *) ret;
2559 short *d16 = (short *) ret;
2560 char *d08 = (char *) ret;
2561 Lisp_Object iter;
2563 for (iter = data; CONSP (iter); iter = XCDR (iter))
2565 Lisp_Object o = XCAR (iter);
2567 if (INTEGERP (o))
2568 val = (long) XFASTINT (o);
2569 else if (FLOATP (o))
2570 val = (long) XFLOAT_DATA (o);
2571 else if (CONSP (o))
2572 val = (long) cons_to_long (o);
2573 else if (STRINGP (o))
2575 BLOCK_INPUT;
2576 val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
2577 UNBLOCK_INPUT;
2579 else
2580 error ("Wrong type, must be string, number or cons");
2582 if (format == 8)
2583 *d08++ = (char) val;
2584 else if (format == 16)
2585 *d16++ = (short) val;
2586 else
2587 *d32++ = val;
2591 /* Convert an array of C values to a Lisp list.
2592 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2593 DATA is a C array of values to be converted.
2594 TYPE is the type of the data. Only XA_ATOM is special, it converts
2595 each number in DATA to its corresponfing X atom as a symbol.
2596 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2597 be stored in RET.
2598 SIZE is the number of elements in DATA.
2600 Important: When format is 32, data should contain an array of int,
2601 not an array of long as the X library returns. This makes a difference
2602 when sizeof(long) != sizeof(int).
2604 Also see comment for selection_data_to_lisp_data above. */
2606 Lisp_Object
2607 x_property_data_to_lisp (f, data, type, format, size)
2608 struct frame *f;
2609 unsigned char *data;
2610 Atom type;
2611 int format;
2612 unsigned long size;
2614 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2615 data, size*format/8, type, format);
2618 /* Get the mouse position in frame relative coordinates. */
2620 static void
2621 mouse_position_for_drop (f, x, y)
2622 FRAME_PTR f;
2623 int *x;
2624 int *y;
2626 Window root, dummy_window;
2627 int dummy;
2629 BLOCK_INPUT;
2631 XQueryPointer (FRAME_X_DISPLAY (f),
2632 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2634 /* The root window which contains the pointer. */
2635 &root,
2637 /* Window pointer is on, not used */
2638 &dummy_window,
2640 /* The position on that root window. */
2641 x, y,
2643 /* x/y in dummy_window coordinates, not used. */
2644 &dummy, &dummy,
2646 /* Modifier keys and pointer buttons, about which
2647 we don't care. */
2648 (unsigned int *) &dummy);
2651 /* Absolute to relative. */
2652 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2653 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2655 UNBLOCK_INPUT;
2658 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2659 Sx_get_atom_name, 1, 2, 0,
2660 doc: /* Return the X atom name for VALUE as a string.
2661 VALUE may be a number or a cons where the car is the upper 16 bits and
2662 the cdr is the lower 16 bits of a 32 bit value.
2663 Use the display for FRAME or the current frame if FRAME is not given or nil.
2665 If the value is 0 or the atom is not known, return the empty string. */)
2666 (value, frame)
2667 Lisp_Object value, frame;
2669 struct frame *f = check_x_frame (frame);
2670 char *name = 0;
2671 Lisp_Object ret = Qnil;
2672 Display *dpy = FRAME_X_DISPLAY (f);
2673 Atom atom;
2674 int had_errors;
2676 if (INTEGERP (value))
2677 atom = (Atom) XUINT (value);
2678 else if (FLOATP (value))
2679 atom = (Atom) XFLOAT_DATA (value);
2680 else if (CONSP (value))
2681 atom = (Atom) cons_to_long (value);
2682 else
2683 error ("Wrong type, value must be number or cons");
2685 BLOCK_INPUT;
2686 x_catch_errors (dpy);
2687 name = atom ? XGetAtomName (dpy, atom) : "";
2688 had_errors = x_had_errors_p (dpy);
2689 x_uncatch_errors ();
2691 if (!had_errors)
2692 ret = make_string (name, strlen (name));
2694 if (atom && name) XFree (name);
2695 if (NILP (ret)) ret = make_string ("", 0);
2697 UNBLOCK_INPUT;
2699 return ret;
2702 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2703 TODO: Check if this client event really is a DND event? */
2706 x_handle_dnd_message (f, event, dpyinfo, bufp)
2707 struct frame *f;
2708 XClientMessageEvent *event;
2709 struct x_display_info *dpyinfo;
2710 struct input_event *bufp;
2712 Lisp_Object vec;
2713 Lisp_Object frame;
2714 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2715 unsigned long size = 160/event->format;
2716 int x, y;
2717 unsigned char *data = (unsigned char *) event->data.b;
2718 int idata[5];
2720 XSETFRAME (frame, f);
2722 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2723 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2724 function expects them to be of size int (i.e. 32). So to be able to
2725 use that function, put the data in the form it expects if format is 32. */
2727 if (event->format == 32 && event->format < BITS_PER_LONG)
2729 int i;
2730 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2731 idata[i] = (int) event->data.l[i];
2732 data = (unsigned char *) idata;
2735 vec = Fmake_vector (make_number (4), Qnil);
2736 AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2737 event->message_type));
2738 AREF (vec, 1) = frame;
2739 AREF (vec, 2) = make_number (event->format);
2740 AREF (vec, 3) = x_property_data_to_lisp (f,
2741 data,
2742 event->message_type,
2743 event->format,
2744 size);
2746 mouse_position_for_drop (f, &x, &y);
2747 bufp->kind = DRAG_N_DROP_EVENT;
2748 bufp->frame_or_window = frame;
2749 bufp->timestamp = CurrentTime;
2750 bufp->x = make_number (x);
2751 bufp->y = make_number (y);
2752 bufp->arg = vec;
2753 bufp->modifiers = 0;
2755 return 1;
2758 DEFUN ("x-send-client-message", Fx_send_client_event,
2759 Sx_send_client_message, 6, 6, 0,
2760 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2762 For DISPLAY, specify either a frame or a display name (a string).
2763 If DISPLAY is nil, that stands for the selected frame's display.
2764 DEST may be a number, in which case it is a Window id. The value 0 may
2765 be used to send to the root window of the DISPLAY.
2766 If DEST is a cons, it is converted to a 32 bit number
2767 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2768 number is then used as a window id.
2769 If DEST is a frame the event is sent to the outer window of that frame.
2770 Nil means the currently selected frame.
2771 If DEST is the string "PointerWindow" the event is sent to the window that
2772 contains the pointer. If DEST is the string "InputFocus" the event is
2773 sent to the window that has the input focus.
2774 FROM is the frame sending the event. Use nil for currently selected frame.
2775 MESSAGE-TYPE is the name of an Atom as a string.
2776 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2777 bits. VALUES is a list of numbers, cons and/or strings containing the values
2778 to send. If a value is a string, it is converted to an Atom and the value of
2779 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2780 with the high 16 bits from the car and the lower 16 bit from the cdr.
2781 If more values than fits into the event is given, the excessive values
2782 are ignored. */)
2783 (display, dest, from, message_type, format, values)
2784 Lisp_Object display, dest, from, message_type, format, values;
2786 struct x_display_info *dpyinfo = check_x_display_info (display);
2787 Window wdest;
2788 XEvent event;
2789 Lisp_Object cons;
2790 int size;
2791 struct frame *f = check_x_frame (from);
2792 int to_root;
2794 CHECK_STRING (message_type);
2795 CHECK_NUMBER (format);
2796 CHECK_CONS (values);
2798 if (x_check_property_data (values) == -1)
2799 error ("Bad data in VALUES, must be number, cons or string");
2801 event.xclient.type = ClientMessage;
2802 event.xclient.format = XFASTINT (format);
2804 if (event.xclient.format != 8 && event.xclient.format != 16
2805 && event.xclient.format != 32)
2806 error ("FORMAT must be one of 8, 16 or 32");
2808 if (FRAMEP (dest) || NILP (dest))
2810 struct frame *fdest = check_x_frame (dest);
2811 wdest = FRAME_OUTER_WINDOW (fdest);
2813 else if (STRINGP (dest))
2815 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2816 wdest = PointerWindow;
2817 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2818 wdest = InputFocus;
2819 else
2820 error ("DEST as a string must be one of PointerWindow or InputFocus");
2822 else if (INTEGERP (dest))
2823 wdest = (Window) XFASTINT (dest);
2824 else if (FLOATP (dest))
2825 wdest = (Window) XFLOAT_DATA (dest);
2826 else if (CONSP (dest))
2828 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2829 error ("Both car and cdr for DEST must be numbers");
2830 else
2831 wdest = (Window) cons_to_long (dest);
2833 else
2834 error ("DEST must be a frame, nil, string, number or cons");
2836 if (wdest == 0) wdest = dpyinfo->root_window;
2837 to_root = wdest == dpyinfo->root_window;
2839 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2842 BLOCK_INPUT;
2844 event.xclient.message_type
2845 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2846 event.xclient.display = dpyinfo->display;
2848 /* Some clients (metacity for example) expects sending window to be here
2849 when sending to the root window. */
2850 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2853 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2854 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2855 event.xclient.format);
2857 /* If event mask is 0 the event is sent to the client that created
2858 the destination window. But if we are sending to the root window,
2859 there is no such client. Then we set the event mask to 0xffff. The
2860 event then goes to clients selecting for events on the root window. */
2861 x_catch_errors (dpyinfo->display);
2863 int propagate = to_root ? False : True;
2864 unsigned mask = to_root ? 0xffff : 0;
2865 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2866 XFlush (dpyinfo->display);
2868 x_uncatch_errors ();
2869 UNBLOCK_INPUT;
2871 return Qnil;
2875 void
2876 syms_of_xselect ()
2878 defsubr (&Sx_get_selection_internal);
2879 defsubr (&Sx_own_selection_internal);
2880 defsubr (&Sx_disown_selection_internal);
2881 defsubr (&Sx_selection_owner_p);
2882 defsubr (&Sx_selection_exists_p);
2884 #ifdef CUT_BUFFER_SUPPORT
2885 defsubr (&Sx_get_cut_buffer_internal);
2886 defsubr (&Sx_store_cut_buffer_internal);
2887 defsubr (&Sx_rotate_cut_buffers_internal);
2888 #endif
2890 defsubr (&Sx_get_atom_name);
2891 defsubr (&Sx_send_client_message);
2893 reading_selection_reply = Fcons (Qnil, Qnil);
2894 staticpro (&reading_selection_reply);
2895 reading_selection_window = 0;
2896 reading_which_selection = 0;
2898 property_change_wait_list = 0;
2899 prop_location_identifier = 0;
2900 property_change_reply = Fcons (Qnil, Qnil);
2901 staticpro (&property_change_reply);
2903 Vselection_alist = Qnil;
2904 staticpro (&Vselection_alist);
2906 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2907 doc: /* An alist associating X Windows selection-types with functions.
2908 These functions are called to convert the selection, with three args:
2909 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2910 a desired type to which the selection should be converted;
2911 and the local selection value (whatever was given to `x-own-selection').
2913 The function should return the value to send to the X server
2914 \(typically a string). A return value of nil
2915 means that the conversion could not be done.
2916 A return value which is the symbol `NULL'
2917 means that a side-effect was executed,
2918 and there is no meaningful selection value. */);
2919 Vselection_converter_alist = Qnil;
2921 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2922 doc: /* A list of functions to be called when Emacs loses an X selection.
2923 \(This happens when some other X client makes its own selection
2924 or when a Lisp program explicitly clears the selection.)
2925 The functions are called with one argument, the selection type
2926 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2927 Vx_lost_selection_functions = Qnil;
2929 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2930 doc: /* A list of functions to be called when Emacs answers a selection request.
2931 The functions are called with four arguments:
2932 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2933 - the selection-type which Emacs was asked to convert the
2934 selection into before sending (for example, `STRING' or `LENGTH');
2935 - a flag indicating success or failure for responding to the request.
2936 We might have failed (and declined the request) for any number of reasons,
2937 including being asked for a selection that we no longer own, or being asked
2938 to convert into a type that we don't know about or that is inappropriate.
2939 This hook doesn't let you change the behavior of Emacs's selection replies,
2940 it merely informs you that they have happened. */);
2941 Vx_sent_selection_functions = Qnil;
2943 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2944 doc: /* Coding system for communicating with other X clients.
2945 When sending or receiving text via cut_buffer, selection, and clipboard,
2946 the text is encoded or decoded by this coding system.
2947 The default value is `compound-text-with-extensions'. */);
2948 Vselection_coding_system = intern ("compound-text-with-extensions");
2950 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2951 doc: /* Coding system for the next communication with other X clients.
2952 Usually, `selection-coding-system' is used for communicating with
2953 other X clients. But, if this variable is set, it is used for the
2954 next communication only. After the communication, this variable is
2955 set to nil. */);
2956 Vnext_selection_coding_system = Qnil;
2958 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2959 doc: /* Number of milliseconds to wait for a selection reply.
2960 If the selection owner doesn't reply in this time, we give up.
2961 A value of 0 means wait as long as necessary. This is initialized from the
2962 \"*selectionTimeout\" resource. */);
2963 x_selection_timeout = 0;
2965 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2966 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2967 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2968 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2969 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2970 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2971 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2972 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2973 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
2974 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2975 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2976 QINCR = intern ("INCR"); staticpro (&QINCR);
2977 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2978 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2979 QATOM = intern ("ATOM"); staticpro (&QATOM);
2980 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2981 QNULL = intern ("NULL"); staticpro (&QNULL);
2982 Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
2983 staticpro (&Qcompound_text_with_extensions);
2985 #ifdef CUT_BUFFER_SUPPORT
2986 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2987 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2988 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2989 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2990 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2991 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2992 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2993 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2994 #endif
2996 Qforeign_selection = intern ("foreign-selection");
2997 staticpro (&Qforeign_selection);
3000 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
3001 (do not change this comment) */