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 void x_get_window_property (Display
*, Window
, Atom
,
70 unsigned char **, int *,
71 Atom
*, int *, unsigned long *, int);
72 static void receive_incremental_selection (Display
*, Window
, Atom
,
73 Lisp_Object
, unsigned,
74 unsigned char **, int *,
75 Atom
*, int *, unsigned long *);
76 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
79 static Lisp_Object
selection_data_to_lisp_data (Display
*,
80 const unsigned char *,
82 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
83 unsigned char **, Atom
*,
84 unsigned *, int *, int *);
85 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
87 /* Printing traces to stderr. */
89 #ifdef TRACE_SELECTION
91 fprintf (stderr, "%d: " fmt "\n", getpid ())
92 #define TRACE1(fmt, a0) \
93 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
94 #define TRACE2(fmt, a0, a1) \
95 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
96 #define TRACE3(fmt, a0, a1, a2) \
97 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
99 #define TRACE0(fmt) (void) 0
100 #define TRACE1(fmt, a0) (void) 0
101 #define TRACE2(fmt, a0, a1) (void) 0
105 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
106 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
107 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
109 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
110 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
112 static Lisp_Object Qcompound_text_with_extensions
;
114 static Lisp_Object Qforeign_selection
;
116 /* If this is a smaller number than the max-request-size of the display,
117 emacs will use INCR selection transfer when the selection is larger
118 than this. The max-request-size is usually around 64k, so if you want
119 emacs to use incremental selection transfers when the selection is
120 smaller than that, set this. I added this mostly for debugging the
121 incremental transfer stuff, but it might improve server performance. */
122 #define MAX_SELECTION_QUANTUM 0xFFFFFF
124 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
126 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
127 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
130 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
133 struct selection_event_queue
135 struct input_event event
;
136 struct selection_event_queue
*next
;
139 static struct selection_event_queue
*selection_queue
;
141 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
143 static int x_queue_selection_requests
;
145 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
148 x_queue_event (struct input_event
*event
)
150 struct selection_event_queue
*queue_tmp
;
152 /* Don't queue repeated requests.
153 This only happens for large requests which uses the incremental protocol. */
154 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
156 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
158 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
159 x_decline_selection_request (event
);
165 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
167 if (queue_tmp
!= NULL
)
169 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
170 queue_tmp
->event
= *event
;
171 queue_tmp
->next
= selection_queue
;
172 selection_queue
= queue_tmp
;
176 /* Start queuing SELECTION_REQUEST_EVENT events. */
179 x_start_queuing_selection_requests (void)
181 if (x_queue_selection_requests
)
184 x_queue_selection_requests
++;
185 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
188 /* Stop queuing SELECTION_REQUEST_EVENT events. */
191 x_stop_queuing_selection_requests (void)
193 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
194 --x_queue_selection_requests
;
196 /* Take all the queued events and put them back
197 so that they get processed afresh. */
199 while (selection_queue
!= NULL
)
201 struct selection_event_queue
*queue_tmp
= selection_queue
;
202 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
203 kbd_buffer_unget_event (&queue_tmp
->event
);
204 selection_queue
= queue_tmp
->next
;
205 xfree ((char *)queue_tmp
);
210 /* This converts a Lisp symbol to a server Atom, avoiding a server
211 roundtrip whenever possible. */
214 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
217 if (NILP (sym
)) return 0;
218 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
219 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
220 if (EQ (sym
, QSTRING
)) return XA_STRING
;
221 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
222 if (EQ (sym
, QATOM
)) return XA_ATOM
;
223 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
224 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
225 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
226 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
227 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
228 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
229 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
230 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
231 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
232 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
233 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
234 if (!SYMBOLP (sym
)) abort ();
236 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
238 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
244 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
245 and calls to intern whenever possible. */
248 x_atom_to_symbol (Display
*dpy
, Atom atom
)
250 struct x_display_info
*dpyinfo
;
271 dpyinfo
= x_display_info_for_display (dpy
);
274 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
276 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
278 if (atom
== dpyinfo
->Xatom_TEXT
)
280 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
281 return QCOMPOUND_TEXT
;
282 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
284 if (atom
== dpyinfo
->Xatom_DELETE
)
286 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
288 if (atom
== dpyinfo
->Xatom_INCR
)
290 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
292 if (atom
== dpyinfo
->Xatom_TARGETS
)
294 if (atom
== dpyinfo
->Xatom_NULL
)
298 str
= XGetAtomName (dpy
, atom
);
300 TRACE1 ("XGetAtomName --> %s", str
);
301 if (! str
) return Qnil
;
304 /* This was allocated by Xlib, so use XFree. */
310 /* Do protocol to assert ourself as a selection owner.
311 FRAME shall be the owner; it must be a valid X frame.
312 Update the Vselection_alist so that we can reply to later requests for
316 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
319 struct frame
*f
= XFRAME (frame
);
320 Window selecting_window
= FRAME_X_WINDOW (f
);
321 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
322 Display
*display
= dpyinfo
->display
;
323 Time timestamp
= last_event_timestamp
;
324 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
327 x_catch_errors (display
);
328 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
329 x_check_errors (display
, "Can't set selection: %s");
333 /* Now update the local cache */
335 Lisp_Object selection_data
;
336 Lisp_Object prev_value
;
338 selection_data
= list4 (selection_name
, selection_value
,
339 INTEGER_TO_CONS (timestamp
), frame
);
340 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
342 dpyinfo
->terminal
->Vselection_alist
343 = Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
);
345 /* If we already owned the selection, remove the old selection
346 data. Don't use Fdelq as that may QUIT. */
347 if (!NILP (prev_value
))
349 /* We know it's not the CAR, so it's easy. */
350 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
351 for (; CONSP (rest
); rest
= XCDR (rest
))
352 if (EQ (prev_value
, Fcar (XCDR (rest
))))
354 XSETCDR (rest
, XCDR (XCDR (rest
)));
361 /* Given a selection-name and desired type, look up our local copy of
362 the selection value and convert it to the type.
363 The value is nil or a string.
364 This function is used both for remote requests (LOCAL_REQUEST is zero)
365 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
367 This calls random Lisp code, and may signal or gc. */
370 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
371 int local_request
, struct x_display_info
*dpyinfo
)
373 Lisp_Object local_value
;
374 Lisp_Object handler_fn
, value
, check
;
377 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
379 if (NILP (local_value
)) return Qnil
;
381 /* TIMESTAMP is a special case. */
382 if (EQ (target_type
, QTIMESTAMP
))
385 value
= XCAR (XCDR (XCDR (local_value
)));
389 /* Don't allow a quit within the converter.
390 When the user types C-g, he would be surprised
391 if by luck it came during a converter. */
392 count
= SPECPDL_INDEX ();
393 specbind (Qinhibit_quit
, Qt
);
395 CHECK_SYMBOL (target_type
);
396 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
397 /* gcpro is not needed here since nothing but HANDLER_FN
398 is live, and that ought to be a symbol. */
400 if (!NILP (handler_fn
))
401 value
= call3 (handler_fn
,
402 selection_symbol
, (local_request
? Qnil
: target_type
),
403 XCAR (XCDR (local_value
)));
406 unbind_to (count
, Qnil
);
409 /* Make sure this value is of a type that we could transmit
410 to another X client. */
414 && SYMBOLP (XCAR (value
)))
415 check
= XCDR (value
);
423 /* Check for a value that CONS_TO_INTEGER could handle. */
424 else if (CONSP (check
)
425 && INTEGERP (XCAR (check
))
426 && (INTEGERP (XCDR (check
))
428 (CONSP (XCDR (check
))
429 && INTEGERP (XCAR (XCDR (check
)))
430 && NILP (XCDR (XCDR (check
))))))
433 signal_error ("Invalid data returned by selection-conversion function",
434 list2 (handler_fn
, value
));
437 /* Subroutines of x_reply_selection_request. */
439 /* Send a SelectionNotify event to the requestor with property=None,
440 meaning we were unable to do what they wanted. */
443 x_decline_selection_request (struct input_event
*event
)
446 XSelectionEvent
*reply
= &(reply_base
.xselection
);
448 reply
->type
= SelectionNotify
;
449 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
450 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
451 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
452 reply
->time
= SELECTION_EVENT_TIME (event
);
453 reply
->target
= SELECTION_EVENT_TARGET (event
);
454 reply
->property
= None
;
456 /* The reason for the error may be that the receiver has
457 died in the meantime. Handle that case. */
459 x_catch_errors (reply
->display
);
460 XSendEvent (reply
->display
, reply
->requestor
, False
, 0L, &reply_base
);
461 XFlush (reply
->display
);
466 /* This is the selection request currently being processed.
467 It is set to zero when the request is fully processed. */
468 static struct input_event
*x_selection_current_request
;
470 /* Display info in x_selection_request. */
472 static struct x_display_info
*selection_request_dpyinfo
;
474 /* Raw selection data, for sending to a requestor window. */
476 struct selection_data
484 /* This can be set to non-NULL during x_reply_selection_request, if
485 the selection is waiting for an INCR transfer to complete. Don't
486 free these; that's done by unexpect_property_change. */
487 struct prop_location
*wait_object
;
488 struct selection_data
*next
;
491 /* Linked list of the above (in support of MULTIPLE targets). */
493 static struct selection_data
*converted_selections
;
495 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
496 static Atom conversion_fail_tag
;
498 /* Used as an unwind-protect clause so that, if a selection-converter signals
499 an error, we tell the requester that we were unable to do what they wanted
500 before we throw to top-level or go into the debugger or whatever. */
503 x_selection_request_lisp_error (Lisp_Object ignore
)
505 struct selection_data
*cs
, *next
;
507 for (cs
= converted_selections
; cs
; cs
= next
)
510 if (cs
->nofree
== 0 && cs
->data
)
514 converted_selections
= NULL
;
516 if (x_selection_current_request
!= 0
517 && selection_request_dpyinfo
->display
)
518 x_decline_selection_request (x_selection_current_request
);
523 x_catch_errors_unwind (Lisp_Object dummy
)
532 /* This stuff is so that INCR selections are reentrant (that is, so we can
533 be servicing multiple INCR selection requests simultaneously.) I haven't
534 actually tested that yet. */
536 /* Keep a list of the property changes that are awaited. */
546 struct prop_location
*next
;
549 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
550 static void wait_for_property_change (struct prop_location
*location
);
551 static void unexpect_property_change (struct prop_location
*location
);
552 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
554 static int prop_location_identifier
;
556 static Lisp_Object property_change_reply
;
558 static struct prop_location
*property_change_reply_object
;
560 static struct prop_location
*property_change_wait_list
;
563 queue_selection_requests_unwind (Lisp_Object tem
)
565 x_stop_queuing_selection_requests ();
570 /* Send the reply to a selection request event EVENT. */
572 #ifdef TRACE_SELECTION
573 static int x_reply_selection_request_cnt
;
574 #endif /* TRACE_SELECTION */
577 x_reply_selection_request (struct input_event
*event
, struct x_display_info
*dpyinfo
)
580 XSelectionEvent
*reply
= &(reply_base
.xselection
);
581 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
582 Window window
= SELECTION_EVENT_REQUESTOR (event
);
584 int max_bytes
= SELECTION_QUANTUM (display
);
585 int count
= SPECPDL_INDEX ();
586 struct selection_data
*cs
;
588 if (max_bytes
> MAX_SELECTION_QUANTUM
)
589 max_bytes
= MAX_SELECTION_QUANTUM
;
591 reply
->type
= SelectionNotify
;
592 reply
->display
= display
;
593 reply
->requestor
= window
;
594 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
595 reply
->time
= SELECTION_EVENT_TIME (event
);
596 reply
->target
= SELECTION_EVENT_TARGET (event
);
597 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
598 if (reply
->property
== None
)
599 reply
->property
= reply
->target
;
602 /* The protected block contains wait_for_property_change, which can
603 run random lisp code (process handlers) or signal. Therefore, we
604 put the x_uncatch_errors call in an unwind. */
605 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
606 x_catch_errors (display
);
608 /* Loop over converted selections, storing them in the requested
609 properties. If data is large, only store the first N bytes
610 (section 2.7.2 of ICCCM). Note that we store the data for a
611 MULTIPLE request in the opposite order; the ICCM says only that
612 the conversion itself must be done in the same order. */
613 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
615 if (cs
->property
== None
)
618 bytes_remaining
= cs
->size
* (cs
->format
/ 8);
619 if (bytes_remaining
<= max_bytes
)
621 /* Send all the data at once, with minimal handshaking. */
622 TRACE1 ("Sending all %d bytes", bytes_remaining
);
623 XChangeProperty (display
, window
, cs
->property
,
624 cs
->type
, cs
->format
, PropModeReplace
,
629 /* Send an INCR tag to initiate incremental transfer. */
632 TRACE2 ("Start sending %d bytes incrementally (%s)",
633 bytes_remaining
, XGetAtomName (display
, cs
->property
));
635 = expect_property_change (display
, window
, cs
->property
,
638 /* XChangeProperty expects an array of long even if long is
639 more than 32 bits. */
640 value
[0] = bytes_remaining
;
641 XChangeProperty (display
, window
, cs
->property
,
642 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
643 (unsigned char *) value
, 1);
644 XSelectInput (display
, window
, PropertyChangeMask
);
648 /* Now issue the SelectionNotify event. */
649 XSendEvent (display
, window
, False
, 0L, &reply_base
);
652 #ifdef TRACE_SELECTION
654 char *sel
= XGetAtomName (display
, reply
->selection
);
655 char *tgt
= XGetAtomName (display
, reply
->target
);
656 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
657 sel
, tgt
, ++x_reply_selection_request_cnt
);
658 if (sel
) XFree (sel
);
659 if (tgt
) XFree (tgt
);
661 #endif /* TRACE_SELECTION */
663 /* Finish sending the rest of each of the INCR values. This should
664 be improved; there's a chance of deadlock if more than one
665 subtarget in a MULTIPLE selection requires an INCR transfer, and
666 the requestor and Emacs loop waiting on different transfers. */
667 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
670 int format_bytes
= cs
->format
/ 8;
671 int had_errors
= x_had_errors_p (display
);
674 bytes_remaining
= cs
->size
* format_bytes
;
676 /* Wait for the requester to ack by deleting the property.
677 This can run Lisp code (process handlers) or signal. */
680 TRACE1 ("Waiting for ACK (deletion of %s)",
681 XGetAtomName (display
, cs
->property
));
682 wait_for_property_change (cs
->wait_object
);
685 unexpect_property_change (cs
->wait_object
);
687 while (bytes_remaining
)
689 int i
= ((bytes_remaining
< max_bytes
)
691 : max_bytes
) / format_bytes
;
695 = expect_property_change (display
, window
, cs
->property
,
698 TRACE1 ("Sending increment of %d elements", i
);
699 TRACE1 ("Set %s to increment data",
700 XGetAtomName (display
, cs
->property
));
702 /* Append the next chunk of data to the property. */
703 XChangeProperty (display
, window
, cs
->property
,
704 cs
->type
, cs
->format
, PropModeAppend
,
706 bytes_remaining
-= i
* format_bytes
;
707 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
710 had_errors
= x_had_errors_p (display
);
713 if (had_errors
) break;
715 /* Wait for the requester to ack this chunk by deleting
716 the property. This can run Lisp code or signal. */
717 TRACE1 ("Waiting for increment ACK (deletion of %s)",
718 XGetAtomName (display
, cs
->property
));
719 wait_for_property_change (cs
->wait_object
);
722 /* Now write a zero-length chunk to the property to tell the
723 requester that we're done. */
725 if (! waiting_for_other_props_on_window (display
, window
))
726 XSelectInput (display
, window
, 0L);
728 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
729 XGetAtomName (display
, cs
->property
));
730 XChangeProperty (display
, window
, cs
->property
,
731 cs
->type
, cs
->format
, PropModeReplace
,
733 TRACE0 ("Done sending incrementally");
736 /* rms, 2003-01-03: I think I have fixed this bug. */
737 /* The window we're communicating with may have been deleted
738 in the meantime (that's a real situation from a bug report).
739 In this case, there may be events in the event queue still
740 refering to the deleted window, and we'll get a BadWindow error
741 in XTread_socket when processing the events. I don't have
742 an idea how to fix that. gerd, 2001-01-98. */
743 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
744 delivered before uncatch errors. */
745 XSync (display
, False
);
748 /* GTK queues events in addition to the queue in Xlib. So we
749 UNBLOCK to enter the event loop and get possible errors delivered,
750 and then BLOCK again because x_uncatch_errors requires it. */
752 /* This calls x_uncatch_errors. */
753 unbind_to (count
, Qnil
);
757 /* Handle a SelectionRequest event EVENT.
758 This is called from keyboard.c when such an event is found in the queue. */
761 x_handle_selection_request (struct input_event
*event
)
763 struct gcpro gcpro1
, gcpro2
;
764 Time local_selection_time
;
766 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
767 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
768 Atom selection
= SELECTION_EVENT_SELECTION (event
);
769 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
770 Atom target
= SELECTION_EVENT_TARGET (event
);
771 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
772 Atom property
= SELECTION_EVENT_PROPERTY (event
);
773 Lisp_Object local_selection_data
;
775 int count
= SPECPDL_INDEX ();
776 GCPRO2 (local_selection_data
, target_symbol
);
778 if (!dpyinfo
) goto DONE
;
780 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
782 /* Decline if we don't own any selections. */
783 if (NILP (local_selection_data
)) goto DONE
;
785 /* Decline requests issued prior to our acquiring the selection. */
786 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
787 Time
, local_selection_time
);
788 if (SELECTION_EVENT_TIME (event
) != CurrentTime
789 && local_selection_time
> SELECTION_EVENT_TIME (event
))
792 x_selection_current_request
= event
;
793 selection_request_dpyinfo
= dpyinfo
;
794 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
796 /* We might be able to handle nested x_handle_selection_requests,
797 but this is difficult to test, and seems unimportant. */
798 x_start_queuing_selection_requests ();
799 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
801 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
802 SDATA (SYMBOL_NAME (selection_symbol
)),
803 SDATA (SYMBOL_NAME (target_symbol
)));
805 if (EQ (target_symbol
, QMULTIPLE
))
807 /* For MULTIPLE targets, the event property names a list of atom
808 pairs; the first atom names a target and the second names a
809 non-None property. */
810 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
811 Lisp_Object multprop
;
814 if (property
== None
) goto DONE
;
816 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
817 QMULTIPLE
, selection
);
819 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
822 nselections
= ASIZE (multprop
) / 2;
823 /* Perform conversions. This can signal. */
824 for (j
= 0; j
< nselections
; j
++)
826 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
827 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
828 AREF (multprop
, 2*j
+1));
830 if (subproperty
!= None
)
831 x_convert_selection (event
, selection_symbol
, subtarget
,
832 subproperty
, 1, dpyinfo
);
838 if (property
== None
)
839 property
= SELECTION_EVENT_TARGET (event
);
840 success
= x_convert_selection (event
, selection_symbol
,
841 target_symbol
, property
,
848 x_reply_selection_request (event
, dpyinfo
);
850 x_decline_selection_request (event
);
851 x_selection_current_request
= 0;
853 /* Run the `x-sent-selection-functions' abnormal hook. */
854 if (!NILP (Vx_sent_selection_functions
)
855 && !EQ (Vx_sent_selection_functions
, Qunbound
))
858 args
[0] = Vx_sent_selection_functions
;
859 args
[1] = selection_symbol
;
860 args
[2] = target_symbol
;
861 args
[3] = success
? Qt
: Qnil
;
862 Frun_hook_with_args (4, args
);
865 unbind_to (count
, Qnil
);
869 /* Perform the requested selection conversion, and write the data to
870 the converted_selections linked list, where it can be accessed by
871 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
872 the data even if conversion fails, using conversion_fail_tag.
874 Return 0 if the selection failed to convert, 1 otherwise. */
877 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
878 Lisp_Object target_symbol
, Atom property
,
879 int for_multiple
, struct x_display_info
*dpyinfo
)
882 Lisp_Object lisp_selection
;
883 struct selection_data
*cs
;
884 GCPRO1 (lisp_selection
);
887 = x_get_local_selection (selection_symbol
, target_symbol
,
890 /* A nil return value means we can't perform the conversion. */
891 if (NILP (lisp_selection
)
892 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
896 cs
= xmalloc (sizeof (struct selection_data
));
897 cs
->data
= (unsigned char *) &conversion_fail_tag
;
902 cs
->property
= property
;
903 cs
->wait_object
= NULL
;
904 cs
->next
= converted_selections
;
905 converted_selections
= cs
;
912 /* Otherwise, record the converted selection to binary. */
913 cs
= xmalloc (sizeof (struct selection_data
));
915 cs
->property
= property
;
916 cs
->wait_object
= NULL
;
917 cs
->next
= converted_selections
;
918 converted_selections
= cs
;
919 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
921 &(cs
->data
), &(cs
->type
),
922 &(cs
->size
), &(cs
->format
),
928 /* Handle a SelectionClear event EVENT, which indicates that some
929 client cleared out our previously asserted selection.
930 This is called from keyboard.c when such an event is found in the queue. */
933 x_handle_selection_clear (struct input_event
*event
)
935 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
936 Atom selection
= SELECTION_EVENT_SELECTION (event
);
937 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
939 Lisp_Object selection_symbol
, local_selection_data
;
940 Time local_selection_time
;
941 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
942 Lisp_Object Vselection_alist
;
944 TRACE0 ("x_handle_selection_clear");
946 if (!dpyinfo
) return;
948 selection_symbol
= x_atom_to_symbol (display
, selection
);
949 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
951 /* Well, we already believe that we don't own it, so that's just fine. */
952 if (NILP (local_selection_data
)) return;
954 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
955 Time
, local_selection_time
);
957 /* We have reasserted the selection since this SelectionClear was
958 generated, so we can disregard it. */
959 if (changed_owner_time
!= CurrentTime
960 && local_selection_time
> changed_owner_time
)
963 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
964 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
965 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
966 Vselection_alist
= XCDR (Vselection_alist
);
970 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
971 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
973 XSETCDR (rest
, XCDR (XCDR (rest
)));
977 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
979 /* Run the `x-lost-selection-functions' abnormal hook. */
982 args
[0] = Vx_lost_selection_functions
;
983 args
[1] = selection_symbol
;
984 Frun_hook_with_args (2, args
);
987 prepare_menu_bars ();
988 redisplay_preserve_echo_area (20);
992 x_handle_selection_event (struct input_event
*event
)
994 TRACE0 ("x_handle_selection_event");
995 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
996 x_handle_selection_clear (event
);
997 else if (x_queue_selection_requests
)
998 x_queue_event (event
);
1000 x_handle_selection_request (event
);
1004 /* Clear all selections that were made from frame F.
1005 We do this when about to delete a frame. */
1008 x_clear_frame_selections (FRAME_PTR f
)
1012 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1013 struct terminal
*t
= dpyinfo
->terminal
;
1015 XSETFRAME (frame
, f
);
1017 /* Delete elements from the beginning of Vselection_alist. */
1018 while (CONSP (t
->Vselection_alist
)
1019 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1021 /* Run the `x-lost-selection-functions' abnormal hook. */
1022 Lisp_Object args
[2];
1023 args
[0] = Vx_lost_selection_functions
;
1024 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1025 Frun_hook_with_args (2, args
);
1027 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
1030 /* Delete elements after the beginning of Vselection_alist. */
1031 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1032 if (CONSP (XCDR (rest
))
1033 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1035 Lisp_Object args
[2];
1036 args
[0] = Vx_lost_selection_functions
;
1037 args
[1] = XCAR (XCAR (XCDR (rest
)));
1038 Frun_hook_with_args (2, args
);
1039 XSETCDR (rest
, XCDR (XCDR (rest
)));
1044 /* Nonzero if any properties for DISPLAY and WINDOW
1045 are on the list of what we are waiting for. */
1048 waiting_for_other_props_on_window (Display
*display
, Window window
)
1050 struct prop_location
*rest
= property_change_wait_list
;
1052 if (rest
->display
== display
&& rest
->window
== window
)
1059 /* Add an entry to the list of property changes we are waiting for.
1060 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1061 The return value is a number that uniquely identifies
1062 this awaited property change. */
1064 static struct prop_location
*
1065 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1067 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1068 pl
->identifier
= ++prop_location_identifier
;
1069 pl
->display
= display
;
1070 pl
->window
= window
;
1071 pl
->property
= property
;
1072 pl
->desired_state
= state
;
1073 pl
->next
= property_change_wait_list
;
1075 property_change_wait_list
= pl
;
1079 /* Delete an entry from the list of property changes we are waiting for.
1080 IDENTIFIER is the number that uniquely identifies the entry. */
1083 unexpect_property_change (struct prop_location
*location
)
1085 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1088 if (rest
== location
)
1091 prev
->next
= rest
->next
;
1093 property_change_wait_list
= rest
->next
;
1102 /* Remove the property change expectation element for IDENTIFIER. */
1105 wait_for_property_change_unwind (Lisp_Object loc
)
1107 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1109 unexpect_property_change (location
);
1110 if (location
== property_change_reply_object
)
1111 property_change_reply_object
= 0;
1115 /* Actually wait for a property change.
1116 IDENTIFIER should be the value that expect_property_change returned. */
1119 wait_for_property_change (struct prop_location
*location
)
1122 int count
= SPECPDL_INDEX ();
1124 if (property_change_reply_object
)
1127 /* Make sure to do unexpect_property_change if we quit or err. */
1128 record_unwind_protect (wait_for_property_change_unwind
,
1129 make_save_value (location
, 0));
1131 XSETCAR (property_change_reply
, Qnil
);
1132 property_change_reply_object
= location
;
1134 /* If the event we are waiting for arrives beyond here, it will set
1135 property_change_reply, because property_change_reply_object says so. */
1136 if (! location
->arrived
)
1138 secs
= x_selection_timeout
/ 1000;
1139 usecs
= (x_selection_timeout
% 1000) * 1000;
1140 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1141 wait_reading_process_output (secs
, usecs
, 0, 0,
1142 property_change_reply
, NULL
, 0);
1144 if (NILP (XCAR (property_change_reply
)))
1146 TRACE0 (" Timed out");
1147 error ("Timed out waiting for property-notify event");
1151 unbind_to (count
, Qnil
);
1154 /* Called from XTread_socket in response to a PropertyNotify event. */
1157 x_handle_property_notify (XPropertyEvent
*event
)
1159 struct prop_location
*rest
;
1161 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1164 && rest
->property
== event
->atom
1165 && rest
->window
== event
->window
1166 && rest
->display
== event
->display
1167 && rest
->desired_state
== event
->state
)
1169 TRACE2 ("Expected %s of property %s",
1170 (event
->state
== PropertyDelete
? "deletion" : "change"),
1171 XGetAtomName (event
->display
, event
->atom
));
1175 /* If this is the one wait_for_property_change is waiting for,
1176 tell it to wake up. */
1177 if (rest
== property_change_reply_object
)
1178 XSETCAR (property_change_reply
, Qt
);
1187 /* Variables for communication with x_handle_selection_notify. */
1188 static Atom reading_which_selection
;
1189 static Lisp_Object reading_selection_reply
;
1190 static Window reading_selection_window
;
1192 /* Do protocol to read selection-data from the server.
1193 Converts this to Lisp data and returns it.
1194 FRAME is the frame whose X window shall request the selection. */
1197 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1198 Lisp_Object time_stamp
, Lisp_Object frame
)
1200 struct frame
*f
= XFRAME (frame
);
1201 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1202 Display
*display
= dpyinfo
->display
;
1203 Window requestor_window
= FRAME_X_WINDOW (f
);
1204 Time requestor_time
= last_event_timestamp
;
1205 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1206 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1207 Atom type_atom
= (CONSP (target_type
)
1208 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1209 : symbol_to_x_atom (dpyinfo
, target_type
));
1212 if (!FRAME_LIVE_P (f
))
1215 if (! NILP (time_stamp
))
1216 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1219 TRACE2 ("Get selection %s, type %s",
1220 XGetAtomName (display
, type_atom
),
1221 XGetAtomName (display
, target_property
));
1223 x_catch_errors (display
);
1224 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1225 requestor_window
, requestor_time
);
1226 x_check_errors (display
, "Can't convert selection: %s");
1227 x_uncatch_errors ();
1229 /* Prepare to block until the reply has been read. */
1230 reading_selection_window
= requestor_window
;
1231 reading_which_selection
= selection_atom
;
1232 XSETCAR (reading_selection_reply
, Qnil
);
1234 /* It should not be necessary to stop handling selection requests
1235 during this time. In fact, the SAVE_TARGETS mechanism requires
1236 us to handle a clipboard manager's requests before it returns
1239 x_start_queuing_selection_requests ();
1240 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1245 /* This allows quits. Also, don't wait forever. */
1246 secs
= x_selection_timeout
/ 1000;
1247 usecs
= (x_selection_timeout
% 1000) * 1000;
1248 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1249 wait_reading_process_output (secs
, usecs
, 0, 0,
1250 reading_selection_reply
, NULL
, 0);
1251 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1253 if (NILP (XCAR (reading_selection_reply
)))
1254 error ("Timed out waiting for reply from selection owner");
1255 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1258 /* Otherwise, the selection is waiting for us on the requested property. */
1260 x_get_window_property_as_lisp_data (display
, requestor_window
,
1261 target_property
, target_type
,
1265 /* Subroutines of x_get_window_property_as_lisp_data */
1267 /* Use xfree, not XFree, to free the data obtained with this function. */
1270 x_get_window_property (Display
*display
, Window window
, Atom property
,
1271 unsigned char **data_ret
, int *bytes_ret
,
1272 Atom
*actual_type_ret
, int *actual_format_ret
,
1273 unsigned long *actual_size_ret
, int delete_p
)
1276 unsigned long bytes_remaining
;
1278 unsigned char *tmp_data
= 0;
1280 int buffer_size
= SELECTION_QUANTUM (display
);
1282 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1283 buffer_size
= MAX_SELECTION_QUANTUM
;
1287 /* First probe the thing to find out how big it is. */
1288 result
= XGetWindowProperty (display
, window
, property
,
1289 0L, 0L, False
, AnyPropertyType
,
1290 actual_type_ret
, actual_format_ret
,
1292 &bytes_remaining
, &tmp_data
);
1293 if (result
!= Success
)
1301 /* This was allocated by Xlib, so use XFree. */
1302 XFree ((char *) tmp_data
);
1304 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1310 total_size
= bytes_remaining
+ 1;
1311 *data_ret
= (unsigned char *) xmalloc (total_size
);
1313 /* Now read, until we've gotten it all. */
1314 while (bytes_remaining
)
1316 #ifdef TRACE_SELECTION
1317 unsigned long last
= bytes_remaining
;
1320 = XGetWindowProperty (display
, window
, property
,
1321 (long)offset
/4, (long)buffer_size
/4,
1324 actual_type_ret
, actual_format_ret
,
1325 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1327 TRACE2 ("Read %lu bytes from property %s",
1328 last
- bytes_remaining
,
1329 XGetAtomName (display
, property
));
1331 /* If this doesn't return Success at this point, it means that
1332 some clod deleted the selection while we were in the midst of
1333 reading it. Deal with that, I guess.... */
1334 if (result
!= Success
)
1337 /* The man page for XGetWindowProperty says:
1338 "If the returned format is 32, the returned data is represented
1339 as a long array and should be cast to that type to obtain the
1341 This applies even if long is more than 32 bits, the X library
1342 converts from 32 bit elements received from the X server to long
1343 and passes the long array to us. Thus, for that case memcpy can not
1344 be used. We convert to a 32 bit type here, because so much code
1347 The bytes and offsets passed to XGetWindowProperty refers to the
1348 property and those are indeed in 32 bit quantities if format is 32. */
1350 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1353 int *idata
= (int *) ((*data_ret
) + offset
);
1354 long *ldata
= (long *) tmp_data
;
1356 for (i
= 0; i
< *actual_size_ret
; ++i
)
1358 idata
[i
]= (int) ldata
[i
];
1364 *actual_size_ret
*= *actual_format_ret
/ 8;
1365 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1366 offset
+= *actual_size_ret
;
1369 /* This was allocated by Xlib, so use XFree. */
1370 XFree ((char *) tmp_data
);
1375 *bytes_ret
= offset
;
1378 /* Use xfree, not XFree, to free the data obtained with this function. */
1381 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1382 Lisp_Object target_type
,
1383 unsigned int min_size_bytes
,
1384 unsigned char **data_ret
, int *size_bytes_ret
,
1385 Atom
*type_ret
, int *format_ret
,
1386 unsigned long *size_ret
)
1389 struct prop_location
*wait_object
;
1390 *size_bytes_ret
= min_size_bytes
;
1391 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1393 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1395 /* At this point, we have read an INCR property.
1396 Delete the property to ack it.
1397 (But first, prepare to receive the next event in this handshake.)
1399 Now, we must loop, waiting for the sending window to put a value on
1400 that property, then reading the property, then deleting it to ack.
1401 We are done when the sender places a property of length 0.
1404 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1405 TRACE1 (" Delete property %s",
1406 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1407 XDeleteProperty (display
, window
, property
);
1408 TRACE1 (" Expect new value of property %s",
1409 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1410 wait_object
= expect_property_change (display
, window
, property
,
1417 unsigned char *tmp_data
;
1420 TRACE0 (" Wait for property change");
1421 wait_for_property_change (wait_object
);
1423 /* expect it again immediately, because x_get_window_property may
1424 .. no it won't, I don't get it.
1425 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1426 TRACE0 (" Get property value");
1427 x_get_window_property (display
, window
, property
,
1428 &tmp_data
, &tmp_size_bytes
,
1429 type_ret
, format_ret
, size_ret
, 1);
1431 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1433 if (tmp_size_bytes
== 0) /* we're done */
1435 TRACE0 ("Done reading incrementally");
1437 if (! waiting_for_other_props_on_window (display
, window
))
1438 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1439 /* Use xfree, not XFree, because x_get_window_property
1440 calls xmalloc itself. */
1446 TRACE1 (" ACK by deleting property %s",
1447 XGetAtomName (display
, property
));
1448 XDeleteProperty (display
, window
, property
);
1449 wait_object
= expect_property_change (display
, window
, property
,
1454 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1456 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1457 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1460 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1461 offset
+= tmp_size_bytes
;
1463 /* Use xfree, not XFree, because x_get_window_property
1464 calls xmalloc itself. */
1470 /* Fetch a value from property PROPERTY of X window WINDOW on display
1471 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1475 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1477 Lisp_Object target_type
,
1478 Atom selection_atom
)
1482 unsigned long actual_size
;
1483 unsigned char *data
= 0;
1486 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1488 TRACE0 ("Reading selection data");
1490 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1491 &actual_type
, &actual_format
, &actual_size
, 1);
1494 int there_is_a_selection_owner
;
1496 there_is_a_selection_owner
1497 = XGetSelectionOwner (display
, selection_atom
);
1499 if (there_is_a_selection_owner
)
1500 signal_error ("Selection owner couldn't convert",
1502 ? list2 (target_type
,
1503 x_atom_to_symbol (display
, actual_type
))
1506 signal_error ("No selection",
1507 x_atom_to_symbol (display
, selection_atom
));
1510 if (actual_type
== dpyinfo
->Xatom_INCR
)
1512 /* That wasn't really the data, just the beginning. */
1514 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1516 /* Use xfree, not XFree, because x_get_window_property
1517 calls xmalloc itself. */
1518 xfree ((char *) data
);
1520 receive_incremental_selection (display
, window
, property
, target_type
,
1521 min_size_bytes
, &data
, &bytes
,
1522 &actual_type
, &actual_format
,
1527 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1528 XDeleteProperty (display
, window
, property
);
1532 /* It's been read. Now convert it to a lisp object in some semi-rational
1534 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1535 actual_type
, actual_format
);
1537 /* Use xfree, not XFree, because x_get_window_property
1538 calls xmalloc itself. */
1539 xfree ((char *) data
);
1543 /* These functions convert from the selection data read from the server into
1544 something that we can use from Lisp, and vice versa.
1546 Type: Format: Size: Lisp Type:
1547 ----- ------- ----- -----------
1550 ATOM 32 > 1 Vector of Symbols
1552 * 16 > 1 Vector of Integers
1553 * 32 1 if <=16 bits: Integer
1554 if > 16 bits: Cons of top16, bot16
1555 * 32 > 1 Vector of the above
1557 When converting a Lisp number to C, it is assumed to be of format 16 if
1558 it is an integer, and of format 32 if it is a cons of two integers.
1560 When converting a vector of numbers from Lisp to C, it is assumed to be
1561 of format 16 if every element in the vector is an integer, and is assumed
1562 to be of format 32 if any element is a cons of two integers.
1564 When converting an object to C, it may be of the form (SYMBOL . <data>)
1565 where SYMBOL is what we should claim that the type is. Format and
1566 representation are as above.
1568 Important: When format is 32, data should contain an array of int,
1569 not an array of long as the X library returns. This makes a difference
1570 when sizeof(long) != sizeof(int). */
1575 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1576 int size
, Atom type
, int format
)
1578 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1580 if (type
== dpyinfo
->Xatom_NULL
)
1583 /* Convert any 8-bit data to a string, for compactness. */
1584 else if (format
== 8)
1586 Lisp_Object str
, lispy_type
;
1588 str
= make_unibyte_string ((char *) data
, size
);
1589 /* Indicate that this string is from foreign selection by a text
1590 property `foreign-selection' so that the caller of
1591 x-get-selection-internal (usually x-get-selection) can know
1592 that the string must be decode. */
1593 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1594 lispy_type
= QCOMPOUND_TEXT
;
1595 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1596 lispy_type
= QUTF8_STRING
;
1598 lispy_type
= QSTRING
;
1599 Fput_text_property (make_number (0), make_number (size
),
1600 Qforeign_selection
, lispy_type
, str
);
1603 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1604 a vector of symbols. */
1605 else if (type
== XA_ATOM
1606 /* Treat ATOM_PAIR type similar to list of atoms. */
1607 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1610 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1611 But the callers of these function has made sure the data for
1612 format == 32 is an array of int. Thus, use int instead
1614 int *idata
= (int *) data
;
1616 if (size
== sizeof (int))
1617 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1620 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1622 for (i
= 0; i
< size
/ sizeof (int); i
++)
1623 Faset (v
, make_number (i
),
1624 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1629 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1630 If the number is 32 bits and won't fit in a Lisp_Int,
1631 convert it to a cons of integers, 16 bits in each half.
1633 else if (format
== 32 && size
== sizeof (int))
1634 return INTEGER_TO_CONS (((unsigned int *) data
) [0]);
1635 else if (format
== 16 && size
== sizeof (short))
1636 return make_number ((int) (((unsigned short *) data
) [0]));
1638 /* Convert any other kind of data to a vector of numbers, represented
1639 as above (as an integer, or a cons of two 16 bit integers.)
1641 else if (format
== 16)
1645 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1646 for (i
= 0; i
< size
/ 2; i
++)
1648 int j
= (int) ((unsigned short *) data
) [i
];
1649 Faset (v
, make_number (i
), make_number (j
));
1656 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1657 for (i
= 0; i
< size
/ 4; i
++)
1659 unsigned int j
= ((unsigned int *) data
) [i
];
1660 Faset (v
, make_number (i
), INTEGER_TO_CONS (j
));
1667 /* Use xfree, not XFree, to free the data obtained with this function. */
1670 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1671 unsigned char **data_ret
, Atom
*type_ret
,
1672 unsigned int *size_ret
,
1673 int *format_ret
, int *nofree_ret
)
1675 Lisp_Object type
= Qnil
;
1676 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1680 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1684 if (CONSP (obj
) && NILP (XCDR (obj
)))
1688 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1689 { /* This is not the same as declining */
1695 else if (STRINGP (obj
))
1697 if (SCHARS (obj
) < SBYTES (obj
))
1698 /* OBJ is a multibyte string containing a non-ASCII char. */
1699 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1703 *size_ret
= SBYTES (obj
);
1704 *data_ret
= SDATA (obj
);
1707 else if (SYMBOLP (obj
))
1711 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1712 (*data_ret
) [sizeof (Atom
)] = 0;
1713 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1714 if (NILP (type
)) type
= QATOM
;
1716 else if (INTEGERP (obj
)
1717 && XINT (obj
) < 0xFFFF
1718 && XINT (obj
) > -0xFFFF)
1722 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1723 (*data_ret
) [sizeof (short)] = 0;
1724 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1725 if (NILP (type
)) type
= QINTEGER
;
1727 else if (INTEGERP (obj
)
1728 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1729 && (INTEGERP (XCDR (obj
))
1730 || (CONSP (XCDR (obj
))
1731 && INTEGERP (XCAR (XCDR (obj
)))))))
1735 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1736 (*data_ret
) [sizeof (long)] = 0;
1737 (*(unsigned long **) data_ret
) [0] = cons_to_unsigned (obj
, ULONG_MAX
);
1738 if (NILP (type
)) type
= QINTEGER
;
1740 else if (VECTORP (obj
))
1742 /* Lisp_Vectors may represent a set of ATOMs;
1743 a set of 16 or 32 bit INTEGERs;
1744 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1748 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1749 /* This vector is an ATOM set */
1751 if (NILP (type
)) type
= QATOM
;
1752 *size_ret
= ASIZE (obj
);
1754 for (i
= 0; i
< *size_ret
; i
++)
1755 if (!SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1756 signal_error ("All elements of selection vector must have same type", obj
);
1758 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1759 for (i
= 0; i
< *size_ret
; i
++)
1760 (*(Atom
**) data_ret
) [i
]
1761 = symbol_to_x_atom (dpyinfo
, XVECTOR (obj
)->contents
[i
]);
1764 /* This vector is an INTEGER set, or something like it */
1767 *size_ret
= ASIZE (obj
);
1768 if (NILP (type
)) type
= QINTEGER
;
1770 for (i
= 0; i
< *size_ret
; i
++)
1771 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1773 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1774 signal_error (/* Qselection_error */
1775 "Elements of selection vector must be integers or conses of integers",
1778 /* Use sizeof(long) even if it is more than 32 bits. See comment
1779 in x_get_window_property and x_fill_property_data. */
1781 if (*format_ret
== 32) data_size
= sizeof(long);
1782 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1783 for (i
= 0; i
< *size_ret
; i
++)
1784 if (*format_ret
== 32)
1785 (*((unsigned long **) data_ret
)) [i
] =
1786 cons_to_unsigned (XVECTOR (obj
)->contents
[i
], ULONG_MAX
);
1788 (*((unsigned short **) data_ret
)) [i
] =
1789 cons_to_unsigned (XVECTOR (obj
)->contents
[i
], USHRT_MAX
);
1793 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1795 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1799 clean_local_selection_data (Lisp_Object obj
)
1802 && INTEGERP (XCAR (obj
))
1803 && CONSP (XCDR (obj
))
1804 && INTEGERP (XCAR (XCDR (obj
)))
1805 && NILP (XCDR (XCDR (obj
))))
1806 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1809 && INTEGERP (XCAR (obj
))
1810 && INTEGERP (XCDR (obj
)))
1812 if (XINT (XCAR (obj
)) == 0)
1814 if (XINT (XCAR (obj
)) == -1)
1815 return make_number (- XINT (XCDR (obj
)));
1820 int size
= ASIZE (obj
);
1823 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1824 copy
= Fmake_vector (make_number (size
), Qnil
);
1825 for (i
= 0; i
< size
; i
++)
1826 XVECTOR (copy
)->contents
[i
]
1827 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1833 /* Called from XTread_socket to handle SelectionNotify events.
1834 If it's the selection we are waiting for, stop waiting
1835 by setting the car of reading_selection_reply to non-nil.
1836 We store t there if the reply is successful, lambda if not. */
1839 x_handle_selection_notify (XSelectionEvent
*event
)
1841 if (event
->requestor
!= reading_selection_window
)
1843 if (event
->selection
!= reading_which_selection
)
1846 TRACE0 ("Received SelectionNotify");
1847 XSETCAR (reading_selection_reply
,
1848 (event
->property
!= 0 ? Qt
: Qlambda
));
1852 /* From a Lisp_Object, return a suitable frame for selection
1853 operations. OBJECT may be a frame, a terminal object, or nil
1854 (which stands for the selected frame--or, if that is not an X
1855 frame, the first X display on the list). If no suitable frame can
1856 be found, return NULL. */
1858 static struct frame
*
1859 frame_for_x_selection (Lisp_Object object
)
1866 f
= XFRAME (selected_frame
);
1867 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1870 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1872 f
= XFRAME (XCAR (tail
));
1873 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1877 else if (TERMINALP (object
))
1879 struct terminal
*t
= get_terminal (object
, 1);
1880 if (t
->type
== output_x_window
)
1882 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1884 f
= XFRAME (XCAR (tail
));
1885 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1890 else if (FRAMEP (object
))
1892 f
= XFRAME (object
);
1893 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1901 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1902 Sx_own_selection_internal
, 2, 3, 0,
1903 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1904 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1905 \(Those are literal upper-case symbol names, since that's what X expects.)
1906 VALUE is typically a string, or a cons of two markers, but may be
1907 anything that the functions on `selection-converter-alist' know about.
1909 FRAME should be a frame that should own the selection. If omitted or
1910 nil, it defaults to the selected frame. */)
1911 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1913 if (NILP (frame
)) frame
= selected_frame
;
1914 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1915 error ("X selection unavailable for this frame");
1917 CHECK_SYMBOL (selection
);
1918 if (NILP (value
)) error ("VALUE may not be nil");
1919 x_own_selection (selection
, value
, frame
);
1924 /* Request the selection value from the owner. If we are the owner,
1925 simply return our selection value. If we are not the owner, this
1926 will block until all of the data has arrived. */
1928 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1929 Sx_get_selection_internal
, 2, 4, 0,
1930 doc
: /* Return text selected from some X window.
1931 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1932 \(Those are literal upper-case symbol names, since that's what X expects.)
1933 TYPE is the type of data desired, typically `STRING'.
1934 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1935 selections. If omitted, defaults to the time for the last event.
1937 TERMINAL should be a terminal object or a frame specifying the X
1938 server to query. If omitted or nil, that stands for the selected
1939 frame's display, or the first available X display. */)
1940 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1941 Lisp_Object time_stamp
, Lisp_Object terminal
)
1943 Lisp_Object val
= Qnil
;
1944 struct gcpro gcpro1
, gcpro2
;
1945 struct frame
*f
= frame_for_x_selection (terminal
);
1946 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1948 CHECK_SYMBOL (selection_symbol
);
1949 CHECK_SYMBOL (target_type
);
1950 if (EQ (target_type
, QMULTIPLE
))
1951 error ("Retrieving MULTIPLE selections is currently unimplemented");
1953 error ("X selection unavailable for this frame");
1955 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
1956 FRAME_X_DISPLAY_INFO (f
));
1958 if (NILP (val
) && FRAME_LIVE_P (f
))
1961 XSETFRAME (frame
, f
);
1962 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
1963 time_stamp
, frame
));
1966 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
1969 if (CONSP (val
) && NILP (XCDR (val
)))
1972 RETURN_UNGCPRO (clean_local_selection_data (val
));
1975 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
1976 Sx_disown_selection_internal
, 1, 3, 0,
1977 doc
: /* If we own the selection SELECTION, disown it.
1978 Disowning it means there is no such selection.
1980 TERMINAL should be a terminal object or a frame specifying the X
1981 server to query. If omitted or nil, that stands for the selected
1982 frame's display, or the first available X display. */)
1983 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
1986 Atom selection_atom
;
1988 struct selection_input_event sie
;
1989 struct input_event ie
;
1991 struct frame
*f
= frame_for_x_selection (terminal
);
1992 struct x_display_info
*dpyinfo
;
1997 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1998 CHECK_SYMBOL (selection
);
2000 /* Don't disown the selection when we're not the owner. */
2001 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2004 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2007 if (NILP (time_object
))
2008 timestamp
= last_event_timestamp
;
2010 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2011 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2014 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2015 generated for a window which owns the selection when that window sets
2016 the selection owner to None. The NCD server does, the MIT Sun4 server
2017 doesn't. So we synthesize one; this means we might get two, but
2018 that's ok, because the second one won't have any effect. */
2019 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2020 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2021 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2022 x_handle_selection_clear (&event
.ie
);
2027 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2029 doc
: /* Whether the current Emacs process owns the given X Selection.
2030 The arg should be the name of the selection in question, typically one of
2031 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2032 \(Those are literal upper-case symbol names, since that's what X expects.)
2033 For convenience, the symbol nil is the same as `PRIMARY',
2034 and t is the same as `SECONDARY'.
2036 TERMINAL should be a terminal object or a frame specifying the X
2037 server to query. If omitted or nil, that stands for the selected
2038 frame's display, or the first available X display. */)
2039 (Lisp_Object selection
, Lisp_Object terminal
)
2041 struct frame
*f
= frame_for_x_selection (terminal
);
2043 CHECK_SYMBOL (selection
);
2044 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2045 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2047 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2053 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2055 doc
: /* Whether there is an owner for the given X selection.
2056 SELECTION should be the name of the selection in question, typically
2057 one of the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'. (X expects
2058 these literal upper-case names.) The symbol nil is the same as
2059 `PRIMARY', and t is the same as `SECONDARY'.
2061 TERMINAL should be a terminal object or a frame specifying the X
2062 server to query. If omitted or nil, that stands for the selected
2063 frame's display, or the first available X display. */)
2064 (Lisp_Object selection
, Lisp_Object terminal
)
2068 struct frame
*f
= frame_for_x_selection (terminal
);
2069 struct x_display_info
*dpyinfo
;
2071 CHECK_SYMBOL (selection
);
2072 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2073 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2078 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2080 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2083 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2084 if (atom
== 0) return Qnil
;
2086 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2088 return (owner
? Qt
: Qnil
);
2092 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2093 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2096 x_clipboard_manager_save (Lisp_Object frame
)
2098 struct frame
*f
= XFRAME (frame
);
2099 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2100 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2102 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2103 dpyinfo
->Xatom_EMACS_TMP
,
2104 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2105 (unsigned char *) &data
, 1);
2106 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2111 /* Error handler for x_clipboard_manager_save_frame. */
2114 x_clipboard_manager_error_1 (Lisp_Object err
)
2116 Lisp_Object args
[2];
2117 args
[0] = build_string ("X clipboard manager error: %s\n\
2118 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2119 args
[1] = CAR (CDR (err
));
2124 /* Error handler for x_clipboard_manager_save_all. */
2127 x_clipboard_manager_error_2 (Lisp_Object err
)
2129 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2130 If the problem persists, set `x-select-enable-clipboard-manager' \
2135 /* Called from delete_frame: save any clipboard owned by FRAME to the
2136 clipboard manager. Do nothing if FRAME does not own the clipboard,
2137 or if no clipboard manager is present. */
2140 x_clipboard_manager_save_frame (Lisp_Object frame
)
2144 if (!NILP (Vx_select_enable_clipboard_manager
)
2146 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2147 && FRAME_LIVE_P (f
))
2149 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2150 Lisp_Object local_selection
2151 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2153 if (!NILP (local_selection
)
2154 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2155 && XGetSelectionOwner (dpyinfo
->display
,
2156 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2157 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2158 x_clipboard_manager_error_1
);
2162 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2163 clipboard manager. Do nothing if FRAME does not own the clipboard,
2164 or if no clipboard manager is present. */
2167 x_clipboard_manager_save_all (void)
2169 /* Loop through all X displays, saving owned clipboards. */
2170 struct x_display_info
*dpyinfo
;
2171 Lisp_Object local_selection
, local_frame
;
2173 if (NILP (Vx_select_enable_clipboard_manager
))
2176 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2178 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2179 if (NILP (local_selection
)
2180 || !XGetSelectionOwner (dpyinfo
->display
,
2181 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2184 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2185 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2186 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2187 Qt
, x_clipboard_manager_error_2
);
2192 /***********************************************************************
2193 Drag and drop support
2194 ***********************************************************************/
2195 /* Check that lisp values are of correct type for x_fill_property_data.
2196 That is, number, string or a cons with two numbers (low and high 16
2197 bit parts of a 32 bit number). Return the number of items in DATA,
2198 or -1 if there is an error. */
2201 x_check_property_data (Lisp_Object data
)
2206 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2208 Lisp_Object o
= XCAR (iter
);
2210 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2212 else if (CONSP (o
) &&
2213 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2221 /* Convert lisp values to a C array. Values may be a number, a string
2222 which is taken as an X atom name and converted to the atom value, or
2223 a cons containing the two 16 bit parts of a 32 bit number.
2225 DPY is the display use to look up X atoms.
2226 DATA is a Lisp list of values to be converted.
2227 RET is the C array that contains the converted values. It is assumed
2228 it is big enough to hold all values.
2229 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2230 be stored in RET. Note that long is used for 32 even if long is more
2231 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2232 XClientMessageEvent). */
2235 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2238 long *d32
= (long *) ret
;
2239 short *d16
= (short *) ret
;
2240 char *d08
= (char *) ret
;
2243 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2245 Lisp_Object o
= XCAR (iter
);
2247 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2248 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2249 else if (STRINGP (o
))
2252 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2256 error ("Wrong type, must be string, number or cons");
2260 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2263 error ("Out of 'char' range");
2265 else if (format
== 16)
2267 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2270 error ("Out of 'short' range");
2277 /* Convert an array of C values to a Lisp list.
2278 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2279 DATA is a C array of values to be converted.
2280 TYPE is the type of the data. Only XA_ATOM is special, it converts
2281 each number in DATA to its corresponfing X atom as a symbol.
2282 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2284 SIZE is the number of elements in DATA.
2286 Important: When format is 32, data should contain an array of int,
2287 not an array of long as the X library returns. This makes a difference
2288 when sizeof(long) != sizeof(int).
2290 Also see comment for selection_data_to_lisp_data above. */
2293 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2294 Atom type
, int format
, long unsigned int size
)
2296 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2297 data
, size
*format
/8, type
, format
);
2300 /* Get the mouse position in frame relative coordinates. */
2303 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2305 Window root
, dummy_window
;
2310 XQueryPointer (FRAME_X_DISPLAY (f
),
2311 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2313 /* The root window which contains the pointer. */
2316 /* Window pointer is on, not used */
2319 /* The position on that root window. */
2322 /* x/y in dummy_window coordinates, not used. */
2325 /* Modifier keys and pointer buttons, about which
2327 (unsigned int *) &dummy
);
2330 /* Absolute to relative. */
2331 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2332 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2337 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2338 Sx_get_atom_name
, 1, 2, 0,
2339 doc
: /* Return the X atom name for VALUE as a string.
2340 VALUE may be a number or a cons where the car is the upper 16 bits and
2341 the cdr is the lower 16 bits of a 32 bit value.
2342 Use the display for FRAME or the current frame if FRAME is not given or nil.
2344 If the value is 0 or the atom is not known, return the empty string. */)
2345 (Lisp_Object value
, Lisp_Object frame
)
2347 struct frame
*f
= check_x_frame (frame
);
2350 Lisp_Object ret
= Qnil
;
2351 Display
*dpy
= FRAME_X_DISPLAY (f
);
2355 CONS_TO_INTEGER (value
, Atom
, atom
);
2358 x_catch_errors (dpy
);
2359 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2360 had_errors
= x_had_errors_p (dpy
);
2361 x_uncatch_errors ();
2364 ret
= make_string (name
, strlen (name
));
2366 if (atom
&& name
) XFree (name
);
2367 if (NILP (ret
)) ret
= empty_unibyte_string
;
2374 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2375 Sx_register_dnd_atom
, 1, 2, 0,
2376 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2377 ATOM can be a symbol or a string. The ATOM is interned on the display that
2378 FRAME is on. If FRAME is nil, the selected frame is used. */)
2379 (Lisp_Object atom
, Lisp_Object frame
)
2382 struct frame
*f
= check_x_frame (frame
);
2384 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2388 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2389 else if (STRINGP (atom
))
2392 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2396 error ("ATOM must be a symbol or a string");
2398 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2399 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2402 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2404 dpyinfo
->x_dnd_atoms_size
*= 2;
2405 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2406 sizeof (*dpyinfo
->x_dnd_atoms
)
2407 * dpyinfo
->x_dnd_atoms_size
);
2410 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2414 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2417 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2421 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2422 unsigned long size
= 160/event
->format
;
2424 unsigned char *data
= (unsigned char *) event
->data
.b
;
2428 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2429 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2431 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2433 XSETFRAME (frame
, f
);
2435 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2436 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2437 function expects them to be of size int (i.e. 32). So to be able to
2438 use that function, put the data in the form it expects if format is 32. */
2440 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2442 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2443 idata
[i
] = (int) event
->data
.l
[i
];
2444 data
= (unsigned char *) idata
;
2447 vec
= Fmake_vector (make_number (4), Qnil
);
2448 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2449 event
->message_type
)));
2450 ASET (vec
, 1, frame
);
2451 ASET (vec
, 2, make_number (event
->format
));
2452 ASET (vec
, 3, x_property_data_to_lisp (f
,
2454 event
->message_type
,
2458 mouse_position_for_drop (f
, &x
, &y
);
2459 bufp
->kind
= DRAG_N_DROP_EVENT
;
2460 bufp
->frame_or_window
= frame
;
2461 bufp
->timestamp
= CurrentTime
;
2462 bufp
->x
= make_number (x
);
2463 bufp
->y
= make_number (y
);
2465 bufp
->modifiers
= 0;
2470 DEFUN ("x-send-client-message", Fx_send_client_event
,
2471 Sx_send_client_message
, 6, 6, 0,
2472 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2474 For DISPLAY, specify either a frame or a display name (a string).
2475 If DISPLAY is nil, that stands for the selected frame's display.
2476 DEST may be a number, in which case it is a Window id. The value 0 may
2477 be used to send to the root window of the DISPLAY.
2478 If DEST is a cons, it is converted to a 32 bit number
2479 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2480 number is then used as a window id.
2481 If DEST is a frame the event is sent to the outer window of that frame.
2482 A value of nil means the currently selected frame.
2483 If DEST is the string "PointerWindow" the event is sent to the window that
2484 contains the pointer. If DEST is the string "InputFocus" the event is
2485 sent to the window that has the input focus.
2486 FROM is the frame sending the event. Use nil for currently selected frame.
2487 MESSAGE-TYPE is the name of an Atom as a string.
2488 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2489 bits. VALUES is a list of numbers, cons and/or strings containing the values
2490 to send. If a value is a string, it is converted to an Atom and the value of
2491 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2492 with the high 16 bits from the car and the lower 16 bit from the cdr.
2493 If more values than fits into the event is given, the excessive values
2495 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2497 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2499 CHECK_STRING (message_type
);
2500 x_send_client_event(display
, dest
, from
,
2501 XInternAtom (dpyinfo
->display
,
2502 SSDATA (message_type
),
2510 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2512 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2515 struct frame
*f
= check_x_frame (from
);
2518 CHECK_NUMBER (format
);
2519 CHECK_CONS (values
);
2521 if (x_check_property_data (values
) == -1)
2522 error ("Bad data in VALUES, must be number, cons or string");
2524 event
.xclient
.type
= ClientMessage
;
2525 event
.xclient
.format
= XFASTINT (format
);
2527 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2528 && event
.xclient
.format
!= 32)
2529 error ("FORMAT must be one of 8, 16 or 32");
2531 if (FRAMEP (dest
) || NILP (dest
))
2533 struct frame
*fdest
= check_x_frame (dest
);
2534 wdest
= FRAME_OUTER_WINDOW (fdest
);
2536 else if (STRINGP (dest
))
2538 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2539 wdest
= PointerWindow
;
2540 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2543 error ("DEST as a string must be one of PointerWindow or InputFocus");
2545 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2546 CONS_TO_INTEGER (dest
, Window
, wdest
);
2548 error ("DEST must be a frame, nil, string, number or cons");
2550 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2551 to_root
= wdest
== dpyinfo
->root_window
;
2555 event
.xclient
.message_type
= message_type
;
2556 event
.xclient
.display
= dpyinfo
->display
;
2558 /* Some clients (metacity for example) expects sending window to be here
2559 when sending to the root window. */
2560 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2563 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2564 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2565 event
.xclient
.format
);
2567 /* If event mask is 0 the event is sent to the client that created
2568 the destination window. But if we are sending to the root window,
2569 there is no such client. Then we set the event mask to 0xffff. The
2570 event then goes to clients selecting for events on the root window. */
2571 x_catch_errors (dpyinfo
->display
);
2573 int propagate
= to_root
? False
: True
;
2574 unsigned mask
= to_root
? 0xffff : 0;
2575 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2576 XFlush (dpyinfo
->display
);
2578 x_uncatch_errors ();
2584 syms_of_xselect (void)
2586 defsubr (&Sx_get_selection_internal
);
2587 defsubr (&Sx_own_selection_internal
);
2588 defsubr (&Sx_disown_selection_internal
);
2589 defsubr (&Sx_selection_owner_p
);
2590 defsubr (&Sx_selection_exists_p
);
2592 defsubr (&Sx_get_atom_name
);
2593 defsubr (&Sx_send_client_message
);
2594 defsubr (&Sx_register_dnd_atom
);
2596 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2597 staticpro (&reading_selection_reply
);
2598 reading_selection_window
= 0;
2599 reading_which_selection
= 0;
2601 property_change_wait_list
= 0;
2602 prop_location_identifier
= 0;
2603 property_change_reply
= Fcons (Qnil
, Qnil
);
2604 staticpro (&property_change_reply
);
2606 converted_selections
= NULL
;
2607 conversion_fail_tag
= None
;
2609 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2610 doc
: /* An alist associating X Windows selection-types with functions.
2611 These functions are called to convert the selection, with three args:
2612 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2613 a desired type to which the selection should be converted;
2614 and the local selection value (whatever was given to `x-own-selection').
2616 The function should return the value to send to the X server
2617 \(typically a string). A return value of nil
2618 means that the conversion could not be done.
2619 A return value which is the symbol `NULL'
2620 means that a side-effect was executed,
2621 and there is no meaningful selection value. */);
2622 Vselection_converter_alist
= Qnil
;
2624 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2625 doc
: /* A list of functions to be called when Emacs loses an X selection.
2626 \(This happens when some other X client makes its own selection
2627 or when a Lisp program explicitly clears the selection.)
2628 The functions are called with one argument, the selection type
2629 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2630 Vx_lost_selection_functions
= Qnil
;
2632 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2633 doc
: /* A list of functions to be called when Emacs answers a selection request.
2634 The functions are called with three arguments:
2635 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2636 - the selection-type which Emacs was asked to convert the
2637 selection into before sending (for example, `STRING' or `LENGTH');
2638 - a flag indicating success or failure for responding to the request.
2639 We might have failed (and declined the request) for any number of reasons,
2640 including being asked for a selection that we no longer own, or being asked
2641 to convert into a type that we don't know about or that is inappropriate.
2642 This hook doesn't let you change the behavior of Emacs's selection replies,
2643 it merely informs you that they have happened. */);
2644 Vx_sent_selection_functions
= Qnil
;
2646 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2647 Vx_select_enable_clipboard_manager
,
2648 doc
: /* Whether to enable X clipboard manager support.
2649 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2650 while owning the X clipboard, the clipboard contents are saved to the
2651 clipboard manager if one is present. */);
2652 Vx_select_enable_clipboard_manager
= Qt
;
2654 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2655 doc
: /* Number of milliseconds to wait for a selection reply.
2656 If the selection owner doesn't reply in this time, we give up.
2657 A value of 0 means wait as long as necessary. This is initialized from the
2658 \"*selectionTimeout\" resource. */);
2659 x_selection_timeout
= 0;
2661 /* QPRIMARY is defined in keyboard.c. */
2662 DEFSYM (QSECONDARY
, "SECONDARY");
2663 DEFSYM (QSTRING
, "STRING");
2664 DEFSYM (QINTEGER
, "INTEGER");
2665 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2666 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2667 DEFSYM (QTEXT
, "TEXT");
2668 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2669 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2670 DEFSYM (QDELETE
, "DELETE");
2671 DEFSYM (QMULTIPLE
, "MULTIPLE");
2672 DEFSYM (QINCR
, "INCR");
2673 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2674 DEFSYM (QTARGETS
, "TARGETS");
2675 DEFSYM (QATOM
, "ATOM");
2676 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2677 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2678 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2679 DEFSYM (QNULL
, "NULL");
2680 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2681 DEFSYM (Qforeign_selection
, "foreign-selection");