1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2014 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 input_event
*);
49 static int x_convert_selection (struct input_event
*, Lisp_Object
, Lisp_Object
,
50 Atom
, int, struct x_display_info
*);
51 static int 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 (Display
*,
59 static Lisp_Object
selection_data_to_lisp_data (Display
*,
60 const unsigned char *,
61 ptrdiff_t, Atom
, int);
62 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
63 unsigned char **, Atom
*,
64 ptrdiff_t *, int *, int *);
66 /* Printing traces to stderr. */
68 #ifdef TRACE_SELECTION
70 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
71 #define TRACE1(fmt, a0) \
72 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
73 #define TRACE2(fmt, a0, a1) \
74 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
75 #define TRACE3(fmt, a0, a1, a2) \
76 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
78 #define TRACE0(fmt) (void) 0
79 #define TRACE1(fmt, a0) (void) 0
80 #define TRACE2(fmt, a0, a1) (void) 0
84 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
85 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
86 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
88 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
89 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
91 static Lisp_Object Qcompound_text_with_extensions
;
93 static Lisp_Object Qforeign_selection
;
94 static Lisp_Object Qx_lost_selection_functions
, Qx_sent_selection_functions
;
96 /* Bytes needed to represent 'long' data. This is as per libX11; it
97 is not necessarily sizeof (long). */
100 /* Extreme 'short' and 'long' values suitable for libX11. */
101 #define X_SHRT_MAX 0x7fff
102 #define X_SHRT_MIN (-1 - X_SHRT_MAX)
103 #define X_LONG_MAX 0x7fffffff
104 #define X_LONG_MIN (-1 - X_LONG_MAX)
105 #define X_ULONG_MAX 0xffffffffUL
107 /* If this is a smaller number than the max-request-size of the display,
108 emacs will use INCR selection transfer when the selection is larger
109 than this. The max-request-size is usually around 64k, so if you want
110 emacs to use incremental selection transfers when the selection is
111 smaller than that, set this. I added this mostly for debugging the
112 incremental transfer stuff, but it might improve server performance.
114 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
115 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
116 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
117 - 1 in place of INT_MAX. */
118 #define MAX_SELECTION_QUANTUM \
119 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
120 / max (X_LONG_SIZE, sizeof (long)))))
123 selection_quantum (Display
*display
)
125 long mrs
= XMaxRequestSize (display
);
126 return (mrs
< MAX_SELECTION_QUANTUM
/ X_LONG_SIZE
+ 25
127 ? (mrs
- 25) * X_LONG_SIZE
128 : MAX_SELECTION_QUANTUM
);
131 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
132 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
135 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
138 struct selection_event_queue
140 struct input_event event
;
141 struct selection_event_queue
*next
;
144 static struct selection_event_queue
*selection_queue
;
146 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
148 static int x_queue_selection_requests
;
150 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
153 x_queue_event (struct input_event
*event
)
155 struct selection_event_queue
*queue_tmp
;
157 /* Don't queue repeated requests.
158 This only happens for large requests which uses the incremental protocol. */
159 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
161 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
163 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
164 x_decline_selection_request (event
);
169 queue_tmp
= xmalloc (sizeof *queue_tmp
);
170 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
171 queue_tmp
->event
= *event
;
172 queue_tmp
->next
= selection_queue
;
173 selection_queue
= queue_tmp
;
176 /* Start queuing SELECTION_REQUEST_EVENT events. */
179 x_start_queuing_selection_requests (void)
181 if (x_queue_selection_requests
)
184 x_queue_selection_requests
++;
185 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
188 /* Stop queuing SELECTION_REQUEST_EVENT events. */
191 x_stop_queuing_selection_requests (void)
193 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
194 --x_queue_selection_requests
;
196 /* Take all the queued events and put them back
197 so that they get processed afresh. */
199 while (selection_queue
!= NULL
)
201 struct selection_event_queue
*queue_tmp
= selection_queue
;
202 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
203 kbd_buffer_unget_event (&queue_tmp
->event
);
204 selection_queue
= queue_tmp
->next
;
210 /* This converts a Lisp symbol to a server Atom, avoiding a server
211 roundtrip whenever possible. */
214 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
217 if (NILP (sym
)) return 0;
218 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
219 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
220 if (EQ (sym
, QSTRING
)) return XA_STRING
;
221 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
222 if (EQ (sym
, QATOM
)) return XA_ATOM
;
223 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
224 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
225 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
226 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
227 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
228 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
229 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
230 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
231 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
232 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
233 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
234 if (!SYMBOLP (sym
)) emacs_abort ();
236 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
238 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
244 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
245 and calls to intern whenever possible. */
248 x_atom_to_symbol (Display
*dpy
, Atom atom
)
250 struct x_display_info
*dpyinfo
;
271 dpyinfo
= x_display_info_for_display (dpy
);
274 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
276 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
278 if (atom
== dpyinfo
->Xatom_TEXT
)
280 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
281 return QCOMPOUND_TEXT
;
282 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
284 if (atom
== dpyinfo
->Xatom_DELETE
)
286 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
288 if (atom
== dpyinfo
->Xatom_INCR
)
290 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
292 if (atom
== dpyinfo
->Xatom_TARGETS
)
294 if (atom
== dpyinfo
->Xatom_NULL
)
298 str
= XGetAtomName (dpy
, atom
);
300 TRACE1 ("XGetAtomName --> %s", str
);
301 if (! str
) return Qnil
;
304 /* This was allocated by Xlib, so use XFree. */
310 /* Do protocol to assert ourself as a selection owner.
311 FRAME shall be the owner; it must be a valid X frame.
312 Update the Vselection_alist so that we can reply to later requests for
316 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
319 struct frame
*f
= XFRAME (frame
);
320 Window selecting_window
= FRAME_X_WINDOW (f
);
321 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
322 Display
*display
= dpyinfo
->display
;
323 Time timestamp
= dpyinfo
->last_user_time
;
324 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
327 x_catch_errors (display
);
328 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
329 x_check_errors (display
, "Can't set selection: %s");
333 /* Now update the local cache */
335 Lisp_Object selection_data
;
336 Lisp_Object prev_value
;
338 selection_data
= list4 (selection_name
, selection_value
,
339 INTEGER_TO_CONS (timestamp
), frame
);
340 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
344 Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
));
346 /* If we already owned the selection, remove the old selection
347 data. Don't use Fdelq as that may QUIT. */
348 if (!NILP (prev_value
))
350 /* We know it's not the CAR, so it's easy. */
351 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
352 for (; CONSP (rest
); rest
= XCDR (rest
))
353 if (EQ (prev_value
, Fcar (XCDR (rest
))))
355 XSETCDR (rest
, XCDR (XCDR (rest
)));
362 /* Given a selection-name and desired type, look up our local copy of
363 the selection value and convert it to the type.
364 Return nil, a string, a vector, a symbol, an integer, or a cons
365 that CONS_TO_INTEGER could plausibly handle.
366 This function is used both for remote requests (LOCAL_REQUEST is zero)
367 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
369 This calls random Lisp code, and may signal or gc. */
372 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
373 int local_request
, struct x_display_info
*dpyinfo
)
375 Lisp_Object local_value
;
376 Lisp_Object handler_fn
, value
, check
;
378 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
380 if (NILP (local_value
)) return Qnil
;
382 /* TIMESTAMP is a special case. */
383 if (EQ (target_type
, QTIMESTAMP
))
386 value
= XCAR (XCDR (XCDR (local_value
)));
390 /* Don't allow a quit within the converter.
391 When the user types C-g, he would be surprised
392 if by luck it came during a converter. */
393 ptrdiff_t count
= SPECPDL_INDEX ();
394 specbind (Qinhibit_quit
, Qt
);
396 CHECK_SYMBOL (target_type
);
397 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
398 /* gcpro is not needed here since nothing but HANDLER_FN
399 is live, and that ought to be a symbol. */
401 if (!NILP (handler_fn
))
402 value
= call3 (handler_fn
,
403 selection_symbol
, (local_request
? Qnil
: target_type
),
404 XCAR (XCDR (local_value
)));
407 unbind_to (count
, Qnil
);
410 /* Make sure this value is of a type that we could transmit
411 to another X client. */
415 && SYMBOLP (XCAR (value
)))
416 check
= XCDR (value
);
424 /* Check for a value that CONS_TO_INTEGER could handle. */
425 else if (CONSP (check
)
426 && INTEGERP (XCAR (check
))
427 && (INTEGERP (XCDR (check
))
429 (CONSP (XCDR (check
))
430 && INTEGERP (XCAR (XCDR (check
)))
431 && NILP (XCDR (XCDR (check
))))))
434 signal_error ("Invalid data returned by selection-conversion function",
435 list2 (handler_fn
, value
));
438 /* Subroutines of x_reply_selection_request. */
440 /* Send a SelectionNotify event to the requestor with property=None,
441 meaning we were unable to do what they wanted. */
444 x_decline_selection_request (struct input_event
*event
)
447 XSelectionEvent
*reply
= &(reply_base
.xselection
);
449 reply
->type
= SelectionNotify
;
450 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
451 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
452 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
453 reply
->time
= SELECTION_EVENT_TIME (event
);
454 reply
->target
= SELECTION_EVENT_TARGET (event
);
455 reply
->property
= None
;
457 /* The reason for the error may be that the receiver has
458 died in the meantime. Handle that case. */
460 x_catch_errors (reply
->display
);
461 XSendEvent (reply
->display
, reply
->requestor
, False
, 0, &reply_base
);
462 XFlush (reply
->display
);
467 /* This is the selection request currently being processed.
468 It is set to zero when the request is fully processed. */
469 static struct input_event
*x_selection_current_request
;
471 /* Display info in x_selection_request. */
473 static struct x_display_info
*selection_request_dpyinfo
;
475 /* Raw selection data, for sending to a requestor window. */
477 struct selection_data
485 /* This can be set to non-NULL during x_reply_selection_request, if
486 the selection is waiting for an INCR transfer to complete. Don't
487 free these; that's done by unexpect_property_change. */
488 struct prop_location
*wait_object
;
489 struct selection_data
*next
;
492 /* Linked list of the above (in support of MULTIPLE targets). */
494 static struct selection_data
*converted_selections
;
496 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
497 static Atom conversion_fail_tag
;
499 /* Used as an unwind-protect clause so that, if a selection-converter signals
500 an error, we tell the requestor that we were unable to do what they wanted
501 before we throw to top-level or go into the debugger or whatever. */
504 x_selection_request_lisp_error (void)
506 struct selection_data
*cs
, *next
;
508 for (cs
= converted_selections
; cs
; cs
= next
)
511 if (cs
->nofree
== 0 && cs
->data
)
515 converted_selections
= NULL
;
517 if (x_selection_current_request
!= 0
518 && selection_request_dpyinfo
->display
)
519 x_decline_selection_request (x_selection_current_request
);
523 x_catch_errors_unwind (void)
531 /* This stuff is so that INCR selections are reentrant (that is, so we can
532 be servicing multiple INCR selection requests simultaneously.) I haven't
533 actually tested that yet. */
535 /* Keep a list of the property changes that are awaited. */
545 struct prop_location
*next
;
548 static int prop_location_identifier
;
550 static Lisp_Object property_change_reply
;
552 static struct prop_location
*property_change_reply_object
;
554 static struct prop_location
*property_change_wait_list
;
557 /* Send the reply to a selection request event EVENT. */
559 #ifdef TRACE_SELECTION
560 static int x_reply_selection_request_cnt
;
561 #endif /* TRACE_SELECTION */
564 x_reply_selection_request (struct input_event
*event
,
565 struct x_display_info
*dpyinfo
)
568 XSelectionEvent
*reply
= &(reply_base
.xselection
);
569 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
570 Window window
= SELECTION_EVENT_REQUESTOR (event
);
571 ptrdiff_t bytes_remaining
;
572 int max_bytes
= selection_quantum (display
);
573 ptrdiff_t count
= SPECPDL_INDEX ();
574 struct selection_data
*cs
;
576 reply
->type
= SelectionNotify
;
577 reply
->display
= display
;
578 reply
->requestor
= window
;
579 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
580 reply
->time
= SELECTION_EVENT_TIME (event
);
581 reply
->target
= SELECTION_EVENT_TARGET (event
);
582 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
583 if (reply
->property
== None
)
584 reply
->property
= reply
->target
;
587 /* The protected block contains wait_for_property_change, which can
588 run random lisp code (process handlers) or signal. Therefore, we
589 put the x_uncatch_errors call in an unwind. */
590 record_unwind_protect_void (x_catch_errors_unwind
);
591 x_catch_errors (display
);
593 /* Loop over converted selections, storing them in the requested
594 properties. If data is large, only store the first N bytes
595 (section 2.7.2 of ICCCM). Note that we store the data for a
596 MULTIPLE request in the opposite order; the ICCM says only that
597 the conversion itself must be done in the same order. */
598 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
600 if (cs
->property
== None
)
603 bytes_remaining
= cs
->size
;
604 bytes_remaining
*= cs
->format
>> 3;
605 if (bytes_remaining
<= max_bytes
)
607 /* Send all the data at once, with minimal handshaking. */
608 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
609 XChangeProperty (display
, window
, cs
->property
,
610 cs
->type
, cs
->format
, PropModeReplace
,
615 /* Send an INCR tag to initiate incremental transfer. */
618 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
619 bytes_remaining
, XGetAtomName (display
, cs
->property
));
621 = expect_property_change (display
, window
, cs
->property
,
624 /* XChangeProperty expects an array of long even if long is
625 more than 32 bits. */
626 value
[0] = min (bytes_remaining
, X_LONG_MAX
);
627 XChangeProperty (display
, window
, cs
->property
,
628 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
629 (unsigned char *) value
, 1);
630 XSelectInput (display
, window
, PropertyChangeMask
);
634 /* Now issue the SelectionNotify event. */
635 XSendEvent (display
, window
, False
, 0, &reply_base
);
638 #ifdef TRACE_SELECTION
640 char *sel
= XGetAtomName (display
, reply
->selection
);
641 char *tgt
= XGetAtomName (display
, reply
->target
);
642 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
643 sel
, tgt
, ++x_reply_selection_request_cnt
);
644 if (sel
) XFree (sel
);
645 if (tgt
) XFree (tgt
);
647 #endif /* TRACE_SELECTION */
649 /* Finish sending the rest of each of the INCR values. This should
650 be improved; there's a chance of deadlock if more than one
651 subtarget in a MULTIPLE selection requires an INCR transfer, and
652 the requestor and Emacs loop waiting on different transfers. */
653 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
656 int format_bytes
= cs
->format
/ 8;
657 bool had_errors_p
= x_had_errors_p (display
);
660 bytes_remaining
= cs
->size
;
661 bytes_remaining
*= format_bytes
;
663 /* Wait for the requestor to ack by deleting the property.
664 This can run Lisp code (process handlers) or signal. */
667 TRACE1 ("Waiting for ACK (deletion of %s)",
668 XGetAtomName (display
, cs
->property
));
669 wait_for_property_change (cs
->wait_object
);
672 unexpect_property_change (cs
->wait_object
);
674 while (bytes_remaining
)
676 int i
= ((bytes_remaining
< max_bytes
)
678 : max_bytes
) / format_bytes
;
682 = expect_property_change (display
, window
, cs
->property
,
685 TRACE1 ("Sending increment of %d elements", i
);
686 TRACE1 ("Set %s to increment data",
687 XGetAtomName (display
, cs
->property
));
689 /* Append the next chunk of data to the property. */
690 XChangeProperty (display
, window
, cs
->property
,
691 cs
->type
, cs
->format
, PropModeAppend
,
693 bytes_remaining
-= i
* format_bytes
;
694 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
697 had_errors_p
= x_had_errors_p (display
);
700 if (had_errors_p
) break;
702 /* Wait for the requestor to ack this chunk by deleting
703 the property. This can run Lisp code or signal. */
704 TRACE1 ("Waiting for increment ACK (deletion of %s)",
705 XGetAtomName (display
, cs
->property
));
706 wait_for_property_change (cs
->wait_object
);
709 /* Now write a zero-length chunk to the property to tell the
710 requestor that we're done. */
712 if (! waiting_for_other_props_on_window (display
, window
))
713 XSelectInput (display
, window
, 0);
715 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
716 XGetAtomName (display
, cs
->property
));
717 XChangeProperty (display
, window
, cs
->property
,
718 cs
->type
, cs
->format
, PropModeReplace
,
720 TRACE0 ("Done sending incrementally");
723 /* rms, 2003-01-03: I think I have fixed this bug. */
724 /* The window we're communicating with may have been deleted
725 in the meantime (that's a real situation from a bug report).
726 In this case, there may be events in the event queue still
727 referring to the deleted window, and we'll get a BadWindow error
728 in XTread_socket when processing the events. I don't have
729 an idea how to fix that. gerd, 2001-01-98. */
730 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
731 delivered before uncatch errors. */
732 XSync (display
, False
);
735 /* GTK queues events in addition to the queue in Xlib. So we
736 UNBLOCK to enter the event loop and get possible errors delivered,
737 and then BLOCK again because x_uncatch_errors requires it. */
739 /* This calls x_uncatch_errors. */
740 unbind_to (count
, Qnil
);
744 /* Handle a SelectionRequest event EVENT.
745 This is called from keyboard.c when such an event is found in the queue. */
748 x_handle_selection_request (struct input_event
*event
)
750 struct gcpro gcpro1
, gcpro2
;
751 Time local_selection_time
;
753 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
754 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
755 Atom selection
= SELECTION_EVENT_SELECTION (event
);
756 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
757 Atom target
= SELECTION_EVENT_TARGET (event
);
758 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
759 Atom property
= SELECTION_EVENT_PROPERTY (event
);
760 Lisp_Object local_selection_data
;
762 ptrdiff_t count
= SPECPDL_INDEX ();
763 GCPRO2 (local_selection_data
, target_symbol
);
765 if (!dpyinfo
) goto DONE
;
767 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
769 /* Decline if we don't own any selections. */
770 if (NILP (local_selection_data
)) goto DONE
;
772 /* Decline requests issued prior to our acquiring the selection. */
773 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
774 Time
, local_selection_time
);
775 if (SELECTION_EVENT_TIME (event
) != CurrentTime
776 && local_selection_time
> SELECTION_EVENT_TIME (event
))
779 x_selection_current_request
= event
;
780 selection_request_dpyinfo
= dpyinfo
;
781 record_unwind_protect_void (x_selection_request_lisp_error
);
783 /* We might be able to handle nested x_handle_selection_requests,
784 but this is difficult to test, and seems unimportant. */
785 x_start_queuing_selection_requests ();
786 record_unwind_protect_void (x_stop_queuing_selection_requests
);
788 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
789 SDATA (SYMBOL_NAME (selection_symbol
)),
790 SDATA (SYMBOL_NAME (target_symbol
)));
792 if (EQ (target_symbol
, QMULTIPLE
))
794 /* For MULTIPLE targets, the event property names a list of atom
795 pairs; the first atom names a target and the second names a
796 non-None property. */
797 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
798 Lisp_Object multprop
;
799 ptrdiff_t j
, nselections
;
801 if (property
== None
) goto DONE
;
803 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
804 QMULTIPLE
, selection
);
806 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
809 nselections
= ASIZE (multprop
) / 2;
810 /* Perform conversions. This can signal. */
811 for (j
= 0; j
< nselections
; j
++)
813 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
814 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
815 AREF (multprop
, 2*j
+1));
817 if (subproperty
!= None
)
818 x_convert_selection (event
, selection_symbol
, subtarget
,
819 subproperty
, 1, dpyinfo
);
825 if (property
== None
)
826 property
= SELECTION_EVENT_TARGET (event
);
827 success
= x_convert_selection (event
, selection_symbol
,
828 target_symbol
, property
,
835 x_reply_selection_request (event
, dpyinfo
);
837 x_decline_selection_request (event
);
838 x_selection_current_request
= 0;
840 /* Run the `x-sent-selection-functions' abnormal hook. */
841 if (!NILP (Vx_sent_selection_functions
)
842 && !EQ (Vx_sent_selection_functions
, Qunbound
))
845 args
[0] = Qx_sent_selection_functions
;
846 args
[1] = selection_symbol
;
847 args
[2] = target_symbol
;
848 args
[3] = success
? Qt
: Qnil
;
849 Frun_hook_with_args (4, args
);
852 unbind_to (count
, Qnil
);
856 /* Perform the requested selection conversion, and write the data to
857 the converted_selections linked list, where it can be accessed by
858 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
859 the data even if conversion fails, using conversion_fail_tag.
861 Return 0 if the selection failed to convert, 1 otherwise. */
864 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
865 Lisp_Object target_symbol
, Atom property
,
866 int for_multiple
, struct x_display_info
*dpyinfo
)
869 Lisp_Object lisp_selection
;
870 struct selection_data
*cs
;
871 GCPRO1 (lisp_selection
);
874 = x_get_local_selection (selection_symbol
, target_symbol
,
877 /* A nil return value means we can't perform the conversion. */
878 if (NILP (lisp_selection
)
879 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
883 cs
= xmalloc (sizeof *cs
);
884 cs
->data
= (unsigned char *) &conversion_fail_tag
;
889 cs
->property
= property
;
890 cs
->wait_object
= NULL
;
891 cs
->next
= converted_selections
;
892 converted_selections
= cs
;
899 /* Otherwise, record the converted selection to binary. */
900 cs
= xmalloc (sizeof *cs
);
903 cs
->property
= property
;
904 cs
->wait_object
= NULL
;
905 cs
->next
= converted_selections
;
906 converted_selections
= cs
;
907 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
909 &(cs
->data
), &(cs
->type
),
910 &(cs
->size
), &(cs
->format
),
916 /* Handle a SelectionClear event EVENT, which indicates that some
917 client cleared out our previously asserted selection.
918 This is called from keyboard.c when such an event is found in the queue. */
921 x_handle_selection_clear (struct input_event
*event
)
923 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
924 Atom selection
= SELECTION_EVENT_SELECTION (event
);
925 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
927 Lisp_Object selection_symbol
, local_selection_data
;
928 Time local_selection_time
;
929 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
930 Lisp_Object Vselection_alist
;
932 TRACE0 ("x_handle_selection_clear");
934 if (!dpyinfo
) return;
936 selection_symbol
= x_atom_to_symbol (display
, selection
);
937 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
939 /* Well, we already believe that we don't own it, so that's just fine. */
940 if (NILP (local_selection_data
)) return;
942 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
943 Time
, local_selection_time
);
945 /* We have reasserted the selection since this SelectionClear was
946 generated, so we can disregard it. */
947 if (changed_owner_time
!= CurrentTime
948 && local_selection_time
> changed_owner_time
)
951 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
952 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
953 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
954 Vselection_alist
= XCDR (Vselection_alist
);
958 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
959 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
961 XSETCDR (rest
, XCDR (XCDR (rest
)));
965 tset_selection_alist (dpyinfo
->terminal
, Vselection_alist
);
967 /* Run the `x-lost-selection-functions' abnormal hook. */
970 args
[0] = Qx_lost_selection_functions
;
971 args
[1] = selection_symbol
;
972 Frun_hook_with_args (2, args
);
975 redisplay_preserve_echo_area (20);
979 x_handle_selection_event (struct input_event
*event
)
981 TRACE0 ("x_handle_selection_event");
982 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
983 x_handle_selection_clear (event
);
984 else if (x_queue_selection_requests
)
985 x_queue_event (event
);
987 x_handle_selection_request (event
);
991 /* Clear all selections that were made from frame F.
992 We do this when about to delete a frame. */
995 x_clear_frame_selections (struct frame
*f
)
999 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
1000 struct terminal
*t
= dpyinfo
->terminal
;
1002 XSETFRAME (frame
, f
);
1004 /* Delete elements from the beginning of Vselection_alist. */
1005 while (CONSP (t
->Vselection_alist
)
1006 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1008 /* Run the `x-lost-selection-functions' abnormal hook. */
1009 Lisp_Object args
[2];
1010 args
[0] = Qx_lost_selection_functions
;
1011 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1012 Frun_hook_with_args (2, args
);
1014 tset_selection_alist (t
, XCDR (t
->Vselection_alist
));
1017 /* Delete elements after the beginning of Vselection_alist. */
1018 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1019 if (CONSP (XCDR (rest
))
1020 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1022 Lisp_Object args
[2];
1023 args
[0] = Qx_lost_selection_functions
;
1024 args
[1] = XCAR (XCAR (XCDR (rest
)));
1025 Frun_hook_with_args (2, args
);
1026 XSETCDR (rest
, XCDR (XCDR (rest
)));
1031 /* Nonzero if any properties for DISPLAY and WINDOW
1032 are on the list of what we are waiting for. */
1035 waiting_for_other_props_on_window (Display
*display
, Window window
)
1037 struct prop_location
*rest
= property_change_wait_list
;
1039 if (rest
->display
== display
&& rest
->window
== window
)
1046 /* Add an entry to the list of property changes we are waiting for.
1047 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1048 The return value is a number that uniquely identifies
1049 this awaited property change. */
1051 static struct prop_location
*
1052 expect_property_change (Display
*display
, Window window
,
1053 Atom property
, int state
)
1055 struct prop_location
*pl
= xmalloc (sizeof *pl
);
1056 pl
->identifier
= ++prop_location_identifier
;
1057 pl
->display
= display
;
1058 pl
->window
= window
;
1059 pl
->property
= property
;
1060 pl
->desired_state
= state
;
1061 pl
->next
= property_change_wait_list
;
1063 property_change_wait_list
= pl
;
1067 /* Delete an entry from the list of property changes we are waiting for.
1068 IDENTIFIER is the number that uniquely identifies the entry. */
1071 unexpect_property_change (struct prop_location
*location
)
1073 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1076 if (rest
== location
)
1079 prev
->next
= rest
->next
;
1081 property_change_wait_list
= rest
->next
;
1090 /* Remove the property change expectation element for IDENTIFIER. */
1093 wait_for_property_change_unwind (void *loc
)
1095 struct prop_location
*location
= loc
;
1097 unexpect_property_change (location
);
1098 if (location
== property_change_reply_object
)
1099 property_change_reply_object
= 0;
1102 /* Actually wait for a property change.
1103 IDENTIFIER should be the value that expect_property_change returned. */
1106 wait_for_property_change (struct prop_location
*location
)
1108 ptrdiff_t count
= SPECPDL_INDEX ();
1110 if (property_change_reply_object
)
1113 /* Make sure to do unexpect_property_change if we quit or err. */
1114 record_unwind_protect_ptr (wait_for_property_change_unwind
, location
);
1116 XSETCAR (property_change_reply
, Qnil
);
1117 property_change_reply_object
= location
;
1119 /* If the event we are waiting for arrives beyond here, it will set
1120 property_change_reply, because property_change_reply_object says so. */
1121 if (! location
->arrived
)
1123 EMACS_INT timeout
= max (0, x_selection_timeout
);
1124 EMACS_INT secs
= timeout
/ 1000;
1125 int nsecs
= (timeout
% 1000) * 1000000;
1126 TRACE2 (" Waiting %"pI
"d secs, %d nsecs", secs
, nsecs
);
1127 wait_reading_process_output (secs
, nsecs
, 0, 0,
1128 property_change_reply
, NULL
, 0);
1130 if (NILP (XCAR (property_change_reply
)))
1132 TRACE0 (" Timed out");
1133 error ("Timed out waiting for property-notify event");
1137 unbind_to (count
, Qnil
);
1140 /* Called from XTread_socket in response to a PropertyNotify event. */
1143 x_handle_property_notify (const XPropertyEvent
*event
)
1145 struct prop_location
*rest
;
1147 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1150 && rest
->property
== event
->atom
1151 && rest
->window
== event
->window
1152 && rest
->display
== event
->display
1153 && rest
->desired_state
== event
->state
)
1155 TRACE2 ("Expected %s of property %s",
1156 (event
->state
== PropertyDelete
? "deletion" : "change"),
1157 XGetAtomName (event
->display
, event
->atom
));
1161 /* If this is the one wait_for_property_change is waiting for,
1162 tell it to wake up. */
1163 if (rest
== property_change_reply_object
)
1164 XSETCAR (property_change_reply
, Qt
);
1173 /* Variables for communication with x_handle_selection_notify. */
1174 static Atom reading_which_selection
;
1175 static Lisp_Object reading_selection_reply
;
1176 static Window reading_selection_window
;
1178 /* Do protocol to read selection-data from the server.
1179 Converts this to Lisp data and returns it.
1180 FRAME is the frame whose X window shall request the selection. */
1183 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1184 Lisp_Object time_stamp
, Lisp_Object frame
)
1186 struct frame
*f
= XFRAME (frame
);
1187 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
1188 Display
*display
= dpyinfo
->display
;
1189 Window requestor_window
= FRAME_X_WINDOW (f
);
1190 Time requestor_time
= dpyinfo
->last_user_time
;
1191 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1192 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1193 Atom type_atom
= (CONSP (target_type
)
1194 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1195 : symbol_to_x_atom (dpyinfo
, target_type
));
1196 EMACS_INT timeout
, secs
;
1199 if (!FRAME_LIVE_P (f
))
1202 if (! NILP (time_stamp
))
1203 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1206 TRACE2 ("Get selection %s, type %s",
1207 XGetAtomName (display
, type_atom
),
1208 XGetAtomName (display
, target_property
));
1210 x_catch_errors (display
);
1211 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1212 requestor_window
, requestor_time
);
1213 x_check_errors (display
, "Can't convert selection: %s");
1214 x_uncatch_errors ();
1216 /* Prepare to block until the reply has been read. */
1217 reading_selection_window
= requestor_window
;
1218 reading_which_selection
= selection_atom
;
1219 XSETCAR (reading_selection_reply
, Qnil
);
1221 /* It should not be necessary to stop handling selection requests
1222 during this time. In fact, the SAVE_TARGETS mechanism requires
1223 us to handle a clipboard manager's requests before it returns
1226 x_start_queuing_selection_requests ();
1227 record_unwind_protect_void (x_stop_queuing_selection_requests
);
1232 /* This allows quits. Also, don't wait forever. */
1233 timeout
= max (0, x_selection_timeout
);
1234 secs
= timeout
/ 1000;
1235 nsecs
= (timeout
% 1000) * 1000000;
1236 TRACE1 (" Start waiting %"pI
"d secs for SelectionNotify", secs
);
1237 wait_reading_process_output (secs
, nsecs
, 0, 0,
1238 reading_selection_reply
, NULL
, 0);
1239 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1241 if (NILP (XCAR (reading_selection_reply
)))
1242 error ("Timed out waiting for reply from selection owner");
1243 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1246 /* Otherwise, the selection is waiting for us on the requested property. */
1248 x_get_window_property_as_lisp_data (display
, requestor_window
,
1249 target_property
, target_type
,
1253 /* Subroutines of x_get_window_property_as_lisp_data */
1255 /* Use xfree, not XFree, to free the data obtained with this function. */
1258 x_get_window_property (Display
*display
, Window window
, Atom property
,
1259 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1260 Atom
*actual_type_ret
, int *actual_format_ret
,
1261 unsigned long *actual_size_ret
, int delete_p
)
1263 ptrdiff_t total_size
;
1264 unsigned long bytes_remaining
;
1265 ptrdiff_t offset
= 0;
1266 unsigned char *data
= 0;
1267 unsigned char *tmp_data
= 0;
1269 int buffer_size
= selection_quantum (display
);
1271 /* Wide enough to avoid overflow in expressions using it. */
1272 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1274 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1275 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1276 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1277 ptrdiff_t total_size_max
=
1278 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1279 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1280 : LONG_MAX
* x_long_size
);
1284 /* First probe the thing to find out how big it is. */
1285 result
= XGetWindowProperty (display
, window
, property
,
1286 0, 0, False
, AnyPropertyType
,
1287 actual_type_ret
, actual_format_ret
,
1289 &bytes_remaining
, &tmp_data
);
1290 if (result
!= Success
)
1293 /* This was allocated by Xlib, so use XFree. */
1296 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1299 if (total_size_max
< bytes_remaining
)
1301 total_size
= bytes_remaining
;
1302 data
= xmalloc (total_size
+ 1);
1304 /* Now read, until we've gotten it all. */
1305 while (bytes_remaining
)
1307 ptrdiff_t bytes_gotten
;
1310 = XGetWindowProperty (display
, window
, property
,
1311 offset
/ X_LONG_SIZE
,
1312 buffer_size
/ X_LONG_SIZE
,
1315 actual_type_ret
, actual_format_ret
,
1316 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1318 /* If this doesn't return Success at this point, it means that
1319 some clod deleted the selection while we were in the midst of
1320 reading it. Deal with that, I guess.... */
1321 if (result
!= Success
)
1324 bytes_per_item
= *actual_format_ret
>> 3;
1325 eassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1327 /* The man page for XGetWindowProperty says:
1328 "If the returned format is 32, the returned data is represented
1329 as a long array and should be cast to that type to obtain the
1331 This applies even if long is more than 32 bits, the X library
1332 converts from 32 bit elements received from the X server to long
1333 and passes the long array to us. Thus, for that case memcpy can not
1334 be used. We convert to a 32 bit type here, because so much code
1337 The bytes and offsets passed to XGetWindowProperty refers to the
1338 property and those are indeed in 32 bit quantities if format is 32. */
1340 bytes_gotten
= *actual_size_ret
;
1341 bytes_gotten
*= bytes_per_item
;
1343 TRACE2 ("Read %"pD
"d bytes from property %s",
1344 bytes_gotten
, XGetAtomName (display
, property
));
1346 if (total_size
- offset
< bytes_gotten
)
1348 unsigned char *data1
;
1349 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1350 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1352 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1353 data1
= xrealloc (data
, total_size
+ 1);
1357 if (BITS_PER_LONG
> 32 && *actual_format_ret
== 32)
1360 int *idata
= (int *) (data
+ offset
);
1361 long *ldata
= (long *) tmp_data
;
1363 for (i
= 0; i
< *actual_size_ret
; ++i
)
1364 idata
[i
] = ldata
[i
];
1367 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1369 offset
+= bytes_gotten
;
1371 /* This was allocated by Xlib, so use XFree. */
1376 data
[offset
] = '\0';
1381 *bytes_ret
= offset
;
1388 memory_full (SIZE_MAX
);
1391 /* Use xfree, not XFree, to free the data obtained with this function. */
1394 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1395 Lisp_Object target_type
,
1396 unsigned int min_size_bytes
,
1397 unsigned char **data_ret
,
1398 ptrdiff_t *size_bytes_ret
,
1399 Atom
*type_ret
, int *format_ret
,
1400 unsigned long *size_ret
)
1402 ptrdiff_t offset
= 0;
1403 struct prop_location
*wait_object
;
1404 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1405 memory_full (SIZE_MAX
);
1406 *data_ret
= xmalloc (min_size_bytes
);
1407 *size_bytes_ret
= min_size_bytes
;
1409 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1411 /* At this point, we have read an INCR property.
1412 Delete the property to ack it.
1413 (But first, prepare to receive the next event in this handshake.)
1415 Now, we must loop, waiting for the sending window to put a value on
1416 that property, then reading the property, then deleting it to ack.
1417 We are done when the sender places a property of length 0.
1420 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1421 TRACE1 (" Delete property %s",
1422 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1423 XDeleteProperty (display
, window
, property
);
1424 TRACE1 (" Expect new value of property %s",
1425 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1426 wait_object
= expect_property_change (display
, window
, property
,
1433 unsigned char *tmp_data
;
1434 ptrdiff_t tmp_size_bytes
;
1436 TRACE0 (" Wait for property change");
1437 wait_for_property_change (wait_object
);
1439 /* expect it again immediately, because x_get_window_property may
1440 .. no it won't, I don't get it.
1441 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1442 TRACE0 (" Get property value");
1443 x_get_window_property (display
, window
, property
,
1444 &tmp_data
, &tmp_size_bytes
,
1445 type_ret
, format_ret
, size_ret
, 1);
1447 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1449 if (tmp_size_bytes
== 0) /* we're done */
1451 TRACE0 ("Done reading incrementally");
1453 if (! waiting_for_other_props_on_window (display
, window
))
1454 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1455 /* Use xfree, not XFree, because x_get_window_property
1456 calls xmalloc itself. */
1462 TRACE1 (" ACK by deleting property %s",
1463 XGetAtomName (display
, property
));
1464 XDeleteProperty (display
, window
, property
);
1465 wait_object
= expect_property_change (display
, window
, property
,
1470 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1471 *data_ret
= xpalloc (*data_ret
, size_bytes_ret
,
1472 tmp_size_bytes
- (*size_bytes_ret
- offset
),
1475 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1476 offset
+= tmp_size_bytes
;
1478 /* Use xfree, not XFree, because x_get_window_property
1479 calls xmalloc itself. */
1485 /* Fetch a value from property PROPERTY of X window WINDOW on display
1486 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1490 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1492 Lisp_Object target_type
,
1493 Atom selection_atom
)
1497 unsigned long actual_size
;
1498 unsigned char *data
= 0;
1499 ptrdiff_t bytes
= 0;
1501 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1503 TRACE0 ("Reading selection data");
1505 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1506 &actual_type
, &actual_format
, &actual_size
, 1);
1509 int there_is_a_selection_owner
;
1511 there_is_a_selection_owner
1512 = XGetSelectionOwner (display
, selection_atom
);
1514 if (there_is_a_selection_owner
)
1515 signal_error ("Selection owner couldn't convert",
1517 ? list2 (target_type
,
1518 x_atom_to_symbol (display
, actual_type
))
1521 signal_error ("No selection",
1522 x_atom_to_symbol (display
, selection_atom
));
1525 if (actual_type
== dpyinfo
->Xatom_INCR
)
1527 /* That wasn't really the data, just the beginning. */
1529 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1531 /* Use xfree, not XFree, because x_get_window_property
1532 calls xmalloc itself. */
1535 receive_incremental_selection (display
, window
, property
, target_type
,
1536 min_size_bytes
, &data
, &bytes
,
1537 &actual_type
, &actual_format
,
1542 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1543 XDeleteProperty (display
, window
, property
);
1547 /* It's been read. Now convert it to a lisp object in some semi-rational
1549 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1550 actual_type
, actual_format
);
1552 /* Use xfree, not XFree, because x_get_window_property
1553 calls xmalloc itself. */
1558 /* These functions convert from the selection data read from the server into
1559 something that we can use from Lisp, and vice versa.
1561 Type: Format: Size: Lisp Type:
1562 ----- ------- ----- -----------
1565 ATOM 32 > 1 Vector of Symbols
1567 * 16 > 1 Vector of Integers
1568 * 32 1 if <=16 bits: Integer
1569 if > 16 bits: Cons of top16, bot16
1570 * 32 > 1 Vector of the above
1572 When converting a Lisp number to C, it is assumed to be of format 16 if
1573 it is an integer, and of format 32 if it is a cons of two integers.
1575 When converting a vector of numbers from Lisp to C, it is assumed to be
1576 of format 16 if every element in the vector is an integer, and is assumed
1577 to be of format 32 if any element is a cons of two integers.
1579 When converting an object to C, it may be of the form (SYMBOL . <data>)
1580 where SYMBOL is what we should claim that the type is. Format and
1581 representation are as above.
1583 Important: When format is 32, data should contain an array of int,
1584 not an array of long as the X library returns. This makes a difference
1585 when sizeof(long) != sizeof(int). */
1590 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1591 ptrdiff_t size
, Atom type
, int format
)
1593 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1595 if (type
== dpyinfo
->Xatom_NULL
)
1598 /* Convert any 8-bit data to a string, for compactness. */
1599 else if (format
== 8)
1601 Lisp_Object str
, lispy_type
;
1603 str
= make_unibyte_string ((char *) data
, size
);
1604 /* Indicate that this string is from foreign selection by a text
1605 property `foreign-selection' so that the caller of
1606 x-get-selection-internal (usually x-get-selection) can know
1607 that the string must be decode. */
1608 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1609 lispy_type
= QCOMPOUND_TEXT
;
1610 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1611 lispy_type
= QUTF8_STRING
;
1613 lispy_type
= QSTRING
;
1614 Fput_text_property (make_number (0), make_number (size
),
1615 Qforeign_selection
, lispy_type
, str
);
1618 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1619 a vector of symbols. */
1620 else if (type
== XA_ATOM
1621 /* Treat ATOM_PAIR type similar to list of atoms. */
1622 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1625 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1626 But the callers of these function has made sure the data for
1627 format == 32 is an array of int. Thus, use int instead
1629 int *idata
= (int *) data
;
1631 if (size
== sizeof (int))
1632 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1635 Lisp_Object v
= make_uninit_vector (size
/ sizeof (int));
1637 for (i
= 0; i
< size
/ sizeof (int); i
++)
1638 ASET (v
, i
, x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1643 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1644 If the number is 32 bits and won't fit in a Lisp_Int,
1645 convert it to a cons of integers, 16 bits in each half.
1647 else if (format
== 32 && size
== sizeof (int))
1648 return INTEGER_TO_CONS (((int *) data
) [0]);
1649 else if (format
== 16 && size
== sizeof (short))
1650 return make_number (((short *) data
) [0]);
1652 /* Convert any other kind of data to a vector of numbers, represented
1653 as above (as an integer, or a cons of two 16 bit integers.)
1655 else if (format
== 16)
1658 Lisp_Object v
= make_uninit_vector (size
/ 2);
1660 for (i
= 0; i
< size
/ 2; i
++)
1662 short j
= ((short *) data
) [i
];
1663 ASET (v
, i
, make_number (j
));
1670 Lisp_Object v
= make_uninit_vector (size
/ X_LONG_SIZE
);
1672 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1674 int j
= ((int *) data
) [i
];
1675 ASET (v
, i
, INTEGER_TO_CONS (j
));
1681 /* Convert OBJ to an X long value, and return it as unsigned long.
1682 OBJ should be an integer or a cons representing an integer.
1683 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1684 unsigned long values: in theory these values are supposed to be
1685 signed but in practice unsigned 32-bit data are communicated via X
1686 selections and we need to support that. */
1687 static unsigned long
1688 cons_to_x_long (Lisp_Object obj
)
1690 if (X_ULONG_MAX
<= INTMAX_MAX
1691 || XINT (INTEGERP (obj
) ? obj
: XCAR (obj
)) < 0)
1692 return cons_to_signed (obj
, X_LONG_MIN
, min (X_ULONG_MAX
, INTMAX_MAX
));
1694 return cons_to_unsigned (obj
, X_ULONG_MAX
);
1697 /* Use xfree, not XFree, to free the data obtained with this function. */
1700 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1701 unsigned char **data_ret
, Atom
*type_ret
,
1702 ptrdiff_t *size_ret
,
1703 int *format_ret
, int *nofree_ret
)
1705 Lisp_Object type
= Qnil
;
1706 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1710 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1714 if (CONSP (obj
) && NILP (XCDR (obj
)))
1718 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1719 { /* This is not the same as declining */
1725 else if (STRINGP (obj
))
1727 if (SCHARS (obj
) < SBYTES (obj
))
1728 /* OBJ is a multibyte string containing a non-ASCII char. */
1729 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1733 *size_ret
= SBYTES (obj
);
1734 *data_ret
= SDATA (obj
);
1737 else if (SYMBOLP (obj
))
1739 void *data
= xmalloc (sizeof (Atom
) + 1);
1740 Atom
*x_atom_ptr
= data
;
1744 (*data_ret
) [sizeof (Atom
)] = 0;
1745 *x_atom_ptr
= symbol_to_x_atom (dpyinfo
, obj
);
1746 if (NILP (type
)) type
= QATOM
;
1748 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1750 void *data
= xmalloc (sizeof (short) + 1);
1751 short *short_ptr
= data
;
1755 (*data_ret
) [sizeof (short)] = 0;
1756 *short_ptr
= XINT (obj
);
1757 if (NILP (type
)) type
= QINTEGER
;
1759 else if (INTEGERP (obj
)
1760 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1761 && (INTEGERP (XCDR (obj
))
1762 || (CONSP (XCDR (obj
))
1763 && INTEGERP (XCAR (XCDR (obj
)))))))
1765 void *data
= xmalloc (sizeof (unsigned long) + 1);
1766 unsigned long *x_long_ptr
= data
;
1770 (*data_ret
) [sizeof (unsigned long)] = 0;
1771 *x_long_ptr
= cons_to_x_long (obj
);
1772 if (NILP (type
)) type
= QINTEGER
;
1774 else if (VECTORP (obj
))
1776 /* Lisp_Vectors may represent a set of ATOMs;
1777 a set of 16 or 32 bit INTEGERs;
1778 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1781 ptrdiff_t size
= ASIZE (obj
);
1783 if (SYMBOLP (AREF (obj
, 0)))
1784 /* This vector is an ATOM set */
1788 if (NILP (type
)) type
= QATOM
;
1789 for (i
= 0; i
< size
; i
++)
1790 if (!SYMBOLP (AREF (obj
, i
)))
1791 signal_error ("All elements of selection vector must have same type", obj
);
1793 *data_ret
= data
= xnmalloc (size
, sizeof *x_atoms
);
1797 for (i
= 0; i
< size
; i
++)
1798 x_atoms
[i
] = symbol_to_x_atom (dpyinfo
, AREF (obj
, i
));
1801 /* This vector is an INTEGER set, or something like it */
1804 int data_size
= sizeof (short);
1806 unsigned long *x_atoms
;
1808 if (NILP (type
)) type
= QINTEGER
;
1809 for (i
= 0; i
< size
; i
++)
1811 if (! RANGED_INTEGERP (X_SHRT_MIN
, AREF (obj
, i
),
1814 /* Use sizeof (long) even if it is more than 32 bits.
1815 See comment in x_get_window_property and
1816 x_fill_property_data. */
1817 data_size
= sizeof (long);
1822 *data_ret
= data
= xnmalloc (size
, data_size
);
1825 *format_ret
= format
;
1827 for (i
= 0; i
< size
; i
++)
1830 x_atoms
[i
] = cons_to_x_long (AREF (obj
, i
));
1832 shorts
[i
] = XINT (AREF (obj
, i
));
1837 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1839 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1843 clean_local_selection_data (Lisp_Object obj
)
1846 && INTEGERP (XCAR (obj
))
1847 && CONSP (XCDR (obj
))
1848 && INTEGERP (XCAR (XCDR (obj
)))
1849 && NILP (XCDR (XCDR (obj
))))
1850 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1853 && INTEGERP (XCAR (obj
))
1854 && INTEGERP (XCDR (obj
)))
1856 if (XINT (XCAR (obj
)) == 0)
1858 if (XINT (XCAR (obj
)) == -1)
1859 return make_number (- XINT (XCDR (obj
)));
1864 ptrdiff_t size
= ASIZE (obj
);
1867 return clean_local_selection_data (AREF (obj
, 0));
1868 copy
= make_uninit_vector (size
);
1869 for (i
= 0; i
< size
; i
++)
1870 ASET (copy
, i
, clean_local_selection_data (AREF (obj
, i
)));
1876 /* Called from XTread_socket to handle SelectionNotify events.
1877 If it's the selection we are waiting for, stop waiting
1878 by setting the car of reading_selection_reply to non-nil.
1879 We store t there if the reply is successful, lambda if not. */
1882 x_handle_selection_notify (const XSelectionEvent
*event
)
1884 if (event
->requestor
!= reading_selection_window
)
1886 if (event
->selection
!= reading_which_selection
)
1889 TRACE0 ("Received SelectionNotify");
1890 XSETCAR (reading_selection_reply
,
1891 (event
->property
!= 0 ? Qt
: Qlambda
));
1895 /* From a Lisp_Object, return a suitable frame for selection
1896 operations. OBJECT may be a frame, a terminal object, or nil
1897 (which stands for the selected frame--or, if that is not an X
1898 frame, the first X display on the list). If no suitable frame can
1899 be found, return NULL. */
1901 static struct frame
*
1902 frame_for_x_selection (Lisp_Object object
)
1904 Lisp_Object tail
, frame
;
1909 f
= XFRAME (selected_frame
);
1910 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1913 FOR_EACH_FRAME (tail
, frame
)
1916 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1920 else if (TERMINALP (object
))
1922 struct terminal
*t
= get_terminal (object
, 1);
1924 if (t
->type
== output_x_window
)
1925 FOR_EACH_FRAME (tail
, frame
)
1928 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1932 else if (FRAMEP (object
))
1934 f
= XFRAME (object
);
1935 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1943 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1944 Sx_own_selection_internal
, 2, 3, 0,
1945 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1946 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1947 \(Those are literal upper-case symbol names, since that's what X expects.)
1948 VALUE is typically a string, or a cons of two markers, but may be
1949 anything that the functions on `selection-converter-alist' know about.
1951 FRAME should be a frame that should own the selection. If omitted or
1952 nil, it defaults to the selected frame.
1954 On Nextstep, FRAME is unused. */)
1955 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1957 if (NILP (frame
)) frame
= selected_frame
;
1958 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1959 error ("X selection unavailable for this frame");
1961 CHECK_SYMBOL (selection
);
1962 if (NILP (value
)) error ("VALUE may not be nil");
1963 x_own_selection (selection
, value
, frame
);
1968 /* Request the selection value from the owner. If we are the owner,
1969 simply return our selection value. If we are not the owner, this
1970 will block until all of the data has arrived. */
1972 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1973 Sx_get_selection_internal
, 2, 4, 0,
1974 doc
: /* Return text selected from some X window.
1975 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1976 \(Those are literal upper-case symbol names, since that's what X expects.)
1977 TARGET-TYPE is the type of data desired, typically `STRING'.
1979 TIME-STAMP is the time to use in the XConvertSelection call for foreign
1980 selections. If omitted, defaults to the time for the last event.
1982 TERMINAL should be a terminal object or a frame specifying the X
1983 server to query. If omitted or nil, that stands for the selected
1984 frame's display, or the first available X display.
1986 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
1987 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1988 Lisp_Object time_stamp
, Lisp_Object terminal
)
1990 Lisp_Object val
= Qnil
;
1991 struct gcpro gcpro1
, gcpro2
;
1992 struct frame
*f
= frame_for_x_selection (terminal
);
1993 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1995 CHECK_SYMBOL (selection_symbol
);
1996 CHECK_SYMBOL (target_type
);
1997 if (EQ (target_type
, QMULTIPLE
))
1998 error ("Retrieving MULTIPLE selections is currently unimplemented");
2000 error ("X selection unavailable for this frame");
2002 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
2003 FRAME_DISPLAY_INFO (f
));
2005 if (NILP (val
) && FRAME_LIVE_P (f
))
2008 XSETFRAME (frame
, f
);
2009 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
2010 time_stamp
, frame
));
2013 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2016 if (CONSP (val
) && NILP (XCDR (val
)))
2019 RETURN_UNGCPRO (clean_local_selection_data (val
));
2022 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2023 Sx_disown_selection_internal
, 1, 3, 0,
2024 doc
: /* If we own the selection SELECTION, disown it.
2025 Disowning it means there is no such selection.
2027 Sets the last-change time for the selection to TIME-OBJECT (by default
2028 the time of the last event).
2030 TERMINAL should be a terminal object or a frame specifying the X
2031 server to query. If omitted or nil, that stands for the selected
2032 frame's display, or the first available X display.
2034 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2035 On MS-DOS, all this does is return non-nil if we own the selection. */)
2036 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2039 Atom selection_atom
;
2041 struct selection_input_event sie
;
2042 struct input_event ie
;
2044 struct frame
*f
= frame_for_x_selection (terminal
);
2045 struct x_display_info
*dpyinfo
;
2050 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2051 CHECK_SYMBOL (selection
);
2053 /* Don't disown the selection when we're not the owner. */
2054 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2057 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2060 if (NILP (time_object
))
2061 timestamp
= dpyinfo
->last_user_time
;
2063 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2064 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2067 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2068 generated for a window which owns the selection when that window sets
2069 the selection owner to None. The NCD server does, the MIT Sun4 server
2070 doesn't. So we synthesize one; this means we might get two, but
2071 that's ok, because the second one won't have any effect. */
2072 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2073 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2074 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2075 x_handle_selection_clear (&event
.ie
);
2080 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2082 doc
: /* Whether the current Emacs process owns the given X Selection.
2083 The arg should be the name of the selection in question, typically one of
2084 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2085 \(Those are literal upper-case symbol names, since that's what X expects.)
2086 For convenience, the symbol nil is the same as `PRIMARY',
2087 and t is the same as `SECONDARY'.
2089 TERMINAL should be a terminal object or a frame specifying the X
2090 server to query. If omitted or nil, that stands for the selected
2091 frame's display, or the first available X display.
2093 On Nextstep, TERMINAL is unused. */)
2094 (Lisp_Object selection
, Lisp_Object terminal
)
2096 struct frame
*f
= frame_for_x_selection (terminal
);
2098 CHECK_SYMBOL (selection
);
2099 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2100 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2102 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_DISPLAY_INFO (f
))))
2108 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2110 doc
: /* Whether there is an owner for the given X selection.
2111 SELECTION should be the name of the selection in question, typically
2112 one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2113 `CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2114 symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
2116 TERMINAL should be a terminal object or a frame specifying the X
2117 server to query. If omitted or nil, that stands for the selected
2118 frame's display, or the first available X display.
2120 On Nextstep, TERMINAL is unused. */)
2121 (Lisp_Object selection
, Lisp_Object terminal
)
2125 struct frame
*f
= frame_for_x_selection (terminal
);
2126 struct x_display_info
*dpyinfo
;
2128 CHECK_SYMBOL (selection
);
2129 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2130 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2135 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2137 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2140 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2141 if (atom
== 0) return Qnil
;
2143 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2145 return (owner
? Qt
: Qnil
);
2149 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2150 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2153 x_clipboard_manager_save (Lisp_Object frame
)
2155 struct frame
*f
= XFRAME (frame
);
2156 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2157 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2159 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2160 dpyinfo
->Xatom_EMACS_TMP
,
2161 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2162 (unsigned char *) &data
, 1);
2163 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2168 /* Error handler for x_clipboard_manager_save_frame. */
2171 x_clipboard_manager_error_1 (Lisp_Object err
)
2173 Lisp_Object args
[2];
2174 args
[0] = build_string ("X clipboard manager error: %s\n\
2175 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2176 args
[1] = CAR (CDR (err
));
2181 /* Error handler for x_clipboard_manager_save_all. */
2184 x_clipboard_manager_error_2 (Lisp_Object err
)
2186 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2187 If the problem persists, set `x-select-enable-clipboard-manager' \
2192 /* Called from delete_frame: save any clipboard owned by FRAME to the
2193 clipboard manager. Do nothing if FRAME does not own the clipboard,
2194 or if no clipboard manager is present. */
2197 x_clipboard_manager_save_frame (Lisp_Object frame
)
2201 if (!NILP (Vx_select_enable_clipboard_manager
)
2203 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2204 && FRAME_LIVE_P (f
))
2206 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2207 Lisp_Object local_selection
2208 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2210 if (!NILP (local_selection
)
2211 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2212 && XGetSelectionOwner (dpyinfo
->display
,
2213 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2214 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2215 x_clipboard_manager_error_1
);
2219 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2220 clipboard manager. Do nothing if FRAME does not own the clipboard,
2221 or if no clipboard manager is present. */
2224 x_clipboard_manager_save_all (void)
2226 /* Loop through all X displays, saving owned clipboards. */
2227 struct x_display_info
*dpyinfo
;
2228 Lisp_Object local_selection
, local_frame
;
2230 if (NILP (Vx_select_enable_clipboard_manager
))
2233 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2235 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2236 if (NILP (local_selection
)
2237 || !XGetSelectionOwner (dpyinfo
->display
,
2238 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2241 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2242 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2244 Lisp_Object args
[1];
2245 args
[0] = build_string ("Saving clipboard to X clipboard manager...");
2248 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2249 Qt
, x_clipboard_manager_error_2
);
2255 /***********************************************************************
2256 Drag and drop support
2257 ***********************************************************************/
2258 /* Check that lisp values are of correct type for x_fill_property_data.
2259 That is, number, string or a cons with two numbers (low and high 16
2260 bit parts of a 32 bit number). Return the number of items in DATA,
2261 or -1 if there is an error. */
2264 x_check_property_data (Lisp_Object data
)
2269 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2271 Lisp_Object o
= XCAR (iter
);
2273 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2275 else if (CONSP (o
) &&
2276 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2278 if (size
== INT_MAX
)
2286 /* Convert lisp values to a C array. Values may be a number, a string
2287 which is taken as an X atom name and converted to the atom value, or
2288 a cons containing the two 16 bit parts of a 32 bit number.
2290 DPY is the display use to look up X atoms.
2291 DATA is a Lisp list of values to be converted.
2292 RET is the C array that contains the converted values. It is assumed
2293 it is big enough to hold all values.
2294 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2295 be stored in RET. Note that long is used for 32 even if long is more
2296 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2297 XClientMessageEvent). */
2300 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2303 long *d32
= (long *) ret
;
2304 short *d16
= (short *) ret
;
2305 char *d08
= (char *) ret
;
2308 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2310 Lisp_Object o
= XCAR (iter
);
2312 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2313 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2314 else if (STRINGP (o
))
2317 val
= XInternAtom (dpy
, SSDATA (o
), False
);
2321 error ("Wrong type, must be string, number or cons");
2325 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2328 error ("Out of 'char' range");
2330 else if (format
== 16)
2332 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2335 error ("Out of 'short' range");
2342 /* Convert an array of C values to a Lisp list.
2343 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2344 DATA is a C array of values to be converted.
2345 TYPE is the type of the data. Only XA_ATOM is special, it converts
2346 each number in DATA to its corresponding X atom as a symbol.
2347 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2349 SIZE is the number of elements in DATA.
2351 Important: When format is 32, data should contain an array of int,
2352 not an array of long as the X library returns. This makes a difference
2353 when sizeof(long) != sizeof(int).
2355 Also see comment for selection_data_to_lisp_data above. */
2358 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2359 Atom type
, int format
, unsigned long size
)
2361 ptrdiff_t format_bytes
= format
>> 3;
2362 if (PTRDIFF_MAX
/ format_bytes
< size
)
2363 memory_full (SIZE_MAX
);
2364 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2365 data
, size
* format_bytes
, type
, format
);
2368 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2369 Sx_get_atom_name
, 1, 2, 0,
2370 doc
: /* Return the X atom name for VALUE as a string.
2371 VALUE may be a number or a cons where the car is the upper 16 bits and
2372 the cdr is the lower 16 bits of a 32 bit value.
2373 Use the display for FRAME or the current frame if FRAME is not given or nil.
2375 If the value is 0 or the atom is not known, return the empty string. */)
2376 (Lisp_Object value
, Lisp_Object frame
)
2378 struct frame
*f
= decode_window_system_frame (frame
);
2381 Lisp_Object ret
= Qnil
;
2382 Display
*dpy
= FRAME_X_DISPLAY (f
);
2386 CONS_TO_INTEGER (value
, Atom
, atom
);
2389 x_catch_errors (dpy
);
2390 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2391 had_errors_p
= x_had_errors_p (dpy
);
2392 x_uncatch_errors ();
2395 ret
= build_string (name
);
2397 if (atom
&& name
) XFree (name
);
2398 if (NILP (ret
)) ret
= empty_unibyte_string
;
2405 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2406 Sx_register_dnd_atom
, 1, 2, 0,
2407 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2408 ATOM can be a symbol or a string. The ATOM is interned on the display that
2409 FRAME is on. If FRAME is nil, the selected frame is used. */)
2410 (Lisp_Object atom
, Lisp_Object frame
)
2413 struct frame
*f
= decode_window_system_frame (frame
);
2415 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2419 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2420 else if (STRINGP (atom
))
2423 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2427 error ("ATOM must be a symbol or a string");
2429 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2430 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2433 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2434 dpyinfo
->x_dnd_atoms
=
2435 xpalloc (dpyinfo
->x_dnd_atoms
, &dpyinfo
->x_dnd_atoms_size
,
2436 1, -1, sizeof *dpyinfo
->x_dnd_atoms
);
2438 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2442 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2445 x_handle_dnd_message (struct frame
*f
, const XClientMessageEvent
*event
,
2446 struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2450 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2451 unsigned long size
= 160/event
->format
;
2453 unsigned char *data
= (unsigned char *) event
->data
.b
;
2457 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2458 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2460 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2462 XSETFRAME (frame
, f
);
2464 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2465 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2466 function expects them to be of size int (i.e. 32). So to be able to
2467 use that function, put the data in the form it expects if format is 32. */
2469 if (BITS_PER_LONG
> 32 && event
->format
== 32)
2471 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2472 idata
[i
] = event
->data
.l
[i
];
2473 data
= (unsigned char *) idata
;
2476 vec
= Fmake_vector (make_number (4), Qnil
);
2477 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2478 event
->message_type
)));
2479 ASET (vec
, 1, frame
);
2480 ASET (vec
, 2, make_number (event
->format
));
2481 ASET (vec
, 3, x_property_data_to_lisp (f
,
2483 event
->message_type
,
2487 x_relative_mouse_position (f
, &x
, &y
);
2488 bufp
->kind
= DRAG_N_DROP_EVENT
;
2489 bufp
->frame_or_window
= frame
;
2490 bufp
->timestamp
= CurrentTime
;
2491 bufp
->x
= make_number (x
);
2492 bufp
->y
= make_number (y
);
2494 bufp
->modifiers
= 0;
2499 DEFUN ("x-send-client-message", Fx_send_client_message
,
2500 Sx_send_client_message
, 6, 6, 0,
2501 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2503 For DISPLAY, specify either a frame or a display name (a string).
2504 If DISPLAY is nil, that stands for the selected frame's display.
2505 DEST may be a number, in which case it is a Window id. The value 0 may
2506 be used to send to the root window of the DISPLAY.
2507 If DEST is a cons, it is converted to a 32 bit number
2508 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2509 number is then used as a window id.
2510 If DEST is a frame the event is sent to the outer window of that frame.
2511 A value of nil means the currently selected frame.
2512 If DEST is the string "PointerWindow" the event is sent to the window that
2513 contains the pointer. If DEST is the string "InputFocus" the event is
2514 sent to the window that has the input focus.
2515 FROM is the frame sending the event. Use nil for currently selected frame.
2516 MESSAGE-TYPE is the name of an Atom as a string.
2517 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2518 bits. VALUES is a list of numbers, cons and/or strings containing the values
2519 to send. If a value is a string, it is converted to an Atom and the value of
2520 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2521 with the high 16 bits from the car and the lower 16 bit from the cdr.
2522 If more values than fits into the event is given, the excessive values
2524 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2525 Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2527 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2529 CHECK_STRING (message_type
);
2530 x_send_client_event (display
, dest
, from
,
2531 XInternAtom (dpyinfo
->display
,
2532 SSDATA (message_type
),
2540 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2541 Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2543 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2546 struct frame
*f
= decode_window_system_frame (from
);
2549 CHECK_NUMBER (format
);
2550 CHECK_CONS (values
);
2552 if (x_check_property_data (values
) == -1)
2553 error ("Bad data in VALUES, must be number, cons or string");
2555 if (XINT (format
) != 8 && XINT (format
) != 16 && XINT (format
) != 32)
2556 error ("FORMAT must be one of 8, 16 or 32");
2558 event
.xclient
.type
= ClientMessage
;
2559 event
.xclient
.format
= XINT (format
);
2561 if (FRAMEP (dest
) || NILP (dest
))
2563 struct frame
*fdest
= decode_window_system_frame (dest
);
2564 wdest
= FRAME_OUTER_WINDOW (fdest
);
2566 else if (STRINGP (dest
))
2568 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2569 wdest
= PointerWindow
;
2570 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2573 error ("DEST as a string must be one of PointerWindow or InputFocus");
2575 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2576 CONS_TO_INTEGER (dest
, Window
, wdest
);
2578 error ("DEST must be a frame, nil, string, number or cons");
2580 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2581 to_root
= wdest
== dpyinfo
->root_window
;
2585 event
.xclient
.send_event
= True
;
2586 event
.xclient
.serial
= 0;
2587 event
.xclient
.message_type
= message_type
;
2588 event
.xclient
.display
= dpyinfo
->display
;
2590 /* Some clients (metacity for example) expects sending window to be here
2591 when sending to the root window. */
2592 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2594 memset (event
.xclient
.data
.l
, 0, sizeof (event
.xclient
.data
.l
));
2595 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2596 event
.xclient
.format
);
2598 /* If event mask is 0 the event is sent to the client that created
2599 the destination window. But if we are sending to the root window,
2600 there is no such client. Then we set the event mask to 0xffffff. The
2601 event then goes to clients selecting for events on the root window. */
2602 x_catch_errors (dpyinfo
->display
);
2604 int propagate
= to_root
? False
: True
;
2605 long mask
= to_root
? 0xffffff : 0;
2607 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2608 XFlush (dpyinfo
->display
);
2610 x_uncatch_errors ();
2616 syms_of_xselect (void)
2618 defsubr (&Sx_get_selection_internal
);
2619 defsubr (&Sx_own_selection_internal
);
2620 defsubr (&Sx_disown_selection_internal
);
2621 defsubr (&Sx_selection_owner_p
);
2622 defsubr (&Sx_selection_exists_p
);
2624 defsubr (&Sx_get_atom_name
);
2625 defsubr (&Sx_send_client_message
);
2626 defsubr (&Sx_register_dnd_atom
);
2628 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2629 staticpro (&reading_selection_reply
);
2630 reading_selection_window
= 0;
2631 reading_which_selection
= 0;
2633 property_change_wait_list
= 0;
2634 prop_location_identifier
= 0;
2635 property_change_reply
= Fcons (Qnil
, Qnil
);
2636 staticpro (&property_change_reply
);
2638 converted_selections
= NULL
;
2639 conversion_fail_tag
= None
;
2641 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2642 doc
: /* An alist associating X Windows selection-types with functions.
2643 These functions are called to convert the selection, with three args:
2644 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2645 a desired type to which the selection should be converted;
2646 and the local selection value (whatever was given to `x-own-selection').
2648 The function should return the value to send to the X server
2649 \(typically a string). A return value of nil
2650 means that the conversion could not be done.
2651 A return value which is the symbol `NULL'
2652 means that a side-effect was executed,
2653 and there is no meaningful selection value. */);
2654 Vselection_converter_alist
= Qnil
;
2656 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2657 doc
: /* A list of functions to be called when Emacs loses an X selection.
2658 \(This happens when some other X client makes its own selection
2659 or when a Lisp program explicitly clears the selection.)
2660 The functions are called with one argument, the selection type
2661 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2662 Vx_lost_selection_functions
= Qnil
;
2664 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2665 doc
: /* A list of functions to be called when Emacs answers a selection request.
2666 The functions are called with three arguments:
2667 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2668 - the selection-type which Emacs was asked to convert the
2669 selection into before sending (for example, `STRING' or `LENGTH');
2670 - a flag indicating success or failure for responding to the request.
2671 We might have failed (and declined the request) for any number of reasons,
2672 including being asked for a selection that we no longer own, or being asked
2673 to convert into a type that we don't know about or that is inappropriate.
2674 This hook doesn't let you change the behavior of Emacs's selection replies,
2675 it merely informs you that they have happened. */);
2676 Vx_sent_selection_functions
= Qnil
;
2678 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2679 Vx_select_enable_clipboard_manager
,
2680 doc
: /* Whether to enable X clipboard manager support.
2681 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2682 while owning the X clipboard, the clipboard contents are saved to the
2683 clipboard manager if one is present. */);
2684 Vx_select_enable_clipboard_manager
= Qt
;
2686 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2687 doc
: /* Number of milliseconds to wait for a selection reply.
2688 If the selection owner doesn't reply in this time, we give up.
2689 A value of 0 means wait as long as necessary. This is initialized from the
2690 \"*selectionTimeout\" resource. */);
2691 x_selection_timeout
= 0;
2693 /* QPRIMARY is defined in keyboard.c. */
2694 DEFSYM (QSECONDARY
, "SECONDARY");
2695 DEFSYM (QSTRING
, "STRING");
2696 DEFSYM (QINTEGER
, "INTEGER");
2697 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2698 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2699 DEFSYM (QTEXT
, "TEXT");
2700 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2701 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2702 DEFSYM (QDELETE
, "DELETE");
2703 DEFSYM (QMULTIPLE
, "MULTIPLE");
2704 DEFSYM (QINCR
, "INCR");
2705 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2706 DEFSYM (QTARGETS
, "TARGETS");
2707 DEFSYM (QATOM
, "ATOM");
2708 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2709 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2710 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2711 DEFSYM (QNULL
, "NULL");
2712 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2713 DEFSYM (Qforeign_selection
, "foreign-selection");
2714 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2715 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");