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