1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* Rewritten by jwz */
24 #include <stdio.h> /* termhooks.h needs this */
27 #ifdef HAVE_SYS_TYPES_H
28 #include <sys/types.h>
34 #include "xterm.h" /* for all of the X includes */
35 #include "dispextern.h" /* frame.h seems to want this */
36 #include "frame.h" /* Need this to get the X window of selected_frame */
37 #include "blockinput.h"
40 #include "termhooks.h"
42 #include "character.h"
44 #include <X11/Xproto.h>
47 struct selection_data
;
49 static Lisp_Object
x_atom_to_symbol (Display
*dpy
, Atom atom
);
50 static Atom
symbol_to_x_atom (struct x_display_info
*, Lisp_Object
);
51 static void x_own_selection (Lisp_Object
, Lisp_Object
, Lisp_Object
);
52 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int,
53 struct x_display_info
*);
54 static void x_decline_selection_request (struct input_event
*);
55 static Lisp_Object
x_selection_request_lisp_error (Lisp_Object
);
56 static Lisp_Object
queue_selection_requests_unwind (Lisp_Object
);
57 static Lisp_Object
x_catch_errors_unwind (Lisp_Object
);
58 static void x_reply_selection_request (struct input_event
*, struct x_display_info
*);
59 static int x_convert_selection (struct input_event
*, Lisp_Object
, Lisp_Object
,
60 Atom
, int, struct x_display_info
*);
61 static int waiting_for_other_props_on_window (Display
*, Window
);
62 static struct prop_location
*expect_property_change (Display
*, Window
,
64 static void unexpect_property_change (struct prop_location
*);
65 static Lisp_Object
wait_for_property_change_unwind (Lisp_Object
);
66 static void wait_for_property_change (struct prop_location
*);
67 static Lisp_Object
x_get_foreign_selection (Lisp_Object
, Lisp_Object
,
68 Lisp_Object
, Lisp_Object
);
69 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
72 static Lisp_Object
selection_data_to_lisp_data (Display
*,
73 const unsigned char *,
74 ptrdiff_t, Atom
, int);
75 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
76 unsigned char **, Atom
*,
77 ptrdiff_t *, int *, int *);
78 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
80 /* Printing traces to stderr. */
82 #ifdef TRACE_SELECTION
84 fprintf (stderr, "%d: " fmt "\n", getpid ())
85 #define TRACE1(fmt, a0) \
86 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
87 #define TRACE2(fmt, a0, a1) \
88 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
89 #define TRACE3(fmt, a0, a1, a2) \
90 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
92 #define TRACE0(fmt) (void) 0
93 #define TRACE1(fmt, a0) (void) 0
94 #define TRACE2(fmt, a0, a1) (void) 0
98 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
99 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
100 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
102 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
103 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
105 static Lisp_Object Qcompound_text_with_extensions
;
107 static Lisp_Object Qforeign_selection
;
108 static Lisp_Object Qx_lost_selection_functions
, Qx_sent_selection_functions
;
110 /* Bytes needed to represent 'long' data. This is as per libX11; it
111 is not necessarily sizeof (long). */
112 #define X_LONG_SIZE 4
114 /* Maximum unsigned 'short' and 'long' values suitable for libX11. */
115 #define X_USHRT_MAX 0xffff
116 #define X_ULONG_MAX 0xffffffff
118 /* If this is a smaller number than the max-request-size of the display,
119 emacs will use INCR selection transfer when the selection is larger
120 than this. The max-request-size is usually around 64k, so if you want
121 emacs to use incremental selection transfers when the selection is
122 smaller than that, set this. I added this mostly for debugging the
123 incremental transfer stuff, but it might improve server performance.
125 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
126 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
127 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
128 - 1 in place of INT_MAX. */
129 #define MAX_SELECTION_QUANTUM \
130 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
131 / max (X_LONG_SIZE, sizeof (long)))))
134 selection_quantum (Display
*display
)
136 long mrs
= XMaxRequestSize (display
);
137 return (mrs
< MAX_SELECTION_QUANTUM
/ X_LONG_SIZE
+ 25
138 ? (mrs
- 25) * X_LONG_SIZE
139 : MAX_SELECTION_QUANTUM
);
142 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
143 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
146 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
149 struct selection_event_queue
151 struct input_event event
;
152 struct selection_event_queue
*next
;
155 static struct selection_event_queue
*selection_queue
;
157 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
159 static int x_queue_selection_requests
;
161 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
164 x_queue_event (struct input_event
*event
)
166 struct selection_event_queue
*queue_tmp
;
168 /* Don't queue repeated requests.
169 This only happens for large requests which uses the incremental protocol. */
170 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
172 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
174 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
175 x_decline_selection_request (event
);
181 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
183 if (queue_tmp
!= NULL
)
185 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
186 queue_tmp
->event
= *event
;
187 queue_tmp
->next
= selection_queue
;
188 selection_queue
= queue_tmp
;
192 /* Start queuing SELECTION_REQUEST_EVENT events. */
195 x_start_queuing_selection_requests (void)
197 if (x_queue_selection_requests
)
200 x_queue_selection_requests
++;
201 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
204 /* Stop queuing SELECTION_REQUEST_EVENT events. */
207 x_stop_queuing_selection_requests (void)
209 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
210 --x_queue_selection_requests
;
212 /* Take all the queued events and put them back
213 so that they get processed afresh. */
215 while (selection_queue
!= NULL
)
217 struct selection_event_queue
*queue_tmp
= selection_queue
;
218 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
219 kbd_buffer_unget_event (&queue_tmp
->event
);
220 selection_queue
= queue_tmp
->next
;
221 xfree ((char *)queue_tmp
);
226 /* This converts a Lisp symbol to a server Atom, avoiding a server
227 roundtrip whenever possible. */
230 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
233 if (NILP (sym
)) return 0;
234 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
235 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
236 if (EQ (sym
, QSTRING
)) return XA_STRING
;
237 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
238 if (EQ (sym
, QATOM
)) return XA_ATOM
;
239 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
240 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
241 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
242 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
243 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
244 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
245 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
246 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
247 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
248 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
249 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
250 if (!SYMBOLP (sym
)) abort ();
252 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
254 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
260 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
261 and calls to intern whenever possible. */
264 x_atom_to_symbol (Display
*dpy
, Atom atom
)
266 struct x_display_info
*dpyinfo
;
287 dpyinfo
= x_display_info_for_display (dpy
);
290 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
292 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
294 if (atom
== dpyinfo
->Xatom_TEXT
)
296 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
297 return QCOMPOUND_TEXT
;
298 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
300 if (atom
== dpyinfo
->Xatom_DELETE
)
302 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
304 if (atom
== dpyinfo
->Xatom_INCR
)
306 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
308 if (atom
== dpyinfo
->Xatom_TARGETS
)
310 if (atom
== dpyinfo
->Xatom_NULL
)
314 str
= XGetAtomName (dpy
, atom
);
316 TRACE1 ("XGetAtomName --> %s", str
);
317 if (! str
) return Qnil
;
320 /* This was allocated by Xlib, so use XFree. */
326 /* Do protocol to assert ourself as a selection owner.
327 FRAME shall be the owner; it must be a valid X frame.
328 Update the Vselection_alist so that we can reply to later requests for
332 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
335 struct frame
*f
= XFRAME (frame
);
336 Window selecting_window
= FRAME_X_WINDOW (f
);
337 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
338 Display
*display
= dpyinfo
->display
;
339 Time timestamp
= last_event_timestamp
;
340 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
343 x_catch_errors (display
);
344 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
345 x_check_errors (display
, "Can't set selection: %s");
349 /* Now update the local cache */
351 Lisp_Object selection_data
;
352 Lisp_Object prev_value
;
354 selection_data
= list4 (selection_name
, selection_value
,
355 INTEGER_TO_CONS (timestamp
), frame
);
356 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
358 dpyinfo
->terminal
->Vselection_alist
359 = Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
);
361 /* If we already owned the selection, remove the old selection
362 data. Don't use Fdelq as that may QUIT. */
363 if (!NILP (prev_value
))
365 /* We know it's not the CAR, so it's easy. */
366 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
367 for (; CONSP (rest
); rest
= XCDR (rest
))
368 if (EQ (prev_value
, Fcar (XCDR (rest
))))
370 XSETCDR (rest
, XCDR (XCDR (rest
)));
377 /* Given a selection-name and desired type, look up our local copy of
378 the selection value and convert it to the type.
379 The value is nil or a string.
380 This function is used both for remote requests (LOCAL_REQUEST is zero)
381 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
383 This calls random Lisp code, and may signal or gc. */
386 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
387 int local_request
, struct x_display_info
*dpyinfo
)
389 Lisp_Object local_value
;
390 Lisp_Object handler_fn
, value
, check
;
393 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
395 if (NILP (local_value
)) return Qnil
;
397 /* TIMESTAMP is a special case. */
398 if (EQ (target_type
, QTIMESTAMP
))
401 value
= XCAR (XCDR (XCDR (local_value
)));
405 /* Don't allow a quit within the converter.
406 When the user types C-g, he would be surprised
407 if by luck it came during a converter. */
408 count
= SPECPDL_INDEX ();
409 specbind (Qinhibit_quit
, Qt
);
411 CHECK_SYMBOL (target_type
);
412 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
413 /* gcpro is not needed here since nothing but HANDLER_FN
414 is live, and that ought to be a symbol. */
416 if (!NILP (handler_fn
))
417 value
= call3 (handler_fn
,
418 selection_symbol
, (local_request
? Qnil
: target_type
),
419 XCAR (XCDR (local_value
)));
422 unbind_to (count
, Qnil
);
425 /* Make sure this value is of a type that we could transmit
426 to another X client. */
430 && SYMBOLP (XCAR (value
)))
431 check
= XCDR (value
);
439 /* Check for a value that CONS_TO_INTEGER could handle. */
440 else if (CONSP (check
)
441 && INTEGERP (XCAR (check
))
442 && (INTEGERP (XCDR (check
))
444 (CONSP (XCDR (check
))
445 && INTEGERP (XCAR (XCDR (check
)))
446 && NILP (XCDR (XCDR (check
))))))
449 signal_error ("Invalid data returned by selection-conversion function",
450 list2 (handler_fn
, value
));
453 /* Subroutines of x_reply_selection_request. */
455 /* Send a SelectionNotify event to the requestor with property=None,
456 meaning we were unable to do what they wanted. */
459 x_decline_selection_request (struct input_event
*event
)
462 XSelectionEvent
*reply
= &(reply_base
.xselection
);
464 reply
->type
= SelectionNotify
;
465 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
466 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
467 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
468 reply
->time
= SELECTION_EVENT_TIME (event
);
469 reply
->target
= SELECTION_EVENT_TARGET (event
);
470 reply
->property
= None
;
472 /* The reason for the error may be that the receiver has
473 died in the meantime. Handle that case. */
475 x_catch_errors (reply
->display
);
476 XSendEvent (reply
->display
, reply
->requestor
, False
, 0L, &reply_base
);
477 XFlush (reply
->display
);
482 /* This is the selection request currently being processed.
483 It is set to zero when the request is fully processed. */
484 static struct input_event
*x_selection_current_request
;
486 /* Display info in x_selection_request. */
488 static struct x_display_info
*selection_request_dpyinfo
;
490 /* Raw selection data, for sending to a requestor window. */
492 struct selection_data
500 /* This can be set to non-NULL during x_reply_selection_request, if
501 the selection is waiting for an INCR transfer to complete. Don't
502 free these; that's done by unexpect_property_change. */
503 struct prop_location
*wait_object
;
504 struct selection_data
*next
;
507 /* Linked list of the above (in support of MULTIPLE targets). */
509 static struct selection_data
*converted_selections
;
511 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
512 static Atom conversion_fail_tag
;
514 /* Used as an unwind-protect clause so that, if a selection-converter signals
515 an error, we tell the requester that we were unable to do what they wanted
516 before we throw to top-level or go into the debugger or whatever. */
519 x_selection_request_lisp_error (Lisp_Object ignore
)
521 struct selection_data
*cs
, *next
;
523 for (cs
= converted_selections
; cs
; cs
= next
)
526 if (cs
->nofree
== 0 && cs
->data
)
530 converted_selections
= NULL
;
532 if (x_selection_current_request
!= 0
533 && selection_request_dpyinfo
->display
)
534 x_decline_selection_request (x_selection_current_request
);
539 x_catch_errors_unwind (Lisp_Object dummy
)
548 /* This stuff is so that INCR selections are reentrant (that is, so we can
549 be servicing multiple INCR selection requests simultaneously.) I haven't
550 actually tested that yet. */
552 /* Keep a list of the property changes that are awaited. */
562 struct prop_location
*next
;
565 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
566 static void wait_for_property_change (struct prop_location
*location
);
567 static void unexpect_property_change (struct prop_location
*location
);
568 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
570 static int prop_location_identifier
;
572 static Lisp_Object property_change_reply
;
574 static struct prop_location
*property_change_reply_object
;
576 static struct prop_location
*property_change_wait_list
;
579 queue_selection_requests_unwind (Lisp_Object tem
)
581 x_stop_queuing_selection_requests ();
586 /* Send the reply to a selection request event EVENT. */
588 #ifdef TRACE_SELECTION
589 static int x_reply_selection_request_cnt
;
590 #endif /* TRACE_SELECTION */
593 x_reply_selection_request (struct input_event
*event
, struct x_display_info
*dpyinfo
)
596 XSelectionEvent
*reply
= &(reply_base
.xselection
);
597 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
598 Window window
= SELECTION_EVENT_REQUESTOR (event
);
599 ptrdiff_t bytes_remaining
;
600 int max_bytes
= selection_quantum (display
);
601 int count
= SPECPDL_INDEX ();
602 struct selection_data
*cs
;
604 reply
->type
= SelectionNotify
;
605 reply
->display
= display
;
606 reply
->requestor
= window
;
607 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
608 reply
->time
= SELECTION_EVENT_TIME (event
);
609 reply
->target
= SELECTION_EVENT_TARGET (event
);
610 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
611 if (reply
->property
== None
)
612 reply
->property
= reply
->target
;
615 /* The protected block contains wait_for_property_change, which can
616 run random lisp code (process handlers) or signal. Therefore, we
617 put the x_uncatch_errors call in an unwind. */
618 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
619 x_catch_errors (display
);
621 /* Loop over converted selections, storing them in the requested
622 properties. If data is large, only store the first N bytes
623 (section 2.7.2 of ICCCM). Note that we store the data for a
624 MULTIPLE request in the opposite order; the ICCM says only that
625 the conversion itself must be done in the same order. */
626 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
628 if (cs
->property
== None
)
631 bytes_remaining
= cs
->size
;
632 bytes_remaining
*= cs
->format
>> 3;
633 if (bytes_remaining
<= max_bytes
)
635 /* Send all the data at once, with minimal handshaking. */
636 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
637 XChangeProperty (display
, window
, cs
->property
,
638 cs
->type
, cs
->format
, PropModeReplace
,
643 /* Send an INCR tag to initiate incremental transfer. */
644 unsigned long value
[1];
646 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
647 bytes_remaining
, XGetAtomName (display
, cs
->property
));
649 = expect_property_change (display
, window
, cs
->property
,
652 /* XChangeProperty expects an array of long even if long is
653 more than 32 bits. */
654 value
[0] = min (bytes_remaining
, X_ULONG_MAX
);
655 XChangeProperty (display
, window
, cs
->property
,
656 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
657 (unsigned char *) value
, 1);
658 XSelectInput (display
, window
, PropertyChangeMask
);
662 /* Now issue the SelectionNotify event. */
663 XSendEvent (display
, window
, False
, 0L, &reply_base
);
666 #ifdef TRACE_SELECTION
668 char *sel
= XGetAtomName (display
, reply
->selection
);
669 char *tgt
= XGetAtomName (display
, reply
->target
);
670 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
671 sel
, tgt
, ++x_reply_selection_request_cnt
);
672 if (sel
) XFree (sel
);
673 if (tgt
) XFree (tgt
);
675 #endif /* TRACE_SELECTION */
677 /* Finish sending the rest of each of the INCR values. This should
678 be improved; there's a chance of deadlock if more than one
679 subtarget in a MULTIPLE selection requires an INCR transfer, and
680 the requestor and Emacs loop waiting on different transfers. */
681 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
684 int format_bytes
= cs
->format
/ 8;
685 int had_errors
= x_had_errors_p (display
);
688 bytes_remaining
= cs
->size
;
689 bytes_remaining
*= format_bytes
;
691 /* Wait for the requester to ack by deleting the property.
692 This can run Lisp code (process handlers) or signal. */
695 TRACE1 ("Waiting for ACK (deletion of %s)",
696 XGetAtomName (display
, cs
->property
));
697 wait_for_property_change (cs
->wait_object
);
700 unexpect_property_change (cs
->wait_object
);
702 while (bytes_remaining
)
704 int i
= ((bytes_remaining
< max_bytes
)
706 : max_bytes
) / format_bytes
;
710 = expect_property_change (display
, window
, cs
->property
,
713 TRACE1 ("Sending increment of %d elements", i
);
714 TRACE1 ("Set %s to increment data",
715 XGetAtomName (display
, cs
->property
));
717 /* Append the next chunk of data to the property. */
718 XChangeProperty (display
, window
, cs
->property
,
719 cs
->type
, cs
->format
, PropModeAppend
,
721 bytes_remaining
-= i
* format_bytes
;
722 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
725 had_errors
= x_had_errors_p (display
);
728 if (had_errors
) break;
730 /* Wait for the requester to ack this chunk by deleting
731 the property. This can run Lisp code or signal. */
732 TRACE1 ("Waiting for increment ACK (deletion of %s)",
733 XGetAtomName (display
, cs
->property
));
734 wait_for_property_change (cs
->wait_object
);
737 /* Now write a zero-length chunk to the property to tell the
738 requester that we're done. */
740 if (! waiting_for_other_props_on_window (display
, window
))
741 XSelectInput (display
, window
, 0L);
743 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
744 XGetAtomName (display
, cs
->property
));
745 XChangeProperty (display
, window
, cs
->property
,
746 cs
->type
, cs
->format
, PropModeReplace
,
748 TRACE0 ("Done sending incrementally");
751 /* rms, 2003-01-03: I think I have fixed this bug. */
752 /* The window we're communicating with may have been deleted
753 in the meantime (that's a real situation from a bug report).
754 In this case, there may be events in the event queue still
755 refering to the deleted window, and we'll get a BadWindow error
756 in XTread_socket when processing the events. I don't have
757 an idea how to fix that. gerd, 2001-01-98. */
758 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
759 delivered before uncatch errors. */
760 XSync (display
, False
);
763 /* GTK queues events in addition to the queue in Xlib. So we
764 UNBLOCK to enter the event loop and get possible errors delivered,
765 and then BLOCK again because x_uncatch_errors requires it. */
767 /* This calls x_uncatch_errors. */
768 unbind_to (count
, Qnil
);
772 /* Handle a SelectionRequest event EVENT.
773 This is called from keyboard.c when such an event is found in the queue. */
776 x_handle_selection_request (struct input_event
*event
)
778 struct gcpro gcpro1
, gcpro2
;
779 Time local_selection_time
;
781 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
782 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
783 Atom selection
= SELECTION_EVENT_SELECTION (event
);
784 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
785 Atom target
= SELECTION_EVENT_TARGET (event
);
786 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
787 Atom property
= SELECTION_EVENT_PROPERTY (event
);
788 Lisp_Object local_selection_data
;
790 int count
= SPECPDL_INDEX ();
791 GCPRO2 (local_selection_data
, target_symbol
);
793 if (!dpyinfo
) goto DONE
;
795 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
797 /* Decline if we don't own any selections. */
798 if (NILP (local_selection_data
)) goto DONE
;
800 /* Decline requests issued prior to our acquiring the selection. */
801 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
802 Time
, local_selection_time
);
803 if (SELECTION_EVENT_TIME (event
) != CurrentTime
804 && local_selection_time
> SELECTION_EVENT_TIME (event
))
807 x_selection_current_request
= event
;
808 selection_request_dpyinfo
= dpyinfo
;
809 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
811 /* We might be able to handle nested x_handle_selection_requests,
812 but this is difficult to test, and seems unimportant. */
813 x_start_queuing_selection_requests ();
814 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
816 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
817 SDATA (SYMBOL_NAME (selection_symbol
)),
818 SDATA (SYMBOL_NAME (target_symbol
)));
820 if (EQ (target_symbol
, QMULTIPLE
))
822 /* For MULTIPLE targets, the event property names a list of atom
823 pairs; the first atom names a target and the second names a
824 non-None property. */
825 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
826 Lisp_Object multprop
;
827 ptrdiff_t j
, nselections
;
829 if (property
== None
) goto DONE
;
831 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
832 QMULTIPLE
, selection
);
834 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
837 nselections
= ASIZE (multprop
) / 2;
838 /* Perform conversions. This can signal. */
839 for (j
= 0; j
< nselections
; j
++)
841 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
842 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
843 AREF (multprop
, 2*j
+1));
845 if (subproperty
!= None
)
846 x_convert_selection (event
, selection_symbol
, subtarget
,
847 subproperty
, 1, dpyinfo
);
853 if (property
== None
)
854 property
= SELECTION_EVENT_TARGET (event
);
855 success
= x_convert_selection (event
, selection_symbol
,
856 target_symbol
, property
,
863 x_reply_selection_request (event
, dpyinfo
);
865 x_decline_selection_request (event
);
866 x_selection_current_request
= 0;
868 /* Run the `x-sent-selection-functions' abnormal hook. */
869 if (!NILP (Vx_sent_selection_functions
)
870 && !EQ (Vx_sent_selection_functions
, Qunbound
))
873 args
[0] = Qx_sent_selection_functions
;
874 args
[1] = selection_symbol
;
875 args
[2] = target_symbol
;
876 args
[3] = success
? Qt
: Qnil
;
877 Frun_hook_with_args (4, args
);
880 unbind_to (count
, Qnil
);
884 /* Perform the requested selection conversion, and write the data to
885 the converted_selections linked list, where it can be accessed by
886 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
887 the data even if conversion fails, using conversion_fail_tag.
889 Return 0 if the selection failed to convert, 1 otherwise. */
892 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
893 Lisp_Object target_symbol
, Atom property
,
894 int for_multiple
, struct x_display_info
*dpyinfo
)
897 Lisp_Object lisp_selection
;
898 struct selection_data
*cs
;
899 GCPRO1 (lisp_selection
);
902 = x_get_local_selection (selection_symbol
, target_symbol
,
905 /* A nil return value means we can't perform the conversion. */
906 if (NILP (lisp_selection
)
907 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
911 cs
= xmalloc (sizeof (struct selection_data
));
912 cs
->data
= (unsigned char *) &conversion_fail_tag
;
917 cs
->property
= property
;
918 cs
->wait_object
= NULL
;
919 cs
->next
= converted_selections
;
920 converted_selections
= cs
;
927 /* Otherwise, record the converted selection to binary. */
928 cs
= xmalloc (sizeof (struct selection_data
));
930 cs
->property
= property
;
931 cs
->wait_object
= NULL
;
932 cs
->next
= converted_selections
;
933 converted_selections
= cs
;
934 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
936 &(cs
->data
), &(cs
->type
),
937 &(cs
->size
), &(cs
->format
),
943 /* Handle a SelectionClear event EVENT, which indicates that some
944 client cleared out our previously asserted selection.
945 This is called from keyboard.c when such an event is found in the queue. */
948 x_handle_selection_clear (struct input_event
*event
)
950 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
951 Atom selection
= SELECTION_EVENT_SELECTION (event
);
952 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
954 Lisp_Object selection_symbol
, local_selection_data
;
955 Time local_selection_time
;
956 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
957 Lisp_Object Vselection_alist
;
959 TRACE0 ("x_handle_selection_clear");
961 if (!dpyinfo
) return;
963 selection_symbol
= x_atom_to_symbol (display
, selection
);
964 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
966 /* Well, we already believe that we don't own it, so that's just fine. */
967 if (NILP (local_selection_data
)) return;
969 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
970 Time
, local_selection_time
);
972 /* We have reasserted the selection since this SelectionClear was
973 generated, so we can disregard it. */
974 if (changed_owner_time
!= CurrentTime
975 && local_selection_time
> changed_owner_time
)
978 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
979 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
980 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
981 Vselection_alist
= XCDR (Vselection_alist
);
985 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
986 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
988 XSETCDR (rest
, XCDR (XCDR (rest
)));
992 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
994 /* Run the `x-lost-selection-functions' abnormal hook. */
997 args
[0] = Qx_lost_selection_functions
;
998 args
[1] = selection_symbol
;
999 Frun_hook_with_args (2, args
);
1002 prepare_menu_bars ();
1003 redisplay_preserve_echo_area (20);
1007 x_handle_selection_event (struct input_event
*event
)
1009 TRACE0 ("x_handle_selection_event");
1010 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
1011 x_handle_selection_clear (event
);
1012 else if (x_queue_selection_requests
)
1013 x_queue_event (event
);
1015 x_handle_selection_request (event
);
1019 /* Clear all selections that were made from frame F.
1020 We do this when about to delete a frame. */
1023 x_clear_frame_selections (FRAME_PTR f
)
1027 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1028 struct terminal
*t
= dpyinfo
->terminal
;
1030 XSETFRAME (frame
, f
);
1032 /* Delete elements from the beginning of Vselection_alist. */
1033 while (CONSP (t
->Vselection_alist
)
1034 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1036 /* Run the `x-lost-selection-functions' abnormal hook. */
1037 Lisp_Object args
[2];
1038 args
[0] = Qx_lost_selection_functions
;
1039 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1040 Frun_hook_with_args (2, args
);
1042 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
1045 /* Delete elements after the beginning of Vselection_alist. */
1046 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1047 if (CONSP (XCDR (rest
))
1048 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1050 Lisp_Object args
[2];
1051 args
[0] = Qx_lost_selection_functions
;
1052 args
[1] = XCAR (XCAR (XCDR (rest
)));
1053 Frun_hook_with_args (2, args
);
1054 XSETCDR (rest
, XCDR (XCDR (rest
)));
1059 /* Nonzero if any properties for DISPLAY and WINDOW
1060 are on the list of what we are waiting for. */
1063 waiting_for_other_props_on_window (Display
*display
, Window window
)
1065 struct prop_location
*rest
= property_change_wait_list
;
1067 if (rest
->display
== display
&& rest
->window
== window
)
1074 /* Add an entry to the list of property changes we are waiting for.
1075 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1076 The return value is a number that uniquely identifies
1077 this awaited property change. */
1079 static struct prop_location
*
1080 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1082 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1083 pl
->identifier
= ++prop_location_identifier
;
1084 pl
->display
= display
;
1085 pl
->window
= window
;
1086 pl
->property
= property
;
1087 pl
->desired_state
= state
;
1088 pl
->next
= property_change_wait_list
;
1090 property_change_wait_list
= pl
;
1094 /* Delete an entry from the list of property changes we are waiting for.
1095 IDENTIFIER is the number that uniquely identifies the entry. */
1098 unexpect_property_change (struct prop_location
*location
)
1100 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1103 if (rest
== location
)
1106 prev
->next
= rest
->next
;
1108 property_change_wait_list
= rest
->next
;
1117 /* Remove the property change expectation element for IDENTIFIER. */
1120 wait_for_property_change_unwind (Lisp_Object loc
)
1122 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1124 unexpect_property_change (location
);
1125 if (location
== property_change_reply_object
)
1126 property_change_reply_object
= 0;
1130 /* Actually wait for a property change.
1131 IDENTIFIER should be the value that expect_property_change returned. */
1134 wait_for_property_change (struct prop_location
*location
)
1137 int count
= SPECPDL_INDEX ();
1139 if (property_change_reply_object
)
1142 /* Make sure to do unexpect_property_change if we quit or err. */
1143 record_unwind_protect (wait_for_property_change_unwind
,
1144 make_save_value (location
, 0));
1146 XSETCAR (property_change_reply
, Qnil
);
1147 property_change_reply_object
= location
;
1149 /* If the event we are waiting for arrives beyond here, it will set
1150 property_change_reply, because property_change_reply_object says so. */
1151 if (! location
->arrived
)
1153 secs
= x_selection_timeout
/ 1000;
1154 usecs
= (x_selection_timeout
% 1000) * 1000;
1155 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1156 wait_reading_process_output (secs
, usecs
, 0, 0,
1157 property_change_reply
, NULL
, 0);
1159 if (NILP (XCAR (property_change_reply
)))
1161 TRACE0 (" Timed out");
1162 error ("Timed out waiting for property-notify event");
1166 unbind_to (count
, Qnil
);
1169 /* Called from XTread_socket in response to a PropertyNotify event. */
1172 x_handle_property_notify (XPropertyEvent
*event
)
1174 struct prop_location
*rest
;
1176 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1179 && rest
->property
== event
->atom
1180 && rest
->window
== event
->window
1181 && rest
->display
== event
->display
1182 && rest
->desired_state
== event
->state
)
1184 TRACE2 ("Expected %s of property %s",
1185 (event
->state
== PropertyDelete
? "deletion" : "change"),
1186 XGetAtomName (event
->display
, event
->atom
));
1190 /* If this is the one wait_for_property_change is waiting for,
1191 tell it to wake up. */
1192 if (rest
== property_change_reply_object
)
1193 XSETCAR (property_change_reply
, Qt
);
1202 /* Variables for communication with x_handle_selection_notify. */
1203 static Atom reading_which_selection
;
1204 static Lisp_Object reading_selection_reply
;
1205 static Window reading_selection_window
;
1207 /* Do protocol to read selection-data from the server.
1208 Converts this to Lisp data and returns it.
1209 FRAME is the frame whose X window shall request the selection. */
1212 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1213 Lisp_Object time_stamp
, Lisp_Object frame
)
1215 struct frame
*f
= XFRAME (frame
);
1216 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1217 Display
*display
= dpyinfo
->display
;
1218 Window requestor_window
= FRAME_X_WINDOW (f
);
1219 Time requestor_time
= last_event_timestamp
;
1220 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1221 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1222 Atom type_atom
= (CONSP (target_type
)
1223 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1224 : symbol_to_x_atom (dpyinfo
, target_type
));
1227 if (!FRAME_LIVE_P (f
))
1230 if (! NILP (time_stamp
))
1231 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1234 TRACE2 ("Get selection %s, type %s",
1235 XGetAtomName (display
, type_atom
),
1236 XGetAtomName (display
, target_property
));
1238 x_catch_errors (display
);
1239 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1240 requestor_window
, requestor_time
);
1241 x_check_errors (display
, "Can't convert selection: %s");
1242 x_uncatch_errors ();
1244 /* Prepare to block until the reply has been read. */
1245 reading_selection_window
= requestor_window
;
1246 reading_which_selection
= selection_atom
;
1247 XSETCAR (reading_selection_reply
, Qnil
);
1249 /* It should not be necessary to stop handling selection requests
1250 during this time. In fact, the SAVE_TARGETS mechanism requires
1251 us to handle a clipboard manager's requests before it returns
1254 x_start_queuing_selection_requests ();
1255 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1260 /* This allows quits. Also, don't wait forever. */
1261 secs
= x_selection_timeout
/ 1000;
1262 usecs
= (x_selection_timeout
% 1000) * 1000;
1263 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1264 wait_reading_process_output (secs
, usecs
, 0, 0,
1265 reading_selection_reply
, NULL
, 0);
1266 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1268 if (NILP (XCAR (reading_selection_reply
)))
1269 error ("Timed out waiting for reply from selection owner");
1270 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1273 /* Otherwise, the selection is waiting for us on the requested property. */
1275 x_get_window_property_as_lisp_data (display
, requestor_window
,
1276 target_property
, target_type
,
1280 /* Subroutines of x_get_window_property_as_lisp_data */
1282 /* Use xfree, not XFree, to free the data obtained with this function. */
1285 x_get_window_property (Display
*display
, Window window
, Atom property
,
1286 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1287 Atom
*actual_type_ret
, int *actual_format_ret
,
1288 unsigned long *actual_size_ret
, int delete_p
)
1290 ptrdiff_t total_size
;
1291 unsigned long bytes_remaining
;
1292 ptrdiff_t offset
= 0;
1293 unsigned char *data
= 0;
1294 unsigned char *tmp_data
= 0;
1296 int buffer_size
= selection_quantum (display
);
1298 /* Wide enough to avoid overflow in expressions using it. */
1299 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1301 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1302 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1303 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1304 ptrdiff_t total_size_max
=
1305 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1306 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1307 : LONG_MAX
* x_long_size
);
1311 /* First probe the thing to find out how big it is. */
1312 result
= XGetWindowProperty (display
, window
, property
,
1313 0L, 0L, False
, AnyPropertyType
,
1314 actual_type_ret
, actual_format_ret
,
1316 &bytes_remaining
, &tmp_data
);
1317 if (result
!= Success
)
1320 /* This was allocated by Xlib, so use XFree. */
1321 XFree ((char *) tmp_data
);
1323 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1326 if (total_size_max
< bytes_remaining
)
1328 total_size
= bytes_remaining
;
1329 data
= malloc (total_size
+ 1);
1331 goto memory_exhausted
;
1333 /* Now read, until we've gotten it all. */
1334 while (bytes_remaining
)
1336 ptrdiff_t bytes_gotten
;
1339 = XGetWindowProperty (display
, window
, property
,
1340 offset
/ X_LONG_SIZE
,
1341 buffer_size
/ X_LONG_SIZE
,
1344 actual_type_ret
, actual_format_ret
,
1345 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1347 /* If this doesn't return Success at this point, it means that
1348 some clod deleted the selection while we were in the midst of
1349 reading it. Deal with that, I guess.... */
1350 if (result
!= Success
)
1353 bytes_per_item
= *actual_format_ret
>> 3;
1354 xassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1356 /* The man page for XGetWindowProperty says:
1357 "If the returned format is 32, the returned data is represented
1358 as a long array and should be cast to that type to obtain the
1360 This applies even if long is more than 32 bits, the X library
1361 converts from 32 bit elements received from the X server to long
1362 and passes the long array to us. Thus, for that case memcpy can not
1363 be used. We convert to a 32 bit type here, because so much code
1366 The bytes and offsets passed to XGetWindowProperty refers to the
1367 property and those are indeed in 32 bit quantities if format is 32. */
1369 bytes_gotten
= *actual_size_ret
;
1370 bytes_gotten
*= bytes_per_item
;
1372 TRACE2 ("Read %"pD
"d bytes from property %s",
1373 bytes_gotten
, XGetAtomName (display
, property
));
1375 if (total_size
- offset
< bytes_gotten
)
1377 unsigned char *data1
;
1378 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1379 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1381 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1382 data1
= realloc (data
, total_size
+ 1);
1384 goto memory_exhausted
;
1388 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1391 int *idata
= (int *) (data
+ offset
);
1392 long *ldata
= (long *) tmp_data
;
1394 for (i
= 0; i
< *actual_size_ret
; ++i
)
1395 idata
[i
] = ldata
[i
];
1398 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1400 offset
+= bytes_gotten
;
1402 /* This was allocated by Xlib, so use XFree. */
1403 XFree ((char *) tmp_data
);
1407 data
[offset
] = '\0';
1412 *bytes_ret
= offset
;
1418 memory_full (SIZE_MAX
);
1423 memory_full (total_size
+ 1);
1426 /* Use xfree, not XFree, to free the data obtained with this function. */
1429 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1430 Lisp_Object target_type
,
1431 unsigned int min_size_bytes
,
1432 unsigned char **data_ret
,
1433 ptrdiff_t *size_bytes_ret
,
1434 Atom
*type_ret
, int *format_ret
,
1435 unsigned long *size_ret
)
1437 ptrdiff_t offset
= 0;
1438 struct prop_location
*wait_object
;
1439 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1440 memory_full (SIZE_MAX
);
1441 *data_ret
= (unsigned char *) xmalloc (min_size_bytes
);
1442 *size_bytes_ret
= min_size_bytes
;
1444 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1446 /* At this point, we have read an INCR property.
1447 Delete the property to ack it.
1448 (But first, prepare to receive the next event in this handshake.)
1450 Now, we must loop, waiting for the sending window to put a value on
1451 that property, then reading the property, then deleting it to ack.
1452 We are done when the sender places a property of length 0.
1455 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1456 TRACE1 (" Delete property %s",
1457 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1458 XDeleteProperty (display
, window
, property
);
1459 TRACE1 (" Expect new value of property %s",
1460 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1461 wait_object
= expect_property_change (display
, window
, property
,
1468 unsigned char *tmp_data
;
1469 ptrdiff_t tmp_size_bytes
;
1471 TRACE0 (" Wait for property change");
1472 wait_for_property_change (wait_object
);
1474 /* expect it again immediately, because x_get_window_property may
1475 .. no it won't, I don't get it.
1476 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1477 TRACE0 (" Get property value");
1478 x_get_window_property (display
, window
, property
,
1479 &tmp_data
, &tmp_size_bytes
,
1480 type_ret
, format_ret
, size_ret
, 1);
1482 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1484 if (tmp_size_bytes
== 0) /* we're done */
1486 TRACE0 ("Done reading incrementally");
1488 if (! waiting_for_other_props_on_window (display
, window
))
1489 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1490 /* Use xfree, not XFree, because x_get_window_property
1491 calls xmalloc itself. */
1497 TRACE1 (" ACK by deleting property %s",
1498 XGetAtomName (display
, property
));
1499 XDeleteProperty (display
, window
, property
);
1500 wait_object
= expect_property_change (display
, window
, property
,
1505 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1508 if (min (PTRDIFF_MAX
, SIZE_MAX
) - offset
< tmp_size_bytes
)
1511 memory_full (SIZE_MAX
);
1513 size
= offset
+ tmp_size_bytes
;
1514 *data_ret
= (unsigned char *) xrealloc (*data_ret
, size
);
1515 *size_bytes_ret
= size
;
1518 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1519 offset
+= tmp_size_bytes
;
1521 /* Use xfree, not XFree, because x_get_window_property
1522 calls xmalloc itself. */
1528 /* Fetch a value from property PROPERTY of X window WINDOW on display
1529 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1533 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1535 Lisp_Object target_type
,
1536 Atom selection_atom
)
1540 unsigned long actual_size
;
1541 unsigned char *data
= 0;
1542 ptrdiff_t bytes
= 0;
1544 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1546 TRACE0 ("Reading selection data");
1548 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1549 &actual_type
, &actual_format
, &actual_size
, 1);
1552 int there_is_a_selection_owner
;
1554 there_is_a_selection_owner
1555 = XGetSelectionOwner (display
, selection_atom
);
1557 if (there_is_a_selection_owner
)
1558 signal_error ("Selection owner couldn't convert",
1560 ? list2 (target_type
,
1561 x_atom_to_symbol (display
, actual_type
))
1564 signal_error ("No selection",
1565 x_atom_to_symbol (display
, selection_atom
));
1568 if (actual_type
== dpyinfo
->Xatom_INCR
)
1570 /* That wasn't really the data, just the beginning. */
1572 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1574 /* Use xfree, not XFree, because x_get_window_property
1575 calls xmalloc itself. */
1576 xfree ((char *) data
);
1578 receive_incremental_selection (display
, window
, property
, target_type
,
1579 min_size_bytes
, &data
, &bytes
,
1580 &actual_type
, &actual_format
,
1585 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1586 XDeleteProperty (display
, window
, property
);
1590 /* It's been read. Now convert it to a lisp object in some semi-rational
1592 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1593 actual_type
, actual_format
);
1595 /* Use xfree, not XFree, because x_get_window_property
1596 calls xmalloc itself. */
1597 xfree ((char *) data
);
1601 /* These functions convert from the selection data read from the server into
1602 something that we can use from Lisp, and vice versa.
1604 Type: Format: Size: Lisp Type:
1605 ----- ------- ----- -----------
1608 ATOM 32 > 1 Vector of Symbols
1610 * 16 > 1 Vector of Integers
1611 * 32 1 if <=16 bits: Integer
1612 if > 16 bits: Cons of top16, bot16
1613 * 32 > 1 Vector of the above
1615 When converting a Lisp number to C, it is assumed to be of format 16 if
1616 it is an integer, and of format 32 if it is a cons of two integers.
1618 When converting a vector of numbers from Lisp to C, it is assumed to be
1619 of format 16 if every element in the vector is an integer, and is assumed
1620 to be of format 32 if any element is a cons of two integers.
1622 When converting an object to C, it may be of the form (SYMBOL . <data>)
1623 where SYMBOL is what we should claim that the type is. Format and
1624 representation are as above.
1626 Important: When format is 32, data should contain an array of int,
1627 not an array of long as the X library returns. This makes a difference
1628 when sizeof(long) != sizeof(int). */
1633 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1634 ptrdiff_t size
, Atom type
, int format
)
1636 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1638 if (type
== dpyinfo
->Xatom_NULL
)
1641 /* Convert any 8-bit data to a string, for compactness. */
1642 else if (format
== 8)
1644 Lisp_Object str
, lispy_type
;
1646 str
= make_unibyte_string ((char *) data
, size
);
1647 /* Indicate that this string is from foreign selection by a text
1648 property `foreign-selection' so that the caller of
1649 x-get-selection-internal (usually x-get-selection) can know
1650 that the string must be decode. */
1651 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1652 lispy_type
= QCOMPOUND_TEXT
;
1653 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1654 lispy_type
= QUTF8_STRING
;
1656 lispy_type
= QSTRING
;
1657 Fput_text_property (make_number (0), make_number (size
),
1658 Qforeign_selection
, lispy_type
, str
);
1661 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1662 a vector of symbols. */
1663 else if (type
== XA_ATOM
1664 /* Treat ATOM_PAIR type similar to list of atoms. */
1665 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1668 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1669 But the callers of these function has made sure the data for
1670 format == 32 is an array of int. Thus, use int instead
1672 int *idata
= (int *) data
;
1674 if (size
== sizeof (int))
1675 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1678 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1680 for (i
= 0; i
< size
/ sizeof (int); i
++)
1681 Faset (v
, make_number (i
),
1682 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1687 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1688 If the number is 32 bits and won't fit in a Lisp_Int,
1689 convert it to a cons of integers, 16 bits in each half.
1691 else if (format
== 32 && size
== sizeof (int))
1692 return INTEGER_TO_CONS (((unsigned int *) data
) [0]);
1693 else if (format
== 16 && size
== sizeof (short))
1694 return make_number (((unsigned short *) data
) [0]);
1696 /* Convert any other kind of data to a vector of numbers, represented
1697 as above (as an integer, or a cons of two 16 bit integers.)
1699 else if (format
== 16)
1703 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1704 for (i
= 0; i
< size
/ 2; i
++)
1706 EMACS_INT j
= ((unsigned short *) data
) [i
];
1707 Faset (v
, make_number (i
), make_number (j
));
1714 Lisp_Object v
= Fmake_vector (make_number (size
/ X_LONG_SIZE
),
1716 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1718 unsigned int j
= ((unsigned int *) data
) [i
];
1719 Faset (v
, make_number (i
), INTEGER_TO_CONS (j
));
1726 /* Use xfree, not XFree, to free the data obtained with this function. */
1729 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1730 unsigned char **data_ret
, Atom
*type_ret
,
1731 ptrdiff_t *size_ret
,
1732 int *format_ret
, int *nofree_ret
)
1734 Lisp_Object type
= Qnil
;
1735 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1739 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1743 if (CONSP (obj
) && NILP (XCDR (obj
)))
1747 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1748 { /* This is not the same as declining */
1754 else if (STRINGP (obj
))
1756 if (SCHARS (obj
) < SBYTES (obj
))
1757 /* OBJ is a multibyte string containing a non-ASCII char. */
1758 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1762 *size_ret
= SBYTES (obj
);
1763 *data_ret
= SDATA (obj
);
1766 else if (SYMBOLP (obj
))
1768 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1771 (*data_ret
) [sizeof (Atom
)] = 0;
1772 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1773 if (NILP (type
)) type
= QATOM
;
1775 else if (RANGED_INTEGERP (0, obj
, X_USHRT_MAX
))
1777 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1780 (*data_ret
) [sizeof (short)] = 0;
1781 (*(unsigned short **) data_ret
) [0] = XINT (obj
);
1782 if (NILP (type
)) type
= QINTEGER
;
1784 else if (INTEGERP (obj
)
1785 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1786 && (INTEGERP (XCDR (obj
))
1787 || (CONSP (XCDR (obj
))
1788 && INTEGERP (XCAR (XCDR (obj
)))))))
1790 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1793 (*data_ret
) [sizeof (long)] = 0;
1794 (*(unsigned long **) data_ret
) [0] = cons_to_unsigned (obj
, X_ULONG_MAX
);
1795 if (NILP (type
)) type
= QINTEGER
;
1797 else if (VECTORP (obj
))
1799 /* Lisp_Vectors may represent a set of ATOMs;
1800 a set of 16 or 32 bit INTEGERs;
1801 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1804 ptrdiff_t size
= ASIZE (obj
);
1806 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1807 /* This vector is an ATOM set */
1809 if (min (PTRDIFF_MAX
, SIZE_MAX
) / sizeof (Atom
) < size
)
1810 memory_full (SIZE_MAX
);
1811 if (NILP (type
)) type
= QATOM
;
1812 for (i
= 0; i
< size
; i
++)
1813 if (!SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1814 signal_error ("All elements of selection vector must have same type", obj
);
1816 *data_ret
= (unsigned char *) xmalloc (size
* sizeof (Atom
));
1819 for (i
= 0; i
< size
; i
++)
1820 (*(Atom
**) data_ret
) [i
]
1821 = symbol_to_x_atom (dpyinfo
, XVECTOR (obj
)->contents
[i
]);
1824 /* This vector is an INTEGER set, or something like it */
1828 if (NILP (type
)) type
= QINTEGER
;
1829 for (i
= 0; i
< size
; i
++)
1831 < cons_to_unsigned (XVECTOR (obj
)->contents
[i
], X_ULONG_MAX
))
1833 /* Use sizeof (long) even if it is more than 32 bits.
1834 See comment in x_get_window_property and
1835 x_fill_property_data. */
1836 data_size
= sizeof (long);
1839 if (min (PTRDIFF_MAX
, SIZE_MAX
) / data_size
< size
)
1840 memory_full (SIZE_MAX
);
1841 *data_ret
= (unsigned char *) xmalloc (size
* data_size
);
1842 *format_ret
= format
;
1844 for (i
= 0; i
< size
; i
++)
1846 (*((unsigned long **) data_ret
)) [i
] =
1847 cons_to_unsigned (XVECTOR (obj
)->contents
[i
], X_ULONG_MAX
);
1849 (*((unsigned short **) data_ret
)) [i
] =
1850 cons_to_unsigned (XVECTOR (obj
)->contents
[i
], X_USHRT_MAX
);
1854 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1856 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1860 clean_local_selection_data (Lisp_Object obj
)
1863 && INTEGERP (XCAR (obj
))
1864 && CONSP (XCDR (obj
))
1865 && INTEGERP (XCAR (XCDR (obj
)))
1866 && NILP (XCDR (XCDR (obj
))))
1867 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1870 && INTEGERP (XCAR (obj
))
1871 && INTEGERP (XCDR (obj
)))
1873 if (XINT (XCAR (obj
)) == 0)
1875 if (XINT (XCAR (obj
)) == -1)
1876 return make_number (- XINT (XCDR (obj
)));
1881 ptrdiff_t size
= ASIZE (obj
);
1884 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1885 copy
= Fmake_vector (make_number (size
), Qnil
);
1886 for (i
= 0; i
< size
; i
++)
1887 XVECTOR (copy
)->contents
[i
]
1888 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1894 /* Called from XTread_socket to handle SelectionNotify events.
1895 If it's the selection we are waiting for, stop waiting
1896 by setting the car of reading_selection_reply to non-nil.
1897 We store t there if the reply is successful, lambda if not. */
1900 x_handle_selection_notify (XSelectionEvent
*event
)
1902 if (event
->requestor
!= reading_selection_window
)
1904 if (event
->selection
!= reading_which_selection
)
1907 TRACE0 ("Received SelectionNotify");
1908 XSETCAR (reading_selection_reply
,
1909 (event
->property
!= 0 ? Qt
: Qlambda
));
1913 /* From a Lisp_Object, return a suitable frame for selection
1914 operations. OBJECT may be a frame, a terminal object, or nil
1915 (which stands for the selected frame--or, if that is not an X
1916 frame, the first X display on the list). If no suitable frame can
1917 be found, return NULL. */
1919 static struct frame
*
1920 frame_for_x_selection (Lisp_Object object
)
1927 f
= XFRAME (selected_frame
);
1928 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1931 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1933 f
= XFRAME (XCAR (tail
));
1934 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1938 else if (TERMINALP (object
))
1940 struct terminal
*t
= get_terminal (object
, 1);
1941 if (t
->type
== output_x_window
)
1943 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1945 f
= XFRAME (XCAR (tail
));
1946 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1951 else if (FRAMEP (object
))
1953 f
= XFRAME (object
);
1954 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1962 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1963 Sx_own_selection_internal
, 2, 3, 0,
1964 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1965 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1966 \(Those are literal upper-case symbol names, since that's what X expects.)
1967 VALUE is typically a string, or a cons of two markers, but may be
1968 anything that the functions on `selection-converter-alist' know about.
1970 FRAME should be a frame that should own the selection. If omitted or
1971 nil, it defaults to the selected frame. */)
1972 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1974 if (NILP (frame
)) frame
= selected_frame
;
1975 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1976 error ("X selection unavailable for this frame");
1978 CHECK_SYMBOL (selection
);
1979 if (NILP (value
)) error ("VALUE may not be nil");
1980 x_own_selection (selection
, value
, frame
);
1985 /* Request the selection value from the owner. If we are the owner,
1986 simply return our selection value. If we are not the owner, this
1987 will block until all of the data has arrived. */
1989 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1990 Sx_get_selection_internal
, 2, 4, 0,
1991 doc
: /* Return text selected from some X window.
1992 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1993 \(Those are literal upper-case symbol names, since that's what X expects.)
1994 TYPE is the type of data desired, typically `STRING'.
1995 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1996 selections. If omitted, defaults to the time for the last event.
1998 TERMINAL should be a terminal object or a frame specifying the X
1999 server to query. If omitted or nil, that stands for the selected
2000 frame's display, or the first available X display. */)
2001 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
2002 Lisp_Object time_stamp
, Lisp_Object terminal
)
2004 Lisp_Object val
= Qnil
;
2005 struct gcpro gcpro1
, gcpro2
;
2006 struct frame
*f
= frame_for_x_selection (terminal
);
2007 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2009 CHECK_SYMBOL (selection_symbol
);
2010 CHECK_SYMBOL (target_type
);
2011 if (EQ (target_type
, QMULTIPLE
))
2012 error ("Retrieving MULTIPLE selections is currently unimplemented");
2014 error ("X selection unavailable for this frame");
2016 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
2017 FRAME_X_DISPLAY_INFO (f
));
2019 if (NILP (val
) && FRAME_LIVE_P (f
))
2022 XSETFRAME (frame
, f
);
2023 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
2024 time_stamp
, frame
));
2027 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2030 if (CONSP (val
) && NILP (XCDR (val
)))
2033 RETURN_UNGCPRO (clean_local_selection_data (val
));
2036 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2037 Sx_disown_selection_internal
, 1, 3, 0,
2038 doc
: /* If we own the selection SELECTION, disown it.
2039 Disowning it means there is no such selection.
2041 TERMINAL should be a terminal object or a frame specifying the X
2042 server to query. If omitted or nil, that stands for the selected
2043 frame's display, or the first available X display. */)
2044 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2047 Atom selection_atom
;
2049 struct selection_input_event sie
;
2050 struct input_event ie
;
2052 struct frame
*f
= frame_for_x_selection (terminal
);
2053 struct x_display_info
*dpyinfo
;
2058 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2059 CHECK_SYMBOL (selection
);
2061 /* Don't disown the selection when we're not the owner. */
2062 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2065 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2068 if (NILP (time_object
))
2069 timestamp
= last_event_timestamp
;
2071 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2072 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2075 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2076 generated for a window which owns the selection when that window sets
2077 the selection owner to None. The NCD server does, the MIT Sun4 server
2078 doesn't. So we synthesize one; this means we might get two, but
2079 that's ok, because the second one won't have any effect. */
2080 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2081 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2082 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2083 x_handle_selection_clear (&event
.ie
);
2088 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2090 doc
: /* Whether the current Emacs process owns the given X Selection.
2091 The arg should be the name of the selection in question, typically one of
2092 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2093 \(Those are literal upper-case symbol names, since that's what X expects.)
2094 For convenience, the symbol nil is the same as `PRIMARY',
2095 and t is the same as `SECONDARY'.
2097 TERMINAL should be a terminal object or a frame specifying the X
2098 server to query. If omitted or nil, that stands for the selected
2099 frame's display, or the first available X display. */)
2100 (Lisp_Object selection
, Lisp_Object terminal
)
2102 struct frame
*f
= frame_for_x_selection (terminal
);
2104 CHECK_SYMBOL (selection
);
2105 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2106 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2108 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2114 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2116 doc
: /* Whether there is an owner for the given X selection.
2117 SELECTION should be the name of the selection in question, typically
2118 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
2119 these literal upper-case names.) The symbol nil is the same as
2120 `PRIMARY', and t is the same as `SECONDARY'.
2122 TERMINAL should be a terminal object or a frame specifying the X
2123 server to query. If omitted or nil, that stands for the selected
2124 frame's display, or the first available X display. */)
2125 (Lisp_Object selection
, Lisp_Object terminal
)
2129 struct frame
*f
= frame_for_x_selection (terminal
);
2130 struct x_display_info
*dpyinfo
;
2132 CHECK_SYMBOL (selection
);
2133 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2134 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2139 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2141 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2144 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2145 if (atom
== 0) return Qnil
;
2147 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2149 return (owner
? Qt
: Qnil
);
2153 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2154 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2157 x_clipboard_manager_save (Lisp_Object frame
)
2159 struct frame
*f
= XFRAME (frame
);
2160 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2161 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2163 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2164 dpyinfo
->Xatom_EMACS_TMP
,
2165 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2166 (unsigned char *) &data
, 1);
2167 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2172 /* Error handler for x_clipboard_manager_save_frame. */
2175 x_clipboard_manager_error_1 (Lisp_Object err
)
2177 Lisp_Object args
[2];
2178 args
[0] = build_string ("X clipboard manager error: %s\n\
2179 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2180 args
[1] = CAR (CDR (err
));
2185 /* Error handler for x_clipboard_manager_save_all. */
2188 x_clipboard_manager_error_2 (Lisp_Object err
)
2190 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2191 If the problem persists, set `x-select-enable-clipboard-manager' \
2196 /* Called from delete_frame: save any clipboard owned by FRAME to the
2197 clipboard manager. Do nothing if FRAME does not own the clipboard,
2198 or if no clipboard manager is present. */
2201 x_clipboard_manager_save_frame (Lisp_Object frame
)
2205 if (!NILP (Vx_select_enable_clipboard_manager
)
2207 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2208 && FRAME_LIVE_P (f
))
2210 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2211 Lisp_Object local_selection
2212 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2214 if (!NILP (local_selection
)
2215 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2216 && XGetSelectionOwner (dpyinfo
->display
,
2217 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2218 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2219 x_clipboard_manager_error_1
);
2223 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2224 clipboard manager. Do nothing if FRAME does not own the clipboard,
2225 or if no clipboard manager is present. */
2228 x_clipboard_manager_save_all (void)
2230 /* Loop through all X displays, saving owned clipboards. */
2231 struct x_display_info
*dpyinfo
;
2232 Lisp_Object local_selection
, local_frame
;
2234 if (NILP (Vx_select_enable_clipboard_manager
))
2237 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2239 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2240 if (NILP (local_selection
)
2241 || !XGetSelectionOwner (dpyinfo
->display
,
2242 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2245 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2246 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2247 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2248 Qt
, x_clipboard_manager_error_2
);
2253 /***********************************************************************
2254 Drag and drop support
2255 ***********************************************************************/
2256 /* Check that lisp values are of correct type for x_fill_property_data.
2257 That is, number, string or a cons with two numbers (low and high 16
2258 bit parts of a 32 bit number). Return the number of items in DATA,
2259 or -1 if there is an error. */
2262 x_check_property_data (Lisp_Object data
)
2267 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2269 Lisp_Object o
= XCAR (iter
);
2271 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2273 else if (CONSP (o
) &&
2274 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2276 if (size
== INT_MAX
)
2284 /* Convert lisp values to a C array. Values may be a number, a string
2285 which is taken as an X atom name and converted to the atom value, or
2286 a cons containing the two 16 bit parts of a 32 bit number.
2288 DPY is the display use to look up X atoms.
2289 DATA is a Lisp list of values to be converted.
2290 RET is the C array that contains the converted values. It is assumed
2291 it is big enough to hold all values.
2292 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2293 be stored in RET. Note that long is used for 32 even if long is more
2294 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2295 XClientMessageEvent). */
2298 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2301 long *d32
= (long *) ret
;
2302 short *d16
= (short *) ret
;
2303 char *d08
= (char *) ret
;
2306 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2308 Lisp_Object o
= XCAR (iter
);
2310 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2311 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2312 else if (STRINGP (o
))
2315 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2319 error ("Wrong type, must be string, number or cons");
2323 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2326 error ("Out of 'char' range");
2328 else if (format
== 16)
2330 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2333 error ("Out of 'short' range");
2340 /* Convert an array of C values to a Lisp list.
2341 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2342 DATA is a C array of values to be converted.
2343 TYPE is the type of the data. Only XA_ATOM is special, it converts
2344 each number in DATA to its corresponfing X atom as a symbol.
2345 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2347 SIZE is the number of elements in DATA.
2349 Important: When format is 32, data should contain an array of int,
2350 not an array of long as the X library returns. This makes a difference
2351 when sizeof(long) != sizeof(int).
2353 Also see comment for selection_data_to_lisp_data above. */
2356 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2357 Atom type
, int format
, long unsigned int size
)
2359 ptrdiff_t format_bytes
= format
>> 3;
2360 if (PTRDIFF_MAX
/ format_bytes
< size
)
2361 memory_full (SIZE_MAX
);
2362 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2363 data
, size
* format_bytes
, type
, format
);
2366 /* Get the mouse position in frame relative coordinates. */
2369 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2371 Window root
, dummy_window
;
2376 XQueryPointer (FRAME_X_DISPLAY (f
),
2377 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2379 /* The root window which contains the pointer. */
2382 /* Window pointer is on, not used */
2385 /* The position on that root window. */
2388 /* x/y in dummy_window coordinates, not used. */
2391 /* Modifier keys and pointer buttons, about which
2393 (unsigned int *) &dummy
);
2396 /* Absolute to relative. */
2397 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2398 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2403 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2404 Sx_get_atom_name
, 1, 2, 0,
2405 doc
: /* Return the X atom name for VALUE as a string.
2406 VALUE may be a number or a cons where the car is the upper 16 bits and
2407 the cdr is the lower 16 bits of a 32 bit value.
2408 Use the display for FRAME or the current frame if FRAME is not given or nil.
2410 If the value is 0 or the atom is not known, return the empty string. */)
2411 (Lisp_Object value
, Lisp_Object frame
)
2413 struct frame
*f
= check_x_frame (frame
);
2416 Lisp_Object ret
= Qnil
;
2417 Display
*dpy
= FRAME_X_DISPLAY (f
);
2421 CONS_TO_INTEGER (value
, Atom
, atom
);
2424 x_catch_errors (dpy
);
2425 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2426 had_errors
= x_had_errors_p (dpy
);
2427 x_uncatch_errors ();
2430 ret
= build_string (name
);
2432 if (atom
&& name
) XFree (name
);
2433 if (NILP (ret
)) ret
= empty_unibyte_string
;
2440 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2441 Sx_register_dnd_atom
, 1, 2, 0,
2442 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2443 ATOM can be a symbol or a string. The ATOM is interned on the display that
2444 FRAME is on. If FRAME is nil, the selected frame is used. */)
2445 (Lisp_Object atom
, Lisp_Object frame
)
2448 struct frame
*f
= check_x_frame (frame
);
2450 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2454 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2455 else if (STRINGP (atom
))
2458 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2462 error ("ATOM must be a symbol or a string");
2464 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2465 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2468 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2470 if (min (PTRDIFF_MAX
, SIZE_MAX
) / sizeof *dpyinfo
->x_dnd_atoms
/ 2
2471 < dpyinfo
->x_dnd_atoms_size
)
2472 memory_full (SIZE_MAX
);
2473 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2474 (2 * sizeof *dpyinfo
->x_dnd_atoms
2475 * dpyinfo
->x_dnd_atoms_size
));
2476 dpyinfo
->x_dnd_atoms_size
*= 2;
2479 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2483 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2486 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2490 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2491 unsigned long size
= 160/event
->format
;
2493 unsigned char *data
= (unsigned char *) event
->data
.b
;
2494 unsigned int idata
[5];
2497 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2498 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2500 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2502 XSETFRAME (frame
, f
);
2504 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2505 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2506 function expects them to be of size int (i.e. 32). So to be able to
2507 use that function, put the data in the form it expects if format is 32. */
2509 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2511 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2512 idata
[i
] = event
->data
.l
[i
];
2513 data
= (unsigned char *) idata
;
2516 vec
= Fmake_vector (make_number (4), Qnil
);
2517 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2518 event
->message_type
)));
2519 ASET (vec
, 1, frame
);
2520 ASET (vec
, 2, make_number (event
->format
));
2521 ASET (vec
, 3, x_property_data_to_lisp (f
,
2523 event
->message_type
,
2527 mouse_position_for_drop (f
, &x
, &y
);
2528 bufp
->kind
= DRAG_N_DROP_EVENT
;
2529 bufp
->frame_or_window
= frame
;
2530 bufp
->timestamp
= CurrentTime
;
2531 bufp
->x
= make_number (x
);
2532 bufp
->y
= make_number (y
);
2534 bufp
->modifiers
= 0;
2539 DEFUN ("x-send-client-message", Fx_send_client_event
,
2540 Sx_send_client_message
, 6, 6, 0,
2541 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2543 For DISPLAY, specify either a frame or a display name (a string).
2544 If DISPLAY is nil, that stands for the selected frame's display.
2545 DEST may be a number, in which case it is a Window id. The value 0 may
2546 be used to send to the root window of the DISPLAY.
2547 If DEST is a cons, it is converted to a 32 bit number
2548 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2549 number is then used as a window id.
2550 If DEST is a frame the event is sent to the outer window of that frame.
2551 A value of nil means the currently selected frame.
2552 If DEST is the string "PointerWindow" the event is sent to the window that
2553 contains the pointer. If DEST is the string "InputFocus" the event is
2554 sent to the window that has the input focus.
2555 FROM is the frame sending the event. Use nil for currently selected frame.
2556 MESSAGE-TYPE is the name of an Atom as a string.
2557 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2558 bits. VALUES is a list of numbers, cons and/or strings containing the values
2559 to send. If a value is a string, it is converted to an Atom and the value of
2560 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2561 with the high 16 bits from the car and the lower 16 bit from the cdr.
2562 If more values than fits into the event is given, the excessive values
2564 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2566 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2568 CHECK_STRING (message_type
);
2569 x_send_client_event(display
, dest
, from
,
2570 XInternAtom (dpyinfo
->display
,
2571 SSDATA (message_type
),
2579 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2581 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2584 struct frame
*f
= check_x_frame (from
);
2587 CHECK_NUMBER (format
);
2588 CHECK_CONS (values
);
2590 if (x_check_property_data (values
) == -1)
2591 error ("Bad data in VALUES, must be number, cons or string");
2593 event
.xclient
.type
= ClientMessage
;
2594 event
.xclient
.format
= XFASTINT (format
);
2596 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2597 && event
.xclient
.format
!= 32)
2598 error ("FORMAT must be one of 8, 16 or 32");
2600 if (FRAMEP (dest
) || NILP (dest
))
2602 struct frame
*fdest
= check_x_frame (dest
);
2603 wdest
= FRAME_OUTER_WINDOW (fdest
);
2605 else if (STRINGP (dest
))
2607 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2608 wdest
= PointerWindow
;
2609 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2612 error ("DEST as a string must be one of PointerWindow or InputFocus");
2614 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2615 CONS_TO_INTEGER (dest
, Window
, wdest
);
2617 error ("DEST must be a frame, nil, string, number or cons");
2619 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2620 to_root
= wdest
== dpyinfo
->root_window
;
2624 event
.xclient
.message_type
= message_type
;
2625 event
.xclient
.display
= dpyinfo
->display
;
2627 /* Some clients (metacity for example) expects sending window to be here
2628 when sending to the root window. */
2629 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2632 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2633 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2634 event
.xclient
.format
);
2636 /* If event mask is 0 the event is sent to the client that created
2637 the destination window. But if we are sending to the root window,
2638 there is no such client. Then we set the event mask to 0xffff. The
2639 event then goes to clients selecting for events on the root window. */
2640 x_catch_errors (dpyinfo
->display
);
2642 int propagate
= to_root
? False
: True
;
2643 unsigned mask
= to_root
? 0xffff : 0;
2644 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2645 XFlush (dpyinfo
->display
);
2647 x_uncatch_errors ();
2653 syms_of_xselect (void)
2655 defsubr (&Sx_get_selection_internal
);
2656 defsubr (&Sx_own_selection_internal
);
2657 defsubr (&Sx_disown_selection_internal
);
2658 defsubr (&Sx_selection_owner_p
);
2659 defsubr (&Sx_selection_exists_p
);
2661 defsubr (&Sx_get_atom_name
);
2662 defsubr (&Sx_send_client_message
);
2663 defsubr (&Sx_register_dnd_atom
);
2665 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2666 staticpro (&reading_selection_reply
);
2667 reading_selection_window
= 0;
2668 reading_which_selection
= 0;
2670 property_change_wait_list
= 0;
2671 prop_location_identifier
= 0;
2672 property_change_reply
= Fcons (Qnil
, Qnil
);
2673 staticpro (&property_change_reply
);
2675 converted_selections
= NULL
;
2676 conversion_fail_tag
= None
;
2678 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2679 doc
: /* An alist associating X Windows selection-types with functions.
2680 These functions are called to convert the selection, with three args:
2681 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2682 a desired type to which the selection should be converted;
2683 and the local selection value (whatever was given to `x-own-selection').
2685 The function should return the value to send to the X server
2686 \(typically a string). A return value of nil
2687 means that the conversion could not be done.
2688 A return value which is the symbol `NULL'
2689 means that a side-effect was executed,
2690 and there is no meaningful selection value. */);
2691 Vselection_converter_alist
= Qnil
;
2693 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2694 doc
: /* A list of functions to be called when Emacs loses an X selection.
2695 \(This happens when some other X client makes its own selection
2696 or when a Lisp program explicitly clears the selection.)
2697 The functions are called with one argument, the selection type
2698 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2699 Vx_lost_selection_functions
= Qnil
;
2701 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2702 doc
: /* A list of functions to be called when Emacs answers a selection request.
2703 The functions are called with three arguments:
2704 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2705 - the selection-type which Emacs was asked to convert the
2706 selection into before sending (for example, `STRING' or `LENGTH');
2707 - a flag indicating success or failure for responding to the request.
2708 We might have failed (and declined the request) for any number of reasons,
2709 including being asked for a selection that we no longer own, or being asked
2710 to convert into a type that we don't know about or that is inappropriate.
2711 This hook doesn't let you change the behavior of Emacs's selection replies,
2712 it merely informs you that they have happened. */);
2713 Vx_sent_selection_functions
= Qnil
;
2715 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2716 Vx_select_enable_clipboard_manager
,
2717 doc
: /* Whether to enable X clipboard manager support.
2718 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2719 while owning the X clipboard, the clipboard contents are saved to the
2720 clipboard manager if one is present. */);
2721 Vx_select_enable_clipboard_manager
= Qt
;
2723 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2724 doc
: /* Number of milliseconds to wait for a selection reply.
2725 If the selection owner doesn't reply in this time, we give up.
2726 A value of 0 means wait as long as necessary. This is initialized from the
2727 \"*selectionTimeout\" resource. */);
2728 x_selection_timeout
= 0;
2730 /* QPRIMARY is defined in keyboard.c. */
2731 DEFSYM (QSECONDARY
, "SECONDARY");
2732 DEFSYM (QSTRING
, "STRING");
2733 DEFSYM (QINTEGER
, "INTEGER");
2734 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2735 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2736 DEFSYM (QTEXT
, "TEXT");
2737 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2738 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2739 DEFSYM (QDELETE
, "DELETE");
2740 DEFSYM (QMULTIPLE
, "MULTIPLE");
2741 DEFSYM (QINCR
, "INCR");
2742 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2743 DEFSYM (QTARGETS
, "TARGETS");
2744 DEFSYM (QATOM
, "ATOM");
2745 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2746 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2747 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2748 DEFSYM (QNULL
, "NULL");
2749 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2750 DEFSYM (Qforeign_selection
, "foreign-selection");
2751 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2752 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");