1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2015 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 */
26 #ifdef HAVE_SYS_TYPES_H
27 #include <sys/types.h>
33 #include "xterm.h" /* for all of the X includes */
34 #include "dispextern.h" /* frame.h seems to want this */
35 #include "frame.h" /* Need this to get the X window of selected_frame */
36 #include "blockinput.h"
37 #include "character.h"
40 #include "termhooks.h"
43 #include <X11/Xproto.h>
46 struct selection_data
;
48 static void x_decline_selection_request (struct selection_input_event
*);
49 static bool x_convert_selection (Lisp_Object
, Lisp_Object
, Atom
, bool,
50 struct x_display_info
*);
51 static bool waiting_for_other_props_on_window (Display
*, Window
);
52 static struct prop_location
*expect_property_change (Display
*, Window
,
54 static void unexpect_property_change (struct prop_location
*);
55 static void wait_for_property_change (struct prop_location
*);
56 static Lisp_Object
x_get_window_property_as_lisp_data (struct x_display_info
*,
59 static Lisp_Object
selection_data_to_lisp_data (struct x_display_info
*,
60 const unsigned char *,
61 ptrdiff_t, Atom
, int);
62 static void lisp_data_to_selection_data (struct x_display_info
*, Lisp_Object
,
63 struct selection_data
*);
65 /* Printing traces to stderr. */
67 #ifdef TRACE_SELECTION
69 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
70 #define TRACE1(fmt, a0) \
71 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
72 #define TRACE2(fmt, a0, a1) \
73 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
74 #define TRACE3(fmt, a0, a1, a2) \
75 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
77 #define TRACE0(fmt) (void) 0
78 #define TRACE1(fmt, a0) (void) 0
79 #define TRACE2(fmt, a0, a1) (void) 0
82 /* Bytes needed to represent 'long' data. This is as per libX11; it
83 is not necessarily sizeof (long). */
86 /* If this is a smaller number than the max-request-size of the display,
87 emacs will use INCR selection transfer when the selection is larger
88 than this. The max-request-size is usually around 64k, so if you want
89 emacs to use incremental selection transfers when the selection is
90 smaller than that, set this. I added this mostly for debugging the
91 incremental transfer stuff, but it might improve server performance.
93 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
94 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
95 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
96 - 1 in place of INT_MAX. */
97 #define MAX_SELECTION_QUANTUM \
98 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
99 / max (X_LONG_SIZE, sizeof (long)))))
102 selection_quantum (Display
*display
)
104 long mrs
= XMaxRequestSize (display
);
105 return (mrs
< MAX_SELECTION_QUANTUM
/ X_LONG_SIZE
+ 25
106 ? (mrs
- 25) * X_LONG_SIZE
107 : MAX_SELECTION_QUANTUM
);
110 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
111 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
114 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
117 struct selection_event_queue
119 struct selection_input_event event
;
120 struct selection_event_queue
*next
;
123 static struct selection_event_queue
*selection_queue
;
125 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
127 static int x_queue_selection_requests
;
129 /* True if the input events are duplicates. */
132 selection_input_event_equal (struct selection_input_event
*a
,
133 struct selection_input_event
*b
)
135 return (a
->kind
== b
->kind
&& a
->dpyinfo
== b
->dpyinfo
136 && a
->requestor
== b
->requestor
&& a
->selection
== b
->selection
137 && a
->target
== b
->target
&& a
->property
== b
->property
138 && a
->time
== b
->time
);
141 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
144 x_queue_event (struct selection_input_event
*event
)
146 struct selection_event_queue
*queue_tmp
;
148 /* Don't queue repeated requests.
149 This only happens for large requests which uses the incremental protocol. */
150 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
152 if (selection_input_event_equal (event
, &queue_tmp
->event
))
154 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
155 x_decline_selection_request (event
);
160 queue_tmp
= xmalloc (sizeof *queue_tmp
);
161 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
162 queue_tmp
->event
= *event
;
163 queue_tmp
->next
= selection_queue
;
164 selection_queue
= queue_tmp
;
167 /* Start queuing SELECTION_REQUEST_EVENT events. */
170 x_start_queuing_selection_requests (void)
172 if (x_queue_selection_requests
)
175 x_queue_selection_requests
++;
176 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
179 /* Stop queuing SELECTION_REQUEST_EVENT events. */
182 x_stop_queuing_selection_requests (void)
184 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
185 --x_queue_selection_requests
;
187 /* Take all the queued events and put them back
188 so that they get processed afresh. */
190 while (selection_queue
!= NULL
)
192 struct selection_event_queue
*queue_tmp
= selection_queue
;
193 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
194 kbd_buffer_unget_event (&queue_tmp
->event
);
195 selection_queue
= queue_tmp
->next
;
201 /* This converts a Lisp symbol to a server Atom, avoiding a server
202 roundtrip whenever possible. */
205 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
208 if (NILP (sym
)) return 0;
209 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
210 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
211 if (EQ (sym
, QSTRING
)) return XA_STRING
;
212 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
213 if (EQ (sym
, QATOM
)) return XA_ATOM
;
214 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
215 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
216 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
217 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
218 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
219 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
220 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
221 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
222 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
223 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
224 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
225 if (!SYMBOLP (sym
)) emacs_abort ();
227 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
229 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
235 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
236 and calls to intern whenever possible. */
239 x_atom_to_symbol (struct x_display_info
*dpyinfo
, Atom atom
)
263 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
265 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
267 if (atom
== dpyinfo
->Xatom_TEXT
)
269 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
270 return QCOMPOUND_TEXT
;
271 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
273 if (atom
== dpyinfo
->Xatom_DELETE
)
275 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
277 if (atom
== dpyinfo
->Xatom_INCR
)
279 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
281 if (atom
== dpyinfo
->Xatom_TARGETS
)
283 if (atom
== dpyinfo
->Xatom_NULL
)
287 str
= XGetAtomName (dpyinfo
->display
, atom
);
289 TRACE1 ("XGetAtomName --> %s", str
);
290 if (! str
) return Qnil
;
293 /* This was allocated by Xlib, so use XFree. */
299 /* Do protocol to assert ourself as a selection owner.
300 FRAME shall be the owner; it must be a valid X frame.
301 Update the Vselection_alist so that we can reply to later requests for
305 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
308 struct frame
*f
= XFRAME (frame
);
309 Window selecting_window
= FRAME_X_WINDOW (f
);
310 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
311 Display
*display
= dpyinfo
->display
;
312 Time timestamp
= dpyinfo
->last_user_time
;
313 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
316 x_catch_errors (display
);
317 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
318 x_check_errors (display
, "Can't set selection: %s");
322 /* Now update the local cache */
324 Lisp_Object selection_data
;
325 Lisp_Object prev_value
;
327 selection_data
= list4 (selection_name
, selection_value
,
328 INTEGER_TO_CONS (timestamp
), frame
);
329 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
333 Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
));
335 /* If we already owned the selection, remove the old selection
336 data. Don't use Fdelq as that may QUIT. */
337 if (!NILP (prev_value
))
339 /* We know it's not the CAR, so it's easy. */
340 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
341 for (; CONSP (rest
); rest
= XCDR (rest
))
342 if (EQ (prev_value
, Fcar (XCDR (rest
))))
344 XSETCDR (rest
, XCDR (XCDR (rest
)));
351 /* Given a selection-name and desired type, look up our local copy of
352 the selection value and convert it to the type.
353 Return nil, a string, a vector, a symbol, an integer, or a cons
354 that CONS_TO_INTEGER could plausibly handle.
355 This function is used both for remote requests (LOCAL_REQUEST is zero)
356 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
358 This calls random Lisp code, and may signal or gc. */
361 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
362 bool local_request
, struct x_display_info
*dpyinfo
)
364 Lisp_Object local_value
;
365 Lisp_Object handler_fn
, value
, check
;
367 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
369 if (NILP (local_value
)) return Qnil
;
371 /* TIMESTAMP is a special case. */
372 if (EQ (target_type
, QTIMESTAMP
))
375 value
= XCAR (XCDR (XCDR (local_value
)));
379 /* Don't allow a quit within the converter.
380 When the user types C-g, he would be surprised
381 if by luck it came during a converter. */
382 ptrdiff_t count
= SPECPDL_INDEX ();
383 specbind (Qinhibit_quit
, Qt
);
385 CHECK_SYMBOL (target_type
);
386 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
387 /* gcpro is not needed here since nothing but HANDLER_FN
388 is live, and that ought to be a symbol. */
390 if (!NILP (handler_fn
))
391 value
= call3 (handler_fn
,
392 selection_symbol
, (local_request
? Qnil
: target_type
),
393 XCAR (XCDR (local_value
)));
396 unbind_to (count
, Qnil
);
399 /* Make sure this value is of a type that we could transmit
400 to another X client. */
404 && SYMBOLP (XCAR (value
)))
405 check
= XCDR (value
);
413 /* Check for a value that CONS_TO_INTEGER could handle. */
414 else if (CONSP (check
)
415 && INTEGERP (XCAR (check
))
416 && (INTEGERP (XCDR (check
))
418 (CONSP (XCDR (check
))
419 && INTEGERP (XCAR (XCDR (check
)))
420 && NILP (XCDR (XCDR (check
))))))
423 signal_error ("Invalid data returned by selection-conversion function",
424 list2 (handler_fn
, value
));
427 /* Subroutines of x_reply_selection_request. */
429 /* Send a SelectionNotify event to the requestor with property=None,
430 meaning we were unable to do what they wanted. */
433 x_decline_selection_request (struct selection_input_event
*event
)
436 XSelectionEvent
*reply
= &(reply_base
.xselection
);
438 reply
->type
= SelectionNotify
;
439 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
440 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
441 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
442 reply
->time
= SELECTION_EVENT_TIME (event
);
443 reply
->target
= SELECTION_EVENT_TARGET (event
);
444 reply
->property
= None
;
446 /* The reason for the error may be that the receiver has
447 died in the meantime. Handle that case. */
449 x_catch_errors (reply
->display
);
450 XSendEvent (reply
->display
, reply
->requestor
, False
, 0, &reply_base
);
451 XFlush (reply
->display
);
456 /* This is the selection request currently being processed.
457 It is set to zero when the request is fully processed. */
458 static struct selection_input_event
*x_selection_current_request
;
460 /* Display info in x_selection_request. */
462 static struct x_display_info
*selection_request_dpyinfo
;
464 /* Raw selection data, for sending to a requestor window. */
466 struct selection_data
474 /* This can be set to non-NULL during x_reply_selection_request, if
475 the selection is waiting for an INCR transfer to complete. Don't
476 free these; that's done by unexpect_property_change. */
477 struct prop_location
*wait_object
;
478 struct selection_data
*next
;
481 /* Linked list of the above (in support of MULTIPLE targets). */
483 static struct selection_data
*converted_selections
;
485 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
486 static Atom conversion_fail_tag
;
488 /* Used as an unwind-protect clause so that, if a selection-converter signals
489 an error, we tell the requestor that we were unable to do what they wanted
490 before we throw to top-level or go into the debugger or whatever. */
493 x_selection_request_lisp_error (void)
495 struct selection_data
*cs
, *next
;
497 for (cs
= converted_selections
; cs
; cs
= next
)
500 if (! cs
->nofree
&& cs
->data
)
504 converted_selections
= NULL
;
506 if (x_selection_current_request
!= 0
507 && selection_request_dpyinfo
->display
)
508 x_decline_selection_request (x_selection_current_request
);
512 x_catch_errors_unwind (void)
520 /* This stuff is so that INCR selections are reentrant (that is, so we can
521 be servicing multiple INCR selection requests simultaneously.) I haven't
522 actually tested that yet. */
524 /* Keep a list of the property changes that are awaited. */
534 struct prop_location
*next
;
537 static int prop_location_identifier
;
539 static Lisp_Object property_change_reply
;
541 static struct prop_location
*property_change_reply_object
;
543 static struct prop_location
*property_change_wait_list
;
546 set_property_change_object (struct prop_location
*location
)
548 /* Input must be blocked so we don't get the event before we set these. */
549 if (! input_blocked_p ())
551 XSETCAR (property_change_reply
, Qnil
);
552 property_change_reply_object
= location
;
556 /* Send the reply to a selection request event EVENT. */
558 #ifdef TRACE_SELECTION
559 static int x_reply_selection_request_cnt
;
560 #endif /* TRACE_SELECTION */
563 x_reply_selection_request (struct selection_input_event
*event
,
564 struct x_display_info
*dpyinfo
)
567 XSelectionEvent
*reply
= &(reply_base
.xselection
);
568 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
569 Window window
= SELECTION_EVENT_REQUESTOR (event
);
570 ptrdiff_t bytes_remaining
;
571 int max_bytes
= selection_quantum (display
);
572 ptrdiff_t count
= SPECPDL_INDEX ();
573 struct selection_data
*cs
;
575 reply
->type
= SelectionNotify
;
576 reply
->display
= display
;
577 reply
->requestor
= window
;
578 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
579 reply
->time
= SELECTION_EVENT_TIME (event
);
580 reply
->target
= SELECTION_EVENT_TARGET (event
);
581 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
582 if (reply
->property
== None
)
583 reply
->property
= reply
->target
;
586 /* The protected block contains wait_for_property_change, which can
587 run random lisp code (process handlers) or signal. Therefore, we
588 put the x_uncatch_errors call in an unwind. */
589 record_unwind_protect_void (x_catch_errors_unwind
);
590 x_catch_errors (display
);
592 /* Loop over converted selections, storing them in the requested
593 properties. If data is large, only store the first N bytes
594 (section 2.7.2 of ICCCM). Note that we store the data for a
595 MULTIPLE request in the opposite order; the ICCM says only that
596 the conversion itself must be done in the same order. */
597 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
599 if (cs
->property
== None
)
602 bytes_remaining
= cs
->size
;
603 bytes_remaining
*= cs
->format
>> 3;
604 if (bytes_remaining
<= max_bytes
)
606 /* Send all the data at once, with minimal handshaking. */
607 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
608 XChangeProperty (display
, window
, cs
->property
,
609 cs
->type
, cs
->format
, PropModeReplace
,
614 /* Send an INCR tag to initiate incremental transfer. */
617 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
618 bytes_remaining
, XGetAtomName (display
, cs
->property
));
620 = expect_property_change (display
, window
, cs
->property
,
623 /* XChangeProperty expects an array of long even if long is
624 more than 32 bits. */
625 value
[0] = min (bytes_remaining
, X_LONG_MAX
);
626 XChangeProperty (display
, window
, cs
->property
,
627 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
628 (unsigned char *) value
, 1);
629 XSelectInput (display
, window
, PropertyChangeMask
);
633 /* Now issue the SelectionNotify event. */
634 XSendEvent (display
, window
, False
, 0, &reply_base
);
637 #ifdef TRACE_SELECTION
639 char *sel
= XGetAtomName (display
, reply
->selection
);
640 char *tgt
= XGetAtomName (display
, reply
->target
);
641 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
642 sel
, tgt
, ++x_reply_selection_request_cnt
);
643 if (sel
) XFree (sel
);
644 if (tgt
) XFree (tgt
);
646 #endif /* TRACE_SELECTION */
648 /* Finish sending the rest of each of the INCR values. This should
649 be improved; there's a chance of deadlock if more than one
650 subtarget in a MULTIPLE selection requires an INCR transfer, and
651 the requestor and Emacs loop waiting on different transfers. */
652 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
655 int format_bytes
= cs
->format
/ 8;
656 bool had_errors_p
= x_had_errors_p (display
);
658 /* Must set this inside block_input (). unblock_input may read
659 events and setting property_change_reply in
660 wait_for_property_change is then too late. */
661 set_property_change_object (cs
->wait_object
);
664 bytes_remaining
= cs
->size
;
665 bytes_remaining
*= format_bytes
;
667 /* Wait for the requestor to ack by deleting the property.
668 This can run Lisp code (process handlers) or signal. */
671 TRACE1 ("Waiting for ACK (deletion of %s)",
672 XGetAtomName (display
, cs
->property
));
673 wait_for_property_change (cs
->wait_object
);
676 unexpect_property_change (cs
->wait_object
);
678 while (bytes_remaining
)
680 int i
= ((bytes_remaining
< max_bytes
)
682 : max_bytes
) / format_bytes
;
686 = expect_property_change (display
, window
, cs
->property
,
689 TRACE1 ("Sending increment of %d elements", i
);
690 TRACE1 ("Set %s to increment data",
691 XGetAtomName (display
, cs
->property
));
693 /* Append the next chunk of data to the property. */
694 XChangeProperty (display
, window
, cs
->property
,
695 cs
->type
, cs
->format
, PropModeAppend
,
697 bytes_remaining
-= i
* format_bytes
;
698 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
701 had_errors_p
= x_had_errors_p (display
);
702 // See comment above about property_change_reply.
703 set_property_change_object (cs
->wait_object
);
706 if (had_errors_p
) break;
708 /* Wait for the requestor to ack this chunk by deleting
709 the property. This can run Lisp code or signal. */
710 TRACE1 ("Waiting for increment ACK (deletion of %s)",
711 XGetAtomName (display
, cs
->property
));
712 wait_for_property_change (cs
->wait_object
);
715 /* Now write a zero-length chunk to the property to tell the
716 requestor that we're done. */
718 if (! waiting_for_other_props_on_window (display
, window
))
719 XSelectInput (display
, window
, 0);
721 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
722 XGetAtomName (display
, cs
->property
));
723 XChangeProperty (display
, window
, cs
->property
,
724 cs
->type
, cs
->format
, PropModeReplace
,
726 TRACE0 ("Done sending incrementally");
729 /* rms, 2003-01-03: I think I have fixed this bug. */
730 /* The window we're communicating with may have been deleted
731 in the meantime (that's a real situation from a bug report).
732 In this case, there may be events in the event queue still
733 referring to the deleted window, and we'll get a BadWindow error
734 in XTread_socket when processing the events. I don't have
735 an idea how to fix that. gerd, 2001-01-98. */
736 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
737 delivered before uncatch errors. */
738 XSync (display
, False
);
741 /* GTK queues events in addition to the queue in Xlib. So we
742 UNBLOCK to enter the event loop and get possible errors delivered,
743 and then BLOCK again because x_uncatch_errors requires it. */
745 /* This calls x_uncatch_errors. */
746 unbind_to (count
, Qnil
);
750 /* Handle a SelectionRequest event EVENT.
751 This is called from keyboard.c when such an event is found in the queue. */
754 x_handle_selection_request (struct selection_input_event
*event
)
756 struct gcpro gcpro1
, gcpro2
;
757 Time local_selection_time
;
759 struct x_display_info
*dpyinfo
= SELECTION_EVENT_DPYINFO (event
);
760 Atom selection
= SELECTION_EVENT_SELECTION (event
);
761 Lisp_Object selection_symbol
= x_atom_to_symbol (dpyinfo
, selection
);
762 Atom target
= SELECTION_EVENT_TARGET (event
);
763 Lisp_Object target_symbol
= x_atom_to_symbol (dpyinfo
, target
);
764 Atom property
= SELECTION_EVENT_PROPERTY (event
);
765 Lisp_Object local_selection_data
;
766 bool success
= false;
767 ptrdiff_t count
= SPECPDL_INDEX ();
768 GCPRO2 (local_selection_data
, target_symbol
);
770 if (!dpyinfo
) goto DONE
;
772 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
774 /* Decline if we don't own any selections. */
775 if (NILP (local_selection_data
)) goto DONE
;
777 /* Decline requests issued prior to our acquiring the selection. */
778 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
779 Time
, local_selection_time
);
780 if (SELECTION_EVENT_TIME (event
) != CurrentTime
781 && local_selection_time
> SELECTION_EVENT_TIME (event
))
784 x_selection_current_request
= event
;
785 selection_request_dpyinfo
= dpyinfo
;
786 record_unwind_protect_void (x_selection_request_lisp_error
);
788 /* We might be able to handle nested x_handle_selection_requests,
789 but this is difficult to test, and seems unimportant. */
790 x_start_queuing_selection_requests ();
791 record_unwind_protect_void (x_stop_queuing_selection_requests
);
793 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
794 SDATA (SYMBOL_NAME (selection_symbol
)),
795 SDATA (SYMBOL_NAME (target_symbol
)));
797 if (EQ (target_symbol
, QMULTIPLE
))
799 /* For MULTIPLE targets, the event property names a list of atom
800 pairs; the first atom names a target and the second names a
801 non-None property. */
802 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
803 Lisp_Object multprop
;
804 ptrdiff_t j
, nselections
;
806 if (property
== None
) goto DONE
;
808 = x_get_window_property_as_lisp_data (dpyinfo
, requestor
, property
,
809 QMULTIPLE
, selection
);
811 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
814 nselections
= ASIZE (multprop
) / 2;
815 /* Perform conversions. This can signal. */
816 for (j
= 0; j
< nselections
; j
++)
818 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
819 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
820 AREF (multprop
, 2*j
+1));
822 if (subproperty
!= None
)
823 x_convert_selection (selection_symbol
, subtarget
,
824 subproperty
, true, dpyinfo
);
830 if (property
== None
)
831 property
= SELECTION_EVENT_TARGET (event
);
832 success
= x_convert_selection (selection_symbol
,
833 target_symbol
, property
,
840 x_reply_selection_request (event
, dpyinfo
);
842 x_decline_selection_request (event
);
843 x_selection_current_request
= 0;
845 /* Run the `x-sent-selection-functions' abnormal hook. */
846 if (!NILP (Vx_sent_selection_functions
)
847 && !EQ (Vx_sent_selection_functions
, Qunbound
))
848 CALLN (Frun_hook_with_args
, Qx_sent_selection_functions
,
849 selection_symbol
, target_symbol
, success
? Qt
: Qnil
);
851 unbind_to (count
, Qnil
);
855 /* Perform the requested selection conversion, and write the data to
856 the converted_selections linked list, where it can be accessed by
857 x_reply_selection_request. If FOR_MULTIPLE, write out
858 the data even if conversion fails, using conversion_fail_tag.
860 Return true iff successful. */
863 x_convert_selection (Lisp_Object selection_symbol
,
864 Lisp_Object target_symbol
, Atom property
,
865 bool for_multiple
, struct x_display_info
*dpyinfo
)
868 Lisp_Object lisp_selection
;
869 struct selection_data
*cs
;
870 GCPRO1 (lisp_selection
);
873 = x_get_local_selection (selection_symbol
, target_symbol
,
876 /* A nil return value means we can't perform the conversion. */
877 if (NILP (lisp_selection
)
878 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
882 cs
= xmalloc (sizeof *cs
);
883 cs
->data
= (unsigned char *) &conversion_fail_tag
;
888 cs
->property
= property
;
889 cs
->wait_object
= NULL
;
890 cs
->next
= converted_selections
;
891 converted_selections
= cs
;
898 /* Otherwise, record the converted selection to binary. */
899 cs
= xmalloc (sizeof *cs
);
902 cs
->property
= property
;
903 cs
->wait_object
= NULL
;
904 cs
->next
= converted_selections
;
905 converted_selections
= cs
;
906 lisp_data_to_selection_data (dpyinfo
, lisp_selection
, cs
);
911 /* Handle a SelectionClear event EVENT, which indicates that some
912 client cleared out our previously asserted selection.
913 This is called from keyboard.c when such an event is found in the queue. */
916 x_handle_selection_clear (struct selection_input_event
*event
)
918 Atom selection
= SELECTION_EVENT_SELECTION (event
);
919 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
921 Lisp_Object selection_symbol
, local_selection_data
;
922 Time local_selection_time
;
923 struct x_display_info
*dpyinfo
= SELECTION_EVENT_DPYINFO (event
);
924 Lisp_Object Vselection_alist
;
926 TRACE0 ("x_handle_selection_clear");
928 if (!dpyinfo
) return;
930 selection_symbol
= x_atom_to_symbol (dpyinfo
, selection
);
931 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
933 /* Well, we already believe that we don't own it, so that's just fine. */
934 if (NILP (local_selection_data
)) return;
936 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
937 Time
, local_selection_time
);
939 /* We have reasserted the selection since this SelectionClear was
940 generated, so we can disregard it. */
941 if (changed_owner_time
!= CurrentTime
942 && local_selection_time
> changed_owner_time
)
945 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
946 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
947 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
948 Vselection_alist
= XCDR (Vselection_alist
);
952 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
953 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
955 XSETCDR (rest
, XCDR (XCDR (rest
)));
959 tset_selection_alist (dpyinfo
->terminal
, Vselection_alist
);
961 /* Run the `x-lost-selection-functions' abnormal hook. */
962 CALLN (Frun_hook_with_args
, Qx_lost_selection_functions
, selection_symbol
);
964 redisplay_preserve_echo_area (20);
968 x_handle_selection_event (struct selection_input_event
*event
)
970 TRACE0 ("x_handle_selection_event");
971 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
972 x_handle_selection_clear (event
);
973 else if (x_queue_selection_requests
)
974 x_queue_event (event
);
976 x_handle_selection_request (event
);
980 /* Clear all selections that were made from frame F.
981 We do this when about to delete a frame. */
984 x_clear_frame_selections (struct frame
*f
)
988 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
989 struct terminal
*t
= dpyinfo
->terminal
;
991 XSETFRAME (frame
, f
);
993 /* Delete elements from the beginning of Vselection_alist. */
994 while (CONSP (t
->Vselection_alist
)
995 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
997 /* Run the `x-lost-selection-functions' abnormal hook. */
998 CALLN (Frun_hook_with_args
, Qx_lost_selection_functions
,
999 Fcar (Fcar (t
->Vselection_alist
)));
1001 tset_selection_alist (t
, XCDR (t
->Vselection_alist
));
1004 /* Delete elements after the beginning of Vselection_alist. */
1005 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1006 if (CONSP (XCDR (rest
))
1007 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1009 CALLN (Frun_hook_with_args
, Qx_lost_selection_functions
,
1010 XCAR (XCAR (XCDR (rest
))));
1011 XSETCDR (rest
, XCDR (XCDR (rest
)));
1016 /* True if any properties for DISPLAY and WINDOW
1017 are on the list of what we are waiting for. */
1020 waiting_for_other_props_on_window (Display
*display
, Window window
)
1022 for (struct prop_location
*p
= property_change_wait_list
; p
; p
= p
->next
)
1023 if (p
->display
== display
&& p
->window
== window
)
1028 /* Add an entry to the list of property changes we are waiting for.
1029 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1030 The return value is a number that uniquely identifies
1031 this awaited property change. */
1033 static struct prop_location
*
1034 expect_property_change (Display
*display
, Window window
,
1035 Atom property
, int state
)
1037 struct prop_location
*pl
= xmalloc (sizeof *pl
);
1038 pl
->identifier
= ++prop_location_identifier
;
1039 pl
->display
= display
;
1040 pl
->window
= window
;
1041 pl
->property
= property
;
1042 pl
->desired_state
= state
;
1043 pl
->next
= property_change_wait_list
;
1044 pl
->arrived
= false;
1045 property_change_wait_list
= pl
;
1049 /* Delete an entry from the list of property changes we are waiting for.
1050 IDENTIFIER is the number that uniquely identifies the entry. */
1053 unexpect_property_change (struct prop_location
*location
)
1055 struct prop_location
*prop
, **pprev
= &property_change_wait_list
;
1057 for (prop
= property_change_wait_list
; prop
; prop
= *pprev
)
1059 if (prop
== location
)
1061 *pprev
= prop
->next
;
1066 pprev
= &prop
->next
;
1070 /* Remove the property change expectation element for IDENTIFIER. */
1073 wait_for_property_change_unwind (void *loc
)
1075 struct prop_location
*location
= loc
;
1077 unexpect_property_change (location
);
1078 if (location
== property_change_reply_object
)
1079 property_change_reply_object
= 0;
1082 /* Actually wait for a property change.
1083 IDENTIFIER should be the value that expect_property_change returned. */
1086 wait_for_property_change (struct prop_location
*location
)
1088 ptrdiff_t count
= SPECPDL_INDEX ();
1090 /* Make sure to do unexpect_property_change if we quit or err. */
1091 record_unwind_protect_ptr (wait_for_property_change_unwind
, location
);
1093 /* See comment in x_reply_selection_request about setting
1094 property_change_reply. Do not do it here. */
1096 /* If the event we are waiting for arrives beyond here, it will set
1097 property_change_reply, because property_change_reply_object says so. */
1098 if (! location
->arrived
)
1100 EMACS_INT timeout
= max (0, x_selection_timeout
);
1101 EMACS_INT secs
= timeout
/ 1000;
1102 int nsecs
= (timeout
% 1000) * 1000000;
1103 TRACE2 (" Waiting %"pI
"d secs, %d nsecs", secs
, nsecs
);
1104 wait_reading_process_output (secs
, nsecs
, 0, false,
1105 property_change_reply
, NULL
, 0);
1107 if (NILP (XCAR (property_change_reply
)))
1109 TRACE0 (" Timed out");
1110 error ("Timed out waiting for property-notify event");
1114 unbind_to (count
, Qnil
);
1117 /* Called from XTread_socket in response to a PropertyNotify event. */
1120 x_handle_property_notify (const XPropertyEvent
*event
)
1122 struct prop_location
*rest
;
1124 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1127 && rest
->property
== event
->atom
1128 && rest
->window
== event
->window
1129 && rest
->display
== event
->display
1130 && rest
->desired_state
== event
->state
)
1132 TRACE2 ("Expected %s of property %s",
1133 (event
->state
== PropertyDelete
? "deletion" : "change"),
1134 XGetAtomName (event
->display
, event
->atom
));
1136 rest
->arrived
= true;
1138 /* If this is the one wait_for_property_change is waiting for,
1139 tell it to wake up. */
1140 if (rest
== property_change_reply_object
)
1141 XSETCAR (property_change_reply
, Qt
);
1150 /* Variables for communication with x_handle_selection_notify. */
1151 static Atom reading_which_selection
;
1152 static Lisp_Object reading_selection_reply
;
1153 static Window reading_selection_window
;
1155 /* Do protocol to read selection-data from the server.
1156 Converts this to Lisp data and returns it.
1157 FRAME is the frame whose X window shall request the selection. */
1160 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1161 Lisp_Object time_stamp
, Lisp_Object frame
)
1163 struct frame
*f
= XFRAME (frame
);
1164 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
1165 Display
*display
= dpyinfo
->display
;
1166 Window requestor_window
= FRAME_X_WINDOW (f
);
1167 Time requestor_time
= dpyinfo
->last_user_time
;
1168 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1169 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1170 Atom type_atom
= (CONSP (target_type
)
1171 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1172 : symbol_to_x_atom (dpyinfo
, target_type
));
1173 EMACS_INT timeout
, secs
;
1176 if (!FRAME_LIVE_P (f
))
1179 if (! NILP (time_stamp
))
1180 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1183 TRACE2 ("Get selection %s, type %s",
1184 XGetAtomName (display
, type_atom
),
1185 XGetAtomName (display
, target_property
));
1187 x_catch_errors (display
);
1188 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1189 requestor_window
, requestor_time
);
1190 x_check_errors (display
, "Can't convert selection: %s");
1191 x_uncatch_errors ();
1193 /* Prepare to block until the reply has been read. */
1194 reading_selection_window
= requestor_window
;
1195 reading_which_selection
= selection_atom
;
1196 XSETCAR (reading_selection_reply
, Qnil
);
1198 /* It should not be necessary to stop handling selection requests
1199 during this time. In fact, the SAVE_TARGETS mechanism requires
1200 us to handle a clipboard manager's requests before it returns
1203 x_start_queuing_selection_requests ();
1204 record_unwind_protect_void (x_stop_queuing_selection_requests
);
1209 /* This allows quits. Also, don't wait forever. */
1210 timeout
= max (0, x_selection_timeout
);
1211 secs
= timeout
/ 1000;
1212 nsecs
= (timeout
% 1000) * 1000000;
1213 TRACE1 (" Start waiting %"pI
"d secs for SelectionNotify", secs
);
1214 wait_reading_process_output (secs
, nsecs
, 0, false,
1215 reading_selection_reply
, NULL
, 0);
1216 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1218 if (NILP (XCAR (reading_selection_reply
)))
1219 error ("Timed out waiting for reply from selection owner");
1220 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1223 /* Otherwise, the selection is waiting for us on the requested property. */
1225 x_get_window_property_as_lisp_data (dpyinfo
, requestor_window
,
1226 target_property
, target_type
,
1230 /* Subroutines of x_get_window_property_as_lisp_data */
1232 /* Use xfree, not XFree, to free the data obtained with this function. */
1235 x_get_window_property (Display
*display
, Window window
, Atom property
,
1236 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1237 Atom
*actual_type_ret
, int *actual_format_ret
,
1238 unsigned long *actual_size_ret
)
1240 ptrdiff_t total_size
;
1241 unsigned long bytes_remaining
;
1242 ptrdiff_t offset
= 0;
1243 unsigned char *data
= 0;
1244 unsigned char *tmp_data
= 0;
1246 int buffer_size
= selection_quantum (display
);
1248 /* Wide enough to avoid overflow in expressions using it. */
1249 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1251 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1252 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1253 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1254 ptrdiff_t total_size_max
=
1255 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1256 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1257 : LONG_MAX
* x_long_size
);
1261 /* First probe the thing to find out how big it is. */
1262 result
= XGetWindowProperty (display
, window
, property
,
1263 0, 0, False
, AnyPropertyType
,
1264 actual_type_ret
, actual_format_ret
,
1266 &bytes_remaining
, &tmp_data
);
1267 if (result
!= Success
)
1270 /* This was allocated by Xlib, so use XFree. */
1273 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1276 if (total_size_max
< bytes_remaining
)
1278 total_size
= bytes_remaining
;
1279 data
= xmalloc (total_size
+ 1);
1281 /* Now read, until we've gotten it all. */
1282 while (bytes_remaining
)
1284 ptrdiff_t bytes_gotten
;
1287 = XGetWindowProperty (display
, window
, property
,
1288 offset
/ X_LONG_SIZE
,
1289 buffer_size
/ X_LONG_SIZE
,
1292 actual_type_ret
, actual_format_ret
,
1293 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1295 /* If this doesn't return Success at this point, it means that
1296 some clod deleted the selection while we were in the midst of
1297 reading it. Deal with that, I guess.... */
1298 if (result
!= Success
)
1301 bytes_per_item
= *actual_format_ret
>> 3;
1302 eassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1304 /* The man page for XGetWindowProperty says:
1305 "If the returned format is 32, the returned data is represented
1306 as a long array and should be cast to that type to obtain the
1308 This applies even if long is more than 32 bits, the X library
1309 converts from 32 bit elements received from the X server to long
1310 and passes the long array to us. Thus, for that case memcpy can not
1311 be used. We convert to a 32 bit type here, because so much code
1314 The bytes and offsets passed to XGetWindowProperty refers to the
1315 property and those are indeed in 32 bit quantities if format is 32. */
1317 bytes_gotten
= *actual_size_ret
;
1318 bytes_gotten
*= bytes_per_item
;
1320 TRACE2 ("Read %"pD
"d bytes from property %s",
1321 bytes_gotten
, XGetAtomName (display
, property
));
1323 if (total_size
- offset
< bytes_gotten
)
1325 unsigned char *data1
;
1326 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1327 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1329 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1330 data1
= xrealloc (data
, total_size
+ 1);
1334 if (BITS_PER_LONG
> 32 && *actual_format_ret
== 32)
1337 int *idata
= (int *) (data
+ offset
);
1338 long *ldata
= (long *) tmp_data
;
1340 for (i
= 0; i
< *actual_size_ret
; ++i
)
1341 idata
[i
] = ldata
[i
];
1344 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1346 offset
+= bytes_gotten
;
1348 /* This was allocated by Xlib, so use XFree. */
1353 data
[offset
] = '\0';
1358 *bytes_ret
= offset
;
1365 memory_full (SIZE_MAX
);
1368 /* Use xfree, not XFree, to free the data obtained with this function. */
1371 receive_incremental_selection (struct x_display_info
*dpyinfo
,
1372 Window window
, Atom property
,
1373 Lisp_Object target_type
,
1374 unsigned int min_size_bytes
,
1375 unsigned char **data_ret
,
1376 ptrdiff_t *size_bytes_ret
,
1377 Atom
*type_ret
, int *format_ret
,
1378 unsigned long *size_ret
)
1380 ptrdiff_t offset
= 0;
1381 struct prop_location
*wait_object
;
1382 Display
*display
= dpyinfo
->display
;
1384 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1385 memory_full (SIZE_MAX
);
1386 *data_ret
= xmalloc (min_size_bytes
);
1387 *size_bytes_ret
= min_size_bytes
;
1389 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1391 /* At this point, we have read an INCR property.
1392 Delete the property to ack it.
1393 (But first, prepare to receive the next event in this handshake.)
1395 Now, we must loop, waiting for the sending window to put a value on
1396 that property, then reading the property, then deleting it to ack.
1397 We are done when the sender places a property of length 0.
1400 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1401 TRACE1 (" Delete property %s",
1402 SDATA (SYMBOL_NAME (x_atom_to_symbol (dpyinfo
, property
))));
1403 XDeleteProperty (display
, window
, property
);
1404 TRACE1 (" Expect new value of property %s",
1405 SDATA (SYMBOL_NAME (x_atom_to_symbol (dpyinfo
, property
))));
1406 wait_object
= expect_property_change (display
, window
, property
,
1409 // See comment in x_reply_selection_request about property_change_reply.
1410 set_property_change_object (wait_object
);
1415 unsigned char *tmp_data
;
1416 ptrdiff_t tmp_size_bytes
;
1418 TRACE0 (" Wait for property change");
1419 wait_for_property_change (wait_object
);
1421 /* expect it again immediately, because x_get_window_property may
1422 .. no it won't, I don't get it.
1423 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1424 TRACE0 (" Get property value");
1425 x_get_window_property (display
, window
, property
,
1426 &tmp_data
, &tmp_size_bytes
,
1427 type_ret
, format_ret
, size_ret
);
1429 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1431 if (tmp_size_bytes
== 0) /* we're done */
1433 TRACE0 ("Done reading incrementally");
1435 if (! waiting_for_other_props_on_window (display
, window
))
1436 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1437 /* Use xfree, not XFree, because x_get_window_property
1438 calls xmalloc itself. */
1444 TRACE1 (" ACK by deleting property %s",
1445 XGetAtomName (display
, property
));
1446 XDeleteProperty (display
, window
, property
);
1447 wait_object
= expect_property_change (display
, window
, property
,
1449 // See comment in x_reply_selection_request about property_change_reply.
1450 set_property_change_object (wait_object
);
1454 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1455 *data_ret
= xpalloc (*data_ret
, size_bytes_ret
,
1456 tmp_size_bytes
- (*size_bytes_ret
- offset
),
1459 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1460 offset
+= tmp_size_bytes
;
1462 /* Use xfree, not XFree, because x_get_window_property
1463 calls xmalloc itself. */
1469 /* Fetch a value from property PROPERTY of X window WINDOW on display
1470 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1474 x_get_window_property_as_lisp_data (struct x_display_info
*dpyinfo
,
1475 Window window
, Atom property
,
1476 Lisp_Object target_type
,
1477 Atom selection_atom
)
1481 unsigned long actual_size
;
1482 unsigned char *data
= 0;
1483 ptrdiff_t bytes
= 0;
1485 Display
*display
= dpyinfo
->display
;
1487 TRACE0 ("Reading selection data");
1489 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1490 &actual_type
, &actual_format
, &actual_size
);
1494 bool there_is_a_selection_owner
1495 = XGetSelectionOwner (display
, selection_atom
) != 0;
1497 if (there_is_a_selection_owner
)
1498 signal_error ("Selection owner couldn't convert",
1500 ? list2 (target_type
,
1501 x_atom_to_symbol (dpyinfo
, actual_type
))
1504 signal_error ("No selection",
1505 x_atom_to_symbol (dpyinfo
, selection_atom
));
1508 if (actual_type
== dpyinfo
->Xatom_INCR
)
1510 /* That wasn't really the data, just the beginning. */
1512 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1514 /* Use xfree, not XFree, because x_get_window_property
1515 calls xmalloc itself. */
1518 receive_incremental_selection (dpyinfo
, window
, property
, target_type
,
1519 min_size_bytes
, &data
, &bytes
,
1520 &actual_type
, &actual_format
,
1525 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1526 XDeleteProperty (display
, window
, property
);
1530 /* It's been read. Now convert it to a lisp object in some semi-rational
1532 val
= selection_data_to_lisp_data (dpyinfo
, data
, bytes
,
1533 actual_type
, actual_format
);
1535 /* Use xfree, not XFree, because x_get_window_property
1536 calls xmalloc itself. */
1541 /* These functions convert from the selection data read from the server into
1542 something that we can use from Lisp, and vice versa.
1544 Type: Format: Size: Lisp Type:
1545 ----- ------- ----- -----------
1548 ATOM 32 > 1 Vector of Symbols
1550 * 16 > 1 Vector of Integers
1551 * 32 1 if <=16 bits: Integer
1552 if > 16 bits: Cons of top16, bot16
1553 * 32 > 1 Vector of the above
1555 When converting a Lisp number to C, it is assumed to be of format 16 if
1556 it is an integer, and of format 32 if it is a cons of two integers.
1558 When converting a vector of numbers from Lisp to C, it is assumed to be
1559 of format 16 if every element in the vector is an integer, and is assumed
1560 to be of format 32 if any element is a cons of two integers.
1562 When converting an object to C, it may be of the form (SYMBOL . <data>)
1563 where SYMBOL is what we should claim that the type is. Format and
1564 representation are as above.
1566 Important: When format is 32, data should contain an array of int,
1567 not an array of long as the X library returns. This makes a difference
1568 when sizeof(long) != sizeof(int). */
1573 selection_data_to_lisp_data (struct x_display_info
*dpyinfo
,
1574 const unsigned char *data
,
1575 ptrdiff_t size
, Atom type
, int format
)
1577 if (type
== dpyinfo
->Xatom_NULL
)
1580 /* Convert any 8-bit data to a string, for compactness. */
1581 else if (format
== 8)
1583 Lisp_Object str
, lispy_type
;
1585 str
= make_unibyte_string ((char *) data
, size
);
1586 /* Indicate that this string is from foreign selection by a text
1587 property `foreign-selection' so that the caller of
1588 x-get-selection-internal (usually x-get-selection) can know
1589 that the string must be decode. */
1590 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1591 lispy_type
= QCOMPOUND_TEXT
;
1592 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1593 lispy_type
= QUTF8_STRING
;
1595 lispy_type
= QSTRING
;
1596 Fput_text_property (make_number (0), make_number (size
),
1597 Qforeign_selection
, lispy_type
, str
);
1600 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1601 a vector of symbols. */
1602 else if (type
== XA_ATOM
1603 /* Treat ATOM_PAIR type similar to list of atoms. */
1604 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1607 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1608 But the callers of these function has made sure the data for
1609 format == 32 is an array of int. Thus, use int instead
1611 int *idata
= (int *) data
;
1613 if (size
== sizeof (int))
1614 return x_atom_to_symbol (dpyinfo
, (Atom
) idata
[0]);
1617 Lisp_Object v
= make_uninit_vector (size
/ sizeof (int));
1619 for (i
= 0; i
< size
/ sizeof (int); i
++)
1620 ASET (v
, i
, x_atom_to_symbol (dpyinfo
, (Atom
) idata
[i
]));
1625 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1626 If the number is 32 bits and won't fit in a Lisp_Int,
1627 convert it to a cons of integers, 16 bits in each half.
1629 else if (format
== 32 && size
== sizeof (int))
1630 return INTEGER_TO_CONS (((int *) data
) [0]);
1631 else if (format
== 16 && size
== sizeof (short))
1632 return make_number (((short *) data
) [0]);
1634 /* Convert any other kind of data to a vector of numbers, represented
1635 as above (as an integer, or a cons of two 16 bit integers.)
1637 else if (format
== 16)
1640 Lisp_Object v
= make_uninit_vector (size
/ 2);
1642 for (i
= 0; i
< size
/ 2; i
++)
1644 short j
= ((short *) data
) [i
];
1645 ASET (v
, i
, make_number (j
));
1652 Lisp_Object v
= make_uninit_vector (size
/ X_LONG_SIZE
);
1654 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1656 int j
= ((int *) data
) [i
];
1657 ASET (v
, i
, INTEGER_TO_CONS (j
));
1663 /* Convert OBJ to an X long value, and return it as unsigned long.
1664 OBJ should be an integer or a cons representing an integer.
1665 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1666 unsigned long values: in theory these values are supposed to be
1667 signed but in practice unsigned 32-bit data are communicated via X
1668 selections and we need to support that. */
1669 static unsigned long
1670 cons_to_x_long (Lisp_Object obj
)
1672 if (X_ULONG_MAX
<= INTMAX_MAX
1673 || XINT (INTEGERP (obj
) ? obj
: XCAR (obj
)) < 0)
1674 return cons_to_signed (obj
, X_LONG_MIN
, min (X_ULONG_MAX
, INTMAX_MAX
));
1676 return cons_to_unsigned (obj
, X_ULONG_MAX
);
1679 /* Use xfree, not XFree, to free the data obtained with this function. */
1682 lisp_data_to_selection_data (struct x_display_info
*dpyinfo
,
1683 Lisp_Object obj
, struct selection_data
*cs
)
1685 Lisp_Object type
= Qnil
;
1687 eassert (cs
!= NULL
);
1690 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1694 if (CONSP (obj
) && NILP (XCDR (obj
)))
1698 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1699 { /* This is not the same as declining */
1705 else if (STRINGP (obj
))
1707 if (SCHARS (obj
) < SBYTES (obj
))
1708 /* OBJ is a multibyte string containing a non-ASCII char. */
1709 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1713 cs
->size
= SBYTES (obj
);
1714 cs
->data
= SDATA (obj
);
1717 else if (SYMBOLP (obj
))
1719 void *data
= xmalloc (sizeof (Atom
) + 1);
1720 Atom
*x_atom_ptr
= data
;
1724 cs
->data
[sizeof (Atom
)] = 0;
1725 *x_atom_ptr
= symbol_to_x_atom (dpyinfo
, obj
);
1726 if (NILP (type
)) type
= QATOM
;
1728 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1730 void *data
= xmalloc (sizeof (short) + 1);
1731 short *short_ptr
= data
;
1735 cs
->data
[sizeof (short)] = 0;
1736 *short_ptr
= XINT (obj
);
1737 if (NILP (type
)) type
= QINTEGER
;
1739 else if (INTEGERP (obj
)
1740 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1741 && (INTEGERP (XCDR (obj
))
1742 || (CONSP (XCDR (obj
))
1743 && INTEGERP (XCAR (XCDR (obj
)))))))
1745 void *data
= xmalloc (sizeof (unsigned long) + 1);
1746 unsigned long *x_long_ptr
= data
;
1750 cs
->data
[sizeof (unsigned long)] = 0;
1751 *x_long_ptr
= cons_to_x_long (obj
);
1752 if (NILP (type
)) type
= QINTEGER
;
1754 else if (VECTORP (obj
))
1756 /* Lisp_Vectors may represent a set of ATOMs;
1757 a set of 16 or 32 bit INTEGERs;
1758 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1761 ptrdiff_t size
= ASIZE (obj
);
1763 if (SYMBOLP (AREF (obj
, 0)))
1764 /* This vector is an ATOM set */
1768 if (NILP (type
)) type
= QATOM
;
1769 for (i
= 0; i
< size
; i
++)
1770 if (!SYMBOLP (AREF (obj
, i
)))
1771 signal_error ("All elements of selection vector must have same type", obj
);
1773 cs
->data
= data
= xnmalloc (size
, sizeof *x_atoms
);
1777 for (i
= 0; i
< size
; i
++)
1778 x_atoms
[i
] = symbol_to_x_atom (dpyinfo
, AREF (obj
, i
));
1781 /* This vector is an INTEGER set, or something like it */
1784 int data_size
= sizeof (short);
1786 unsigned long *x_atoms
;
1788 if (NILP (type
)) type
= QINTEGER
;
1789 for (i
= 0; i
< size
; i
++)
1791 if (! RANGED_INTEGERP (X_SHRT_MIN
, AREF (obj
, i
),
1794 /* Use sizeof (long) even if it is more than 32 bits.
1795 See comment in x_get_window_property and
1796 x_fill_property_data. */
1797 data_size
= sizeof (long);
1802 cs
->data
= data
= xnmalloc (size
, data_size
);
1805 cs
->format
= format
;
1807 for (i
= 0; i
< size
; i
++)
1810 x_atoms
[i
] = cons_to_x_long (AREF (obj
, i
));
1812 shorts
[i
] = XINT (AREF (obj
, i
));
1817 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1819 cs
->type
= symbol_to_x_atom (dpyinfo
, type
);
1823 clean_local_selection_data (Lisp_Object obj
)
1826 && INTEGERP (XCAR (obj
))
1827 && CONSP (XCDR (obj
))
1828 && INTEGERP (XCAR (XCDR (obj
)))
1829 && NILP (XCDR (XCDR (obj
))))
1830 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1833 && INTEGERP (XCAR (obj
))
1834 && INTEGERP (XCDR (obj
)))
1836 if (XINT (XCAR (obj
)) == 0)
1838 if (XINT (XCAR (obj
)) == -1)
1839 return make_number (- XINT (XCDR (obj
)));
1844 ptrdiff_t size
= ASIZE (obj
);
1847 return clean_local_selection_data (AREF (obj
, 0));
1848 copy
= make_uninit_vector (size
);
1849 for (i
= 0; i
< size
; i
++)
1850 ASET (copy
, i
, clean_local_selection_data (AREF (obj
, i
)));
1856 /* Called from XTread_socket to handle SelectionNotify events.
1857 If it's the selection we are waiting for, stop waiting
1858 by setting the car of reading_selection_reply to non-nil.
1859 We store t there if the reply is successful, lambda if not. */
1862 x_handle_selection_notify (const XSelectionEvent
*event
)
1864 if (event
->requestor
!= reading_selection_window
)
1866 if (event
->selection
!= reading_which_selection
)
1869 TRACE0 ("Received SelectionNotify");
1870 XSETCAR (reading_selection_reply
,
1871 (event
->property
!= 0 ? Qt
: Qlambda
));
1875 /* From a Lisp_Object, return a suitable frame for selection
1876 operations. OBJECT may be a frame, a terminal object, or nil
1877 (which stands for the selected frame--or, if that is not an X
1878 frame, the first X display on the list). If no suitable frame can
1879 be found, return NULL. */
1881 static struct frame
*
1882 frame_for_x_selection (Lisp_Object object
)
1884 Lisp_Object tail
, frame
;
1889 f
= XFRAME (selected_frame
);
1890 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1893 FOR_EACH_FRAME (tail
, frame
)
1896 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1900 else if (TERMINALP (object
))
1902 struct terminal
*t
= decode_live_terminal (object
);
1904 if (t
->type
== output_x_window
)
1905 FOR_EACH_FRAME (tail
, frame
)
1908 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1912 else if (FRAMEP (object
))
1914 f
= XFRAME (object
);
1915 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1923 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1924 Sx_own_selection_internal
, 2, 3, 0,
1925 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1926 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1927 \(Those are literal upper-case symbol names, since that's what X expects.)
1928 VALUE is typically a string, or a cons of two markers, but may be
1929 anything that the functions on `selection-converter-alist' know about.
1931 FRAME should be a frame that should own the selection. If omitted or
1932 nil, it defaults to the selected frame.
1934 On Nextstep, FRAME is unused. */)
1935 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1937 if (NILP (frame
)) frame
= selected_frame
;
1938 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1939 error ("X selection unavailable for this frame");
1941 CHECK_SYMBOL (selection
);
1942 if (NILP (value
)) error ("VALUE may not be nil");
1943 x_own_selection (selection
, value
, frame
);
1948 /* Request the selection value from the owner. If we are the owner,
1949 simply return our selection value. If we are not the owner, this
1950 will block until all of the data has arrived. */
1952 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1953 Sx_get_selection_internal
, 2, 4, 0,
1954 doc
: /* Return text selected from some X window.
1955 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1956 \(Those are literal upper-case symbol names, since that's what X expects.)
1957 TARGET-TYPE is the type of data desired, typically `STRING'.
1959 TIME-STAMP is the time to use in the XConvertSelection call for foreign
1960 selections. If omitted, defaults to the time for the last event.
1962 TERMINAL should be a terminal object or a frame specifying the X
1963 server to query. If omitted or nil, that stands for the selected
1964 frame's display, or the first available X display.
1966 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
1967 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1968 Lisp_Object time_stamp
, Lisp_Object terminal
)
1970 Lisp_Object val
= Qnil
;
1971 struct gcpro gcpro1
, gcpro2
;
1972 struct frame
*f
= frame_for_x_selection (terminal
);
1973 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1975 CHECK_SYMBOL (selection_symbol
);
1976 CHECK_SYMBOL (target_type
);
1977 if (EQ (target_type
, QMULTIPLE
))
1978 error ("Retrieving MULTIPLE selections is currently unimplemented");
1980 error ("X selection unavailable for this frame");
1982 val
= x_get_local_selection (selection_symbol
, target_type
, true,
1983 FRAME_DISPLAY_INFO (f
));
1985 if (NILP (val
) && FRAME_LIVE_P (f
))
1988 XSETFRAME (frame
, f
);
1989 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
1990 time_stamp
, frame
));
1993 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
1996 if (CONSP (val
) && NILP (XCDR (val
)))
1999 RETURN_UNGCPRO (clean_local_selection_data (val
));
2002 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2003 Sx_disown_selection_internal
, 1, 3, 0,
2004 doc
: /* If we own the selection SELECTION, disown it.
2005 Disowning it means there is no such selection.
2007 Sets the last-change time for the selection to TIME-OBJECT (by default
2008 the time of the last event).
2010 TERMINAL should be a terminal object or a frame specifying the X
2011 server to query. If omitted or nil, that stands for the selected
2012 frame's display, or the first available X display.
2014 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2015 On MS-DOS, all this does is return non-nil if we own the selection. */)
2016 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2019 Atom selection_atom
;
2020 struct selection_input_event event
;
2021 struct frame
*f
= frame_for_x_selection (terminal
);
2022 struct x_display_info
*dpyinfo
;
2027 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2028 CHECK_SYMBOL (selection
);
2030 /* Don't disown the selection when we're not the owner. */
2031 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2034 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2037 if (NILP (time_object
))
2038 timestamp
= dpyinfo
->last_user_time
;
2040 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2041 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2044 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2045 generated for a window which owns the selection when that window sets
2046 the selection owner to None. The NCD server does, the MIT Sun4 server
2047 doesn't. So we synthesize one; this means we might get two, but
2048 that's ok, because the second one won't have any effect. */
2049 SELECTION_EVENT_DPYINFO (&event
) = dpyinfo
;
2050 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2051 SELECTION_EVENT_TIME (&event
) = timestamp
;
2052 x_handle_selection_clear (&event
);
2057 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2059 doc
: /* Whether the current Emacs process owns the given X Selection.
2060 The arg should be the name of the selection in question, typically one of
2061 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2062 \(Those are literal upper-case symbol names, since that's what X expects.)
2063 For convenience, the symbol nil is the same as `PRIMARY',
2064 and t is the same as `SECONDARY'.
2066 TERMINAL should be a terminal object or a frame specifying the X
2067 server to query. If omitted or nil, that stands for the selected
2068 frame's display, or the first available X display.
2070 On Nextstep, TERMINAL is unused. */)
2071 (Lisp_Object selection
, Lisp_Object terminal
)
2073 struct frame
*f
= frame_for_x_selection (terminal
);
2075 CHECK_SYMBOL (selection
);
2076 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2077 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2079 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_DISPLAY_INFO (f
))))
2085 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2087 doc
: /* Whether there is an owner for the given X selection.
2088 SELECTION should be the name of the selection in question, typically
2089 one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2090 `CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2091 symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
2093 TERMINAL should be a terminal object or a frame specifying the X
2094 server to query. If omitted or nil, that stands for the selected
2095 frame's display, or the first available X display.
2097 On Nextstep, TERMINAL is unused. */)
2098 (Lisp_Object selection
, Lisp_Object terminal
)
2102 struct frame
*f
= frame_for_x_selection (terminal
);
2103 struct x_display_info
*dpyinfo
;
2105 CHECK_SYMBOL (selection
);
2106 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2107 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2112 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2114 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2117 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2118 if (atom
== 0) return Qnil
;
2120 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2122 return (owner
? Qt
: Qnil
);
2126 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2127 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2130 x_clipboard_manager_save (Lisp_Object frame
)
2132 struct frame
*f
= XFRAME (frame
);
2133 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2134 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2136 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2137 dpyinfo
->Xatom_EMACS_TMP
,
2138 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2139 (unsigned char *) &data
, 1);
2140 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2145 /* Error handler for x_clipboard_manager_save_frame. */
2148 x_clipboard_manager_error_1 (Lisp_Object err
)
2150 AUTO_STRING (format
, "X clipboard manager error: %s\n\
2151 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2152 CALLN (Fmessage
, format
, CAR (CDR (err
)));
2156 /* Error handler for x_clipboard_manager_save_all. */
2159 x_clipboard_manager_error_2 (Lisp_Object err
)
2161 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2162 If the problem persists, set `x-select-enable-clipboard-manager' \
2167 /* Called from delete_frame: save any clipboard owned by FRAME to the
2168 clipboard manager. Do nothing if FRAME does not own the clipboard,
2169 or if no clipboard manager is present. */
2172 x_clipboard_manager_save_frame (Lisp_Object frame
)
2176 if (!NILP (Vx_select_enable_clipboard_manager
)
2178 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2179 && FRAME_LIVE_P (f
))
2181 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2182 Lisp_Object local_selection
2183 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2185 if (!NILP (local_selection
)
2186 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2187 && XGetSelectionOwner (dpyinfo
->display
,
2188 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2189 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2190 x_clipboard_manager_error_1
);
2194 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2195 clipboard manager. Do nothing if FRAME does not own the clipboard,
2196 or if no clipboard manager is present. */
2199 x_clipboard_manager_save_all (void)
2201 /* Loop through all X displays, saving owned clipboards. */
2202 struct x_display_info
*dpyinfo
;
2203 Lisp_Object local_selection
, local_frame
;
2205 if (NILP (Vx_select_enable_clipboard_manager
))
2208 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2210 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2211 if (NILP (local_selection
)
2212 || !XGetSelectionOwner (dpyinfo
->display
,
2213 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2216 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2217 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2219 message ("Saving clipboard to X clipboard manager...");
2220 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2221 Qt
, x_clipboard_manager_error_2
);
2227 /***********************************************************************
2228 Drag and drop support
2229 ***********************************************************************/
2230 /* Check that lisp values are of correct type for x_fill_property_data.
2231 That is, number, string or a cons with two numbers (low and high 16
2232 bit parts of a 32 bit number). Return the number of items in DATA,
2233 or -1 if there is an error. */
2236 x_check_property_data (Lisp_Object data
)
2241 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2243 Lisp_Object o
= XCAR (iter
);
2245 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2247 else if (CONSP (o
) &&
2248 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2250 if (size
== INT_MAX
)
2258 /* Convert lisp values to a C array. Values may be a number, a string
2259 which is taken as an X atom name and converted to the atom value, or
2260 a cons containing the two 16 bit parts of a 32 bit number.
2262 DPY is the display use to look up X atoms.
2263 DATA is a Lisp list of values to be converted.
2264 RET is the C array that contains the converted values. It is assumed
2265 it is big enough to hold all values.
2266 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2267 be stored in RET. Note that long is used for 32 even if long is more
2268 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2269 XClientMessageEvent). */
2272 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2275 unsigned long *d32
= (unsigned long *) ret
;
2276 unsigned short *d16
= (unsigned short *) ret
;
2277 unsigned char *d08
= (unsigned char *) ret
;
2280 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2282 Lisp_Object o
= XCAR (iter
);
2284 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2287 && RANGED_INTEGERP (X_LONG_MIN
>> 16, XCAR (o
), X_LONG_MAX
>> 16)
2288 && RANGED_INTEGERP (- (1 << 15), XCDR (o
), -1))
2290 /* cons_to_x_long does not handle negative values for v2.
2291 For XDnd, v2 might be y of a window, and can be negative.
2292 The XDnd spec. is not explicit about negative values,
2293 but let's assume negative v2 is sent modulo 2**16. */
2294 unsigned long v1
= XINT (XCAR (o
)) & 0xffff;
2295 unsigned long v2
= XINT (XCDR (o
)) & 0xffff;
2296 val
= (v1
<< 16) | v2
;
2299 val
= cons_to_x_long (o
);
2301 else if (STRINGP (o
))
2304 val
= XInternAtom (dpy
, SSDATA (o
), False
);
2308 error ("Wrong type, must be string, number or cons");
2312 if ((1 << 8) < val
&& val
<= X_ULONG_MAX
- (1 << 7))
2313 error ("Out of 'char' range");
2316 else if (format
== 16)
2318 if ((1 << 16) < val
&& val
<= X_ULONG_MAX
- (1 << 15))
2319 error ("Out of 'short' range");
2327 /* Convert an array of C values to a Lisp list.
2328 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2329 DATA is a C array of values to be converted.
2330 TYPE is the type of the data. Only XA_ATOM is special, it converts
2331 each number in DATA to its corresponding X atom as a symbol.
2332 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2334 SIZE is the number of elements in DATA.
2336 Important: When format is 32, data should contain an array of int,
2337 not an array of long as the X library returns. This makes a difference
2338 when sizeof(long) != sizeof(int).
2340 Also see comment for selection_data_to_lisp_data above. */
2343 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2344 Atom type
, int format
, unsigned long size
)
2346 ptrdiff_t format_bytes
= format
>> 3;
2347 if (PTRDIFF_MAX
/ format_bytes
< size
)
2348 memory_full (SIZE_MAX
);
2349 return selection_data_to_lisp_data (FRAME_DISPLAY_INFO (f
), data
,
2350 size
* format_bytes
, type
, format
);
2353 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2354 Sx_get_atom_name
, 1, 2, 0,
2355 doc
: /* Return the X atom name for VALUE as a string.
2356 VALUE may be a number or a cons where the car is the upper 16 bits and
2357 the cdr is the lower 16 bits of a 32 bit value.
2358 Use the display for FRAME or the current frame if FRAME is not given or nil.
2360 If the value is 0 or the atom is not known, return the empty string. */)
2361 (Lisp_Object value
, Lisp_Object frame
)
2363 struct frame
*f
= decode_window_system_frame (frame
);
2366 Lisp_Object ret
= Qnil
;
2367 Display
*dpy
= FRAME_X_DISPLAY (f
);
2371 CONS_TO_INTEGER (value
, Atom
, atom
);
2374 x_catch_errors (dpy
);
2375 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2376 had_errors_p
= x_had_errors_p (dpy
);
2377 x_uncatch_errors ();
2380 ret
= build_string (name
);
2382 if (atom
&& name
) XFree (name
);
2383 if (NILP (ret
)) ret
= empty_unibyte_string
;
2390 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2391 Sx_register_dnd_atom
, 1, 2, 0,
2392 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2393 ATOM can be a symbol or a string. The ATOM is interned on the display that
2394 FRAME is on. If FRAME is nil, the selected frame is used. */)
2395 (Lisp_Object atom
, Lisp_Object frame
)
2398 struct frame
*f
= decode_window_system_frame (frame
);
2400 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2404 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2405 else if (STRINGP (atom
))
2408 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2412 error ("ATOM must be a symbol or a string");
2414 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2415 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2418 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2419 dpyinfo
->x_dnd_atoms
=
2420 xpalloc (dpyinfo
->x_dnd_atoms
, &dpyinfo
->x_dnd_atoms_size
,
2421 1, -1, sizeof *dpyinfo
->x_dnd_atoms
);
2423 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2427 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2430 x_handle_dnd_message (struct frame
*f
, const XClientMessageEvent
*event
,
2431 struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2435 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2436 unsigned long size
= 160/event
->format
;
2438 unsigned char *data
= (unsigned char *) event
->data
.b
;
2442 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2443 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2445 if (i
== dpyinfo
->x_dnd_atoms_length
) return false;
2447 XSETFRAME (frame
, f
);
2449 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2450 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2451 function expects them to be of size int (i.e. 32). So to be able to
2452 use that function, put the data in the form it expects if format is 32. */
2454 if (BITS_PER_LONG
> 32 && event
->format
== 32)
2456 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2457 idata
[i
] = event
->data
.l
[i
];
2458 data
= (unsigned char *) idata
;
2461 vec
= Fmake_vector (make_number (4), Qnil
);
2462 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_DISPLAY_INFO (f
),
2463 event
->message_type
)));
2464 ASET (vec
, 1, frame
);
2465 ASET (vec
, 2, make_number (event
->format
));
2466 ASET (vec
, 3, x_property_data_to_lisp (f
,
2468 event
->message_type
,
2472 x_relative_mouse_position (f
, &x
, &y
);
2473 bufp
->kind
= DRAG_N_DROP_EVENT
;
2474 bufp
->frame_or_window
= frame
;
2475 bufp
->timestamp
= CurrentTime
;
2476 bufp
->x
= make_number (x
);
2477 bufp
->y
= make_number (y
);
2479 bufp
->modifiers
= 0;
2484 DEFUN ("x-send-client-message", Fx_send_client_message
,
2485 Sx_send_client_message
, 6, 6, 0,
2486 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2488 For DISPLAY, specify either a frame or a display name (a string).
2489 If DISPLAY is nil, that stands for the selected frame's display.
2490 DEST may be a number, in which case it is a Window id. The value 0 may
2491 be used to send to the root window of the DISPLAY.
2492 If DEST is a cons, it is converted to a 32 bit number
2493 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2494 number is then used as a window id.
2495 If DEST is a frame the event is sent to the outer window of that frame.
2496 A value of nil means the currently selected frame.
2497 If DEST is the string "PointerWindow" the event is sent to the window that
2498 contains the pointer. If DEST is the string "InputFocus" the event is
2499 sent to the window that has the input focus.
2500 FROM is the frame sending the event. Use nil for currently selected frame.
2501 MESSAGE-TYPE is the name of an Atom as a string.
2502 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2503 bits. VALUES is a list of numbers, cons and/or strings containing the values
2504 to send. If a value is a string, it is converted to an Atom and the value of
2505 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2506 with the high 16 bits from the car and the lower 16 bit from the cdr.
2507 If more values than fits into the event is given, the excessive values
2509 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2510 Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2512 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2514 CHECK_STRING (message_type
);
2515 x_send_client_event (display
, dest
, from
,
2516 XInternAtom (dpyinfo
->display
,
2517 SSDATA (message_type
),
2525 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2526 Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2528 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2531 struct frame
*f
= decode_window_system_frame (from
);
2534 CHECK_NUMBER (format
);
2535 CHECK_CONS (values
);
2537 if (x_check_property_data (values
) == -1)
2538 error ("Bad data in VALUES, must be number, cons or string");
2540 if (XINT (format
) != 8 && XINT (format
) != 16 && XINT (format
) != 32)
2541 error ("FORMAT must be one of 8, 16 or 32");
2543 event
.xclient
.type
= ClientMessage
;
2544 event
.xclient
.format
= XINT (format
);
2546 if (FRAMEP (dest
) || NILP (dest
))
2548 struct frame
*fdest
= decode_window_system_frame (dest
);
2549 wdest
= FRAME_OUTER_WINDOW (fdest
);
2551 else if (STRINGP (dest
))
2553 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2554 wdest
= PointerWindow
;
2555 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2558 error ("DEST as a string must be one of PointerWindow or InputFocus");
2560 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2561 CONS_TO_INTEGER (dest
, Window
, wdest
);
2563 error ("DEST must be a frame, nil, string, number or cons");
2565 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2566 to_root
= wdest
== dpyinfo
->root_window
;
2570 event
.xclient
.send_event
= True
;
2571 event
.xclient
.serial
= 0;
2572 event
.xclient
.message_type
= message_type
;
2573 event
.xclient
.display
= dpyinfo
->display
;
2575 /* Some clients (metacity for example) expects sending window to be here
2576 when sending to the root window. */
2577 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2579 memset (event
.xclient
.data
.l
, 0, sizeof (event
.xclient
.data
.l
));
2580 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2581 event
.xclient
.format
);
2583 /* If event mask is 0 the event is sent to the client that created
2584 the destination window. But if we are sending to the root window,
2585 there is no such client. Then we set the event mask to 0xffffff. The
2586 event then goes to clients selecting for events on the root window. */
2587 x_catch_errors (dpyinfo
->display
);
2589 bool propagate
= !to_root
;
2590 long mask
= to_root
? 0xffffff : 0;
2592 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2593 XFlush (dpyinfo
->display
);
2595 x_uncatch_errors ();
2601 syms_of_xselect (void)
2603 defsubr (&Sx_get_selection_internal
);
2604 defsubr (&Sx_own_selection_internal
);
2605 defsubr (&Sx_disown_selection_internal
);
2606 defsubr (&Sx_selection_owner_p
);
2607 defsubr (&Sx_selection_exists_p
);
2609 defsubr (&Sx_get_atom_name
);
2610 defsubr (&Sx_send_client_message
);
2611 defsubr (&Sx_register_dnd_atom
);
2613 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2614 staticpro (&reading_selection_reply
);
2615 reading_selection_window
= 0;
2616 reading_which_selection
= 0;
2618 property_change_wait_list
= 0;
2619 prop_location_identifier
= 0;
2620 property_change_reply
= Fcons (Qnil
, Qnil
);
2621 staticpro (&property_change_reply
);
2623 converted_selections
= NULL
;
2624 conversion_fail_tag
= None
;
2626 /* FIXME: Duplicate definition in nsselect.c. */
2627 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2628 doc
: /* An alist associating X Windows selection-types with functions.
2629 These functions are called to convert the selection, with three args:
2630 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2631 a desired type to which the selection should be converted;
2632 and the local selection value (whatever was given to
2633 `x-own-selection-internal').
2635 The function should return the value to send to the X server
2636 \(typically a string). A return value of nil
2637 means that the conversion could not be done.
2638 A return value which is the symbol `NULL'
2639 means that a side-effect was executed,
2640 and there is no meaningful selection value. */);
2641 Vselection_converter_alist
= Qnil
;
2643 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2644 doc
: /* A list of functions to be called when Emacs loses an X selection.
2645 \(This happens when some other X client makes its own selection
2646 or when a Lisp program explicitly clears the selection.)
2647 The functions are called with one argument, the selection type
2648 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2649 Vx_lost_selection_functions
= Qnil
;
2651 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2652 doc
: /* A list of functions to be called when Emacs answers a selection request.
2653 The functions are called with three arguments:
2654 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2655 - the selection-type which Emacs was asked to convert the
2656 selection into before sending (for example, `STRING' or `LENGTH');
2657 - a flag indicating success or failure for responding to the request.
2658 We might have failed (and declined the request) for any number of reasons,
2659 including being asked for a selection that we no longer own, or being asked
2660 to convert into a type that we don't know about or that is inappropriate.
2661 This hook doesn't let you change the behavior of Emacs's selection replies,
2662 it merely informs you that they have happened. */);
2663 Vx_sent_selection_functions
= Qnil
;
2665 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2666 Vx_select_enable_clipboard_manager
,
2667 doc
: /* Whether to enable X clipboard manager support.
2668 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2669 while owning the X clipboard, the clipboard contents are saved to the
2670 clipboard manager if one is present. */);
2671 Vx_select_enable_clipboard_manager
= Qt
;
2673 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2674 doc
: /* Number of milliseconds to wait for a selection reply.
2675 If the selection owner doesn't reply in this time, we give up.
2676 A value of 0 means wait as long as necessary. This is initialized from the
2677 \"*selectionTimeout\" resource. */);
2678 x_selection_timeout
= 0;
2680 /* QPRIMARY is defined in keyboard.c. */
2681 DEFSYM (QSECONDARY
, "SECONDARY");
2682 DEFSYM (QSTRING
, "STRING");
2683 DEFSYM (QINTEGER
, "INTEGER");
2684 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2685 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2686 DEFSYM (QTEXT
, "TEXT");
2688 /* These are types of selection. */
2689 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2690 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2692 DEFSYM (QDELETE
, "DELETE");
2693 DEFSYM (QMULTIPLE
, "MULTIPLE");
2694 DEFSYM (QINCR
, "INCR");
2695 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2696 DEFSYM (QTARGETS
, "TARGETS");
2697 DEFSYM (QATOM
, "ATOM");
2698 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2699 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2700 DEFSYM (QNULL
, "NULL");
2701 DEFSYM (Qforeign_selection
, "foreign-selection");
2702 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2703 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");