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