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
*, Display
*,
51 static void x_own_selection (Lisp_Object
, Lisp_Object
);
52 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int);
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
some_frame_on_display (struct x_display_info
*);
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
,
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
,
70 static void x_get_window_property (Display
*, Window
, Atom
,
71 unsigned char **, int *,
72 Atom
*, int *, unsigned long *, int);
73 static void receive_incremental_selection (Display
*, Window
, Atom
,
74 Lisp_Object
, unsigned,
75 unsigned char **, int *,
76 Atom
*, int *, unsigned long *);
77 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
80 static Lisp_Object
selection_data_to_lisp_data (Display
*,
81 const unsigned char *,
83 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
84 unsigned char **, Atom
*,
85 unsigned *, int *, int *);
86 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
88 /* Printing traces to stderr. */
90 #ifdef TRACE_SELECTION
92 fprintf (stderr, "%d: " fmt "\n", getpid ())
93 #define TRACE1(fmt, a0) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
95 #define TRACE2(fmt, a0, a1) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
97 #define TRACE3(fmt, a0, a1, a2) \
98 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
100 #define TRACE0(fmt) (void) 0
101 #define TRACE1(fmt, a0) (void) 0
102 #define TRACE2(fmt, a0, a1) (void) 0
106 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
107 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
110 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
111 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
113 static Lisp_Object Qcompound_text_with_extensions
;
115 static Lisp_Object Qforeign_selection
;
117 /* If this is a smaller number than the max-request-size of the display,
118 emacs will use INCR selection transfer when the selection is larger
119 than this. The max-request-size is usually around 64k, so if you want
120 emacs to use incremental selection transfers when the selection is
121 smaller than that, set this. I added this mostly for debugging the
122 incremental transfer stuff, but it might improve server performance. */
123 #define MAX_SELECTION_QUANTUM 0xFFFFFF
125 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
127 /* This is an association list whose elements are of the form
128 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
129 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
130 SELECTION-VALUE is the value that emacs owns for that selection.
131 It may be any kind of Lisp object.
132 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
133 as a cons of two 16-bit numbers (making a 32 bit time.)
134 FRAME is the frame for which we made the selection.
135 If there is an entry in this alist, then it can be assumed that Emacs owns
137 The only (eq) parts of this list that are visible from Lisp are the
139 static Lisp_Object Vselection_alist
;
143 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
146 struct selection_event_queue
148 struct input_event event
;
149 struct selection_event_queue
*next
;
152 static struct selection_event_queue
*selection_queue
;
154 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
156 static int x_queue_selection_requests
;
158 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
161 x_queue_event (struct input_event
*event
)
163 struct selection_event_queue
*queue_tmp
;
165 /* Don't queue repeated requests.
166 This only happens for large requests which uses the incremental protocol. */
167 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
169 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
171 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
172 x_decline_selection_request (event
);
178 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
180 if (queue_tmp
!= NULL
)
182 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
183 queue_tmp
->event
= *event
;
184 queue_tmp
->next
= selection_queue
;
185 selection_queue
= queue_tmp
;
189 /* Start queuing SELECTION_REQUEST_EVENT events. */
192 x_start_queuing_selection_requests (void)
194 if (x_queue_selection_requests
)
197 x_queue_selection_requests
++;
198 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
201 /* Stop queuing SELECTION_REQUEST_EVENT events. */
204 x_stop_queuing_selection_requests (void)
206 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
207 --x_queue_selection_requests
;
209 /* Take all the queued events and put them back
210 so that they get processed afresh. */
212 while (selection_queue
!= NULL
)
214 struct selection_event_queue
*queue_tmp
= selection_queue
;
215 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
216 kbd_buffer_unget_event (&queue_tmp
->event
);
217 selection_queue
= queue_tmp
->next
;
218 xfree ((char *)queue_tmp
);
223 /* This converts a Lisp symbol to a server Atom, avoiding a server
224 roundtrip whenever possible. */
227 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Display
*display
, Lisp_Object sym
)
230 if (NILP (sym
)) return 0;
231 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
232 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
233 if (EQ (sym
, QSTRING
)) return XA_STRING
;
234 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
235 if (EQ (sym
, QATOM
)) return XA_ATOM
;
236 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
237 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
238 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
239 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
240 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
241 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
242 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
243 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
244 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
245 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
246 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
247 if (!SYMBOLP (sym
)) abort ();
249 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
251 val
= XInternAtom (display
, SSDATA (SYMBOL_NAME (sym
)), False
);
257 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
258 and calls to intern whenever possible. */
261 x_atom_to_symbol (Display
*dpy
, Atom atom
)
263 struct x_display_info
*dpyinfo
;
284 dpyinfo
= x_display_info_for_display (dpy
);
285 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
287 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
289 if (atom
== dpyinfo
->Xatom_TEXT
)
291 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
292 return QCOMPOUND_TEXT
;
293 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
295 if (atom
== dpyinfo
->Xatom_DELETE
)
297 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
299 if (atom
== dpyinfo
->Xatom_INCR
)
301 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
303 if (atom
== dpyinfo
->Xatom_TARGETS
)
305 if (atom
== dpyinfo
->Xatom_NULL
)
309 str
= XGetAtomName (dpy
, atom
);
311 TRACE1 ("XGetAtomName --> %s", str
);
312 if (! str
) return Qnil
;
315 /* This was allocated by Xlib, so use XFree. */
321 /* Do protocol to assert ourself as a selection owner.
322 Update the Vselection_alist so that we can reply to later requests for
326 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
)
328 struct frame
*sf
= SELECTED_FRAME ();
329 Window selecting_window
;
331 Time timestamp
= last_event_timestamp
;
333 struct x_display_info
*dpyinfo
;
335 if (! FRAME_X_P (sf
))
338 selecting_window
= FRAME_X_WINDOW (sf
);
339 display
= FRAME_X_DISPLAY (sf
);
340 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
342 CHECK_SYMBOL (selection_name
);
343 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
346 x_catch_errors (display
);
347 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
348 x_check_errors (display
, "Can't set selection: %s");
352 /* Now update the local cache */
354 Lisp_Object selection_time
;
355 Lisp_Object selection_data
;
356 Lisp_Object prev_value
;
358 selection_time
= long_to_cons (timestamp
);
359 selection_data
= list4 (selection_name
, selection_value
,
360 selection_time
, selected_frame
);
361 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
363 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
365 /* If we already owned the selection, remove the old selection data.
366 Perhaps we should destructively modify it instead.
367 Don't use Fdelq as that may QUIT. */
368 if (!NILP (prev_value
))
370 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
371 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
372 if (EQ (prev_value
, Fcar (XCDR (rest
))))
374 XSETCDR (rest
, Fcdr (XCDR (rest
)));
381 /* Given a selection-name and desired type, look up our local copy of
382 the selection value and convert it to the type.
383 The value is nil or a string.
384 This function is used both for remote requests (LOCAL_REQUEST is zero)
385 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
387 This calls random Lisp code, and may signal or gc. */
390 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, int local_request
)
392 Lisp_Object local_value
;
393 Lisp_Object handler_fn
, value
, check
;
396 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
398 if (NILP (local_value
)) return Qnil
;
400 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
401 if (EQ (target_type
, QTIMESTAMP
))
404 value
= XCAR (XCDR (XCDR (local_value
)));
408 /* Don't allow a quit within the converter.
409 When the user types C-g, he would be surprised
410 if by luck it came during a converter. */
411 count
= SPECPDL_INDEX ();
412 specbind (Qinhibit_quit
, Qt
);
414 CHECK_SYMBOL (target_type
);
415 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
416 /* gcpro is not needed here since nothing but HANDLER_FN
417 is live, and that ought to be a symbol. */
419 if (!NILP (handler_fn
))
420 value
= call3 (handler_fn
,
421 selection_symbol
, (local_request
? Qnil
: target_type
),
422 XCAR (XCDR (local_value
)));
425 unbind_to (count
, Qnil
);
428 /* Make sure this value is of a type that we could transmit
429 to another X client. */
433 && SYMBOLP (XCAR (value
)))
434 check
= XCDR (value
);
442 /* Check for a value that cons_to_long could handle. */
443 else if (CONSP (check
)
444 && INTEGERP (XCAR (check
))
445 && (INTEGERP (XCDR (check
))
447 (CONSP (XCDR (check
))
448 && INTEGERP (XCAR (XCDR (check
)))
449 && NILP (XCDR (XCDR (check
))))))
452 signal_error ("Invalid data returned by selection-conversion function",
453 list2 (handler_fn
, value
));
456 /* Subroutines of x_reply_selection_request. */
458 /* Send a SelectionNotify event to the requestor with property=None,
459 meaning we were unable to do what they wanted. */
462 x_decline_selection_request (struct input_event
*event
)
465 XSelectionEvent
*reply
= &(reply_base
.xselection
);
467 reply
->type
= SelectionNotify
;
468 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
469 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
470 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
471 reply
->time
= SELECTION_EVENT_TIME (event
);
472 reply
->target
= SELECTION_EVENT_TARGET (event
);
473 reply
->property
= None
;
475 /* The reason for the error may be that the receiver has
476 died in the meantime. Handle that case. */
478 x_catch_errors (reply
->display
);
479 XSendEvent (reply
->display
, reply
->requestor
, False
, 0L, &reply_base
);
480 XFlush (reply
->display
);
485 /* This is the selection request currently being processed.
486 It is set to zero when the request is fully processed. */
487 static struct input_event
*x_selection_current_request
;
489 /* Display info in x_selection_request. */
491 static struct x_display_info
*selection_request_dpyinfo
;
493 /* Raw selection data, for sending to a requestor window. */
495 struct selection_data
503 /* This can be set to non-NULL during x_reply_selection_request, if
504 the selection is waiting for an INCR transfer to complete. Don't
505 free these; that's done by unexpect_property_change. */
506 struct prop_location
*wait_object
;
507 struct selection_data
*next
;
510 /* Linked list of the above (in support of MULTIPLE targets). */
512 struct selection_data
*converted_selections
;
514 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
515 Atom conversion_fail_tag
;
517 /* Used as an unwind-protect clause so that, if a selection-converter signals
518 an error, we tell the requester that we were unable to do what they wanted
519 before we throw to top-level or go into the debugger or whatever. */
522 x_selection_request_lisp_error (Lisp_Object ignore
)
524 struct selection_data
*cs
, *next
;
526 for (cs
= converted_selections
; cs
; cs
= next
)
529 if (cs
->nofree
== 0 && cs
->data
)
533 converted_selections
= NULL
;
535 if (x_selection_current_request
!= 0
536 && selection_request_dpyinfo
->display
)
537 x_decline_selection_request (x_selection_current_request
);
542 x_catch_errors_unwind (Lisp_Object dummy
)
551 /* This stuff is so that INCR selections are reentrant (that is, so we can
552 be servicing multiple INCR selection requests simultaneously.) I haven't
553 actually tested that yet. */
555 /* Keep a list of the property changes that are awaited. */
565 struct prop_location
*next
;
568 static struct prop_location
*expect_property_change (Display
*display
, Window window
, Atom property
, int state
);
569 static void wait_for_property_change (struct prop_location
*location
);
570 static void unexpect_property_change (struct prop_location
*location
);
571 static int waiting_for_other_props_on_window (Display
*display
, Window window
);
573 static int prop_location_identifier
;
575 static Lisp_Object property_change_reply
;
577 static struct prop_location
*property_change_reply_object
;
579 static struct prop_location
*property_change_wait_list
;
582 queue_selection_requests_unwind (Lisp_Object tem
)
584 x_stop_queuing_selection_requests ();
588 /* Return some frame whose display info is DPYINFO.
589 Return nil if there is none. */
592 some_frame_on_display (struct x_display_info
*dpyinfo
)
594 Lisp_Object list
, frame
;
596 FOR_EACH_FRAME (list
, frame
)
598 if (FRAME_X_P (XFRAME (frame
))
599 && FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
606 /* Send the reply to a selection request event EVENT. */
608 #ifdef TRACE_SELECTION
609 static int x_reply_selection_request_cnt
;
610 #endif /* TRACE_SELECTION */
613 x_reply_selection_request (struct input_event
*event
, struct x_display_info
*dpyinfo
)
616 XSelectionEvent
*reply
= &(reply_base
.xselection
);
617 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
618 Window window
= SELECTION_EVENT_REQUESTOR (event
);
620 int max_bytes
= SELECTION_QUANTUM (display
);
621 int count
= SPECPDL_INDEX ();
622 struct selection_data
*cs
;
624 if (max_bytes
> MAX_SELECTION_QUANTUM
)
625 max_bytes
= MAX_SELECTION_QUANTUM
;
627 reply
->type
= SelectionNotify
;
628 reply
->display
= display
;
629 reply
->requestor
= window
;
630 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
631 reply
->time
= SELECTION_EVENT_TIME (event
);
632 reply
->target
= SELECTION_EVENT_TARGET (event
);
633 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
634 if (reply
->property
== None
)
635 reply
->property
= reply
->target
;
638 /* The protected block contains wait_for_property_change, which can
639 run random lisp code (process handlers) or signal. Therefore, we
640 put the x_uncatch_errors call in an unwind. */
641 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
642 x_catch_errors (display
);
644 /* Loop over converted selections, storing them in the requested
645 properties. If data is large, only store the first N bytes
646 (section 2.7.2 of ICCCM). Note that we store the data for a
647 MULTIPLE request in the opposite order; the ICCM says only that
648 the conversion itself must be done in the same order. */
649 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
651 if (cs
->property
!= None
)
653 bytes_remaining
= cs
->size
* (cs
->format
/ 8);
654 if (bytes_remaining
<= max_bytes
)
656 /* Send all the data at once, with minimal handshaking. */
657 TRACE1 ("Sending all %d bytes", bytes_remaining
);
658 XChangeProperty (display
, window
, cs
->property
,
659 cs
->type
, cs
->format
, PropModeReplace
,
664 /* Send an INCR tag to initiate incremental transfer. */
667 TRACE2 ("Start sending %d bytes incrementally (%s)",
668 bytes_remaining
, XGetAtomName (display
, cs
->property
));
670 = expect_property_change (display
, window
, cs
->property
,
673 /* XChangeProperty expects an array of long even if long
674 is more than 32 bits. */
675 value
[0] = bytes_remaining
;
676 XChangeProperty (display
, window
, cs
->property
,
677 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
678 (unsigned char *) value
, 1);
679 XSelectInput (display
, window
, PropertyChangeMask
);
684 /* Now issue the SelectionNotify event. */
685 XSendEvent (display
, window
, False
, 0L, &reply_base
);
688 #ifdef TRACE_SELECTION
690 char *sel
= XGetAtomName (display
, reply
->selection
);
691 char *tgt
= XGetAtomName (display
, reply
->target
);
692 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
693 sel
, tgt
, ++x_reply_selection_request_cnt
);
694 if (sel
) XFree (sel
);
695 if (tgt
) XFree (tgt
);
697 #endif /* TRACE_SELECTION */
699 /* Finish sending the rest of each of the INCR values. This should
700 be improved; there's a chance of deadlock if more than one
701 subtarget in a MULTIPLE selection requires an INCR transfer, and
702 the requestor and Emacs loop waiting on different transfers. */
703 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
706 int format_bytes
= cs
->format
/ 8;
707 int had_errors
= x_had_errors_p (display
);
710 bytes_remaining
= cs
->size
* format_bytes
;
712 /* Wait for the requester to ack by deleting the property.
713 This can run Lisp code (process handlers) or signal. */
716 TRACE1 ("Waiting for ACK (deletion of %s)",
717 XGetAtomName (display
, cs
->property
));
718 wait_for_property_change (cs
->wait_object
);
721 unexpect_property_change (cs
->wait_object
);
723 while (bytes_remaining
)
725 int i
= ((bytes_remaining
< max_bytes
)
727 : max_bytes
) / format_bytes
;
731 = expect_property_change (display
, window
, cs
->property
,
734 TRACE1 ("Sending increment of %d elements", i
);
735 TRACE1 ("Set %s to increment data",
736 XGetAtomName (display
, cs
->property
));
738 /* Append the next chunk of data to the property. */
739 XChangeProperty (display
, window
, cs
->property
,
740 cs
->type
, cs
->format
, PropModeAppend
,
742 bytes_remaining
-= i
* format_bytes
;
743 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long) : format_bytes
);
745 had_errors
= x_had_errors_p (display
);
748 if (had_errors
) break;
750 /* Wait for the requester to ack this chunk by deleting
751 the property. This can run Lisp code or signal. */
752 TRACE1 ("Waiting for increment ACK (deletion of %s)",
753 XGetAtomName (display
, cs
->property
));
754 wait_for_property_change (cs
->wait_object
);
757 /* Now write a zero-length chunk to the property to tell the
758 requester that we're done. */
760 if (! waiting_for_other_props_on_window (display
, window
))
761 XSelectInput (display
, window
, 0L);
763 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
764 XGetAtomName (display
, cs
->property
));
765 XChangeProperty (display
, window
, cs
->property
,
766 cs
->type
, cs
->format
, PropModeReplace
,
768 TRACE0 ("Done sending incrementally");
771 /* rms, 2003-01-03: I think I have fixed this bug. */
772 /* The window we're communicating with may have been deleted
773 in the meantime (that's a real situation from a bug report).
774 In this case, there may be events in the event queue still
775 refering to the deleted window, and we'll get a BadWindow error
776 in XTread_socket when processing the events. I don't have
777 an idea how to fix that. gerd, 2001-01-98. */
778 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
779 delivered before uncatch errors. */
780 XSync (display
, False
);
783 /* GTK queues events in addition to the queue in Xlib. So we
784 UNBLOCK to enter the event loop and get possible errors delivered,
785 and then BLOCK again because x_uncatch_errors requires it. */
787 /* This calls x_uncatch_errors. */
788 unbind_to (count
, Qnil
);
792 /* Handle a SelectionRequest event EVENT.
793 This is called from keyboard.c when such an event is found in the queue. */
796 x_handle_selection_request (struct input_event
*event
)
798 struct gcpro gcpro1
, gcpro2
;
799 Time local_selection_time
;
801 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
802 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
804 Atom selection
= SELECTION_EVENT_SELECTION (event
);
805 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
806 Atom target
= SELECTION_EVENT_TARGET (event
);
807 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
808 Atom property
= SELECTION_EVENT_PROPERTY (event
);
809 Lisp_Object local_selection_data
810 = assq_no_quit (selection_symbol
, Vselection_alist
);
812 int count
= SPECPDL_INDEX ();
814 GCPRO2 (local_selection_data
, target_symbol
);
816 /* Decline if we don't own any selections. */
817 if (NILP (local_selection_data
)) goto DONE
;
819 /* Decline requests issued prior to our acquiring the selection. */
821 = (Time
) cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
822 if (SELECTION_EVENT_TIME (event
) != CurrentTime
823 && local_selection_time
> SELECTION_EVENT_TIME (event
))
826 x_selection_current_request
= event
;
827 selection_request_dpyinfo
= dpyinfo
;
828 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
830 /* We might be able to handle nested x_handle_selection_requests,
831 but this is difficult to test, and seems unimportant. */
832 x_start_queuing_selection_requests ();
833 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
835 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
836 SDATA (SYMBOL_NAME (selection_symbol
)),
837 SDATA (SYMBOL_NAME (target_symbol
)));
839 if (EQ (target_symbol
, QMULTIPLE
))
841 /* For MULTIPLE targets, the event property names a list of atom
842 pairs; the first atom names a target and the second names a
843 non-None property. */
844 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
845 Lisp_Object multprop
;
848 if (property
== None
) goto DONE
;
849 multprop
= x_get_window_property_as_lisp_data (display
, requestor
, property
,
850 QMULTIPLE
, selection
);
852 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
855 nselections
= ASIZE (multprop
) / 2;
856 /* Perform conversions. This can signal. */
857 for (j
= 0; j
< nselections
; j
++)
859 struct selection_data
*cs
= converted_selections
+ j
;
860 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
861 Atom subproperty
= symbol_to_x_atom (dpyinfo
, display
,
862 AREF (multprop
, 2*j
+1));
864 if (subproperty
!= None
)
865 x_convert_selection (event
, selection_symbol
, subtarget
,
872 if (property
== None
)
873 property
= SELECTION_EVENT_TARGET (event
);
874 success
= x_convert_selection (event
, selection_symbol
,
875 target_symbol
, property
, 0);
881 x_reply_selection_request (event
, dpyinfo
);
883 x_decline_selection_request (event
);
884 x_selection_current_request
= 0;
886 /* Run the `x-sent-selection-functions' abnormal hook. */
887 if (!NILP (Vx_sent_selection_functions
)
888 && !EQ (Vx_sent_selection_functions
, Qunbound
))
891 args
[0] = Vx_sent_selection_functions
;
892 args
[1] = selection_symbol
;
893 args
[2] = target_symbol
;
894 args
[3] = success
? Qt
: Qnil
;
895 Frun_hook_with_args (4, args
);
898 unbind_to (count
, Qnil
);
902 /* Perform the requested selection conversion, and write the data to
903 the converted_selections linked list, where it can be accessed by
904 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
905 the data even if conversion fails, using conversion_fail_tag.
907 Return 0 if the selection failed to convert, 1 otherwise. */
910 x_convert_selection (struct input_event
*event
,
911 Lisp_Object selection_symbol
,
912 Lisp_Object target_symbol
,
913 Atom property
, int for_multiple
)
916 Lisp_Object lisp_selection
;
917 struct selection_data
*cs
;
918 GCPRO1 (lisp_selection
);
921 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
923 /* A nil return value means we can't perform the conversion. */
924 if (NILP (lisp_selection
)
925 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
929 cs
= xmalloc (sizeof (struct selection_data
));
930 cs
->data
= (unsigned char *) &conversion_fail_tag
;
935 cs
->property
= property
;
936 cs
->wait_object
= NULL
;
937 cs
->next
= converted_selections
;
938 converted_selections
= cs
;
944 /* Otherwise, record the converted selection to binary. */
945 cs
= xmalloc (sizeof (struct selection_data
));
947 cs
->property
= property
;
948 cs
->wait_object
= NULL
;
949 cs
->next
= converted_selections
;
950 converted_selections
= cs
;
951 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
953 &(cs
->data
), &(cs
->type
),
954 &(cs
->size
), &(cs
->format
),
959 /* Handle a SelectionClear event EVENT, which indicates that some
960 client cleared out our previously asserted selection.
961 This is called from keyboard.c when such an event is found in the queue. */
964 x_handle_selection_clear (struct input_event
*event
)
966 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
967 Atom selection
= SELECTION_EVENT_SELECTION (event
);
968 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
970 Lisp_Object selection_symbol
, local_selection_data
;
971 Time local_selection_time
;
972 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
973 struct x_display_info
*t_dpyinfo
;
975 TRACE0 ("x_handle_selection_clear");
977 /* If the new selection owner is also Emacs,
978 don't clear the new selection. */
980 /* Check each display on the same terminal,
981 to see if this Emacs job now owns the selection
982 through that display. */
983 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
984 if (t_dpyinfo
->terminal
->kboard
== dpyinfo
->terminal
->kboard
)
987 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
988 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
996 selection_symbol
= x_atom_to_symbol (display
, selection
);
998 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
1000 /* Well, we already believe that we don't own it, so that's just fine. */
1001 if (NILP (local_selection_data
)) return;
1003 local_selection_time
= (Time
)
1004 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
1006 /* This SelectionClear is for a selection that we no longer own, so we can
1007 disregard it. (That is, we have reasserted the selection since this
1008 request was generated.) */
1010 if (changed_owner_time
!= CurrentTime
1011 && local_selection_time
> changed_owner_time
)
1014 /* Otherwise, we're really honest and truly being told to drop it.
1015 Don't use Fdelq as that may QUIT;. */
1017 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
1018 Vselection_alist
= Fcdr (Vselection_alist
);
1022 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1023 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
1025 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1030 /* Let random lisp code notice that the selection has been stolen. */
1034 rest
= Vx_lost_selection_functions
;
1035 if (!EQ (rest
, Qunbound
))
1037 for (; CONSP (rest
); rest
= Fcdr (rest
))
1038 call1 (Fcar (rest
), selection_symbol
);
1039 prepare_menu_bars ();
1040 redisplay_preserve_echo_area (20);
1046 x_handle_selection_event (struct input_event
*event
)
1048 TRACE0 ("x_handle_selection_event");
1049 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
1050 x_handle_selection_clear (event
);
1051 else if (x_queue_selection_requests
)
1052 x_queue_event (event
);
1054 x_handle_selection_request (event
);
1058 /* Clear all selections that were made from frame F.
1059 We do this when about to delete a frame. */
1062 x_clear_frame_selections (FRAME_PTR f
)
1067 XSETFRAME (frame
, f
);
1069 /* Otherwise, we're really honest and truly being told to drop it.
1070 Don't use Fdelq as that may QUIT;. */
1072 /* Delete elements from the beginning of Vselection_alist. */
1073 while (!NILP (Vselection_alist
)
1074 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
1076 /* Let random Lisp code notice that the selection has been stolen. */
1077 Lisp_Object hooks
, selection_symbol
;
1079 hooks
= Vx_lost_selection_functions
;
1080 selection_symbol
= Fcar (Fcar (Vselection_alist
));
1082 if (!EQ (hooks
, Qunbound
))
1084 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1085 call1 (Fcar (hooks
), selection_symbol
);
1086 #if 0 /* This can crash when deleting a frame
1087 from x_connection_closed. Anyway, it seems unnecessary;
1088 something else should cause a redisplay. */
1089 redisplay_preserve_echo_area (21);
1093 Vselection_alist
= Fcdr (Vselection_alist
);
1096 /* Delete elements after the beginning of Vselection_alist. */
1097 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1098 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
1100 /* Let random Lisp code notice that the selection has been stolen. */
1101 Lisp_Object hooks
, selection_symbol
;
1103 hooks
= Vx_lost_selection_functions
;
1104 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
1106 if (!EQ (hooks
, Qunbound
))
1108 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
1109 call1 (Fcar (hooks
), selection_symbol
);
1110 #if 0 /* See above */
1111 redisplay_preserve_echo_area (22);
1114 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1119 /* Nonzero if any properties for DISPLAY and WINDOW
1120 are on the list of what we are waiting for. */
1123 waiting_for_other_props_on_window (Display
*display
, Window window
)
1125 struct prop_location
*rest
= property_change_wait_list
;
1127 if (rest
->display
== display
&& rest
->window
== window
)
1134 /* Add an entry to the list of property changes we are waiting for.
1135 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1136 The return value is a number that uniquely identifies
1137 this awaited property change. */
1139 static struct prop_location
*
1140 expect_property_change (Display
*display
, Window window
, Atom property
, int state
)
1142 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1143 pl
->identifier
= ++prop_location_identifier
;
1144 pl
->display
= display
;
1145 pl
->window
= window
;
1146 pl
->property
= property
;
1147 pl
->desired_state
= state
;
1148 pl
->next
= property_change_wait_list
;
1150 property_change_wait_list
= pl
;
1154 /* Delete an entry from the list of property changes we are waiting for.
1155 IDENTIFIER is the number that uniquely identifies the entry. */
1158 unexpect_property_change (struct prop_location
*location
)
1160 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1163 if (rest
== location
)
1166 prev
->next
= rest
->next
;
1168 property_change_wait_list
= rest
->next
;
1177 /* Remove the property change expectation element for IDENTIFIER. */
1180 wait_for_property_change_unwind (Lisp_Object loc
)
1182 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1184 unexpect_property_change (location
);
1185 if (location
== property_change_reply_object
)
1186 property_change_reply_object
= 0;
1190 /* Actually wait for a property change.
1191 IDENTIFIER should be the value that expect_property_change returned. */
1194 wait_for_property_change (struct prop_location
*location
)
1197 int count
= SPECPDL_INDEX ();
1199 if (property_change_reply_object
)
1202 /* Make sure to do unexpect_property_change if we quit or err. */
1203 record_unwind_protect (wait_for_property_change_unwind
,
1204 make_save_value (location
, 0));
1206 XSETCAR (property_change_reply
, Qnil
);
1207 property_change_reply_object
= location
;
1209 /* If the event we are waiting for arrives beyond here, it will set
1210 property_change_reply, because property_change_reply_object says so. */
1211 if (! location
->arrived
)
1213 secs
= x_selection_timeout
/ 1000;
1214 usecs
= (x_selection_timeout
% 1000) * 1000;
1215 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1216 wait_reading_process_output (secs
, usecs
, 0, 0,
1217 property_change_reply
, NULL
, 0);
1219 if (NILP (XCAR (property_change_reply
)))
1221 TRACE0 (" Timed out");
1222 error ("Timed out waiting for property-notify event");
1226 unbind_to (count
, Qnil
);
1229 /* Called from XTread_socket in response to a PropertyNotify event. */
1232 x_handle_property_notify (XPropertyEvent
*event
)
1234 struct prop_location
*rest
;
1236 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1239 && rest
->property
== event
->atom
1240 && rest
->window
== event
->window
1241 && rest
->display
== event
->display
1242 && rest
->desired_state
== event
->state
)
1244 TRACE2 ("Expected %s of property %s",
1245 (event
->state
== PropertyDelete
? "deletion" : "change"),
1246 XGetAtomName (event
->display
, event
->atom
));
1250 /* If this is the one wait_for_property_change is waiting for,
1251 tell it to wake up. */
1252 if (rest
== property_change_reply_object
)
1253 XSETCAR (property_change_reply
, Qt
);
1262 /* Variables for communication with x_handle_selection_notify. */
1263 static Atom reading_which_selection
;
1264 static Lisp_Object reading_selection_reply
;
1265 static Window reading_selection_window
;
1267 /* Do protocol to read selection-data from the server.
1268 Converts this to Lisp data and returns it. */
1271 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
1273 struct frame
*sf
= SELECTED_FRAME ();
1274 Window requestor_window
;
1276 struct x_display_info
*dpyinfo
;
1277 Time requestor_time
= last_event_timestamp
;
1278 Atom target_property
;
1279 Atom selection_atom
;
1282 int count
= SPECPDL_INDEX ();
1285 if (! FRAME_X_P (sf
))
1288 requestor_window
= FRAME_X_WINDOW (sf
);
1289 display
= FRAME_X_DISPLAY (sf
);
1290 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1291 target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1292 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1294 if (CONSP (target_type
))
1295 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1297 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1299 if (! NILP (time_stamp
))
1301 if (CONSP (time_stamp
))
1302 requestor_time
= (Time
) cons_to_long (time_stamp
);
1303 else if (INTEGERP (time_stamp
))
1304 requestor_time
= (Time
) XUINT (time_stamp
);
1305 else if (FLOATP (time_stamp
))
1306 requestor_time
= (Time
) XFLOAT_DATA (time_stamp
);
1308 error ("TIME_STAMP must be cons or number");
1313 /* The protected block contains wait_reading_process_output, which
1314 can run random lisp code (process handlers) or signal.
1315 Therefore, we put the x_uncatch_errors call in an unwind. */
1316 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
1317 x_catch_errors (display
);
1319 TRACE2 ("Get selection %s, type %s",
1320 XGetAtomName (display
, type_atom
),
1321 XGetAtomName (display
, target_property
));
1323 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1324 requestor_window
, requestor_time
);
1327 /* Prepare to block until the reply has been read. */
1328 reading_selection_window
= requestor_window
;
1329 reading_which_selection
= selection_atom
;
1330 XSETCAR (reading_selection_reply
, Qnil
);
1332 frame
= some_frame_on_display (dpyinfo
);
1334 /* It should not be necessary to stop handling selection requests
1335 during this time. In fact, the SAVE_TARGETS mechanism requires
1336 us to handle a clipboard manager's requests before it returns
1341 x_start_queuing_selection_requests ();
1342 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1348 /* This allows quits. Also, don't wait forever. */
1349 secs
= x_selection_timeout
/ 1000;
1350 usecs
= (x_selection_timeout
% 1000) * 1000;
1351 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1352 wait_reading_process_output (secs
, usecs
, 0, 0,
1353 reading_selection_reply
, NULL
, 0);
1354 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1357 if (x_had_errors_p (display
))
1358 error ("Cannot get selection");
1359 /* This calls x_uncatch_errors. */
1360 unbind_to (count
, Qnil
);
1363 if (NILP (XCAR (reading_selection_reply
)))
1364 error ("Timed out waiting for reply from selection owner");
1365 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1368 /* Otherwise, the selection is waiting for us on the requested property. */
1370 x_get_window_property_as_lisp_data (display
, requestor_window
,
1371 target_property
, target_type
,
1375 /* Subroutines of x_get_window_property_as_lisp_data */
1377 /* Use xfree, not XFree, to free the data obtained with this function. */
1380 x_get_window_property (Display
*display
, Window window
, Atom property
,
1381 unsigned char **data_ret
, int *bytes_ret
,
1382 Atom
*actual_type_ret
, int *actual_format_ret
,
1383 unsigned long *actual_size_ret
, int delete_p
)
1386 unsigned long bytes_remaining
;
1388 unsigned char *tmp_data
= 0;
1390 int buffer_size
= SELECTION_QUANTUM (display
);
1392 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1393 buffer_size
= MAX_SELECTION_QUANTUM
;
1397 /* First probe the thing to find out how big it is. */
1398 result
= XGetWindowProperty (display
, window
, property
,
1399 0L, 0L, False
, AnyPropertyType
,
1400 actual_type_ret
, actual_format_ret
,
1402 &bytes_remaining
, &tmp_data
);
1403 if (result
!= Success
)
1411 /* This was allocated by Xlib, so use XFree. */
1412 XFree ((char *) tmp_data
);
1414 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1420 total_size
= bytes_remaining
+ 1;
1421 *data_ret
= (unsigned char *) xmalloc (total_size
);
1423 /* Now read, until we've gotten it all. */
1424 while (bytes_remaining
)
1426 #ifdef TRACE_SELECTION
1427 unsigned long last
= bytes_remaining
;
1430 = XGetWindowProperty (display
, window
, property
,
1431 (long)offset
/4, (long)buffer_size
/4,
1434 actual_type_ret
, actual_format_ret
,
1435 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1437 TRACE2 ("Read %lu bytes from property %s",
1438 last
- bytes_remaining
,
1439 XGetAtomName (display
, property
));
1441 /* If this doesn't return Success at this point, it means that
1442 some clod deleted the selection while we were in the midst of
1443 reading it. Deal with that, I guess.... */
1444 if (result
!= Success
)
1447 /* The man page for XGetWindowProperty says:
1448 "If the returned format is 32, the returned data is represented
1449 as a long array and should be cast to that type to obtain the
1451 This applies even if long is more than 32 bits, the X library
1452 converts from 32 bit elements received from the X server to long
1453 and passes the long array to us. Thus, for that case memcpy can not
1454 be used. We convert to a 32 bit type here, because so much code
1457 The bytes and offsets passed to XGetWindowProperty refers to the
1458 property and those are indeed in 32 bit quantities if format is 32. */
1460 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1463 int *idata
= (int *) ((*data_ret
) + offset
);
1464 long *ldata
= (long *) tmp_data
;
1466 for (i
= 0; i
< *actual_size_ret
; ++i
)
1468 idata
[i
]= (int) ldata
[i
];
1474 *actual_size_ret
*= *actual_format_ret
/ 8;
1475 memcpy ((*data_ret
) + offset
, tmp_data
, *actual_size_ret
);
1476 offset
+= *actual_size_ret
;
1479 /* This was allocated by Xlib, so use XFree. */
1480 XFree ((char *) tmp_data
);
1485 *bytes_ret
= offset
;
1488 /* Use xfree, not XFree, to free the data obtained with this function. */
1491 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1492 Lisp_Object target_type
,
1493 unsigned int min_size_bytes
,
1494 unsigned char **data_ret
, int *size_bytes_ret
,
1495 Atom
*type_ret
, int *format_ret
,
1496 unsigned long *size_ret
)
1499 struct prop_location
*wait_object
;
1500 *size_bytes_ret
= min_size_bytes
;
1501 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1503 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1505 /* At this point, we have read an INCR property.
1506 Delete the property to ack it.
1507 (But first, prepare to receive the next event in this handshake.)
1509 Now, we must loop, waiting for the sending window to put a value on
1510 that property, then reading the property, then deleting it to ack.
1511 We are done when the sender places a property of length 0.
1514 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1515 TRACE1 (" Delete property %s",
1516 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1517 XDeleteProperty (display
, window
, property
);
1518 TRACE1 (" Expect new value of property %s",
1519 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1520 wait_object
= expect_property_change (display
, window
, property
,
1527 unsigned char *tmp_data
;
1530 TRACE0 (" Wait for property change");
1531 wait_for_property_change (wait_object
);
1533 /* expect it again immediately, because x_get_window_property may
1534 .. no it won't, I don't get it.
1535 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1536 TRACE0 (" Get property value");
1537 x_get_window_property (display
, window
, property
,
1538 &tmp_data
, &tmp_size_bytes
,
1539 type_ret
, format_ret
, size_ret
, 1);
1541 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1543 if (tmp_size_bytes
== 0) /* we're done */
1545 TRACE0 ("Done reading incrementally");
1547 if (! waiting_for_other_props_on_window (display
, window
))
1548 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1549 /* Use xfree, not XFree, because x_get_window_property
1550 calls xmalloc itself. */
1556 TRACE1 (" ACK by deleting property %s",
1557 XGetAtomName (display
, property
));
1558 XDeleteProperty (display
, window
, property
);
1559 wait_object
= expect_property_change (display
, window
, property
,
1564 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1566 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1567 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1570 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1571 offset
+= tmp_size_bytes
;
1573 /* Use xfree, not XFree, because x_get_window_property
1574 calls xmalloc itself. */
1580 /* Fetch a value from property PROPERTY of X window WINDOW on display
1581 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1585 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1587 Lisp_Object target_type
,
1588 Atom selection_atom
)
1592 unsigned long actual_size
;
1593 unsigned char *data
= 0;
1596 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1598 TRACE0 ("Reading selection data");
1600 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1601 &actual_type
, &actual_format
, &actual_size
, 1);
1604 int there_is_a_selection_owner
;
1606 there_is_a_selection_owner
1607 = XGetSelectionOwner (display
, selection_atom
);
1609 if (there_is_a_selection_owner
)
1610 signal_error ("Selection owner couldn't convert",
1612 ? list2 (target_type
,
1613 x_atom_to_symbol (display
, actual_type
))
1616 signal_error ("No selection",
1617 x_atom_to_symbol (display
, selection_atom
));
1620 if (actual_type
== dpyinfo
->Xatom_INCR
)
1622 /* That wasn't really the data, just the beginning. */
1624 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1626 /* Use xfree, not XFree, because x_get_window_property
1627 calls xmalloc itself. */
1628 xfree ((char *) data
);
1630 receive_incremental_selection (display
, window
, property
, target_type
,
1631 min_size_bytes
, &data
, &bytes
,
1632 &actual_type
, &actual_format
,
1637 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1638 XDeleteProperty (display
, window
, property
);
1642 /* It's been read. Now convert it to a lisp object in some semi-rational
1644 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1645 actual_type
, actual_format
);
1647 /* Use xfree, not XFree, because x_get_window_property
1648 calls xmalloc itself. */
1649 xfree ((char *) data
);
1653 /* These functions convert from the selection data read from the server into
1654 something that we can use from Lisp, and vice versa.
1656 Type: Format: Size: Lisp Type:
1657 ----- ------- ----- -----------
1660 ATOM 32 > 1 Vector of Symbols
1662 * 16 > 1 Vector of Integers
1663 * 32 1 if <=16 bits: Integer
1664 if > 16 bits: Cons of top16, bot16
1665 * 32 > 1 Vector of the above
1667 When converting a Lisp number to C, it is assumed to be of format 16 if
1668 it is an integer, and of format 32 if it is a cons of two integers.
1670 When converting a vector of numbers from Lisp to C, it is assumed to be
1671 of format 16 if every element in the vector is an integer, and is assumed
1672 to be of format 32 if any element is a cons of two integers.
1674 When converting an object to C, it may be of the form (SYMBOL . <data>)
1675 where SYMBOL is what we should claim that the type is. Format and
1676 representation are as above.
1678 Important: When format is 32, data should contain an array of int,
1679 not an array of long as the X library returns. This makes a difference
1680 when sizeof(long) != sizeof(int). */
1685 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1686 int size
, Atom type
, int format
)
1688 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1690 if (type
== dpyinfo
->Xatom_NULL
)
1693 /* Convert any 8-bit data to a string, for compactness. */
1694 else if (format
== 8)
1696 Lisp_Object str
, lispy_type
;
1698 str
= make_unibyte_string ((char *) data
, size
);
1699 /* Indicate that this string is from foreign selection by a text
1700 property `foreign-selection' so that the caller of
1701 x-get-selection-internal (usually x-get-selection) can know
1702 that the string must be decode. */
1703 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1704 lispy_type
= QCOMPOUND_TEXT
;
1705 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1706 lispy_type
= QUTF8_STRING
;
1708 lispy_type
= QSTRING
;
1709 Fput_text_property (make_number (0), make_number (size
),
1710 Qforeign_selection
, lispy_type
, str
);
1713 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1714 a vector of symbols. */
1715 else if (type
== XA_ATOM
1716 /* Treat ATOM_PAIR type similar to list of atoms. */
1717 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1720 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1721 But the callers of these function has made sure the data for
1722 format == 32 is an array of int. Thus, use int instead
1724 int *idata
= (int *) data
;
1726 if (size
== sizeof (int))
1727 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1730 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1732 for (i
= 0; i
< size
/ sizeof (int); i
++)
1733 Faset (v
, make_number (i
),
1734 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1739 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1740 If the number is 32 bits and won't fit in a Lisp_Int,
1741 convert it to a cons of integers, 16 bits in each half.
1743 else if (format
== 32 && size
== sizeof (int))
1744 return long_to_cons (((unsigned int *) data
) [0]);
1745 else if (format
== 16 && size
== sizeof (short))
1746 return make_number ((int) (((unsigned short *) data
) [0]));
1748 /* Convert any other kind of data to a vector of numbers, represented
1749 as above (as an integer, or a cons of two 16 bit integers.)
1751 else if (format
== 16)
1755 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1756 for (i
= 0; i
< size
/ 2; i
++)
1758 int j
= (int) ((unsigned short *) data
) [i
];
1759 Faset (v
, make_number (i
), make_number (j
));
1766 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1767 for (i
= 0; i
< size
/ 4; i
++)
1769 unsigned int j
= ((unsigned int *) data
) [i
];
1770 Faset (v
, make_number (i
), long_to_cons (j
));
1777 /* Use xfree, not XFree, to free the data obtained with this function. */
1780 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1781 unsigned char **data_ret
, Atom
*type_ret
,
1782 unsigned int *size_ret
,
1783 int *format_ret
, int *nofree_ret
)
1785 Lisp_Object type
= Qnil
;
1786 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1790 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1794 if (CONSP (obj
) && NILP (XCDR (obj
)))
1798 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1799 { /* This is not the same as declining */
1805 else if (STRINGP (obj
))
1807 if (SCHARS (obj
) < SBYTES (obj
))
1808 /* OBJ is a multibyte string containing a non-ASCII char. */
1809 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1813 *size_ret
= SBYTES (obj
);
1814 *data_ret
= SDATA (obj
);
1817 else if (SYMBOLP (obj
))
1821 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1822 (*data_ret
) [sizeof (Atom
)] = 0;
1823 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1824 if (NILP (type
)) type
= QATOM
;
1826 else if (INTEGERP (obj
)
1827 && XINT (obj
) < 0xFFFF
1828 && XINT (obj
) > -0xFFFF)
1832 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1833 (*data_ret
) [sizeof (short)] = 0;
1834 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1835 if (NILP (type
)) type
= QINTEGER
;
1837 else if (INTEGERP (obj
)
1838 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1839 && (INTEGERP (XCDR (obj
))
1840 || (CONSP (XCDR (obj
))
1841 && INTEGERP (XCAR (XCDR (obj
)))))))
1845 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1846 (*data_ret
) [sizeof (long)] = 0;
1847 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1848 if (NILP (type
)) type
= QINTEGER
;
1850 else if (VECTORP (obj
))
1852 /* Lisp_Vectors may represent a set of ATOMs;
1853 a set of 16 or 32 bit INTEGERs;
1854 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1858 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1859 /* This vector is an ATOM set */
1861 if (NILP (type
)) type
= QATOM
;
1862 *size_ret
= ASIZE (obj
);
1864 for (i
= 0; i
< *size_ret
; i
++)
1865 if (!SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1866 signal_error ("All elements of selection vector must have same type", obj
);
1868 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1869 for (i
= 0; i
< *size_ret
; i
++)
1870 (*(Atom
**) data_ret
) [i
]
1871 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1874 /* This vector is an INTEGER set, or something like it */
1877 *size_ret
= ASIZE (obj
);
1878 if (NILP (type
)) type
= QINTEGER
;
1880 for (i
= 0; i
< *size_ret
; i
++)
1881 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1883 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1884 signal_error (/* Qselection_error */
1885 "Elements of selection vector must be integers or conses of integers",
1888 /* Use sizeof(long) even if it is more than 32 bits. See comment
1889 in x_get_window_property and x_fill_property_data. */
1891 if (*format_ret
== 32) data_size
= sizeof(long);
1892 *data_ret
= (unsigned char *) xmalloc (*size_ret
* data_size
);
1893 for (i
= 0; i
< *size_ret
; i
++)
1894 if (*format_ret
== 32)
1895 (*((unsigned long **) data_ret
)) [i
]
1896 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1898 (*((unsigned short **) data_ret
)) [i
]
1899 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1903 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1905 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1909 clean_local_selection_data (Lisp_Object obj
)
1912 && INTEGERP (XCAR (obj
))
1913 && CONSP (XCDR (obj
))
1914 && INTEGERP (XCAR (XCDR (obj
)))
1915 && NILP (XCDR (XCDR (obj
))))
1916 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1919 && INTEGERP (XCAR (obj
))
1920 && INTEGERP (XCDR (obj
)))
1922 if (XINT (XCAR (obj
)) == 0)
1924 if (XINT (XCAR (obj
)) == -1)
1925 return make_number (- XINT (XCDR (obj
)));
1930 int size
= ASIZE (obj
);
1933 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1934 copy
= Fmake_vector (make_number (size
), Qnil
);
1935 for (i
= 0; i
< size
; i
++)
1936 XVECTOR (copy
)->contents
[i
]
1937 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1943 /* Called from XTread_socket to handle SelectionNotify events.
1944 If it's the selection we are waiting for, stop waiting
1945 by setting the car of reading_selection_reply to non-nil.
1946 We store t there if the reply is successful, lambda if not. */
1949 x_handle_selection_notify (XSelectionEvent
*event
)
1951 if (event
->requestor
!= reading_selection_window
)
1953 if (event
->selection
!= reading_which_selection
)
1956 TRACE0 ("Received SelectionNotify");
1957 XSETCAR (reading_selection_reply
,
1958 (event
->property
!= 0 ? Qt
: Qlambda
));
1962 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1963 Sx_own_selection_internal
, 2, 2, 0,
1964 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1965 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1966 \(Those are literal upper-case symbol names, since that's what X expects.)
1967 VALUE is typically a string, or a cons of two markers, but may be
1968 anything that the functions on `selection-converter-alist' know about. */)
1969 (Lisp_Object selection
, Lisp_Object value
)
1972 CHECK_SYMBOL (selection
);
1973 if (NILP (value
)) error ("VALUE may not be nil");
1974 x_own_selection (selection
, value
);
1979 /* Request the selection value from the owner. If we are the owner,
1980 simply return our selection value. If we are not the owner, this
1981 will block until all of the data has arrived. */
1983 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1984 Sx_get_selection_internal
, 2, 3, 0,
1985 doc
: /* Return text selected from some X window.
1986 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1987 \(Those are literal upper-case symbol names, since that's what X expects.)
1988 TYPE is the type of data desired, typically `STRING'.
1989 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1990 selections. If omitted, defaults to the time for the last event. */)
1991 (Lisp_Object selection_symbol
, Lisp_Object target_type
, Lisp_Object time_stamp
)
1993 Lisp_Object val
= Qnil
;
1994 struct gcpro gcpro1
, gcpro2
;
1995 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1997 CHECK_SYMBOL (selection_symbol
);
1999 #if 0 /* #### MULTIPLE doesn't work yet */
2000 if (CONSP (target_type
)
2001 && XCAR (target_type
) == QMULTIPLE
)
2003 CHECK_VECTOR (XCDR (target_type
));
2004 /* So we don't destructively modify this... */
2005 target_type
= copy_multiple_data (target_type
);
2009 CHECK_SYMBOL (target_type
);
2011 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2014 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
,
2015 target_type
, time_stamp
));
2017 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2020 if (CONSP (val
) && NILP (XCDR (val
)))
2023 RETURN_UNGCPRO (clean_local_selection_data (val
));
2026 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2027 Sx_disown_selection_internal
, 1, 2, 0,
2028 doc
: /* If we own the selection SELECTION, disown it.
2029 Disowning it means there is no such selection. */)
2030 (Lisp_Object selection
, Lisp_Object time_object
)
2033 Atom selection_atom
;
2035 struct selection_input_event sie
;
2036 struct input_event ie
;
2039 struct x_display_info
*dpyinfo
;
2040 struct frame
*sf
= SELECTED_FRAME ();
2043 if (! FRAME_X_P (sf
))
2046 display
= FRAME_X_DISPLAY (sf
);
2047 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2048 CHECK_SYMBOL (selection
);
2049 if (NILP (time_object
))
2050 timestamp
= last_event_timestamp
;
2052 timestamp
= cons_to_long (time_object
);
2054 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2055 return Qnil
; /* Don't disown the selection when we're not the owner. */
2057 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2060 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2063 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2064 generated for a window which owns the selection when that window sets
2065 the selection owner to None. The NCD server does, the MIT Sun4 server
2066 doesn't. So we synthesize one; this means we might get two, but
2067 that's ok, because the second one won't have any effect. */
2068 SELECTION_EVENT_DISPLAY (&event
.sie
) = display
;
2069 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2070 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2071 x_handle_selection_clear (&event
.ie
);
2076 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2078 doc
: /* Whether the current Emacs process owns the given X Selection.
2079 The arg should be the name of the selection in question, typically one of
2080 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2081 \(Those are literal upper-case symbol names, since that's what X expects.)
2082 For convenience, the symbol nil is the same as `PRIMARY',
2083 and t is the same as `SECONDARY'. */)
2084 (Lisp_Object selection
)
2087 CHECK_SYMBOL (selection
);
2088 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2089 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2091 if (NILP (Fassq (selection
, Vselection_alist
)))
2096 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2098 doc
: /* Whether there is an owner for the given X Selection.
2099 The arg should be the name of the selection in question, typically one of
2100 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2101 \(Those are literal upper-case symbol names, since that's what X expects.)
2102 For convenience, the symbol nil is the same as `PRIMARY',
2103 and t is the same as `SECONDARY'. */)
2104 (Lisp_Object selection
)
2109 struct frame
*sf
= SELECTED_FRAME ();
2111 /* It should be safe to call this before we have an X frame. */
2112 if (! FRAME_X_P (sf
))
2115 dpy
= FRAME_X_DISPLAY (sf
);
2116 CHECK_SYMBOL (selection
);
2117 if (!NILP (Fx_selection_owner_p (selection
)))
2119 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2120 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2121 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2125 owner
= XGetSelectionOwner (dpy
, atom
);
2127 return (owner
? Qt
: Qnil
);
2131 /***********************************************************************
2132 Drag and drop support
2133 ***********************************************************************/
2134 /* Check that lisp values are of correct type for x_fill_property_data.
2135 That is, number, string or a cons with two numbers (low and high 16
2136 bit parts of a 32 bit number). Return the number of items in DATA,
2137 or -1 if there is an error. */
2140 x_check_property_data (Lisp_Object data
)
2145 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2147 Lisp_Object o
= XCAR (iter
);
2149 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2151 else if (CONSP (o
) &&
2152 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2160 /* Convert lisp values to a C array. Values may be a number, a string
2161 which is taken as an X atom name and converted to the atom value, or
2162 a cons containing the two 16 bit parts of a 32 bit number.
2164 DPY is the display use to look up X atoms.
2165 DATA is a Lisp list of values to be converted.
2166 RET is the C array that contains the converted values. It is assumed
2167 it is big enough to hold all values.
2168 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2169 be stored in RET. Note that long is used for 32 even if long is more
2170 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2171 XClientMessageEvent). */
2174 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2177 long *d32
= (long *) ret
;
2178 short *d16
= (short *) ret
;
2179 char *d08
= (char *) ret
;
2182 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2184 Lisp_Object o
= XCAR (iter
);
2187 val
= (long) XFASTINT (o
);
2188 else if (FLOATP (o
))
2189 val
= (long) XFLOAT_DATA (o
);
2191 val
= (long) cons_to_long (o
);
2192 else if (STRINGP (o
))
2195 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2199 error ("Wrong type, must be string, number or cons");
2202 *d08
++ = (char) val
;
2203 else if (format
== 16)
2204 *d16
++ = (short) val
;
2210 /* Convert an array of C values to a Lisp list.
2211 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2212 DATA is a C array of values to be converted.
2213 TYPE is the type of the data. Only XA_ATOM is special, it converts
2214 each number in DATA to its corresponfing X atom as a symbol.
2215 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2217 SIZE is the number of elements in DATA.
2219 Important: When format is 32, data should contain an array of int,
2220 not an array of long as the X library returns. This makes a difference
2221 when sizeof(long) != sizeof(int).
2223 Also see comment for selection_data_to_lisp_data above. */
2226 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2227 Atom type
, int format
, long unsigned int size
)
2229 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2230 data
, size
*format
/8, type
, format
);
2233 /* Get the mouse position in frame relative coordinates. */
2236 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2238 Window root
, dummy_window
;
2243 XQueryPointer (FRAME_X_DISPLAY (f
),
2244 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2246 /* The root window which contains the pointer. */
2249 /* Window pointer is on, not used */
2252 /* The position on that root window. */
2255 /* x/y in dummy_window coordinates, not used. */
2258 /* Modifier keys and pointer buttons, about which
2260 (unsigned int *) &dummy
);
2263 /* Absolute to relative. */
2264 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2265 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2270 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2271 Sx_get_atom_name
, 1, 2, 0,
2272 doc
: /* Return the X atom name for VALUE as a string.
2273 VALUE may be a number or a cons where the car is the upper 16 bits and
2274 the cdr is the lower 16 bits of a 32 bit value.
2275 Use the display for FRAME or the current frame if FRAME is not given or nil.
2277 If the value is 0 or the atom is not known, return the empty string. */)
2278 (Lisp_Object value
, Lisp_Object frame
)
2280 struct frame
*f
= check_x_frame (frame
);
2283 Lisp_Object ret
= Qnil
;
2284 Display
*dpy
= FRAME_X_DISPLAY (f
);
2288 if (INTEGERP (value
))
2289 atom
= (Atom
) XUINT (value
);
2290 else if (FLOATP (value
))
2291 atom
= (Atom
) XFLOAT_DATA (value
);
2292 else if (CONSP (value
))
2293 atom
= (Atom
) cons_to_long (value
);
2295 error ("Wrong type, value must be number or cons");
2298 x_catch_errors (dpy
);
2299 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2300 had_errors
= x_had_errors_p (dpy
);
2301 x_uncatch_errors ();
2304 ret
= make_string (name
, strlen (name
));
2306 if (atom
&& name
) XFree (name
);
2307 if (NILP (ret
)) ret
= empty_unibyte_string
;
2314 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2315 Sx_register_dnd_atom
, 1, 2, 0,
2316 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2317 ATOM can be a symbol or a string. The ATOM is interned on the display that
2318 FRAME is on. If FRAME is nil, the selected frame is used. */)
2319 (Lisp_Object atom
, Lisp_Object frame
)
2322 struct frame
*f
= check_x_frame (frame
);
2324 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2328 x_atom
= symbol_to_x_atom (dpyinfo
, FRAME_X_DISPLAY (f
), atom
);
2329 else if (STRINGP (atom
))
2332 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2336 error ("ATOM must be a symbol or a string");
2338 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2339 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2342 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2344 dpyinfo
->x_dnd_atoms_size
*= 2;
2345 dpyinfo
->x_dnd_atoms
= xrealloc (dpyinfo
->x_dnd_atoms
,
2346 sizeof (*dpyinfo
->x_dnd_atoms
)
2347 * dpyinfo
->x_dnd_atoms_size
);
2350 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2354 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2357 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
, struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2361 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2362 unsigned long size
= 160/event
->format
;
2364 unsigned char *data
= (unsigned char *) event
->data
.b
;
2368 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2369 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2371 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2373 XSETFRAME (frame
, f
);
2375 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2376 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2377 function expects them to be of size int (i.e. 32). So to be able to
2378 use that function, put the data in the form it expects if format is 32. */
2380 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2382 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2383 idata
[i
] = (int) event
->data
.l
[i
];
2384 data
= (unsigned char *) idata
;
2387 vec
= Fmake_vector (make_number (4), Qnil
);
2388 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2389 event
->message_type
)));
2390 ASET (vec
, 1, frame
);
2391 ASET (vec
, 2, make_number (event
->format
));
2392 ASET (vec
, 3, x_property_data_to_lisp (f
,
2394 event
->message_type
,
2398 mouse_position_for_drop (f
, &x
, &y
);
2399 bufp
->kind
= DRAG_N_DROP_EVENT
;
2400 bufp
->frame_or_window
= frame
;
2401 bufp
->timestamp
= CurrentTime
;
2402 bufp
->x
= make_number (x
);
2403 bufp
->y
= make_number (y
);
2405 bufp
->modifiers
= 0;
2410 DEFUN ("x-send-client-message", Fx_send_client_event
,
2411 Sx_send_client_message
, 6, 6, 0,
2412 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2414 For DISPLAY, specify either a frame or a display name (a string).
2415 If DISPLAY is nil, that stands for the selected frame's display.
2416 DEST may be a number, in which case it is a Window id. The value 0 may
2417 be used to send to the root window of the DISPLAY.
2418 If DEST is a cons, it is converted to a 32 bit number
2419 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2420 number is then used as a window id.
2421 If DEST is a frame the event is sent to the outer window of that frame.
2422 A value of nil means the currently selected frame.
2423 If DEST is the string "PointerWindow" the event is sent to the window that
2424 contains the pointer. If DEST is the string "InputFocus" the event is
2425 sent to the window that has the input focus.
2426 FROM is the frame sending the event. Use nil for currently selected frame.
2427 MESSAGE-TYPE is the name of an Atom as a string.
2428 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2429 bits. VALUES is a list of numbers, cons and/or strings containing the values
2430 to send. If a value is a string, it is converted to an Atom and the value of
2431 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2432 with the high 16 bits from the car and the lower 16 bit from the cdr.
2433 If more values than fits into the event is given, the excessive values
2435 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2437 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2439 CHECK_STRING (message_type
);
2440 x_send_client_event(display
, dest
, from
,
2441 XInternAtom (dpyinfo
->display
,
2442 SSDATA (message_type
),
2450 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
, Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2452 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2455 struct frame
*f
= check_x_frame (from
);
2458 CHECK_NUMBER (format
);
2459 CHECK_CONS (values
);
2461 if (x_check_property_data (values
) == -1)
2462 error ("Bad data in VALUES, must be number, cons or string");
2464 event
.xclient
.type
= ClientMessage
;
2465 event
.xclient
.format
= XFASTINT (format
);
2467 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2468 && event
.xclient
.format
!= 32)
2469 error ("FORMAT must be one of 8, 16 or 32");
2471 if (FRAMEP (dest
) || NILP (dest
))
2473 struct frame
*fdest
= check_x_frame (dest
);
2474 wdest
= FRAME_OUTER_WINDOW (fdest
);
2476 else if (STRINGP (dest
))
2478 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2479 wdest
= PointerWindow
;
2480 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2483 error ("DEST as a string must be one of PointerWindow or InputFocus");
2485 else if (INTEGERP (dest
))
2486 wdest
= (Window
) XFASTINT (dest
);
2487 else if (FLOATP (dest
))
2488 wdest
= (Window
) XFLOAT_DATA (dest
);
2489 else if (CONSP (dest
))
2491 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2492 error ("Both car and cdr for DEST must be numbers");
2494 wdest
= (Window
) cons_to_long (dest
);
2497 error ("DEST must be a frame, nil, string, number or cons");
2499 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2500 to_root
= wdest
== dpyinfo
->root_window
;
2504 event
.xclient
.message_type
= message_type
;
2505 event
.xclient
.display
= dpyinfo
->display
;
2507 /* Some clients (metacity for example) expects sending window to be here
2508 when sending to the root window. */
2509 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2512 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2513 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2514 event
.xclient
.format
);
2516 /* If event mask is 0 the event is sent to the client that created
2517 the destination window. But if we are sending to the root window,
2518 there is no such client. Then we set the event mask to 0xffff. The
2519 event then goes to clients selecting for events on the root window. */
2520 x_catch_errors (dpyinfo
->display
);
2522 int propagate
= to_root
? False
: True
;
2523 unsigned mask
= to_root
? 0xffff : 0;
2524 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2525 XFlush (dpyinfo
->display
);
2527 x_uncatch_errors ();
2533 syms_of_xselect (void)
2535 defsubr (&Sx_get_selection_internal
);
2536 defsubr (&Sx_own_selection_internal
);
2537 defsubr (&Sx_disown_selection_internal
);
2538 defsubr (&Sx_selection_owner_p
);
2539 defsubr (&Sx_selection_exists_p
);
2541 defsubr (&Sx_get_atom_name
);
2542 defsubr (&Sx_send_client_message
);
2543 defsubr (&Sx_register_dnd_atom
);
2545 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2546 staticpro (&reading_selection_reply
);
2547 reading_selection_window
= 0;
2548 reading_which_selection
= 0;
2550 property_change_wait_list
= 0;
2551 prop_location_identifier
= 0;
2552 property_change_reply
= Fcons (Qnil
, Qnil
);
2553 staticpro (&property_change_reply
);
2555 Vselection_alist
= Qnil
;
2556 staticpro (&Vselection_alist
);
2558 converted_selections
= NULL
;
2559 conversion_fail_tag
= None
;
2561 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2562 doc
: /* An alist associating X Windows selection-types with functions.
2563 These functions are called to convert the selection, with three args:
2564 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2565 a desired type to which the selection should be converted;
2566 and the local selection value (whatever was given to `x-own-selection').
2568 The function should return the value to send to the X server
2569 \(typically a string). A return value of nil
2570 means that the conversion could not be done.
2571 A return value which is the symbol `NULL'
2572 means that a side-effect was executed,
2573 and there is no meaningful selection value. */);
2574 Vselection_converter_alist
= Qnil
;
2576 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2577 doc
: /* A list of functions to be called when Emacs loses an X selection.
2578 \(This happens when some other X client makes its own selection
2579 or when a Lisp program explicitly clears the selection.)
2580 The functions are called with one argument, the selection type
2581 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2582 Vx_lost_selection_functions
= Qnil
;
2584 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2585 doc
: /* A list of functions to be called when Emacs answers a selection request.
2586 The functions are called with three arguments:
2587 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2588 - the selection-type which Emacs was asked to convert the
2589 selection into before sending (for example, `STRING' or `LENGTH');
2590 - a flag indicating success or failure for responding to the request.
2591 We might have failed (and declined the request) for any number of reasons,
2592 including being asked for a selection that we no longer own, or being asked
2593 to convert into a type that we don't know about or that is inappropriate.
2594 This hook doesn't let you change the behavior of Emacs's selection replies,
2595 it merely informs you that they have happened. */);
2596 Vx_sent_selection_functions
= Qnil
;
2598 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2599 doc
: /* Number of milliseconds to wait for a selection reply.
2600 If the selection owner doesn't reply in this time, we give up.
2601 A value of 0 means wait as long as necessary. This is initialized from the
2602 \"*selectionTimeout\" resource. */);
2603 x_selection_timeout
= 0;
2605 /* QPRIMARY is defined in keyboard.c. */
2606 DEFSYM (QSECONDARY
, "SECONDARY");
2607 DEFSYM (QSTRING
, "STRING");
2608 DEFSYM (QINTEGER
, "INTEGER");
2609 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2610 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2611 DEFSYM (QTEXT
, "TEXT");
2612 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2613 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2614 DEFSYM (QDELETE
, "DELETE");
2615 DEFSYM (QMULTIPLE
, "MULTIPLE");
2616 DEFSYM (QINCR
, "INCR");
2617 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2618 DEFSYM (QTARGETS
, "TARGETS");
2619 DEFSYM (QATOM
, "ATOM");
2620 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2621 DEFSYM (QNULL
, "NULL");
2622 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2623 DEFSYM (Qforeign_selection
, "foreign-selection");