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