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