Avoid crash on composition (backport from trunk).
[emacs.git] / src / xselect.c
blob00099ec6f0c9530d22c96285b11069a944550d6f
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
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 3 of the License, or
10 (at your option) 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. If not, see <http://www.gnu.org/licenses/>. */
21 /* Rewritten by jwz */
23 #include <config.h>
24 #include <stdio.h> /* termhooks.h needs this */
25 #include <setjmp.h>
27 #ifdef HAVE_SYS_TYPES_H
28 #include <sys/types.h>
29 #endif
30 #ifdef HAVE_UNISTD_H
31 #include <unistd.h>
32 #endif
34 #include "lisp.h"
35 #include "xterm.h" /* for all of the X includes */
36 #include "dispextern.h" /* frame.h seems to want this */
37 #include "frame.h" /* Need this to get the X window of selected_frame */
38 #include "blockinput.h"
39 #include "buffer.h"
40 #include "process.h"
41 #include "termhooks.h"
42 #include "keyboard.h"
44 #include <X11/Xproto.h>
46 struct prop_location;
48 static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
49 static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
50 Lisp_Object));
51 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
52 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
53 static void x_decline_selection_request P_ ((struct input_event *));
54 static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
55 static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
56 static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
57 static Lisp_Object x_catch_errors_unwind P_ ((Lisp_Object));
58 static void x_reply_selection_request P_ ((struct input_event *, int,
59 unsigned char *, int, Atom));
60 static int waiting_for_other_props_on_window P_ ((Display *, Window));
61 static struct prop_location *expect_property_change P_ ((Display *, Window,
62 Atom, int));
63 static void unexpect_property_change P_ ((struct prop_location *));
64 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
65 static void wait_for_property_change P_ ((struct prop_location *));
66 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
67 Lisp_Object,
68 Lisp_Object));
69 static void x_get_window_property P_ ((Display *, Window, Atom,
70 unsigned char **, int *,
71 Atom *, int *, unsigned long *, int));
72 static void receive_incremental_selection P_ ((Display *, Window, Atom,
73 Lisp_Object, unsigned,
74 unsigned char **, int *,
75 Atom *, int *, unsigned long *));
76 static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
77 Window, Atom,
78 Lisp_Object, Atom));
79 static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
80 int, Atom, int));
81 static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
82 unsigned char **, Atom *,
83 unsigned *, int *, int *));
84 static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
85 static void initialize_cut_buffers P_ ((Display *, Window));
88 /* Printing traces to stderr. */
90 #ifdef TRACE_SELECTION
91 #define TRACE0(fmt) \
92 fprintf (stderr, "%d: " fmt "\n", getpid ())
93 #define TRACE1(fmt, a0) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
95 #define TRACE2(fmt, a0, a1) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
97 #define TRACE3(fmt, a0, a1, a2) \
98 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
99 #else
100 #define TRACE0(fmt) (void) 0
101 #define TRACE1(fmt, a0) (void) 0
102 #define TRACE2(fmt, a0, a1) (void) 0
103 #define TRACE3(fmt, a0, a1) (void) 0
104 #endif
107 #define CUT_BUFFER_SUPPORT
109 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
110 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
111 QATOM_PAIR;
113 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
114 Lisp_Object QUTF8_STRING; /* This is a type of selection. */
116 Lisp_Object Qcompound_text_with_extensions;
118 #ifdef CUT_BUFFER_SUPPORT
119 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
120 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
121 #endif
123 static Lisp_Object Vx_lost_selection_functions;
124 static Lisp_Object Vx_sent_selection_functions;
125 static Lisp_Object Qforeign_selection;
127 /* If this is a smaller number than the max-request-size of the display,
128 emacs will use INCR selection transfer when the selection is larger
129 than this. The max-request-size is usually around 64k, so if you want
130 emacs to use incremental selection transfers when the selection is
131 smaller than that, set this. I added this mostly for debugging the
132 incremental transfer stuff, but it might improve server performance. */
133 #define MAX_SELECTION_QUANTUM 0xFFFFFF
135 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
137 /* The timestamp of the last input event Emacs received from the X server. */
138 /* Defined in keyboard.c. */
139 extern unsigned long last_event_timestamp;
141 /* This is an association list whose elements are of the form
142 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
143 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
144 SELECTION-VALUE is the value that emacs owns for that selection.
145 It may be any kind of Lisp object.
146 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
147 as a cons of two 16-bit numbers (making a 32 bit time.)
148 FRAME is the frame for which we made the selection.
149 If there is an entry in this alist, then it can be assumed that Emacs owns
150 that selection.
151 The only (eq) parts of this list that are visible from Lisp are the
152 selection-values. */
153 static Lisp_Object Vselection_alist;
155 /* This is an alist whose CARs are selection-types (whose names are the same
156 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
157 call to convert the given Emacs selection value to a string representing
158 the given selection type. This is for Lisp-level extension of the emacs
159 selection handling. */
160 static Lisp_Object Vselection_converter_alist;
162 /* If the selection owner takes too long to reply to a selection request,
163 we give up on it. This is in milliseconds (0 = no timeout.) */
164 static EMACS_INT x_selection_timeout;
168 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
169 handling. */
171 struct selection_event_queue
173 struct input_event event;
174 struct selection_event_queue *next;
177 static struct selection_event_queue *selection_queue;
179 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
181 static int x_queue_selection_requests;
183 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
185 static void
186 x_queue_event (event)
187 struct input_event *event;
189 struct selection_event_queue *queue_tmp;
191 /* Don't queue repeated requests.
192 This only happens for large requests which uses the incremental protocol. */
193 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
195 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
197 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
198 x_decline_selection_request (event);
199 return;
203 queue_tmp
204 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
206 if (queue_tmp != NULL)
208 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
209 queue_tmp->event = *event;
210 queue_tmp->next = selection_queue;
211 selection_queue = queue_tmp;
215 /* Start queuing SELECTION_REQUEST_EVENT events. */
217 static void
218 x_start_queuing_selection_requests ()
220 if (x_queue_selection_requests)
221 abort ();
223 x_queue_selection_requests++;
224 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
227 /* Stop queuing SELECTION_REQUEST_EVENT events. */
229 static void
230 x_stop_queuing_selection_requests ()
232 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
233 --x_queue_selection_requests;
235 /* Take all the queued events and put them back
236 so that they get processed afresh. */
238 while (selection_queue != NULL)
240 struct selection_event_queue *queue_tmp = selection_queue;
241 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
242 kbd_buffer_unget_event (&queue_tmp->event);
243 selection_queue = queue_tmp->next;
244 xfree ((char *)queue_tmp);
249 /* This converts a Lisp symbol to a server Atom, avoiding a server
250 roundtrip whenever possible. */
252 static Atom
253 symbol_to_x_atom (dpyinfo, display, sym)
254 struct x_display_info *dpyinfo;
255 Display *display;
256 Lisp_Object sym;
258 Atom val;
259 if (NILP (sym)) return 0;
260 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
261 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
262 if (EQ (sym, QSTRING)) return XA_STRING;
263 if (EQ (sym, QINTEGER)) return XA_INTEGER;
264 if (EQ (sym, QATOM)) return XA_ATOM;
265 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
266 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
267 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
268 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
269 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
270 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
271 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
272 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
273 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
274 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
275 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
276 #ifdef CUT_BUFFER_SUPPORT
277 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
278 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
279 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
280 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
281 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
282 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
283 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
284 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
285 #endif
286 if (!SYMBOLP (sym)) abort ();
288 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
289 BLOCK_INPUT;
290 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
291 UNBLOCK_INPUT;
292 return val;
296 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
297 and calls to intern whenever possible. */
299 static Lisp_Object
300 x_atom_to_symbol (dpy, atom)
301 Display *dpy;
302 Atom atom;
304 struct x_display_info *dpyinfo;
305 char *str;
306 Lisp_Object val;
308 if (! atom)
309 return Qnil;
311 switch (atom)
313 case XA_PRIMARY:
314 return QPRIMARY;
315 case XA_SECONDARY:
316 return QSECONDARY;
317 case XA_STRING:
318 return QSTRING;
319 case XA_INTEGER:
320 return QINTEGER;
321 case XA_ATOM:
322 return QATOM;
323 #ifdef CUT_BUFFER_SUPPORT
324 case XA_CUT_BUFFER0:
325 return QCUT_BUFFER0;
326 case XA_CUT_BUFFER1:
327 return QCUT_BUFFER1;
328 case XA_CUT_BUFFER2:
329 return QCUT_BUFFER2;
330 case XA_CUT_BUFFER3:
331 return QCUT_BUFFER3;
332 case XA_CUT_BUFFER4:
333 return QCUT_BUFFER4;
334 case XA_CUT_BUFFER5:
335 return QCUT_BUFFER5;
336 case XA_CUT_BUFFER6:
337 return QCUT_BUFFER6;
338 case XA_CUT_BUFFER7:
339 return QCUT_BUFFER7;
340 #endif
343 dpyinfo = x_display_info_for_display (dpy);
344 if (atom == dpyinfo->Xatom_CLIPBOARD)
345 return QCLIPBOARD;
346 if (atom == dpyinfo->Xatom_TIMESTAMP)
347 return QTIMESTAMP;
348 if (atom == dpyinfo->Xatom_TEXT)
349 return QTEXT;
350 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
351 return QCOMPOUND_TEXT;
352 if (atom == dpyinfo->Xatom_UTF8_STRING)
353 return QUTF8_STRING;
354 if (atom == dpyinfo->Xatom_DELETE)
355 return QDELETE;
356 if (atom == dpyinfo->Xatom_MULTIPLE)
357 return QMULTIPLE;
358 if (atom == dpyinfo->Xatom_INCR)
359 return QINCR;
360 if (atom == dpyinfo->Xatom_EMACS_TMP)
361 return QEMACS_TMP;
362 if (atom == dpyinfo->Xatom_TARGETS)
363 return QTARGETS;
364 if (atom == dpyinfo->Xatom_NULL)
365 return QNULL;
367 BLOCK_INPUT;
368 str = XGetAtomName (dpy, atom);
369 UNBLOCK_INPUT;
370 TRACE1 ("XGetAtomName --> %s", str);
371 if (! str) return Qnil;
372 val = intern (str);
373 BLOCK_INPUT;
374 /* This was allocated by Xlib, so use XFree. */
375 XFree (str);
376 UNBLOCK_INPUT;
377 return val;
380 /* Do protocol to assert ourself as a selection owner.
381 Update the Vselection_alist so that we can reply to later requests for
382 our selection. */
384 static void
385 x_own_selection (selection_name, selection_value)
386 Lisp_Object selection_name, selection_value;
388 struct frame *sf = SELECTED_FRAME ();
389 Window selecting_window;
390 Display *display;
391 Time time = last_event_timestamp;
392 Atom selection_atom;
393 struct x_display_info *dpyinfo;
395 if (! FRAME_X_P (sf))
396 return;
398 selecting_window = FRAME_X_WINDOW (sf);
399 display = FRAME_X_DISPLAY (sf);
400 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
402 CHECK_SYMBOL (selection_name);
403 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
405 BLOCK_INPUT;
406 x_catch_errors (display);
407 XSetSelectionOwner (display, selection_atom, selecting_window, time);
408 x_check_errors (display, "Can't set selection: %s");
409 x_uncatch_errors ();
410 UNBLOCK_INPUT;
412 /* Now update the local cache */
414 Lisp_Object selection_time;
415 Lisp_Object selection_data;
416 Lisp_Object prev_value;
418 selection_time = long_to_cons ((unsigned long) time);
419 selection_data = Fcons (selection_name,
420 Fcons (selection_value,
421 Fcons (selection_time,
422 Fcons (selected_frame, Qnil))));
423 prev_value = assq_no_quit (selection_name, Vselection_alist);
425 Vselection_alist = Fcons (selection_data, Vselection_alist);
427 /* If we already owned the selection, remove the old selection data.
428 Perhaps we should destructively modify it instead.
429 Don't use Fdelq as that may QUIT. */
430 if (!NILP (prev_value))
432 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
433 for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
434 if (EQ (prev_value, Fcar (XCDR (rest))))
436 XSETCDR (rest, Fcdr (XCDR (rest)));
437 break;
443 /* Given a selection-name and desired type, look up our local copy of
444 the selection value and convert it to the type.
445 The value is nil or a string.
446 This function is used both for remote requests (LOCAL_REQUEST is zero)
447 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
449 This calls random Lisp code, and may signal or gc. */
451 static Lisp_Object
452 x_get_local_selection (selection_symbol, target_type, local_request)
453 Lisp_Object selection_symbol, target_type;
454 int local_request;
456 Lisp_Object local_value;
457 Lisp_Object handler_fn, value, type, check;
458 int count;
460 local_value = assq_no_quit (selection_symbol, Vselection_alist);
462 if (NILP (local_value)) return Qnil;
464 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
465 if (EQ (target_type, QTIMESTAMP))
467 handler_fn = Qnil;
468 value = XCAR (XCDR (XCDR (local_value)));
470 #if 0
471 else if (EQ (target_type, QDELETE))
473 handler_fn = Qnil;
474 Fx_disown_selection_internal
475 (selection_symbol,
476 XCAR (XCDR (XCDR (local_value))));
477 value = QNULL;
479 #endif
481 #if 0 /* #### MULTIPLE doesn't work yet */
482 else if (CONSP (target_type)
483 && XCAR (target_type) == QMULTIPLE)
485 Lisp_Object pairs;
486 int size;
487 int i;
488 pairs = XCDR (target_type);
489 size = XVECTOR_SIZE (pairs);
490 /* If the target is MULTIPLE, then target_type looks like
491 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
492 We modify the second element of each pair in the vector and
493 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
495 for (i = 0; i < size; i++)
497 Lisp_Object pair;
498 pair = XVECTOR (pairs)->contents [i];
499 XVECTOR (pair)->contents [1]
500 = x_get_local_selection (XVECTOR (pair)->contents [0],
501 XVECTOR (pair)->contents [1],
502 local_request);
504 return pairs;
506 #endif
507 else
509 /* Don't allow a quit within the converter.
510 When the user types C-g, he would be surprised
511 if by luck it came during a converter. */
512 count = SPECPDL_INDEX ();
513 specbind (Qinhibit_quit, Qt);
515 CHECK_SYMBOL (target_type);
516 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
517 /* gcpro is not needed here since nothing but HANDLER_FN
518 is live, and that ought to be a symbol. */
520 if (!NILP (handler_fn))
521 value = call3 (handler_fn,
522 selection_symbol, (local_request ? Qnil : target_type),
523 XCAR (XCDR (local_value)));
524 else
525 value = Qnil;
526 unbind_to (count, Qnil);
529 /* Make sure this value is of a type that we could transmit
530 to another X client. */
532 check = value;
533 if (CONSP (value)
534 && SYMBOLP (XCAR (value)))
535 type = XCAR (value),
536 check = XCDR (value);
538 if (STRINGP (check)
539 || VECTORP (check)
540 || SYMBOLP (check)
541 || INTEGERP (check)
542 || NILP (value))
543 return value;
544 /* Check for a value that cons_to_long could handle. */
545 else if (CONSP (check)
546 && INTEGERP (XCAR (check))
547 && (INTEGERP (XCDR (check))
549 (CONSP (XCDR (check))
550 && INTEGERP (XCAR (XCDR (check)))
551 && NILP (XCDR (XCDR (check))))))
552 return value;
554 signal_error ("Invalid data returned by selection-conversion function",
555 list2 (handler_fn, value));
558 /* Subroutines of x_reply_selection_request. */
560 /* Send a SelectionNotify event to the requestor with property=None,
561 meaning we were unable to do what they wanted. */
563 static void
564 x_decline_selection_request (event)
565 struct input_event *event;
567 XEvent reply_base;
568 XSelectionEvent *reply = &(reply_base.xselection);
570 reply->type = SelectionNotify;
571 reply->display = SELECTION_EVENT_DISPLAY (event);
572 reply->requestor = SELECTION_EVENT_REQUESTOR (event);
573 reply->selection = SELECTION_EVENT_SELECTION (event);
574 reply->time = SELECTION_EVENT_TIME (event);
575 reply->target = SELECTION_EVENT_TARGET (event);
576 reply->property = None;
578 /* The reason for the error may be that the receiver has
579 died in the meantime. Handle that case. */
580 BLOCK_INPUT;
581 x_catch_errors (reply->display);
582 XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
583 XFlush (reply->display);
584 x_uncatch_errors ();
585 UNBLOCK_INPUT;
588 /* This is the selection request currently being processed.
589 It is set to zero when the request is fully processed. */
590 static struct input_event *x_selection_current_request;
592 /* Display info in x_selection_request. */
594 static struct x_display_info *selection_request_dpyinfo;
596 /* Used as an unwind-protect clause so that, if a selection-converter signals
597 an error, we tell the requester that we were unable to do what they wanted
598 before we throw to top-level or go into the debugger or whatever. */
600 static Lisp_Object
601 x_selection_request_lisp_error (ignore)
602 Lisp_Object ignore;
604 if (x_selection_current_request != 0
605 && selection_request_dpyinfo->display)
606 x_decline_selection_request (x_selection_current_request);
607 return Qnil;
610 static Lisp_Object
611 x_catch_errors_unwind (dummy)
612 Lisp_Object dummy;
614 BLOCK_INPUT;
615 x_uncatch_errors ();
616 UNBLOCK_INPUT;
617 return Qnil;
621 /* This stuff is so that INCR selections are reentrant (that is, so we can
622 be servicing multiple INCR selection requests simultaneously.) I haven't
623 actually tested that yet. */
625 /* Keep a list of the property changes that are awaited. */
627 struct prop_location
629 int identifier;
630 Display *display;
631 Window window;
632 Atom property;
633 int desired_state;
634 int arrived;
635 struct prop_location *next;
638 static struct prop_location *expect_property_change ();
639 static void wait_for_property_change ();
640 static void unexpect_property_change ();
641 static int waiting_for_other_props_on_window ();
643 static int prop_location_identifier;
645 static Lisp_Object property_change_reply;
647 static struct prop_location *property_change_reply_object;
649 static struct prop_location *property_change_wait_list;
651 static Lisp_Object
652 queue_selection_requests_unwind (tem)
653 Lisp_Object tem;
655 x_stop_queuing_selection_requests ();
656 return Qnil;
659 /* Return some frame whose display info is DPYINFO.
660 Return nil if there is none. */
662 static Lisp_Object
663 some_frame_on_display (dpyinfo)
664 struct x_display_info *dpyinfo;
666 Lisp_Object list, frame;
668 FOR_EACH_FRAME (list, frame)
670 if (FRAME_X_P (XFRAME (frame))
671 && FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
672 return frame;
675 return Qnil;
678 /* Send the reply to a selection request event EVENT.
679 TYPE is the type of selection data requested.
680 DATA and SIZE describe the data to send, already converted.
681 FORMAT is the unit-size (in bits) of the data to be transmitted. */
683 #ifdef TRACE_SELECTION
684 static int x_reply_selection_request_cnt;
685 #endif /* TRACE_SELECTION */
687 static void
688 x_reply_selection_request (event, format, data, size, type)
689 struct input_event *event;
690 int format, size;
691 unsigned char *data;
692 Atom type;
694 XEvent reply_base;
695 XSelectionEvent *reply = &(reply_base.xselection);
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 char *sel = XGetAtomName (display, reply->selection);
727 char *tgt = XGetAtomName (display, reply->target);
728 TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
729 if (sel) XFree (sel);
730 if (tgt) XFree (tgt);
732 #endif /* TRACE_SELECTION */
734 /* Store the data on the requested property.
735 If the selection is large, only store the first N bytes of it.
737 bytes_remaining = size * format_bytes;
738 if (bytes_remaining <= max_bytes)
740 /* Send all the data at once, with minimal handshaking. */
741 TRACE1 ("Sending all %d bytes", bytes_remaining);
742 XChangeProperty (display, window, reply->property, type, format,
743 PropModeReplace, data, size);
744 /* At this point, the selection was successfully stored; ack it. */
745 XSendEvent (display, window, False, 0L, &reply_base);
747 else
749 /* Send an INCR selection. */
750 struct prop_location *wait_object;
751 int had_errors;
752 Lisp_Object frame;
754 frame = some_frame_on_display (dpyinfo);
756 /* If the display no longer has frames, we can't expect
757 to get many more selection requests from it, so don't
758 bother trying to queue them. */
759 if (!NILP (frame))
761 x_start_queuing_selection_requests ();
763 record_unwind_protect (queue_selection_requests_unwind,
764 Qnil);
767 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
768 error ("Attempt to transfer an INCR to ourself!");
770 TRACE2 ("Start sending %d bytes incrementally (%s)",
771 bytes_remaining, XGetAtomName (display, reply->property));
772 wait_object = expect_property_change (display, window, reply->property,
773 PropertyDelete);
775 TRACE1 ("Set %s to number of bytes to send",
776 XGetAtomName (display, reply->property));
778 /* XChangeProperty expects an array of long even if long is more than
779 32 bits. */
780 long value[1];
782 value[0] = bytes_remaining;
783 XChangeProperty (display, window, reply->property, dpyinfo->Xatom_INCR,
784 32, PropModeReplace,
785 (unsigned char *) value, 1);
788 XSelectInput (display, window, PropertyChangeMask);
790 /* Tell 'em the INCR data is there... */
791 TRACE0 ("Send SelectionNotify event");
792 XSendEvent (display, window, False, 0L, &reply_base);
793 XFlush (display);
795 had_errors = x_had_errors_p (display);
796 UNBLOCK_INPUT;
798 /* First, wait for the requester to ack by deleting the property.
799 This can run random lisp code (process handlers) or signal. */
800 if (! had_errors)
802 TRACE1 ("Waiting for ACK (deletion of %s)",
803 XGetAtomName (display, reply->property));
804 wait_for_property_change (wait_object);
806 else
807 unexpect_property_change (wait_object);
809 TRACE0 ("Got ACK");
810 while (bytes_remaining)
812 int i = ((bytes_remaining < max_bytes)
813 ? bytes_remaining
814 : max_bytes) / format_bytes;
816 BLOCK_INPUT;
818 wait_object
819 = expect_property_change (display, window, reply->property,
820 PropertyDelete);
822 TRACE1 ("Sending increment of %d elements", i);
823 TRACE1 ("Set %s to increment data",
824 XGetAtomName (display, reply->property));
826 /* Append the next chunk of data to the property. */
827 XChangeProperty (display, window, reply->property, type, format,
828 PropModeAppend, data, i);
829 bytes_remaining -= i * format_bytes;
830 if (format == 32)
831 data += i * sizeof (long);
832 else
833 data += i * format_bytes;
834 XFlush (display);
835 had_errors = x_had_errors_p (display);
836 UNBLOCK_INPUT;
838 if (had_errors)
839 break;
841 /* Now wait for the requester to ack this chunk by deleting the
842 property. This can run random lisp code or signal. */
843 TRACE1 ("Waiting for increment ACK (deletion of %s)",
844 XGetAtomName (display, reply->property));
845 wait_for_property_change (wait_object);
848 /* Now write a zero-length chunk to the property to tell the
849 requester that we're done. */
850 BLOCK_INPUT;
851 if (! waiting_for_other_props_on_window (display, window))
852 XSelectInput (display, window, 0L);
854 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
855 XGetAtomName (display, reply->property));
856 XChangeProperty (display, window, reply->property, type, format,
857 PropModeReplace, data, 0);
858 TRACE0 ("Done sending incrementally");
861 /* rms, 2003-01-03: I think I have fixed this bug. */
862 /* The window we're communicating with may have been deleted
863 in the meantime (that's a real situation from a bug report).
864 In this case, there may be events in the event queue still
865 refering to the deleted window, and we'll get a BadWindow error
866 in XTread_socket when processing the events. I don't have
867 an idea how to fix that. gerd, 2001-01-98. */
868 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
869 delivered before uncatch errors. */
870 XSync (display, False);
871 UNBLOCK_INPUT;
873 /* GTK queues events in addition to the queue in Xlib. So we
874 UNBLOCK to enter the event loop and get possible errors delivered,
875 and then BLOCK again because x_uncatch_errors requires it. */
876 BLOCK_INPUT;
877 /* This calls x_uncatch_errors. */
878 unbind_to (count, Qnil);
879 UNBLOCK_INPUT;
882 /* Handle a SelectionRequest event EVENT.
883 This is called from keyboard.c when such an event is found in the queue. */
885 static void
886 x_handle_selection_request (event)
887 struct input_event *event;
889 struct gcpro gcpro1, gcpro2, gcpro3;
890 Lisp_Object local_selection_data;
891 Lisp_Object selection_symbol;
892 Lisp_Object target_symbol;
893 Lisp_Object converted_selection;
894 Time local_selection_time;
895 Lisp_Object successful_p;
896 int count;
897 struct x_display_info *dpyinfo
898 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
900 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
901 (unsigned long) SELECTION_EVENT_REQUESTOR (event),
902 (unsigned long) SELECTION_EVENT_TIME (event));
904 local_selection_data = Qnil;
905 target_symbol = Qnil;
906 converted_selection = Qnil;
907 successful_p = Qnil;
909 GCPRO3 (local_selection_data, converted_selection, target_symbol);
911 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
912 SELECTION_EVENT_SELECTION (event));
914 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
916 if (NILP (local_selection_data))
918 /* Someone asked for the selection, but we don't have it any more.
920 x_decline_selection_request (event);
921 goto DONE;
924 local_selection_time = (Time)
925 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
927 if (SELECTION_EVENT_TIME (event) != CurrentTime
928 && local_selection_time > SELECTION_EVENT_TIME (event))
930 /* Someone asked for the selection, and we have one, but not the one
931 they're looking for.
933 x_decline_selection_request (event);
934 goto DONE;
937 x_selection_current_request = event;
938 count = SPECPDL_INDEX ();
939 selection_request_dpyinfo = dpyinfo;
940 record_unwind_protect (x_selection_request_lisp_error, Qnil);
942 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
943 SELECTION_EVENT_TARGET (event));
945 #if 0 /* #### MULTIPLE doesn't work yet */
946 if (EQ (target_symbol, QMULTIPLE))
947 target_symbol = fetch_multiple_target (event);
948 #endif
950 /* Convert lisp objects back into binary data */
952 converted_selection
953 = x_get_local_selection (selection_symbol, target_symbol, 0);
955 if (! NILP (converted_selection))
957 unsigned char *data;
958 unsigned int size;
959 int format;
960 Atom type;
961 int nofree;
963 if (CONSP (converted_selection) && NILP (XCDR (converted_selection)))
965 x_decline_selection_request (event);
966 goto DONE2;
969 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
970 converted_selection,
971 &data, &type, &size, &format, &nofree);
973 x_reply_selection_request (event, format, data, size, type);
974 successful_p = Qt;
976 /* Indicate we have successfully processed this event. */
977 x_selection_current_request = 0;
979 /* Use xfree, not XFree, because lisp_data_to_selection_data
980 calls xmalloc itself. */
981 if (!nofree)
982 xfree (data);
985 DONE2:
986 unbind_to (count, Qnil);
988 DONE:
990 /* Let random lisp code notice that the selection has been asked for. */
992 Lisp_Object rest;
993 rest = Vx_sent_selection_functions;
994 if (!EQ (rest, Qunbound))
995 for (; CONSP (rest); rest = Fcdr (rest))
996 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
999 UNGCPRO;
1002 /* Handle a SelectionClear event EVENT, which indicates that some
1003 client cleared out our previously asserted selection.
1004 This is called from keyboard.c when such an event is found in the queue. */
1006 static void
1007 x_handle_selection_clear (event)
1008 struct input_event *event;
1010 Display *display = SELECTION_EVENT_DISPLAY (event);
1011 Atom selection = SELECTION_EVENT_SELECTION (event);
1012 Time changed_owner_time = SELECTION_EVENT_TIME (event);
1014 Lisp_Object selection_symbol, local_selection_data;
1015 Time local_selection_time;
1016 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1017 struct x_display_info *t_dpyinfo;
1019 TRACE0 ("x_handle_selection_clear");
1021 /* If the new selection owner is also Emacs,
1022 don't clear the new selection. */
1023 BLOCK_INPUT;
1024 /* Check each display on the same terminal,
1025 to see if this Emacs job now owns the selection
1026 through that display. */
1027 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1028 if (t_dpyinfo->terminal->kboard == dpyinfo->terminal->kboard)
1030 Window owner_window
1031 = XGetSelectionOwner (t_dpyinfo->display, selection);
1032 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1034 UNBLOCK_INPUT;
1035 return;
1038 UNBLOCK_INPUT;
1040 selection_symbol = x_atom_to_symbol (display, selection);
1042 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1044 /* Well, we already believe that we don't own it, so that's just fine. */
1045 if (NILP (local_selection_data)) return;
1047 local_selection_time = (Time)
1048 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
1050 /* This SelectionClear is for a selection that we no longer own, so we can
1051 disregard it. (That is, we have reasserted the selection since this
1052 request was generated.) */
1054 if (changed_owner_time != CurrentTime
1055 && local_selection_time > changed_owner_time)
1056 return;
1058 /* Otherwise, we're really honest and truly being told to drop it.
1059 Don't use Fdelq as that may QUIT;. */
1061 if (EQ (local_selection_data, Fcar (Vselection_alist)))
1062 Vselection_alist = Fcdr (Vselection_alist);
1063 else
1065 Lisp_Object rest;
1066 for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
1067 if (EQ (local_selection_data, Fcar (XCDR (rest))))
1069 XSETCDR (rest, Fcdr (XCDR (rest)));
1070 break;
1074 /* Let random lisp code notice that the selection has been stolen. */
1077 Lisp_Object rest;
1078 rest = Vx_lost_selection_functions;
1079 if (!EQ (rest, Qunbound))
1081 for (; CONSP (rest); rest = Fcdr (rest))
1082 call1 (Fcar (rest), selection_symbol);
1083 prepare_menu_bars ();
1084 redisplay_preserve_echo_area (20);
1089 void
1090 x_handle_selection_event (event)
1091 struct input_event *event;
1093 TRACE0 ("x_handle_selection_event");
1095 if (event->kind == SELECTION_REQUEST_EVENT)
1097 if (x_queue_selection_requests)
1098 x_queue_event (event);
1099 else
1100 x_handle_selection_request (event);
1102 else
1103 x_handle_selection_clear (event);
1107 /* Clear all selections that were made from frame F.
1108 We do this when about to delete a frame. */
1110 void
1111 x_clear_frame_selections (f)
1112 FRAME_PTR f;
1114 Lisp_Object frame;
1115 Lisp_Object rest;
1117 XSETFRAME (frame, f);
1119 /* Otherwise, we're really honest and truly being told to drop it.
1120 Don't use Fdelq as that may QUIT;. */
1122 /* Delete elements from the beginning of Vselection_alist. */
1123 while (!NILP (Vselection_alist)
1124 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1126 /* Let random Lisp code notice that the selection has been stolen. */
1127 Lisp_Object hooks, selection_symbol;
1129 hooks = Vx_lost_selection_functions;
1130 selection_symbol = Fcar (Fcar (Vselection_alist));
1132 if (!EQ (hooks, Qunbound))
1134 for (; CONSP (hooks); hooks = Fcdr (hooks))
1135 call1 (Fcar (hooks), selection_symbol);
1136 #if 0 /* This can crash when deleting a frame
1137 from x_connection_closed. Anyway, it seems unnecessary;
1138 something else should cause a redisplay. */
1139 redisplay_preserve_echo_area (21);
1140 #endif
1143 Vselection_alist = Fcdr (Vselection_alist);
1146 /* Delete elements after the beginning of Vselection_alist. */
1147 for (rest = Vselection_alist; CONSP (rest); rest = XCDR (rest))
1148 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
1150 /* Let random Lisp code notice that the selection has been stolen. */
1151 Lisp_Object hooks, selection_symbol;
1153 hooks = Vx_lost_selection_functions;
1154 selection_symbol = Fcar (Fcar (XCDR (rest)));
1156 if (!EQ (hooks, Qunbound))
1158 for (; CONSP (hooks); hooks = Fcdr (hooks))
1159 call1 (Fcar (hooks), selection_symbol);
1160 #if 0 /* See above */
1161 redisplay_preserve_echo_area (22);
1162 #endif
1164 XSETCDR (rest, Fcdr (XCDR (rest)));
1165 break;
1169 /* Nonzero if any properties for DISPLAY and WINDOW
1170 are on the list of what we are waiting for. */
1172 static int
1173 waiting_for_other_props_on_window (display, window)
1174 Display *display;
1175 Window window;
1177 struct prop_location *rest = property_change_wait_list;
1178 while (rest)
1179 if (rest->display == display && rest->window == window)
1180 return 1;
1181 else
1182 rest = rest->next;
1183 return 0;
1186 /* Add an entry to the list of property changes we are waiting for.
1187 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1188 The return value is a number that uniquely identifies
1189 this awaited property change. */
1191 static struct prop_location *
1192 expect_property_change (display, window, property, state)
1193 Display *display;
1194 Window window;
1195 Atom property;
1196 int state;
1198 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1199 pl->identifier = ++prop_location_identifier;
1200 pl->display = display;
1201 pl->window = window;
1202 pl->property = property;
1203 pl->desired_state = state;
1204 pl->next = property_change_wait_list;
1205 pl->arrived = 0;
1206 property_change_wait_list = pl;
1207 return pl;
1210 /* Delete an entry from the list of property changes we are waiting for.
1211 IDENTIFIER is the number that uniquely identifies the entry. */
1213 static void
1214 unexpect_property_change (location)
1215 struct prop_location *location;
1217 struct prop_location *prev = 0, *rest = property_change_wait_list;
1218 while (rest)
1220 if (rest == location)
1222 if (prev)
1223 prev->next = rest->next;
1224 else
1225 property_change_wait_list = rest->next;
1226 xfree (rest);
1227 return;
1229 prev = rest;
1230 rest = rest->next;
1234 /* Remove the property change expectation element for IDENTIFIER. */
1236 static Lisp_Object
1237 wait_for_property_change_unwind (loc)
1238 Lisp_Object loc;
1240 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1242 unexpect_property_change (location);
1243 if (location == property_change_reply_object)
1244 property_change_reply_object = 0;
1245 return Qnil;
1248 /* Actually wait for a property change.
1249 IDENTIFIER should be the value that expect_property_change returned. */
1251 static void
1252 wait_for_property_change (location)
1253 struct prop_location *location;
1255 int secs, usecs;
1256 int count = SPECPDL_INDEX ();
1258 if (property_change_reply_object)
1259 abort ();
1261 /* Make sure to do unexpect_property_change if we quit or err. */
1262 record_unwind_protect (wait_for_property_change_unwind,
1263 make_save_value (location, 0));
1265 XSETCAR (property_change_reply, Qnil);
1266 property_change_reply_object = location;
1268 /* If the event we are waiting for arrives beyond here, it will set
1269 property_change_reply, because property_change_reply_object says so. */
1270 if (! location->arrived)
1272 secs = x_selection_timeout / 1000;
1273 usecs = (x_selection_timeout % 1000) * 1000;
1274 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1275 wait_reading_process_output (secs, usecs, 0, 0,
1276 property_change_reply, NULL, 0);
1278 if (NILP (XCAR (property_change_reply)))
1280 TRACE0 (" Timed out");
1281 error ("Timed out waiting for property-notify event");
1285 unbind_to (count, Qnil);
1288 /* Called from XTread_socket in response to a PropertyNotify event. */
1290 void
1291 x_handle_property_notify (event)
1292 XPropertyEvent *event;
1294 struct prop_location *prev = 0, *rest = property_change_wait_list;
1296 while (rest)
1298 if (!rest->arrived
1299 && rest->property == event->atom
1300 && rest->window == event->window
1301 && rest->display == event->display
1302 && rest->desired_state == event->state)
1304 TRACE2 ("Expected %s of property %s",
1305 (event->state == PropertyDelete ? "deletion" : "change"),
1306 XGetAtomName (event->display, event->atom));
1308 rest->arrived = 1;
1310 /* If this is the one wait_for_property_change is waiting for,
1311 tell it to wake up. */
1312 if (rest == property_change_reply_object)
1313 XSETCAR (property_change_reply, Qt);
1315 return;
1318 prev = rest;
1319 rest = rest->next;
1325 #if 0 /* #### MULTIPLE doesn't work yet */
1327 static Lisp_Object
1328 fetch_multiple_target (event)
1329 XSelectionRequestEvent *event;
1331 Display *display = event->display;
1332 Window window = event->requestor;
1333 Atom target = event->target;
1334 Atom selection_atom = event->selection;
1335 int result;
1337 return
1338 Fcons (QMULTIPLE,
1339 x_get_window_property_as_lisp_data (display, window, target,
1340 QMULTIPLE, selection_atom));
1343 static Lisp_Object
1344 copy_multiple_data (obj)
1345 Lisp_Object obj;
1347 Lisp_Object vec;
1348 int i;
1349 int size;
1350 if (CONSP (obj))
1351 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1353 CHECK_VECTOR (obj);
1354 vec = Fmake_vector (size = XVECTOR_SIZE (obj), Qnil);
1355 for (i = 0; i < size; i++)
1357 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1358 CHECK_VECTOR (vec2);
1359 if (XVECTOR_SIZE (vec2) != 2)
1360 /* ??? Confusing error message */
1361 signal_error ("Vectors must be of length 2", vec2);
1362 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1363 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1364 = XVECTOR (vec2)->contents [0];
1365 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1366 = XVECTOR (vec2)->contents [1];
1368 return vec;
1371 #endif
1374 /* Variables for communication with x_handle_selection_notify. */
1375 static Atom reading_which_selection;
1376 static Lisp_Object reading_selection_reply;
1377 static Window reading_selection_window;
1379 /* Do protocol to read selection-data from the server.
1380 Converts this to Lisp data and returns it. */
1382 static Lisp_Object
1383 x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1384 Lisp_Object selection_symbol, target_type, time_stamp;
1386 struct frame *sf = SELECTED_FRAME ();
1387 Window requestor_window;
1388 Display *display;
1389 struct x_display_info *dpyinfo;
1390 Time requestor_time = last_event_timestamp;
1391 Atom target_property;
1392 Atom selection_atom;
1393 Atom type_atom;
1394 int secs, usecs;
1395 int count = SPECPDL_INDEX ();
1396 Lisp_Object frame;
1398 if (! FRAME_X_P (sf))
1399 return Qnil;
1401 requestor_window = FRAME_X_WINDOW (sf);
1402 display = FRAME_X_DISPLAY (sf);
1403 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1404 target_property = dpyinfo->Xatom_EMACS_TMP;
1405 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1407 if (CONSP (target_type))
1408 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1409 else
1410 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1412 if (! NILP (time_stamp))
1414 if (CONSP (time_stamp))
1415 requestor_time = (Time) cons_to_long (time_stamp);
1416 else if (INTEGERP (time_stamp))
1417 requestor_time = (Time) XUINT (time_stamp);
1418 else if (FLOATP (time_stamp))
1419 requestor_time = (Time) XFLOAT_DATA (time_stamp);
1420 else
1421 error ("TIME_STAMP must be cons or number");
1424 BLOCK_INPUT;
1426 /* The protected block contains wait_reading_process_output, which
1427 can run random lisp code (process handlers) or signal.
1428 Therefore, we put the x_uncatch_errors call in an unwind. */
1429 record_unwind_protect (x_catch_errors_unwind, Qnil);
1430 x_catch_errors (display);
1432 TRACE2 ("Get selection %s, type %s",
1433 XGetAtomName (display, type_atom),
1434 XGetAtomName (display, target_property));
1436 XConvertSelection (display, selection_atom, type_atom, target_property,
1437 requestor_window, requestor_time);
1438 XFlush (display);
1440 /* Prepare to block until the reply has been read. */
1441 reading_selection_window = requestor_window;
1442 reading_which_selection = selection_atom;
1443 XSETCAR (reading_selection_reply, Qnil);
1445 frame = some_frame_on_display (dpyinfo);
1447 /* If the display no longer has frames, we can't expect
1448 to get many more selection requests from it, so don't
1449 bother trying to queue them. */
1450 if (!NILP (frame))
1452 x_start_queuing_selection_requests ();
1454 record_unwind_protect (queue_selection_requests_unwind,
1455 Qnil);
1457 UNBLOCK_INPUT;
1459 /* This allows quits. Also, don't wait forever. */
1460 secs = x_selection_timeout / 1000;
1461 usecs = (x_selection_timeout % 1000) * 1000;
1462 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1463 wait_reading_process_output (secs, usecs, 0, 0,
1464 reading_selection_reply, NULL, 0);
1465 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1467 BLOCK_INPUT;
1468 if (x_had_errors_p (display))
1469 error ("Cannot get selection");
1470 /* This calls x_uncatch_errors. */
1471 unbind_to (count, Qnil);
1472 UNBLOCK_INPUT;
1474 if (NILP (XCAR (reading_selection_reply)))
1475 error ("Timed out waiting for reply from selection owner");
1476 if (EQ (XCAR (reading_selection_reply), Qlambda))
1477 return Qnil;
1479 /* Otherwise, the selection is waiting for us on the requested property. */
1480 return
1481 x_get_window_property_as_lisp_data (display, requestor_window,
1482 target_property, target_type,
1483 selection_atom);
1486 /* Subroutines of x_get_window_property_as_lisp_data */
1488 /* Use xfree, not XFree, to free the data obtained with this function. */
1490 static void
1491 x_get_window_property (display, window, property, data_ret, bytes_ret,
1492 actual_type_ret, actual_format_ret, actual_size_ret,
1493 delete_p)
1494 Display *display;
1495 Window window;
1496 Atom property;
1497 unsigned char **data_ret;
1498 int *bytes_ret;
1499 Atom *actual_type_ret;
1500 int *actual_format_ret;
1501 unsigned long *actual_size_ret;
1502 int delete_p;
1504 int total_size;
1505 unsigned long bytes_remaining;
1506 int offset = 0;
1507 unsigned char *tmp_data = 0;
1508 int result;
1509 int buffer_size = SELECTION_QUANTUM (display);
1511 if (buffer_size > MAX_SELECTION_QUANTUM)
1512 buffer_size = MAX_SELECTION_QUANTUM;
1514 BLOCK_INPUT;
1516 /* First probe the thing to find out how big it is. */
1517 result = XGetWindowProperty (display, window, property,
1518 0L, 0L, False, AnyPropertyType,
1519 actual_type_ret, actual_format_ret,
1520 actual_size_ret,
1521 &bytes_remaining, &tmp_data);
1522 if (result != Success)
1524 UNBLOCK_INPUT;
1525 *data_ret = 0;
1526 *bytes_ret = 0;
1527 return;
1530 /* This was allocated by Xlib, so use XFree. */
1531 XFree ((char *) tmp_data);
1533 if (*actual_type_ret == None || *actual_format_ret == 0)
1535 UNBLOCK_INPUT;
1536 return;
1539 total_size = bytes_remaining + 1;
1540 *data_ret = (unsigned char *) xmalloc (total_size);
1542 /* Now read, until we've gotten it all. */
1543 while (bytes_remaining)
1545 #ifdef TRACE_SELECTION
1546 int last = bytes_remaining;
1547 #endif
1548 result
1549 = XGetWindowProperty (display, window, property,
1550 (long)offset/4, (long)buffer_size/4,
1551 False,
1552 AnyPropertyType,
1553 actual_type_ret, actual_format_ret,
1554 actual_size_ret, &bytes_remaining, &tmp_data);
1556 TRACE2 ("Read %ld bytes from property %s",
1557 last - bytes_remaining,
1558 XGetAtomName (display, property));
1560 /* If this doesn't return Success at this point, it means that
1561 some clod deleted the selection while we were in the midst of
1562 reading it. Deal with that, I guess.... */
1563 if (result != Success)
1564 break;
1566 /* The man page for XGetWindowProperty says:
1567 "If the returned format is 32, the returned data is represented
1568 as a long array and should be cast to that type to obtain the
1569 elements."
1570 This applies even if long is more than 32 bits, the X library
1571 converts from 32 bit elements received from the X server to long
1572 and passes the long array to us. Thus, for that case bcopy can not
1573 be used. We convert to a 32 bit type here, because so much code
1574 assume on that.
1576 The bytes and offsets passed to XGetWindowProperty refers to the
1577 property and those are indeed in 32 bit quantities if format is 32. */
1579 if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1581 unsigned long i;
1582 int *idata = (int *) ((*data_ret) + offset);
1583 long *ldata = (long *) tmp_data;
1585 for (i = 0; i < *actual_size_ret; ++i)
1587 idata[i]= (int) ldata[i];
1588 offset += 4;
1591 else
1593 *actual_size_ret *= *actual_format_ret / 8;
1594 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1595 offset += *actual_size_ret;
1598 /* This was allocated by Xlib, so use XFree. */
1599 XFree ((char *) tmp_data);
1602 XFlush (display);
1603 UNBLOCK_INPUT;
1604 *bytes_ret = offset;
1607 /* Use xfree, not XFree, to free the data obtained with this function. */
1609 static void
1610 receive_incremental_selection (display, window, property, target_type,
1611 min_size_bytes, data_ret, size_bytes_ret,
1612 type_ret, format_ret, size_ret)
1613 Display *display;
1614 Window window;
1615 Atom property;
1616 Lisp_Object target_type; /* for error messages only */
1617 unsigned int min_size_bytes;
1618 unsigned char **data_ret;
1619 int *size_bytes_ret;
1620 Atom *type_ret;
1621 unsigned long *size_ret;
1622 int *format_ret;
1624 int offset = 0;
1625 struct prop_location *wait_object;
1626 *size_bytes_ret = min_size_bytes;
1627 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1629 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1631 /* At this point, we have read an INCR property.
1632 Delete the property to ack it.
1633 (But first, prepare to receive the next event in this handshake.)
1635 Now, we must loop, waiting for the sending window to put a value on
1636 that property, then reading the property, then deleting it to ack.
1637 We are done when the sender places a property of length 0.
1639 BLOCK_INPUT;
1640 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1641 TRACE1 (" Delete property %s",
1642 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1643 XDeleteProperty (display, window, property);
1644 TRACE1 (" Expect new value of property %s",
1645 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1646 wait_object = expect_property_change (display, window, property,
1647 PropertyNewValue);
1648 XFlush (display);
1649 UNBLOCK_INPUT;
1651 while (1)
1653 unsigned char *tmp_data;
1654 int tmp_size_bytes;
1656 TRACE0 (" Wait for property change");
1657 wait_for_property_change (wait_object);
1659 /* expect it again immediately, because x_get_window_property may
1660 .. no it won't, I don't get it.
1661 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1662 TRACE0 (" Get property value");
1663 x_get_window_property (display, window, property,
1664 &tmp_data, &tmp_size_bytes,
1665 type_ret, format_ret, size_ret, 1);
1667 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1669 if (tmp_size_bytes == 0) /* we're done */
1671 TRACE0 ("Done reading incrementally");
1673 if (! waiting_for_other_props_on_window (display, window))
1674 XSelectInput (display, window, STANDARD_EVENT_SET);
1675 /* Use xfree, not XFree, because x_get_window_property
1676 calls xmalloc itself. */
1677 xfree (tmp_data);
1678 break;
1681 BLOCK_INPUT;
1682 TRACE1 (" ACK by deleting property %s",
1683 XGetAtomName (display, property));
1684 XDeleteProperty (display, window, property);
1685 wait_object = expect_property_change (display, window, property,
1686 PropertyNewValue);
1687 XFlush (display);
1688 UNBLOCK_INPUT;
1690 if (*size_bytes_ret < offset + tmp_size_bytes)
1692 *size_bytes_ret = offset + tmp_size_bytes;
1693 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1696 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1697 offset += tmp_size_bytes;
1699 /* Use xfree, not XFree, because x_get_window_property
1700 calls xmalloc itself. */
1701 xfree (tmp_data);
1706 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1707 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1708 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1710 static Lisp_Object
1711 x_get_window_property_as_lisp_data (display, window, property, target_type,
1712 selection_atom)
1713 Display *display;
1714 Window window;
1715 Atom property;
1716 Lisp_Object target_type; /* for error messages only */
1717 Atom selection_atom; /* for error messages only */
1719 Atom actual_type;
1720 int actual_format;
1721 unsigned long actual_size;
1722 unsigned char *data = 0;
1723 int bytes = 0;
1724 Lisp_Object val;
1725 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1727 TRACE0 ("Reading selection data");
1729 x_get_window_property (display, window, property, &data, &bytes,
1730 &actual_type, &actual_format, &actual_size, 1);
1731 if (! data)
1733 int there_is_a_selection_owner;
1734 BLOCK_INPUT;
1735 there_is_a_selection_owner
1736 = XGetSelectionOwner (display, selection_atom);
1737 UNBLOCK_INPUT;
1738 if (there_is_a_selection_owner)
1739 signal_error ("Selection owner couldn't convert",
1740 actual_type
1741 ? list2 (target_type,
1742 x_atom_to_symbol (display, actual_type))
1743 : target_type);
1744 else
1745 signal_error ("No selection",
1746 x_atom_to_symbol (display, selection_atom));
1749 if (actual_type == dpyinfo->Xatom_INCR)
1751 /* That wasn't really the data, just the beginning. */
1753 unsigned int min_size_bytes = * ((unsigned int *) data);
1754 BLOCK_INPUT;
1755 /* Use xfree, not XFree, because x_get_window_property
1756 calls xmalloc itself. */
1757 xfree ((char *) data);
1758 UNBLOCK_INPUT;
1759 receive_incremental_selection (display, window, property, target_type,
1760 min_size_bytes, &data, &bytes,
1761 &actual_type, &actual_format,
1762 &actual_size);
1765 BLOCK_INPUT;
1766 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1767 XDeleteProperty (display, window, property);
1768 XFlush (display);
1769 UNBLOCK_INPUT;
1771 /* It's been read. Now convert it to a lisp object in some semi-rational
1772 manner. */
1773 val = selection_data_to_lisp_data (display, data, bytes,
1774 actual_type, actual_format);
1776 /* Use xfree, not XFree, because x_get_window_property
1777 calls xmalloc itself. */
1778 xfree ((char *) data);
1779 return val;
1782 /* These functions convert from the selection data read from the server into
1783 something that we can use from Lisp, and vice versa.
1785 Type: Format: Size: Lisp Type:
1786 ----- ------- ----- -----------
1787 * 8 * String
1788 ATOM 32 1 Symbol
1789 ATOM 32 > 1 Vector of Symbols
1790 * 16 1 Integer
1791 * 16 > 1 Vector of Integers
1792 * 32 1 if <=16 bits: Integer
1793 if > 16 bits: Cons of top16, bot16
1794 * 32 > 1 Vector of the above
1796 When converting a Lisp number to C, it is assumed to be of format 16 if
1797 it is an integer, and of format 32 if it is a cons of two integers.
1799 When converting a vector of numbers from Lisp to C, it is assumed to be
1800 of format 16 if every element in the vector is an integer, and is assumed
1801 to be of format 32 if any element is a cons of two integers.
1803 When converting an object to C, it may be of the form (SYMBOL . <data>)
1804 where SYMBOL is what we should claim that the type is. Format and
1805 representation are as above.
1807 Important: When format is 32, data should contain an array of int,
1808 not an array of long as the X library returns. This makes a difference
1809 when sizeof(long) != sizeof(int). */
1813 static Lisp_Object
1814 selection_data_to_lisp_data (display, data, size, type, format)
1815 Display *display;
1816 unsigned char *data;
1817 Atom type;
1818 int size, format;
1820 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1822 if (type == dpyinfo->Xatom_NULL)
1823 return QNULL;
1825 /* Convert any 8-bit data to a string, for compactness. */
1826 else if (format == 8)
1828 Lisp_Object str, lispy_type;
1830 str = make_unibyte_string ((char *) data, size);
1831 /* Indicate that this string is from foreign selection by a text
1832 property `foreign-selection' so that the caller of
1833 x-get-selection-internal (usually x-get-selection) can know
1834 that the string must be decode. */
1835 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1836 lispy_type = QCOMPOUND_TEXT;
1837 else if (type == dpyinfo->Xatom_UTF8_STRING)
1838 lispy_type = QUTF8_STRING;
1839 else
1840 lispy_type = QSTRING;
1841 Fput_text_property (make_number (0), make_number (size),
1842 Qforeign_selection, lispy_type, str);
1843 return str;
1845 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1846 a vector of symbols.
1848 else if (type == XA_ATOM)
1850 int i;
1851 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1852 But the callers of these function has made sure the data for
1853 format == 32 is an array of int. Thus, use int instead
1854 of Atom. */
1855 int *idata = (int *) data;
1857 if (size == sizeof (int))
1858 return x_atom_to_symbol (display, (Atom) idata[0]);
1859 else
1861 Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
1862 make_number (0));
1863 for (i = 0; i < size / sizeof (int); i++)
1864 Faset (v, make_number (i),
1865 x_atom_to_symbol (display, (Atom) idata[i]));
1866 return v;
1870 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1871 If the number is 32 bits and won't fit in a Lisp_Int,
1872 convert it to a cons of integers, 16 bits in each half.
1874 else if (format == 32 && size == sizeof (int))
1875 return long_to_cons (((unsigned int *) data) [0]);
1876 else if (format == 16 && size == sizeof (short))
1877 return make_number ((int) (((unsigned short *) data) [0]));
1879 /* Convert any other kind of data to a vector of numbers, represented
1880 as above (as an integer, or a cons of two 16 bit integers.)
1882 else if (format == 16)
1884 int i;
1885 Lisp_Object v;
1886 v = Fmake_vector (make_number (size / 2), make_number (0));
1887 for (i = 0; i < size / 2; i++)
1889 int j = (int) ((unsigned short *) data) [i];
1890 Faset (v, make_number (i), make_number (j));
1892 return v;
1894 else
1896 int i;
1897 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1898 for (i = 0; i < size / 4; i++)
1900 unsigned int j = ((unsigned int *) data) [i];
1901 Faset (v, make_number (i), long_to_cons (j));
1903 return v;
1908 /* Use xfree, not XFree, to free the data obtained with this function. */
1910 static void
1911 lisp_data_to_selection_data (display, obj,
1912 data_ret, type_ret, size_ret,
1913 format_ret, nofree_ret)
1914 Display *display;
1915 Lisp_Object obj;
1916 unsigned char **data_ret;
1917 Atom *type_ret;
1918 unsigned int *size_ret;
1919 int *format_ret;
1920 int *nofree_ret;
1922 Lisp_Object type = Qnil;
1923 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1925 *nofree_ret = 0;
1927 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1929 type = XCAR (obj);
1930 obj = XCDR (obj);
1931 if (CONSP (obj) && NILP (XCDR (obj)))
1932 obj = XCAR (obj);
1935 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1936 { /* This is not the same as declining */
1937 *format_ret = 32;
1938 *size_ret = 0;
1939 *data_ret = 0;
1940 type = QNULL;
1942 else if (STRINGP (obj))
1944 if (SCHARS (obj) < SBYTES (obj))
1945 /* OBJ is a multibyte string containing a non-ASCII char. */
1946 signal_error ("Non-ASCII string must be encoded in advance", obj);
1947 if (NILP (type))
1948 type = QSTRING;
1949 *format_ret = 8;
1950 *size_ret = SBYTES (obj);
1951 *data_ret = SDATA (obj);
1952 *nofree_ret = 1;
1954 else if (SYMBOLP (obj))
1956 *format_ret = 32;
1957 *size_ret = 1;
1958 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1959 (*data_ret) [sizeof (Atom)] = 0;
1960 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1961 if (NILP (type)) type = QATOM;
1963 else if (INTEGERP (obj)
1964 && XINT (obj) < 0xFFFF
1965 && XINT (obj) > -0xFFFF)
1967 *format_ret = 16;
1968 *size_ret = 1;
1969 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1970 (*data_ret) [sizeof (short)] = 0;
1971 (*(short **) data_ret) [0] = (short) XINT (obj);
1972 if (NILP (type)) type = QINTEGER;
1974 else if (INTEGERP (obj)
1975 || (CONSP (obj) && INTEGERP (XCAR (obj))
1976 && (INTEGERP (XCDR (obj))
1977 || (CONSP (XCDR (obj))
1978 && INTEGERP (XCAR (XCDR (obj)))))))
1980 *format_ret = 32;
1981 *size_ret = 1;
1982 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1983 (*data_ret) [sizeof (long)] = 0;
1984 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1985 if (NILP (type)) type = QINTEGER;
1987 else if (VECTORP (obj))
1989 /* Lisp_Vectors may represent a set of ATOMs;
1990 a set of 16 or 32 bit INTEGERs;
1991 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1993 int i;
1995 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1996 /* This vector is an ATOM set */
1998 if (NILP (type)) type = QATOM;
1999 *size_ret = XVECTOR_SIZE (obj);
2000 *format_ret = 32;
2001 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
2002 for (i = 0; i < *size_ret; i++)
2003 if (SYMBOLP (XVECTOR (obj)->contents [i]))
2004 (*(Atom **) data_ret) [i]
2005 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
2006 else
2007 signal_error ("All elements of selection vector must have same type", obj);
2009 #if 0 /* #### MULTIPLE doesn't work yet */
2010 else if (VECTORP (XVECTOR (obj)->contents [0]))
2011 /* This vector is an ATOM_PAIR set */
2013 if (NILP (type)) type = QATOM_PAIR;
2014 *size_ret = XVECTOR_SIZE (obj);
2015 *format_ret = 32;
2016 *data_ret = (unsigned char *)
2017 xmalloc ((*size_ret) * sizeof (Atom) * 2);
2018 for (i = 0; i < *size_ret; i++)
2019 if (VECTORP (XVECTOR (obj)->contents [i]))
2021 Lisp_Object pair = XVECTOR (obj)->contents [i];
2022 if (XVECTOR_SIZE (pair) != 2)
2023 signal_error (
2024 "Elements of the vector must be vectors of exactly two elements",
2025 pair);
2027 (*(Atom **) data_ret) [i * 2]
2028 = symbol_to_x_atom (dpyinfo, display,
2029 XVECTOR (pair)->contents [0]);
2030 (*(Atom **) data_ret) [(i * 2) + 1]
2031 = symbol_to_x_atom (dpyinfo, display,
2032 XVECTOR (pair)->contents [1]);
2034 else
2035 signal_error ("All elements of the vector must be of the same type",
2036 obj);
2039 #endif
2040 else
2041 /* This vector is an INTEGER set, or something like it */
2043 int data_size = 2;
2044 *size_ret = XVECTOR_SIZE (obj);
2045 if (NILP (type)) type = QINTEGER;
2046 *format_ret = 16;
2047 for (i = 0; i < *size_ret; i++)
2048 if (CONSP (XVECTOR (obj)->contents [i]))
2049 *format_ret = 32;
2050 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2051 signal_error (/* Qselection_error */
2052 "Elements of selection vector must be integers or conses of integers",
2053 obj);
2055 /* Use sizeof(long) even if it is more than 32 bits. See comment
2056 in x_get_window_property and x_fill_property_data. */
2058 if (*format_ret == 32) data_size = sizeof(long);
2059 *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
2060 for (i = 0; i < *size_ret; i++)
2061 if (*format_ret == 32)
2062 (*((unsigned long **) data_ret)) [i]
2063 = cons_to_long (XVECTOR (obj)->contents [i]);
2064 else
2065 (*((unsigned short **) data_ret)) [i]
2066 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2069 else
2070 signal_error (/* Qselection_error */ "Unrecognized selection data", obj);
2072 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2075 static Lisp_Object
2076 clean_local_selection_data (obj)
2077 Lisp_Object obj;
2079 if (CONSP (obj)
2080 && INTEGERP (XCAR (obj))
2081 && CONSP (XCDR (obj))
2082 && INTEGERP (XCAR (XCDR (obj)))
2083 && NILP (XCDR (XCDR (obj))))
2084 obj = Fcons (XCAR (obj), XCDR (obj));
2086 if (CONSP (obj)
2087 && INTEGERP (XCAR (obj))
2088 && INTEGERP (XCDR (obj)))
2090 if (XINT (XCAR (obj)) == 0)
2091 return XCDR (obj);
2092 if (XINT (XCAR (obj)) == -1)
2093 return make_number (- XINT (XCDR (obj)));
2095 if (VECTORP (obj))
2097 int i;
2098 int size = XVECTOR_SIZE (obj);
2099 Lisp_Object copy;
2100 if (size == 1)
2101 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2102 copy = Fmake_vector (make_number (size), Qnil);
2103 for (i = 0; i < size; i++)
2104 XVECTOR (copy)->contents [i]
2105 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2106 return copy;
2108 return obj;
2111 /* Called from XTread_socket to handle SelectionNotify events.
2112 If it's the selection we are waiting for, stop waiting
2113 by setting the car of reading_selection_reply to non-nil.
2114 We store t there if the reply is successful, lambda if not. */
2116 void
2117 x_handle_selection_notify (event)
2118 XSelectionEvent *event;
2120 if (event->requestor != reading_selection_window)
2121 return;
2122 if (event->selection != reading_which_selection)
2123 return;
2125 TRACE0 ("Received SelectionNotify");
2126 XSETCAR (reading_selection_reply,
2127 (event->property != 0 ? Qt : Qlambda));
2131 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2132 Sx_own_selection_internal, 2, 2, 0,
2133 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2134 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2135 \(Those are literal upper-case symbol names, since that's what X expects.)
2136 VALUE is typically a string, or a cons of two markers, but may be
2137 anything that the functions on `selection-converter-alist' know about. */)
2138 (selection_name, selection_value)
2139 Lisp_Object selection_name, selection_value;
2141 check_x ();
2142 CHECK_SYMBOL (selection_name);
2143 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
2144 x_own_selection (selection_name, selection_value);
2145 return selection_value;
2149 /* Request the selection value from the owner. If we are the owner,
2150 simply return our selection value. If we are not the owner, this
2151 will block until all of the data has arrived. */
2153 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2154 Sx_get_selection_internal, 2, 3, 0,
2155 doc: /* Return text selected from some X window.
2156 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2157 \(Those are literal upper-case symbol names, since that's what X expects.)
2158 TYPE is the type of data desired, typically `STRING'.
2159 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2160 selections. If omitted, defaults to the time for the last event. */)
2161 (selection_symbol, target_type, time_stamp)
2162 Lisp_Object selection_symbol, target_type, time_stamp;
2164 Lisp_Object val = Qnil;
2165 struct gcpro gcpro1, gcpro2;
2166 GCPRO2 (target_type, val); /* we store newly consed data into these */
2167 check_x ();
2168 CHECK_SYMBOL (selection_symbol);
2170 #if 0 /* #### MULTIPLE doesn't work yet */
2171 if (CONSP (target_type)
2172 && XCAR (target_type) == QMULTIPLE)
2174 CHECK_VECTOR (XCDR (target_type));
2175 /* So we don't destructively modify this... */
2176 target_type = copy_multiple_data (target_type);
2178 else
2179 #endif
2180 CHECK_SYMBOL (target_type);
2182 val = x_get_local_selection (selection_symbol, target_type, 1);
2184 if (NILP (val))
2186 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2187 goto DONE;
2190 if (CONSP (val)
2191 && SYMBOLP (XCAR (val)))
2193 val = XCDR (val);
2194 if (CONSP (val) && NILP (XCDR (val)))
2195 val = XCAR (val);
2197 val = clean_local_selection_data (val);
2198 DONE:
2199 UNGCPRO;
2200 return val;
2203 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2204 Sx_disown_selection_internal, 1, 2, 0,
2205 doc: /* If we own the selection SELECTION, disown it.
2206 Disowning it means there is no such selection. */)
2207 (selection, time)
2208 Lisp_Object selection;
2209 Lisp_Object time;
2211 Time timestamp;
2212 Atom selection_atom;
2213 union {
2214 struct selection_input_event sie;
2215 struct input_event ie;
2216 } event;
2217 Display *display;
2218 struct x_display_info *dpyinfo;
2219 struct frame *sf = SELECTED_FRAME ();
2221 check_x ();
2222 if (! FRAME_X_P (sf))
2223 return Qnil;
2225 display = FRAME_X_DISPLAY (sf);
2226 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2227 CHECK_SYMBOL (selection);
2228 if (NILP (time))
2229 timestamp = last_event_timestamp;
2230 else
2231 timestamp = cons_to_long (time);
2233 if (NILP (assq_no_quit (selection, Vselection_alist)))
2234 return Qnil; /* Don't disown the selection when we're not the owner. */
2236 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2238 BLOCK_INPUT;
2239 XSetSelectionOwner (display, selection_atom, None, timestamp);
2240 UNBLOCK_INPUT;
2242 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2243 generated for a window which owns the selection when that window sets
2244 the selection owner to None. The NCD server does, the MIT Sun4 server
2245 doesn't. So we synthesize one; this means we might get two, but
2246 that's ok, because the second one won't have any effect. */
2247 SELECTION_EVENT_DISPLAY (&event.sie) = display;
2248 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2249 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2250 x_handle_selection_clear (&event.ie);
2252 return Qt;
2255 /* Get rid of all the selections in buffer BUFFER.
2256 This is used when we kill a buffer. */
2258 void
2259 x_disown_buffer_selections (buffer)
2260 Lisp_Object buffer;
2262 Lisp_Object tail;
2263 struct buffer *buf = XBUFFER (buffer);
2265 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2267 Lisp_Object elt, value;
2268 elt = XCAR (tail);
2269 value = XCDR (elt);
2270 if (CONSP (value) && MARKERP (XCAR (value))
2271 && XMARKER (XCAR (value))->buffer == buf)
2272 Fx_disown_selection_internal (XCAR (elt), Qnil);
2276 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2277 0, 1, 0,
2278 doc: /* Whether the current Emacs process owns the given X Selection.
2279 The arg should be the name of the selection in question, typically one of
2280 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2281 \(Those are literal upper-case symbol names, since that's what X expects.)
2282 For convenience, the symbol nil is the same as `PRIMARY',
2283 and t is the same as `SECONDARY'. */)
2284 (selection)
2285 Lisp_Object selection;
2287 check_x ();
2288 CHECK_SYMBOL (selection);
2289 if (EQ (selection, Qnil)) selection = QPRIMARY;
2290 if (EQ (selection, Qt)) selection = QSECONDARY;
2292 if (NILP (Fassq (selection, Vselection_alist)))
2293 return Qnil;
2294 return Qt;
2297 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2298 0, 1, 0,
2299 doc: /* Whether there is an owner for the given X Selection.
2300 The arg should be the name of the selection in question, typically one of
2301 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2302 \(Those are literal upper-case symbol names, since that's what X expects.)
2303 For convenience, the symbol nil is the same as `PRIMARY',
2304 and t is the same as `SECONDARY'. */)
2305 (selection)
2306 Lisp_Object selection;
2308 Window owner;
2309 Atom atom;
2310 Display *dpy;
2311 struct frame *sf = SELECTED_FRAME ();
2313 /* It should be safe to call this before we have an X frame. */
2314 if (! FRAME_X_P (sf))
2315 return Qnil;
2317 dpy = FRAME_X_DISPLAY (sf);
2318 CHECK_SYMBOL (selection);
2319 if (!NILP (Fx_selection_owner_p (selection)))
2320 return Qt;
2321 if (EQ (selection, Qnil)) selection = QPRIMARY;
2322 if (EQ (selection, Qt)) selection = QSECONDARY;
2323 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2324 if (atom == 0)
2325 return Qnil;
2326 BLOCK_INPUT;
2327 owner = XGetSelectionOwner (dpy, atom);
2328 UNBLOCK_INPUT;
2329 return (owner ? Qt : Qnil);
2333 #ifdef CUT_BUFFER_SUPPORT
2335 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2336 static void
2337 initialize_cut_buffers (display, window)
2338 Display *display;
2339 Window window;
2341 unsigned char *data = (unsigned char *) "";
2342 BLOCK_INPUT;
2343 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2344 PropModeAppend, data, 0)
2345 FROB (XA_CUT_BUFFER0);
2346 FROB (XA_CUT_BUFFER1);
2347 FROB (XA_CUT_BUFFER2);
2348 FROB (XA_CUT_BUFFER3);
2349 FROB (XA_CUT_BUFFER4);
2350 FROB (XA_CUT_BUFFER5);
2351 FROB (XA_CUT_BUFFER6);
2352 FROB (XA_CUT_BUFFER7);
2353 #undef FROB
2354 UNBLOCK_INPUT;
2358 #define CHECK_CUT_BUFFER(symbol) \
2359 do { CHECK_SYMBOL ((symbol)); \
2360 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2361 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2362 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2363 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2364 signal_error ("Doesn't name a cut buffer", (symbol)); \
2365 } while (0)
2367 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2368 Sx_get_cut_buffer_internal, 1, 1, 0,
2369 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2370 (buffer)
2371 Lisp_Object buffer;
2373 Window window;
2374 Atom buffer_atom;
2375 unsigned char *data = NULL;
2376 int bytes;
2377 Atom type;
2378 int format;
2379 unsigned long size;
2380 Lisp_Object ret;
2381 Display *display;
2382 struct x_display_info *dpyinfo;
2383 struct frame *sf = SELECTED_FRAME ();
2385 check_x ();
2387 if (! FRAME_X_P (sf))
2388 return Qnil;
2390 display = FRAME_X_DISPLAY (sf);
2391 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2392 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2393 CHECK_CUT_BUFFER (buffer);
2394 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2396 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2397 &type, &format, &size, 0);
2399 if (!data || !format)
2401 xfree (data);
2402 return Qnil;
2405 if (format != 8 || type != XA_STRING)
2406 signal_error ("Cut buffer doesn't contain 8-bit data",
2407 list2 (x_atom_to_symbol (display, type),
2408 make_number (format)));
2410 ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
2411 /* Use xfree, not XFree, because x_get_window_property
2412 calls xmalloc itself. */
2413 xfree (data);
2414 return ret;
2418 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2419 Sx_store_cut_buffer_internal, 2, 2, 0,
2420 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2421 (buffer, string)
2422 Lisp_Object buffer, string;
2424 Window window;
2425 Atom buffer_atom;
2426 unsigned char *data;
2427 int bytes;
2428 int bytes_remaining;
2429 int max_bytes;
2430 Display *display;
2431 struct frame *sf = SELECTED_FRAME ();
2433 check_x ();
2435 if (! FRAME_X_P (sf))
2436 return Qnil;
2438 display = FRAME_X_DISPLAY (sf);
2439 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2441 max_bytes = SELECTION_QUANTUM (display);
2442 if (max_bytes > MAX_SELECTION_QUANTUM)
2443 max_bytes = MAX_SELECTION_QUANTUM;
2445 CHECK_CUT_BUFFER (buffer);
2446 CHECK_STRING (string);
2447 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2448 display, buffer);
2449 data = (unsigned char *) SDATA (string);
2450 bytes = SBYTES (string);
2451 bytes_remaining = bytes;
2453 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2455 initialize_cut_buffers (display, window);
2456 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2459 BLOCK_INPUT;
2461 /* Don't mess up with an empty value. */
2462 if (!bytes_remaining)
2463 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2464 PropModeReplace, data, 0);
2466 while (bytes_remaining)
2468 int chunk = (bytes_remaining < max_bytes
2469 ? bytes_remaining : max_bytes);
2470 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2471 (bytes_remaining == bytes
2472 ? PropModeReplace
2473 : PropModeAppend),
2474 data, chunk);
2475 data += chunk;
2476 bytes_remaining -= chunk;
2478 UNBLOCK_INPUT;
2479 return string;
2483 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2484 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2485 doc: /* Rotate the values of the cut buffers by N steps.
2486 Positive N means shift the values forward, negative means backward. */)
2488 Lisp_Object n;
2490 Window window;
2491 Atom props[8];
2492 Display *display;
2493 struct frame *sf = SELECTED_FRAME ();
2495 check_x ();
2497 if (! FRAME_X_P (sf))
2498 return Qnil;
2500 display = FRAME_X_DISPLAY (sf);
2501 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2502 CHECK_NUMBER (n);
2503 if (XINT (n) == 0)
2504 return n;
2505 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2507 initialize_cut_buffers (display, window);
2508 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2511 props[0] = XA_CUT_BUFFER0;
2512 props[1] = XA_CUT_BUFFER1;
2513 props[2] = XA_CUT_BUFFER2;
2514 props[3] = XA_CUT_BUFFER3;
2515 props[4] = XA_CUT_BUFFER4;
2516 props[5] = XA_CUT_BUFFER5;
2517 props[6] = XA_CUT_BUFFER6;
2518 props[7] = XA_CUT_BUFFER7;
2519 BLOCK_INPUT;
2520 XRotateWindowProperties (display, window, props, 8, XINT (n));
2521 UNBLOCK_INPUT;
2522 return n;
2525 #endif
2527 /***********************************************************************
2528 Drag and drop support
2529 ***********************************************************************/
2530 /* Check that lisp values are of correct type for x_fill_property_data.
2531 That is, number, string or a cons with two numbers (low and high 16
2532 bit parts of a 32 bit number). */
2535 x_check_property_data (data)
2536 Lisp_Object data;
2538 Lisp_Object iter;
2539 int size = 0;
2541 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2543 Lisp_Object o = XCAR (iter);
2545 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2546 size = -1;
2547 else if (CONSP (o) &&
2548 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2549 size = -1;
2552 return size;
2555 /* Convert lisp values to a C array. Values may be a number, a string
2556 which is taken as an X atom name and converted to the atom value, or
2557 a cons containing the two 16 bit parts of a 32 bit number.
2559 DPY is the display use to look up X atoms.
2560 DATA is a Lisp list of values to be converted.
2561 RET is the C array that contains the converted values. It is assumed
2562 it is big enough to hold all values.
2563 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2564 be stored in RET. Note that long is used for 32 even if long is more
2565 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2566 XClientMessageEvent). */
2568 void
2569 x_fill_property_data (dpy, data, ret, format)
2570 Display *dpy;
2571 Lisp_Object data;
2572 void *ret;
2573 int format;
2575 long val;
2576 long *d32 = (long *) ret;
2577 short *d16 = (short *) ret;
2578 char *d08 = (char *) ret;
2579 Lisp_Object iter;
2581 for (iter = data; CONSP (iter); iter = XCDR (iter))
2583 Lisp_Object o = XCAR (iter);
2585 if (INTEGERP (o))
2586 val = (long) XFASTINT (o);
2587 else if (FLOATP (o))
2588 val = (long) XFLOAT_DATA (o);
2589 else if (CONSP (o))
2590 val = (long) cons_to_long (o);
2591 else if (STRINGP (o))
2593 BLOCK_INPUT;
2594 val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
2595 UNBLOCK_INPUT;
2597 else
2598 error ("Wrong type, must be string, number or cons");
2600 if (format == 8)
2601 *d08++ = (char) val;
2602 else if (format == 16)
2603 *d16++ = (short) val;
2604 else
2605 *d32++ = val;
2609 /* Convert an array of C values to a Lisp list.
2610 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2611 DATA is a C array of values to be converted.
2612 TYPE is the type of the data. Only XA_ATOM is special, it converts
2613 each number in DATA to its corresponfing X atom as a symbol.
2614 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2615 be stored in RET.
2616 SIZE is the number of elements in DATA.
2618 Important: When format is 32, data should contain an array of int,
2619 not an array of long as the X library returns. This makes a difference
2620 when sizeof(long) != sizeof(int).
2622 Also see comment for selection_data_to_lisp_data above. */
2624 Lisp_Object
2625 x_property_data_to_lisp (f, data, type, format, size)
2626 struct frame *f;
2627 unsigned char *data;
2628 Atom type;
2629 int format;
2630 unsigned long size;
2632 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2633 data, size*format/8, type, format);
2636 /* Get the mouse position in frame relative coordinates. */
2638 static void
2639 mouse_position_for_drop (f, x, y)
2640 FRAME_PTR f;
2641 int *x;
2642 int *y;
2644 Window root, dummy_window;
2645 int dummy;
2647 BLOCK_INPUT;
2649 XQueryPointer (FRAME_X_DISPLAY (f),
2650 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2652 /* The root window which contains the pointer. */
2653 &root,
2655 /* Window pointer is on, not used */
2656 &dummy_window,
2658 /* The position on that root window. */
2659 x, y,
2661 /* x/y in dummy_window coordinates, not used. */
2662 &dummy, &dummy,
2664 /* Modifier keys and pointer buttons, about which
2665 we don't care. */
2666 (unsigned int *) &dummy);
2669 /* Absolute to relative. */
2670 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2671 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2673 UNBLOCK_INPUT;
2676 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2677 Sx_get_atom_name, 1, 2, 0,
2678 doc: /* Return the X atom name for VALUE as a string.
2679 VALUE may be a number or a cons where the car is the upper 16 bits and
2680 the cdr is the lower 16 bits of a 32 bit value.
2681 Use the display for FRAME or the current frame if FRAME is not given or nil.
2683 If the value is 0 or the atom is not known, return the empty string. */)
2684 (value, frame)
2685 Lisp_Object value, frame;
2687 struct frame *f = check_x_frame (frame);
2688 char *name = 0;
2689 Lisp_Object ret = Qnil;
2690 Display *dpy = FRAME_X_DISPLAY (f);
2691 Atom atom;
2692 int had_errors;
2694 if (INTEGERP (value))
2695 atom = (Atom) XUINT (value);
2696 else if (FLOATP (value))
2697 atom = (Atom) XFLOAT_DATA (value);
2698 else if (CONSP (value))
2699 atom = (Atom) cons_to_long (value);
2700 else
2701 error ("Wrong type, value must be number or cons");
2703 BLOCK_INPUT;
2704 x_catch_errors (dpy);
2705 name = atom ? XGetAtomName (dpy, atom) : "";
2706 had_errors = x_had_errors_p (dpy);
2707 x_uncatch_errors ();
2709 if (!had_errors)
2710 ret = make_string (name, strlen (name));
2712 if (atom && name) XFree (name);
2713 if (NILP (ret)) ret = empty_unibyte_string;
2715 UNBLOCK_INPUT;
2717 return ret;
2720 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom,
2721 Sx_register_dnd_atom, 1, 2, 0,
2722 doc: /* Request that dnd events are made for ClientMessages with ATOM.
2723 ATOM can be a symbol or a string. The ATOM is interned on the display that
2724 FRAME is on. If FRAME is nil, the selected frame is used. */)
2725 (atom, frame)
2726 Lisp_Object atom, frame;
2728 Atom x_atom;
2729 struct frame *f = check_x_frame (frame);
2730 size_t i;
2731 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f);
2734 if (SYMBOLP (atom))
2735 x_atom = symbol_to_x_atom (dpyinfo, FRAME_X_DISPLAY (f), atom);
2736 else if (STRINGP (atom))
2738 BLOCK_INPUT;
2739 x_atom = XInternAtom (FRAME_X_DISPLAY (f), (char *) SDATA (atom), False);
2740 UNBLOCK_INPUT;
2742 else
2743 error ("ATOM must be a symbol or a string");
2745 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2746 if (dpyinfo->x_dnd_atoms[i] == x_atom)
2747 return Qnil;
2749 if (dpyinfo->x_dnd_atoms_length == dpyinfo->x_dnd_atoms_size)
2751 dpyinfo->x_dnd_atoms_size *= 2;
2752 dpyinfo->x_dnd_atoms = xrealloc (dpyinfo->x_dnd_atoms,
2753 sizeof (*dpyinfo->x_dnd_atoms)
2754 * dpyinfo->x_dnd_atoms_size);
2757 dpyinfo->x_dnd_atoms[dpyinfo->x_dnd_atoms_length++] = x_atom;
2758 return Qnil;
2761 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2764 x_handle_dnd_message (f, event, dpyinfo, bufp)
2765 struct frame *f;
2766 XClientMessageEvent *event;
2767 struct x_display_info *dpyinfo;
2768 struct input_event *bufp;
2770 Lisp_Object vec;
2771 Lisp_Object frame;
2772 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2773 unsigned long size = 160/event->format;
2774 int x, y;
2775 unsigned char *data = (unsigned char *) event->data.b;
2776 int idata[5];
2777 size_t i;
2779 for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
2780 if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
2782 if (i == dpyinfo->x_dnd_atoms_length) return 0;
2784 XSETFRAME (frame, f);
2786 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2787 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2788 function expects them to be of size int (i.e. 32). So to be able to
2789 use that function, put the data in the form it expects if format is 32. */
2791 if (event->format == 32 && event->format < BITS_PER_LONG)
2793 int i;
2794 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2795 idata[i] = (int) event->data.l[i];
2796 data = (unsigned char *) idata;
2799 vec = Fmake_vector (make_number (4), Qnil);
2800 ASET (vec, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2801 event->message_type)));
2802 ASET (vec, 1, frame);
2803 ASET (vec, 2, make_number (event->format));
2804 ASET (vec, 3, x_property_data_to_lisp (f,
2805 data,
2806 event->message_type,
2807 event->format,
2808 size));
2810 mouse_position_for_drop (f, &x, &y);
2811 bufp->kind = DRAG_N_DROP_EVENT;
2812 bufp->frame_or_window = frame;
2813 bufp->timestamp = CurrentTime;
2814 bufp->x = make_number (x);
2815 bufp->y = make_number (y);
2816 bufp->arg = vec;
2817 bufp->modifiers = 0;
2819 return 1;
2822 DEFUN ("x-send-client-message", Fx_send_client_event,
2823 Sx_send_client_message, 6, 6, 0,
2824 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2826 For DISPLAY, specify either a frame or a display name (a string).
2827 If DISPLAY is nil, that stands for the selected frame's display.
2828 DEST may be a number, in which case it is a Window id. The value 0 may
2829 be used to send to the root window of the DISPLAY.
2830 If DEST is a cons, it is converted to a 32 bit number
2831 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2832 number is then used as a window id.
2833 If DEST is a frame the event is sent to the outer window of that frame.
2834 A value of nil means the currently selected frame.
2835 If DEST is the string "PointerWindow" the event is sent to the window that
2836 contains the pointer. If DEST is the string "InputFocus" the event is
2837 sent to the window that has the input focus.
2838 FROM is the frame sending the event. Use nil for currently selected frame.
2839 MESSAGE-TYPE is the name of an Atom as a string.
2840 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2841 bits. VALUES is a list of numbers, cons and/or strings containing the values
2842 to send. If a value is a string, it is converted to an Atom and the value of
2843 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2844 with the high 16 bits from the car and the lower 16 bit from the cdr.
2845 If more values than fits into the event is given, the excessive values
2846 are ignored. */)
2847 (display, dest, from, message_type, format, values)
2848 Lisp_Object display, dest, from, message_type, format, values;
2850 struct x_display_info *dpyinfo = check_x_display_info (display);
2851 Window wdest;
2852 XEvent event;
2853 Lisp_Object cons;
2854 int size;
2855 struct frame *f = check_x_frame (from);
2856 int to_root;
2858 CHECK_STRING (message_type);
2859 CHECK_NUMBER (format);
2860 CHECK_CONS (values);
2862 if (x_check_property_data (values) == -1)
2863 error ("Bad data in VALUES, must be number, cons or string");
2865 event.xclient.type = ClientMessage;
2866 event.xclient.format = XFASTINT (format);
2868 if (event.xclient.format != 8 && event.xclient.format != 16
2869 && event.xclient.format != 32)
2870 error ("FORMAT must be one of 8, 16 or 32");
2872 if (FRAMEP (dest) || NILP (dest))
2874 struct frame *fdest = check_x_frame (dest);
2875 wdest = FRAME_OUTER_WINDOW (fdest);
2877 else if (STRINGP (dest))
2879 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2880 wdest = PointerWindow;
2881 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2882 wdest = InputFocus;
2883 else
2884 error ("DEST as a string must be one of PointerWindow or InputFocus");
2886 else if (INTEGERP (dest))
2887 wdest = (Window) XFASTINT (dest);
2888 else if (FLOATP (dest))
2889 wdest = (Window) XFLOAT_DATA (dest);
2890 else if (CONSP (dest))
2892 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2893 error ("Both car and cdr for DEST must be numbers");
2894 else
2895 wdest = (Window) cons_to_long (dest);
2897 else
2898 error ("DEST must be a frame, nil, string, number or cons");
2900 if (wdest == 0) wdest = dpyinfo->root_window;
2901 to_root = wdest == dpyinfo->root_window;
2903 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2906 BLOCK_INPUT;
2908 event.xclient.message_type
2909 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2910 event.xclient.display = dpyinfo->display;
2912 /* Some clients (metacity for example) expects sending window to be here
2913 when sending to the root window. */
2914 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2917 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2918 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2919 event.xclient.format);
2921 /* If event mask is 0 the event is sent to the client that created
2922 the destination window. But if we are sending to the root window,
2923 there is no such client. Then we set the event mask to 0xffff. The
2924 event then goes to clients selecting for events on the root window. */
2925 x_catch_errors (dpyinfo->display);
2927 int propagate = to_root ? False : True;
2928 unsigned mask = to_root ? 0xffff : 0;
2929 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2930 XFlush (dpyinfo->display);
2932 x_uncatch_errors ();
2933 UNBLOCK_INPUT;
2935 return Qnil;
2939 void
2940 syms_of_xselect ()
2942 defsubr (&Sx_get_selection_internal);
2943 defsubr (&Sx_own_selection_internal);
2944 defsubr (&Sx_disown_selection_internal);
2945 defsubr (&Sx_selection_owner_p);
2946 defsubr (&Sx_selection_exists_p);
2948 #ifdef CUT_BUFFER_SUPPORT
2949 defsubr (&Sx_get_cut_buffer_internal);
2950 defsubr (&Sx_store_cut_buffer_internal);
2951 defsubr (&Sx_rotate_cut_buffers_internal);
2952 #endif
2954 defsubr (&Sx_get_atom_name);
2955 defsubr (&Sx_send_client_message);
2956 defsubr (&Sx_register_dnd_atom);
2958 reading_selection_reply = Fcons (Qnil, Qnil);
2959 staticpro (&reading_selection_reply);
2960 reading_selection_window = 0;
2961 reading_which_selection = 0;
2963 property_change_wait_list = 0;
2964 prop_location_identifier = 0;
2965 property_change_reply = Fcons (Qnil, Qnil);
2966 staticpro (&property_change_reply);
2968 Vselection_alist = Qnil;
2969 staticpro (&Vselection_alist);
2971 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2972 doc: /* An alist associating X Windows selection-types with functions.
2973 These functions are called to convert the selection, with three args:
2974 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2975 a desired type to which the selection should be converted;
2976 and the local selection value (whatever was given to `x-own-selection').
2978 The function should return the value to send to the X server
2979 \(typically a string). A return value of nil
2980 means that the conversion could not be done.
2981 A return value which is the symbol `NULL'
2982 means that a side-effect was executed,
2983 and there is no meaningful selection value. */);
2984 Vselection_converter_alist = Qnil;
2986 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2987 doc: /* A list of functions to be called when Emacs loses an X selection.
2988 \(This happens when some other X client makes its own selection
2989 or when a Lisp program explicitly clears the selection.)
2990 The functions are called with one argument, the selection type
2991 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2992 Vx_lost_selection_functions = Qnil;
2994 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2995 doc: /* A list of functions to be called when Emacs answers a selection request.
2996 The functions are called with four arguments:
2997 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2998 - the selection-type which Emacs was asked to convert the
2999 selection into before sending (for example, `STRING' or `LENGTH');
3000 - a flag indicating success or failure for responding to the request.
3001 We might have failed (and declined the request) for any number of reasons,
3002 including being asked for a selection that we no longer own, or being asked
3003 to convert into a type that we don't know about or that is inappropriate.
3004 This hook doesn't let you change the behavior of Emacs's selection replies,
3005 it merely informs you that they have happened. */);
3006 Vx_sent_selection_functions = Qnil;
3008 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
3009 doc: /* Number of milliseconds to wait for a selection reply.
3010 If the selection owner doesn't reply in this time, we give up.
3011 A value of 0 means wait as long as necessary. This is initialized from the
3012 \"*selectionTimeout\" resource. */);
3013 x_selection_timeout = 0;
3015 QPRIMARY = intern_c_string ("PRIMARY"); staticpro (&QPRIMARY);
3016 QSECONDARY = intern_c_string ("SECONDARY"); staticpro (&QSECONDARY);
3017 QSTRING = intern_c_string ("STRING"); staticpro (&QSTRING);
3018 QINTEGER = intern_c_string ("INTEGER"); staticpro (&QINTEGER);
3019 QCLIPBOARD = intern_c_string ("CLIPBOARD"); staticpro (&QCLIPBOARD);
3020 QTIMESTAMP = intern_c_string ("TIMESTAMP"); staticpro (&QTIMESTAMP);
3021 QTEXT = intern_c_string ("TEXT"); staticpro (&QTEXT);
3022 QCOMPOUND_TEXT = intern_c_string ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
3023 QUTF8_STRING = intern_c_string ("UTF8_STRING"); staticpro (&QUTF8_STRING);
3024 QDELETE = intern_c_string ("DELETE"); staticpro (&QDELETE);
3025 QMULTIPLE = intern_c_string ("MULTIPLE"); staticpro (&QMULTIPLE);
3026 QINCR = intern_c_string ("INCR"); staticpro (&QINCR);
3027 QEMACS_TMP = intern_c_string ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
3028 QTARGETS = intern_c_string ("TARGETS"); staticpro (&QTARGETS);
3029 QATOM = intern_c_string ("ATOM"); staticpro (&QATOM);
3030 QATOM_PAIR = intern_c_string ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
3031 QNULL = intern_c_string ("NULL"); staticpro (&QNULL);
3032 Qcompound_text_with_extensions = intern_c_string ("compound-text-with-extensions");
3033 staticpro (&Qcompound_text_with_extensions);
3035 #ifdef CUT_BUFFER_SUPPORT
3036 QCUT_BUFFER0 = intern_c_string ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
3037 QCUT_BUFFER1 = intern_c_string ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
3038 QCUT_BUFFER2 = intern_c_string ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
3039 QCUT_BUFFER3 = intern_c_string ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
3040 QCUT_BUFFER4 = intern_c_string ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
3041 QCUT_BUFFER5 = intern_c_string ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
3042 QCUT_BUFFER6 = intern_c_string ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
3043 QCUT_BUFFER7 = intern_c_string ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
3044 #endif
3046 Qforeign_selection = intern_c_string ("foreign-selection");
3047 staticpro (&Qforeign_selection);
3050 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
3051 (do not change this comment) */