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 */
23 #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"
39 #include "termhooks.h"
41 #include "character.h"
43 #include <X11/Xproto.h>
46 struct selection_data
;
48 static Lisp_Object
x_atom_to_symbol (Display
*dpy
, Atom atom
);
49 static Atom
symbol_to_x_atom (struct x_display_info
*, Lisp_Object
);
50 static void x_own_selection (Lisp_Object
, Lisp_Object
, Lisp_Object
);
51 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int,
52 struct x_display_info
*);
53 static void x_decline_selection_request (struct input_event
*);
54 static Lisp_Object
x_selection_request_lisp_error (Lisp_Object
);
55 static Lisp_Object
queue_selection_requests_unwind (Lisp_Object
);
56 static Lisp_Object
x_catch_errors_unwind (Lisp_Object
);
57 static void x_reply_selection_request (struct input_event
*, struct x_display_info
*);
58 static int x_convert_selection (struct input_event
*, Lisp_Object
, Lisp_Object
,
59 Atom
, int, struct x_display_info
*);
60 static int waiting_for_other_props_on_window (Display
*, Window
);
61 static struct prop_location
*expect_property_change (Display
*, Window
,
63 static void unexpect_property_change (struct prop_location
*);
64 static Lisp_Object
wait_for_property_change_unwind (Lisp_Object
);
65 static void wait_for_property_change (struct prop_location
*);
66 static Lisp_Object
x_get_foreign_selection (Lisp_Object
, Lisp_Object
,
67 Lisp_Object
, Lisp_Object
);
68 static void x_get_window_property (Display
*, Window
, Atom
,
69 unsigned char **, int *,
70 Atom
*, int *, unsigned long *, int);
71 static void receive_incremental_selection (Display
*, Window
, Atom
,
72 Lisp_Object
, unsigned,
73 unsigned char **, int *,
74 Atom
*, int *, unsigned long *);
75 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
78 static Lisp_Object
selection_data_to_lisp_data (Display
*,
79 const unsigned char *,
81 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
82 unsigned char **, Atom
*,
83 unsigned *, int *, int *);
84 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
86 /* Printing traces to stderr. */
88 #ifdef TRACE_SELECTION
90 fprintf (stderr, "%d: " fmt "\n", getpid ())
91 #define TRACE1(fmt, a0) \
92 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
93 #define TRACE2(fmt, a0, a1) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
95 #define TRACE3(fmt, a0, a1, a2) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
98 #define TRACE0(fmt) (void) 0
99 #define TRACE1(fmt, a0) (void) 0
100 #define TRACE2(fmt, a0, a1) (void) 0
104 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
105 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
106 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
108 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
109 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
111 static Lisp_Object Qcompound_text_with_extensions
;
113 static Lisp_Object Qforeign_selection
;
115 /* If this is a smaller number than the max-request-size of the display,
116 emacs will use INCR selection transfer when the selection is larger
117 than this. The max-request-size is usually around 64k, so if you want
118 emacs to use incremental selection transfers when the selection is
119 smaller than that, set this. I added this mostly for debugging the
120 incremental transfer stuff, but it might improve server performance. */
121 #define MAX_SELECTION_QUANTUM 0xFFFFFF
123 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
125 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
126 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
129 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
132 struct selection_event_queue
134 struct input_event event
;
135 struct selection_event_queue
*next
;
138 static struct selection_event_queue
*selection_queue
;
140 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
142 static int x_queue_selection_requests
;
144 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
147 x_queue_event (struct input_event
*event
)
149 struct selection_event_queue
*queue_tmp
;
151 /* Don't queue repeated requests.
152 This only happens for large requests which uses the incremental protocol. */
153 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
155 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
157 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
158 x_decline_selection_request (event
);
164 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
166 if (queue_tmp
!= NULL
)
168 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
169 queue_tmp
->event
= *event
;
170 queue_tmp
->next
= selection_queue
;
171 selection_queue
= queue_tmp
;
175 /* Start queuing SELECTION_REQUEST_EVENT events. */
178 x_start_queuing_selection_requests (void)
180 if (x_queue_selection_requests
)
183 x_queue_selection_requests
++;
184 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
187 /* Stop queuing SELECTION_REQUEST_EVENT events. */
190 x_stop_queuing_selection_requests (void)
192 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
193 --x_queue_selection_requests
;
195 /* Take all the queued events and put them back
196 so that they get processed afresh. */
198 while (selection_queue
!= NULL
)
200 struct selection_event_queue
*queue_tmp
= selection_queue
;
201 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
202 kbd_buffer_unget_event (&queue_tmp
->event
);
203 selection_queue
= queue_tmp
->next
;
204 xfree ((char *)queue_tmp
);
209 /* This converts a Lisp symbol to a server Atom, avoiding a server
210 roundtrip whenever possible. */
213 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
216 if (NILP (sym
)) return 0;
217 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
218 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
219 if (EQ (sym
, QSTRING
)) return XA_STRING
;
220 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
221 if (EQ (sym
, QATOM
)) return XA_ATOM
;
222 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
223 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
224 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
225 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
226 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
227 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
228 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
229 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
230 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
231 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
232 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
233 if (!SYMBOLP (sym
)) abort ();
235 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
237 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
243 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
244 and calls to intern whenever possible. */
247 x_atom_to_symbol (Display
*dpy
, Atom atom
)
249 struct x_display_info
*dpyinfo
;
270 dpyinfo
= x_display_info_for_display (dpy
);
273 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
275 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
277 if (atom
== dpyinfo
->Xatom_TEXT
)
279 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
280 return QCOMPOUND_TEXT
;
281 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
283 if (atom
== dpyinfo
->Xatom_DELETE
)
285 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
287 if (atom
== dpyinfo
->Xatom_INCR
)
289 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
291 if (atom
== dpyinfo
->Xatom_TARGETS
)
293 if (atom
== dpyinfo
->Xatom_NULL
)
297 str
= XGetAtomName (dpy
, atom
);
299 TRACE1 ("XGetAtomName --> %s", str
);
300 if (! str
) return Qnil
;
303 /* This was allocated by Xlib, so use XFree. */
309 /* Do protocol to assert ourself as a selection owner.
310 FRAME shall be the owner; it must be a valid X frame.
311 Update the Vselection_alist so that we can reply to later requests for
315 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
318 struct frame
*f
= XFRAME (frame
);
319 Window selecting_window
= FRAME_X_WINDOW (f
);
320 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
321 Display
*display
= dpyinfo
->display
;
322 Time timestamp
= last_event_timestamp
;
323 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
326 x_catch_errors (display
);
327 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
328 x_check_errors (display
, "Can't set selection: %s");
332 /* Now update the local cache */
334 Lisp_Object selection_data
;
335 Lisp_Object prev_value
;
337 selection_data
= list4 (selection_name
, selection_value
,
338 long_to_cons (timestamp
), frame
);
339 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
341 dpyinfo
->terminal
->Vselection_alist
342 = Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
);
344 /* If we already owned the selection, remove the old selection
345 data. Don't use Fdelq as that may QUIT. */
346 if (!NILP (prev_value
))
348 /* We know it's not the CAR, so it's easy. */
349 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
350 for (; CONSP (rest
); rest
= XCDR (rest
))
351 if (EQ (prev_value
, Fcar (XCDR (rest
))))
353 XSETCDR (rest
, XCDR (XCDR (rest
)));
360 /* Given a selection-name and desired type, look up our local copy of
361 the selection value and convert it to the type.
362 The value is nil or a string.
363 This function is used both for remote requests (LOCAL_REQUEST is zero)
364 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
366 This calls random Lisp code, and may signal or gc. */
369 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
370 int local_request
, struct x_display_info
*dpyinfo
)
372 Lisp_Object local_value
;
373 Lisp_Object handler_fn
, value
, check
;
376 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
378 if (NILP (local_value
)) return Qnil
;
380 /* TIMESTAMP is a special case. */
381 if (EQ (target_type
, QTIMESTAMP
))
384 value
= XCAR (XCDR (XCDR (local_value
)));
388 /* Don't allow a quit within the converter.
389 When the user types C-g, he would be surprised
390 if by luck it came during a converter. */
391 count
= SPECPDL_INDEX ();
392 specbind (Qinhibit_quit
, Qt
);
394 CHECK_SYMBOL (target_type
);
395 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
396 /* gcpro is not needed here since nothing but HANDLER_FN
397 is live, and that ought to be a symbol. */
399 if (!NILP (handler_fn
))
400 value
= call3 (handler_fn
,
401 selection_symbol
, (local_request
? Qnil
: target_type
),
402 XCAR (XCDR (local_value
)));
405 unbind_to (count
, Qnil
);
408 /* Make sure this value is of a type that we could transmit
409 to another X client. */
413 && SYMBOLP (XCAR (value
)))
414 check
= XCDR (value
);
422 /* Check for a value that cons_to_long could handle. */
423 else if (CONSP (check
)
424 && INTEGERP (XCAR (check
))
425 && (INTEGERP (XCDR (check
))
427 (CONSP (XCDR (check
))
428 && INTEGERP (XCAR (XCDR (check
)))
429 && NILP (XCDR (XCDR (check
))))))
432 signal_error ("Invalid data returned by selection-conversion function",
433 list2 (handler_fn
, value
));
436 /* Subroutines of x_reply_selection_request. */
438 /* Send a SelectionNotify event to the requestor with property=None,
439 meaning we were unable to do what they wanted. */
442 x_decline_selection_request (struct input_event
*event
)
445 XSelectionEvent
*reply
= &(reply_base
.xselection
);
447 reply
->type
= SelectionNotify
;
448 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
449 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
450 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
451 reply
->time
= SELECTION_EVENT_TIME (event
);
452 reply
->target
= SELECTION_EVENT_TARGET (event
);
453 reply
->property
= None
;
455 /* The reason for the error may be that the receiver has
456 died in the meantime. Handle that case. */
458 x_catch_errors (reply
->display
);
459 XSendEvent (reply
->display
, reply
->requestor
, False
, 0L, &reply_base
);
460 XFlush (reply
->display
);
465 /* This is the selection request currently being processed.
466 It is set to zero when the request is fully processed. */
467 static struct input_event
*x_selection_current_request
;
469 /* Display info in x_selection_request. */
471 static struct x_display_info
*selection_request_dpyinfo
;
473 /* Raw selection data, for sending to a requestor window. */
475 struct selection_data
483 /* This can be set to non-NULL during x_reply_selection_request, if
484 the selection is waiting for an INCR transfer to complete. Don't
485 free these; that's done by unexpect_property_change. */
486 struct prop_location
*wait_object
;
487 struct selection_data
*next
;
490 /* Linked list of the above (in support of MULTIPLE targets). */
492 static struct selection_data
*converted_selections
;
494 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
495 static Atom conversion_fail_tag
;
497 /* Used as an unwind-protect clause so that, if a selection-converter signals
498 an error, we tell the requester that we were unable to do what they wanted
499 before we throw to top-level or go into the debugger or whatever. */
502 x_selection_request_lisp_error (Lisp_Object ignore
)
504 struct selection_data
*cs
, *next
;
506 for (cs
= converted_selections
; cs
; cs
= next
)
509 if (cs
->nofree
== 0 && cs
->data
)
513 converted_selections
= NULL
;
515 if (x_selection_current_request
!= 0
516 && selection_request_dpyinfo
->display
)
517 x_decline_selection_request (x_selection_current_request
);
522 x_catch_errors_unwind (Lisp_Object dummy
)
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 struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
549 static void wait_for_property_change (struct prop_location
*location
);
550 static void unexpect_property_change (struct prop_location
*location
);
551 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
553 static int prop_location_identifier
;
555 static Lisp_Object property_change_reply
;
557 static struct prop_location
*property_change_reply_object
;
559 static struct prop_location
*property_change_wait_list
;
562 queue_selection_requests_unwind (Lisp_Object tem
)
564 x_stop_queuing_selection_requests ();
569 /* Send the reply to a selection request event EVENT. */
571 #ifdef TRACE_SELECTION
572 static int x_reply_selection_request_cnt
;
573 #endif /* TRACE_SELECTION */
576 x_reply_selection_request (struct input_event
*event
, struct x_display_info
*dpyinfo
)
579 XSelectionEvent
*reply
= &(reply_base
.xselection
);
580 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
581 Window window
= SELECTION_EVENT_REQUESTOR (event
);
583 int max_bytes
= SELECTION_QUANTUM (display
);
584 int count
= SPECPDL_INDEX ();
585 struct selection_data
*cs
;
587 if (max_bytes
> MAX_SELECTION_QUANTUM
)
588 max_bytes
= MAX_SELECTION_QUANTUM
;
590 reply
->type
= SelectionNotify
;
591 reply
->display
= display
;
592 reply
->requestor
= window
;
593 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
594 reply
->time
= SELECTION_EVENT_TIME (event
);
595 reply
->target
= SELECTION_EVENT_TARGET (event
);
596 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
597 if (reply
->property
== None
)
598 reply
->property
= reply
->target
;
601 /* The protected block contains wait_for_property_change, which can
602 run random lisp code (process handlers) or signal. Therefore, we
603 put the x_uncatch_errors call in an unwind. */
604 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
605 x_catch_errors (display
);
607 /* Loop over converted selections, storing them in the requested
608 properties. If data is large, only store the first N bytes
609 (section 2.7.2 of ICCCM). Note that we store the data for a
610 MULTIPLE request in the opposite order; the ICCM says only that
611 the conversion itself must be done in the same order. */
612 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
614 if (cs
->property
== None
)
617 bytes_remaining
= cs
->size
* (cs
->format
/ 8);
618 if (bytes_remaining
<= max_bytes
)
620 /* Send all the data at once, with minimal handshaking. */
621 TRACE1 ("Sending all %d bytes", bytes_remaining
);
622 XChangeProperty (display
, window
, cs
->property
,
623 cs
->type
, cs
->format
, PropModeReplace
,
628 /* Send an INCR tag to initiate incremental transfer. */
631 TRACE2 ("Start sending %d bytes incrementally (%s)",
632 bytes_remaining
, XGetAtomName (display
, cs
->property
));
634 = expect_property_change (display
, window
, cs
->property
,
637 /* XChangeProperty expects an array of long even if long is
638 more than 32 bits. */
639 value
[0] = bytes_remaining
;
640 XChangeProperty (display
, window
, cs
->property
,
641 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
642 (unsigned char *) value
, 1);
643 XSelectInput (display
, window
, PropertyChangeMask
);
647 /* Now issue the SelectionNotify event. */
648 XSendEvent (display
, window
, False
, 0L, &reply_base
);
651 #ifdef TRACE_SELECTION
653 char *sel
= XGetAtomName (display
, reply
->selection
);
654 char *tgt
= XGetAtomName (display
, reply
->target
);
655 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
656 sel
, tgt
, ++x_reply_selection_request_cnt
);
657 if (sel
) XFree (sel
);
658 if (tgt
) XFree (tgt
);
660 #endif /* TRACE_SELECTION */
662 /* Finish sending the rest of each of the INCR values. This should
663 be improved; there's a chance of deadlock if more than one
664 subtarget in a MULTIPLE selection requires an INCR transfer, and
665 the requestor and Emacs loop waiting on different transfers. */
666 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
669 int format_bytes
= cs
->format
/ 8;
670 int had_errors
= x_had_errors_p (display
);
673 bytes_remaining
= cs
->size
* format_bytes
;
675 /* Wait for the requester to ack by deleting the property.
676 This can run Lisp code (process handlers) or signal. */
679 TRACE1 ("Waiting for ACK (deletion of %s)",
680 XGetAtomName (display
, cs
->property
));
681 wait_for_property_change (cs
->wait_object
);
684 unexpect_property_change (cs
->wait_object
);
686 while (bytes_remaining
)
688 int i
= ((bytes_remaining
< max_bytes
)
690 : max_bytes
) / format_bytes
;
694 = expect_property_change (display
, window
, cs
->property
,
697 TRACE1 ("Sending increment of %d elements", i
);
698 TRACE1 ("Set %s to increment data",
699 XGetAtomName (display
, cs
->property
));
701 /* Append the next chunk of data to the property. */
702 XChangeProperty (display
, window
, cs
->property
,
703 cs
->type
, cs
->format
, PropModeAppend
,
705 bytes_remaining
-= i
* format_bytes
;
706 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
709 had_errors
= x_had_errors_p (display
);
712 if (had_errors
) break;
714 /* Wait for the requester to ack this chunk by deleting
715 the property. This can run Lisp code or signal. */
716 TRACE1 ("Waiting for increment ACK (deletion of %s)",
717 XGetAtomName (display
, cs
->property
));
718 wait_for_property_change (cs
->wait_object
);
721 /* Now write a zero-length chunk to the property to tell the
722 requester that we're done. */
724 if (! waiting_for_other_props_on_window (display
, window
))
725 XSelectInput (display
, window
, 0L);
727 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
728 XGetAtomName (display
, cs
->property
));
729 XChangeProperty (display
, window
, cs
->property
,
730 cs
->type
, cs
->format
, PropModeReplace
,
732 TRACE0 ("Done sending incrementally");
735 /* rms, 2003-01-03: I think I have fixed this bug. */
736 /* The window we're communicating with may have been deleted
737 in the meantime (that's a real situation from a bug report).
738 In this case, there may be events in the event queue still
739 refering to the deleted window, and we'll get a BadWindow error
740 in XTread_socket when processing the events. I don't have
741 an idea how to fix that. gerd, 2001-01-98. */
742 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
743 delivered before uncatch errors. */
744 XSync (display
, False
);
747 /* GTK queues events in addition to the queue in Xlib. So we
748 UNBLOCK to enter the event loop and get possible errors delivered,
749 and then BLOCK again because x_uncatch_errors requires it. */
751 /* This calls x_uncatch_errors. */
752 unbind_to (count
, Qnil
);
756 /* Handle a SelectionRequest event EVENT.
757 This is called from keyboard.c when such an event is found in the queue. */
760 x_handle_selection_request (struct input_event
*event
)
762 struct gcpro gcpro1
, gcpro2
;
763 Time local_selection_time
;
765 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
766 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
767 Atom selection
= SELECTION_EVENT_SELECTION (event
);
768 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
769 Atom target
= SELECTION_EVENT_TARGET (event
);
770 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
771 Atom property
= SELECTION_EVENT_PROPERTY (event
);
772 Lisp_Object local_selection_data
;
774 int count
= SPECPDL_INDEX ();
775 GCPRO2 (local_selection_data
, target_symbol
);
777 if (!dpyinfo
) goto DONE
;
779 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
781 /* Decline if we don't own any selections. */
782 if (NILP (local_selection_data
)) goto DONE
;
784 /* Decline requests issued prior to our acquiring the selection. */
786 = (Time
) cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
787 if (SELECTION_EVENT_TIME (event
) != CurrentTime
788 && local_selection_time
> SELECTION_EVENT_TIME (event
))
791 x_selection_current_request
= event
;
792 selection_request_dpyinfo
= dpyinfo
;
793 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
795 /* We might be able to handle nested x_handle_selection_requests,
796 but this is difficult to test, and seems unimportant. */
797 x_start_queuing_selection_requests ();
798 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
800 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
801 SDATA (SYMBOL_NAME (selection_symbol
)),
802 SDATA (SYMBOL_NAME (target_symbol
)));
804 if (EQ (target_symbol
, QMULTIPLE
))
806 /* For MULTIPLE targets, the event property names a list of atom
807 pairs; the first atom names a target and the second names a
808 non-None property. */
809 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
810 Lisp_Object multprop
;
813 if (property
== None
) goto DONE
;
815 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
816 QMULTIPLE
, selection
);
818 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
821 nselections
= ASIZE (multprop
) / 2;
822 /* Perform conversions. This can signal. */
823 for (j
= 0; j
< nselections
; j
++)
825 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
826 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
827 AREF (multprop
, 2*j
+1));
829 if (subproperty
!= None
)
830 x_convert_selection (event
, selection_symbol
, subtarget
,
831 subproperty
, 1, dpyinfo
);
837 if (property
== None
)
838 property
= SELECTION_EVENT_TARGET (event
);
839 success
= x_convert_selection (event
, selection_symbol
,
840 target_symbol
, property
,
847 x_reply_selection_request (event
, dpyinfo
);
849 x_decline_selection_request (event
);
850 x_selection_current_request
= 0;
852 /* Run the `x-sent-selection-functions' abnormal hook. */
853 if (!NILP (Vx_sent_selection_functions
)
854 && !EQ (Vx_sent_selection_functions
, Qunbound
))
857 args
[0] = Vx_sent_selection_functions
;
858 args
[1] = selection_symbol
;
859 args
[2] = target_symbol
;
860 args
[3] = success
? Qt
: Qnil
;
861 Frun_hook_with_args (4, args
);
864 unbind_to (count
, Qnil
);
868 /* Perform the requested selection conversion, and write the data to
869 the converted_selections linked list, where it can be accessed by
870 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
871 the data even if conversion fails, using conversion_fail_tag.
873 Return 0 if the selection failed to convert, 1 otherwise. */
876 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
877 Lisp_Object target_symbol
, Atom property
,
878 int for_multiple
, struct x_display_info
*dpyinfo
)
881 Lisp_Object lisp_selection
;
882 struct selection_data
*cs
;
883 GCPRO1 (lisp_selection
);
886 = x_get_local_selection (selection_symbol
, target_symbol
,
889 /* A nil return value means we can't perform the conversion. */
890 if (NILP (lisp_selection
)
891 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
895 cs
= xmalloc (sizeof (struct selection_data
));
896 cs
->data
= (unsigned char *) &conversion_fail_tag
;
901 cs
->property
= property
;
902 cs
->wait_object
= NULL
;
903 cs
->next
= converted_selections
;
904 converted_selections
= cs
;
911 /* Otherwise, record the converted selection to binary. */
912 cs
= xmalloc (sizeof (struct selection_data
));
914 cs
->property
= property
;
915 cs
->wait_object
= NULL
;
916 cs
->next
= converted_selections
;
917 converted_selections
= cs
;
918 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
920 &(cs
->data
), &(cs
->type
),
921 &(cs
->size
), &(cs
->format
),
927 /* Handle a SelectionClear event EVENT, which indicates that some
928 client cleared out our previously asserted selection.
929 This is called from keyboard.c when such an event is found in the queue. */
932 x_handle_selection_clear (struct input_event
*event
)
934 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
935 Atom selection
= SELECTION_EVENT_SELECTION (event
);
936 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
938 Lisp_Object selection_symbol
, local_selection_data
;
939 Time local_selection_time
;
940 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
941 Lisp_Object Vselection_alist
;
943 TRACE0 ("x_handle_selection_clear");
945 if (!dpyinfo
) return;
947 selection_symbol
= x_atom_to_symbol (display
, selection
);
948 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
950 /* Well, we already believe that we don't own it, so that's just fine. */
951 if (NILP (local_selection_data
)) return;
953 local_selection_time
= (Time
)
954 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
956 /* We have reasserted the selection since this SelectionClear was
957 generated, so we can disregard it. */
958 if (changed_owner_time
!= CurrentTime
959 && local_selection_time
> changed_owner_time
)
962 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
963 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
964 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
965 Vselection_alist
= XCDR (Vselection_alist
);
969 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
970 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
972 XSETCDR (rest
, XCDR (XCDR (rest
)));
976 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
978 /* Run the `x-lost-selection-functions' abnormal hook. */
981 args
[0] = Vx_lost_selection_functions
;
982 args
[1] = selection_symbol
;
983 Frun_hook_with_args (2, args
);
986 prepare_menu_bars ();
987 redisplay_preserve_echo_area (20);
991 x_handle_selection_event (struct input_event
*event
)
993 TRACE0 ("x_handle_selection_event");
994 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
995 x_handle_selection_clear (event
);
996 else if (x_queue_selection_requests
)
997 x_queue_event (event
);
999 x_handle_selection_request (event
);
1003 /* Clear all selections that were made from frame F.
1004 We do this when about to delete a frame. */
1007 x_clear_frame_selections (FRAME_PTR f
)
1011 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1012 struct terminal
*t
= dpyinfo
->terminal
;
1014 XSETFRAME (frame
, f
);
1016 /* Delete elements from the beginning of Vselection_alist. */
1017 while (CONSP (t
->Vselection_alist
)
1018 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1020 /* Run the `x-lost-selection-functions' abnormal hook. */
1021 Lisp_Object args
[2];
1022 args
[0] = Vx_lost_selection_functions
;
1023 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1024 Frun_hook_with_args (2, args
);
1026 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
1029 /* Delete elements after the beginning of Vselection_alist. */
1030 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1031 if (CONSP (XCDR (rest
))
1032 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1034 Lisp_Object args
[2];
1035 args
[0] = Vx_lost_selection_functions
;
1036 args
[1] = XCAR (XCAR (XCDR (rest
)));
1037 Frun_hook_with_args (2, args
);
1038 XSETCDR (rest
, XCDR (XCDR (rest
)));
1043 /* Nonzero if any properties for DISPLAY and WINDOW
1044 are on the list of what we are waiting for. */
1047 waiting_for_other_props_on_window (Display
*display
, Window window
)
1049 struct prop_location
*rest
= property_change_wait_list
;
1051 if (rest
->display
== display
&& rest
->window
== window
)
1058 /* Add an entry to the list of property changes we are waiting for.
1059 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1060 The return value is a number that uniquely identifies
1061 this awaited property change. */
1063 static struct prop_location
*
1064 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1066 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1067 pl
->identifier
= ++prop_location_identifier
;
1068 pl
->display
= display
;
1069 pl
->window
= window
;
1070 pl
->property
= property
;
1071 pl
->desired_state
= state
;
1072 pl
->next
= property_change_wait_list
;
1074 property_change_wait_list
= pl
;
1078 /* Delete an entry from the list of property changes we are waiting for.
1079 IDENTIFIER is the number that uniquely identifies the entry. */
1082 unexpect_property_change (struct prop_location
*location
)
1084 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1087 if (rest
== location
)
1090 prev
->next
= rest
->next
;
1092 property_change_wait_list
= rest
->next
;
1101 /* Remove the property change expectation element for IDENTIFIER. */
1104 wait_for_property_change_unwind (Lisp_Object loc
)
1106 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1108 unexpect_property_change (location
);
1109 if (location
== property_change_reply_object
)
1110 property_change_reply_object
= 0;
1114 /* Actually wait for a property change.
1115 IDENTIFIER should be the value that expect_property_change returned. */
1118 wait_for_property_change (struct prop_location
*location
)
1121 int count
= SPECPDL_INDEX ();
1123 if (property_change_reply_object
)
1126 /* Make sure to do unexpect_property_change if we quit or err. */
1127 record_unwind_protect (wait_for_property_change_unwind
,
1128 make_save_value (location
, 0));
1130 XSETCAR (property_change_reply
, Qnil
);
1131 property_change_reply_object
= location
;
1133 /* If the event we are waiting for arrives beyond here, it will set
1134 property_change_reply, because property_change_reply_object says so. */
1135 if (! location
->arrived
)
1137 secs
= x_selection_timeout
/ 1000;
1138 usecs
= (x_selection_timeout
% 1000) * 1000;
1139 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1140 wait_reading_process_output (secs
, usecs
, 0, 0,
1141 property_change_reply
, NULL
, 0);
1143 if (NILP (XCAR (property_change_reply
)))
1145 TRACE0 (" Timed out");
1146 error ("Timed out waiting for property-notify event");
1150 unbind_to (count
, Qnil
);
1153 /* Called from XTread_socket in response to a PropertyNotify event. */
1156 x_handle_property_notify (XPropertyEvent
*event
)
1158 struct prop_location
*rest
;
1160 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1163 && rest
->property
== event
->atom
1164 && rest
->window
== event
->window
1165 && rest
->display
== event
->display
1166 && rest
->desired_state
== event
->state
)
1168 TRACE2 ("Expected %s of property %s",
1169 (event
->state
== PropertyDelete
? "deletion" : "change"),
1170 XGetAtomName (event
->display
, event
->atom
));
1174 /* If this is the one wait_for_property_change is waiting for,
1175 tell it to wake up. */
1176 if (rest
== property_change_reply_object
)
1177 XSETCAR (property_change_reply
, Qt
);
1186 /* Variables for communication with x_handle_selection_notify. */
1187 static Atom reading_which_selection
;
1188 static Lisp_Object reading_selection_reply
;
1189 static Window reading_selection_window
;
1191 /* Do protocol to read selection-data from the server.
1192 Converts this to Lisp data and returns it.
1193 FRAME is the frame whose X window shall request the selection. */
1196 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1197 Lisp_Object time_stamp
, Lisp_Object frame
)
1199 struct frame
*f
= XFRAME (frame
);
1200 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1201 Display
*display
= dpyinfo
->display
;
1202 Window requestor_window
= FRAME_X_WINDOW (f
);
1203 Time requestor_time
= last_event_timestamp
;
1204 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1205 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1206 Atom type_atom
= (CONSP (target_type
)
1207 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1208 : symbol_to_x_atom (dpyinfo
, target_type
));
1210 int count
= SPECPDL_INDEX ();
1212 if (!FRAME_LIVE_P (f
))
1215 if (! NILP (time_stamp
))
1217 if (CONSP (time_stamp
))
1218 requestor_time
= (Time
) cons_to_long (time_stamp
);
1219 else if (INTEGERP (time_stamp
))
1220 requestor_time
= (Time
) XUINT (time_stamp
);
1221 else if (FLOATP (time_stamp
))
1222 requestor_time
= (Time
) XFLOAT_DATA (time_stamp
);
1224 error ("TIME_STAMP must be cons or number");
1229 /* The protected block contains wait_reading_process_output, which
1230 can run random lisp code (process handlers) or signal.
1231 Therefore, we put the x_uncatch_errors call in an unwind. */
1232 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
1233 x_catch_errors (display
);
1235 TRACE2 ("Get selection %s, type %s",
1236 XGetAtomName (display
, type_atom
),
1237 XGetAtomName (display
, target_property
));
1239 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1240 requestor_window
, requestor_time
);
1243 /* Prepare to block until the reply has been read. */
1244 reading_selection_window
= requestor_window
;
1245 reading_which_selection
= selection_atom
;
1246 XSETCAR (reading_selection_reply
, Qnil
);
1248 /* It should not be necessary to stop handling selection requests
1249 during this time. In fact, the SAVE_TARGETS mechanism requires
1250 us to handle a clipboard manager's requests before it returns
1253 x_start_queuing_selection_requests ();
1254 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1259 /* This allows quits. Also, don't wait forever. */
1260 secs
= x_selection_timeout
/ 1000;
1261 usecs
= (x_selection_timeout
% 1000) * 1000;
1262 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1263 wait_reading_process_output (secs
, usecs
, 0, 0,
1264 reading_selection_reply
, NULL
, 0);
1265 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1268 if (x_had_errors_p (display
))
1269 error ("Cannot get selection");
1270 /* This calls x_uncatch_errors. */
1271 unbind_to (count
, Qnil
);
1274 if (NILP (XCAR (reading_selection_reply
)))
1275 error ("Timed out waiting for reply from selection owner");
1276 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1279 /* Otherwise, the selection is waiting for us on the requested property. */
1281 x_get_window_property_as_lisp_data (display
, requestor_window
,
1282 target_property
, target_type
,
1286 /* Subroutines of x_get_window_property_as_lisp_data */
1288 /* Use xfree, not XFree, to free the data obtained with this function. */
1291 x_get_window_property (Display
*display
, Window window
, Atom property
,
1292 unsigned char **data_ret
, int *bytes_ret
,
1293 Atom
*actual_type_ret
, int *actual_format_ret
,
1294 unsigned long *actual_size_ret
, int delete_p
)
1297 unsigned long bytes_remaining
;
1299 unsigned char *tmp_data
= 0;
1301 int buffer_size
= SELECTION_QUANTUM (display
);
1303 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1304 buffer_size
= MAX_SELECTION_QUANTUM
;
1308 /* First probe the thing to find out how big it is. */
1309 result
= XGetWindowProperty (display
, window
, property
,
1310 0L, 0L, False
, AnyPropertyType
,
1311 actual_type_ret
, actual_format_ret
,
1313 &bytes_remaining
, &tmp_data
);
1314 if (result
!= Success
)
1322 /* This was allocated by Xlib, so use XFree. */
1323 XFree ((char *) tmp_data
);
1325 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1331 total_size
= bytes_remaining
+ 1;
1332 *data_ret
= (unsigned char *) xmalloc (total_size
);
1334 /* Now read, until we've gotten it all. */
1335 while (bytes_remaining
)
1337 #ifdef TRACE_SELECTION
1338 unsigned long last
= bytes_remaining
;
1341 = XGetWindowProperty (display
, window
, property
,
1342 (long)offset
/4, (long)buffer_size
/4,
1345 actual_type_ret
, actual_format_ret
,
1346 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1348 TRACE2 ("Read %lu bytes from property %s",
1349 last
- bytes_remaining
,
1350 XGetAtomName (display
, property
));
1352 /* If this doesn't return Success at this point, it means that
1353 some clod deleted the selection while we were in the midst of
1354 reading it. Deal with that, I guess.... */
1355 if (result
!= Success
)
1358 /* The man page for XGetWindowProperty says:
1359 "If the returned format is 32, the returned data is represented
1360 as a long array and should be cast to that type to obtain the
1362 This applies even if long is more than 32 bits, the X library
1363 converts from 32 bit elements received from the X server to long
1364 and passes the long array to us. Thus, for that case memcpy can not
1365 be used. We convert to a 32 bit type here, because so much code
1368 The bytes and offsets passed to XGetWindowProperty refers to the
1369 property and those are indeed in 32 bit quantities if format is 32. */
1371 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1374 int *idata
= (int *) ((*data_ret
) + offset
);
1375 long *ldata
= (long *) tmp_data
;
1377 for (i
= 0; i
< *actual_size_ret
; ++i
)
1379 idata
[i
]= (int) ldata
[i
];
1385 *actual_size_ret
*= *actual_format_ret
/ 8;
1386 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1387 offset
+= *actual_size_ret
;
1390 /* This was allocated by Xlib, so use XFree. */
1391 XFree ((char *) tmp_data
);
1396 *bytes_ret
= offset
;
1399 /* Use xfree, not XFree, to free the data obtained with this function. */
1402 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1403 Lisp_Object target_type
,
1404 unsigned int min_size_bytes
,
1405 unsigned char **data_ret
, int *size_bytes_ret
,
1406 Atom
*type_ret
, int *format_ret
,
1407 unsigned long *size_ret
)
1410 struct prop_location
*wait_object
;
1411 *size_bytes_ret
= min_size_bytes
;
1412 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1414 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1416 /* At this point, we have read an INCR property.
1417 Delete the property to ack it.
1418 (But first, prepare to receive the next event in this handshake.)
1420 Now, we must loop, waiting for the sending window to put a value on
1421 that property, then reading the property, then deleting it to ack.
1422 We are done when the sender places a property of length 0.
1425 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1426 TRACE1 (" Delete property %s",
1427 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1428 XDeleteProperty (display
, window
, property
);
1429 TRACE1 (" Expect new value of property %s",
1430 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1431 wait_object
= expect_property_change (display
, window
, property
,
1438 unsigned char *tmp_data
;
1441 TRACE0 (" Wait for property change");
1442 wait_for_property_change (wait_object
);
1444 /* expect it again immediately, because x_get_window_property may
1445 .. no it won't, I don't get it.
1446 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1447 TRACE0 (" Get property value");
1448 x_get_window_property (display
, window
, property
,
1449 &tmp_data
, &tmp_size_bytes
,
1450 type_ret
, format_ret
, size_ret
, 1);
1452 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1454 if (tmp_size_bytes
== 0) /* we're done */
1456 TRACE0 ("Done reading incrementally");
1458 if (! waiting_for_other_props_on_window (display
, window
))
1459 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1460 /* Use xfree, not XFree, because x_get_window_property
1461 calls xmalloc itself. */
1467 TRACE1 (" ACK by deleting property %s",
1468 XGetAtomName (display
, property
));
1469 XDeleteProperty (display
, window
, property
);
1470 wait_object
= expect_property_change (display
, window
, property
,
1475 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1477 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1478 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1481 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1482 offset
+= tmp_size_bytes
;
1484 /* Use xfree, not XFree, because x_get_window_property
1485 calls xmalloc itself. */
1491 /* Fetch a value from property PROPERTY of X window WINDOW on display
1492 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1496 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1498 Lisp_Object target_type
,
1499 Atom selection_atom
)
1503 unsigned long actual_size
;
1504 unsigned char *data
= 0;
1507 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1509 TRACE0 ("Reading selection data");
1511 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1512 &actual_type
, &actual_format
, &actual_size
, 1);
1515 int there_is_a_selection_owner
;
1517 there_is_a_selection_owner
1518 = XGetSelectionOwner (display
, selection_atom
);
1520 if (there_is_a_selection_owner
)
1521 signal_error ("Selection owner couldn't convert",
1523 ? list2 (target_type
,
1524 x_atom_to_symbol (display
, actual_type
))
1527 signal_error ("No selection",
1528 x_atom_to_symbol (display
, selection_atom
));
1531 if (actual_type
== dpyinfo
->Xatom_INCR
)
1533 /* That wasn't really the data, just the beginning. */
1535 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1537 /* Use xfree, not XFree, because x_get_window_property
1538 calls xmalloc itself. */
1539 xfree ((char *) data
);
1541 receive_incremental_selection (display
, window
, property
, target_type
,
1542 min_size_bytes
, &data
, &bytes
,
1543 &actual_type
, &actual_format
,
1548 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1549 XDeleteProperty (display
, window
, property
);
1553 /* It's been read. Now convert it to a lisp object in some semi-rational
1555 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1556 actual_type
, actual_format
);
1558 /* Use xfree, not XFree, because x_get_window_property
1559 calls xmalloc itself. */
1560 xfree ((char *) data
);
1564 /* These functions convert from the selection data read from the server into
1565 something that we can use from Lisp, and vice versa.
1567 Type: Format: Size: Lisp Type:
1568 ----- ------- ----- -----------
1571 ATOM 32 > 1 Vector of Symbols
1573 * 16 > 1 Vector of Integers
1574 * 32 1 if <=16 bits: Integer
1575 if > 16 bits: Cons of top16, bot16
1576 * 32 > 1 Vector of the above
1578 When converting a Lisp number to C, it is assumed to be of format 16 if
1579 it is an integer, and of format 32 if it is a cons of two integers.
1581 When converting a vector of numbers from Lisp to C, it is assumed to be
1582 of format 16 if every element in the vector is an integer, and is assumed
1583 to be of format 32 if any element is a cons of two integers.
1585 When converting an object to C, it may be of the form (SYMBOL . <data>)
1586 where SYMBOL is what we should claim that the type is. Format and
1587 representation are as above.
1589 Important: When format is 32, data should contain an array of int,
1590 not an array of long as the X library returns. This makes a difference
1591 when sizeof(long) != sizeof(int). */
1596 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1597 int size
, Atom type
, int format
)
1599 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1601 if (type
== dpyinfo
->Xatom_NULL
)
1604 /* Convert any 8-bit data to a string, for compactness. */
1605 else if (format
== 8)
1607 Lisp_Object str
, lispy_type
;
1609 str
= make_unibyte_string ((char *) data
, size
);
1610 /* Indicate that this string is from foreign selection by a text
1611 property `foreign-selection' so that the caller of
1612 x-get-selection-internal (usually x-get-selection) can know
1613 that the string must be decode. */
1614 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1615 lispy_type
= QCOMPOUND_TEXT
;
1616 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1617 lispy_type
= QUTF8_STRING
;
1619 lispy_type
= QSTRING
;
1620 Fput_text_property (make_number (0), make_number (size
),
1621 Qforeign_selection
, lispy_type
, str
);
1624 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1625 a vector of symbols. */
1626 else if (type
== XA_ATOM
1627 /* Treat ATOM_PAIR type similar to list of atoms. */
1628 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1631 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1632 But the callers of these function has made sure the data for
1633 format == 32 is an array of int. Thus, use int instead
1635 int *idata
= (int *) data
;
1637 if (size
== sizeof (int))
1638 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1641 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1643 for (i
= 0; i
< size
/ sizeof (int); i
++)
1644 Faset (v
, make_number (i
),
1645 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1650 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1651 If the number is 32 bits and won't fit in a Lisp_Int,
1652 convert it to a cons of integers, 16 bits in each half.
1654 else if (format
== 32 && size
== sizeof (int))
1655 return long_to_cons (((unsigned int *) data
) [0]);
1656 else if (format
== 16 && size
== sizeof (short))
1657 return make_number ((int) (((unsigned short *) data
) [0]));
1659 /* Convert any other kind of data to a vector of numbers, represented
1660 as above (as an integer, or a cons of two 16 bit integers.)
1662 else if (format
== 16)
1666 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1667 for (i
= 0; i
< size
/ 2; i
++)
1669 int j
= (int) ((unsigned short *) data
) [i
];
1670 Faset (v
, make_number (i
), make_number (j
));
1677 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1678 for (i
= 0; i
< size
/ 4; i
++)
1680 unsigned int j
= ((unsigned int *) data
) [i
];
1681 Faset (v
, make_number (i
), long_to_cons (j
));
1688 /* Use xfree, not XFree, to free the data obtained with this function. */
1691 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1692 unsigned char **data_ret
, Atom
*type_ret
,
1693 unsigned int *size_ret
,
1694 int *format_ret
, int *nofree_ret
)
1696 Lisp_Object type
= Qnil
;
1697 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1701 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1705 if (CONSP (obj
) && NILP (XCDR (obj
)))
1709 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1710 { /* This is not the same as declining */
1716 else if (STRINGP (obj
))
1718 if (SCHARS (obj
) < SBYTES (obj
))
1719 /* OBJ is a multibyte string containing a non-ASCII char. */
1720 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1724 *size_ret
= SBYTES (obj
);
1725 *data_ret
= SDATA (obj
);
1728 else if (SYMBOLP (obj
))
1732 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1733 (*data_ret
) [sizeof (Atom
)] = 0;
1734 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1735 if (NILP (type
)) type
= QATOM
;
1737 else if (INTEGERP (obj
)
1738 && XINT (obj
) < 0xFFFF
1739 && XINT (obj
) > -0xFFFF)
1743 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1744 (*data_ret
) [sizeof (short)] = 0;
1745 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1746 if (NILP (type
)) type
= QINTEGER
;
1748 else if (INTEGERP (obj
)
1749 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1750 && (INTEGERP (XCDR (obj
))
1751 || (CONSP (XCDR (obj
))
1752 && INTEGERP (XCAR (XCDR (obj
)))))))
1756 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1757 (*data_ret
) [sizeof (long)] = 0;
1758 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1759 if (NILP (type
)) type
= QINTEGER
;
1761 else if (VECTORP (obj
))
1763 /* Lisp_Vectors may represent a set of ATOMs;
1764 a set of 16 or 32 bit INTEGERs;
1765 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1769 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1770 /* This vector is an ATOM set */
1772 if (NILP (type
)) type
= QATOM
;
1773 *size_ret
= ASIZE (obj
);
1775 for (i
= 0; i
< *size_ret
; i
++)
1776 if (!SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1777 signal_error ("All elements of selection vector must have same type", obj
);
1779 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1780 for (i
= 0; i
< *size_ret
; i
++)
1781 (*(Atom
**) data_ret
) [i
]
1782 = symbol_to_x_atom (dpyinfo
, XVECTOR (obj
)->contents
[i
]);
1785 /* This vector is an INTEGER set, or something like it */
1788 *size_ret
= ASIZE (obj
);
1789 if (NILP (type
)) type
= QINTEGER
;
1791 for (i
= 0; i
< *size_ret
; i
++)
1792 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1794 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1795 signal_error (/* Qselection_error */
1796 "Elements of selection vector must be integers or conses of integers",
1799 /* Use sizeof(long) even if it is more than 32 bits. See comment
1800 in x_get_window_property and x_fill_property_data. */
1802 if (*format_ret
== 32) data_size
= sizeof(long);
1803 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1804 for (i
= 0; i
< *size_ret
; i
++)
1805 if (*format_ret
== 32)
1806 (*((unsigned long **) data_ret
)) [i
]
1807 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1809 (*((unsigned short **) data_ret
)) [i
]
1810 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1814 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1816 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1820 clean_local_selection_data (Lisp_Object obj
)
1823 && INTEGERP (XCAR (obj
))
1824 && CONSP (XCDR (obj
))
1825 && INTEGERP (XCAR (XCDR (obj
)))
1826 && NILP (XCDR (XCDR (obj
))))
1827 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1830 && INTEGERP (XCAR (obj
))
1831 && INTEGERP (XCDR (obj
)))
1833 if (XINT (XCAR (obj
)) == 0)
1835 if (XINT (XCAR (obj
)) == -1)
1836 return make_number (- XINT (XCDR (obj
)));
1841 int size
= ASIZE (obj
);
1844 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1845 copy
= Fmake_vector (make_number (size
), Qnil
);
1846 for (i
= 0; i
< size
; i
++)
1847 XVECTOR (copy
)->contents
[i
]
1848 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1854 /* Called from XTread_socket to handle SelectionNotify events.
1855 If it's the selection we are waiting for, stop waiting
1856 by setting the car of reading_selection_reply to non-nil.
1857 We store t there if the reply is successful, lambda if not. */
1860 x_handle_selection_notify (XSelectionEvent
*event
)
1862 if (event
->requestor
!= reading_selection_window
)
1864 if (event
->selection
!= reading_which_selection
)
1867 TRACE0 ("Received SelectionNotify");
1868 XSETCAR (reading_selection_reply
,
1869 (event
->property
!= 0 ? Qt
: Qlambda
));
1873 /* From a Lisp_Object, return a suitable frame for selection
1874 operations. OBJECT may be a frame, a terminal object, or nil
1875 (which stands for the selected frame--or, if that is not an X
1876 frame, the first X display on the list). If no suitable frame can
1877 be found, return NULL. */
1879 static struct frame
*
1880 frame_for_x_selection (Lisp_Object object
)
1887 f
= XFRAME (selected_frame
);
1888 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1891 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1893 f
= XFRAME (XCAR (tail
));
1894 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1898 else if (TERMINALP (object
))
1900 struct terminal
*t
= get_terminal (object
, 1);
1901 if (t
->type
== output_x_window
)
1903 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1905 f
= XFRAME (XCAR (tail
));
1906 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1911 else if (FRAMEP (object
))
1913 f
= XFRAME (object
);
1914 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1922 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1923 Sx_own_selection_internal
, 2, 3, 0,
1924 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1925 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1926 \(Those are literal upper-case symbol names, since that's what X expects.)
1927 VALUE is typically a string, or a cons of two markers, but may be
1928 anything that the functions on `selection-converter-alist' know about.
1930 FRAME should be a frame that should own the selection. If omitted or
1931 nil, it defaults to the selected frame. */)
1932 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1934 if (NILP (frame
)) frame
= selected_frame
;
1935 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1936 error ("X selection unavailable for this frame");
1938 CHECK_SYMBOL (selection
);
1939 if (NILP (value
)) error ("VALUE may not be nil");
1940 x_own_selection (selection
, value
, frame
);
1945 /* Request the selection value from the owner. If we are the owner,
1946 simply return our selection value. If we are not the owner, this
1947 will block until all of the data has arrived. */
1949 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1950 Sx_get_selection_internal
, 2, 4, 0,
1951 doc
: /* Return text selected from some X window.
1952 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1953 \(Those are literal upper-case symbol names, since that's what X expects.)
1954 TYPE is the type of data desired, typically `STRING'.
1955 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1956 selections. If omitted, defaults to the time for the last event.
1958 TERMINAL should be a terminal object or a frame specifying the X
1959 server to query. If omitted or nil, that stands for the selected
1960 frame's display, or the first available X display. */)
1961 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1962 Lisp_Object time_stamp
, Lisp_Object terminal
)
1964 Lisp_Object val
= Qnil
;
1965 struct gcpro gcpro1
, gcpro2
;
1966 struct frame
*f
= frame_for_x_selection (terminal
);
1967 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1969 CHECK_SYMBOL (selection_symbol
);
1970 CHECK_SYMBOL (target_type
);
1971 if (EQ (target_type
, QMULTIPLE
))
1972 error ("Retrieving MULTIPLE selections is currently unimplemented");
1974 error ("X selection unavailable for this frame");
1976 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
1977 FRAME_X_DISPLAY_INFO (f
));
1979 if (NILP (val
) && FRAME_LIVE_P (f
))
1982 XSETFRAME (frame
, f
);
1983 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
1984 time_stamp
, frame
));
1987 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
1990 if (CONSP (val
) && NILP (XCDR (val
)))
1993 RETURN_UNGCPRO (clean_local_selection_data (val
));
1996 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
1997 Sx_disown_selection_internal
, 1, 3, 0,
1998 doc
: /* If we own the selection SELECTION, disown it.
1999 Disowning it means there is no such selection.
2001 TERMINAL should be a terminal object or a frame specifying the X
2002 server to query. If omitted or nil, that stands for the selected
2003 frame's display, or the first available X display. */)
2004 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2007 Atom selection_atom
;
2009 struct selection_input_event sie
;
2010 struct input_event ie
;
2012 struct frame
*f
= frame_for_x_selection (terminal
);
2013 struct x_display_info
*dpyinfo
;
2018 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2019 CHECK_SYMBOL (selection
);
2021 /* Don't disown the selection when we're not the owner. */
2022 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2025 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2028 timestamp
= (NILP (time_object
) ? last_event_timestamp
2029 : cons_to_long (time_object
));
2030 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2033 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2034 generated for a window which owns the selection when that window sets
2035 the selection owner to None. The NCD server does, the MIT Sun4 server
2036 doesn't. So we synthesize one; this means we might get two, but
2037 that's ok, because the second one won't have any effect. */
2038 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2039 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2040 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2041 x_handle_selection_clear (&event
.ie
);
2046 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2048 doc
: /* Whether the current Emacs process owns the given X Selection.
2049 The arg should be the name of the selection in question, typically one of
2050 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2051 \(Those are literal upper-case symbol names, since that's what X expects.)
2052 For convenience, the symbol nil is the same as `PRIMARY',
2053 and t is the same as `SECONDARY'.
2055 TERMINAL should be a terminal object or a frame specifying the X
2056 server to query. If omitted or nil, that stands for the selected
2057 frame's display, or the first available X display. */)
2058 (Lisp_Object selection
, Lisp_Object terminal
)
2060 struct frame
*f
= frame_for_x_selection (terminal
);
2062 CHECK_SYMBOL (selection
);
2063 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2064 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2066 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2072 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2074 doc
: /* Whether there is an owner for the given X selection.
2075 SELECTION should be the name of the selection in question, typically
2076 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
2077 these literal upper-case names.) The symbol nil is the same as
2078 `PRIMARY', and t is the same as `SECONDARY'.
2080 TERMINAL should be a terminal object or a frame specifying the X
2081 server to query. If omitted or nil, that stands for the selected
2082 frame's display, or the first available X display. */)
2083 (Lisp_Object selection
, Lisp_Object terminal
)
2087 struct frame
*f
= frame_for_x_selection (terminal
);
2088 struct x_display_info
*dpyinfo
;
2090 CHECK_SYMBOL (selection
);
2091 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2092 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2097 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2099 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2102 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2103 if (atom
== 0) return Qnil
;
2105 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2107 return (owner
? Qt
: Qnil
);
2111 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2112 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2115 x_clipboard_manager_save (Lisp_Object frame
)
2117 struct frame
*f
= XFRAME (frame
);
2118 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2119 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2121 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2122 dpyinfo
->Xatom_EMACS_TMP
,
2123 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2124 (unsigned char *) &data
, 1);
2125 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2130 /* Error handler for x_clipboard_manager_save_frame. */
2133 x_clipboard_manager_error_1 (Lisp_Object err
)
2135 Lisp_Object args
[2];
2136 args
[0] = build_string ("X clipboard manager error: %s\n\
2137 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2138 args
[1] = CAR (CDR (err
));
2143 /* Error handler for x_clipboard_manager_save_all. */
2146 x_clipboard_manager_error_2 (Lisp_Object err
)
2148 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2149 If the problem persists, set `x-select-enable-clipboard-manager' \
2154 /* Called from delete_frame: save any clipboard owned by FRAME to the
2155 clipboard manager. Do nothing if FRAME does not own the clipboard,
2156 or if no clipboard manager is present. */
2159 x_clipboard_manager_save_frame (Lisp_Object frame
)
2163 if (!NILP (Vx_select_enable_clipboard_manager
)
2165 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2166 && FRAME_LIVE_P (f
))
2168 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2169 Lisp_Object local_selection
2170 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2172 if (!NILP (local_selection
)
2173 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2174 && XGetSelectionOwner (dpyinfo
->display
,
2175 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2176 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2177 x_clipboard_manager_error_1
);
2181 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2182 clipboard manager. Do nothing if FRAME does not own the clipboard,
2183 or if no clipboard manager is present. */
2186 x_clipboard_manager_save_all (void)
2188 /* Loop through all X displays, saving owned clipboards. */
2189 struct x_display_info
*dpyinfo
;
2190 Lisp_Object local_selection
, local_frame
;
2192 if (NILP (Vx_select_enable_clipboard_manager
))
2195 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2197 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2198 if (NILP (local_selection
)
2199 || !XGetSelectionOwner (dpyinfo
->display
,
2200 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2203 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2204 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2205 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2206 Qt
, x_clipboard_manager_error_2
);
2211 /***********************************************************************
2212 Drag and drop support
2213 ***********************************************************************/
2214 /* Check that lisp values are of correct type for x_fill_property_data.
2215 That is, number, string or a cons with two numbers (low and high 16
2216 bit parts of a 32 bit number). Return the number of items in DATA,
2217 or -1 if there is an error. */
2220 x_check_property_data (Lisp_Object data
)
2225 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2227 Lisp_Object o
= XCAR (iter
);
2229 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2231 else if (CONSP (o
) &&
2232 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2240 /* Convert lisp values to a C array. Values may be a number, a string
2241 which is taken as an X atom name and converted to the atom value, or
2242 a cons containing the two 16 bit parts of a 32 bit number.
2244 DPY is the display use to look up X atoms.
2245 DATA is a Lisp list of values to be converted.
2246 RET is the C array that contains the converted values. It is assumed
2247 it is big enough to hold all values.
2248 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2249 be stored in RET. Note that long is used for 32 even if long is more
2250 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2251 XClientMessageEvent). */
2254 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2257 long *d32
= (long *) ret
;
2258 short *d16
= (short *) ret
;
2259 char *d08
= (char *) ret
;
2262 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2264 Lisp_Object o
= XCAR (iter
);
2267 val
= (long) XFASTINT (o
);
2268 else if (FLOATP (o
))
2269 val
= (long) XFLOAT_DATA (o
);
2271 val
= (long) cons_to_long (o
);
2272 else if (STRINGP (o
))
2275 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2279 error ("Wrong type, must be string, number or cons");
2282 *d08
++ = (char) val
;
2283 else if (format
== 16)
2284 *d16
++ = (short) val
;
2290 /* Convert an array of C values to a Lisp list.
2291 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2292 DATA is a C array of values to be converted.
2293 TYPE is the type of the data. Only XA_ATOM is special, it converts
2294 each number in DATA to its corresponfing X atom as a symbol.
2295 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2297 SIZE is the number of elements in DATA.
2299 Important: When format is 32, data should contain an array of int,
2300 not an array of long as the X library returns. This makes a difference
2301 when sizeof(long) != sizeof(int).
2303 Also see comment for selection_data_to_lisp_data above. */
2306 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2307 Atom type
, int format
, long unsigned int size
)
2309 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2310 data
, size
*format
/8, type
, format
);
2313 /* Get the mouse position in frame relative coordinates. */
2316 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2318 Window root
, dummy_window
;
2323 XQueryPointer (FRAME_X_DISPLAY (f
),
2324 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2326 /* The root window which contains the pointer. */
2329 /* Window pointer is on, not used */
2332 /* The position on that root window. */
2335 /* x/y in dummy_window coordinates, not used. */
2338 /* Modifier keys and pointer buttons, about which
2340 (unsigned int *) &dummy
);
2343 /* Absolute to relative. */
2344 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2345 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2350 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2351 Sx_get_atom_name
, 1, 2, 0,
2352 doc
: /* Return the X atom name for VALUE as a string.
2353 VALUE may be a number or a cons where the car is the upper 16 bits and
2354 the cdr is the lower 16 bits of a 32 bit value.
2355 Use the display for FRAME or the current frame if FRAME is not given or nil.
2357 If the value is 0 or the atom is not known, return the empty string. */)
2358 (Lisp_Object value
, Lisp_Object frame
)
2360 struct frame
*f
= check_x_frame (frame
);
2363 Lisp_Object ret
= Qnil
;
2364 Display
*dpy
= FRAME_X_DISPLAY (f
);
2368 if (INTEGERP (value
))
2369 atom
= (Atom
) XUINT (value
);
2370 else if (FLOATP (value
))
2371 atom
= (Atom
) XFLOAT_DATA (value
);
2372 else if (CONSP (value
))
2373 atom
= (Atom
) cons_to_long (value
);
2375 error ("Wrong type, value must be number or cons");
2378 x_catch_errors (dpy
);
2379 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2380 had_errors
= x_had_errors_p (dpy
);
2381 x_uncatch_errors ();
2384 ret
= make_string (name
, strlen (name
));
2386 if (atom
&& name
) XFree (name
);
2387 if (NILP (ret
)) ret
= empty_unibyte_string
;
2394 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2395 Sx_register_dnd_atom
, 1, 2, 0,
2396 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2397 ATOM can be a symbol or a string. The ATOM is interned on the display that
2398 FRAME is on. If FRAME is nil, the selected frame is used. */)
2399 (Lisp_Object atom
, Lisp_Object frame
)
2402 struct frame
*f
= check_x_frame (frame
);
2404 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2408 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2409 else if (STRINGP (atom
))
2412 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2416 error ("ATOM must be a symbol or a string");
2418 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2419 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2422 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2424 dpyinfo
->x_dnd_atoms_size
*= 2;
2425 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2426 sizeof (*dpyinfo
->x_dnd_atoms
)
2427 * dpyinfo
->x_dnd_atoms_size
);
2430 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2434 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2437 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2441 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2442 unsigned long size
= 160/event
->format
;
2444 unsigned char *data
= (unsigned char *) event
->data
.b
;
2448 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2449 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2451 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2453 XSETFRAME (frame
, f
);
2455 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2456 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2457 function expects them to be of size int (i.e. 32). So to be able to
2458 use that function, put the data in the form it expects if format is 32. */
2460 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2462 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2463 idata
[i
] = (int) event
->data
.l
[i
];
2464 data
= (unsigned char *) idata
;
2467 vec
= Fmake_vector (make_number (4), Qnil
);
2468 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2469 event
->message_type
)));
2470 ASET (vec
, 1, frame
);
2471 ASET (vec
, 2, make_number (event
->format
));
2472 ASET (vec
, 3, x_property_data_to_lisp (f
,
2474 event
->message_type
,
2478 mouse_position_for_drop (f
, &x
, &y
);
2479 bufp
->kind
= DRAG_N_DROP_EVENT
;
2480 bufp
->frame_or_window
= frame
;
2481 bufp
->timestamp
= CurrentTime
;
2482 bufp
->x
= make_number (x
);
2483 bufp
->y
= make_number (y
);
2485 bufp
->modifiers
= 0;
2490 DEFUN ("x-send-client-message", Fx_send_client_event
,
2491 Sx_send_client_message
, 6, 6, 0,
2492 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2494 For DISPLAY, specify either a frame or a display name (a string).
2495 If DISPLAY is nil, that stands for the selected frame's display.
2496 DEST may be a number, in which case it is a Window id. The value 0 may
2497 be used to send to the root window of the DISPLAY.
2498 If DEST is a cons, it is converted to a 32 bit number
2499 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2500 number is then used as a window id.
2501 If DEST is a frame the event is sent to the outer window of that frame.
2502 A value of nil means the currently selected frame.
2503 If DEST is the string "PointerWindow" the event is sent to the window that
2504 contains the pointer. If DEST is the string "InputFocus" the event is
2505 sent to the window that has the input focus.
2506 FROM is the frame sending the event. Use nil for currently selected frame.
2507 MESSAGE-TYPE is the name of an Atom as a string.
2508 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2509 bits. VALUES is a list of numbers, cons and/or strings containing the values
2510 to send. If a value is a string, it is converted to an Atom and the value of
2511 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2512 with the high 16 bits from the car and the lower 16 bit from the cdr.
2513 If more values than fits into the event is given, the excessive values
2515 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2517 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2519 CHECK_STRING (message_type
);
2520 x_send_client_event(display
, dest
, from
,
2521 XInternAtom (dpyinfo
->display
,
2522 SSDATA (message_type
),
2530 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2532 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2535 struct frame
*f
= check_x_frame (from
);
2538 CHECK_NUMBER (format
);
2539 CHECK_CONS (values
);
2541 if (x_check_property_data (values
) == -1)
2542 error ("Bad data in VALUES, must be number, cons or string");
2544 event
.xclient
.type
= ClientMessage
;
2545 event
.xclient
.format
= XFASTINT (format
);
2547 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2548 && event
.xclient
.format
!= 32)
2549 error ("FORMAT must be one of 8, 16 or 32");
2551 if (FRAMEP (dest
) || NILP (dest
))
2553 struct frame
*fdest
= check_x_frame (dest
);
2554 wdest
= FRAME_OUTER_WINDOW (fdest
);
2556 else if (STRINGP (dest
))
2558 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2559 wdest
= PointerWindow
;
2560 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2563 error ("DEST as a string must be one of PointerWindow or InputFocus");
2565 else if (INTEGERP (dest
))
2566 wdest
= (Window
) XFASTINT (dest
);
2567 else if (FLOATP (dest
))
2568 wdest
= (Window
) XFLOAT_DATA (dest
);
2569 else if (CONSP (dest
))
2571 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2572 error ("Both car and cdr for DEST must be numbers");
2574 wdest
= (Window
) cons_to_long (dest
);
2577 error ("DEST must be a frame, nil, string, number or cons");
2579 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2580 to_root
= wdest
== dpyinfo
->root_window
;
2584 event
.xclient
.message_type
= message_type
;
2585 event
.xclient
.display
= dpyinfo
->display
;
2587 /* Some clients (metacity for example) expects sending window to be here
2588 when sending to the root window. */
2589 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2592 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2593 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2594 event
.xclient
.format
);
2596 /* If event mask is 0 the event is sent to the client that created
2597 the destination window. But if we are sending to the root window,
2598 there is no such client. Then we set the event mask to 0xffff. The
2599 event then goes to clients selecting for events on the root window. */
2600 x_catch_errors (dpyinfo
->display
);
2602 int propagate
= to_root
? False
: True
;
2603 unsigned mask
= to_root
? 0xffff : 0;
2604 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2605 XFlush (dpyinfo
->display
);
2607 x_uncatch_errors ();
2613 syms_of_xselect (void)
2615 defsubr (&Sx_get_selection_internal
);
2616 defsubr (&Sx_own_selection_internal
);
2617 defsubr (&Sx_disown_selection_internal
);
2618 defsubr (&Sx_selection_owner_p
);
2619 defsubr (&Sx_selection_exists_p
);
2621 defsubr (&Sx_get_atom_name
);
2622 defsubr (&Sx_send_client_message
);
2623 defsubr (&Sx_register_dnd_atom
);
2625 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2626 staticpro (&reading_selection_reply
);
2627 reading_selection_window
= 0;
2628 reading_which_selection
= 0;
2630 property_change_wait_list
= 0;
2631 prop_location_identifier
= 0;
2632 property_change_reply
= Fcons (Qnil
, Qnil
);
2633 staticpro (&property_change_reply
);
2635 converted_selections
= NULL
;
2636 conversion_fail_tag
= None
;
2638 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2639 doc
: /* An alist associating X Windows selection-types with functions.
2640 These functions are called to convert the selection, with three args:
2641 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2642 a desired type to which the selection should be converted;
2643 and the local selection value (whatever was given to `x-own-selection').
2645 The function should return the value to send to the X server
2646 \(typically a string). A return value of nil
2647 means that the conversion could not be done.
2648 A return value which is the symbol `NULL'
2649 means that a side-effect was executed,
2650 and there is no meaningful selection value. */);
2651 Vselection_converter_alist
= Qnil
;
2653 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2654 doc
: /* A list of functions to be called when Emacs loses an X selection.
2655 \(This happens when some other X client makes its own selection
2656 or when a Lisp program explicitly clears the selection.)
2657 The functions are called with one argument, the selection type
2658 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2659 Vx_lost_selection_functions
= Qnil
;
2661 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2662 doc
: /* A list of functions to be called when Emacs answers a selection request.
2663 The functions are called with three arguments:
2664 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2665 - the selection-type which Emacs was asked to convert the
2666 selection into before sending (for example, `STRING' or `LENGTH');
2667 - a flag indicating success or failure for responding to the request.
2668 We might have failed (and declined the request) for any number of reasons,
2669 including being asked for a selection that we no longer own, or being asked
2670 to convert into a type that we don't know about or that is inappropriate.
2671 This hook doesn't let you change the behavior of Emacs's selection replies,
2672 it merely informs you that they have happened. */);
2673 Vx_sent_selection_functions
= Qnil
;
2675 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2676 Vx_select_enable_clipboard_manager
,
2677 doc
: /* Whether to enable X clipboard manager support.
2678 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2679 while owning the X clipboard, the clipboard contents are saved to the
2680 clipboard manager if one is present. */);
2681 Vx_select_enable_clipboard_manager
= Qt
;
2683 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2684 doc
: /* Number of milliseconds to wait for a selection reply.
2685 If the selection owner doesn't reply in this time, we give up.
2686 A value of 0 means wait as long as necessary. This is initialized from the
2687 \"*selectionTimeout\" resource. */);
2688 x_selection_timeout
= 0;
2690 /* QPRIMARY is defined in keyboard.c. */
2691 DEFSYM (QSECONDARY
, "SECONDARY");
2692 DEFSYM (QSTRING
, "STRING");
2693 DEFSYM (QINTEGER
, "INTEGER");
2694 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2695 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2696 DEFSYM (QTEXT
, "TEXT");
2697 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2698 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2699 DEFSYM (QDELETE
, "DELETE");
2700 DEFSYM (QMULTIPLE
, "MULTIPLE");
2701 DEFSYM (QINCR
, "INCR");
2702 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2703 DEFSYM (QTARGETS
, "TARGETS");
2704 DEFSYM (QATOM
, "ATOM");
2705 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2706 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2707 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2708 DEFSYM (QNULL
, "NULL");
2709 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2710 DEFSYM (Qforeign_selection
, "foreign-selection");