1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2012 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"
38 #include "character.h"
41 #include "termhooks.h"
44 #include <X11/Xproto.h>
47 struct selection_data
;
49 static Lisp_Object
x_atom_to_symbol (Display
*dpy
, Atom atom
);
50 static Atom
symbol_to_x_atom (struct x_display_info
*, Lisp_Object
);
51 static void x_own_selection (Lisp_Object
, Lisp_Object
, Lisp_Object
);
52 static Lisp_Object
x_get_local_selection (Lisp_Object
, Lisp_Object
, int,
53 struct x_display_info
*);
54 static void x_decline_selection_request (struct input_event
*);
55 static Lisp_Object
x_selection_request_lisp_error (Lisp_Object
);
56 static Lisp_Object
queue_selection_requests_unwind (Lisp_Object
);
57 static Lisp_Object
x_catch_errors_unwind (Lisp_Object
);
58 static void x_reply_selection_request (struct input_event
*, struct x_display_info
*);
59 static int x_convert_selection (struct input_event
*, Lisp_Object
, Lisp_Object
,
60 Atom
, int, struct x_display_info
*);
61 static int waiting_for_other_props_on_window (Display
*, Window
);
62 static struct prop_location
*expect_property_change (Display
*, Window
,
64 static void unexpect_property_change (struct prop_location
*);
65 static Lisp_Object
wait_for_property_change_unwind (Lisp_Object
);
66 static void wait_for_property_change (struct prop_location
*);
67 static Lisp_Object
x_get_foreign_selection (Lisp_Object
, Lisp_Object
,
68 Lisp_Object
, Lisp_Object
);
69 static Lisp_Object
x_get_window_property_as_lisp_data (Display
*,
72 static Lisp_Object
selection_data_to_lisp_data (Display
*,
73 const unsigned char *,
74 ptrdiff_t, Atom
, int);
75 static void lisp_data_to_selection_data (Display
*, Lisp_Object
,
76 unsigned char **, Atom
*,
77 ptrdiff_t *, int *, int *);
78 static Lisp_Object
clean_local_selection_data (Lisp_Object
);
80 /* Printing traces to stderr. */
82 #ifdef TRACE_SELECTION
84 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
85 #define TRACE1(fmt, a0) \
86 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
87 #define TRACE2(fmt, a0, a1) \
88 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
89 #define TRACE3(fmt, a0, a1, a2) \
90 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
92 #define TRACE0(fmt) (void) 0
93 #define TRACE1(fmt, a0) (void) 0
94 #define TRACE2(fmt, a0, a1) (void) 0
98 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
99 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
100 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
102 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
103 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
105 static Lisp_Object Qcompound_text_with_extensions
;
107 static Lisp_Object Qforeign_selection
;
108 static Lisp_Object Qx_lost_selection_functions
, Qx_sent_selection_functions
;
110 /* Bytes needed to represent 'long' data. This is as per libX11; it
111 is not necessarily sizeof (long). */
112 #define X_LONG_SIZE 4
114 /* Extreme 'short' and 'long' values suitable for libX11. */
115 #define X_SHRT_MAX 0x7fff
116 #define X_SHRT_MIN (-1 - X_SHRT_MAX)
117 #define X_LONG_MAX 0x7fffffff
118 #define X_LONG_MIN (-1 - X_LONG_MAX)
119 #define X_ULONG_MAX 0xffffffffUL
121 /* If this is a smaller number than the max-request-size of the display,
122 emacs will use INCR selection transfer when the selection is larger
123 than this. The max-request-size is usually around 64k, so if you want
124 emacs to use incremental selection transfers when the selection is
125 smaller than that, set this. I added this mostly for debugging the
126 incremental transfer stuff, but it might improve server performance.
128 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
129 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
130 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
131 - 1 in place of INT_MAX. */
132 #define MAX_SELECTION_QUANTUM \
133 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
134 / max (X_LONG_SIZE, sizeof (long)))))
137 selection_quantum (Display
*display
)
139 long mrs
= XMaxRequestSize (display
);
140 return (mrs
< MAX_SELECTION_QUANTUM
/ X_LONG_SIZE
+ 25
141 ? (mrs
- 25) * X_LONG_SIZE
142 : MAX_SELECTION_QUANTUM
);
145 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
146 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
149 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
152 struct selection_event_queue
154 struct input_event event
;
155 struct selection_event_queue
*next
;
158 static struct selection_event_queue
*selection_queue
;
160 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
162 static int x_queue_selection_requests
;
164 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
167 x_queue_event (struct input_event
*event
)
169 struct selection_event_queue
*queue_tmp
;
171 /* Don't queue repeated requests.
172 This only happens for large requests which uses the incremental protocol. */
173 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
175 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
177 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
178 x_decline_selection_request (event
);
184 = (struct selection_event_queue
*) xmalloc (sizeof (struct selection_event_queue
));
186 if (queue_tmp
!= NULL
)
188 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
189 queue_tmp
->event
= *event
;
190 queue_tmp
->next
= selection_queue
;
191 selection_queue
= queue_tmp
;
195 /* Start queuing SELECTION_REQUEST_EVENT events. */
198 x_start_queuing_selection_requests (void)
200 if (x_queue_selection_requests
)
203 x_queue_selection_requests
++;
204 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
207 /* Stop queuing SELECTION_REQUEST_EVENT events. */
210 x_stop_queuing_selection_requests (void)
212 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
213 --x_queue_selection_requests
;
215 /* Take all the queued events and put them back
216 so that they get processed afresh. */
218 while (selection_queue
!= NULL
)
220 struct selection_event_queue
*queue_tmp
= selection_queue
;
221 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
222 kbd_buffer_unget_event (&queue_tmp
->event
);
223 selection_queue
= queue_tmp
->next
;
224 xfree ((char *)queue_tmp
);
229 /* This converts a Lisp symbol to a server Atom, avoiding a server
230 roundtrip whenever possible. */
233 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
236 if (NILP (sym
)) return 0;
237 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
238 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
239 if (EQ (sym
, QSTRING
)) return XA_STRING
;
240 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
241 if (EQ (sym
, QATOM
)) return XA_ATOM
;
242 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
243 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
244 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
245 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
246 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
247 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
248 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
249 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
250 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
251 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
252 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
253 if (!SYMBOLP (sym
)) abort ();
255 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
257 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
263 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
264 and calls to intern whenever possible. */
267 x_atom_to_symbol (Display
*dpy
, Atom atom
)
269 struct x_display_info
*dpyinfo
;
290 dpyinfo
= x_display_info_for_display (dpy
);
293 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
295 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
297 if (atom
== dpyinfo
->Xatom_TEXT
)
299 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
300 return QCOMPOUND_TEXT
;
301 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
303 if (atom
== dpyinfo
->Xatom_DELETE
)
305 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
307 if (atom
== dpyinfo
->Xatom_INCR
)
309 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
311 if (atom
== dpyinfo
->Xatom_TARGETS
)
313 if (atom
== dpyinfo
->Xatom_NULL
)
317 str
= XGetAtomName (dpy
, atom
);
319 TRACE1 ("XGetAtomName --> %s", str
);
320 if (! str
) return Qnil
;
323 /* This was allocated by Xlib, so use XFree. */
329 /* Do protocol to assert ourself as a selection owner.
330 FRAME shall be the owner; it must be a valid X frame.
331 Update the Vselection_alist so that we can reply to later requests for
335 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
338 struct frame
*f
= XFRAME (frame
);
339 Window selecting_window
= FRAME_X_WINDOW (f
);
340 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
341 Display
*display
= dpyinfo
->display
;
342 Time timestamp
= last_event_timestamp
;
343 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, 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_data
;
355 Lisp_Object prev_value
;
357 selection_data
= list4 (selection_name
, selection_value
,
358 INTEGER_TO_CONS (timestamp
), frame
);
359 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
361 dpyinfo
->terminal
->Vselection_alist
362 = Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
);
364 /* If we already owned the selection, remove the old selection
365 data. Don't use Fdelq as that may QUIT. */
366 if (!NILP (prev_value
))
368 /* We know it's not the CAR, so it's easy. */
369 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
370 for (; CONSP (rest
); rest
= XCDR (rest
))
371 if (EQ (prev_value
, Fcar (XCDR (rest
))))
373 XSETCDR (rest
, XCDR (XCDR (rest
)));
380 /* Given a selection-name and desired type, look up our local copy of
381 the selection value and convert it to the type.
382 Return nil, a string, a vector, a symbol, an integer, or a cons
383 that CONS_TO_INTEGER could plausibly handle.
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
,
391 int local_request
, struct x_display_info
*dpyinfo
)
393 Lisp_Object local_value
;
394 Lisp_Object handler_fn
, value
, check
;
396 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
398 if (NILP (local_value
)) return Qnil
;
400 /* TIMESTAMP is a special case. */
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 ptrdiff_t 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_INTEGER 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 static struct selection_data
*converted_selections
;
514 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
515 static Atom conversion_fail_tag
;
517 /* Used as an unwind-protect clause so that, if a selection-converter signals
518 an error, we tell the requestor 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 ();
589 /* Send the reply to a selection request event EVENT. */
591 #ifdef TRACE_SELECTION
592 static int x_reply_selection_request_cnt
;
593 #endif /* TRACE_SELECTION */
596 x_reply_selection_request (struct input_event
*event
,
597 struct x_display_info
*dpyinfo
)
600 XSelectionEvent
*reply
= &(reply_base
.xselection
);
601 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
602 Window window
= SELECTION_EVENT_REQUESTOR (event
);
603 ptrdiff_t bytes_remaining
;
604 int max_bytes
= selection_quantum (display
);
605 ptrdiff_t count
= SPECPDL_INDEX ();
606 struct selection_data
*cs
;
608 reply
->type
= SelectionNotify
;
609 reply
->display
= display
;
610 reply
->requestor
= window
;
611 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
612 reply
->time
= SELECTION_EVENT_TIME (event
);
613 reply
->target
= SELECTION_EVENT_TARGET (event
);
614 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
615 if (reply
->property
== None
)
616 reply
->property
= reply
->target
;
619 /* The protected block contains wait_for_property_change, which can
620 run random lisp code (process handlers) or signal. Therefore, we
621 put the x_uncatch_errors call in an unwind. */
622 record_unwind_protect (x_catch_errors_unwind
, Qnil
);
623 x_catch_errors (display
);
625 /* Loop over converted selections, storing them in the requested
626 properties. If data is large, only store the first N bytes
627 (section 2.7.2 of ICCCM). Note that we store the data for a
628 MULTIPLE request in the opposite order; the ICCM says only that
629 the conversion itself must be done in the same order. */
630 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
632 if (cs
->property
== None
)
635 bytes_remaining
= cs
->size
;
636 bytes_remaining
*= cs
->format
>> 3;
637 if (bytes_remaining
<= max_bytes
)
639 /* Send all the data at once, with minimal handshaking. */
640 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
641 XChangeProperty (display
, window
, cs
->property
,
642 cs
->type
, cs
->format
, PropModeReplace
,
647 /* Send an INCR tag to initiate incremental transfer. */
650 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
651 bytes_remaining
, XGetAtomName (display
, cs
->property
));
653 = expect_property_change (display
, window
, cs
->property
,
656 /* XChangeProperty expects an array of long even if long is
657 more than 32 bits. */
658 value
[0] = min (bytes_remaining
, X_LONG_MAX
);
659 XChangeProperty (display
, window
, cs
->property
,
660 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
661 (unsigned char *) value
, 1);
662 XSelectInput (display
, window
, PropertyChangeMask
);
666 /* Now issue the SelectionNotify event. */
667 XSendEvent (display
, window
, False
, 0L, &reply_base
);
670 #ifdef TRACE_SELECTION
672 char *sel
= XGetAtomName (display
, reply
->selection
);
673 char *tgt
= XGetAtomName (display
, reply
->target
);
674 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
675 sel
, tgt
, ++x_reply_selection_request_cnt
);
676 if (sel
) XFree (sel
);
677 if (tgt
) XFree (tgt
);
679 #endif /* TRACE_SELECTION */
681 /* Finish sending the rest of each of the INCR values. This should
682 be improved; there's a chance of deadlock if more than one
683 subtarget in a MULTIPLE selection requires an INCR transfer, and
684 the requestor and Emacs loop waiting on different transfers. */
685 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
688 int format_bytes
= cs
->format
/ 8;
689 int had_errors
= x_had_errors_p (display
);
692 bytes_remaining
= cs
->size
;
693 bytes_remaining
*= format_bytes
;
695 /* Wait for the requestor to ack by deleting the property.
696 This can run Lisp code (process handlers) or signal. */
699 TRACE1 ("Waiting for ACK (deletion of %s)",
700 XGetAtomName (display
, cs
->property
));
701 wait_for_property_change (cs
->wait_object
);
704 unexpect_property_change (cs
->wait_object
);
706 while (bytes_remaining
)
708 int i
= ((bytes_remaining
< max_bytes
)
710 : max_bytes
) / format_bytes
;
714 = expect_property_change (display
, window
, cs
->property
,
717 TRACE1 ("Sending increment of %d elements", i
);
718 TRACE1 ("Set %s to increment data",
719 XGetAtomName (display
, cs
->property
));
721 /* Append the next chunk of data to the property. */
722 XChangeProperty (display
, window
, cs
->property
,
723 cs
->type
, cs
->format
, PropModeAppend
,
725 bytes_remaining
-= i
* format_bytes
;
726 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
729 had_errors
= x_had_errors_p (display
);
732 if (had_errors
) break;
734 /* Wait for the requestor to ack this chunk by deleting
735 the property. This can run Lisp code or signal. */
736 TRACE1 ("Waiting for increment ACK (deletion of %s)",
737 XGetAtomName (display
, cs
->property
));
738 wait_for_property_change (cs
->wait_object
);
741 /* Now write a zero-length chunk to the property to tell the
742 requestor that we're done. */
744 if (! waiting_for_other_props_on_window (display
, window
))
745 XSelectInput (display
, window
, 0L);
747 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
748 XGetAtomName (display
, cs
->property
));
749 XChangeProperty (display
, window
, cs
->property
,
750 cs
->type
, cs
->format
, PropModeReplace
,
752 TRACE0 ("Done sending incrementally");
755 /* rms, 2003-01-03: I think I have fixed this bug. */
756 /* The window we're communicating with may have been deleted
757 in the meantime (that's a real situation from a bug report).
758 In this case, there may be events in the event queue still
759 referring to the deleted window, and we'll get a BadWindow error
760 in XTread_socket when processing the events. I don't have
761 an idea how to fix that. gerd, 2001-01-98. */
762 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
763 delivered before uncatch errors. */
764 XSync (display
, False
);
767 /* GTK queues events in addition to the queue in Xlib. So we
768 UNBLOCK to enter the event loop and get possible errors delivered,
769 and then BLOCK again because x_uncatch_errors requires it. */
771 /* This calls x_uncatch_errors. */
772 unbind_to (count
, Qnil
);
776 /* Handle a SelectionRequest event EVENT.
777 This is called from keyboard.c when such an event is found in the queue. */
780 x_handle_selection_request (struct input_event
*event
)
782 struct gcpro gcpro1
, gcpro2
;
783 Time local_selection_time
;
785 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
786 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
787 Atom selection
= SELECTION_EVENT_SELECTION (event
);
788 Lisp_Object selection_symbol
= x_atom_to_symbol (display
, selection
);
789 Atom target
= SELECTION_EVENT_TARGET (event
);
790 Lisp_Object target_symbol
= x_atom_to_symbol (display
, target
);
791 Atom property
= SELECTION_EVENT_PROPERTY (event
);
792 Lisp_Object local_selection_data
;
794 ptrdiff_t count
= SPECPDL_INDEX ();
795 GCPRO2 (local_selection_data
, target_symbol
);
797 if (!dpyinfo
) goto DONE
;
799 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
801 /* Decline if we don't own any selections. */
802 if (NILP (local_selection_data
)) goto DONE
;
804 /* Decline requests issued prior to our acquiring the selection. */
805 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
806 Time
, local_selection_time
);
807 if (SELECTION_EVENT_TIME (event
) != CurrentTime
808 && local_selection_time
> SELECTION_EVENT_TIME (event
))
811 x_selection_current_request
= event
;
812 selection_request_dpyinfo
= dpyinfo
;
813 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
815 /* We might be able to handle nested x_handle_selection_requests,
816 but this is difficult to test, and seems unimportant. */
817 x_start_queuing_selection_requests ();
818 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
820 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
821 SDATA (SYMBOL_NAME (selection_symbol
)),
822 SDATA (SYMBOL_NAME (target_symbol
)));
824 if (EQ (target_symbol
, QMULTIPLE
))
826 /* For MULTIPLE targets, the event property names a list of atom
827 pairs; the first atom names a target and the second names a
828 non-None property. */
829 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
830 Lisp_Object multprop
;
831 ptrdiff_t j
, nselections
;
833 if (property
== None
) goto DONE
;
835 = x_get_window_property_as_lisp_data (display
, requestor
, property
,
836 QMULTIPLE
, selection
);
838 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
841 nselections
= ASIZE (multprop
) / 2;
842 /* Perform conversions. This can signal. */
843 for (j
= 0; j
< nselections
; j
++)
845 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
846 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
847 AREF (multprop
, 2*j
+1));
849 if (subproperty
!= None
)
850 x_convert_selection (event
, selection_symbol
, subtarget
,
851 subproperty
, 1, dpyinfo
);
857 if (property
== None
)
858 property
= SELECTION_EVENT_TARGET (event
);
859 success
= x_convert_selection (event
, selection_symbol
,
860 target_symbol
, property
,
867 x_reply_selection_request (event
, dpyinfo
);
869 x_decline_selection_request (event
);
870 x_selection_current_request
= 0;
872 /* Run the `x-sent-selection-functions' abnormal hook. */
873 if (!NILP (Vx_sent_selection_functions
)
874 && !EQ (Vx_sent_selection_functions
, Qunbound
))
877 args
[0] = Qx_sent_selection_functions
;
878 args
[1] = selection_symbol
;
879 args
[2] = target_symbol
;
880 args
[3] = success
? Qt
: Qnil
;
881 Frun_hook_with_args (4, args
);
884 unbind_to (count
, Qnil
);
888 /* Perform the requested selection conversion, and write the data to
889 the converted_selections linked list, where it can be accessed by
890 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
891 the data even if conversion fails, using conversion_fail_tag.
893 Return 0 if the selection failed to convert, 1 otherwise. */
896 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
897 Lisp_Object target_symbol
, Atom property
,
898 int for_multiple
, struct x_display_info
*dpyinfo
)
901 Lisp_Object lisp_selection
;
902 struct selection_data
*cs
;
903 GCPRO1 (lisp_selection
);
906 = x_get_local_selection (selection_symbol
, target_symbol
,
909 /* A nil return value means we can't perform the conversion. */
910 if (NILP (lisp_selection
)
911 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
915 cs
= xmalloc (sizeof (struct selection_data
));
916 cs
->data
= (unsigned char *) &conversion_fail_tag
;
921 cs
->property
= property
;
922 cs
->wait_object
= NULL
;
923 cs
->next
= converted_selections
;
924 converted_selections
= cs
;
931 /* Otherwise, record the converted selection to binary. */
932 cs
= xmalloc (sizeof (struct selection_data
));
935 cs
->property
= property
;
936 cs
->wait_object
= NULL
;
937 cs
->next
= converted_selections
;
938 converted_selections
= cs
;
939 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
941 &(cs
->data
), &(cs
->type
),
942 &(cs
->size
), &(cs
->format
),
948 /* Handle a SelectionClear event EVENT, which indicates that some
949 client cleared out our previously asserted selection.
950 This is called from keyboard.c when such an event is found in the queue. */
953 x_handle_selection_clear (struct input_event
*event
)
955 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
956 Atom selection
= SELECTION_EVENT_SELECTION (event
);
957 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
959 Lisp_Object selection_symbol
, local_selection_data
;
960 Time local_selection_time
;
961 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
962 Lisp_Object Vselection_alist
;
964 TRACE0 ("x_handle_selection_clear");
966 if (!dpyinfo
) return;
968 selection_symbol
= x_atom_to_symbol (display
, selection
);
969 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
971 /* Well, we already believe that we don't own it, so that's just fine. */
972 if (NILP (local_selection_data
)) return;
974 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
975 Time
, local_selection_time
);
977 /* We have reasserted the selection since this SelectionClear was
978 generated, so we can disregard it. */
979 if (changed_owner_time
!= CurrentTime
980 && local_selection_time
> changed_owner_time
)
983 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
984 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
985 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
986 Vselection_alist
= XCDR (Vselection_alist
);
990 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
991 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
993 XSETCDR (rest
, XCDR (XCDR (rest
)));
997 dpyinfo
->terminal
->Vselection_alist
= Vselection_alist
;
999 /* Run the `x-lost-selection-functions' abnormal hook. */
1001 Lisp_Object args
[2];
1002 args
[0] = Qx_lost_selection_functions
;
1003 args
[1] = selection_symbol
;
1004 Frun_hook_with_args (2, args
);
1007 prepare_menu_bars ();
1008 redisplay_preserve_echo_area (20);
1012 x_handle_selection_event (struct input_event
*event
)
1014 TRACE0 ("x_handle_selection_event");
1015 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
1016 x_handle_selection_clear (event
);
1017 else if (x_queue_selection_requests
)
1018 x_queue_event (event
);
1020 x_handle_selection_request (event
);
1024 /* Clear all selections that were made from frame F.
1025 We do this when about to delete a frame. */
1028 x_clear_frame_selections (FRAME_PTR f
)
1032 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1033 struct terminal
*t
= dpyinfo
->terminal
;
1035 XSETFRAME (frame
, f
);
1037 /* Delete elements from the beginning of Vselection_alist. */
1038 while (CONSP (t
->Vselection_alist
)
1039 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
1041 /* Run the `x-lost-selection-functions' abnormal hook. */
1042 Lisp_Object args
[2];
1043 args
[0] = Qx_lost_selection_functions
;
1044 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
1045 Frun_hook_with_args (2, args
);
1047 t
->Vselection_alist
= XCDR (t
->Vselection_alist
);
1050 /* Delete elements after the beginning of Vselection_alist. */
1051 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1052 if (CONSP (XCDR (rest
))
1053 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1055 Lisp_Object args
[2];
1056 args
[0] = Qx_lost_selection_functions
;
1057 args
[1] = XCAR (XCAR (XCDR (rest
)));
1058 Frun_hook_with_args (2, args
);
1059 XSETCDR (rest
, XCDR (XCDR (rest
)));
1064 /* Nonzero if any properties for DISPLAY and WINDOW
1065 are on the list of what we are waiting for. */
1068 waiting_for_other_props_on_window (Display
*display
, Window window
)
1070 struct prop_location
*rest
= property_change_wait_list
;
1072 if (rest
->display
== display
&& rest
->window
== window
)
1079 /* Add an entry to the list of property changes we are waiting for.
1080 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1081 The return value is a number that uniquely identifies
1082 this awaited property change. */
1084 static struct prop_location
*
1085 expect_property_change (Display
*display
, Window window
,
1086 Atom property
, int state
)
1088 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1089 pl
->identifier
= ++prop_location_identifier
;
1090 pl
->display
= display
;
1091 pl
->window
= window
;
1092 pl
->property
= property
;
1093 pl
->desired_state
= state
;
1094 pl
->next
= property_change_wait_list
;
1096 property_change_wait_list
= pl
;
1100 /* Delete an entry from the list of property changes we are waiting for.
1101 IDENTIFIER is the number that uniquely identifies the entry. */
1104 unexpect_property_change (struct prop_location
*location
)
1106 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1109 if (rest
== location
)
1112 prev
->next
= rest
->next
;
1114 property_change_wait_list
= rest
->next
;
1123 /* Remove the property change expectation element for IDENTIFIER. */
1126 wait_for_property_change_unwind (Lisp_Object loc
)
1128 struct prop_location
*location
= XSAVE_VALUE (loc
)->pointer
;
1130 unexpect_property_change (location
);
1131 if (location
== property_change_reply_object
)
1132 property_change_reply_object
= 0;
1136 /* Actually wait for a property change.
1137 IDENTIFIER should be the value that expect_property_change returned. */
1140 wait_for_property_change (struct prop_location
*location
)
1143 ptrdiff_t count
= SPECPDL_INDEX ();
1145 if (property_change_reply_object
)
1148 /* Make sure to do unexpect_property_change if we quit or err. */
1149 record_unwind_protect (wait_for_property_change_unwind
,
1150 make_save_value (location
, 0));
1152 XSETCAR (property_change_reply
, Qnil
);
1153 property_change_reply_object
= location
;
1155 /* If the event we are waiting for arrives beyond here, it will set
1156 property_change_reply, because property_change_reply_object says so. */
1157 if (! location
->arrived
)
1159 secs
= x_selection_timeout
/ 1000;
1160 usecs
= (x_selection_timeout
% 1000) * 1000;
1161 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1162 wait_reading_process_output (secs
, usecs
, 0, 0,
1163 property_change_reply
, NULL
, 0);
1165 if (NILP (XCAR (property_change_reply
)))
1167 TRACE0 (" Timed out");
1168 error ("Timed out waiting for property-notify event");
1172 unbind_to (count
, Qnil
);
1175 /* Called from XTread_socket in response to a PropertyNotify event. */
1178 x_handle_property_notify (XPropertyEvent
*event
)
1180 struct prop_location
*rest
;
1182 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1185 && rest
->property
== event
->atom
1186 && rest
->window
== event
->window
1187 && rest
->display
== event
->display
1188 && rest
->desired_state
== event
->state
)
1190 TRACE2 ("Expected %s of property %s",
1191 (event
->state
== PropertyDelete
? "deletion" : "change"),
1192 XGetAtomName (event
->display
, event
->atom
));
1196 /* If this is the one wait_for_property_change is waiting for,
1197 tell it to wake up. */
1198 if (rest
== property_change_reply_object
)
1199 XSETCAR (property_change_reply
, Qt
);
1208 /* Variables for communication with x_handle_selection_notify. */
1209 static Atom reading_which_selection
;
1210 static Lisp_Object reading_selection_reply
;
1211 static Window reading_selection_window
;
1213 /* Do protocol to read selection-data from the server.
1214 Converts this to Lisp data and returns it.
1215 FRAME is the frame whose X window shall request the selection. */
1218 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1219 Lisp_Object time_stamp
, Lisp_Object frame
)
1221 struct frame
*f
= XFRAME (frame
);
1222 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1223 Display
*display
= dpyinfo
->display
;
1224 Window requestor_window
= FRAME_X_WINDOW (f
);
1225 Time requestor_time
= last_event_timestamp
;
1226 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1227 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1228 Atom type_atom
= (CONSP (target_type
)
1229 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1230 : symbol_to_x_atom (dpyinfo
, target_type
));
1233 if (!FRAME_LIVE_P (f
))
1236 if (! NILP (time_stamp
))
1237 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1240 TRACE2 ("Get selection %s, type %s",
1241 XGetAtomName (display
, type_atom
),
1242 XGetAtomName (display
, target_property
));
1244 x_catch_errors (display
);
1245 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1246 requestor_window
, requestor_time
);
1247 x_check_errors (display
, "Can't convert selection: %s");
1248 x_uncatch_errors ();
1250 /* Prepare to block until the reply has been read. */
1251 reading_selection_window
= requestor_window
;
1252 reading_which_selection
= selection_atom
;
1253 XSETCAR (reading_selection_reply
, Qnil
);
1255 /* It should not be necessary to stop handling selection requests
1256 during this time. In fact, the SAVE_TARGETS mechanism requires
1257 us to handle a clipboard manager's requests before it returns
1260 x_start_queuing_selection_requests ();
1261 record_unwind_protect (queue_selection_requests_unwind
, Qnil
);
1266 /* This allows quits. Also, don't wait forever. */
1267 secs
= x_selection_timeout
/ 1000;
1268 usecs
= (x_selection_timeout
% 1000) * 1000;
1269 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1270 wait_reading_process_output (secs
, usecs
, 0, 0,
1271 reading_selection_reply
, NULL
, 0);
1272 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1274 if (NILP (XCAR (reading_selection_reply
)))
1275 error ("Timed out waiting for reply from selection owner");
1276 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1279 /* Otherwise, the selection is waiting for us on the requested property. */
1281 x_get_window_property_as_lisp_data (display
, requestor_window
,
1282 target_property
, target_type
,
1286 /* Subroutines of x_get_window_property_as_lisp_data */
1288 /* Use xfree, not XFree, to free the data obtained with this function. */
1291 x_get_window_property (Display
*display
, Window window
, Atom property
,
1292 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1293 Atom
*actual_type_ret
, int *actual_format_ret
,
1294 unsigned long *actual_size_ret
, int delete_p
)
1296 ptrdiff_t total_size
;
1297 unsigned long bytes_remaining
;
1298 ptrdiff_t offset
= 0;
1299 unsigned char *data
= 0;
1300 unsigned char *tmp_data
= 0;
1302 int buffer_size
= selection_quantum (display
);
1304 /* Wide enough to avoid overflow in expressions using it. */
1305 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1307 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1308 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1309 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1310 ptrdiff_t total_size_max
=
1311 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1312 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1313 : LONG_MAX
* x_long_size
);
1317 /* First probe the thing to find out how big it is. */
1318 result
= XGetWindowProperty (display
, window
, property
,
1319 0L, 0L, False
, AnyPropertyType
,
1320 actual_type_ret
, actual_format_ret
,
1322 &bytes_remaining
, &tmp_data
);
1323 if (result
!= Success
)
1326 /* This was allocated by Xlib, so use XFree. */
1327 XFree ((char *) tmp_data
);
1329 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1332 if (total_size_max
< bytes_remaining
)
1334 total_size
= bytes_remaining
;
1335 data
= malloc (total_size
+ 1);
1337 goto memory_exhausted
;
1339 /* Now read, until we've gotten it all. */
1340 while (bytes_remaining
)
1342 ptrdiff_t bytes_gotten
;
1345 = XGetWindowProperty (display
, window
, property
,
1346 offset
/ X_LONG_SIZE
,
1347 buffer_size
/ X_LONG_SIZE
,
1350 actual_type_ret
, actual_format_ret
,
1351 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1353 /* If this doesn't return Success at this point, it means that
1354 some clod deleted the selection while we were in the midst of
1355 reading it. Deal with that, I guess.... */
1356 if (result
!= Success
)
1359 bytes_per_item
= *actual_format_ret
>> 3;
1360 xassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1362 /* The man page for XGetWindowProperty says:
1363 "If the returned format is 32, the returned data is represented
1364 as a long array and should be cast to that type to obtain the
1366 This applies even if long is more than 32 bits, the X library
1367 converts from 32 bit elements received from the X server to long
1368 and passes the long array to us. Thus, for that case memcpy can not
1369 be used. We convert to a 32 bit type here, because so much code
1372 The bytes and offsets passed to XGetWindowProperty refers to the
1373 property and those are indeed in 32 bit quantities if format is 32. */
1375 bytes_gotten
= *actual_size_ret
;
1376 bytes_gotten
*= bytes_per_item
;
1378 TRACE2 ("Read %"pD
"d bytes from property %s",
1379 bytes_gotten
, XGetAtomName (display
, property
));
1381 if (total_size
- offset
< bytes_gotten
)
1383 unsigned char *data1
;
1384 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1385 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1387 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1388 data1
= realloc (data
, total_size
+ 1);
1390 goto memory_exhausted
;
1394 if (32 < BITS_PER_LONG
&& *actual_format_ret
== 32)
1397 int *idata
= (int *) (data
+ offset
);
1398 long *ldata
= (long *) tmp_data
;
1400 for (i
= 0; i
< *actual_size_ret
; ++i
)
1401 idata
[i
] = ldata
[i
];
1404 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1406 offset
+= bytes_gotten
;
1408 /* This was allocated by Xlib, so use XFree. */
1409 XFree ((char *) tmp_data
);
1413 data
[offset
] = '\0';
1418 *bytes_ret
= offset
;
1424 memory_full (SIZE_MAX
);
1429 memory_full (total_size
+ 1);
1432 /* Use xfree, not XFree, to free the data obtained with this function. */
1435 receive_incremental_selection (Display
*display
, Window window
, Atom property
,
1436 Lisp_Object target_type
,
1437 unsigned int min_size_bytes
,
1438 unsigned char **data_ret
,
1439 ptrdiff_t *size_bytes_ret
,
1440 Atom
*type_ret
, int *format_ret
,
1441 unsigned long *size_ret
)
1443 ptrdiff_t offset
= 0;
1444 struct prop_location
*wait_object
;
1445 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1446 memory_full (SIZE_MAX
);
1447 *data_ret
= (unsigned char *) xmalloc (min_size_bytes
);
1448 *size_bytes_ret
= min_size_bytes
;
1450 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1452 /* At this point, we have read an INCR property.
1453 Delete the property to ack it.
1454 (But first, prepare to receive the next event in this handshake.)
1456 Now, we must loop, waiting for the sending window to put a value on
1457 that property, then reading the property, then deleting it to ack.
1458 We are done when the sender places a property of length 0.
1461 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1462 TRACE1 (" Delete property %s",
1463 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1464 XDeleteProperty (display
, window
, property
);
1465 TRACE1 (" Expect new value of property %s",
1466 SDATA (SYMBOL_NAME (x_atom_to_symbol (display
, property
))));
1467 wait_object
= expect_property_change (display
, window
, property
,
1474 unsigned char *tmp_data
;
1475 ptrdiff_t tmp_size_bytes
;
1477 TRACE0 (" Wait for property change");
1478 wait_for_property_change (wait_object
);
1480 /* expect it again immediately, because x_get_window_property may
1481 .. no it won't, I don't get it.
1482 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1483 TRACE0 (" Get property value");
1484 x_get_window_property (display
, window
, property
,
1485 &tmp_data
, &tmp_size_bytes
,
1486 type_ret
, format_ret
, size_ret
, 1);
1488 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1490 if (tmp_size_bytes
== 0) /* we're done */
1492 TRACE0 ("Done reading incrementally");
1494 if (! waiting_for_other_props_on_window (display
, window
))
1495 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1496 /* Use xfree, not XFree, because x_get_window_property
1497 calls xmalloc itself. */
1503 TRACE1 (" ACK by deleting property %s",
1504 XGetAtomName (display
, property
));
1505 XDeleteProperty (display
, window
, property
);
1506 wait_object
= expect_property_change (display
, window
, property
,
1511 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1512 *data_ret
= xpalloc (*data_ret
, size_bytes_ret
,
1513 tmp_size_bytes
- (*size_bytes_ret
- offset
),
1516 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1517 offset
+= tmp_size_bytes
;
1519 /* Use xfree, not XFree, because x_get_window_property
1520 calls xmalloc itself. */
1526 /* Fetch a value from property PROPERTY of X window WINDOW on display
1527 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1531 x_get_window_property_as_lisp_data (Display
*display
, Window window
,
1533 Lisp_Object target_type
,
1534 Atom selection_atom
)
1538 unsigned long actual_size
;
1539 unsigned char *data
= 0;
1540 ptrdiff_t bytes
= 0;
1542 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1544 TRACE0 ("Reading selection data");
1546 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1547 &actual_type
, &actual_format
, &actual_size
, 1);
1550 int there_is_a_selection_owner
;
1552 there_is_a_selection_owner
1553 = XGetSelectionOwner (display
, selection_atom
);
1555 if (there_is_a_selection_owner
)
1556 signal_error ("Selection owner couldn't convert",
1558 ? list2 (target_type
,
1559 x_atom_to_symbol (display
, actual_type
))
1562 signal_error ("No selection",
1563 x_atom_to_symbol (display
, selection_atom
));
1566 if (actual_type
== dpyinfo
->Xatom_INCR
)
1568 /* That wasn't really the data, just the beginning. */
1570 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1572 /* Use xfree, not XFree, because x_get_window_property
1573 calls xmalloc itself. */
1574 xfree ((char *) data
);
1576 receive_incremental_selection (display
, window
, property
, target_type
,
1577 min_size_bytes
, &data
, &bytes
,
1578 &actual_type
, &actual_format
,
1583 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1584 XDeleteProperty (display
, window
, property
);
1588 /* It's been read. Now convert it to a lisp object in some semi-rational
1590 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1591 actual_type
, actual_format
);
1593 /* Use xfree, not XFree, because x_get_window_property
1594 calls xmalloc itself. */
1595 xfree ((char *) data
);
1599 /* These functions convert from the selection data read from the server into
1600 something that we can use from Lisp, and vice versa.
1602 Type: Format: Size: Lisp Type:
1603 ----- ------- ----- -----------
1606 ATOM 32 > 1 Vector of Symbols
1608 * 16 > 1 Vector of Integers
1609 * 32 1 if <=16 bits: Integer
1610 if > 16 bits: Cons of top16, bot16
1611 * 32 > 1 Vector of the above
1613 When converting a Lisp number to C, it is assumed to be of format 16 if
1614 it is an integer, and of format 32 if it is a cons of two integers.
1616 When converting a vector of numbers from Lisp to C, it is assumed to be
1617 of format 16 if every element in the vector is an integer, and is assumed
1618 to be of format 32 if any element is a cons of two integers.
1620 When converting an object to C, it may be of the form (SYMBOL . <data>)
1621 where SYMBOL is what we should claim that the type is. Format and
1622 representation are as above.
1624 Important: When format is 32, data should contain an array of int,
1625 not an array of long as the X library returns. This makes a difference
1626 when sizeof(long) != sizeof(int). */
1631 selection_data_to_lisp_data (Display
*display
, const unsigned char *data
,
1632 ptrdiff_t size
, Atom type
, int format
)
1634 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1636 if (type
== dpyinfo
->Xatom_NULL
)
1639 /* Convert any 8-bit data to a string, for compactness. */
1640 else if (format
== 8)
1642 Lisp_Object str
, lispy_type
;
1644 str
= make_unibyte_string ((char *) data
, size
);
1645 /* Indicate that this string is from foreign selection by a text
1646 property `foreign-selection' so that the caller of
1647 x-get-selection-internal (usually x-get-selection) can know
1648 that the string must be decode. */
1649 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1650 lispy_type
= QCOMPOUND_TEXT
;
1651 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1652 lispy_type
= QUTF8_STRING
;
1654 lispy_type
= QSTRING
;
1655 Fput_text_property (make_number (0), make_number (size
),
1656 Qforeign_selection
, lispy_type
, str
);
1659 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1660 a vector of symbols. */
1661 else if (type
== XA_ATOM
1662 /* Treat ATOM_PAIR type similar to list of atoms. */
1663 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1666 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1667 But the callers of these function has made sure the data for
1668 format == 32 is an array of int. Thus, use int instead
1670 int *idata
= (int *) data
;
1672 if (size
== sizeof (int))
1673 return x_atom_to_symbol (display
, (Atom
) idata
[0]);
1676 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (int)),
1678 for (i
= 0; i
< size
/ sizeof (int); i
++)
1679 Faset (v
, make_number (i
),
1680 x_atom_to_symbol (display
, (Atom
) idata
[i
]));
1685 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1686 If the number is 32 bits and won't fit in a Lisp_Int,
1687 convert it to a cons of integers, 16 bits in each half.
1689 else if (format
== 32 && size
== sizeof (int))
1690 return INTEGER_TO_CONS (((int *) data
) [0]);
1691 else if (format
== 16 && size
== sizeof (short))
1692 return make_number (((short *) data
) [0]);
1694 /* Convert any other kind of data to a vector of numbers, represented
1695 as above (as an integer, or a cons of two 16 bit integers.)
1697 else if (format
== 16)
1701 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1702 for (i
= 0; i
< size
/ 2; i
++)
1704 short j
= ((short *) data
) [i
];
1705 Faset (v
, make_number (i
), make_number (j
));
1712 Lisp_Object v
= Fmake_vector (make_number (size
/ X_LONG_SIZE
),
1714 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1716 int j
= ((int *) data
) [i
];
1717 Faset (v
, make_number (i
), INTEGER_TO_CONS (j
));
1723 /* Convert OBJ to an X long value, and return it as unsigned long.
1724 OBJ should be an integer or a cons representing an integer.
1725 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1726 unsigned long values: in theory these values are supposed to be
1727 signed but in practice unsigned 32-bit data are communicated via X
1728 selections and we need to support that. */
1729 static unsigned long
1730 cons_to_x_long (Lisp_Object obj
)
1732 if (X_ULONG_MAX
<= INTMAX_MAX
1733 || XINT (INTEGERP (obj
) ? obj
: XCAR (obj
)) < 0)
1734 return cons_to_signed (obj
, X_LONG_MIN
, min (X_ULONG_MAX
, INTMAX_MAX
));
1736 return cons_to_unsigned (obj
, X_ULONG_MAX
);
1739 /* Use xfree, not XFree, to free the data obtained with this function. */
1742 lisp_data_to_selection_data (Display
*display
, Lisp_Object obj
,
1743 unsigned char **data_ret
, Atom
*type_ret
,
1744 ptrdiff_t *size_ret
,
1745 int *format_ret
, int *nofree_ret
)
1747 Lisp_Object type
= Qnil
;
1748 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1752 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1756 if (CONSP (obj
) && NILP (XCDR (obj
)))
1760 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1761 { /* This is not the same as declining */
1767 else if (STRINGP (obj
))
1769 if (SCHARS (obj
) < SBYTES (obj
))
1770 /* OBJ is a multibyte string containing a non-ASCII char. */
1771 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1775 *size_ret
= SBYTES (obj
);
1776 *data_ret
= SDATA (obj
);
1779 else if (SYMBOLP (obj
))
1781 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1784 (*data_ret
) [sizeof (Atom
)] = 0;
1785 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, obj
);
1786 if (NILP (type
)) type
= QATOM
;
1788 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1790 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1793 (*data_ret
) [sizeof (short)] = 0;
1794 (*(short **) data_ret
) [0] = XINT (obj
);
1795 if (NILP (type
)) type
= QINTEGER
;
1797 else if (INTEGERP (obj
)
1798 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1799 && (INTEGERP (XCDR (obj
))
1800 || (CONSP (XCDR (obj
))
1801 && INTEGERP (XCAR (XCDR (obj
)))))))
1803 *data_ret
= (unsigned char *) xmalloc (sizeof (unsigned long) + 1);
1806 (*data_ret
) [sizeof (unsigned long)] = 0;
1807 (*(unsigned long **) data_ret
) [0] = cons_to_x_long (obj
);
1808 if (NILP (type
)) type
= QINTEGER
;
1810 else if (VECTORP (obj
))
1812 /* Lisp_Vectors may represent a set of ATOMs;
1813 a set of 16 or 32 bit INTEGERs;
1814 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1817 ptrdiff_t size
= ASIZE (obj
);
1819 if (SYMBOLP (AREF (obj
, 0)))
1820 /* This vector is an ATOM set */
1822 if (NILP (type
)) type
= QATOM
;
1823 for (i
= 0; i
< size
; i
++)
1824 if (!SYMBOLP (AREF (obj
, i
)))
1825 signal_error ("All elements of selection vector must have same type", obj
);
1827 *data_ret
= xnmalloc (size
, sizeof (Atom
));
1830 for (i
= 0; i
< size
; i
++)
1831 (*(Atom
**) data_ret
) [i
]
1832 = symbol_to_x_atom (dpyinfo
, AREF (obj
, i
));
1835 /* This vector is an INTEGER set, or something like it */
1838 int data_size
= sizeof (short);
1839 if (NILP (type
)) type
= QINTEGER
;
1840 for (i
= 0; i
< size
; i
++)
1842 if (! RANGED_INTEGERP (X_SHRT_MIN
, AREF (obj
, i
),
1845 /* Use sizeof (long) even if it is more than 32 bits.
1846 See comment in x_get_window_property and
1847 x_fill_property_data. */
1848 data_size
= sizeof (long);
1853 *data_ret
= xnmalloc (size
, data_size
);
1854 *format_ret
= format
;
1856 for (i
= 0; i
< size
; i
++)
1859 (*((unsigned long **) data_ret
)) [i
] =
1860 cons_to_x_long (AREF (obj
, i
));
1862 (*((short **) data_ret
)) [i
] =
1863 XINT (AREF (obj
, i
));
1868 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1870 *type_ret
= symbol_to_x_atom (dpyinfo
, type
);
1874 clean_local_selection_data (Lisp_Object obj
)
1877 && INTEGERP (XCAR (obj
))
1878 && CONSP (XCDR (obj
))
1879 && INTEGERP (XCAR (XCDR (obj
)))
1880 && NILP (XCDR (XCDR (obj
))))
1881 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1884 && INTEGERP (XCAR (obj
))
1885 && INTEGERP (XCDR (obj
)))
1887 if (XINT (XCAR (obj
)) == 0)
1889 if (XINT (XCAR (obj
)) == -1)
1890 return make_number (- XINT (XCDR (obj
)));
1895 ptrdiff_t size
= ASIZE (obj
);
1898 return clean_local_selection_data (AREF (obj
, 0));
1899 copy
= Fmake_vector (make_number (size
), Qnil
);
1900 for (i
= 0; i
< size
; i
++)
1901 ASET (copy
, i
, clean_local_selection_data (AREF (obj
, i
)));
1907 /* Called from XTread_socket to handle SelectionNotify events.
1908 If it's the selection we are waiting for, stop waiting
1909 by setting the car of reading_selection_reply to non-nil.
1910 We store t there if the reply is successful, lambda if not. */
1913 x_handle_selection_notify (XSelectionEvent
*event
)
1915 if (event
->requestor
!= reading_selection_window
)
1917 if (event
->selection
!= reading_which_selection
)
1920 TRACE0 ("Received SelectionNotify");
1921 XSETCAR (reading_selection_reply
,
1922 (event
->property
!= 0 ? Qt
: Qlambda
));
1926 /* From a Lisp_Object, return a suitable frame for selection
1927 operations. OBJECT may be a frame, a terminal object, or nil
1928 (which stands for the selected frame--or, if that is not an X
1929 frame, the first X display on the list). If no suitable frame can
1930 be found, return NULL. */
1932 static struct frame
*
1933 frame_for_x_selection (Lisp_Object object
)
1940 f
= XFRAME (selected_frame
);
1941 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1944 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1946 f
= XFRAME (XCAR (tail
));
1947 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1951 else if (TERMINALP (object
))
1953 struct terminal
*t
= get_terminal (object
, 1);
1954 if (t
->type
== output_x_window
)
1956 for (tail
= Vframe_list
; CONSP (tail
); tail
= XCDR (tail
))
1958 f
= XFRAME (XCAR (tail
));
1959 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1964 else if (FRAMEP (object
))
1966 f
= XFRAME (object
);
1967 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1975 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1976 Sx_own_selection_internal
, 2, 3, 0,
1977 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1978 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1979 \(Those are literal upper-case symbol names, since that's what X expects.)
1980 VALUE is typically a string, or a cons of two markers, but may be
1981 anything that the functions on `selection-converter-alist' know about.
1983 FRAME should be a frame that should own the selection. If omitted or
1984 nil, it defaults to the selected frame.
1986 On Nextstep, FRAME is unused. */)
1987 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1989 if (NILP (frame
)) frame
= selected_frame
;
1990 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1991 error ("X selection unavailable for this frame");
1993 CHECK_SYMBOL (selection
);
1994 if (NILP (value
)) error ("VALUE may not be nil");
1995 x_own_selection (selection
, value
, frame
);
2000 /* Request the selection value from the owner. If we are the owner,
2001 simply return our selection value. If we are not the owner, this
2002 will block until all of the data has arrived. */
2004 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
2005 Sx_get_selection_internal
, 2, 4, 0,
2006 doc
: /* Return text selected from some X window.
2007 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2008 \(Those are literal upper-case symbol names, since that's what X expects.)
2009 TARGET-TYPE is the type of data desired, typically `STRING'.
2011 TIME-STAMP is the time to use in the XConvertSelection call for foreign
2012 selections. If omitted, defaults to the time for the last event.
2014 TERMINAL should be a terminal object or a frame specifying the X
2015 server to query. If omitted or nil, that stands for the selected
2016 frame's display, or the first available X display.
2018 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
2019 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
2020 Lisp_Object time_stamp
, Lisp_Object terminal
)
2022 Lisp_Object val
= Qnil
;
2023 struct gcpro gcpro1
, gcpro2
;
2024 struct frame
*f
= frame_for_x_selection (terminal
);
2025 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
2027 CHECK_SYMBOL (selection_symbol
);
2028 CHECK_SYMBOL (target_type
);
2029 if (EQ (target_type
, QMULTIPLE
))
2030 error ("Retrieving MULTIPLE selections is currently unimplemented");
2032 error ("X selection unavailable for this frame");
2034 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
2035 FRAME_X_DISPLAY_INFO (f
));
2037 if (NILP (val
) && FRAME_LIVE_P (f
))
2040 XSETFRAME (frame
, f
);
2041 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
2042 time_stamp
, frame
));
2045 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
2048 if (CONSP (val
) && NILP (XCDR (val
)))
2051 RETURN_UNGCPRO (clean_local_selection_data (val
));
2054 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2055 Sx_disown_selection_internal
, 1, 3, 0,
2056 doc
: /* If we own the selection SELECTION, disown it.
2057 Disowning it means there is no such selection.
2059 Sets the last-change time for the selection to TIME-OBJECT (by default
2060 the time of the last event).
2062 TERMINAL should be a terminal object or a frame specifying the X
2063 server to query. If omitted or nil, that stands for the selected
2064 frame's display, or the first available X display.
2066 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2067 On MS-DOS, all this does is return non-nil if we own the selection. */)
2068 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2071 Atom selection_atom
;
2073 struct selection_input_event sie
;
2074 struct input_event ie
;
2076 struct frame
*f
= frame_for_x_selection (terminal
);
2077 struct x_display_info
*dpyinfo
;
2082 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2083 CHECK_SYMBOL (selection
);
2085 /* Don't disown the selection when we're not the owner. */
2086 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2089 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2092 if (NILP (time_object
))
2093 timestamp
= last_event_timestamp
;
2095 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2096 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2099 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2100 generated for a window which owns the selection when that window sets
2101 the selection owner to None. The NCD server does, the MIT Sun4 server
2102 doesn't. So we synthesize one; this means we might get two, but
2103 that's ok, because the second one won't have any effect. */
2104 SELECTION_EVENT_DISPLAY (&event
.sie
) = dpyinfo
->display
;
2105 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2106 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2107 x_handle_selection_clear (&event
.ie
);
2112 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2114 doc
: /* Whether the current Emacs process owns the given X Selection.
2115 The arg should be the name of the selection in question, typically one of
2116 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2117 \(Those are literal upper-case symbol names, since that's what X expects.)
2118 For convenience, the symbol nil is the same as `PRIMARY',
2119 and t is the same as `SECONDARY'.
2121 TERMINAL should be a terminal object or a frame specifying the X
2122 server to query. If omitted or nil, that stands for the selected
2123 frame's display, or the first available X display.
2125 On Nextstep, TERMINAL is unused. */)
2126 (Lisp_Object selection
, Lisp_Object terminal
)
2128 struct frame
*f
= frame_for_x_selection (terminal
);
2130 CHECK_SYMBOL (selection
);
2131 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2132 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2134 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_X_DISPLAY_INFO (f
))))
2140 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2142 doc
: /* Whether there is an owner for the given X selection.
2143 SELECTION should be the name of the selection in question, typically
2144 one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2145 `CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2146 symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
2148 TERMINAL should be a terminal object or a frame specifying the X
2149 server to query. If omitted or nil, that stands for the selected
2150 frame's display, or the first available X display.
2152 On Nextstep, TERMINAL is unused. */)
2153 (Lisp_Object selection
, Lisp_Object terminal
)
2157 struct frame
*f
= frame_for_x_selection (terminal
);
2158 struct x_display_info
*dpyinfo
;
2160 CHECK_SYMBOL (selection
);
2161 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2162 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2167 dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2169 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2172 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2173 if (atom
== 0) return Qnil
;
2175 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2177 return (owner
? Qt
: Qnil
);
2181 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2182 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2185 x_clipboard_manager_save (Lisp_Object frame
)
2187 struct frame
*f
= XFRAME (frame
);
2188 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2189 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2191 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2192 dpyinfo
->Xatom_EMACS_TMP
,
2193 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2194 (unsigned char *) &data
, 1);
2195 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2200 /* Error handler for x_clipboard_manager_save_frame. */
2203 x_clipboard_manager_error_1 (Lisp_Object err
)
2205 Lisp_Object args
[2];
2206 args
[0] = build_string ("X clipboard manager error: %s\n\
2207 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2208 args
[1] = CAR (CDR (err
));
2213 /* Error handler for x_clipboard_manager_save_all. */
2216 x_clipboard_manager_error_2 (Lisp_Object err
)
2218 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2219 If the problem persists, set `x-select-enable-clipboard-manager' \
2224 /* Called from delete_frame: save any clipboard owned by FRAME to the
2225 clipboard manager. Do nothing if FRAME does not own the clipboard,
2226 or if no clipboard manager is present. */
2229 x_clipboard_manager_save_frame (Lisp_Object frame
)
2233 if (!NILP (Vx_select_enable_clipboard_manager
)
2235 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2236 && FRAME_LIVE_P (f
))
2238 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2239 Lisp_Object local_selection
2240 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2242 if (!NILP (local_selection
)
2243 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2244 && XGetSelectionOwner (dpyinfo
->display
,
2245 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2246 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2247 x_clipboard_manager_error_1
);
2251 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2252 clipboard manager. Do nothing if FRAME does not own the clipboard,
2253 or if no clipboard manager is present. */
2256 x_clipboard_manager_save_all (void)
2258 /* Loop through all X displays, saving owned clipboards. */
2259 struct x_display_info
*dpyinfo
;
2260 Lisp_Object local_selection
, local_frame
;
2262 if (NILP (Vx_select_enable_clipboard_manager
))
2265 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2267 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2268 if (NILP (local_selection
)
2269 || !XGetSelectionOwner (dpyinfo
->display
,
2270 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2273 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2274 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2276 Lisp_Object args
[1];
2277 args
[0] = build_string ("Saving clipboard to X clipboard manager...");
2280 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2281 Qt
, x_clipboard_manager_error_2
);
2287 /***********************************************************************
2288 Drag and drop support
2289 ***********************************************************************/
2290 /* Check that lisp values are of correct type for x_fill_property_data.
2291 That is, number, string or a cons with two numbers (low and high 16
2292 bit parts of a 32 bit number). Return the number of items in DATA,
2293 or -1 if there is an error. */
2296 x_check_property_data (Lisp_Object data
)
2301 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2303 Lisp_Object o
= XCAR (iter
);
2305 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2307 else if (CONSP (o
) &&
2308 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2310 if (size
== INT_MAX
)
2318 /* Convert lisp values to a C array. Values may be a number, a string
2319 which is taken as an X atom name and converted to the atom value, or
2320 a cons containing the two 16 bit parts of a 32 bit number.
2322 DPY is the display use to look up X atoms.
2323 DATA is a Lisp list of values to be converted.
2324 RET is the C array that contains the converted values. It is assumed
2325 it is big enough to hold all values.
2326 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2327 be stored in RET. Note that long is used for 32 even if long is more
2328 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2329 XClientMessageEvent). */
2332 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2335 long *d32
= (long *) ret
;
2336 short *d16
= (short *) ret
;
2337 char *d08
= (char *) ret
;
2340 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2342 Lisp_Object o
= XCAR (iter
);
2344 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2345 val
= cons_to_signed (o
, LONG_MIN
, LONG_MAX
);
2346 else if (STRINGP (o
))
2349 val
= (long) XInternAtom (dpy
, SSDATA (o
), False
);
2353 error ("Wrong type, must be string, number or cons");
2357 if (CHAR_MIN
<= val
&& val
<= CHAR_MAX
)
2360 error ("Out of 'char' range");
2362 else if (format
== 16)
2364 if (SHRT_MIN
<= val
&& val
<= SHRT_MAX
)
2367 error ("Out of 'short' range");
2374 /* Convert an array of C values to a Lisp list.
2375 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2376 DATA is a C array of values to be converted.
2377 TYPE is the type of the data. Only XA_ATOM is special, it converts
2378 each number in DATA to its corresponding X atom as a symbol.
2379 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2381 SIZE is the number of elements in DATA.
2383 Important: When format is 32, data should contain an array of int,
2384 not an array of long as the X library returns. This makes a difference
2385 when sizeof(long) != sizeof(int).
2387 Also see comment for selection_data_to_lisp_data above. */
2390 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2391 Atom type
, int format
, long unsigned int size
)
2393 ptrdiff_t format_bytes
= format
>> 3;
2394 if (PTRDIFF_MAX
/ format_bytes
< size
)
2395 memory_full (SIZE_MAX
);
2396 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2397 data
, size
* format_bytes
, type
, format
);
2400 /* Get the mouse position in frame relative coordinates. */
2403 mouse_position_for_drop (FRAME_PTR f
, int *x
, int *y
)
2405 Window root
, dummy_window
;
2410 XQueryPointer (FRAME_X_DISPLAY (f
),
2411 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2413 /* The root window which contains the pointer. */
2416 /* Window pointer is on, not used */
2419 /* The position on that root window. */
2422 /* x/y in dummy_window coordinates, not used. */
2425 /* Modifier keys and pointer buttons, about which
2427 (unsigned int *) &dummy
);
2430 /* Absolute to relative. */
2431 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2432 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2437 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2438 Sx_get_atom_name
, 1, 2, 0,
2439 doc
: /* Return the X atom name for VALUE as a string.
2440 VALUE may be a number or a cons where the car is the upper 16 bits and
2441 the cdr is the lower 16 bits of a 32 bit value.
2442 Use the display for FRAME or the current frame if FRAME is not given or nil.
2444 If the value is 0 or the atom is not known, return the empty string. */)
2445 (Lisp_Object value
, Lisp_Object frame
)
2447 struct frame
*f
= check_x_frame (frame
);
2450 Lisp_Object ret
= Qnil
;
2451 Display
*dpy
= FRAME_X_DISPLAY (f
);
2455 CONS_TO_INTEGER (value
, Atom
, atom
);
2458 x_catch_errors (dpy
);
2459 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2460 had_errors
= x_had_errors_p (dpy
);
2461 x_uncatch_errors ();
2464 ret
= build_string (name
);
2466 if (atom
&& name
) XFree (name
);
2467 if (NILP (ret
)) ret
= empty_unibyte_string
;
2474 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2475 Sx_register_dnd_atom
, 1, 2, 0,
2476 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2477 ATOM can be a symbol or a string. The ATOM is interned on the display that
2478 FRAME is on. If FRAME is nil, the selected frame is used. */)
2479 (Lisp_Object atom
, Lisp_Object frame
)
2482 struct frame
*f
= check_x_frame (frame
);
2484 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
2488 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2489 else if (STRINGP (atom
))
2492 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2496 error ("ATOM must be a symbol or a string");
2498 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2499 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2502 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2503 dpyinfo
->x_dnd_atoms
=
2504 xpalloc (dpyinfo
->x_dnd_atoms
, &dpyinfo
->x_dnd_atoms_size
,
2505 1, -1, sizeof *dpyinfo
->x_dnd_atoms
);
2507 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2511 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2514 x_handle_dnd_message (struct frame
*f
, XClientMessageEvent
*event
,
2515 struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2519 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2520 unsigned long size
= 160/event
->format
;
2522 unsigned char *data
= (unsigned char *) event
->data
.b
;
2526 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2527 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2529 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2531 XSETFRAME (frame
, f
);
2533 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2534 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2535 function expects them to be of size int (i.e. 32). So to be able to
2536 use that function, put the data in the form it expects if format is 32. */
2538 if (32 < BITS_PER_LONG
&& event
->format
== 32)
2540 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2541 idata
[i
] = event
->data
.l
[i
];
2542 data
= (unsigned char *) idata
;
2545 vec
= Fmake_vector (make_number (4), Qnil
);
2546 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2547 event
->message_type
)));
2548 ASET (vec
, 1, frame
);
2549 ASET (vec
, 2, make_number (event
->format
));
2550 ASET (vec
, 3, x_property_data_to_lisp (f
,
2552 event
->message_type
,
2556 mouse_position_for_drop (f
, &x
, &y
);
2557 bufp
->kind
= DRAG_N_DROP_EVENT
;
2558 bufp
->frame_or_window
= frame
;
2559 bufp
->timestamp
= CurrentTime
;
2560 bufp
->x
= make_number (x
);
2561 bufp
->y
= make_number (y
);
2563 bufp
->modifiers
= 0;
2568 DEFUN ("x-send-client-message", Fx_send_client_event
,
2569 Sx_send_client_message
, 6, 6, 0,
2570 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2572 For DISPLAY, specify either a frame or a display name (a string).
2573 If DISPLAY is nil, that stands for the selected frame's display.
2574 DEST may be a number, in which case it is a Window id. The value 0 may
2575 be used to send to the root window of the DISPLAY.
2576 If DEST is a cons, it is converted to a 32 bit number
2577 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2578 number is then used as a window id.
2579 If DEST is a frame the event is sent to the outer window of that frame.
2580 A value of nil means the currently selected frame.
2581 If DEST is the string "PointerWindow" the event is sent to the window that
2582 contains the pointer. If DEST is the string "InputFocus" the event is
2583 sent to the window that has the input focus.
2584 FROM is the frame sending the event. Use nil for currently selected frame.
2585 MESSAGE-TYPE is the name of an Atom as a string.
2586 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2587 bits. VALUES is a list of numbers, cons and/or strings containing the values
2588 to send. If a value is a string, it is converted to an Atom and the value of
2589 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2590 with the high 16 bits from the car and the lower 16 bit from the cdr.
2591 If more values than fits into the event is given, the excessive values
2593 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2594 Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2596 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2598 CHECK_STRING (message_type
);
2599 x_send_client_event (display
, dest
, from
,
2600 XInternAtom (dpyinfo
->display
,
2601 SSDATA (message_type
),
2609 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2610 Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2612 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2615 struct frame
*f
= check_x_frame (from
);
2618 CHECK_NUMBER (format
);
2619 CHECK_CONS (values
);
2621 if (x_check_property_data (values
) == -1)
2622 error ("Bad data in VALUES, must be number, cons or string");
2624 if (XINT (format
) != 8 && XINT (format
) != 16 && XINT (format
) != 32)
2625 error ("FORMAT must be one of 8, 16 or 32");
2627 event
.xclient
.type
= ClientMessage
;
2628 event
.xclient
.format
= XINT (format
);
2630 if (FRAMEP (dest
) || NILP (dest
))
2632 struct frame
*fdest
= check_x_frame (dest
);
2633 wdest
= FRAME_OUTER_WINDOW (fdest
);
2635 else if (STRINGP (dest
))
2637 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2638 wdest
= PointerWindow
;
2639 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2642 error ("DEST as a string must be one of PointerWindow or InputFocus");
2644 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2645 CONS_TO_INTEGER (dest
, Window
, wdest
);
2647 error ("DEST must be a frame, nil, string, number or cons");
2649 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2650 to_root
= wdest
== dpyinfo
->root_window
;
2654 event
.xclient
.message_type
= message_type
;
2655 event
.xclient
.display
= dpyinfo
->display
;
2657 /* Some clients (metacity for example) expects sending window to be here
2658 when sending to the root window. */
2659 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2662 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2663 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2664 event
.xclient
.format
);
2666 /* If event mask is 0 the event is sent to the client that created
2667 the destination window. But if we are sending to the root window,
2668 there is no such client. Then we set the event mask to 0xffff. The
2669 event then goes to clients selecting for events on the root window. */
2670 x_catch_errors (dpyinfo
->display
);
2672 int propagate
= to_root
? False
: True
;
2673 unsigned mask
= to_root
? 0xffff : 0;
2674 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2675 XFlush (dpyinfo
->display
);
2677 x_uncatch_errors ();
2683 syms_of_xselect (void)
2685 defsubr (&Sx_get_selection_internal
);
2686 defsubr (&Sx_own_selection_internal
);
2687 defsubr (&Sx_disown_selection_internal
);
2688 defsubr (&Sx_selection_owner_p
);
2689 defsubr (&Sx_selection_exists_p
);
2691 defsubr (&Sx_get_atom_name
);
2692 defsubr (&Sx_send_client_message
);
2693 defsubr (&Sx_register_dnd_atom
);
2695 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2696 staticpro (&reading_selection_reply
);
2697 reading_selection_window
= 0;
2698 reading_which_selection
= 0;
2700 property_change_wait_list
= 0;
2701 prop_location_identifier
= 0;
2702 property_change_reply
= Fcons (Qnil
, Qnil
);
2703 staticpro (&property_change_reply
);
2705 converted_selections
= NULL
;
2706 conversion_fail_tag
= None
;
2708 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2709 doc
: /* An alist associating X Windows selection-types with functions.
2710 These functions are called to convert the selection, with three args:
2711 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2712 a desired type to which the selection should be converted;
2713 and the local selection value (whatever was given to `x-own-selection').
2715 The function should return the value to send to the X server
2716 \(typically a string). A return value of nil
2717 means that the conversion could not be done.
2718 A return value which is the symbol `NULL'
2719 means that a side-effect was executed,
2720 and there is no meaningful selection value. */);
2721 Vselection_converter_alist
= Qnil
;
2723 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2724 doc
: /* A list of functions to be called when Emacs loses an X selection.
2725 \(This happens when some other X client makes its own selection
2726 or when a Lisp program explicitly clears the selection.)
2727 The functions are called with one argument, the selection type
2728 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2729 Vx_lost_selection_functions
= Qnil
;
2731 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2732 doc
: /* A list of functions to be called when Emacs answers a selection request.
2733 The functions are called with three arguments:
2734 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2735 - the selection-type which Emacs was asked to convert the
2736 selection into before sending (for example, `STRING' or `LENGTH');
2737 - a flag indicating success or failure for responding to the request.
2738 We might have failed (and declined the request) for any number of reasons,
2739 including being asked for a selection that we no longer own, or being asked
2740 to convert into a type that we don't know about or that is inappropriate.
2741 This hook doesn't let you change the behavior of Emacs's selection replies,
2742 it merely informs you that they have happened. */);
2743 Vx_sent_selection_functions
= Qnil
;
2745 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2746 Vx_select_enable_clipboard_manager
,
2747 doc
: /* Whether to enable X clipboard manager support.
2748 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2749 while owning the X clipboard, the clipboard contents are saved to the
2750 clipboard manager if one is present. */);
2751 Vx_select_enable_clipboard_manager
= Qt
;
2753 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2754 doc
: /* Number of milliseconds to wait for a selection reply.
2755 If the selection owner doesn't reply in this time, we give up.
2756 A value of 0 means wait as long as necessary. This is initialized from the
2757 \"*selectionTimeout\" resource. */);
2758 x_selection_timeout
= 0;
2760 /* QPRIMARY is defined in keyboard.c. */
2761 DEFSYM (QSECONDARY
, "SECONDARY");
2762 DEFSYM (QSTRING
, "STRING");
2763 DEFSYM (QINTEGER
, "INTEGER");
2764 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2765 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2766 DEFSYM (QTEXT
, "TEXT");
2767 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2768 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2769 DEFSYM (QDELETE
, "DELETE");
2770 DEFSYM (QMULTIPLE
, "MULTIPLE");
2771 DEFSYM (QINCR
, "INCR");
2772 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2773 DEFSYM (QTARGETS
, "TARGETS");
2774 DEFSYM (QATOM
, "ATOM");
2775 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2776 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2777 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2778 DEFSYM (QNULL
, "NULL");
2779 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2780 DEFSYM (Qforeign_selection
, "foreign-selection");
2781 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2782 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");