* xterm.h, xterm.c (x_uncatch_errors): Delete unneccessary
[bpt/emacs.git] / src / xselect.c
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
3 2004, 2005, 2006 Free Software Foundation, Inc.
4
5 This file is part of GNU Emacs.
6
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 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., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, 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
406 CHECK_SYMBOL (selection_name);
407 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
408
409 BLOCK_INPUT;
410 x_catch_errors (display);
411 XSetSelectionOwner (display, selection_atom, selecting_window, time);
412 x_check_errors (display, "Can't set selection: %s");
413 x_uncatch_errors ();
414 UNBLOCK_INPUT;
415
416 /* Now update the local cache */
417 {
418 Lisp_Object selection_time;
419 Lisp_Object selection_data;
420 Lisp_Object prev_value;
421
422 selection_time = long_to_cons ((unsigned long) time);
423 selection_data = Fcons (selection_name,
424 Fcons (selection_value,
425 Fcons (selection_time,
426 Fcons (selected_frame, Qnil))));
427 prev_value = assq_no_quit (selection_name, Vselection_alist);
428
429 Vselection_alist = Fcons (selection_data, Vselection_alist);
430
431 /* If we already owned the selection, remove the old selection data.
432 Perhaps we should destructively modify it instead.
433 Don't use Fdelq as that may QUIT. */
434 if (!NILP (prev_value))
435 {
436 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
437 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
438 if (EQ (prev_value, Fcar (XCDR (rest))))
439 {
440 XSETCDR (rest, Fcdr (XCDR (rest)));
441 break;
442 }
443 }
444 }
445 }
446 \f
447 /* Given a selection-name and desired type, look up our local copy of
448 the selection value and convert it to the type.
449 The value is nil or a string.
450 This function is used both for remote requests (LOCAL_REQUEST is zero)
451 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
452
453 This calls random Lisp code, and may signal or gc. */
454
455 static Lisp_Object
456 x_get_local_selection (selection_symbol, target_type, local_request)
457 Lisp_Object selection_symbol, target_type;
458 int local_request;
459 {
460 Lisp_Object local_value;
461 Lisp_Object handler_fn, value, type, check;
462 int count;
463
464 local_value = assq_no_quit (selection_symbol, Vselection_alist);
465
466 if (NILP (local_value)) return Qnil;
467
468 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
469 if (EQ (target_type, QTIMESTAMP))
470 {
471 handler_fn = Qnil;
472 value = XCAR (XCDR (XCDR (local_value)));
473 }
474 #if 0
475 else if (EQ (target_type, QDELETE))
476 {
477 handler_fn = Qnil;
478 Fx_disown_selection_internal
479 (selection_symbol,
480 XCAR (XCDR (XCDR (local_value))));
481 value = QNULL;
482 }
483 #endif
484
485 #if 0 /* #### MULTIPLE doesn't work yet */
486 else if (CONSP (target_type)
487 && XCAR (target_type) == QMULTIPLE)
488 {
489 Lisp_Object pairs;
490 int size;
491 int i;
492 pairs = XCDR (target_type);
493 size = XVECTOR (pairs)->size;
494 /* If the target is MULTIPLE, then target_type looks like
495 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
496 We modify the second element of each pair in the vector and
497 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
498 */
499 for (i = 0; i < size; i++)
500 {
501 Lisp_Object pair;
502 pair = XVECTOR (pairs)->contents [i];
503 XVECTOR (pair)->contents [1]
504 = x_get_local_selection (XVECTOR (pair)->contents [0],
505 XVECTOR (pair)->contents [1],
506 local_request);
507 }
508 return pairs;
509 }
510 #endif
511 else
512 {
513 /* Don't allow a quit within the converter.
514 When the user types C-g, he would be surprised
515 if by luck it came during a converter. */
516 count = SPECPDL_INDEX ();
517 specbind (Qinhibit_quit, Qt);
518
519 CHECK_SYMBOL (target_type);
520 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
521 /* gcpro is not needed here since nothing but HANDLER_FN
522 is live, and that ought to be a symbol. */
523
524 if (!NILP (handler_fn))
525 value = call3 (handler_fn,
526 selection_symbol, (local_request ? Qnil : target_type),
527 XCAR (XCDR (local_value)));
528 else
529 value = Qnil;
530 unbind_to (count, Qnil);
531 }
532
533 /* Make sure this value is of a type that we could transmit
534 to another X client. */
535
536 check = value;
537 if (CONSP (value)
538 && SYMBOLP (XCAR (value)))
539 type = XCAR (value),
540 check = XCDR (value);
541
542 if (STRINGP (check)
543 || VECTORP (check)
544 || SYMBOLP (check)
545 || INTEGERP (check)
546 || NILP (value))
547 return value;
548 /* Check for a value that cons_to_long could handle. */
549 else if (CONSP (check)
550 && INTEGERP (XCAR (check))
551 && (INTEGERP (XCDR (check))
552 ||
553 (CONSP (XCDR (check))
554 && INTEGERP (XCAR (XCDR (check)))
555 && NILP (XCDR (XCDR (check))))))
556 return value;
557 else
558 return
559 Fsignal (Qerror,
560 Fcons (build_string ("invalid data returned by selection-conversion function"),
561 Fcons (handler_fn, Fcons (value, Qnil))));
562 }
563 \f
564 /* Subroutines of x_reply_selection_request. */
565
566 /* Send a SelectionNotify event to the requestor with property=None,
567 meaning we were unable to do what they wanted. */
568
569 static void
570 x_decline_selection_request (event)
571 struct input_event *event;
572 {
573 XSelectionEvent reply;
574
575 reply.type = SelectionNotify;
576 reply.display = SELECTION_EVENT_DISPLAY (event);
577 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
578 reply.selection = SELECTION_EVENT_SELECTION (event);
579 reply.time = SELECTION_EVENT_TIME (event);
580 reply.target = SELECTION_EVENT_TARGET (event);
581 reply.property = None;
582
583 /* The reason for the error may be that the receiver has
584 died in the meantime. Handle that case. */
585 BLOCK_INPUT;
586 x_catch_errors (reply.display);
587 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
588 XFlush (reply.display);
589 x_uncatch_errors ();
590 UNBLOCK_INPUT;
591 }
592
593 /* This is the selection request currently being processed.
594 It is set to zero when the request is fully processed. */
595 static struct input_event *x_selection_current_request;
596
597 /* Display info in x_selection_request. */
598
599 static struct x_display_info *selection_request_dpyinfo;
600
601 /* Used as an unwind-protect clause so that, if a selection-converter signals
602 an error, we tell the requester that we were unable to do what they wanted
603 before we throw to top-level or go into the debugger or whatever. */
604
605 static Lisp_Object
606 x_selection_request_lisp_error (ignore)
607 Lisp_Object ignore;
608 {
609 if (x_selection_current_request != 0
610 && selection_request_dpyinfo->display)
611 x_decline_selection_request (x_selection_current_request);
612 return Qnil;
613 }
614 \f
615
616 /* This stuff is so that INCR selections are reentrant (that is, so we can
617 be servicing multiple INCR selection requests simultaneously.) I haven't
618 actually tested that yet. */
619
620 /* Keep a list of the property changes that are awaited. */
621
622 struct prop_location
623 {
624 int identifier;
625 Display *display;
626 Window window;
627 Atom property;
628 int desired_state;
629 int arrived;
630 struct prop_location *next;
631 };
632
633 static struct prop_location *expect_property_change ();
634 static void wait_for_property_change ();
635 static void unexpect_property_change ();
636 static int waiting_for_other_props_on_window ();
637
638 static int prop_location_identifier;
639
640 static Lisp_Object property_change_reply;
641
642 static struct prop_location *property_change_reply_object;
643
644 static struct prop_location *property_change_wait_list;
645
646 static Lisp_Object
647 queue_selection_requests_unwind (tem)
648 Lisp_Object tem;
649 {
650 x_stop_queuing_selection_requests ();
651 return Qnil;
652 }
653
654 /* Return some frame whose display info is DPYINFO.
655 Return nil if there is none. */
656
657 static Lisp_Object
658 some_frame_on_display (dpyinfo)
659 struct x_display_info *dpyinfo;
660 {
661 Lisp_Object list, frame;
662
663 FOR_EACH_FRAME (list, frame)
664 {
665 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
666 return frame;
667 }
668
669 return Qnil;
670 }
671 \f
672 /* Send the reply to a selection request event EVENT.
673 TYPE is the type of selection data requested.
674 DATA and SIZE describe the data to send, already converted.
675 FORMAT is the unit-size (in bits) of the data to be transmitted. */
676
677 static void
678 x_reply_selection_request (event, format, data, size, type)
679 struct input_event *event;
680 int format, size;
681 unsigned char *data;
682 Atom type;
683 {
684 XSelectionEvent reply;
685 Display *display = SELECTION_EVENT_DISPLAY (event);
686 Window window = SELECTION_EVENT_REQUESTOR (event);
687 int bytes_remaining;
688 int format_bytes = format/8;
689 int max_bytes = SELECTION_QUANTUM (display);
690 struct x_display_info *dpyinfo = x_display_info_for_display (display);
691 int count = SPECPDL_INDEX ();
692
693 if (max_bytes > MAX_SELECTION_QUANTUM)
694 max_bytes = MAX_SELECTION_QUANTUM;
695
696 reply.type = SelectionNotify;
697 reply.display = display;
698 reply.requestor = window;
699 reply.selection = SELECTION_EVENT_SELECTION (event);
700 reply.time = SELECTION_EVENT_TIME (event);
701 reply.target = SELECTION_EVENT_TARGET (event);
702 reply.property = SELECTION_EVENT_PROPERTY (event);
703 if (reply.property == None)
704 reply.property = reply.target;
705
706 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
707 BLOCK_INPUT;
708 x_catch_errors (display);
709
710 #ifdef TRACE_SELECTION
711 {
712 static int cnt;
713 char *sel = XGetAtomName (display, reply.selection);
714 char *tgt = XGetAtomName (display, reply.target);
715 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
716 if (sel) XFree (sel);
717 if (tgt) XFree (tgt);
718 }
719 #endif /* TRACE_SELECTION */
720
721 /* Store the data on the requested property.
722 If the selection is large, only store the first N bytes of it.
723 */
724 bytes_remaining = size * format_bytes;
725 if (bytes_remaining <= max_bytes)
726 {
727 /* Send all the data at once, with minimal handshaking. */
728 TRACE1 ("Sending all %d bytes", bytes_remaining);
729 XChangeProperty (display, window, reply.property, type, format,
730 PropModeReplace, data, size);
731 /* At this point, the selection was successfully stored; ack it. */
732 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
733 }
734 else
735 {
736 /* Send an INCR selection. */
737 struct prop_location *wait_object;
738 int had_errors;
739 Lisp_Object frame;
740
741 frame = some_frame_on_display (dpyinfo);
742
743 /* If the display no longer has frames, we can't expect
744 to get many more selection requests from it, so don't
745 bother trying to queue them. */
746 if (!NILP (frame))
747 {
748 x_start_queuing_selection_requests ();
749
750 record_unwind_protect (queue_selection_requests_unwind,
751 Qnil);
752 }
753
754 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
755 error ("Attempt to transfer an INCR to ourself!");
756
757 TRACE2 ("Start sending %d bytes incrementally (%s)",
758 bytes_remaining, XGetAtomName (display, reply.property));
759 wait_object = expect_property_change (display, window, reply.property,
760 PropertyDelete);
761
762 TRACE1 ("Set %s to number of bytes to send",
763 XGetAtomName (display, reply.property));
764 {
765 /* XChangeProperty expects an array of long even if long is more than
766 32 bits. */
767 long value[1];
768
769 value[0] = bytes_remaining;
770 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
771 32, PropModeReplace,
772 (unsigned char *) value, 1);
773 }
774
775 XSelectInput (display, window, PropertyChangeMask);
776
777 /* Tell 'em the INCR data is there... */
778 TRACE0 ("Send SelectionNotify event");
779 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
780 XFlush (display);
781
782 had_errors = x_had_errors_p (display);
783 UNBLOCK_INPUT;
784
785 /* First, wait for the requester to ack by deleting the property.
786 This can run random lisp code (process handlers) or signal. */
787 if (! had_errors)
788 {
789 TRACE1 ("Waiting for ACK (deletion of %s)",
790 XGetAtomName (display, reply.property));
791 wait_for_property_change (wait_object);
792 }
793 else
794 unexpect_property_change (wait_object);
795
796 TRACE0 ("Got ACK");
797 while (bytes_remaining)
798 {
799 int i = ((bytes_remaining < max_bytes)
800 ? bytes_remaining
801 : max_bytes);
802
803 BLOCK_INPUT;
804
805 wait_object
806 = expect_property_change (display, window, reply.property,
807 PropertyDelete);
808
809 TRACE1 ("Sending increment of %d bytes", i);
810 TRACE1 ("Set %s to increment data",
811 XGetAtomName (display, reply.property));
812
813 /* Append the next chunk of data to the property. */
814 XChangeProperty (display, window, reply.property, type, format,
815 PropModeAppend, data, i / format_bytes);
816 bytes_remaining -= i;
817 data += i;
818 XFlush (display);
819 had_errors = x_had_errors_p (display);
820 UNBLOCK_INPUT;
821
822 if (had_errors)
823 break;
824
825 /* Now wait for the requester to ack this chunk by deleting the
826 property. This can run random lisp code or signal. */
827 TRACE1 ("Waiting for increment ACK (deletion of %s)",
828 XGetAtomName (display, reply.property));
829 wait_for_property_change (wait_object);
830 }
831
832 /* Now write a zero-length chunk to the property to tell the
833 requester that we're done. */
834 BLOCK_INPUT;
835 if (! waiting_for_other_props_on_window (display, window))
836 XSelectInput (display, window, 0L);
837
838 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
839 XGetAtomName (display, reply.property));
840 XChangeProperty (display, window, reply.property, type, format,
841 PropModeReplace, data, 0);
842 TRACE0 ("Done sending incrementally");
843 }
844
845 /* rms, 2003-01-03: I think I have fixed this bug. */
846 /* The window we're communicating with may have been deleted
847 in the meantime (that's a real situation from a bug report).
848 In this case, there may be events in the event queue still
849 refering to the deleted window, and we'll get a BadWindow error
850 in XTread_socket when processing the events. I don't have
851 an idea how to fix that. gerd, 2001-01-98. */
852 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
853 delivered before uncatch errors. */
854 XSync (display, False);
855 UNBLOCK_INPUT;
856
857 /* GTK queues events in addition to the queue in Xlib. So we
858 UNBLOCK to enter the event loop and get possible errors delivered,
859 and then BLOCK again because x_uncatch_errors requires it. */
860 BLOCK_INPUT;
861
862 unbind_to (count, Qnil);
863 x_uncatch_errors ();
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 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 count = SPECPDL_INDEX ();
1413
1414 /* If the display no longer has frames, we can't expect
1415 to get many more selection requests from it, so don't
1416 bother trying to queue them. */
1417 if (!NILP (frame))
1418 {
1419 x_start_queuing_selection_requests ();
1420
1421 record_unwind_protect (queue_selection_requests_unwind,
1422 Qnil);
1423 }
1424 UNBLOCK_INPUT;
1425
1426 /* This allows quits. Also, don't wait forever. */
1427 secs = x_selection_timeout / 1000;
1428 usecs = (x_selection_timeout % 1000) * 1000;
1429 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1430 wait_reading_process_output (secs, usecs, 0, 0,
1431 reading_selection_reply, NULL, 0);
1432 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1433
1434 BLOCK_INPUT;
1435 unbind_to (count, Qnil);
1436 x_check_errors (display, "Cannot get selection: %s");
1437 x_uncatch_errors ();
1438 UNBLOCK_INPUT;
1439
1440 if (NILP (XCAR (reading_selection_reply)))
1441 error ("Timed out waiting for reply from selection owner");
1442 if (EQ (XCAR (reading_selection_reply), Qlambda))
1443 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
1444
1445 /* Otherwise, the selection is waiting for us on the requested property. */
1446 return
1447 x_get_window_property_as_lisp_data (display, requestor_window,
1448 target_property, target_type,
1449 selection_atom);
1450 }
1451 \f
1452 /* Subroutines of x_get_window_property_as_lisp_data */
1453
1454 /* Use xfree, not XFree, to free the data obtained with this function. */
1455
1456 static void
1457 x_get_window_property (display, window, property, data_ret, bytes_ret,
1458 actual_type_ret, actual_format_ret, actual_size_ret,
1459 delete_p)
1460 Display *display;
1461 Window window;
1462 Atom property;
1463 unsigned char **data_ret;
1464 int *bytes_ret;
1465 Atom *actual_type_ret;
1466 int *actual_format_ret;
1467 unsigned long *actual_size_ret;
1468 int delete_p;
1469 {
1470 int total_size;
1471 unsigned long bytes_remaining;
1472 int offset = 0;
1473 unsigned char *tmp_data = 0;
1474 int result;
1475 int buffer_size = SELECTION_QUANTUM (display);
1476
1477 if (buffer_size > MAX_SELECTION_QUANTUM)
1478 buffer_size = MAX_SELECTION_QUANTUM;
1479
1480 BLOCK_INPUT;
1481
1482 /* First probe the thing to find out how big it is. */
1483 result = XGetWindowProperty (display, window, property,
1484 0L, 0L, False, AnyPropertyType,
1485 actual_type_ret, actual_format_ret,
1486 actual_size_ret,
1487 &bytes_remaining, &tmp_data);
1488 if (result != Success)
1489 {
1490 UNBLOCK_INPUT;
1491 *data_ret = 0;
1492 *bytes_ret = 0;
1493 return;
1494 }
1495
1496 /* This was allocated by Xlib, so use XFree. */
1497 XFree ((char *) tmp_data);
1498
1499 if (*actual_type_ret == None || *actual_format_ret == 0)
1500 {
1501 UNBLOCK_INPUT;
1502 return;
1503 }
1504
1505 total_size = bytes_remaining + 1;
1506 *data_ret = (unsigned char *) xmalloc (total_size);
1507
1508 /* Now read, until we've gotten it all. */
1509 while (bytes_remaining)
1510 {
1511 #ifdef TRACE_SELECTION
1512 int last = bytes_remaining;
1513 #endif
1514 result
1515 = XGetWindowProperty (display, window, property,
1516 (long)offset/4, (long)buffer_size/4,
1517 False,
1518 AnyPropertyType,
1519 actual_type_ret, actual_format_ret,
1520 actual_size_ret, &bytes_remaining, &tmp_data);
1521
1522 TRACE2 ("Read %ld bytes from property %s",
1523 last - bytes_remaining,
1524 XGetAtomName (display, property));
1525
1526 /* If this doesn't return Success at this point, it means that
1527 some clod deleted the selection while we were in the midst of
1528 reading it. Deal with that, I guess.... */
1529 if (result != Success)
1530 break;
1531
1532 /* The man page for XGetWindowProperty says:
1533 "If the returned format is 32, the returned data is represented
1534 as a long array and should be cast to that type to obtain the
1535 elements."
1536 This applies even if long is more than 32 bits, the X library
1537 converts from 32 bit elements received from the X server to long
1538 and passes the long array to us. Thus, for that case bcopy can not
1539 be used. We convert to a 32 bit type here, because so much code
1540 assume on that.
1541
1542 The bytes and offsets passed to XGetWindowProperty refers to the
1543 property and those are indeed in 32 bit quantities if format is 32. */
1544
1545 if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1546 {
1547 unsigned long i;
1548 int *idata = (int *) ((*data_ret) + offset);
1549 long *ldata = (long *) tmp_data;
1550
1551 for (i = 0; i < *actual_size_ret; ++i)
1552 {
1553 idata[i]= (int) ldata[i];
1554 offset += 4;
1555 }
1556 }
1557 else
1558 {
1559 *actual_size_ret *= *actual_format_ret / 8;
1560 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1561 offset += *actual_size_ret;
1562 }
1563
1564 /* This was allocated by Xlib, so use XFree. */
1565 XFree ((char *) tmp_data);
1566 }
1567
1568 XFlush (display);
1569 UNBLOCK_INPUT;
1570 *bytes_ret = offset;
1571 }
1572 \f
1573 /* Use xfree, not XFree, to free the data obtained with this function. */
1574
1575 static void
1576 receive_incremental_selection (display, window, property, target_type,
1577 min_size_bytes, data_ret, size_bytes_ret,
1578 type_ret, format_ret, size_ret)
1579 Display *display;
1580 Window window;
1581 Atom property;
1582 Lisp_Object target_type; /* for error messages only */
1583 unsigned int min_size_bytes;
1584 unsigned char **data_ret;
1585 int *size_bytes_ret;
1586 Atom *type_ret;
1587 unsigned long *size_ret;
1588 int *format_ret;
1589 {
1590 int offset = 0;
1591 struct prop_location *wait_object;
1592 *size_bytes_ret = min_size_bytes;
1593 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1594
1595 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1596
1597 /* At this point, we have read an INCR property.
1598 Delete the property to ack it.
1599 (But first, prepare to receive the next event in this handshake.)
1600
1601 Now, we must loop, waiting for the sending window to put a value on
1602 that property, then reading the property, then deleting it to ack.
1603 We are done when the sender places a property of length 0.
1604 */
1605 BLOCK_INPUT;
1606 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1607 TRACE1 (" Delete property %s",
1608 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1609 XDeleteProperty (display, window, property);
1610 TRACE1 (" Expect new value of property %s",
1611 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
1612 wait_object = expect_property_change (display, window, property,
1613 PropertyNewValue);
1614 XFlush (display);
1615 UNBLOCK_INPUT;
1616
1617 while (1)
1618 {
1619 unsigned char *tmp_data;
1620 int tmp_size_bytes;
1621
1622 TRACE0 (" Wait for property change");
1623 wait_for_property_change (wait_object);
1624
1625 /* expect it again immediately, because x_get_window_property may
1626 .. no it won't, I don't get it.
1627 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1628 TRACE0 (" Get property value");
1629 x_get_window_property (display, window, property,
1630 &tmp_data, &tmp_size_bytes,
1631 type_ret, format_ret, size_ret, 1);
1632
1633 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1634
1635 if (tmp_size_bytes == 0) /* we're done */
1636 {
1637 TRACE0 ("Done reading incrementally");
1638
1639 if (! waiting_for_other_props_on_window (display, window))
1640 XSelectInput (display, window, STANDARD_EVENT_SET);
1641 /* Use xfree, not XFree, because x_get_window_property
1642 calls xmalloc itself. */
1643 if (tmp_data) xfree (tmp_data);
1644 break;
1645 }
1646
1647 BLOCK_INPUT;
1648 TRACE1 (" ACK by deleting property %s",
1649 XGetAtomName (display, property));
1650 XDeleteProperty (display, window, property);
1651 wait_object = expect_property_change (display, window, property,
1652 PropertyNewValue);
1653 XFlush (display);
1654 UNBLOCK_INPUT;
1655
1656 if (*size_bytes_ret < offset + tmp_size_bytes)
1657 {
1658 *size_bytes_ret = offset + tmp_size_bytes;
1659 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1660 }
1661
1662 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1663 offset += tmp_size_bytes;
1664
1665 /* Use xfree, not XFree, because x_get_window_property
1666 calls xmalloc itself. */
1667 xfree (tmp_data);
1668 }
1669 }
1670
1671 \f
1672 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1673 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1674 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1675
1676 static Lisp_Object
1677 x_get_window_property_as_lisp_data (display, window, property, target_type,
1678 selection_atom)
1679 Display *display;
1680 Window window;
1681 Atom property;
1682 Lisp_Object target_type; /* for error messages only */
1683 Atom selection_atom; /* for error messages only */
1684 {
1685 Atom actual_type;
1686 int actual_format;
1687 unsigned long actual_size;
1688 unsigned char *data = 0;
1689 int bytes = 0;
1690 Lisp_Object val;
1691 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1692
1693 TRACE0 ("Reading selection data");
1694
1695 x_get_window_property (display, window, property, &data, &bytes,
1696 &actual_type, &actual_format, &actual_size, 1);
1697 if (! data)
1698 {
1699 int there_is_a_selection_owner;
1700 BLOCK_INPUT;
1701 there_is_a_selection_owner
1702 = XGetSelectionOwner (display, selection_atom);
1703 UNBLOCK_INPUT;
1704 Fsignal (Qerror,
1705 there_is_a_selection_owner
1706 ? Fcons (build_string ("selection owner couldn't convert"),
1707 actual_type
1708 ? Fcons (target_type,
1709 Fcons (x_atom_to_symbol (display,
1710 actual_type),
1711 Qnil))
1712 : Fcons (target_type, Qnil))
1713 : Fcons (build_string ("no selection"),
1714 Fcons (x_atom_to_symbol (display,
1715 selection_atom),
1716 Qnil)));
1717 }
1718
1719 if (actual_type == dpyinfo->Xatom_INCR)
1720 {
1721 /* That wasn't really the data, just the beginning. */
1722
1723 unsigned int min_size_bytes = * ((unsigned int *) data);
1724 BLOCK_INPUT;
1725 /* Use xfree, not XFree, because x_get_window_property
1726 calls xmalloc itself. */
1727 xfree ((char *) data);
1728 UNBLOCK_INPUT;
1729 receive_incremental_selection (display, window, property, target_type,
1730 min_size_bytes, &data, &bytes,
1731 &actual_type, &actual_format,
1732 &actual_size);
1733 }
1734
1735 BLOCK_INPUT;
1736 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1737 XDeleteProperty (display, window, property);
1738 XFlush (display);
1739 UNBLOCK_INPUT;
1740
1741 /* It's been read. Now convert it to a lisp object in some semi-rational
1742 manner. */
1743 val = selection_data_to_lisp_data (display, data, bytes,
1744 actual_type, actual_format);
1745
1746 /* Use xfree, not XFree, because x_get_window_property
1747 calls xmalloc itself. */
1748 xfree ((char *) data);
1749 return val;
1750 }
1751 \f
1752 /* These functions convert from the selection data read from the server into
1753 something that we can use from Lisp, and vice versa.
1754
1755 Type: Format: Size: Lisp Type:
1756 ----- ------- ----- -----------
1757 * 8 * String
1758 ATOM 32 1 Symbol
1759 ATOM 32 > 1 Vector of Symbols
1760 * 16 1 Integer
1761 * 16 > 1 Vector of Integers
1762 * 32 1 if <=16 bits: Integer
1763 if > 16 bits: Cons of top16, bot16
1764 * 32 > 1 Vector of the above
1765
1766 When converting a Lisp number to C, it is assumed to be of format 16 if
1767 it is an integer, and of format 32 if it is a cons of two integers.
1768
1769 When converting a vector of numbers from Lisp to C, it is assumed to be
1770 of format 16 if every element in the vector is an integer, and is assumed
1771 to be of format 32 if any element is a cons of two integers.
1772
1773 When converting an object to C, it may be of the form (SYMBOL . <data>)
1774 where SYMBOL is what we should claim that the type is. Format and
1775 representation are as above.
1776
1777 Important: When format is 32, data should contain an array of int,
1778 not an array of long as the X library returns. This makes a difference
1779 when sizeof(long) != sizeof(int). */
1780
1781
1782
1783 static Lisp_Object
1784 selection_data_to_lisp_data (display, data, size, type, format)
1785 Display *display;
1786 unsigned char *data;
1787 Atom type;
1788 int size, format;
1789 {
1790 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1791
1792 if (type == dpyinfo->Xatom_NULL)
1793 return QNULL;
1794
1795 /* Convert any 8-bit data to a string, for compactness. */
1796 else if (format == 8)
1797 {
1798 Lisp_Object str, lispy_type;
1799
1800 str = make_unibyte_string ((char *) data, size);
1801 /* Indicate that this string is from foreign selection by a text
1802 property `foreign-selection' so that the caller of
1803 x-get-selection-internal (usually x-get-selection) can know
1804 that the string must be decode. */
1805 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1806 lispy_type = QCOMPOUND_TEXT;
1807 else if (type == dpyinfo->Xatom_UTF8_STRING)
1808 lispy_type = QUTF8_STRING;
1809 else
1810 lispy_type = QSTRING;
1811 Fput_text_property (make_number (0), make_number (size),
1812 Qforeign_selection, lispy_type, str);
1813 return str;
1814 }
1815 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1816 a vector of symbols.
1817 */
1818 else if (type == XA_ATOM)
1819 {
1820 int i;
1821 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1822 But the callers of these function has made sure the data for
1823 format == 32 is an array of int. Thus, use int instead
1824 of Atom. */
1825 int *idata = (int *) data;
1826
1827 if (size == sizeof (int))
1828 return x_atom_to_symbol (display, (Atom) idata[0]);
1829 else
1830 {
1831 Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
1832 make_number (0));
1833 for (i = 0; i < size / sizeof (int); i++)
1834 Faset (v, make_number (i),
1835 x_atom_to_symbol (display, (Atom) idata[i]));
1836 return v;
1837 }
1838 }
1839
1840 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1841 If the number is > 16 bits, convert it to a cons of integers,
1842 16 bits in each half.
1843 */
1844 else if (format == 32 && size == sizeof (int))
1845 return long_to_cons (((unsigned int *) data) [0]);
1846 else if (format == 16 && size == sizeof (short))
1847 return make_number ((int) (((unsigned short *) data) [0]));
1848
1849 /* Convert any other kind of data to a vector of numbers, represented
1850 as above (as an integer, or a cons of two 16 bit integers.)
1851 */
1852 else if (format == 16)
1853 {
1854 int i;
1855 Lisp_Object v;
1856 v = Fmake_vector (make_number (size / 2), make_number (0));
1857 for (i = 0; i < size / 2; i++)
1858 {
1859 int j = (int) ((unsigned short *) data) [i];
1860 Faset (v, make_number (i), make_number (j));
1861 }
1862 return v;
1863 }
1864 else
1865 {
1866 int i;
1867 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1868 for (i = 0; i < size / 4; i++)
1869 {
1870 unsigned int j = ((unsigned int *) data) [i];
1871 Faset (v, make_number (i), long_to_cons (j));
1872 }
1873 return v;
1874 }
1875 }
1876
1877
1878 /* Use xfree, not XFree, to free the data obtained with this function. */
1879
1880 static void
1881 lisp_data_to_selection_data (display, obj,
1882 data_ret, type_ret, size_ret,
1883 format_ret, nofree_ret)
1884 Display *display;
1885 Lisp_Object obj;
1886 unsigned char **data_ret;
1887 Atom *type_ret;
1888 unsigned int *size_ret;
1889 int *format_ret;
1890 int *nofree_ret;
1891 {
1892 Lisp_Object type = Qnil;
1893 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1894
1895 *nofree_ret = 0;
1896
1897 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1898 {
1899 type = XCAR (obj);
1900 obj = XCDR (obj);
1901 if (CONSP (obj) && NILP (XCDR (obj)))
1902 obj = XCAR (obj);
1903 }
1904
1905 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1906 { /* This is not the same as declining */
1907 *format_ret = 32;
1908 *size_ret = 0;
1909 *data_ret = 0;
1910 type = QNULL;
1911 }
1912 else if (STRINGP (obj))
1913 {
1914 if (SCHARS (obj) < SBYTES (obj))
1915 /* OBJ is a multibyte string containing a non-ASCII char. */
1916 Fsignal (Qerror, /* Qselection_error */
1917 Fcons (build_string
1918 ("Non-ASCII string must be encoded in advance"),
1919 Fcons (obj, Qnil)));
1920 if (NILP (type))
1921 type = QSTRING;
1922 *format_ret = 8;
1923 *size_ret = SBYTES (obj);
1924 *data_ret = SDATA (obj);
1925 *nofree_ret = 1;
1926 }
1927 else if (SYMBOLP (obj))
1928 {
1929 *format_ret = 32;
1930 *size_ret = 1;
1931 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1932 (*data_ret) [sizeof (Atom)] = 0;
1933 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1934 if (NILP (type)) type = QATOM;
1935 }
1936 else if (INTEGERP (obj)
1937 && XINT (obj) < 0xFFFF
1938 && XINT (obj) > -0xFFFF)
1939 {
1940 *format_ret = 16;
1941 *size_ret = 1;
1942 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1943 (*data_ret) [sizeof (short)] = 0;
1944 (*(short **) data_ret) [0] = (short) XINT (obj);
1945 if (NILP (type)) type = QINTEGER;
1946 }
1947 else if (INTEGERP (obj)
1948 || (CONSP (obj) && INTEGERP (XCAR (obj))
1949 && (INTEGERP (XCDR (obj))
1950 || (CONSP (XCDR (obj))
1951 && INTEGERP (XCAR (XCDR (obj)))))))
1952 {
1953 *format_ret = 32;
1954 *size_ret = 1;
1955 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1956 (*data_ret) [sizeof (long)] = 0;
1957 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1958 if (NILP (type)) type = QINTEGER;
1959 }
1960 else if (VECTORP (obj))
1961 {
1962 /* Lisp_Vectors may represent a set of ATOMs;
1963 a set of 16 or 32 bit INTEGERs;
1964 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1965 */
1966 int i;
1967
1968 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1969 /* This vector is an ATOM set */
1970 {
1971 if (NILP (type)) type = QATOM;
1972 *size_ret = XVECTOR (obj)->size;
1973 *format_ret = 32;
1974 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1975 for (i = 0; i < *size_ret; i++)
1976 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1977 (*(Atom **) data_ret) [i]
1978 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1979 else
1980 Fsignal (Qerror, /* Qselection_error */
1981 Fcons (build_string
1982 ("all elements of selection vector must have same type"),
1983 Fcons (obj, Qnil)));
1984 }
1985 #if 0 /* #### MULTIPLE doesn't work yet */
1986 else if (VECTORP (XVECTOR (obj)->contents [0]))
1987 /* This vector is an ATOM_PAIR set */
1988 {
1989 if (NILP (type)) type = QATOM_PAIR;
1990 *size_ret = XVECTOR (obj)->size;
1991 *format_ret = 32;
1992 *data_ret = (unsigned char *)
1993 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1994 for (i = 0; i < *size_ret; i++)
1995 if (VECTORP (XVECTOR (obj)->contents [i]))
1996 {
1997 Lisp_Object pair = XVECTOR (obj)->contents [i];
1998 if (XVECTOR (pair)->size != 2)
1999 Fsignal (Qerror,
2000 Fcons (build_string
2001 ("elements of the vector must be vectors of exactly two elements"),
2002 Fcons (pair, Qnil)));
2003
2004 (*(Atom **) data_ret) [i * 2]
2005 = symbol_to_x_atom (dpyinfo, display,
2006 XVECTOR (pair)->contents [0]);
2007 (*(Atom **) data_ret) [(i * 2) + 1]
2008 = symbol_to_x_atom (dpyinfo, display,
2009 XVECTOR (pair)->contents [1]);
2010 }
2011 else
2012 Fsignal (Qerror,
2013 Fcons (build_string
2014 ("all elements of the vector must be of the same type"),
2015 Fcons (obj, Qnil)));
2016
2017 }
2018 #endif
2019 else
2020 /* This vector is an INTEGER set, or something like it */
2021 {
2022 int data_size = 2;
2023 *size_ret = XVECTOR (obj)->size;
2024 if (NILP (type)) type = QINTEGER;
2025 *format_ret = 16;
2026 for (i = 0; i < *size_ret; i++)
2027 if (CONSP (XVECTOR (obj)->contents [i]))
2028 *format_ret = 32;
2029 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
2030 Fsignal (Qerror, /* Qselection_error */
2031 Fcons (build_string
2032 ("elements of selection vector must be integers or conses of integers"),
2033 Fcons (obj, Qnil)));
2034
2035 /* Use sizeof(long) even if it is more than 32 bits. See comment
2036 in x_get_window_property and x_fill_property_data. */
2037
2038 if (*format_ret == 32) data_size = sizeof(long);
2039 *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
2040 for (i = 0; i < *size_ret; i++)
2041 if (*format_ret == 32)
2042 (*((unsigned long **) data_ret)) [i]
2043 = cons_to_long (XVECTOR (obj)->contents [i]);
2044 else
2045 (*((unsigned short **) data_ret)) [i]
2046 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2047 }
2048 }
2049 else
2050 Fsignal (Qerror, /* Qselection_error */
2051 Fcons (build_string ("unrecognized selection data"),
2052 Fcons (obj, Qnil)));
2053
2054 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
2055 }
2056
2057 static Lisp_Object
2058 clean_local_selection_data (obj)
2059 Lisp_Object obj;
2060 {
2061 if (CONSP (obj)
2062 && INTEGERP (XCAR (obj))
2063 && CONSP (XCDR (obj))
2064 && INTEGERP (XCAR (XCDR (obj)))
2065 && NILP (XCDR (XCDR (obj))))
2066 obj = Fcons (XCAR (obj), XCDR (obj));
2067
2068 if (CONSP (obj)
2069 && INTEGERP (XCAR (obj))
2070 && INTEGERP (XCDR (obj)))
2071 {
2072 if (XINT (XCAR (obj)) == 0)
2073 return XCDR (obj);
2074 if (XINT (XCAR (obj)) == -1)
2075 return make_number (- XINT (XCDR (obj)));
2076 }
2077 if (VECTORP (obj))
2078 {
2079 int i;
2080 int size = XVECTOR (obj)->size;
2081 Lisp_Object copy;
2082 if (size == 1)
2083 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
2084 copy = Fmake_vector (make_number (size), Qnil);
2085 for (i = 0; i < size; i++)
2086 XVECTOR (copy)->contents [i]
2087 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2088 return copy;
2089 }
2090 return obj;
2091 }
2092 \f
2093 /* Called from XTread_socket to handle SelectionNotify events.
2094 If it's the selection we are waiting for, stop waiting
2095 by setting the car of reading_selection_reply to non-nil.
2096 We store t there if the reply is successful, lambda if not. */
2097
2098 void
2099 x_handle_selection_notify (event)
2100 XSelectionEvent *event;
2101 {
2102 if (event->requestor != reading_selection_window)
2103 return;
2104 if (event->selection != reading_which_selection)
2105 return;
2106
2107 TRACE0 ("Received SelectionNotify");
2108 XSETCAR (reading_selection_reply,
2109 (event->property != 0 ? Qt : Qlambda));
2110 }
2111
2112 \f
2113 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
2114 Sx_own_selection_internal, 2, 2, 0,
2115 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2116 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2117 \(Those are literal upper-case symbol names, since that's what X expects.)
2118 VALUE is typically a string, or a cons of two markers, but may be
2119 anything that the functions on `selection-converter-alist' know about. */)
2120 (selection_name, selection_value)
2121 Lisp_Object selection_name, selection_value;
2122 {
2123 check_x ();
2124 CHECK_SYMBOL (selection_name);
2125 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
2126 x_own_selection (selection_name, selection_value);
2127 return selection_value;
2128 }
2129
2130
2131 /* Request the selection value from the owner. If we are the owner,
2132 simply return our selection value. If we are not the owner, this
2133 will block until all of the data has arrived. */
2134
2135 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
2136 Sx_get_selection_internal, 2, 3, 0,
2137 doc: /* Return text selected from some X window.
2138 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2139 \(Those are literal upper-case symbol names, since that's what X expects.)
2140 TYPE is the type of data desired, typically `STRING'.
2141 TIME_STAMP is the time to use in the XConvertSelection call for foreign
2142 selections. If omitted, defaults to the time for the last event. */)
2143 (selection_symbol, target_type, time_stamp)
2144 Lisp_Object selection_symbol, target_type, time_stamp;
2145 {
2146 Lisp_Object val = Qnil;
2147 struct gcpro gcpro1, gcpro2;
2148 GCPRO2 (target_type, val); /* we store newly consed data into these */
2149 check_x ();
2150 CHECK_SYMBOL (selection_symbol);
2151
2152 #if 0 /* #### MULTIPLE doesn't work yet */
2153 if (CONSP (target_type)
2154 && XCAR (target_type) == QMULTIPLE)
2155 {
2156 CHECK_VECTOR (XCDR (target_type));
2157 /* So we don't destructively modify this... */
2158 target_type = copy_multiple_data (target_type);
2159 }
2160 else
2161 #endif
2162 CHECK_SYMBOL (target_type);
2163
2164 val = x_get_local_selection (selection_symbol, target_type, 1);
2165
2166 if (NILP (val))
2167 {
2168 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
2169 goto DONE;
2170 }
2171
2172 if (CONSP (val)
2173 && SYMBOLP (XCAR (val)))
2174 {
2175 val = XCDR (val);
2176 if (CONSP (val) && NILP (XCDR (val)))
2177 val = XCAR (val);
2178 }
2179 val = clean_local_selection_data (val);
2180 DONE:
2181 UNGCPRO;
2182 return val;
2183 }
2184
2185 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
2186 Sx_disown_selection_internal, 1, 2, 0,
2187 doc: /* If we own the selection SELECTION, disown it.
2188 Disowning it means there is no such selection. */)
2189 (selection, time)
2190 Lisp_Object selection;
2191 Lisp_Object time;
2192 {
2193 Time timestamp;
2194 Atom selection_atom;
2195 union {
2196 struct selection_input_event sie;
2197 struct input_event ie;
2198 } event;
2199 Display *display;
2200 struct x_display_info *dpyinfo;
2201 struct frame *sf = SELECTED_FRAME ();
2202
2203 check_x ();
2204 display = FRAME_X_DISPLAY (sf);
2205 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2206 CHECK_SYMBOL (selection);
2207 if (NILP (time))
2208 timestamp = last_event_timestamp;
2209 else
2210 timestamp = cons_to_long (time);
2211
2212 if (NILP (assq_no_quit (selection, Vselection_alist)))
2213 return Qnil; /* Don't disown the selection when we're not the owner. */
2214
2215 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2216
2217 BLOCK_INPUT;
2218 XSetSelectionOwner (display, selection_atom, None, timestamp);
2219 UNBLOCK_INPUT;
2220
2221 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2222 generated for a window which owns the selection when that window sets
2223 the selection owner to None. The NCD server does, the MIT Sun4 server
2224 doesn't. So we synthesize one; this means we might get two, but
2225 that's ok, because the second one won't have any effect. */
2226 SELECTION_EVENT_DISPLAY (&event.sie) = display;
2227 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2228 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2229 x_handle_selection_clear (&event.ie);
2230
2231 return Qt;
2232 }
2233
2234 /* Get rid of all the selections in buffer BUFFER.
2235 This is used when we kill a buffer. */
2236
2237 void
2238 x_disown_buffer_selections (buffer)
2239 Lisp_Object buffer;
2240 {
2241 Lisp_Object tail;
2242 struct buffer *buf = XBUFFER (buffer);
2243
2244 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2245 {
2246 Lisp_Object elt, value;
2247 elt = XCAR (tail);
2248 value = XCDR (elt);
2249 if (CONSP (value) && MARKERP (XCAR (value))
2250 && XMARKER (XCAR (value))->buffer == buf)
2251 Fx_disown_selection_internal (XCAR (elt), Qnil);
2252 }
2253 }
2254
2255 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2256 0, 1, 0,
2257 doc: /* Whether the current Emacs process owns the given X Selection.
2258 The arg should be the name of the selection in question, typically one of
2259 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2260 \(Those are literal upper-case symbol names, since that's what X expects.)
2261 For convenience, the symbol nil is the same as `PRIMARY',
2262 and t is the same as `SECONDARY'. */)
2263 (selection)
2264 Lisp_Object selection;
2265 {
2266 check_x ();
2267 CHECK_SYMBOL (selection);
2268 if (EQ (selection, Qnil)) selection = QPRIMARY;
2269 if (EQ (selection, Qt)) selection = QSECONDARY;
2270
2271 if (NILP (Fassq (selection, Vselection_alist)))
2272 return Qnil;
2273 return Qt;
2274 }
2275
2276 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2277 0, 1, 0,
2278 doc: /* Whether there is an owner for the given X Selection.
2279 The arg should be the name of the selection in question, typically one of
2280 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2281 \(Those are literal upper-case symbol names, since that's what X expects.)
2282 For convenience, the symbol nil is the same as `PRIMARY',
2283 and t is the same as `SECONDARY'. */)
2284 (selection)
2285 Lisp_Object selection;
2286 {
2287 Window owner;
2288 Atom atom;
2289 Display *dpy;
2290 struct frame *sf = SELECTED_FRAME ();
2291
2292 /* It should be safe to call this before we have an X frame. */
2293 if (! FRAME_X_P (sf))
2294 return Qnil;
2295
2296 dpy = FRAME_X_DISPLAY (sf);
2297 CHECK_SYMBOL (selection);
2298 if (!NILP (Fx_selection_owner_p (selection)))
2299 return Qt;
2300 if (EQ (selection, Qnil)) selection = QPRIMARY;
2301 if (EQ (selection, Qt)) selection = QSECONDARY;
2302 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2303 if (atom == 0)
2304 return Qnil;
2305 BLOCK_INPUT;
2306 owner = XGetSelectionOwner (dpy, atom);
2307 UNBLOCK_INPUT;
2308 return (owner ? Qt : Qnil);
2309 }
2310
2311 \f
2312 #ifdef CUT_BUFFER_SUPPORT
2313
2314 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2315 static void
2316 initialize_cut_buffers (display, window)
2317 Display *display;
2318 Window window;
2319 {
2320 unsigned char *data = (unsigned char *) "";
2321 BLOCK_INPUT;
2322 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2323 PropModeAppend, data, 0)
2324 FROB (XA_CUT_BUFFER0);
2325 FROB (XA_CUT_BUFFER1);
2326 FROB (XA_CUT_BUFFER2);
2327 FROB (XA_CUT_BUFFER3);
2328 FROB (XA_CUT_BUFFER4);
2329 FROB (XA_CUT_BUFFER5);
2330 FROB (XA_CUT_BUFFER6);
2331 FROB (XA_CUT_BUFFER7);
2332 #undef FROB
2333 UNBLOCK_INPUT;
2334 }
2335
2336
2337 #define CHECK_CUT_BUFFER(symbol) \
2338 { CHECK_SYMBOL ((symbol)); \
2339 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2340 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2341 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2342 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2343 Fsignal (Qerror, \
2344 Fcons (build_string ("doesn't name a cut buffer"), \
2345 Fcons ((symbol), Qnil))); \
2346 }
2347
2348 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2349 Sx_get_cut_buffer_internal, 1, 1, 0,
2350 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2351 (buffer)
2352 Lisp_Object buffer;
2353 {
2354 Window window;
2355 Atom buffer_atom;
2356 unsigned char *data;
2357 int bytes;
2358 Atom type;
2359 int format;
2360 unsigned long size;
2361 Lisp_Object ret;
2362 Display *display;
2363 struct x_display_info *dpyinfo;
2364 struct frame *sf = SELECTED_FRAME ();
2365
2366 check_x ();
2367 display = FRAME_X_DISPLAY (sf);
2368 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2369 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2370 CHECK_CUT_BUFFER (buffer);
2371 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2372
2373 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2374 &type, &format, &size, 0);
2375 if (!data || !format)
2376 return Qnil;
2377
2378 if (format != 8 || type != XA_STRING)
2379 Fsignal (Qerror,
2380 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2381 Fcons (x_atom_to_symbol (display, type),
2382 Fcons (make_number (format), Qnil))));
2383
2384 ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
2385 /* Use xfree, not XFree, because x_get_window_property
2386 calls xmalloc itself. */
2387 xfree (data);
2388 return ret;
2389 }
2390
2391
2392 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2393 Sx_store_cut_buffer_internal, 2, 2, 0,
2394 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2395 (buffer, string)
2396 Lisp_Object buffer, string;
2397 {
2398 Window window;
2399 Atom buffer_atom;
2400 unsigned char *data;
2401 int bytes;
2402 int bytes_remaining;
2403 int max_bytes;
2404 Display *display;
2405 struct frame *sf = SELECTED_FRAME ();
2406
2407 check_x ();
2408 display = FRAME_X_DISPLAY (sf);
2409 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2410
2411 max_bytes = SELECTION_QUANTUM (display);
2412 if (max_bytes > MAX_SELECTION_QUANTUM)
2413 max_bytes = MAX_SELECTION_QUANTUM;
2414
2415 CHECK_CUT_BUFFER (buffer);
2416 CHECK_STRING (string);
2417 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2418 display, buffer);
2419 data = (unsigned char *) SDATA (string);
2420 bytes = SBYTES (string);
2421 bytes_remaining = bytes;
2422
2423 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2424 {
2425 initialize_cut_buffers (display, window);
2426 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2427 }
2428
2429 BLOCK_INPUT;
2430
2431 /* Don't mess up with an empty value. */
2432 if (!bytes_remaining)
2433 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2434 PropModeReplace, data, 0);
2435
2436 while (bytes_remaining)
2437 {
2438 int chunk = (bytes_remaining < max_bytes
2439 ? bytes_remaining : max_bytes);
2440 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2441 (bytes_remaining == bytes
2442 ? PropModeReplace
2443 : PropModeAppend),
2444 data, chunk);
2445 data += chunk;
2446 bytes_remaining -= chunk;
2447 }
2448 UNBLOCK_INPUT;
2449 return string;
2450 }
2451
2452
2453 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2454 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2455 doc: /* Rotate the values of the cut buffers by the given number of step.
2456 Positive means shift the values forward, negative means backward. */)
2457 (n)
2458 Lisp_Object n;
2459 {
2460 Window window;
2461 Atom props[8];
2462 Display *display;
2463 struct frame *sf = SELECTED_FRAME ();
2464
2465 check_x ();
2466 display = FRAME_X_DISPLAY (sf);
2467 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2468 CHECK_NUMBER (n);
2469 if (XINT (n) == 0)
2470 return n;
2471 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2472 {
2473 initialize_cut_buffers (display, window);
2474 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2475 }
2476
2477 props[0] = XA_CUT_BUFFER0;
2478 props[1] = XA_CUT_BUFFER1;
2479 props[2] = XA_CUT_BUFFER2;
2480 props[3] = XA_CUT_BUFFER3;
2481 props[4] = XA_CUT_BUFFER4;
2482 props[5] = XA_CUT_BUFFER5;
2483 props[6] = XA_CUT_BUFFER6;
2484 props[7] = XA_CUT_BUFFER7;
2485 BLOCK_INPUT;
2486 XRotateWindowProperties (display, window, props, 8, XINT (n));
2487 UNBLOCK_INPUT;
2488 return n;
2489 }
2490
2491 #endif
2492 \f
2493 /***********************************************************************
2494 Drag and drop support
2495 ***********************************************************************/
2496 /* Check that lisp values are of correct type for x_fill_property_data.
2497 That is, number, string or a cons with two numbers (low and high 16
2498 bit parts of a 32 bit number). */
2499
2500 int
2501 x_check_property_data (data)
2502 Lisp_Object data;
2503 {
2504 Lisp_Object iter;
2505 int size = 0;
2506
2507 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2508 {
2509 Lisp_Object o = XCAR (iter);
2510
2511 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2512 size = -1;
2513 else if (CONSP (o) &&
2514 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2515 size = -1;
2516 }
2517
2518 return size;
2519 }
2520
2521 /* Convert lisp values to a C array. Values may be a number, a string
2522 which is taken as an X atom name and converted to the atom value, or
2523 a cons containing the two 16 bit parts of a 32 bit number.
2524
2525 DPY is the display use to look up X atoms.
2526 DATA is a Lisp list of values to be converted.
2527 RET is the C array that contains the converted values. It is assumed
2528 it is big enough to hold all values.
2529 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2530 be stored in RET. Note that long is used for 32 even if long is more
2531 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2532 XClientMessageEvent). */
2533
2534 void
2535 x_fill_property_data (dpy, data, ret, format)
2536 Display *dpy;
2537 Lisp_Object data;
2538 void *ret;
2539 int format;
2540 {
2541 long val;
2542 long *d32 = (long *) ret;
2543 short *d16 = (short *) ret;
2544 char *d08 = (char *) ret;
2545 Lisp_Object iter;
2546
2547 for (iter = data; CONSP (iter); iter = XCDR (iter))
2548 {
2549 Lisp_Object o = XCAR (iter);
2550
2551 if (INTEGERP (o))
2552 val = (long) XFASTINT (o);
2553 else if (FLOATP (o))
2554 val = (long) XFLOAT_DATA (o);
2555 else if (CONSP (o))
2556 val = (long) cons_to_long (o);
2557 else if (STRINGP (o))
2558 {
2559 BLOCK_INPUT;
2560 val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
2561 UNBLOCK_INPUT;
2562 }
2563 else
2564 error ("Wrong type, must be string, number or cons");
2565
2566 if (format == 8)
2567 *d08++ = (char) val;
2568 else if (format == 16)
2569 *d16++ = (short) val;
2570 else
2571 *d32++ = val;
2572 }
2573 }
2574
2575 /* Convert an array of C values to a Lisp list.
2576 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2577 DATA is a C array of values to be converted.
2578 TYPE is the type of the data. Only XA_ATOM is special, it converts
2579 each number in DATA to its corresponfing X atom as a symbol.
2580 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2581 be stored in RET.
2582 SIZE is the number of elements in DATA.
2583
2584 Important: When format is 32, data should contain an array of int,
2585 not an array of long as the X library returns. This makes a difference
2586 when sizeof(long) != sizeof(int).
2587
2588 Also see comment for selection_data_to_lisp_data above. */
2589
2590 Lisp_Object
2591 x_property_data_to_lisp (f, data, type, format, size)
2592 struct frame *f;
2593 unsigned char *data;
2594 Atom type;
2595 int format;
2596 unsigned long size;
2597 {
2598 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2599 data, size*format/8, type, format);
2600 }
2601
2602 /* Get the mouse position in frame relative coordinates. */
2603
2604 static void
2605 mouse_position_for_drop (f, x, y)
2606 FRAME_PTR f;
2607 int *x;
2608 int *y;
2609 {
2610 Window root, dummy_window;
2611 int dummy;
2612
2613 BLOCK_INPUT;
2614
2615 XQueryPointer (FRAME_X_DISPLAY (f),
2616 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2617
2618 /* The root window which contains the pointer. */
2619 &root,
2620
2621 /* Window pointer is on, not used */
2622 &dummy_window,
2623
2624 /* The position on that root window. */
2625 x, y,
2626
2627 /* x/y in dummy_window coordinates, not used. */
2628 &dummy, &dummy,
2629
2630 /* Modifier keys and pointer buttons, about which
2631 we don't care. */
2632 (unsigned int *) &dummy);
2633
2634
2635 /* Absolute to relative. */
2636 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2637 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2638
2639 UNBLOCK_INPUT;
2640 }
2641
2642 DEFUN ("x-get-atom-name", Fx_get_atom_name,
2643 Sx_get_atom_name, 1, 2, 0,
2644 doc: /* Return the X atom name for VALUE as a string.
2645 VALUE may be a number or a cons where the car is the upper 16 bits and
2646 the cdr is the lower 16 bits of a 32 bit value.
2647 Use the display for FRAME or the current frame if FRAME is not given or nil.
2648
2649 If the value is 0 or the atom is not known, return the empty string. */)
2650 (value, frame)
2651 Lisp_Object value, frame;
2652 {
2653 struct frame *f = check_x_frame (frame);
2654 char *name = 0;
2655 Lisp_Object ret = Qnil;
2656 Display *dpy = FRAME_X_DISPLAY (f);
2657 Atom atom;
2658
2659 if (INTEGERP (value))
2660 atom = (Atom) XUINT (value);
2661 else if (FLOATP (value))
2662 atom = (Atom) XFLOAT_DATA (value);
2663 else if (CONSP (value))
2664 atom = (Atom) cons_to_long (value);
2665 else
2666 error ("Wrong type, value must be number or cons");
2667
2668 BLOCK_INPUT;
2669 x_catch_errors (dpy);
2670
2671 name = atom ? XGetAtomName (dpy, atom) : "";
2672
2673 if (! x_had_errors_p (dpy))
2674 ret = make_string (name, strlen (name));
2675
2676 x_uncatch_errors ();
2677
2678 if (atom && name) XFree (name);
2679 if (NILP (ret)) ret = make_string ("", 0);
2680
2681 UNBLOCK_INPUT;
2682
2683 return ret;
2684 }
2685
2686 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2687 TODO: Check if this client event really is a DND event? */
2688
2689 int
2690 x_handle_dnd_message (f, event, dpyinfo, bufp)
2691 struct frame *f;
2692 XClientMessageEvent *event;
2693 struct x_display_info *dpyinfo;
2694 struct input_event *bufp;
2695 {
2696 Lisp_Object vec;
2697 Lisp_Object frame;
2698 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2699 unsigned long size = 160/event->format;
2700 int x, y;
2701 unsigned char *data = (unsigned char *) event->data.b;
2702 int idata[5];
2703
2704 XSETFRAME (frame, f);
2705
2706 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2707 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2708 function expects them to be of size int (i.e. 32). So to be able to
2709 use that function, put the data in the form it expects if format is 32. */
2710
2711 if (event->format == 32 && event->format < BITS_PER_LONG)
2712 {
2713 int i;
2714 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2715 idata[i] = (int) event->data.l[i];
2716 data = (unsigned char *) idata;
2717 }
2718
2719 vec = Fmake_vector (make_number (4), Qnil);
2720 AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2721 event->message_type));
2722 AREF (vec, 1) = frame;
2723 AREF (vec, 2) = make_number (event->format);
2724 AREF (vec, 3) = x_property_data_to_lisp (f,
2725 data,
2726 event->message_type,
2727 event->format,
2728 size);
2729
2730 mouse_position_for_drop (f, &x, &y);
2731 bufp->kind = DRAG_N_DROP_EVENT;
2732 bufp->frame_or_window = frame;
2733 bufp->timestamp = CurrentTime;
2734 bufp->x = make_number (x);
2735 bufp->y = make_number (y);
2736 bufp->arg = vec;
2737 bufp->modifiers = 0;
2738
2739 return 1;
2740 }
2741
2742 DEFUN ("x-send-client-message", Fx_send_client_event,
2743 Sx_send_client_message, 6, 6, 0,
2744 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2745
2746 For DISPLAY, specify either a frame or a display name (a string).
2747 If DISPLAY is nil, that stands for the selected frame's display.
2748 DEST may be a number, in which case it is a Window id. The value 0 may
2749 be used to send to the root window of the DISPLAY.
2750 If DEST is a cons, it is converted to a 32 bit number
2751 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2752 number is then used as a window id.
2753 If DEST is a frame the event is sent to the outer window of that frame.
2754 Nil means the currently selected frame.
2755 If DEST is the string "PointerWindow" the event is sent to the window that
2756 contains the pointer. If DEST is the string "InputFocus" the event is
2757 sent to the window that has the input focus.
2758 FROM is the frame sending the event. Use nil for currently selected frame.
2759 MESSAGE-TYPE is the name of an Atom as a string.
2760 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2761 bits. VALUES is a list of numbers, cons and/or strings containing the values
2762 to send. If a value is a string, it is converted to an Atom and the value of
2763 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2764 with the high 16 bits from the car and the lower 16 bit from the cdr.
2765 If more values than fits into the event is given, the excessive values
2766 are ignored. */)
2767 (display, dest, from, message_type, format, values)
2768 Lisp_Object display, dest, from, message_type, format, values;
2769 {
2770 struct x_display_info *dpyinfo = check_x_display_info (display);
2771 Window wdest;
2772 XEvent event;
2773 Lisp_Object cons;
2774 int size;
2775 struct frame *f = check_x_frame (from);
2776 int to_root;
2777
2778 CHECK_STRING (message_type);
2779 CHECK_NUMBER (format);
2780 CHECK_CONS (values);
2781
2782 if (x_check_property_data (values) == -1)
2783 error ("Bad data in VALUES, must be number, cons or string");
2784
2785 event.xclient.type = ClientMessage;
2786 event.xclient.format = XFASTINT (format);
2787
2788 if (event.xclient.format != 8 && event.xclient.format != 16
2789 && event.xclient.format != 32)
2790 error ("FORMAT must be one of 8, 16 or 32");
2791
2792 if (FRAMEP (dest) || NILP (dest))
2793 {
2794 struct frame *fdest = check_x_frame (dest);
2795 wdest = FRAME_OUTER_WINDOW (fdest);
2796 }
2797 else if (STRINGP (dest))
2798 {
2799 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2800 wdest = PointerWindow;
2801 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2802 wdest = InputFocus;
2803 else
2804 error ("DEST as a string must be one of PointerWindow or InputFocus");
2805 }
2806 else if (INTEGERP (dest))
2807 wdest = (Window) XFASTINT (dest);
2808 else if (FLOATP (dest))
2809 wdest = (Window) XFLOAT_DATA (dest);
2810 else if (CONSP (dest))
2811 {
2812 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2813 error ("Both car and cdr for DEST must be numbers");
2814 else
2815 wdest = (Window) cons_to_long (dest);
2816 }
2817 else
2818 error ("DEST must be a frame, nil, string, number or cons");
2819
2820 if (wdest == 0) wdest = dpyinfo->root_window;
2821 to_root = wdest == dpyinfo->root_window;
2822
2823 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2824 ;
2825
2826 BLOCK_INPUT;
2827
2828 event.xclient.message_type
2829 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2830 event.xclient.display = dpyinfo->display;
2831
2832 /* Some clients (metacity for example) expects sending window to be here
2833 when sending to the root window. */
2834 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2835
2836
2837 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2838 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2839 event.xclient.format);
2840
2841 /* If event mask is 0 the event is sent to the client that created
2842 the destination window. But if we are sending to the root window,
2843 there is no such client. Then we set the event mask to 0xffff. The
2844 event then goes to clients selecting for events on the root window. */
2845 x_catch_errors (dpyinfo->display);
2846 {
2847 int propagate = to_root ? False : True;
2848 unsigned mask = to_root ? 0xffff : 0;
2849 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2850 XFlush (dpyinfo->display);
2851 }
2852 x_uncatch_errors ();
2853 UNBLOCK_INPUT;
2854
2855 return Qnil;
2856 }
2857
2858 \f
2859 void
2860 syms_of_xselect ()
2861 {
2862 defsubr (&Sx_get_selection_internal);
2863 defsubr (&Sx_own_selection_internal);
2864 defsubr (&Sx_disown_selection_internal);
2865 defsubr (&Sx_selection_owner_p);
2866 defsubr (&Sx_selection_exists_p);
2867
2868 #ifdef CUT_BUFFER_SUPPORT
2869 defsubr (&Sx_get_cut_buffer_internal);
2870 defsubr (&Sx_store_cut_buffer_internal);
2871 defsubr (&Sx_rotate_cut_buffers_internal);
2872 #endif
2873
2874 defsubr (&Sx_get_atom_name);
2875 defsubr (&Sx_send_client_message);
2876
2877 reading_selection_reply = Fcons (Qnil, Qnil);
2878 staticpro (&reading_selection_reply);
2879 reading_selection_window = 0;
2880 reading_which_selection = 0;
2881
2882 property_change_wait_list = 0;
2883 prop_location_identifier = 0;
2884 property_change_reply = Fcons (Qnil, Qnil);
2885 staticpro (&property_change_reply);
2886
2887 Vselection_alist = Qnil;
2888 staticpro (&Vselection_alist);
2889
2890 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2891 doc: /* An alist associating X Windows selection-types with functions.
2892 These functions are called to convert the selection, with three args:
2893 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2894 a desired type to which the selection should be converted;
2895 and the local selection value (whatever was given to `x-own-selection').
2896
2897 The function should return the value to send to the X server
2898 \(typically a string). A return value of nil
2899 means that the conversion could not be done.
2900 A return value which is the symbol `NULL'
2901 means that a side-effect was executed,
2902 and there is no meaningful selection value. */);
2903 Vselection_converter_alist = Qnil;
2904
2905 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
2906 doc: /* A list of functions to be called when Emacs loses an X selection.
2907 \(This happens when some other X client makes its own selection
2908 or when a Lisp program explicitly clears the selection.)
2909 The functions are called with one argument, the selection type
2910 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2911 Vx_lost_selection_functions = Qnil;
2912
2913 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
2914 doc: /* A list of functions to be called when Emacs answers a selection request.
2915 The functions are called with four arguments:
2916 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2917 - the selection-type which Emacs was asked to convert the
2918 selection into before sending (for example, `STRING' or `LENGTH');
2919 - a flag indicating success or failure for responding to the request.
2920 We might have failed (and declined the request) for any number of reasons,
2921 including being asked for a selection that we no longer own, or being asked
2922 to convert into a type that we don't know about or that is inappropriate.
2923 This hook doesn't let you change the behavior of Emacs's selection replies,
2924 it merely informs you that they have happened. */);
2925 Vx_sent_selection_functions = Qnil;
2926
2927 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2928 doc: /* Coding system for communicating with other X clients.
2929 When sending or receiving text via cut_buffer, selection, and clipboard,
2930 the text is encoded or decoded by this coding system.
2931 The default value is `compound-text-with-extensions'. */);
2932 Vselection_coding_system = intern ("compound-text-with-extensions");
2933
2934 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2935 doc: /* Coding system for the next communication with other X clients.
2936 Usually, `selection-coding-system' is used for communicating with
2937 other X clients. But, if this variable is set, it is used for the
2938 next communication only. After the communication, this variable is
2939 set to nil. */);
2940 Vnext_selection_coding_system = Qnil;
2941
2942 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2943 doc: /* Number of milliseconds to wait for a selection reply.
2944 If the selection owner doesn't reply in this time, we give up.
2945 A value of 0 means wait as long as necessary. This is initialized from the
2946 \"*selectionTimeout\" resource. */);
2947 x_selection_timeout = 0;
2948
2949 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2950 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2951 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2952 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2953 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2954 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2955 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2956 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2957 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
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) */