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