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
,
596 struct x_display_info
*dpyinfo
)
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
;
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
;
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
);
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
)
631 if (cs
->property
== None
)
634 bytes_remaining
= cs
->size
;
635 bytes_remaining
*= cs
->format
>> 3;
636 if (bytes_remaining
<= max_bytes
)
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
,
646 /* Send an INCR tag to initiate incremental transfer. */
649 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
650 bytes_remaining
, XGetAtomName (display
, cs
->property
));
652 = expect_property_change (display
, window
, cs
->property
,
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
);
665 /* Now issue the SelectionNotify event. */
666 XSendEvent (display
, window
, False
, 0L, &reply_base
);
669 #ifdef TRACE_SELECTION
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
);
678 #endif /* TRACE_SELECTION */
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
)
687 int format_bytes
= cs
->format
/ 8;
688 int had_errors
= x_had_errors_p (display
);
691 bytes_remaining
= cs
->size
;
692 bytes_remaining
*= format_bytes
;
694 /* Wait for the requester to ack by deleting the property.
695 This can run Lisp code (process handlers) or signal. */
698 TRACE1 ("Waiting for ACK (deletion of %s)",
699 XGetAtomName (display
, cs
->property
));
700 wait_for_property_change (cs
->wait_object
);
703 unexpect_property_change (cs
->wait_object
);
705 while (bytes_remaining
)
707 int i
= ((bytes_remaining
< max_bytes
)
709 : max_bytes
) / format_bytes
;
713 = expect_property_change (display
, window
, cs
->property
,
716 TRACE1 ("Sending increment of %d elements", i
);
717 TRACE1 ("Set %s to increment data",
718 XGetAtomName (display
, cs
->property
));
720 /* Append the next chunk of data to the property. */
721 XChangeProperty (display
, window
, cs
->property
,
722 cs
->type
, cs
->format
, PropModeAppend
,
724 bytes_remaining
-= i
* format_bytes
;
725 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
728 had_errors
= x_had_errors_p (display
);
731 if (had_errors
) break;
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
);
740 /* Now write a zero-length chunk to the property to tell the
741 requester that we're done. */
743 if (! waiting_for_other_props_on_window (display
, window
))
744 XSelectInput (display
, window
, 0L);
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
,
751 TRACE0 ("Done sending incrementally");
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
);
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. */
770 /* This calls x_uncatch_errors. */
771 unbind_to (count
, Qnil
);
775 /* Handle a SelectionRequest event EVENT.
776 This is called from keyboard.c when such an event is found in the queue. */
779 x_handle_selection_request (struct input_event
*event
)
781 struct gcpro gcpro1
, gcpro2
;
782 Time local_selection_time
;
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
;
793 int count
= SPECPDL_INDEX ();
794 GCPRO2 (local_selection_data
, target_symbol
);
796 if (!dpyinfo
) goto DONE
;
798 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
800 /* Decline if we don't own any selections. */
801 if (NILP (local_selection_data
)) goto DONE
;
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
))
810 x_selection_current_request
= event
;
811 selection_request_dpyinfo
= dpyinfo
;
812 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
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
);
819 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
820 SDATA (SYMBOL_NAME (selection_symbol
)),
821 SDATA (SYMBOL_NAME (target_symbol
)));
823 if (EQ (target_symbol
, QMULTIPLE
))
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
;
832 if (property
== None
) goto DONE
;
834 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
835 QMULTIPLE
, selection
);
837 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
840 nselections
= ASIZE (multprop
) / 2;
841 /* Perform conversions. This can signal. */
842 for (j
= 0; j
< nselections
; j
++)
844 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
845 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
846 AREF (multprop
, 2*j
+1));
848 if (subproperty
!= None
)
849 x_convert_selection (event
, selection_symbol
, subtarget
,
850 subproperty
, 1, dpyinfo
);
856 if (property
== None
)
857 property
= SELECTION_EVENT_TARGET (event
);
858 success
= x_convert_selection (event
, selection_symbol
,
859 target_symbol
, property
,
866 x_reply_selection_request (event
, dpyinfo
);
868 x_decline_selection_request (event
);
869 x_selection_current_request
= 0;
871 /* Run the `x-sent-selection-functions' abnormal hook. */
872 if (!NILP (Vx_sent_selection_functions
)
873 && !EQ (Vx_sent_selection_functions
, Qunbound
))
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
);
883 unbind_to (count
, Qnil
);
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.
892 Return 0 if the selection failed to convert, 1 otherwise. */
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
)
900 Lisp_Object lisp_selection
;
901 struct selection_data
*cs
;
902 GCPRO1 (lisp_selection
);
905 = x_get_local_selection (selection_symbol
, target_symbol
,
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
))))
914 cs
= xmalloc (sizeof (struct selection_data
));
915 cs
->data
= (unsigned char *) &conversion_fail_tag
;
920 cs
->property
= property
;
921 cs
->wait_object
= NULL
;
922 cs
->next
= converted_selections
;
923 converted_selections
= cs
;
930 /* Otherwise, record the converted selection to binary. */
931 cs
= xmalloc (sizeof (struct selection_data
));
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
),
939 &(cs
->data
), &(cs
->type
),
940 &(cs
->size
), &(cs
->format
),
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. */
951 x_handle_selection_clear (struct input_event
*event
)
953 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
954 Atom selection
= SELECTION_EVENT_SELECTION (event
);
955 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
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
;
962 TRACE0 ("x_handle_selection_clear");
964 if (!dpyinfo
) return;
966 selection_symbol
= x_atom_to_symbol (display
, selection
);
967 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
969 /* Well, we already believe that we don't own it, so that's just fine. */
970 if (NILP (local_selection_data
)) return;
972 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
973 Time
, local_selection_time
);
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
)
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
);
988 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
989 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
991 XSETCDR (rest
, XCDR (XCDR (rest
)));
995 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
997 /* Run the `x-lost-selection-functions' abnormal hook. */
1000 args
[0] = Qx_lost_selection_functions
;
1001 args
[1] = selection_symbol
;
1002 Frun_hook_with_args (2, args
);
1005 prepare_menu_bars ();
1006 redisplay_preserve_echo_area (20);
1010 x_handle_selection_event (struct input_event
*event
)
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
);
1018 x_handle_selection_request (event
);
1022 /* Clear all selections that were made from frame F.
1023 We do this when about to delete a frame. */
1026 x_clear_frame_selections (FRAME_PTR f
)
1030 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1031 struct terminal
*t
= dpyinfo
->terminal
;
1033 XSETFRAME (frame
, f
);
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
)))))))
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
);
1045 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
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
))))))))
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
)));
1062 /* Nonzero if any properties for DISPLAY and WINDOW
1063 are on the list of what we are waiting for. */
1066 waiting_for_other_props_on_window (Display
*display
, Window window
)
1068 struct prop_location
*rest
= property_change_wait_list
;
1070 if (rest
->display
== display
&& rest
->window
== window
)
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. */
1082 static struct prop_location
*
1083 expect_property_change (Display
*display
, Window window
,
1084 Atom property
, int state
)
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
;
1094 property_change_wait_list
= pl
;
1098 /* Delete an entry from the list of property changes we are waiting for.
1099 IDENTIFIER is the number that uniquely identifies the entry. */
1102 unexpect_property_change (struct prop_location
*location
)
1104 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1107 if (rest
== location
)
1110 prev
->next
= rest
->next
;
1112 property_change_wait_list
= rest
->next
;
1121 /* Remove the property change expectation element for IDENTIFIER. */
1124 wait_for_property_change_unwind (Lisp_Object loc
)
1126 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1128 unexpect_property_change (location
);
1129 if (location
== property_change_reply_object
)
1130 property_change_reply_object
= 0;
1134 /* Actually wait for a property change.
1135 IDENTIFIER should be the value that expect_property_change returned. */
1138 wait_for_property_change (struct prop_location
*location
)
1141 int count
= SPECPDL_INDEX ();
1143 if (property_change_reply_object
)
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));
1150 XSETCAR (property_change_reply
, Qnil
);
1151 property_change_reply_object
= location
;
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
)
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);
1163 if (NILP (XCAR (property_change_reply
)))
1165 TRACE0 (" Timed out");
1166 error ("Timed out waiting for property-notify event");
1170 unbind_to (count
, Qnil
);
1173 /* Called from XTread_socket in response to a PropertyNotify event. */
1176 x_handle_property_notify (XPropertyEvent
*event
)
1178 struct prop_location
*rest
;
1180 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1183 && rest
->property
== event
->atom
1184 && rest
->window
== event
->window
1185 && rest
->display
== event
->display
1186 && rest
->desired_state
== event
->state
)
1188 TRACE2 ("Expected %s of property %s",
1189 (event
->state
== PropertyDelete
? "deletion" : "change"),
1190 XGetAtomName (event
->display
, event
->atom
));
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
);
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
;
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. */
1216 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1217 Lisp_Object time_stamp
, Lisp_Object frame
)
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
));
1231 if (!FRAME_LIVE_P (f
))
1234 if (! NILP (time_stamp
))
1235 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1238 TRACE2 ("Get selection %s, type %s",
1239 XGetAtomName (display
, type_atom
),
1240 XGetAtomName (display
, target_property
));
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 ();
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
);
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
1258 x_start_queuing_selection_requests ();
1259 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
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
)));
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
))
1277 /* Otherwise, the selection is waiting for us on the requested property. */
1279 x_get_window_property_as_lisp_data (display
, requestor_window
,
1280 target_property
, target_type
,
1284 /* Subroutines of x_get_window_property_as_lisp_data */
1286 /* Use xfree, not XFree, to free the data obtained with this function. */
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
)
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;
1300 int buffer_size
= selection_quantum (display
);
1302 /* Wide enough to avoid overflow in expressions using it. */
1303 ptrdiff_t x_long_size
= X_LONG_SIZE
;
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
);
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
,
1320 &bytes_remaining
, &tmp_data
);
1321 if (result
!= Success
)
1324 /* This was allocated by Xlib, so use XFree. */
1325 XFree ((char *) tmp_data
);
1327 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1330 if (total_size_max
< bytes_remaining
)
1332 total_size
= bytes_remaining
;
1333 data
= malloc (total_size
+ 1);
1335 goto memory_exhausted
;
1337 /* Now read, until we've gotten it all. */
1338 while (bytes_remaining
)
1340 ptrdiff_t bytes_gotten
;
1343 = XGetWindowProperty (display
, window
, property
,
1344 offset
/ X_LONG_SIZE
,
1345 buffer_size
/ X_LONG_SIZE
,
1348 actual_type_ret
, actual_format_ret
,
1349 actual_size_ret
, &bytes_remaining
, &tmp_data
);
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
)
1357 bytes_per_item
= *actual_format_ret
>> 3;
1358 xassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
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
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
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. */
1373 bytes_gotten
= *actual_size_ret
;
1374 bytes_gotten
*= bytes_per_item
;
1376 TRACE2 ("Read %"pD
"d bytes from property %s",
1377 bytes_gotten
, XGetAtomName (display
, property
));
1379 if (total_size
- offset
< bytes_gotten
)
1381 unsigned char *data1
;
1382 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1383 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1385 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1386 data1
= realloc (data
, total_size
+ 1);
1388 goto memory_exhausted
;
1392 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1395 int *idata
= (int *) (data
+ offset
);
1396 long *ldata
= (long *) tmp_data
;
1398 for (i
= 0; i
< *actual_size_ret
; ++i
)
1399 idata
[i
] = ldata
[i
];
1402 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1404 offset
+= bytes_gotten
;
1406 /* This was allocated by Xlib, so use XFree. */
1407 XFree ((char *) tmp_data
);
1411 data
[offset
] = '\0';
1416 *bytes_ret
= offset
;
1422 memory_full (SIZE_MAX
);
1427 memory_full (total_size
+ 1);
1430 /* Use xfree, not XFree, to free the data obtained with this function. */
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
)
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
;
1448 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
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.)
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.
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
,
1472 unsigned char *tmp_data
;
1473 ptrdiff_t tmp_size_bytes
;
1475 TRACE0 (" Wait for property change");
1476 wait_for_property_change (wait_object
);
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);
1486 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1488 if (tmp_size_bytes
== 0) /* we're done */
1490 TRACE0 ("Done reading incrementally");
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. */
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
,
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
),
1514 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1515 offset
+= tmp_size_bytes
;
1517 /* Use xfree, not XFree, because x_get_window_property
1518 calls xmalloc itself. */
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
1529 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1531 Lisp_Object target_type
,
1532 Atom selection_atom
)
1536 unsigned long actual_size
;
1537 unsigned char *data
= 0;
1538 ptrdiff_t bytes
= 0;
1540 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1542 TRACE0 ("Reading selection data");
1544 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1545 &actual_type
, &actual_format
, &actual_size
, 1);
1548 int there_is_a_selection_owner
;
1550 there_is_a_selection_owner
1551 = XGetSelectionOwner (display
, selection_atom
);
1553 if (there_is_a_selection_owner
)
1554 signal_error ("Selection owner couldn't convert",
1556 ? list2 (target_type
,
1557 x_atom_to_symbol (display
, actual_type
))
1560 signal_error ("No selection",
1561 x_atom_to_symbol (display
, selection_atom
));
1564 if (actual_type
== dpyinfo
->Xatom_INCR
)
1566 /* That wasn't really the data, just the beginning. */
1568 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1570 /* Use xfree, not XFree, because x_get_window_property
1571 calls xmalloc itself. */
1572 xfree ((char *) data
);
1574 receive_incremental_selection (display
, window
, property
, target_type
,
1575 min_size_bytes
, &data
, &bytes
,
1576 &actual_type
, &actual_format
,
1581 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1582 XDeleteProperty (display
, window
, property
);
1586 /* It's been read. Now convert it to a lisp object in some semi-rational
1588 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1589 actual_type
, actual_format
);
1591 /* Use xfree, not XFree, because x_get_window_property
1592 calls xmalloc itself. */
1593 xfree ((char *) data
);
1597 /* These functions convert from the selection data read from the server into
1598 something that we can use from Lisp, and vice versa.
1600 Type: Format: Size: Lisp Type:
1601 ----- ------- ----- -----------
1604 ATOM 32 > 1 Vector of Symbols
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
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.
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.
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.
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). */
1629 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1630 ptrdiff_t size
, Atom type
, int format
)
1632 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1634 if (type
== dpyinfo
->Xatom_NULL
)
1637 /* Convert any 8-bit data to a string, for compactness. */
1638 else if (format
== 8)
1640 Lisp_Object str
, lispy_type
;
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
;
1652 lispy_type
= QSTRING
;
1653 Fput_text_property (make_number (0), make_number (size
),
1654 Qforeign_selection
, lispy_type
, str
);
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
)
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
1668 int *idata
= (int *) data
;
1670 if (size
== sizeof (int))
1671 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1674 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1676 for (i
= 0; i
< size
/ sizeof (int); i
++)
1677 Faset (v
, make_number (i
),
1678 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
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.
1687 else if (format
== 32 && size
== sizeof (int))
1688 return INTEGER_TO_CONS (((int *) data
) [0]);
1689 else if (format
== 16 && size
== sizeof (short))
1690 return make_number (((short *) data
) [0]);
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.)
1695 else if (format
== 16)
1699 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1700 for (i
= 0; i
< size
/ 2; i
++)
1702 EMACS_INT j
= ((short *) data
) [i
];
1703 Faset (v
, make_number (i
), make_number (j
));
1710 Lisp_Object v
= Fmake_vector (make_number (size
/ X_LONG_SIZE
),
1712 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1714 int j
= ((int *) data
) [i
];
1715 Faset (v
, make_number (i
), INTEGER_TO_CONS (j
));
1722 /* Use xfree, not XFree, to free the data obtained with this function. */
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
)
1730 Lisp_Object type
= Qnil
;
1731 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1735 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1739 if (CONSP (obj
) && NILP (XCDR (obj
)))
1743 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1744 { /* This is not the same as declining */
1750 else if (STRINGP (obj
))
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
);
1758 *size_ret
= SBYTES (obj
);
1759 *data_ret
= SDATA (obj
);
1762 else if (SYMBOLP (obj
))
1764 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1767 (*data_ret
) [sizeof (Atom
)] = 0;
1768 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1769 if (NILP (type
)) type
= QATOM
;
1771 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1773 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1776 (*data_ret
) [sizeof (short)] = 0;
1777 (*(short **) data_ret
) [0] = XINT (obj
);
1778 if (NILP (type
)) type
= QINTEGER
;
1780 else if (INTEGERP (obj
)
1781 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1782 && (INTEGERP (XCDR (obj
))
1783 || (CONSP (XCDR (obj
))
1784 && INTEGERP (XCAR (XCDR (obj
)))))))
1786 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 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
;
1793 else if (VECTORP (obj
))
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] ...]
1800 ptrdiff_t size
= ASIZE (obj
);
1802 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1803 /* This vector is an ATOM set */
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
);
1810 *data_ret
= xnmalloc (size
, sizeof (Atom
));
1813 for (i
= 0; i
< size
; i
++)
1814 (*(Atom
**) data_ret
) [i
]
1815 = symbol_to_x_atom (dpyinfo
, XVECTOR (obj
)->contents
[i
]);
1818 /* This vector is an INTEGER set, or something like it */
1821 int data_size
= sizeof (short);
1822 if (NILP (type
)) type
= QINTEGER
;
1823 for (i
= 0; i
< size
; i
++)
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
)
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);
1836 *data_ret
= xnmalloc (size
, data_size
);
1837 *format_ret
= format
;
1839 for (i
= 0; i
< size
; i
++)
1841 long v
= cons_to_signed (XVECTOR (obj
)->contents
[i
],
1842 X_LONG_MIN
, X_LONG_MAX
);
1844 (*((long **) data_ret
)) [i
] = v
;
1846 (*((short **) data_ret
)) [i
] = v
;
1851 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1853 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1857 clean_local_selection_data (Lisp_Object 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
));
1867 && INTEGERP (XCAR (obj
))
1868 && INTEGERP (XCDR (obj
)))
1870 if (XINT (XCAR (obj
)) == 0)
1872 if (XINT (XCAR (obj
)) == -1)
1873 return make_number (- XINT (XCDR (obj
)));
1878 ptrdiff_t size
= ASIZE (obj
);
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
]);
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. */
1897 x_handle_selection_notify (XSelectionEvent
*event
)
1899 if (event
->requestor
!= reading_selection_window
)
1901 if (event
->selection
!= reading_which_selection
)
1904 TRACE0 ("Received SelectionNotify");
1905 XSETCAR (reading_selection_reply
,
1906 (event
->property
!= 0 ? Qt
: Qlambda
));
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. */
1916 static struct frame
*
1917 frame_for_x_selection (Lisp_Object object
)
1924 f
= XFRAME (selected_frame
);
1925 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1928 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1930 f
= XFRAME (XCAR (tail
));
1931 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1935 else if (TERMINALP (object
))
1937 struct terminal
*t
= get_terminal (object
, 1);
1938 if (t
->type
== output_x_window
)
1940 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1942 f
= XFRAME (XCAR (tail
));
1943 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1948 else if (FRAMEP (object
))
1950 f
= XFRAME (object
);
1951 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
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.
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
)
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");
1975 CHECK_SYMBOL (selection
);
1976 if (NILP (value
)) error ("VALUE may not be nil");
1977 x_own_selection (selection
, value
, frame
);
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. */
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.
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
)
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 */
2006 CHECK_SYMBOL (selection_symbol
);
2007 CHECK_SYMBOL (target_type
);
2008 if (EQ (target_type
, QMULTIPLE
))
2009 error ("Retrieving MULTIPLE selections is currently unimplemented");
2011 error ("X selection unavailable for this frame");
2013 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
2014 FRAME_X_DISPLAY_INFO (f
));
2016 if (NILP (val
) && FRAME_LIVE_P (f
))
2019 XSETFRAME (frame
, f
);
2020 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
2021 time_stamp
, frame
));
2024 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2027 if (CONSP (val
) && NILP (XCDR (val
)))
2030 RETURN_UNGCPRO (clean_local_selection_data (val
));
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.
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
)
2044 Atom selection_atom
;
2046 struct selection_input_event sie
;
2047 struct input_event ie
;
2049 struct frame
*f
= frame_for_x_selection (terminal
);
2050 struct x_display_info
*dpyinfo
;
2055 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2056 CHECK_SYMBOL (selection
);
2058 /* Don't disown the selection when we're not the owner. */
2059 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2062 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2065 if (NILP (time_object
))
2066 timestamp
= last_event_timestamp
;
2068 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2069 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
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
);
2085 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
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'.
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
)
2099 struct frame
*f
= frame_for_x_selection (terminal
);
2101 CHECK_SYMBOL (selection
);
2102 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2103 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2105 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2111 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
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'.
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
)
2126 struct frame
*f
= frame_for_x_selection (terminal
);
2127 struct x_display_info
*dpyinfo
;
2129 CHECK_SYMBOL (selection
);
2130 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2131 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2136 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2138 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2141 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2142 if (atom
== 0) return Qnil
;
2144 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2146 return (owner
? Qt
: Qnil
);
2150 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2151 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2154 x_clipboard_manager_save (Lisp_Object frame
)
2156 struct frame
*f
= XFRAME (frame
);
2157 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2158 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
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
,
2169 /* Error handler for x_clipboard_manager_save_frame. */
2172 x_clipboard_manager_error_1 (Lisp_Object err
)
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
));
2182 /* Error handler for x_clipboard_manager_save_all. */
2185 x_clipboard_manager_error_2 (Lisp_Object err
)
2187 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2188 If the problem persists, set `x-select-enable-clipboard-manager' \
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. */
2198 x_clipboard_manager_save_frame (Lisp_Object frame
)
2202 if (!NILP (Vx_select_enable_clipboard_manager
)
2204 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2205 && FRAME_LIVE_P (f
))
2207 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2208 Lisp_Object local_selection
2209 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
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
);
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. */
2225 x_clipboard_manager_save_all (void)
2227 /* Loop through all X displays, saving owned clipboards. */
2228 struct x_display_info
*dpyinfo
;
2229 Lisp_Object local_selection
, local_frame
;
2231 if (NILP (Vx_select_enable_clipboard_manager
))
2234 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2236 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2237 if (NILP (local_selection
)
2238 || !XGetSelectionOwner (dpyinfo
->display
,
2239 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
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
);
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. */
2259 x_check_property_data (Lisp_Object data
)
2264 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2266 Lisp_Object o
= XCAR (iter
);
2268 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2270 else if (CONSP (o
) &&
2271 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2273 if (size
== INT_MAX
)
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.
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). */
2295 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2298 long *d32
= (long *) ret
;
2299 short *d16
= (short *) ret
;
2300 char *d08
= (char *) ret
;
2303 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2305 Lisp_Object o
= XCAR (iter
);
2307 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2308 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2309 else if (STRINGP (o
))
2312 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2316 error ("Wrong type, must be string, number or cons");
2320 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2323 error ("Out of 'char' range");
2325 else if (format
== 16)
2327 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2330 error ("Out of 'short' range");
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
2344 SIZE is the number of elements in DATA.
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).
2350 Also see comment for selection_data_to_lisp_data above. */
2353 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2354 Atom type
, int format
, long unsigned int size
)
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
);
2363 /* Get the mouse position in frame relative coordinates. */
2366 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2368 Window root
, dummy_window
;
2373 XQueryPointer (FRAME_X_DISPLAY (f
),
2374 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2376 /* The root window which contains the pointer. */
2379 /* Window pointer is on, not used */
2382 /* The position on that root window. */
2385 /* x/y in dummy_window coordinates, not used. */
2388 /* Modifier keys and pointer buttons, about which
2390 (unsigned int *) &dummy
);
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
);
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.
2407 If the value is 0 or the atom is not known, return the empty string. */)
2408 (Lisp_Object value
, Lisp_Object frame
)
2410 struct frame
*f
= check_x_frame (frame
);
2413 Lisp_Object ret
= Qnil
;
2414 Display
*dpy
= FRAME_X_DISPLAY (f
);
2418 CONS_TO_INTEGER (value
, Atom
, atom
);
2421 x_catch_errors (dpy
);
2422 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2423 had_errors
= x_had_errors_p (dpy
);
2424 x_uncatch_errors ();
2427 ret
= build_string (name
);
2429 if (atom
&& name
) XFree (name
);
2430 if (NILP (ret
)) ret
= empty_unibyte_string
;
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
)
2445 struct frame
*f
= check_x_frame (frame
);
2447 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2451 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2452 else if (STRINGP (atom
))
2455 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2459 error ("ATOM must be a symbol or a string");
2461 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2462 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
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
);
2470 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2474 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2477 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
,
2478 struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2482 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2483 unsigned long size
= 160/event
->format
;
2485 unsigned char *data
= (unsigned char *) event
->data
.b
;
2489 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2490 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2492 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2494 XSETFRAME (frame
, f
);
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. */
2501 if (32 < BITS_PER_LONG
&& event
->format
== 32)
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
;
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
,
2515 event
->message_type
,
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
);
2526 bufp
->modifiers
= 0;
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.
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
2556 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2557 Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2559 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2561 CHECK_STRING (message_type
);
2562 x_send_client_event (display
, dest
, from
,
2563 XInternAtom (dpyinfo
->display
,
2564 SSDATA (message_type
),
2572 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2573 Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2575 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2578 struct frame
*f
= check_x_frame (from
);
2581 CHECK_NUMBER (format
);
2582 CHECK_CONS (values
);
2584 if (x_check_property_data (values
) == -1)
2585 error ("Bad data in VALUES, must be number, cons or string");
2587 event
.xclient
.type
= ClientMessage
;
2588 event
.xclient
.format
= XFASTINT (format
);
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");
2594 if (FRAMEP (dest
) || NILP (dest
))
2596 struct frame
*fdest
= check_x_frame (dest
);
2597 wdest
= FRAME_OUTER_WINDOW (fdest
);
2599 else if (STRINGP (dest
))
2601 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2602 wdest
= PointerWindow
;
2603 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2606 error ("DEST as a string must be one of PointerWindow or InputFocus");
2608 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2609 CONS_TO_INTEGER (dest
, Window
, wdest
);
2611 error ("DEST must be a frame, nil, string, number or cons");
2613 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2614 to_root
= wdest
== dpyinfo
->root_window
;
2618 event
.xclient
.message_type
= message_type
;
2619 event
.xclient
.display
= dpyinfo
->display
;
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
;
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
);
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
);
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
);
2641 x_uncatch_errors ();
2647 syms_of_xselect (void)
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
);
2655 defsubr (&Sx_get_atom_name
);
2656 defsubr (&Sx_send_client_message
);
2657 defsubr (&Sx_register_dnd_atom
);
2659 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2660 staticpro (&reading_selection_reply
);
2661 reading_selection_window
= 0;
2662 reading_which_selection
= 0;
2664 property_change_wait_list
= 0;
2665 prop_location_identifier
= 0;
2666 property_change_reply
= Fcons (Qnil
, Qnil
);
2667 staticpro (&property_change_reply
);
2669 converted_selections
= NULL
;
2670 conversion_fail_tag
= None
;
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').
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
;
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
;
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
;
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
;
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;
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");