1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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.
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.
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/>. */
20 /* Rewritten by jwz */
24 #include <stdio.h> /* termhooks.h needs this */
27 #ifdef HAVE_SYS_TYPES_H
28 #include <sys/types.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"
40 #include "termhooks.h"
42 #include "character.h"
44 #include <X11/Xproto.h>
47 struct selection_data
;
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
,
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
*,
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
);
80 /* Printing traces to stderr. */
82 #ifdef TRACE_SELECTION
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)
92 #define TRACE0(fmt) (void) 0
93 #define TRACE1(fmt, a0) (void) 0
94 #define TRACE2(fmt, a0, a1) (void) 0
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
;
102 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
103 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
105 static Lisp_Object Qcompound_text_with_extensions
;
107 static Lisp_Object Qforeign_selection
;
108 static Lisp_Object Qx_lost_selection_functions
, Qx_sent_selection_functions
;
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
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)
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.
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)))))
136 selection_quantum (Display
*display
)
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
);
144 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
145 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
148 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
151 struct selection_event_queue
153 struct input_event event
;
154 struct selection_event_queue
*next
;
157 static struct selection_event_queue
*selection_queue
;
159 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
161 static int x_queue_selection_requests
;
163 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
166 x_queue_event (struct input_event
*event
)
168 struct selection_event_queue
*queue_tmp
;
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
)
174 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
176 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
177 x_decline_selection_request (event
);
183 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
185 if (queue_tmp
!= NULL
)
187 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
188 queue_tmp
->event
= *event
;
189 queue_tmp
->next
= selection_queue
;
190 selection_queue
= queue_tmp
;
194 /* Start queuing SELECTION_REQUEST_EVENT events. */
197 x_start_queuing_selection_requests (void)
199 if (x_queue_selection_requests
)
202 x_queue_selection_requests
++;
203 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
206 /* Stop queuing SELECTION_REQUEST_EVENT events. */
209 x_stop_queuing_selection_requests (void)
211 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
212 --x_queue_selection_requests
;
214 /* Take all the queued events and put them back
215 so that they get processed afresh. */
217 while (selection_queue
!= NULL
)
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
);
228 /* This converts a Lisp symbol to a server Atom, avoiding a server
229 roundtrip whenever possible. */
232 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
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 ();
254 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
256 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
262 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
263 and calls to intern whenever possible. */
266 x_atom_to_symbol (Display
*dpy
, Atom atom
)
268 struct x_display_info
*dpyinfo
;
289 dpyinfo
= x_display_info_for_display (dpy
);
292 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
294 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
296 if (atom
== dpyinfo
->Xatom_TEXT
)
298 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
299 return QCOMPOUND_TEXT
;
300 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
302 if (atom
== dpyinfo
->Xatom_DELETE
)
304 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
306 if (atom
== dpyinfo
->Xatom_INCR
)
308 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
310 if (atom
== dpyinfo
->Xatom_TARGETS
)
312 if (atom
== dpyinfo
->Xatom_NULL
)
316 str
= XGetAtomName (dpy
, atom
);
318 TRACE1 ("XGetAtomName --> %s", str
);
319 if (! str
) return Qnil
;
322 /* This was allocated by Xlib, so use XFree. */
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
334 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
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
);
345 x_catch_errors (display
);
346 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
347 x_check_errors (display
, "Can't set selection: %s");
351 /* Now update the local cache */
353 Lisp_Object selection_data
;
354 Lisp_Object prev_value
;
356 selection_data
= list4 (selection_name
, selection_value
,
357 INTEGER_TO_CONS (timestamp
), frame
);
358 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
360 dpyinfo
->terminal
->Vselection_alist
361 = Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
);
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
))
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
))))
372 XSETCDR (rest
, XCDR (XCDR (rest
)));
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).
385 This calls random Lisp code, and may signal or gc. */
388 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
389 int local_request
, struct x_display_info
*dpyinfo
)
391 Lisp_Object local_value
;
392 Lisp_Object handler_fn
, value
, check
;
395 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
397 if (NILP (local_value
)) return Qnil
;
399 /* TIMESTAMP is a special case. */
400 if (EQ (target_type
, QTIMESTAMP
))
403 value
= XCAR (XCDR (XCDR (local_value
)));
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
);
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. */
418 if (!NILP (handler_fn
))
419 value
= call3 (handler_fn
,
420 selection_symbol
, (local_request
? Qnil
: target_type
),
421 XCAR (XCDR (local_value
)));
424 unbind_to (count
, Qnil
);
427 /* Make sure this value is of a type that we could transmit
428 to another X client. */
432 && SYMBOLP (XCAR (value
)))
433 check
= XCDR (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
))
446 (CONSP (XCDR (check
))
447 && INTEGERP (XCAR (XCDR (check
)))
448 && NILP (XCDR (XCDR (check
))))))
451 signal_error ("Invalid data returned by selection-conversion function",
452 list2 (handler_fn
, value
));
455 /* Subroutines of x_reply_selection_request. */
457 /* Send a SelectionNotify event to the requestor with property=None,
458 meaning we were unable to do what they wanted. */
461 x_decline_selection_request (struct input_event
*event
)
464 XSelectionEvent
*reply
= &(reply_base
.xselection
);
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
;
474 /* The reason for the error may be that the receiver has
475 died in the meantime. Handle that case. */
477 x_catch_errors (reply
->display
);
478 XSendEvent (reply
->display
, reply
->requestor
, False
, 0L, &reply_base
);
479 XFlush (reply
->display
);
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
;
488 /* Display info in x_selection_request. */
490 static struct x_display_info
*selection_request_dpyinfo
;
492 /* Raw selection data, for sending to a requestor window. */
494 struct selection_data
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
;
509 /* Linked list of the above (in support of MULTIPLE targets). */
511 static struct selection_data
*converted_selections
;
513 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
514 static Atom conversion_fail_tag
;
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. */
521 x_selection_request_lisp_error (Lisp_Object ignore
)
523 struct selection_data
*cs
, *next
;
525 for (cs
= converted_selections
; cs
; cs
= next
)
528 if (cs
->nofree
== 0 && cs
->data
)
532 converted_selections
= NULL
;
534 if (x_selection_current_request
!= 0
535 && selection_request_dpyinfo
->display
)
536 x_decline_selection_request (x_selection_current_request
);
541 x_catch_errors_unwind (Lisp_Object dummy
)
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. */
554 /* Keep a list of the property changes that are awaited. */
564 struct prop_location
*next
;
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
);
572 static int prop_location_identifier
;
574 static Lisp_Object property_change_reply
;
576 static struct prop_location
*property_change_reply_object
;
578 static struct prop_location
*property_change_wait_list
;
581 queue_selection_requests_unwind (Lisp_Object tem
)
583 x_stop_queuing_selection_requests ();
588 /* Send the reply to a selection request event EVENT. */
590 #ifdef TRACE_SELECTION
591 static int x_reply_selection_request_cnt
;
592 #endif /* TRACE_SELECTION */
595 x_reply_selection_request (struct input_event
*event
, struct x_display_info
*dpyinfo
)
598 XSelectionEvent
*reply
= &(reply_base
.xselection
);
599 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
600 Window window
= SELECTION_EVENT_REQUESTOR (event
);
601 ptrdiff_t bytes_remaining
;
602 int max_bytes
= selection_quantum (display
);
603 int count
= SPECPDL_INDEX ();
604 struct selection_data
*cs
;
606 reply
->type
= SelectionNotify
;
607 reply
->display
= display
;
608 reply
->requestor
= window
;
609 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
610 reply
->time
= SELECTION_EVENT_TIME (event
);
611 reply
->target
= SELECTION_EVENT_TARGET (event
);
612 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
613 if (reply
->property
== None
)
614 reply
->property
= reply
->target
;
617 /* The protected block contains wait_for_property_change, which can
618 run random lisp code (process handlers) or signal. Therefore, we
619 put the x_uncatch_errors call in an unwind. */
620 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
621 x_catch_errors (display
);
623 /* Loop over converted selections, storing them in the requested
624 properties. If data is large, only store the first N bytes
625 (section 2.7.2 of ICCCM). Note that we store the data for a
626 MULTIPLE request in the opposite order; the ICCM says only that
627 the conversion itself must be done in the same order. */
628 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
630 if (cs
->property
== None
)
633 bytes_remaining
= cs
->size
;
634 bytes_remaining
*= cs
->format
>> 3;
635 if (bytes_remaining
<= max_bytes
)
637 /* Send all the data at once, with minimal handshaking. */
638 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
639 XChangeProperty (display
, window
, cs
->property
,
640 cs
->type
, cs
->format
, PropModeReplace
,
645 /* Send an INCR tag to initiate incremental transfer. */
648 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
649 bytes_remaining
, XGetAtomName (display
, cs
->property
));
651 = expect_property_change (display
, window
, cs
->property
,
654 /* XChangeProperty expects an array of long even if long is
655 more than 32 bits. */
656 value
[0] = min (bytes_remaining
, X_LONG_MAX
);
657 XChangeProperty (display
, window
, cs
->property
,
658 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
659 (unsigned char *) value
, 1);
660 XSelectInput (display
, window
, PropertyChangeMask
);
664 /* Now issue the SelectionNotify event. */
665 XSendEvent (display
, window
, False
, 0L, &reply_base
);
668 #ifdef TRACE_SELECTION
670 char *sel
= XGetAtomName (display
, reply
->selection
);
671 char *tgt
= XGetAtomName (display
, reply
->target
);
672 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
673 sel
, tgt
, ++x_reply_selection_request_cnt
);
674 if (sel
) XFree (sel
);
675 if (tgt
) XFree (tgt
);
677 #endif /* TRACE_SELECTION */
679 /* Finish sending the rest of each of the INCR values. This should
680 be improved; there's a chance of deadlock if more than one
681 subtarget in a MULTIPLE selection requires an INCR transfer, and
682 the requestor and Emacs loop waiting on different transfers. */
683 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
686 int format_bytes
= cs
->format
/ 8;
687 int had_errors
= x_had_errors_p (display
);
690 bytes_remaining
= cs
->size
;
691 bytes_remaining
*= format_bytes
;
693 /* Wait for the requester to ack by deleting the property.
694 This can run Lisp code (process handlers) or signal. */
697 TRACE1 ("Waiting for ACK (deletion of %s)",
698 XGetAtomName (display
, cs
->property
));
699 wait_for_property_change (cs
->wait_object
);
702 unexpect_property_change (cs
->wait_object
);
704 while (bytes_remaining
)
706 int i
= ((bytes_remaining
< max_bytes
)
708 : max_bytes
) / format_bytes
;
712 = expect_property_change (display
, window
, cs
->property
,
715 TRACE1 ("Sending increment of %d elements", i
);
716 TRACE1 ("Set %s to increment data",
717 XGetAtomName (display
, cs
->property
));
719 /* Append the next chunk of data to the property. */
720 XChangeProperty (display
, window
, cs
->property
,
721 cs
->type
, cs
->format
, PropModeAppend
,
723 bytes_remaining
-= i
* format_bytes
;
724 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
727 had_errors
= x_had_errors_p (display
);
730 if (had_errors
) break;
732 /* Wait for the requester to ack this chunk by deleting
733 the property. This can run Lisp code or signal. */
734 TRACE1 ("Waiting for increment ACK (deletion of %s)",
735 XGetAtomName (display
, cs
->property
));
736 wait_for_property_change (cs
->wait_object
);
739 /* Now write a zero-length chunk to the property to tell the
740 requester that we're done. */
742 if (! waiting_for_other_props_on_window (display
, window
))
743 XSelectInput (display
, window
, 0L);
745 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
746 XGetAtomName (display
, cs
->property
));
747 XChangeProperty (display
, window
, cs
->property
,
748 cs
->type
, cs
->format
, PropModeReplace
,
750 TRACE0 ("Done sending incrementally");
753 /* rms, 2003-01-03: I think I have fixed this bug. */
754 /* The window we're communicating with may have been deleted
755 in the meantime (that's a real situation from a bug report).
756 In this case, there may be events in the event queue still
757 refering to the deleted window, and we'll get a BadWindow error
758 in XTread_socket when processing the events. I don't have
759 an idea how to fix that. gerd, 2001-01-98. */
760 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
761 delivered before uncatch errors. */
762 XSync (display
, False
);
765 /* GTK queues events in addition to the queue in Xlib. So we
766 UNBLOCK to enter the event loop and get possible errors delivered,
767 and then BLOCK again because x_uncatch_errors requires it. */
769 /* This calls x_uncatch_errors. */
770 unbind_to (count
, Qnil
);
774 /* Handle a SelectionRequest event EVENT.
775 This is called from keyboard.c when such an event is found in the queue. */
778 x_handle_selection_request (struct input_event
*event
)
780 struct gcpro gcpro1
, gcpro2
;
781 Time local_selection_time
;
783 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
784 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
785 Atom selection
= SELECTION_EVENT_SELECTION (event
);
786 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
787 Atom target
= SELECTION_EVENT_TARGET (event
);
788 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
789 Atom property
= SELECTION_EVENT_PROPERTY (event
);
790 Lisp_Object local_selection_data
;
792 int count
= SPECPDL_INDEX ();
793 GCPRO2 (local_selection_data
, target_symbol
);
795 if (!dpyinfo
) goto DONE
;
797 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
799 /* Decline if we don't own any selections. */
800 if (NILP (local_selection_data
)) goto DONE
;
802 /* Decline requests issued prior to our acquiring the selection. */
803 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
804 Time
, local_selection_time
);
805 if (SELECTION_EVENT_TIME (event
) != CurrentTime
806 && local_selection_time
> SELECTION_EVENT_TIME (event
))
809 x_selection_current_request
= event
;
810 selection_request_dpyinfo
= dpyinfo
;
811 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
813 /* We might be able to handle nested x_handle_selection_requests,
814 but this is difficult to test, and seems unimportant. */
815 x_start_queuing_selection_requests ();
816 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
818 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
819 SDATA (SYMBOL_NAME (selection_symbol
)),
820 SDATA (SYMBOL_NAME (target_symbol
)));
822 if (EQ (target_symbol
, QMULTIPLE
))
824 /* For MULTIPLE targets, the event property names a list of atom
825 pairs; the first atom names a target and the second names a
826 non-None property. */
827 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
828 Lisp_Object multprop
;
829 ptrdiff_t j
, nselections
;
831 if (property
== None
) goto DONE
;
833 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
834 QMULTIPLE
, selection
);
836 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
839 nselections
= ASIZE (multprop
) / 2;
840 /* Perform conversions. This can signal. */
841 for (j
= 0; j
< nselections
; j
++)
843 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
844 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
845 AREF (multprop
, 2*j
+1));
847 if (subproperty
!= None
)
848 x_convert_selection (event
, selection_symbol
, subtarget
,
849 subproperty
, 1, dpyinfo
);
855 if (property
== None
)
856 property
= SELECTION_EVENT_TARGET (event
);
857 success
= x_convert_selection (event
, selection_symbol
,
858 target_symbol
, property
,
865 x_reply_selection_request (event
, dpyinfo
);
867 x_decline_selection_request (event
);
868 x_selection_current_request
= 0;
870 /* Run the `x-sent-selection-functions' abnormal hook. */
871 if (!NILP (Vx_sent_selection_functions
)
872 && !EQ (Vx_sent_selection_functions
, Qunbound
))
875 args
[0] = Qx_sent_selection_functions
;
876 args
[1] = selection_symbol
;
877 args
[2] = target_symbol
;
878 args
[3] = success
? Qt
: Qnil
;
879 Frun_hook_with_args (4, args
);
882 unbind_to (count
, Qnil
);
886 /* Perform the requested selection conversion, and write the data to
887 the converted_selections linked list, where it can be accessed by
888 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
889 the data even if conversion fails, using conversion_fail_tag.
891 Return 0 if the selection failed to convert, 1 otherwise. */
894 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
895 Lisp_Object target_symbol
, Atom property
,
896 int for_multiple
, struct x_display_info
*dpyinfo
)
899 Lisp_Object lisp_selection
;
900 struct selection_data
*cs
;
901 GCPRO1 (lisp_selection
);
904 = x_get_local_selection (selection_symbol
, target_symbol
,
907 /* A nil return value means we can't perform the conversion. */
908 if (NILP (lisp_selection
)
909 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
913 cs
= xmalloc (sizeof (struct selection_data
));
914 cs
->data
= (unsigned char *) &conversion_fail_tag
;
919 cs
->property
= property
;
920 cs
->wait_object
= NULL
;
921 cs
->next
= converted_selections
;
922 converted_selections
= cs
;
929 /* Otherwise, record the converted selection to binary. */
930 cs
= xmalloc (sizeof (struct selection_data
));
932 cs
->property
= property
;
933 cs
->wait_object
= NULL
;
934 cs
->next
= converted_selections
;
935 converted_selections
= cs
;
936 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
938 &(cs
->data
), &(cs
->type
),
939 &(cs
->size
), &(cs
->format
),
945 /* Handle a SelectionClear event EVENT, which indicates that some
946 client cleared out our previously asserted selection.
947 This is called from keyboard.c when such an event is found in the queue. */
950 x_handle_selection_clear (struct input_event
*event
)
952 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
953 Atom selection
= SELECTION_EVENT_SELECTION (event
);
954 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
956 Lisp_Object selection_symbol
, local_selection_data
;
957 Time local_selection_time
;
958 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
959 Lisp_Object Vselection_alist
;
961 TRACE0 ("x_handle_selection_clear");
963 if (!dpyinfo
) return;
965 selection_symbol
= x_atom_to_symbol (display
, selection
);
966 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
968 /* Well, we already believe that we don't own it, so that's just fine. */
969 if (NILP (local_selection_data
)) return;
971 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
972 Time
, local_selection_time
);
974 /* We have reasserted the selection since this SelectionClear was
975 generated, so we can disregard it. */
976 if (changed_owner_time
!= CurrentTime
977 && local_selection_time
> changed_owner_time
)
980 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
981 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
982 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
983 Vselection_alist
= XCDR (Vselection_alist
);
987 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
988 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
990 XSETCDR (rest
, XCDR (XCDR (rest
)));
994 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
996 /* Run the `x-lost-selection-functions' abnormal hook. */
999 args
[0] = Qx_lost_selection_functions
;
1000 args
[1] = selection_symbol
;
1001 Frun_hook_with_args (2, args
);
1004 prepare_menu_bars ();
1005 redisplay_preserve_echo_area (20);
1009 x_handle_selection_event (struct input_event
*event
)
1011 TRACE0 ("x_handle_selection_event");
1012 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
1013 x_handle_selection_clear (event
);
1014 else if (x_queue_selection_requests
)
1015 x_queue_event (event
);
1017 x_handle_selection_request (event
);
1021 /* Clear all selections that were made from frame F.
1022 We do this when about to delete a frame. */
1025 x_clear_frame_selections (FRAME_PTR f
)
1029 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1030 struct terminal
*t
= dpyinfo
->terminal
;
1032 XSETFRAME (frame
, f
);
1034 /* Delete elements from the beginning of Vselection_alist. */
1035 while (CONSP (t
->Vselection_alist
)
1036 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1038 /* Run the `x-lost-selection-functions' abnormal hook. */
1039 Lisp_Object args
[2];
1040 args
[0] = Qx_lost_selection_functions
;
1041 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1042 Frun_hook_with_args (2, args
);
1044 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
1047 /* Delete elements after the beginning of Vselection_alist. */
1048 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1049 if (CONSP (XCDR (rest
))
1050 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1052 Lisp_Object args
[2];
1053 args
[0] = Qx_lost_selection_functions
;
1054 args
[1] = XCAR (XCAR (XCDR (rest
)));
1055 Frun_hook_with_args (2, args
);
1056 XSETCDR (rest
, XCDR (XCDR (rest
)));
1061 /* Nonzero if any properties for DISPLAY and WINDOW
1062 are on the list of what we are waiting for. */
1065 waiting_for_other_props_on_window (Display
*display
, Window window
)
1067 struct prop_location
*rest
= property_change_wait_list
;
1069 if (rest
->display
== display
&& rest
->window
== window
)
1076 /* Add an entry to the list of property changes we are waiting for.
1077 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1078 The return value is a number that uniquely identifies
1079 this awaited property change. */
1081 static struct prop_location
*
1082 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1084 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1085 pl
->identifier
= ++prop_location_identifier
;
1086 pl
->display
= display
;
1087 pl
->window
= window
;
1088 pl
->property
= property
;
1089 pl
->desired_state
= state
;
1090 pl
->next
= property_change_wait_list
;
1092 property_change_wait_list
= pl
;
1096 /* Delete an entry from the list of property changes we are waiting for.
1097 IDENTIFIER is the number that uniquely identifies the entry. */
1100 unexpect_property_change (struct prop_location
*location
)
1102 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1105 if (rest
== location
)
1108 prev
->next
= rest
->next
;
1110 property_change_wait_list
= rest
->next
;
1119 /* Remove the property change expectation element for IDENTIFIER. */
1122 wait_for_property_change_unwind (Lisp_Object loc
)
1124 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1126 unexpect_property_change (location
);
1127 if (location
== property_change_reply_object
)
1128 property_change_reply_object
= 0;
1132 /* Actually wait for a property change.
1133 IDENTIFIER should be the value that expect_property_change returned. */
1136 wait_for_property_change (struct prop_location
*location
)
1139 int count
= SPECPDL_INDEX ();
1141 if (property_change_reply_object
)
1144 /* Make sure to do unexpect_property_change if we quit or err. */
1145 record_unwind_protect (wait_for_property_change_unwind
,
1146 make_save_value (location
, 0));
1148 XSETCAR (property_change_reply
, Qnil
);
1149 property_change_reply_object
= location
;
1151 /* If the event we are waiting for arrives beyond here, it will set
1152 property_change_reply, because property_change_reply_object says so. */
1153 if (! location
->arrived
)
1155 secs
= x_selection_timeout
/ 1000;
1156 usecs
= (x_selection_timeout
% 1000) * 1000;
1157 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1158 wait_reading_process_output (secs
, usecs
, 0, 0,
1159 property_change_reply
, NULL
, 0);
1161 if (NILP (XCAR (property_change_reply
)))
1163 TRACE0 (" Timed out");
1164 error ("Timed out waiting for property-notify event");
1168 unbind_to (count
, Qnil
);
1171 /* Called from XTread_socket in response to a PropertyNotify event. */
1174 x_handle_property_notify (XPropertyEvent
*event
)
1176 struct prop_location
*rest
;
1178 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1181 && rest
->property
== event
->atom
1182 && rest
->window
== event
->window
1183 && rest
->display
== event
->display
1184 && rest
->desired_state
== event
->state
)
1186 TRACE2 ("Expected %s of property %s",
1187 (event
->state
== PropertyDelete
? "deletion" : "change"),
1188 XGetAtomName (event
->display
, event
->atom
));
1192 /* If this is the one wait_for_property_change is waiting for,
1193 tell it to wake up. */
1194 if (rest
== property_change_reply_object
)
1195 XSETCAR (property_change_reply
, Qt
);
1204 /* Variables for communication with x_handle_selection_notify. */
1205 static Atom reading_which_selection
;
1206 static Lisp_Object reading_selection_reply
;
1207 static Window reading_selection_window
;
1209 /* Do protocol to read selection-data from the server.
1210 Converts this to Lisp data and returns it.
1211 FRAME is the frame whose X window shall request the selection. */
1214 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1215 Lisp_Object time_stamp
, Lisp_Object frame
)
1217 struct frame
*f
= XFRAME (frame
);
1218 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1219 Display
*display
= dpyinfo
->display
;
1220 Window requestor_window
= FRAME_X_WINDOW (f
);
1221 Time requestor_time
= last_event_timestamp
;
1222 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1223 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1224 Atom type_atom
= (CONSP (target_type
)
1225 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1226 : symbol_to_x_atom (dpyinfo
, target_type
));
1229 if (!FRAME_LIVE_P (f
))
1232 if (! NILP (time_stamp
))
1233 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1236 TRACE2 ("Get selection %s, type %s",
1237 XGetAtomName (display
, type_atom
),
1238 XGetAtomName (display
, target_property
));
1240 x_catch_errors (display
);
1241 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1242 requestor_window
, requestor_time
);
1243 x_check_errors (display
, "Can't convert selection: %s");
1244 x_uncatch_errors ();
1246 /* Prepare to block until the reply has been read. */
1247 reading_selection_window
= requestor_window
;
1248 reading_which_selection
= selection_atom
;
1249 XSETCAR (reading_selection_reply
, Qnil
);
1251 /* It should not be necessary to stop handling selection requests
1252 during this time. In fact, the SAVE_TARGETS mechanism requires
1253 us to handle a clipboard manager's requests before it returns
1256 x_start_queuing_selection_requests ();
1257 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1262 /* This allows quits. Also, don't wait forever. */
1263 secs
= x_selection_timeout
/ 1000;
1264 usecs
= (x_selection_timeout
% 1000) * 1000;
1265 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1266 wait_reading_process_output (secs
, usecs
, 0, 0,
1267 reading_selection_reply
, NULL
, 0);
1268 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1270 if (NILP (XCAR (reading_selection_reply
)))
1271 error ("Timed out waiting for reply from selection owner");
1272 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1275 /* Otherwise, the selection is waiting for us on the requested property. */
1277 x_get_window_property_as_lisp_data (display
, requestor_window
,
1278 target_property
, target_type
,
1282 /* Subroutines of x_get_window_property_as_lisp_data */
1284 /* Use xfree, not XFree, to free the data obtained with this function. */
1287 x_get_window_property (Display
*display
, Window window
, Atom property
,
1288 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1289 Atom
*actual_type_ret
, int *actual_format_ret
,
1290 unsigned long *actual_size_ret
, int delete_p
)
1292 ptrdiff_t total_size
;
1293 unsigned long bytes_remaining
;
1294 ptrdiff_t offset
= 0;
1295 unsigned char *data
= 0;
1296 unsigned char *tmp_data
= 0;
1298 int buffer_size
= selection_quantum (display
);
1300 /* Wide enough to avoid overflow in expressions using it. */
1301 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1303 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1304 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1305 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1306 ptrdiff_t total_size_max
=
1307 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1308 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1309 : LONG_MAX
* x_long_size
);
1313 /* First probe the thing to find out how big it is. */
1314 result
= XGetWindowProperty (display
, window
, property
,
1315 0L, 0L, False
, AnyPropertyType
,
1316 actual_type_ret
, actual_format_ret
,
1318 &bytes_remaining
, &tmp_data
);
1319 if (result
!= Success
)
1322 /* This was allocated by Xlib, so use XFree. */
1323 XFree ((char *) tmp_data
);
1325 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1328 if (total_size_max
< bytes_remaining
)
1330 total_size
= bytes_remaining
;
1331 data
= malloc (total_size
+ 1);
1333 goto memory_exhausted
;
1335 /* Now read, until we've gotten it all. */
1336 while (bytes_remaining
)
1338 ptrdiff_t bytes_gotten
;
1341 = XGetWindowProperty (display
, window
, property
,
1342 offset
/ X_LONG_SIZE
,
1343 buffer_size
/ X_LONG_SIZE
,
1346 actual_type_ret
, actual_format_ret
,
1347 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1349 /* If this doesn't return Success at this point, it means that
1350 some clod deleted the selection while we were in the midst of
1351 reading it. Deal with that, I guess.... */
1352 if (result
!= Success
)
1355 bytes_per_item
= *actual_format_ret
>> 3;
1356 xassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1358 /* The man page for XGetWindowProperty says:
1359 "If the returned format is 32, the returned data is represented
1360 as a long array and should be cast to that type to obtain the
1362 This applies even if long is more than 32 bits, the X library
1363 converts from 32 bit elements received from the X server to long
1364 and passes the long array to us. Thus, for that case memcpy can not
1365 be used. We convert to a 32 bit type here, because so much code
1368 The bytes and offsets passed to XGetWindowProperty refers to the
1369 property and those are indeed in 32 bit quantities if format is 32. */
1371 bytes_gotten
= *actual_size_ret
;
1372 bytes_gotten
*= bytes_per_item
;
1374 TRACE2 ("Read %"pD
"d bytes from property %s",
1375 bytes_gotten
, XGetAtomName (display
, property
));
1377 if (total_size
- offset
< bytes_gotten
)
1379 unsigned char *data1
;
1380 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1381 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1383 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1384 data1
= realloc (data
, total_size
+ 1);
1386 goto memory_exhausted
;
1390 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1393 int *idata
= (int *) (data
+ offset
);
1394 long *ldata
= (long *) tmp_data
;
1396 for (i
= 0; i
< *actual_size_ret
; ++i
)
1397 idata
[i
] = ldata
[i
];
1400 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1402 offset
+= bytes_gotten
;
1404 /* This was allocated by Xlib, so use XFree. */
1405 XFree ((char *) tmp_data
);
1409 data
[offset
] = '\0';
1414 *bytes_ret
= offset
;
1420 memory_full (SIZE_MAX
);
1425 memory_full (total_size
+ 1);
1428 /* Use xfree, not XFree, to free the data obtained with this function. */
1431 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1432 Lisp_Object target_type
,
1433 unsigned int min_size_bytes
,
1434 unsigned char **data_ret
,
1435 ptrdiff_t *size_bytes_ret
,
1436 Atom
*type_ret
, int *format_ret
,
1437 unsigned long *size_ret
)
1439 ptrdiff_t offset
= 0;
1440 struct prop_location
*wait_object
;
1441 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1442 memory_full (SIZE_MAX
);
1443 *data_ret
= (unsigned char *) xmalloc (min_size_bytes
);
1444 *size_bytes_ret
= min_size_bytes
;
1446 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1448 /* At this point, we have read an INCR property.
1449 Delete the property to ack it.
1450 (But first, prepare to receive the next event in this handshake.)
1452 Now, we must loop, waiting for the sending window to put a value on
1453 that property, then reading the property, then deleting it to ack.
1454 We are done when the sender places a property of length 0.
1457 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1458 TRACE1 (" Delete property %s",
1459 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1460 XDeleteProperty (display
, window
, property
);
1461 TRACE1 (" Expect new value of property %s",
1462 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1463 wait_object
= expect_property_change (display
, window
, property
,
1470 unsigned char *tmp_data
;
1471 ptrdiff_t tmp_size_bytes
;
1473 TRACE0 (" Wait for property change");
1474 wait_for_property_change (wait_object
);
1476 /* expect it again immediately, because x_get_window_property may
1477 .. no it won't, I don't get it.
1478 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1479 TRACE0 (" Get property value");
1480 x_get_window_property (display
, window
, property
,
1481 &tmp_data
, &tmp_size_bytes
,
1482 type_ret
, format_ret
, size_ret
, 1);
1484 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1486 if (tmp_size_bytes
== 0) /* we're done */
1488 TRACE0 ("Done reading incrementally");
1490 if (! waiting_for_other_props_on_window (display
, window
))
1491 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1492 /* Use xfree, not XFree, because x_get_window_property
1493 calls xmalloc itself. */
1499 TRACE1 (" ACK by deleting property %s",
1500 XGetAtomName (display
, property
));
1501 XDeleteProperty (display
, window
, property
);
1502 wait_object
= expect_property_change (display
, window
, property
,
1507 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1508 *data_ret
= xpalloc (*data_ret
, size_bytes_ret
,
1509 tmp_size_bytes
- (*size_bytes_ret
- offset
),
1512 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1513 offset
+= tmp_size_bytes
;
1515 /* Use xfree, not XFree, because x_get_window_property
1516 calls xmalloc itself. */
1522 /* Fetch a value from property PROPERTY of X window WINDOW on display
1523 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1527 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1529 Lisp_Object target_type
,
1530 Atom selection_atom
)
1534 unsigned long actual_size
;
1535 unsigned char *data
= 0;
1536 ptrdiff_t bytes
= 0;
1538 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1540 TRACE0 ("Reading selection data");
1542 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1543 &actual_type
, &actual_format
, &actual_size
, 1);
1546 int there_is_a_selection_owner
;
1548 there_is_a_selection_owner
1549 = XGetSelectionOwner (display
, selection_atom
);
1551 if (there_is_a_selection_owner
)
1552 signal_error ("Selection owner couldn't convert",
1554 ? list2 (target_type
,
1555 x_atom_to_symbol (display
, actual_type
))
1558 signal_error ("No selection",
1559 x_atom_to_symbol (display
, selection_atom
));
1562 if (actual_type
== dpyinfo
->Xatom_INCR
)
1564 /* That wasn't really the data, just the beginning. */
1566 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1568 /* Use xfree, not XFree, because x_get_window_property
1569 calls xmalloc itself. */
1570 xfree ((char *) data
);
1572 receive_incremental_selection (display
, window
, property
, target_type
,
1573 min_size_bytes
, &data
, &bytes
,
1574 &actual_type
, &actual_format
,
1579 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1580 XDeleteProperty (display
, window
, property
);
1584 /* It's been read. Now convert it to a lisp object in some semi-rational
1586 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1587 actual_type
, actual_format
);
1589 /* Use xfree, not XFree, because x_get_window_property
1590 calls xmalloc itself. */
1591 xfree ((char *) data
);
1595 /* These functions convert from the selection data read from the server into
1596 something that we can use from Lisp, and vice versa.
1598 Type: Format: Size: Lisp Type:
1599 ----- ------- ----- -----------
1602 ATOM 32 > 1 Vector of Symbols
1604 * 16 > 1 Vector of Integers
1605 * 32 1 if <=16 bits: Integer
1606 if > 16 bits: Cons of top16, bot16
1607 * 32 > 1 Vector of the above
1609 When converting a Lisp number to C, it is assumed to be of format 16 if
1610 it is an integer, and of format 32 if it is a cons of two integers.
1612 When converting a vector of numbers from Lisp to C, it is assumed to be
1613 of format 16 if every element in the vector is an integer, and is assumed
1614 to be of format 32 if any element is a cons of two integers.
1616 When converting an object to C, it may be of the form (SYMBOL . <data>)
1617 where SYMBOL is what we should claim that the type is. Format and
1618 representation are as above.
1620 Important: When format is 32, data should contain an array of int,
1621 not an array of long as the X library returns. This makes a difference
1622 when sizeof(long) != sizeof(int). */
1627 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1628 ptrdiff_t size
, Atom type
, int format
)
1630 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1632 if (type
== dpyinfo
->Xatom_NULL
)
1635 /* Convert any 8-bit data to a string, for compactness. */
1636 else if (format
== 8)
1638 Lisp_Object str
, lispy_type
;
1640 str
= make_unibyte_string ((char *) data
, size
);
1641 /* Indicate that this string is from foreign selection by a text
1642 property `foreign-selection' so that the caller of
1643 x-get-selection-internal (usually x-get-selection) can know
1644 that the string must be decode. */
1645 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1646 lispy_type
= QCOMPOUND_TEXT
;
1647 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1648 lispy_type
= QUTF8_STRING
;
1650 lispy_type
= QSTRING
;
1651 Fput_text_property (make_number (0), make_number (size
),
1652 Qforeign_selection
, lispy_type
, str
);
1655 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1656 a vector of symbols. */
1657 else if (type
== XA_ATOM
1658 /* Treat ATOM_PAIR type similar to list of atoms. */
1659 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1662 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1663 But the callers of these function has made sure the data for
1664 format == 32 is an array of int. Thus, use int instead
1666 int *idata
= (int *) data
;
1668 if (size
== sizeof (int))
1669 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1672 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1674 for (i
= 0; i
< size
/ sizeof (int); i
++)
1675 Faset (v
, make_number (i
),
1676 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1681 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1682 If the number is 32 bits and won't fit in a Lisp_Int,
1683 convert it to a cons of integers, 16 bits in each half.
1685 else if (format
== 32 && size
== sizeof (int))
1686 return INTEGER_TO_CONS (((unsigned int *) data
) [0]);
1687 else if (format
== 16 && size
== sizeof (short))
1688 return make_number (((unsigned short *) data
) [0]);
1690 /* Convert any other kind of data to a vector of numbers, represented
1691 as above (as an integer, or a cons of two 16 bit integers.)
1693 else if (format
== 16)
1697 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1698 for (i
= 0; i
< size
/ 2; i
++)
1700 EMACS_INT j
= ((unsigned short *) data
) [i
];
1701 Faset (v
, make_number (i
), make_number (j
));
1708 Lisp_Object v
= Fmake_vector (make_number (size
/ X_LONG_SIZE
),
1710 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1712 unsigned int j
= ((unsigned int *) data
) [i
];
1713 Faset (v
, make_number (i
), INTEGER_TO_CONS (j
));
1720 /* Use xfree, not XFree, to free the data obtained with this function. */
1723 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1724 unsigned char **data_ret
, Atom
*type_ret
,
1725 ptrdiff_t *size_ret
,
1726 int *format_ret
, int *nofree_ret
)
1728 Lisp_Object type
= Qnil
;
1729 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1733 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1737 if (CONSP (obj
) && NILP (XCDR (obj
)))
1741 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1742 { /* This is not the same as declining */
1748 else if (STRINGP (obj
))
1750 if (SCHARS (obj
) < SBYTES (obj
))
1751 /* OBJ is a multibyte string containing a non-ASCII char. */
1752 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1756 *size_ret
= SBYTES (obj
);
1757 *data_ret
= SDATA (obj
);
1760 else if (SYMBOLP (obj
))
1762 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1765 (*data_ret
) [sizeof (Atom
)] = 0;
1766 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1767 if (NILP (type
)) type
= QATOM
;
1769 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1771 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1774 (*data_ret
) [sizeof (short)] = 0;
1775 (*(short **) data_ret
) [0] = XINT (obj
);
1776 if (NILP (type
)) type
= QINTEGER
;
1778 else if (INTEGERP (obj
)
1779 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1780 && (INTEGERP (XCDR (obj
))
1781 || (CONSP (XCDR (obj
))
1782 && INTEGERP (XCAR (XCDR (obj
)))))))
1784 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1787 (*data_ret
) [sizeof (long)] = 0;
1788 (*(long **) data_ret
) [0] = cons_to_signed (obj
, X_LONG_MIN
, X_LONG_MAX
);
1789 if (NILP (type
)) type
= QINTEGER
;
1791 else if (VECTORP (obj
))
1793 /* Lisp_Vectors may represent a set of ATOMs;
1794 a set of 16 or 32 bit INTEGERs;
1795 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1798 ptrdiff_t size
= ASIZE (obj
);
1800 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1801 /* This vector is an ATOM set */
1803 if (NILP (type
)) type
= QATOM
;
1804 for (i
= 0; i
< size
; i
++)
1805 if (!SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1806 signal_error ("All elements of selection vector must have same type", obj
);
1808 *data_ret
= xnmalloc (size
, sizeof (Atom
));
1811 for (i
= 0; i
< size
; i
++)
1812 (*(Atom
**) data_ret
) [i
]
1813 = symbol_to_x_atom (dpyinfo
, XVECTOR (obj
)->contents
[i
]);
1816 /* This vector is an INTEGER set, or something like it */
1819 int data_size
= sizeof (short);
1820 if (NILP (type
)) type
= QINTEGER
;
1821 for (i
= 0; i
< size
; i
++)
1823 intmax_t v
= cons_to_signed (XVECTOR (obj
)->contents
[i
],
1824 X_LONG_MIN
, X_LONG_MAX
);
1825 if (X_SHRT_MIN
<= v
&& v
<= X_SHRT_MAX
)
1827 /* Use sizeof (long) even if it is more than 32 bits.
1828 See comment in x_get_window_property and
1829 x_fill_property_data. */
1830 data_size
= sizeof (long);
1834 *data_ret
= xnmalloc (size
, data_size
);
1835 *format_ret
= format
;
1837 for (i
= 0; i
< size
; i
++)
1839 long v
= cons_to_signed (XVECTOR (obj
)->contents
[i
],
1840 X_LONG_MIN
, X_LONG_MAX
);
1842 (*((long **) data_ret
)) [i
] = v
;
1844 (*((short **) data_ret
)) [i
] = v
;
1849 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1851 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1855 clean_local_selection_data (Lisp_Object obj
)
1858 && INTEGERP (XCAR (obj
))
1859 && CONSP (XCDR (obj
))
1860 && INTEGERP (XCAR (XCDR (obj
)))
1861 && NILP (XCDR (XCDR (obj
))))
1862 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1865 && INTEGERP (XCAR (obj
))
1866 && INTEGERP (XCDR (obj
)))
1868 if (XINT (XCAR (obj
)) == 0)
1870 if (XINT (XCAR (obj
)) == -1)
1871 return make_number (- XINT (XCDR (obj
)));
1876 ptrdiff_t size
= ASIZE (obj
);
1879 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1880 copy
= Fmake_vector (make_number (size
), Qnil
);
1881 for (i
= 0; i
< size
; i
++)
1882 XVECTOR (copy
)->contents
[i
]
1883 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1889 /* Called from XTread_socket to handle SelectionNotify events.
1890 If it's the selection we are waiting for, stop waiting
1891 by setting the car of reading_selection_reply to non-nil.
1892 We store t there if the reply is successful, lambda if not. */
1895 x_handle_selection_notify (XSelectionEvent
*event
)
1897 if (event
->requestor
!= reading_selection_window
)
1899 if (event
->selection
!= reading_which_selection
)
1902 TRACE0 ("Received SelectionNotify");
1903 XSETCAR (reading_selection_reply
,
1904 (event
->property
!= 0 ? Qt
: Qlambda
));
1908 /* From a Lisp_Object, return a suitable frame for selection
1909 operations. OBJECT may be a frame, a terminal object, or nil
1910 (which stands for the selected frame--or, if that is not an X
1911 frame, the first X display on the list). If no suitable frame can
1912 be found, return NULL. */
1914 static struct frame
*
1915 frame_for_x_selection (Lisp_Object object
)
1922 f
= XFRAME (selected_frame
);
1923 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1926 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1928 f
= XFRAME (XCAR (tail
));
1929 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1933 else if (TERMINALP (object
))
1935 struct terminal
*t
= get_terminal (object
, 1);
1936 if (t
->type
== output_x_window
)
1938 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1940 f
= XFRAME (XCAR (tail
));
1941 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1946 else if (FRAMEP (object
))
1948 f
= XFRAME (object
);
1949 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1957 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1958 Sx_own_selection_internal
, 2, 3, 0,
1959 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1960 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1961 \(Those are literal upper-case symbol names, since that's what X expects.)
1962 VALUE is typically a string, or a cons of two markers, but may be
1963 anything that the functions on `selection-converter-alist' know about.
1965 FRAME should be a frame that should own the selection. If omitted or
1966 nil, it defaults to the selected frame. */)
1967 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1969 if (NILP (frame
)) frame
= selected_frame
;
1970 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1971 error ("X selection unavailable for this frame");
1973 CHECK_SYMBOL (selection
);
1974 if (NILP (value
)) error ("VALUE may not be nil");
1975 x_own_selection (selection
, value
, frame
);
1980 /* Request the selection value from the owner. If we are the owner,
1981 simply return our selection value. If we are not the owner, this
1982 will block until all of the data has arrived. */
1984 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1985 Sx_get_selection_internal
, 2, 4, 0,
1986 doc
: /* Return text selected from some X window.
1987 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1988 \(Those are literal upper-case symbol names, since that's what X expects.)
1989 TYPE is the type of data desired, typically `STRING'.
1990 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1991 selections. If omitted, defaults to the time for the last event.
1993 TERMINAL should be a terminal object or a frame specifying the X
1994 server to query. If omitted or nil, that stands for the selected
1995 frame's display, or the first available X display. */)
1996 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1997 Lisp_Object time_stamp
, Lisp_Object terminal
)
1999 Lisp_Object val
= Qnil
;
2000 struct gcpro gcpro1
, gcpro2
;
2001 struct frame
*f
= frame_for_x_selection (terminal
);
2002 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2004 CHECK_SYMBOL (selection_symbol
);
2005 CHECK_SYMBOL (target_type
);
2006 if (EQ (target_type
, QMULTIPLE
))
2007 error ("Retrieving MULTIPLE selections is currently unimplemented");
2009 error ("X selection unavailable for this frame");
2011 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
2012 FRAME_X_DISPLAY_INFO (f
));
2014 if (NILP (val
) && FRAME_LIVE_P (f
))
2017 XSETFRAME (frame
, f
);
2018 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
2019 time_stamp
, frame
));
2022 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2025 if (CONSP (val
) && NILP (XCDR (val
)))
2028 RETURN_UNGCPRO (clean_local_selection_data (val
));
2031 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2032 Sx_disown_selection_internal
, 1, 3, 0,
2033 doc
: /* If we own the selection SELECTION, disown it.
2034 Disowning it means there is no such selection.
2036 TERMINAL should be a terminal object or a frame specifying the X
2037 server to query. If omitted or nil, that stands for the selected
2038 frame's display, or the first available X display. */)
2039 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2042 Atom selection_atom
;
2044 struct selection_input_event sie
;
2045 struct input_event ie
;
2047 struct frame
*f
= frame_for_x_selection (terminal
);
2048 struct x_display_info
*dpyinfo
;
2053 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2054 CHECK_SYMBOL (selection
);
2056 /* Don't disown the selection when we're not the owner. */
2057 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2060 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2063 if (NILP (time_object
))
2064 timestamp
= last_event_timestamp
;
2066 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2067 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2070 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2071 generated for a window which owns the selection when that window sets
2072 the selection owner to None. The NCD server does, the MIT Sun4 server
2073 doesn't. So we synthesize one; this means we might get two, but
2074 that's ok, because the second one won't have any effect. */
2075 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2076 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2077 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2078 x_handle_selection_clear (&event
.ie
);
2083 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2085 doc
: /* Whether the current Emacs process owns the given X Selection.
2086 The arg should be the name of the selection in question, typically one of
2087 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2088 \(Those are literal upper-case symbol names, since that's what X expects.)
2089 For convenience, the symbol nil is the same as `PRIMARY',
2090 and t is the same as `SECONDARY'.
2092 TERMINAL should be a terminal object or a frame specifying the X
2093 server to query. If omitted or nil, that stands for the selected
2094 frame's display, or the first available X display. */)
2095 (Lisp_Object selection
, Lisp_Object terminal
)
2097 struct frame
*f
= frame_for_x_selection (terminal
);
2099 CHECK_SYMBOL (selection
);
2100 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2101 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2103 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2109 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2111 doc
: /* Whether there is an owner for the given X selection.
2112 SELECTION should be the name of the selection in question, typically
2113 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
2114 these literal upper-case names.) The symbol nil is the same as
2115 `PRIMARY', and t is the same as `SECONDARY'.
2117 TERMINAL should be a terminal object or a frame specifying the X
2118 server to query. If omitted or nil, that stands for the selected
2119 frame's display, or the first available X display. */)
2120 (Lisp_Object selection
, Lisp_Object terminal
)
2124 struct frame
*f
= frame_for_x_selection (terminal
);
2125 struct x_display_info
*dpyinfo
;
2127 CHECK_SYMBOL (selection
);
2128 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2129 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2134 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2136 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2139 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2140 if (atom
== 0) return Qnil
;
2142 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2144 return (owner
? Qt
: Qnil
);
2148 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2149 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2152 x_clipboard_manager_save (Lisp_Object frame
)
2154 struct frame
*f
= XFRAME (frame
);
2155 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2156 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2158 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2159 dpyinfo
->Xatom_EMACS_TMP
,
2160 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2161 (unsigned char *) &data
, 1);
2162 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2167 /* Error handler for x_clipboard_manager_save_frame. */
2170 x_clipboard_manager_error_1 (Lisp_Object err
)
2172 Lisp_Object args
[2];
2173 args
[0] = build_string ("X clipboard manager error: %s\n\
2174 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2175 args
[1] = CAR (CDR (err
));
2180 /* Error handler for x_clipboard_manager_save_all. */
2183 x_clipboard_manager_error_2 (Lisp_Object err
)
2185 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2186 If the problem persists, set `x-select-enable-clipboard-manager' \
2191 /* Called from delete_frame: save any clipboard owned by FRAME to the
2192 clipboard manager. Do nothing if FRAME does not own the clipboard,
2193 or if no clipboard manager is present. */
2196 x_clipboard_manager_save_frame (Lisp_Object frame
)
2200 if (!NILP (Vx_select_enable_clipboard_manager
)
2202 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2203 && FRAME_LIVE_P (f
))
2205 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2206 Lisp_Object local_selection
2207 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2209 if (!NILP (local_selection
)
2210 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2211 && XGetSelectionOwner (dpyinfo
->display
,
2212 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2213 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2214 x_clipboard_manager_error_1
);
2218 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2219 clipboard manager. Do nothing if FRAME does not own the clipboard,
2220 or if no clipboard manager is present. */
2223 x_clipboard_manager_save_all (void)
2225 /* Loop through all X displays, saving owned clipboards. */
2226 struct x_display_info
*dpyinfo
;
2227 Lisp_Object local_selection
, local_frame
;
2229 if (NILP (Vx_select_enable_clipboard_manager
))
2232 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2234 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2235 if (NILP (local_selection
)
2236 || !XGetSelectionOwner (dpyinfo
->display
,
2237 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2240 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2241 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2242 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2243 Qt
, x_clipboard_manager_error_2
);
2248 /***********************************************************************
2249 Drag and drop support
2250 ***********************************************************************/
2251 /* Check that lisp values are of correct type for x_fill_property_data.
2252 That is, number, string or a cons with two numbers (low and high 16
2253 bit parts of a 32 bit number). Return the number of items in DATA,
2254 or -1 if there is an error. */
2257 x_check_property_data (Lisp_Object data
)
2262 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2264 Lisp_Object o
= XCAR (iter
);
2266 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2268 else if (CONSP (o
) &&
2269 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2271 if (size
== INT_MAX
)
2279 /* Convert lisp values to a C array. Values may be a number, a string
2280 which is taken as an X atom name and converted to the atom value, or
2281 a cons containing the two 16 bit parts of a 32 bit number.
2283 DPY is the display use to look up X atoms.
2284 DATA is a Lisp list of values to be converted.
2285 RET is the C array that contains the converted values. It is assumed
2286 it is big enough to hold all values.
2287 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2288 be stored in RET. Note that long is used for 32 even if long is more
2289 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2290 XClientMessageEvent). */
2293 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2296 long *d32
= (long *) ret
;
2297 short *d16
= (short *) ret
;
2298 char *d08
= (char *) ret
;
2301 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2303 Lisp_Object o
= XCAR (iter
);
2305 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2306 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2307 else if (STRINGP (o
))
2310 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2314 error ("Wrong type, must be string, number or cons");
2318 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2321 error ("Out of 'char' range");
2323 else if (format
== 16)
2325 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2328 error ("Out of 'short' range");
2335 /* Convert an array of C values to a Lisp list.
2336 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2337 DATA is a C array of values to be converted.
2338 TYPE is the type of the data. Only XA_ATOM is special, it converts
2339 each number in DATA to its corresponfing X atom as a symbol.
2340 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2342 SIZE is the number of elements in DATA.
2344 Important: When format is 32, data should contain an array of int,
2345 not an array of long as the X library returns. This makes a difference
2346 when sizeof(long) != sizeof(int).
2348 Also see comment for selection_data_to_lisp_data above. */
2351 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2352 Atom type
, int format
, long unsigned int size
)
2354 ptrdiff_t format_bytes
= format
>> 3;
2355 if (PTRDIFF_MAX
/ format_bytes
< size
)
2356 memory_full (SIZE_MAX
);
2357 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2358 data
, size
* format_bytes
, type
, format
);
2361 /* Get the mouse position in frame relative coordinates. */
2364 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2366 Window root
, dummy_window
;
2371 XQueryPointer (FRAME_X_DISPLAY (f
),
2372 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2374 /* The root window which contains the pointer. */
2377 /* Window pointer is on, not used */
2380 /* The position on that root window. */
2383 /* x/y in dummy_window coordinates, not used. */
2386 /* Modifier keys and pointer buttons, about which
2388 (unsigned int *) &dummy
);
2391 /* Absolute to relative. */
2392 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2393 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2398 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2399 Sx_get_atom_name
, 1, 2, 0,
2400 doc
: /* Return the X atom name for VALUE as a string.
2401 VALUE may be a number or a cons where the car is the upper 16 bits and
2402 the cdr is the lower 16 bits of a 32 bit value.
2403 Use the display for FRAME or the current frame if FRAME is not given or nil.
2405 If the value is 0 or the atom is not known, return the empty string. */)
2406 (Lisp_Object value
, Lisp_Object frame
)
2408 struct frame
*f
= check_x_frame (frame
);
2411 Lisp_Object ret
= Qnil
;
2412 Display
*dpy
= FRAME_X_DISPLAY (f
);
2416 CONS_TO_INTEGER (value
, Atom
, atom
);
2419 x_catch_errors (dpy
);
2420 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2421 had_errors
= x_had_errors_p (dpy
);
2422 x_uncatch_errors ();
2425 ret
= build_string (name
);
2427 if (atom
&& name
) XFree (name
);
2428 if (NILP (ret
)) ret
= empty_unibyte_string
;
2435 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2436 Sx_register_dnd_atom
, 1, 2, 0,
2437 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2438 ATOM can be a symbol or a string. The ATOM is interned on the display that
2439 FRAME is on. If FRAME is nil, the selected frame is used. */)
2440 (Lisp_Object atom
, Lisp_Object frame
)
2443 struct frame
*f
= check_x_frame (frame
);
2445 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2449 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2450 else if (STRINGP (atom
))
2453 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2457 error ("ATOM must be a symbol or a string");
2459 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2460 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2463 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2464 dpyinfo
->x_dnd_atoms
=
2465 xpalloc (dpyinfo
->x_dnd_atoms
, &dpyinfo
->x_dnd_atoms_size
,
2466 1, -1, sizeof *dpyinfo
->x_dnd_atoms
);
2468 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2472 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2475 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2479 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2480 unsigned long size
= 160/event
->format
;
2482 unsigned char *data
= (unsigned char *) event
->data
.b
;
2486 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2487 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2489 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2491 XSETFRAME (frame
, f
);
2493 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2494 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2495 function expects them to be of size int (i.e. 32). So to be able to
2496 use that function, put the data in the form it expects if format is 32. */
2498 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2500 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2501 idata
[i
] = event
->data
.l
[i
];
2502 data
= (unsigned char *) idata
;
2505 vec
= Fmake_vector (make_number (4), Qnil
);
2506 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2507 event
->message_type
)));
2508 ASET (vec
, 1, frame
);
2509 ASET (vec
, 2, make_number (event
->format
));
2510 ASET (vec
, 3, x_property_data_to_lisp (f
,
2512 event
->message_type
,
2516 mouse_position_for_drop (f
, &x
, &y
);
2517 bufp
->kind
= DRAG_N_DROP_EVENT
;
2518 bufp
->frame_or_window
= frame
;
2519 bufp
->timestamp
= CurrentTime
;
2520 bufp
->x
= make_number (x
);
2521 bufp
->y
= make_number (y
);
2523 bufp
->modifiers
= 0;
2528 DEFUN ("x-send-client-message", Fx_send_client_event
,
2529 Sx_send_client_message
, 6, 6, 0,
2530 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2532 For DISPLAY, specify either a frame or a display name (a string).
2533 If DISPLAY is nil, that stands for the selected frame's display.
2534 DEST may be a number, in which case it is a Window id. The value 0 may
2535 be used to send to the root window of the DISPLAY.
2536 If DEST is a cons, it is converted to a 32 bit number
2537 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2538 number is then used as a window id.
2539 If DEST is a frame the event is sent to the outer window of that frame.
2540 A value of nil means the currently selected frame.
2541 If DEST is the string "PointerWindow" the event is sent to the window that
2542 contains the pointer. If DEST is the string "InputFocus" the event is
2543 sent to the window that has the input focus.
2544 FROM is the frame sending the event. Use nil for currently selected frame.
2545 MESSAGE-TYPE is the name of an Atom as a string.
2546 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2547 bits. VALUES is a list of numbers, cons and/or strings containing the values
2548 to send. If a value is a string, it is converted to an Atom and the value of
2549 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2550 with the high 16 bits from the car and the lower 16 bit from the cdr.
2551 If more values than fits into the event is given, the excessive values
2553 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2555 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2557 CHECK_STRING (message_type
);
2558 x_send_client_event(display
, dest
, from
,
2559 XInternAtom (dpyinfo
->display
,
2560 SSDATA (message_type
),
2568 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2570 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2573 struct frame
*f
= check_x_frame (from
);
2576 CHECK_NUMBER (format
);
2577 CHECK_CONS (values
);
2579 if (x_check_property_data (values
) == -1)
2580 error ("Bad data in VALUES, must be number, cons or string");
2582 event
.xclient
.type
= ClientMessage
;
2583 event
.xclient
.format
= XFASTINT (format
);
2585 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2586 && event
.xclient
.format
!= 32)
2587 error ("FORMAT must be one of 8, 16 or 32");
2589 if (FRAMEP (dest
) || NILP (dest
))
2591 struct frame
*fdest
= check_x_frame (dest
);
2592 wdest
= FRAME_OUTER_WINDOW (fdest
);
2594 else if (STRINGP (dest
))
2596 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2597 wdest
= PointerWindow
;
2598 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2601 error ("DEST as a string must be one of PointerWindow or InputFocus");
2603 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2604 CONS_TO_INTEGER (dest
, Window
, wdest
);
2606 error ("DEST must be a frame, nil, string, number or cons");
2608 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2609 to_root
= wdest
== dpyinfo
->root_window
;
2613 event
.xclient
.message_type
= message_type
;
2614 event
.xclient
.display
= dpyinfo
->display
;
2616 /* Some clients (metacity for example) expects sending window to be here
2617 when sending to the root window. */
2618 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2621 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2622 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2623 event
.xclient
.format
);
2625 /* If event mask is 0 the event is sent to the client that created
2626 the destination window. But if we are sending to the root window,
2627 there is no such client. Then we set the event mask to 0xffff. The
2628 event then goes to clients selecting for events on the root window. */
2629 x_catch_errors (dpyinfo
->display
);
2631 int propagate
= to_root
? False
: True
;
2632 unsigned mask
= to_root
? 0xffff : 0;
2633 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2634 XFlush (dpyinfo
->display
);
2636 x_uncatch_errors ();
2642 syms_of_xselect (void)
2644 defsubr (&Sx_get_selection_internal
);
2645 defsubr (&Sx_own_selection_internal
);
2646 defsubr (&Sx_disown_selection_internal
);
2647 defsubr (&Sx_selection_owner_p
);
2648 defsubr (&Sx_selection_exists_p
);
2650 defsubr (&Sx_get_atom_name
);
2651 defsubr (&Sx_send_client_message
);
2652 defsubr (&Sx_register_dnd_atom
);
2654 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2655 staticpro (&reading_selection_reply
);
2656 reading_selection_window
= 0;
2657 reading_which_selection
= 0;
2659 property_change_wait_list
= 0;
2660 prop_location_identifier
= 0;
2661 property_change_reply
= Fcons (Qnil
, Qnil
);
2662 staticpro (&property_change_reply
);
2664 converted_selections
= NULL
;
2665 conversion_fail_tag
= None
;
2667 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2668 doc
: /* An alist associating X Windows selection-types with functions.
2669 These functions are called to convert the selection, with three args:
2670 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2671 a desired type to which the selection should be converted;
2672 and the local selection value (whatever was given to `x-own-selection').
2674 The function should return the value to send to the X server
2675 \(typically a string). A return value of nil
2676 means that the conversion could not be done.
2677 A return value which is the symbol `NULL'
2678 means that a side-effect was executed,
2679 and there is no meaningful selection value. */);
2680 Vselection_converter_alist
= Qnil
;
2682 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2683 doc
: /* A list of functions to be called when Emacs loses an X selection.
2684 \(This happens when some other X client makes its own selection
2685 or when a Lisp program explicitly clears the selection.)
2686 The functions are called with one argument, the selection type
2687 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2688 Vx_lost_selection_functions
= Qnil
;
2690 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2691 doc
: /* A list of functions to be called when Emacs answers a selection request.
2692 The functions are called with three arguments:
2693 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2694 - the selection-type which Emacs was asked to convert the
2695 selection into before sending (for example, `STRING' or `LENGTH');
2696 - a flag indicating success or failure for responding to the request.
2697 We might have failed (and declined the request) for any number of reasons,
2698 including being asked for a selection that we no longer own, or being asked
2699 to convert into a type that we don't know about or that is inappropriate.
2700 This hook doesn't let you change the behavior of Emacs's selection replies,
2701 it merely informs you that they have happened. */);
2702 Vx_sent_selection_functions
= Qnil
;
2704 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2705 Vx_select_enable_clipboard_manager
,
2706 doc
: /* Whether to enable X clipboard manager support.
2707 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2708 while owning the X clipboard, the clipboard contents are saved to the
2709 clipboard manager if one is present. */);
2710 Vx_select_enable_clipboard_manager
= Qt
;
2712 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2713 doc
: /* Number of milliseconds to wait for a selection reply.
2714 If the selection owner doesn't reply in this time, we give up.
2715 A value of 0 means wait as long as necessary. This is initialized from the
2716 \"*selectionTimeout\" resource. */);
2717 x_selection_timeout
= 0;
2719 /* QPRIMARY is defined in keyboard.c. */
2720 DEFSYM (QSECONDARY
, "SECONDARY");
2721 DEFSYM (QSTRING
, "STRING");
2722 DEFSYM (QINTEGER
, "INTEGER");
2723 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2724 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2725 DEFSYM (QTEXT
, "TEXT");
2726 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2727 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2728 DEFSYM (QDELETE
, "DELETE");
2729 DEFSYM (QMULTIPLE
, "MULTIPLE");
2730 DEFSYM (QINCR
, "INCR");
2731 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2732 DEFSYM (QTARGETS
, "TARGETS");
2733 DEFSYM (QATOM
, "ATOM");
2734 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2735 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2736 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2737 DEFSYM (QNULL
, "NULL");
2738 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2739 DEFSYM (Qforeign_selection
, "foreign-selection");
2740 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2741 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");