1 /* X Selection processing for Emacs.
2 Copyright (C) 1993-1997, 2000-2014 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 */
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"
37 #include "character.h"
40 #include "termhooks.h"
43 #include <X11/Xproto.h>
46 struct selection_data
;
48 static void x_decline_selection_request (struct input_event
*);
49 static int x_convert_selection (struct input_event
*, Lisp_Object
, Lisp_Object
,
50 Atom
, int, struct x_display_info
*);
51 static int waiting_for_other_props_on_window (Display
*, Window
);
52 static struct prop_location
*expect_property_change (Display
*, Window
,
54 static void unexpect_property_change (struct prop_location
*);
55 static void wait_for_property_change (struct prop_location
*);
56 static Lisp_Object
x_get_window_property_as_lisp_data (struct x_display_info
*,
59 static Lisp_Object
selection_data_to_lisp_data (struct x_display_info
*,
60 const unsigned char *,
61 ptrdiff_t, Atom
, int);
62 static void lisp_data_to_selection_data (struct x_display_info
*, Lisp_Object
,
63 struct selection_data
*);
65 /* Printing traces to stderr. */
67 #ifdef TRACE_SELECTION
69 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid ())
70 #define TRACE1(fmt, a0) \
71 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0)
72 #define TRACE2(fmt, a0, a1) \
73 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1)
74 #define TRACE3(fmt, a0, a1, a2) \
75 fprintf (stderr, "%"pMd": " fmt "\n", (printmax_t) getpid (), a0, a1, a2)
77 #define TRACE0(fmt) (void) 0
78 #define TRACE1(fmt, a0) (void) 0
79 #define TRACE2(fmt, a0, a1) (void) 0
83 static Lisp_Object QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
84 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
85 QATOM_PAIR
, QCLIPBOARD_MANAGER
, QSAVE_TARGETS
;
87 static Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
88 static Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
90 static Lisp_Object Qcompound_text_with_extensions
;
92 static Lisp_Object Qforeign_selection
;
93 static Lisp_Object Qx_lost_selection_functions
, Qx_sent_selection_functions
;
95 /* Bytes needed to represent 'long' data. This is as per libX11; it
96 is not necessarily sizeof (long). */
99 /* If this is a smaller number than the max-request-size of the display,
100 emacs will use INCR selection transfer when the selection is larger
101 than this. The max-request-size is usually around 64k, so if you want
102 emacs to use incremental selection transfers when the selection is
103 smaller than that, set this. I added this mostly for debugging the
104 incremental transfer stuff, but it might improve server performance.
106 This value cannot exceed INT_MAX / max (X_LONG_SIZE, sizeof (long))
107 because it is multiplied by X_LONG_SIZE and by sizeof (long) in
108 subscript calculations. Similarly for PTRDIFF_MAX - 1 or SIZE_MAX
109 - 1 in place of INT_MAX. */
110 #define MAX_SELECTION_QUANTUM \
111 ((int) min (0xFFFFFF, (min (INT_MAX, min (PTRDIFF_MAX, SIZE_MAX) - 1) \
112 / max (X_LONG_SIZE, sizeof (long)))))
115 selection_quantum (Display
*display
)
117 long mrs
= XMaxRequestSize (display
);
118 return (mrs
< MAX_SELECTION_QUANTUM
/ X_LONG_SIZE
+ 25
119 ? (mrs
- 25) * X_LONG_SIZE
120 : MAX_SELECTION_QUANTUM
);
123 #define LOCAL_SELECTION(selection_symbol,dpyinfo) \
124 assq_no_quit (selection_symbol, dpyinfo->terminal->Vselection_alist)
127 /* Define a queue to save up SELECTION_REQUEST_EVENT events for later
130 struct selection_event_queue
132 struct input_event event
;
133 struct selection_event_queue
*next
;
136 static struct selection_event_queue
*selection_queue
;
138 /* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
140 static int x_queue_selection_requests
;
142 /* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
145 x_queue_event (struct input_event
*event
)
147 struct selection_event_queue
*queue_tmp
;
149 /* Don't queue repeated requests.
150 This only happens for large requests which uses the incremental protocol. */
151 for (queue_tmp
= selection_queue
; queue_tmp
; queue_tmp
= queue_tmp
->next
)
153 if (!memcmp (&queue_tmp
->event
, event
, sizeof (*event
)))
155 TRACE1 ("DECLINE DUP SELECTION EVENT %p", queue_tmp
);
156 x_decline_selection_request (event
);
161 queue_tmp
= xmalloc (sizeof *queue_tmp
);
162 TRACE1 ("QUEUE SELECTION EVENT %p", queue_tmp
);
163 queue_tmp
->event
= *event
;
164 queue_tmp
->next
= selection_queue
;
165 selection_queue
= queue_tmp
;
168 /* Start queuing SELECTION_REQUEST_EVENT events. */
171 x_start_queuing_selection_requests (void)
173 if (x_queue_selection_requests
)
176 x_queue_selection_requests
++;
177 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests
);
180 /* Stop queuing SELECTION_REQUEST_EVENT events. */
183 x_stop_queuing_selection_requests (void)
185 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests
);
186 --x_queue_selection_requests
;
188 /* Take all the queued events and put them back
189 so that they get processed afresh. */
191 while (selection_queue
!= NULL
)
193 struct selection_event_queue
*queue_tmp
= selection_queue
;
194 TRACE1 ("RESTORE SELECTION EVENT %p", queue_tmp
);
195 kbd_buffer_unget_event (&queue_tmp
->event
);
196 selection_queue
= queue_tmp
->next
;
202 /* This converts a Lisp symbol to a server Atom, avoiding a server
203 roundtrip whenever possible. */
206 symbol_to_x_atom (struct x_display_info
*dpyinfo
, Lisp_Object sym
)
209 if (NILP (sym
)) return 0;
210 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
211 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
212 if (EQ (sym
, QSTRING
)) return XA_STRING
;
213 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
214 if (EQ (sym
, QATOM
)) return XA_ATOM
;
215 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
216 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
217 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
218 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
219 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
220 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
221 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
222 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
223 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
224 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
225 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
226 if (!SYMBOLP (sym
)) emacs_abort ();
228 TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym
)));
230 val
= XInternAtom (dpyinfo
->display
, SSDATA (SYMBOL_NAME (sym
)), False
);
236 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
237 and calls to intern whenever possible. */
240 x_atom_to_symbol (struct x_display_info
*dpyinfo
, Atom atom
)
264 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
266 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
268 if (atom
== dpyinfo
->Xatom_TEXT
)
270 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
271 return QCOMPOUND_TEXT
;
272 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
274 if (atom
== dpyinfo
->Xatom_DELETE
)
276 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
278 if (atom
== dpyinfo
->Xatom_INCR
)
280 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
282 if (atom
== dpyinfo
->Xatom_TARGETS
)
284 if (atom
== dpyinfo
->Xatom_NULL
)
288 str
= XGetAtomName (dpyinfo
->display
, atom
);
290 TRACE1 ("XGetAtomName --> %s", str
);
291 if (! str
) return Qnil
;
294 /* This was allocated by Xlib, so use XFree. */
300 /* Do protocol to assert ourself as a selection owner.
301 FRAME shall be the owner; it must be a valid X frame.
302 Update the Vselection_alist so that we can reply to later requests for
306 x_own_selection (Lisp_Object selection_name
, Lisp_Object selection_value
,
309 struct frame
*f
= XFRAME (frame
);
310 Window selecting_window
= FRAME_X_WINDOW (f
);
311 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
312 Display
*display
= dpyinfo
->display
;
313 Time timestamp
= dpyinfo
->last_user_time
;
314 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_name
);
317 x_catch_errors (display
);
318 XSetSelectionOwner (display
, selection_atom
, selecting_window
, timestamp
);
319 x_check_errors (display
, "Can't set selection: %s");
323 /* Now update the local cache */
325 Lisp_Object selection_data
;
326 Lisp_Object prev_value
;
328 selection_data
= list4 (selection_name
, selection_value
,
329 INTEGER_TO_CONS (timestamp
), frame
);
330 prev_value
= LOCAL_SELECTION (selection_name
, dpyinfo
);
334 Fcons (selection_data
, dpyinfo
->terminal
->Vselection_alist
));
336 /* If we already owned the selection, remove the old selection
337 data. Don't use Fdelq as that may QUIT. */
338 if (!NILP (prev_value
))
340 /* We know it's not the CAR, so it's easy. */
341 Lisp_Object rest
= dpyinfo
->terminal
->Vselection_alist
;
342 for (; CONSP (rest
); rest
= XCDR (rest
))
343 if (EQ (prev_value
, Fcar (XCDR (rest
))))
345 XSETCDR (rest
, XCDR (XCDR (rest
)));
352 /* Given a selection-name and desired type, look up our local copy of
353 the selection value and convert it to the type.
354 Return nil, a string, a vector, a symbol, an integer, or a cons
355 that CONS_TO_INTEGER could plausibly handle.
356 This function is used both for remote requests (LOCAL_REQUEST is zero)
357 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
359 This calls random Lisp code, and may signal or gc. */
362 x_get_local_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
363 int local_request
, struct x_display_info
*dpyinfo
)
365 Lisp_Object local_value
;
366 Lisp_Object handler_fn
, value
, check
;
368 local_value
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
370 if (NILP (local_value
)) return Qnil
;
372 /* TIMESTAMP is a special case. */
373 if (EQ (target_type
, QTIMESTAMP
))
376 value
= XCAR (XCDR (XCDR (local_value
)));
380 /* Don't allow a quit within the converter.
381 When the user types C-g, he would be surprised
382 if by luck it came during a converter. */
383 ptrdiff_t count
= SPECPDL_INDEX ();
384 specbind (Qinhibit_quit
, Qt
);
386 CHECK_SYMBOL (target_type
);
387 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
388 /* gcpro is not needed here since nothing but HANDLER_FN
389 is live, and that ought to be a symbol. */
391 if (!NILP (handler_fn
))
392 value
= call3 (handler_fn
,
393 selection_symbol
, (local_request
? Qnil
: target_type
),
394 XCAR (XCDR (local_value
)));
397 unbind_to (count
, Qnil
);
400 /* Make sure this value is of a type that we could transmit
401 to another X client. */
405 && SYMBOLP (XCAR (value
)))
406 check
= XCDR (value
);
414 /* Check for a value that CONS_TO_INTEGER could handle. */
415 else if (CONSP (check
)
416 && INTEGERP (XCAR (check
))
417 && (INTEGERP (XCDR (check
))
419 (CONSP (XCDR (check
))
420 && INTEGERP (XCAR (XCDR (check
)))
421 && NILP (XCDR (XCDR (check
))))))
424 signal_error ("Invalid data returned by selection-conversion function",
425 list2 (handler_fn
, value
));
428 /* Subroutines of x_reply_selection_request. */
430 /* Send a SelectionNotify event to the requestor with property=None,
431 meaning we were unable to do what they wanted. */
434 x_decline_selection_request (struct input_event
*event
)
437 XSelectionEvent
*reply
= &(reply_base
.xselection
);
439 reply
->type
= SelectionNotify
;
440 reply
->display
= SELECTION_EVENT_DISPLAY (event
);
441 reply
->requestor
= SELECTION_EVENT_REQUESTOR (event
);
442 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
443 reply
->time
= SELECTION_EVENT_TIME (event
);
444 reply
->target
= SELECTION_EVENT_TARGET (event
);
445 reply
->property
= None
;
447 /* The reason for the error may be that the receiver has
448 died in the meantime. Handle that case. */
450 x_catch_errors (reply
->display
);
451 XSendEvent (reply
->display
, reply
->requestor
, False
, 0, &reply_base
);
452 XFlush (reply
->display
);
457 /* This is the selection request currently being processed.
458 It is set to zero when the request is fully processed. */
459 static struct input_event
*x_selection_current_request
;
461 /* Display info in x_selection_request. */
463 static struct x_display_info
*selection_request_dpyinfo
;
465 /* Raw selection data, for sending to a requestor window. */
467 struct selection_data
475 /* This can be set to non-NULL during x_reply_selection_request, if
476 the selection is waiting for an INCR transfer to complete. Don't
477 free these; that's done by unexpect_property_change. */
478 struct prop_location
*wait_object
;
479 struct selection_data
*next
;
482 /* Linked list of the above (in support of MULTIPLE targets). */
484 static struct selection_data
*converted_selections
;
486 /* "Data" to send a requestor for a failed MULTIPLE subtarget. */
487 static Atom conversion_fail_tag
;
489 /* Used as an unwind-protect clause so that, if a selection-converter signals
490 an error, we tell the requestor that we were unable to do what they wanted
491 before we throw to top-level or go into the debugger or whatever. */
494 x_selection_request_lisp_error (void)
496 struct selection_data
*cs
, *next
;
498 for (cs
= converted_selections
; cs
; cs
= next
)
501 if (cs
->nofree
== 0 && cs
->data
)
505 converted_selections
= NULL
;
507 if (x_selection_current_request
!= 0
508 && selection_request_dpyinfo
->display
)
509 x_decline_selection_request (x_selection_current_request
);
513 x_catch_errors_unwind (void)
521 /* This stuff is so that INCR selections are reentrant (that is, so we can
522 be servicing multiple INCR selection requests simultaneously.) I haven't
523 actually tested that yet. */
525 /* Keep a list of the property changes that are awaited. */
535 struct prop_location
*next
;
538 static int prop_location_identifier
;
540 static Lisp_Object property_change_reply
;
542 static struct prop_location
*property_change_reply_object
;
544 static struct prop_location
*property_change_wait_list
;
547 /* Send the reply to a selection request event EVENT. */
549 #ifdef TRACE_SELECTION
550 static int x_reply_selection_request_cnt
;
551 #endif /* TRACE_SELECTION */
554 x_reply_selection_request (struct input_event
*event
,
555 struct x_display_info
*dpyinfo
)
558 XSelectionEvent
*reply
= &(reply_base
.xselection
);
559 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
560 Window window
= SELECTION_EVENT_REQUESTOR (event
);
561 ptrdiff_t bytes_remaining
;
562 int max_bytes
= selection_quantum (display
);
563 ptrdiff_t count
= SPECPDL_INDEX ();
564 struct selection_data
*cs
;
566 reply
->type
= SelectionNotify
;
567 reply
->display
= display
;
568 reply
->requestor
= window
;
569 reply
->selection
= SELECTION_EVENT_SELECTION (event
);
570 reply
->time
= SELECTION_EVENT_TIME (event
);
571 reply
->target
= SELECTION_EVENT_TARGET (event
);
572 reply
->property
= SELECTION_EVENT_PROPERTY (event
);
573 if (reply
->property
== None
)
574 reply
->property
= reply
->target
;
577 /* The protected block contains wait_for_property_change, which can
578 run random lisp code (process handlers) or signal. Therefore, we
579 put the x_uncatch_errors call in an unwind. */
580 record_unwind_protect_void (x_catch_errors_unwind
);
581 x_catch_errors (display
);
583 /* Loop over converted selections, storing them in the requested
584 properties. If data is large, only store the first N bytes
585 (section 2.7.2 of ICCCM). Note that we store the data for a
586 MULTIPLE request in the opposite order; the ICCM says only that
587 the conversion itself must be done in the same order. */
588 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
590 if (cs
->property
== None
)
593 bytes_remaining
= cs
->size
;
594 bytes_remaining
*= cs
->format
>> 3;
595 if (bytes_remaining
<= max_bytes
)
597 /* Send all the data at once, with minimal handshaking. */
598 TRACE1 ("Sending all %"pD
"d bytes", bytes_remaining
);
599 XChangeProperty (display
, window
, cs
->property
,
600 cs
->type
, cs
->format
, PropModeReplace
,
605 /* Send an INCR tag to initiate incremental transfer. */
608 TRACE2 ("Start sending %"pD
"d bytes incrementally (%s)",
609 bytes_remaining
, XGetAtomName (display
, cs
->property
));
611 = expect_property_change (display
, window
, cs
->property
,
614 /* XChangeProperty expects an array of long even if long is
615 more than 32 bits. */
616 value
[0] = min (bytes_remaining
, X_LONG_MAX
);
617 XChangeProperty (display
, window
, cs
->property
,
618 dpyinfo
->Xatom_INCR
, 32, PropModeReplace
,
619 (unsigned char *) value
, 1);
620 XSelectInput (display
, window
, PropertyChangeMask
);
624 /* Now issue the SelectionNotify event. */
625 XSendEvent (display
, window
, False
, 0, &reply_base
);
628 #ifdef TRACE_SELECTION
630 char *sel
= XGetAtomName (display
, reply
->selection
);
631 char *tgt
= XGetAtomName (display
, reply
->target
);
632 TRACE3 ("Sent SelectionNotify: %s, target %s (%d)",
633 sel
, tgt
, ++x_reply_selection_request_cnt
);
634 if (sel
) XFree (sel
);
635 if (tgt
) XFree (tgt
);
637 #endif /* TRACE_SELECTION */
639 /* Finish sending the rest of each of the INCR values. This should
640 be improved; there's a chance of deadlock if more than one
641 subtarget in a MULTIPLE selection requires an INCR transfer, and
642 the requestor and Emacs loop waiting on different transfers. */
643 for (cs
= converted_selections
; cs
; cs
= cs
->next
)
646 int format_bytes
= cs
->format
/ 8;
647 bool had_errors_p
= x_had_errors_p (display
);
650 bytes_remaining
= cs
->size
;
651 bytes_remaining
*= format_bytes
;
653 /* Wait for the requestor to ack by deleting the property.
654 This can run Lisp code (process handlers) or signal. */
657 TRACE1 ("Waiting for ACK (deletion of %s)",
658 XGetAtomName (display
, cs
->property
));
659 wait_for_property_change (cs
->wait_object
);
662 unexpect_property_change (cs
->wait_object
);
664 while (bytes_remaining
)
666 int i
= ((bytes_remaining
< max_bytes
)
668 : max_bytes
) / format_bytes
;
672 = expect_property_change (display
, window
, cs
->property
,
675 TRACE1 ("Sending increment of %d elements", i
);
676 TRACE1 ("Set %s to increment data",
677 XGetAtomName (display
, cs
->property
));
679 /* Append the next chunk of data to the property. */
680 XChangeProperty (display
, window
, cs
->property
,
681 cs
->type
, cs
->format
, PropModeAppend
,
683 bytes_remaining
-= i
* format_bytes
;
684 cs
->data
+= i
* ((cs
->format
== 32) ? sizeof (long)
687 had_errors_p
= x_had_errors_p (display
);
690 if (had_errors_p
) break;
692 /* Wait for the requestor to ack this chunk by deleting
693 the property. This can run Lisp code or signal. */
694 TRACE1 ("Waiting for increment ACK (deletion of %s)",
695 XGetAtomName (display
, cs
->property
));
696 wait_for_property_change (cs
->wait_object
);
699 /* Now write a zero-length chunk to the property to tell the
700 requestor that we're done. */
702 if (! waiting_for_other_props_on_window (display
, window
))
703 XSelectInput (display
, window
, 0);
705 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
706 XGetAtomName (display
, cs
->property
));
707 XChangeProperty (display
, window
, cs
->property
,
708 cs
->type
, cs
->format
, PropModeReplace
,
710 TRACE0 ("Done sending incrementally");
713 /* rms, 2003-01-03: I think I have fixed this bug. */
714 /* The window we're communicating with may have been deleted
715 in the meantime (that's a real situation from a bug report).
716 In this case, there may be events in the event queue still
717 referring to the deleted window, and we'll get a BadWindow error
718 in XTread_socket when processing the events. I don't have
719 an idea how to fix that. gerd, 2001-01-98. */
720 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
721 delivered before uncatch errors. */
722 XSync (display
, False
);
725 /* GTK queues events in addition to the queue in Xlib. So we
726 UNBLOCK to enter the event loop and get possible errors delivered,
727 and then BLOCK again because x_uncatch_errors requires it. */
729 /* This calls x_uncatch_errors. */
730 unbind_to (count
, Qnil
);
734 /* Handle a SelectionRequest event EVENT.
735 This is called from keyboard.c when such an event is found in the queue. */
738 x_handle_selection_request (struct input_event
*event
)
740 struct gcpro gcpro1
, gcpro2
;
741 Time local_selection_time
;
743 struct x_display_info
*dpyinfo
= SELECTION_EVENT_DPYINFO (event
);
744 Atom selection
= SELECTION_EVENT_SELECTION (event
);
745 Lisp_Object selection_symbol
= x_atom_to_symbol (dpyinfo
, selection
);
746 Atom target
= SELECTION_EVENT_TARGET (event
);
747 Lisp_Object target_symbol
= x_atom_to_symbol (dpyinfo
, target
);
748 Atom property
= SELECTION_EVENT_PROPERTY (event
);
749 Lisp_Object local_selection_data
;
751 ptrdiff_t count
= SPECPDL_INDEX ();
752 GCPRO2 (local_selection_data
, target_symbol
);
754 if (!dpyinfo
) goto DONE
;
756 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
758 /* Decline if we don't own any selections. */
759 if (NILP (local_selection_data
)) goto DONE
;
761 /* Decline requests issued prior to our acquiring the selection. */
762 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
763 Time
, local_selection_time
);
764 if (SELECTION_EVENT_TIME (event
) != CurrentTime
765 && local_selection_time
> SELECTION_EVENT_TIME (event
))
768 x_selection_current_request
= event
;
769 selection_request_dpyinfo
= dpyinfo
;
770 record_unwind_protect_void (x_selection_request_lisp_error
);
772 /* We might be able to handle nested x_handle_selection_requests,
773 but this is difficult to test, and seems unimportant. */
774 x_start_queuing_selection_requests ();
775 record_unwind_protect_void (x_stop_queuing_selection_requests
);
777 TRACE2 ("x_handle_selection_request: selection=%s, target=%s",
778 SDATA (SYMBOL_NAME (selection_symbol
)),
779 SDATA (SYMBOL_NAME (target_symbol
)));
781 if (EQ (target_symbol
, QMULTIPLE
))
783 /* For MULTIPLE targets, the event property names a list of atom
784 pairs; the first atom names a target and the second names a
785 non-None property. */
786 Window requestor
= SELECTION_EVENT_REQUESTOR (event
);
787 Lisp_Object multprop
;
788 ptrdiff_t j
, nselections
;
790 if (property
== None
) goto DONE
;
792 = x_get_window_property_as_lisp_data (dpyinfo
, requestor
, property
,
793 QMULTIPLE
, selection
);
795 if (!VECTORP (multprop
) || ASIZE (multprop
) % 2)
798 nselections
= ASIZE (multprop
) / 2;
799 /* Perform conversions. This can signal. */
800 for (j
= 0; j
< nselections
; j
++)
802 Lisp_Object subtarget
= AREF (multprop
, 2*j
);
803 Atom subproperty
= symbol_to_x_atom (dpyinfo
,
804 AREF (multprop
, 2*j
+1));
806 if (subproperty
!= None
)
807 x_convert_selection (event
, selection_symbol
, subtarget
,
808 subproperty
, 1, dpyinfo
);
814 if (property
== None
)
815 property
= SELECTION_EVENT_TARGET (event
);
816 success
= x_convert_selection (event
, selection_symbol
,
817 target_symbol
, property
,
824 x_reply_selection_request (event
, dpyinfo
);
826 x_decline_selection_request (event
);
827 x_selection_current_request
= 0;
829 /* Run the `x-sent-selection-functions' abnormal hook. */
830 if (!NILP (Vx_sent_selection_functions
)
831 && !EQ (Vx_sent_selection_functions
, Qunbound
))
834 args
[0] = Qx_sent_selection_functions
;
835 args
[1] = selection_symbol
;
836 args
[2] = target_symbol
;
837 args
[3] = success
? Qt
: Qnil
;
838 Frun_hook_with_args (4, args
);
841 unbind_to (count
, Qnil
);
845 /* Perform the requested selection conversion, and write the data to
846 the converted_selections linked list, where it can be accessed by
847 x_reply_selection_request. If FOR_MULTIPLE is non-zero, write out
848 the data even if conversion fails, using conversion_fail_tag.
850 Return 0 if the selection failed to convert, 1 otherwise. */
853 x_convert_selection (struct input_event
*event
, Lisp_Object selection_symbol
,
854 Lisp_Object target_symbol
, Atom property
,
855 int for_multiple
, struct x_display_info
*dpyinfo
)
858 Lisp_Object lisp_selection
;
859 struct selection_data
*cs
;
860 GCPRO1 (lisp_selection
);
863 = x_get_local_selection (selection_symbol
, target_symbol
,
866 /* A nil return value means we can't perform the conversion. */
867 if (NILP (lisp_selection
)
868 || (CONSP (lisp_selection
) && NILP (XCDR (lisp_selection
))))
872 cs
= xmalloc (sizeof *cs
);
873 cs
->data
= (unsigned char *) &conversion_fail_tag
;
878 cs
->property
= property
;
879 cs
->wait_object
= NULL
;
880 cs
->next
= converted_selections
;
881 converted_selections
= cs
;
888 /* Otherwise, record the converted selection to binary. */
889 cs
= xmalloc (sizeof *cs
);
892 cs
->property
= property
;
893 cs
->wait_object
= NULL
;
894 cs
->next
= converted_selections
;
895 converted_selections
= cs
;
896 lisp_data_to_selection_data (dpyinfo
, lisp_selection
, cs
);
901 /* Handle a SelectionClear event EVENT, which indicates that some
902 client cleared out our previously asserted selection.
903 This is called from keyboard.c when such an event is found in the queue. */
906 x_handle_selection_clear (struct input_event
*event
)
908 Atom selection
= SELECTION_EVENT_SELECTION (event
);
909 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
911 Lisp_Object selection_symbol
, local_selection_data
;
912 Time local_selection_time
;
913 struct x_display_info
*dpyinfo
= SELECTION_EVENT_DPYINFO (event
);
914 Lisp_Object Vselection_alist
;
916 TRACE0 ("x_handle_selection_clear");
918 if (!dpyinfo
) return;
920 selection_symbol
= x_atom_to_symbol (dpyinfo
, selection
);
921 local_selection_data
= LOCAL_SELECTION (selection_symbol
, dpyinfo
);
923 /* Well, we already believe that we don't own it, so that's just fine. */
924 if (NILP (local_selection_data
)) return;
926 CONS_TO_INTEGER (XCAR (XCDR (XCDR (local_selection_data
))),
927 Time
, local_selection_time
);
929 /* We have reasserted the selection since this SelectionClear was
930 generated, so we can disregard it. */
931 if (changed_owner_time
!= CurrentTime
932 && local_selection_time
> changed_owner_time
)
935 /* Otherwise, really clear. Don't use Fdelq as that may QUIT;. */
936 Vselection_alist
= dpyinfo
->terminal
->Vselection_alist
;
937 if (EQ (local_selection_data
, CAR (Vselection_alist
)))
938 Vselection_alist
= XCDR (Vselection_alist
);
942 for (rest
= Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
943 if (EQ (local_selection_data
, CAR (XCDR (rest
))))
945 XSETCDR (rest
, XCDR (XCDR (rest
)));
949 tset_selection_alist (dpyinfo
->terminal
, Vselection_alist
);
951 /* Run the `x-lost-selection-functions' abnormal hook. */
954 args
[0] = Qx_lost_selection_functions
;
955 args
[1] = selection_symbol
;
956 Frun_hook_with_args (2, args
);
959 redisplay_preserve_echo_area (20);
963 x_handle_selection_event (struct input_event
*event
)
965 TRACE0 ("x_handle_selection_event");
966 if (event
->kind
!= SELECTION_REQUEST_EVENT
)
967 x_handle_selection_clear (event
);
968 else if (x_queue_selection_requests
)
969 x_queue_event (event
);
971 x_handle_selection_request (event
);
975 /* Clear all selections that were made from frame F.
976 We do this when about to delete a frame. */
979 x_clear_frame_selections (struct frame
*f
)
983 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
984 struct terminal
*t
= dpyinfo
->terminal
;
986 XSETFRAME (frame
, f
);
988 /* Delete elements from the beginning of Vselection_alist. */
989 while (CONSP (t
->Vselection_alist
)
990 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (t
->Vselection_alist
)))))))
992 /* Run the `x-lost-selection-functions' abnormal hook. */
994 args
[0] = Qx_lost_selection_functions
;
995 args
[1] = Fcar (Fcar (t
->Vselection_alist
));
996 Frun_hook_with_args (2, args
);
998 tset_selection_alist (t
, XCDR (t
->Vselection_alist
));
1001 /* Delete elements after the beginning of Vselection_alist. */
1002 for (rest
= t
->Vselection_alist
; CONSP (rest
); rest
= XCDR (rest
))
1003 if (CONSP (XCDR (rest
))
1004 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (XCAR (XCDR (rest
))))))))
1006 Lisp_Object args
[2];
1007 args
[0] = Qx_lost_selection_functions
;
1008 args
[1] = XCAR (XCAR (XCDR (rest
)));
1009 Frun_hook_with_args (2, args
);
1010 XSETCDR (rest
, XCDR (XCDR (rest
)));
1015 /* Nonzero if any properties for DISPLAY and WINDOW
1016 are on the list of what we are waiting for. */
1019 waiting_for_other_props_on_window (Display
*display
, Window window
)
1021 struct prop_location
*rest
= property_change_wait_list
;
1023 if (rest
->display
== display
&& rest
->window
== window
)
1030 /* Add an entry to the list of property changes we are waiting for.
1031 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1032 The return value is a number that uniquely identifies
1033 this awaited property change. */
1035 static struct prop_location
*
1036 expect_property_change (Display
*display
, Window window
,
1037 Atom property
, int state
)
1039 struct prop_location
*pl
= xmalloc (sizeof *pl
);
1040 pl
->identifier
= ++prop_location_identifier
;
1041 pl
->display
= display
;
1042 pl
->window
= window
;
1043 pl
->property
= property
;
1044 pl
->desired_state
= state
;
1045 pl
->next
= property_change_wait_list
;
1047 property_change_wait_list
= pl
;
1051 /* Delete an entry from the list of property changes we are waiting for.
1052 IDENTIFIER is the number that uniquely identifies the entry. */
1055 unexpect_property_change (struct prop_location
*location
)
1057 struct prop_location
*prop
, **pprev
= &property_change_wait_list
;
1059 for (prop
= property_change_wait_list
; prop
; prop
= *pprev
)
1061 if (prop
== location
)
1063 *pprev
= prop
->next
;
1068 pprev
= &prop
->next
;
1072 /* Remove the property change expectation element for IDENTIFIER. */
1075 wait_for_property_change_unwind (void *loc
)
1077 struct prop_location
*location
= loc
;
1079 unexpect_property_change (location
);
1080 if (location
== property_change_reply_object
)
1081 property_change_reply_object
= 0;
1084 /* Actually wait for a property change.
1085 IDENTIFIER should be the value that expect_property_change returned. */
1088 wait_for_property_change (struct prop_location
*location
)
1090 ptrdiff_t count
= SPECPDL_INDEX ();
1092 if (property_change_reply_object
)
1095 /* Make sure to do unexpect_property_change if we quit or err. */
1096 record_unwind_protect_ptr (wait_for_property_change_unwind
, location
);
1098 XSETCAR (property_change_reply
, Qnil
);
1099 property_change_reply_object
= location
;
1101 /* If the event we are waiting for arrives beyond here, it will set
1102 property_change_reply, because property_change_reply_object says so. */
1103 if (! location
->arrived
)
1105 EMACS_INT timeout
= max (0, x_selection_timeout
);
1106 EMACS_INT secs
= timeout
/ 1000;
1107 int nsecs
= (timeout
% 1000) * 1000000;
1108 TRACE2 (" Waiting %"pI
"d secs, %d nsecs", secs
, nsecs
);
1109 wait_reading_process_output (secs
, nsecs
, 0, 0,
1110 property_change_reply
, NULL
, 0);
1112 if (NILP (XCAR (property_change_reply
)))
1114 TRACE0 (" Timed out");
1115 error ("Timed out waiting for property-notify event");
1119 unbind_to (count
, Qnil
);
1122 /* Called from XTread_socket in response to a PropertyNotify event. */
1125 x_handle_property_notify (const XPropertyEvent
*event
)
1127 struct prop_location
*rest
;
1129 for (rest
= property_change_wait_list
; rest
; rest
= rest
->next
)
1132 && rest
->property
== event
->atom
1133 && rest
->window
== event
->window
1134 && rest
->display
== event
->display
1135 && rest
->desired_state
== event
->state
)
1137 TRACE2 ("Expected %s of property %s",
1138 (event
->state
== PropertyDelete
? "deletion" : "change"),
1139 XGetAtomName (event
->display
, event
->atom
));
1143 /* If this is the one wait_for_property_change is waiting for,
1144 tell it to wake up. */
1145 if (rest
== property_change_reply_object
)
1146 XSETCAR (property_change_reply
, Qt
);
1155 /* Variables for communication with x_handle_selection_notify. */
1156 static Atom reading_which_selection
;
1157 static Lisp_Object reading_selection_reply
;
1158 static Window reading_selection_window
;
1160 /* Do protocol to read selection-data from the server.
1161 Converts this to Lisp data and returns it.
1162 FRAME is the frame whose X window shall request the selection. */
1165 x_get_foreign_selection (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1166 Lisp_Object time_stamp
, Lisp_Object frame
)
1168 struct frame
*f
= XFRAME (frame
);
1169 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
1170 Display
*display
= dpyinfo
->display
;
1171 Window requestor_window
= FRAME_X_WINDOW (f
);
1172 Time requestor_time
= dpyinfo
->last_user_time
;
1173 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1174 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, selection_symbol
);
1175 Atom type_atom
= (CONSP (target_type
)
1176 ? symbol_to_x_atom (dpyinfo
, XCAR (target_type
))
1177 : symbol_to_x_atom (dpyinfo
, target_type
));
1178 EMACS_INT timeout
, secs
;
1181 if (!FRAME_LIVE_P (f
))
1184 if (! NILP (time_stamp
))
1185 CONS_TO_INTEGER (time_stamp
, Time
, requestor_time
);
1188 TRACE2 ("Get selection %s, type %s",
1189 XGetAtomName (display
, type_atom
),
1190 XGetAtomName (display
, target_property
));
1192 x_catch_errors (display
);
1193 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1194 requestor_window
, requestor_time
);
1195 x_check_errors (display
, "Can't convert selection: %s");
1196 x_uncatch_errors ();
1198 /* Prepare to block until the reply has been read. */
1199 reading_selection_window
= requestor_window
;
1200 reading_which_selection
= selection_atom
;
1201 XSETCAR (reading_selection_reply
, Qnil
);
1203 /* It should not be necessary to stop handling selection requests
1204 during this time. In fact, the SAVE_TARGETS mechanism requires
1205 us to handle a clipboard manager's requests before it returns
1208 x_start_queuing_selection_requests ();
1209 record_unwind_protect_void (x_stop_queuing_selection_requests
);
1214 /* This allows quits. Also, don't wait forever. */
1215 timeout
= max (0, x_selection_timeout
);
1216 secs
= timeout
/ 1000;
1217 nsecs
= (timeout
% 1000) * 1000000;
1218 TRACE1 (" Start waiting %"pI
"d secs for SelectionNotify", secs
);
1219 wait_reading_process_output (secs
, nsecs
, 0, 0,
1220 reading_selection_reply
, NULL
, 0);
1221 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1223 if (NILP (XCAR (reading_selection_reply
)))
1224 error ("Timed out waiting for reply from selection owner");
1225 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1228 /* Otherwise, the selection is waiting for us on the requested property. */
1230 x_get_window_property_as_lisp_data (dpyinfo
, requestor_window
,
1231 target_property
, target_type
,
1235 /* Subroutines of x_get_window_property_as_lisp_data */
1237 /* Use xfree, not XFree, to free the data obtained with this function. */
1240 x_get_window_property (Display
*display
, Window window
, Atom property
,
1241 unsigned char **data_ret
, ptrdiff_t *bytes_ret
,
1242 Atom
*actual_type_ret
, int *actual_format_ret
,
1243 unsigned long *actual_size_ret
, int delete_p
)
1245 ptrdiff_t total_size
;
1246 unsigned long bytes_remaining
;
1247 ptrdiff_t offset
= 0;
1248 unsigned char *data
= 0;
1249 unsigned char *tmp_data
= 0;
1251 int buffer_size
= selection_quantum (display
);
1253 /* Wide enough to avoid overflow in expressions using it. */
1254 ptrdiff_t x_long_size
= X_LONG_SIZE
;
1256 /* Maximum value for TOTAL_SIZE. It cannot exceed PTRDIFF_MAX - 1
1257 and SIZE_MAX - 1, for an extra byte at the end. And it cannot
1258 exceed LONG_MAX * X_LONG_SIZE, for XGetWindowProperty. */
1259 ptrdiff_t total_size_max
=
1260 ((min (PTRDIFF_MAX
, SIZE_MAX
) - 1) / x_long_size
< LONG_MAX
1261 ? min (PTRDIFF_MAX
, SIZE_MAX
) - 1
1262 : LONG_MAX
* x_long_size
);
1266 /* First probe the thing to find out how big it is. */
1267 result
= XGetWindowProperty (display
, window
, property
,
1268 0, 0, False
, AnyPropertyType
,
1269 actual_type_ret
, actual_format_ret
,
1271 &bytes_remaining
, &tmp_data
);
1272 if (result
!= Success
)
1275 /* This was allocated by Xlib, so use XFree. */
1278 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1281 if (total_size_max
< bytes_remaining
)
1283 total_size
= bytes_remaining
;
1284 data
= xmalloc (total_size
+ 1);
1286 /* Now read, until we've gotten it all. */
1287 while (bytes_remaining
)
1289 ptrdiff_t bytes_gotten
;
1292 = XGetWindowProperty (display
, window
, property
,
1293 offset
/ X_LONG_SIZE
,
1294 buffer_size
/ X_LONG_SIZE
,
1297 actual_type_ret
, actual_format_ret
,
1298 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1300 /* If this doesn't return Success at this point, it means that
1301 some clod deleted the selection while we were in the midst of
1302 reading it. Deal with that, I guess.... */
1303 if (result
!= Success
)
1306 bytes_per_item
= *actual_format_ret
>> 3;
1307 eassert (*actual_size_ret
<= buffer_size
/ bytes_per_item
);
1309 /* The man page for XGetWindowProperty says:
1310 "If the returned format is 32, the returned data is represented
1311 as a long array and should be cast to that type to obtain the
1313 This applies even if long is more than 32 bits, the X library
1314 converts from 32 bit elements received from the X server to long
1315 and passes the long array to us. Thus, for that case memcpy can not
1316 be used. We convert to a 32 bit type here, because so much code
1319 The bytes and offsets passed to XGetWindowProperty refers to the
1320 property and those are indeed in 32 bit quantities if format is 32. */
1322 bytes_gotten
= *actual_size_ret
;
1323 bytes_gotten
*= bytes_per_item
;
1325 TRACE2 ("Read %"pD
"d bytes from property %s",
1326 bytes_gotten
, XGetAtomName (display
, property
));
1328 if (total_size
- offset
< bytes_gotten
)
1330 unsigned char *data1
;
1331 ptrdiff_t remaining_lim
= total_size_max
- offset
- bytes_gotten
;
1332 if (remaining_lim
< 0 || remaining_lim
< bytes_remaining
)
1334 total_size
= offset
+ bytes_gotten
+ bytes_remaining
;
1335 data1
= xrealloc (data
, total_size
+ 1);
1339 if (BITS_PER_LONG
> 32 && *actual_format_ret
== 32)
1342 int *idata
= (int *) (data
+ offset
);
1343 long *ldata
= (long *) tmp_data
;
1345 for (i
= 0; i
< *actual_size_ret
; ++i
)
1346 idata
[i
] = ldata
[i
];
1349 memcpy (data
+ offset
, tmp_data
, bytes_gotten
);
1351 offset
+= bytes_gotten
;
1353 /* This was allocated by Xlib, so use XFree. */
1358 data
[offset
] = '\0';
1363 *bytes_ret
= offset
;
1370 memory_full (SIZE_MAX
);
1373 /* Use xfree, not XFree, to free the data obtained with this function. */
1376 receive_incremental_selection (struct x_display_info
*dpyinfo
,
1377 Window window
, Atom property
,
1378 Lisp_Object target_type
,
1379 unsigned int min_size_bytes
,
1380 unsigned char **data_ret
,
1381 ptrdiff_t *size_bytes_ret
,
1382 Atom
*type_ret
, int *format_ret
,
1383 unsigned long *size_ret
)
1385 ptrdiff_t offset
= 0;
1386 struct prop_location
*wait_object
;
1387 Display
*display
= dpyinfo
->display
;
1389 if (min (PTRDIFF_MAX
, SIZE_MAX
) < min_size_bytes
)
1390 memory_full (SIZE_MAX
);
1391 *data_ret
= xmalloc (min_size_bytes
);
1392 *size_bytes_ret
= min_size_bytes
;
1394 TRACE1 ("Read %u bytes incrementally", min_size_bytes
);
1396 /* At this point, we have read an INCR property.
1397 Delete the property to ack it.
1398 (But first, prepare to receive the next event in this handshake.)
1400 Now, we must loop, waiting for the sending window to put a value on
1401 that property, then reading the property, then deleting it to ack.
1402 We are done when the sender places a property of length 0.
1405 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1406 TRACE1 (" Delete property %s",
1407 SDATA (SYMBOL_NAME (x_atom_to_symbol (dpyinfo
, property
))));
1408 XDeleteProperty (display
, window
, property
);
1409 TRACE1 (" Expect new value of property %s",
1410 SDATA (SYMBOL_NAME (x_atom_to_symbol (dpyinfo
, property
))));
1411 wait_object
= expect_property_change (display
, window
, property
,
1418 unsigned char *tmp_data
;
1419 ptrdiff_t tmp_size_bytes
;
1421 TRACE0 (" Wait for property change");
1422 wait_for_property_change (wait_object
);
1424 /* expect it again immediately, because x_get_window_property may
1425 .. no it won't, I don't get it.
1426 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1427 TRACE0 (" Get property value");
1428 x_get_window_property (display
, window
, property
,
1429 &tmp_data
, &tmp_size_bytes
,
1430 type_ret
, format_ret
, size_ret
, 1);
1432 TRACE1 (" Read increment of %"pD
"d bytes", tmp_size_bytes
);
1434 if (tmp_size_bytes
== 0) /* we're done */
1436 TRACE0 ("Done reading incrementally");
1438 if (! waiting_for_other_props_on_window (display
, window
))
1439 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1440 /* Use xfree, not XFree, because x_get_window_property
1441 calls xmalloc itself. */
1447 TRACE1 (" ACK by deleting property %s",
1448 XGetAtomName (display
, property
));
1449 XDeleteProperty (display
, window
, property
);
1450 wait_object
= expect_property_change (display
, window
, property
,
1455 if (*size_bytes_ret
- offset
< tmp_size_bytes
)
1456 *data_ret
= xpalloc (*data_ret
, size_bytes_ret
,
1457 tmp_size_bytes
- (*size_bytes_ret
- offset
),
1460 memcpy ((*data_ret
) + offset
, tmp_data
, tmp_size_bytes
);
1461 offset
+= tmp_size_bytes
;
1463 /* Use xfree, not XFree, because x_get_window_property
1464 calls xmalloc itself. */
1470 /* Fetch a value from property PROPERTY of X window WINDOW on display
1471 DISPLAY. TARGET_TYPE and SELECTION_ATOM are used in error message
1475 x_get_window_property_as_lisp_data (struct x_display_info
*dpyinfo
,
1476 Window window
, Atom property
,
1477 Lisp_Object target_type
,
1478 Atom selection_atom
)
1482 unsigned long actual_size
;
1483 unsigned char *data
= 0;
1484 ptrdiff_t bytes
= 0;
1486 Display
*display
= dpyinfo
->display
;
1488 TRACE0 ("Reading selection data");
1490 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1491 &actual_type
, &actual_format
, &actual_size
, 1);
1494 int there_is_a_selection_owner
;
1496 there_is_a_selection_owner
1497 = XGetSelectionOwner (display
, selection_atom
);
1499 if (there_is_a_selection_owner
)
1500 signal_error ("Selection owner couldn't convert",
1502 ? list2 (target_type
,
1503 x_atom_to_symbol (dpyinfo
, actual_type
))
1506 signal_error ("No selection",
1507 x_atom_to_symbol (dpyinfo
, selection_atom
));
1510 if (actual_type
== dpyinfo
->Xatom_INCR
)
1512 /* That wasn't really the data, just the beginning. */
1514 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1516 /* Use xfree, not XFree, because x_get_window_property
1517 calls xmalloc itself. */
1520 receive_incremental_selection (dpyinfo
, window
, property
, target_type
,
1521 min_size_bytes
, &data
, &bytes
,
1522 &actual_type
, &actual_format
,
1527 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1528 XDeleteProperty (display
, window
, property
);
1532 /* It's been read. Now convert it to a lisp object in some semi-rational
1534 val
= selection_data_to_lisp_data (dpyinfo
, data
, bytes
,
1535 actual_type
, actual_format
);
1537 /* Use xfree, not XFree, because x_get_window_property
1538 calls xmalloc itself. */
1543 /* These functions convert from the selection data read from the server into
1544 something that we can use from Lisp, and vice versa.
1546 Type: Format: Size: Lisp Type:
1547 ----- ------- ----- -----------
1550 ATOM 32 > 1 Vector of Symbols
1552 * 16 > 1 Vector of Integers
1553 * 32 1 if <=16 bits: Integer
1554 if > 16 bits: Cons of top16, bot16
1555 * 32 > 1 Vector of the above
1557 When converting a Lisp number to C, it is assumed to be of format 16 if
1558 it is an integer, and of format 32 if it is a cons of two integers.
1560 When converting a vector of numbers from Lisp to C, it is assumed to be
1561 of format 16 if every element in the vector is an integer, and is assumed
1562 to be of format 32 if any element is a cons of two integers.
1564 When converting an object to C, it may be of the form (SYMBOL . <data>)
1565 where SYMBOL is what we should claim that the type is. Format and
1566 representation are as above.
1568 Important: When format is 32, data should contain an array of int,
1569 not an array of long as the X library returns. This makes a difference
1570 when sizeof(long) != sizeof(int). */
1575 selection_data_to_lisp_data (struct x_display_info
*dpyinfo
,
1576 const unsigned char *data
,
1577 ptrdiff_t size
, Atom type
, int format
)
1579 if (type
== dpyinfo
->Xatom_NULL
)
1582 /* Convert any 8-bit data to a string, for compactness. */
1583 else if (format
== 8)
1585 Lisp_Object str
, lispy_type
;
1587 str
= make_unibyte_string ((char *) data
, size
);
1588 /* Indicate that this string is from foreign selection by a text
1589 property `foreign-selection' so that the caller of
1590 x-get-selection-internal (usually x-get-selection) can know
1591 that the string must be decode. */
1592 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1593 lispy_type
= QCOMPOUND_TEXT
;
1594 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1595 lispy_type
= QUTF8_STRING
;
1597 lispy_type
= QSTRING
;
1598 Fput_text_property (make_number (0), make_number (size
),
1599 Qforeign_selection
, lispy_type
, str
);
1602 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1603 a vector of symbols. */
1604 else if (type
== XA_ATOM
1605 /* Treat ATOM_PAIR type similar to list of atoms. */
1606 || type
== dpyinfo
->Xatom_ATOM_PAIR
)
1609 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1610 But the callers of these function has made sure the data for
1611 format == 32 is an array of int. Thus, use int instead
1613 int *idata
= (int *) data
;
1615 if (size
== sizeof (int))
1616 return x_atom_to_symbol (dpyinfo
, (Atom
) idata
[0]);
1619 Lisp_Object v
= make_uninit_vector (size
/ sizeof (int));
1621 for (i
= 0; i
< size
/ sizeof (int); i
++)
1622 ASET (v
, i
, x_atom_to_symbol (dpyinfo
, (Atom
) idata
[i
]));
1627 /* Convert a single 16-bit number or a small 32-bit number to a Lisp_Int.
1628 If the number is 32 bits and won't fit in a Lisp_Int,
1629 convert it to a cons of integers, 16 bits in each half.
1631 else if (format
== 32 && size
== sizeof (int))
1632 return INTEGER_TO_CONS (((int *) data
) [0]);
1633 else if (format
== 16 && size
== sizeof (short))
1634 return make_number (((short *) data
) [0]);
1636 /* Convert any other kind of data to a vector of numbers, represented
1637 as above (as an integer, or a cons of two 16 bit integers.)
1639 else if (format
== 16)
1642 Lisp_Object v
= make_uninit_vector (size
/ 2);
1644 for (i
= 0; i
< size
/ 2; i
++)
1646 short j
= ((short *) data
) [i
];
1647 ASET (v
, i
, make_number (j
));
1654 Lisp_Object v
= make_uninit_vector (size
/ X_LONG_SIZE
);
1656 for (i
= 0; i
< size
/ X_LONG_SIZE
; i
++)
1658 int j
= ((int *) data
) [i
];
1659 ASET (v
, i
, INTEGER_TO_CONS (j
));
1665 /* Convert OBJ to an X long value, and return it as unsigned long.
1666 OBJ should be an integer or a cons representing an integer.
1667 Treat values in the range X_LONG_MAX + 1 .. X_ULONG_MAX as X
1668 unsigned long values: in theory these values are supposed to be
1669 signed but in practice unsigned 32-bit data are communicated via X
1670 selections and we need to support that. */
1671 static unsigned long
1672 cons_to_x_long (Lisp_Object obj
)
1674 if (X_ULONG_MAX
<= INTMAX_MAX
1675 || XINT (INTEGERP (obj
) ? obj
: XCAR (obj
)) < 0)
1676 return cons_to_signed (obj
, X_LONG_MIN
, min (X_ULONG_MAX
, INTMAX_MAX
));
1678 return cons_to_unsigned (obj
, X_ULONG_MAX
);
1681 /* Use xfree, not XFree, to free the data obtained with this function. */
1684 lisp_data_to_selection_data (struct x_display_info
*dpyinfo
,
1685 Lisp_Object obj
, struct selection_data
*cs
)
1687 Lisp_Object type
= Qnil
;
1689 eassert (cs
!= NULL
);
1692 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1696 if (CONSP (obj
) && NILP (XCDR (obj
)))
1700 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1701 { /* This is not the same as declining */
1707 else if (STRINGP (obj
))
1709 if (SCHARS (obj
) < SBYTES (obj
))
1710 /* OBJ is a multibyte string containing a non-ASCII char. */
1711 signal_error ("Non-ASCII string must be encoded in advance", obj
);
1715 cs
->size
= SBYTES (obj
);
1716 cs
->data
= SDATA (obj
);
1719 else if (SYMBOLP (obj
))
1721 void *data
= xmalloc (sizeof (Atom
) + 1);
1722 Atom
*x_atom_ptr
= data
;
1726 cs
->data
[sizeof (Atom
)] = 0;
1727 *x_atom_ptr
= symbol_to_x_atom (dpyinfo
, obj
);
1728 if (NILP (type
)) type
= QATOM
;
1730 else if (RANGED_INTEGERP (X_SHRT_MIN
, obj
, X_SHRT_MAX
))
1732 void *data
= xmalloc (sizeof (short) + 1);
1733 short *short_ptr
= data
;
1737 cs
->data
[sizeof (short)] = 0;
1738 *short_ptr
= XINT (obj
);
1739 if (NILP (type
)) type
= QINTEGER
;
1741 else if (INTEGERP (obj
)
1742 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1743 && (INTEGERP (XCDR (obj
))
1744 || (CONSP (XCDR (obj
))
1745 && INTEGERP (XCAR (XCDR (obj
)))))))
1747 void *data
= xmalloc (sizeof (unsigned long) + 1);
1748 unsigned long *x_long_ptr
= data
;
1752 cs
->data
[sizeof (unsigned long)] = 0;
1753 *x_long_ptr
= cons_to_x_long (obj
);
1754 if (NILP (type
)) type
= QINTEGER
;
1756 else if (VECTORP (obj
))
1758 /* Lisp_Vectors may represent a set of ATOMs;
1759 a set of 16 or 32 bit INTEGERs;
1760 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1763 ptrdiff_t size
= ASIZE (obj
);
1765 if (SYMBOLP (AREF (obj
, 0)))
1766 /* This vector is an ATOM set */
1770 if (NILP (type
)) type
= QATOM
;
1771 for (i
= 0; i
< size
; i
++)
1772 if (!SYMBOLP (AREF (obj
, i
)))
1773 signal_error ("All elements of selection vector must have same type", obj
);
1775 cs
->data
= data
= xnmalloc (size
, sizeof *x_atoms
);
1779 for (i
= 0; i
< size
; i
++)
1780 x_atoms
[i
] = symbol_to_x_atom (dpyinfo
, AREF (obj
, i
));
1783 /* This vector is an INTEGER set, or something like it */
1786 int data_size
= sizeof (short);
1788 unsigned long *x_atoms
;
1790 if (NILP (type
)) type
= QINTEGER
;
1791 for (i
= 0; i
< size
; i
++)
1793 if (! RANGED_INTEGERP (X_SHRT_MIN
, AREF (obj
, i
),
1796 /* Use sizeof (long) even if it is more than 32 bits.
1797 See comment in x_get_window_property and
1798 x_fill_property_data. */
1799 data_size
= sizeof (long);
1804 cs
->data
= data
= xnmalloc (size
, data_size
);
1807 cs
->format
= format
;
1809 for (i
= 0; i
< size
; i
++)
1812 x_atoms
[i
] = cons_to_x_long (AREF (obj
, i
));
1814 shorts
[i
] = XINT (AREF (obj
, i
));
1819 signal_error (/* Qselection_error */ "Unrecognized selection data", obj
);
1821 cs
->type
= symbol_to_x_atom (dpyinfo
, type
);
1825 clean_local_selection_data (Lisp_Object obj
)
1828 && INTEGERP (XCAR (obj
))
1829 && CONSP (XCDR (obj
))
1830 && INTEGERP (XCAR (XCDR (obj
)))
1831 && NILP (XCDR (XCDR (obj
))))
1832 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1835 && INTEGERP (XCAR (obj
))
1836 && INTEGERP (XCDR (obj
)))
1838 if (XINT (XCAR (obj
)) == 0)
1840 if (XINT (XCAR (obj
)) == -1)
1841 return make_number (- XINT (XCDR (obj
)));
1846 ptrdiff_t size
= ASIZE (obj
);
1849 return clean_local_selection_data (AREF (obj
, 0));
1850 copy
= make_uninit_vector (size
);
1851 for (i
= 0; i
< size
; i
++)
1852 ASET (copy
, i
, clean_local_selection_data (AREF (obj
, i
)));
1858 /* Called from XTread_socket to handle SelectionNotify events.
1859 If it's the selection we are waiting for, stop waiting
1860 by setting the car of reading_selection_reply to non-nil.
1861 We store t there if the reply is successful, lambda if not. */
1864 x_handle_selection_notify (const XSelectionEvent
*event
)
1866 if (event
->requestor
!= reading_selection_window
)
1868 if (event
->selection
!= reading_which_selection
)
1871 TRACE0 ("Received SelectionNotify");
1872 XSETCAR (reading_selection_reply
,
1873 (event
->property
!= 0 ? Qt
: Qlambda
));
1877 /* From a Lisp_Object, return a suitable frame for selection
1878 operations. OBJECT may be a frame, a terminal object, or nil
1879 (which stands for the selected frame--or, if that is not an X
1880 frame, the first X display on the list). If no suitable frame can
1881 be found, return NULL. */
1883 static struct frame
*
1884 frame_for_x_selection (Lisp_Object object
)
1886 Lisp_Object tail
, frame
;
1891 f
= XFRAME (selected_frame
);
1892 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1895 FOR_EACH_FRAME (tail
, frame
)
1898 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1902 else if (TERMINALP (object
))
1904 struct terminal
*t
= decode_live_terminal (object
);
1906 if (t
->type
== output_x_window
)
1907 FOR_EACH_FRAME (tail
, frame
)
1910 if (FRAME_LIVE_P (f
) && f
->terminal
== t
)
1914 else if (FRAMEP (object
))
1916 f
= XFRAME (object
);
1917 if (FRAME_X_P (f
) && FRAME_LIVE_P (f
))
1925 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1926 Sx_own_selection_internal
, 2, 3, 0,
1927 doc
: /* Assert an X selection of type SELECTION and value VALUE.
1928 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1929 \(Those are literal upper-case symbol names, since that's what X expects.)
1930 VALUE is typically a string, or a cons of two markers, but may be
1931 anything that the functions on `selection-converter-alist' know about.
1933 FRAME should be a frame that should own the selection. If omitted or
1934 nil, it defaults to the selected frame.
1936 On Nextstep, FRAME is unused. */)
1937 (Lisp_Object selection
, Lisp_Object value
, Lisp_Object frame
)
1939 if (NILP (frame
)) frame
= selected_frame
;
1940 if (!FRAME_LIVE_P (XFRAME (frame
)) || !FRAME_X_P (XFRAME (frame
)))
1941 error ("X selection unavailable for this frame");
1943 CHECK_SYMBOL (selection
);
1944 if (NILP (value
)) error ("VALUE may not be nil");
1945 x_own_selection (selection
, value
, frame
);
1950 /* Request the selection value from the owner. If we are the owner,
1951 simply return our selection value. If we are not the owner, this
1952 will block until all of the data has arrived. */
1954 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1955 Sx_get_selection_internal
, 2, 4, 0,
1956 doc
: /* Return text selected from some X window.
1957 SELECTION-SYMBOL is typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1958 \(Those are literal upper-case symbol names, since that's what X expects.)
1959 TARGET-TYPE is the type of data desired, typically `STRING'.
1961 TIME-STAMP is the time to use in the XConvertSelection call for foreign
1962 selections. If omitted, defaults to the time for the last event.
1964 TERMINAL should be a terminal object or a frame specifying the X
1965 server to query. If omitted or nil, that stands for the selected
1966 frame's display, or the first available X display.
1968 On Nextstep, TIME-STAMP and TERMINAL are unused. */)
1969 (Lisp_Object selection_symbol
, Lisp_Object target_type
,
1970 Lisp_Object time_stamp
, Lisp_Object terminal
)
1972 Lisp_Object val
= Qnil
;
1973 struct gcpro gcpro1
, gcpro2
;
1974 struct frame
*f
= frame_for_x_selection (terminal
);
1975 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1977 CHECK_SYMBOL (selection_symbol
);
1978 CHECK_SYMBOL (target_type
);
1979 if (EQ (target_type
, QMULTIPLE
))
1980 error ("Retrieving MULTIPLE selections is currently unimplemented");
1982 error ("X selection unavailable for this frame");
1984 val
= x_get_local_selection (selection_symbol
, target_type
, 1,
1985 FRAME_DISPLAY_INFO (f
));
1987 if (NILP (val
) && FRAME_LIVE_P (f
))
1990 XSETFRAME (frame
, f
);
1991 RETURN_UNGCPRO (x_get_foreign_selection (selection_symbol
, target_type
,
1992 time_stamp
, frame
));
1995 if (CONSP (val
) && SYMBOLP (XCAR (val
)))
1998 if (CONSP (val
) && NILP (XCDR (val
)))
2001 RETURN_UNGCPRO (clean_local_selection_data (val
));
2004 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2005 Sx_disown_selection_internal
, 1, 3, 0,
2006 doc
: /* If we own the selection SELECTION, disown it.
2007 Disowning it means there is no such selection.
2009 Sets the last-change time for the selection to TIME-OBJECT (by default
2010 the time of the last event).
2012 TERMINAL should be a terminal object or a frame specifying the X
2013 server to query. If omitted or nil, that stands for the selected
2014 frame's display, or the first available X display.
2016 On Nextstep, the TIME-OBJECT and TERMINAL arguments are unused.
2017 On MS-DOS, all this does is return non-nil if we own the selection. */)
2018 (Lisp_Object selection
, Lisp_Object time_object
, Lisp_Object terminal
)
2021 Atom selection_atom
;
2023 struct selection_input_event sie
;
2024 struct input_event ie
;
2026 struct frame
*f
= frame_for_x_selection (terminal
);
2027 struct x_display_info
*dpyinfo
;
2032 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2033 CHECK_SYMBOL (selection
);
2035 /* Don't disown the selection when we're not the owner. */
2036 if (NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2039 selection_atom
= symbol_to_x_atom (dpyinfo
, selection
);
2042 if (NILP (time_object
))
2043 timestamp
= dpyinfo
->last_user_time
;
2045 CONS_TO_INTEGER (time_object
, Time
, timestamp
);
2046 XSetSelectionOwner (dpyinfo
->display
, selection_atom
, None
, timestamp
);
2049 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2050 generated for a window which owns the selection when that window sets
2051 the selection owner to None. The NCD server does, the MIT Sun4 server
2052 doesn't. So we synthesize one; this means we might get two, but
2053 that's ok, because the second one won't have any effect. */
2054 SELECTION_EVENT_DPYINFO (&event
.sie
) = dpyinfo
;
2055 SELECTION_EVENT_SELECTION (&event
.sie
) = selection_atom
;
2056 SELECTION_EVENT_TIME (&event
.sie
) = timestamp
;
2057 x_handle_selection_clear (&event
.ie
);
2062 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2064 doc
: /* Whether the current Emacs process owns the given X Selection.
2065 The arg should be the name of the selection in question, typically one of
2066 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2067 \(Those are literal upper-case symbol names, since that's what X expects.)
2068 For convenience, the symbol nil is the same as `PRIMARY',
2069 and t is the same as `SECONDARY'.
2071 TERMINAL should be a terminal object or a frame specifying the X
2072 server to query. If omitted or nil, that stands for the selected
2073 frame's display, or the first available X display.
2075 On Nextstep, TERMINAL is unused. */)
2076 (Lisp_Object selection
, Lisp_Object terminal
)
2078 struct frame
*f
= frame_for_x_selection (terminal
);
2080 CHECK_SYMBOL (selection
);
2081 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2082 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2084 if (f
&& !NILP (LOCAL_SELECTION (selection
, FRAME_DISPLAY_INFO (f
))))
2090 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2092 doc
: /* Whether there is an owner for the given X selection.
2093 SELECTION should be the name of the selection in question, typically
2094 one of the symbols `PRIMARY', `SECONDARY', `CLIPBOARD', or
2095 `CLIPBOARD_MANAGER' (X expects these literal upper-case names.) The
2096 symbol nil is the same as `PRIMARY', and t is the same as `SECONDARY'.
2098 TERMINAL should be a terminal object or a frame specifying the X
2099 server to query. If omitted or nil, that stands for the selected
2100 frame's display, or the first available X display.
2102 On Nextstep, TERMINAL is unused. */)
2103 (Lisp_Object selection
, Lisp_Object terminal
)
2107 struct frame
*f
= frame_for_x_selection (terminal
);
2108 struct x_display_info
*dpyinfo
;
2110 CHECK_SYMBOL (selection
);
2111 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2112 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2117 dpyinfo
= FRAME_DISPLAY_INFO (f
);
2119 if (!NILP (LOCAL_SELECTION (selection
, dpyinfo
)))
2122 atom
= symbol_to_x_atom (dpyinfo
, selection
);
2123 if (atom
== 0) return Qnil
;
2125 owner
= XGetSelectionOwner (dpyinfo
->display
, atom
);
2127 return (owner
? Qt
: Qnil
);
2131 /* Send clipboard manager a SAVE_TARGETS request with a UTF8_STRING
2132 property (http://www.freedesktop.org/wiki/ClipboardManager). */
2135 x_clipboard_manager_save (Lisp_Object frame
)
2137 struct frame
*f
= XFRAME (frame
);
2138 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2139 Atom data
= dpyinfo
->Xatom_UTF8_STRING
;
2141 XChangeProperty (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
),
2142 dpyinfo
->Xatom_EMACS_TMP
,
2143 dpyinfo
->Xatom_ATOM
, 32, PropModeReplace
,
2144 (unsigned char *) &data
, 1);
2145 x_get_foreign_selection (QCLIPBOARD_MANAGER
, QSAVE_TARGETS
,
2150 /* Error handler for x_clipboard_manager_save_frame. */
2153 x_clipboard_manager_error_1 (Lisp_Object err
)
2155 AUTO_STRING (format
, "X clipboard manager error: %s\n\
2156 If the problem persists, set `x-select-enable-clipboard-manager' to nil.");
2157 Fmessage (2, (Lisp_Object
[]) {format
, CAR (CDR (err
))});
2161 /* Error handler for x_clipboard_manager_save_all. */
2164 x_clipboard_manager_error_2 (Lisp_Object err
)
2166 fprintf (stderr
, "Error saving to X clipboard manager.\n\
2167 If the problem persists, set `x-select-enable-clipboard-manager' \
2172 /* Called from delete_frame: save any clipboard owned by FRAME to the
2173 clipboard manager. Do nothing if FRAME does not own the clipboard,
2174 or if no clipboard manager is present. */
2177 x_clipboard_manager_save_frame (Lisp_Object frame
)
2181 if (!NILP (Vx_select_enable_clipboard_manager
)
2183 && (f
= XFRAME (frame
), FRAME_X_P (f
))
2184 && FRAME_LIVE_P (f
))
2186 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2187 Lisp_Object local_selection
2188 = LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2190 if (!NILP (local_selection
)
2191 && EQ (frame
, XCAR (XCDR (XCDR (XCDR (local_selection
)))))
2192 && XGetSelectionOwner (dpyinfo
->display
,
2193 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2194 internal_condition_case_1 (x_clipboard_manager_save
, frame
, Qt
,
2195 x_clipboard_manager_error_1
);
2199 /* Called from Fkill_emacs: save any clipboard owned by FRAME to the
2200 clipboard manager. Do nothing if FRAME does not own the clipboard,
2201 or if no clipboard manager is present. */
2204 x_clipboard_manager_save_all (void)
2206 /* Loop through all X displays, saving owned clipboards. */
2207 struct x_display_info
*dpyinfo
;
2208 Lisp_Object local_selection
, local_frame
;
2210 if (NILP (Vx_select_enable_clipboard_manager
))
2213 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
2215 local_selection
= LOCAL_SELECTION (QCLIPBOARD
, dpyinfo
);
2216 if (NILP (local_selection
)
2217 || !XGetSelectionOwner (dpyinfo
->display
,
2218 dpyinfo
->Xatom_CLIPBOARD_MANAGER
))
2221 local_frame
= XCAR (XCDR (XCDR (XCDR (local_selection
))));
2222 if (FRAME_LIVE_P (XFRAME (local_frame
)))
2224 AUTO_STRING (saving
, "Saving clipboard to X clipboard manager...");
2225 Fmessage (1, &saving
);
2226 internal_condition_case_1 (x_clipboard_manager_save
, local_frame
,
2227 Qt
, x_clipboard_manager_error_2
);
2233 /***********************************************************************
2234 Drag and drop support
2235 ***********************************************************************/
2236 /* Check that lisp values are of correct type for x_fill_property_data.
2237 That is, number, string or a cons with two numbers (low and high 16
2238 bit parts of a 32 bit number). Return the number of items in DATA,
2239 or -1 if there is an error. */
2242 x_check_property_data (Lisp_Object data
)
2247 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2249 Lisp_Object o
= XCAR (iter
);
2251 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2253 else if (CONSP (o
) &&
2254 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2256 if (size
== INT_MAX
)
2264 /* Convert lisp values to a C array. Values may be a number, a string
2265 which is taken as an X atom name and converted to the atom value, or
2266 a cons containing the two 16 bit parts of a 32 bit number.
2268 DPY is the display use to look up X atoms.
2269 DATA is a Lisp list of values to be converted.
2270 RET is the C array that contains the converted values. It is assumed
2271 it is big enough to hold all values.
2272 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2273 be stored in RET. Note that long is used for 32 even if long is more
2274 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2275 XClientMessageEvent). */
2278 x_fill_property_data (Display
*dpy
, Lisp_Object data
, void *ret
, int format
)
2281 unsigned long *d32
= (unsigned long *) ret
;
2282 unsigned short *d16
= (unsigned short *) ret
;
2283 unsigned char *d08
= (unsigned char *) ret
;
2286 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2288 Lisp_Object o
= XCAR (iter
);
2290 if (INTEGERP (o
) || FLOATP (o
) || CONSP (o
))
2293 && RANGED_INTEGERP (X_LONG_MIN
>> 16, XCAR (o
), X_LONG_MAX
>> 16)
2294 && RANGED_INTEGERP (- (1 << 15), XCDR (o
), -1))
2296 /* cons_to_x_long does not handle negative values for v2.
2297 For XDnd, v2 might be y of a window, and can be negative.
2298 The XDnd spec. is not explicit about negative values,
2299 but let's assume negative v2 is sent modulo 2**16. */
2300 unsigned long v1
= XINT (XCAR (o
)) & 0xffff;
2301 unsigned long v2
= XINT (XCDR (o
)) & 0xffff;
2302 val
= (v1
<< 16) | v2
;
2305 val
= cons_to_x_long (o
);
2307 else if (STRINGP (o
))
2310 val
= XInternAtom (dpy
, SSDATA (o
), False
);
2314 error ("Wrong type, must be string, number or cons");
2318 if ((1 << 8) < val
&& val
<= X_ULONG_MAX
- (1 << 7))
2319 error ("Out of 'char' range");
2322 else if (format
== 16)
2324 if ((1 << 16) < val
&& val
<= X_ULONG_MAX
- (1 << 15))
2325 error ("Out of 'short' range");
2333 /* Convert an array of C values to a Lisp list.
2334 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2335 DATA is a C array of values to be converted.
2336 TYPE is the type of the data. Only XA_ATOM is special, it converts
2337 each number in DATA to its corresponding X atom as a symbol.
2338 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2340 SIZE is the number of elements in DATA.
2342 Important: When format is 32, data should contain an array of int,
2343 not an array of long as the X library returns. This makes a difference
2344 when sizeof(long) != sizeof(int).
2346 Also see comment for selection_data_to_lisp_data above. */
2349 x_property_data_to_lisp (struct frame
*f
, const unsigned char *data
,
2350 Atom type
, int format
, unsigned long size
)
2352 ptrdiff_t format_bytes
= format
>> 3;
2353 if (PTRDIFF_MAX
/ format_bytes
< size
)
2354 memory_full (SIZE_MAX
);
2355 return selection_data_to_lisp_data (FRAME_DISPLAY_INFO (f
), data
,
2356 size
* format_bytes
, type
, format
);
2359 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2360 Sx_get_atom_name
, 1, 2, 0,
2361 doc
: /* Return the X atom name for VALUE as a string.
2362 VALUE may be a number or a cons where the car is the upper 16 bits and
2363 the cdr is the lower 16 bits of a 32 bit value.
2364 Use the display for FRAME or the current frame if FRAME is not given or nil.
2366 If the value is 0 or the atom is not known, return the empty string. */)
2367 (Lisp_Object value
, Lisp_Object frame
)
2369 struct frame
*f
= decode_window_system_frame (frame
);
2372 Lisp_Object ret
= Qnil
;
2373 Display
*dpy
= FRAME_X_DISPLAY (f
);
2377 CONS_TO_INTEGER (value
, Atom
, atom
);
2380 x_catch_errors (dpy
);
2381 name
= atom
? XGetAtomName (dpy
, atom
) : empty
;
2382 had_errors_p
= x_had_errors_p (dpy
);
2383 x_uncatch_errors ();
2386 ret
= build_string (name
);
2388 if (atom
&& name
) XFree (name
);
2389 if (NILP (ret
)) ret
= empty_unibyte_string
;
2396 DEFUN ("x-register-dnd-atom", Fx_register_dnd_atom
,
2397 Sx_register_dnd_atom
, 1, 2, 0,
2398 doc
: /* Request that dnd events are made for ClientMessages with ATOM.
2399 ATOM can be a symbol or a string. The ATOM is interned on the display that
2400 FRAME is on. If FRAME is nil, the selected frame is used. */)
2401 (Lisp_Object atom
, Lisp_Object frame
)
2404 struct frame
*f
= decode_window_system_frame (frame
);
2406 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
2410 x_atom
= symbol_to_x_atom (dpyinfo
, atom
);
2411 else if (STRINGP (atom
))
2414 x_atom
= XInternAtom (FRAME_X_DISPLAY (f
), SSDATA (atom
), False
);
2418 error ("ATOM must be a symbol or a string");
2420 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2421 if (dpyinfo
->x_dnd_atoms
[i
] == x_atom
)
2424 if (dpyinfo
->x_dnd_atoms_length
== dpyinfo
->x_dnd_atoms_size
)
2425 dpyinfo
->x_dnd_atoms
=
2426 xpalloc (dpyinfo
->x_dnd_atoms
, &dpyinfo
->x_dnd_atoms_size
,
2427 1, -1, sizeof *dpyinfo
->x_dnd_atoms
);
2429 dpyinfo
->x_dnd_atoms
[dpyinfo
->x_dnd_atoms_length
++] = x_atom
;
2433 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT. */
2436 x_handle_dnd_message (struct frame
*f
, const XClientMessageEvent
*event
,
2437 struct x_display_info
*dpyinfo
, struct input_event
*bufp
)
2441 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2442 unsigned long size
= 160/event
->format
;
2444 unsigned char *data
= (unsigned char *) event
->data
.b
;
2448 for (i
= 0; i
< dpyinfo
->x_dnd_atoms_length
; ++i
)
2449 if (dpyinfo
->x_dnd_atoms
[i
] == event
->message_type
) break;
2451 if (i
== dpyinfo
->x_dnd_atoms_length
) return 0;
2453 XSETFRAME (frame
, f
);
2455 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2456 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2457 function expects them to be of size int (i.e. 32). So to be able to
2458 use that function, put the data in the form it expects if format is 32. */
2460 if (BITS_PER_LONG
> 32 && event
->format
== 32)
2462 for (i
= 0; i
< 5; ++i
) /* There are only 5 longs in a ClientMessage. */
2463 idata
[i
] = event
->data
.l
[i
];
2464 data
= (unsigned char *) idata
;
2467 vec
= Fmake_vector (make_number (4), Qnil
);
2468 ASET (vec
, 0, SYMBOL_NAME (x_atom_to_symbol (FRAME_DISPLAY_INFO (f
),
2469 event
->message_type
)));
2470 ASET (vec
, 1, frame
);
2471 ASET (vec
, 2, make_number (event
->format
));
2472 ASET (vec
, 3, x_property_data_to_lisp (f
,
2474 event
->message_type
,
2478 x_relative_mouse_position (f
, &x
, &y
);
2479 bufp
->kind
= DRAG_N_DROP_EVENT
;
2480 bufp
->frame_or_window
= frame
;
2481 bufp
->timestamp
= CurrentTime
;
2482 bufp
->x
= make_number (x
);
2483 bufp
->y
= make_number (y
);
2485 bufp
->modifiers
= 0;
2490 DEFUN ("x-send-client-message", Fx_send_client_message
,
2491 Sx_send_client_message
, 6, 6, 0,
2492 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2494 For DISPLAY, specify either a frame or a display name (a string).
2495 If DISPLAY is nil, that stands for the selected frame's display.
2496 DEST may be a number, in which case it is a Window id. The value 0 may
2497 be used to send to the root window of the DISPLAY.
2498 If DEST is a cons, it is converted to a 32 bit number
2499 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2500 number is then used as a window id.
2501 If DEST is a frame the event is sent to the outer window of that frame.
2502 A value of nil means the currently selected frame.
2503 If DEST is the string "PointerWindow" the event is sent to the window that
2504 contains the pointer. If DEST is the string "InputFocus" the event is
2505 sent to the window that has the input focus.
2506 FROM is the frame sending the event. Use nil for currently selected frame.
2507 MESSAGE-TYPE is the name of an Atom as a string.
2508 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2509 bits. VALUES is a list of numbers, cons and/or strings containing the values
2510 to send. If a value is a string, it is converted to an Atom and the value of
2511 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2512 with the high 16 bits from the car and the lower 16 bit from the cdr.
2513 If more values than fits into the event is given, the excessive values
2515 (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2516 Lisp_Object message_type
, Lisp_Object format
, Lisp_Object values
)
2518 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2520 CHECK_STRING (message_type
);
2521 x_send_client_event (display
, dest
, from
,
2522 XInternAtom (dpyinfo
->display
,
2523 SSDATA (message_type
),
2531 x_send_client_event (Lisp_Object display
, Lisp_Object dest
, Lisp_Object from
,
2532 Atom message_type
, Lisp_Object format
, Lisp_Object values
)
2534 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2537 struct frame
*f
= decode_window_system_frame (from
);
2540 CHECK_NUMBER (format
);
2541 CHECK_CONS (values
);
2543 if (x_check_property_data (values
) == -1)
2544 error ("Bad data in VALUES, must be number, cons or string");
2546 if (XINT (format
) != 8 && XINT (format
) != 16 && XINT (format
) != 32)
2547 error ("FORMAT must be one of 8, 16 or 32");
2549 event
.xclient
.type
= ClientMessage
;
2550 event
.xclient
.format
= XINT (format
);
2552 if (FRAMEP (dest
) || NILP (dest
))
2554 struct frame
*fdest
= decode_window_system_frame (dest
);
2555 wdest
= FRAME_OUTER_WINDOW (fdest
);
2557 else if (STRINGP (dest
))
2559 if (strcmp (SSDATA (dest
), "PointerWindow") == 0)
2560 wdest
= PointerWindow
;
2561 else if (strcmp (SSDATA (dest
), "InputFocus") == 0)
2564 error ("DEST as a string must be one of PointerWindow or InputFocus");
2566 else if (INTEGERP (dest
) || FLOATP (dest
) || CONSP (dest
))
2567 CONS_TO_INTEGER (dest
, Window
, wdest
);
2569 error ("DEST must be a frame, nil, string, number or cons");
2571 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2572 to_root
= wdest
== dpyinfo
->root_window
;
2576 event
.xclient
.send_event
= True
;
2577 event
.xclient
.serial
= 0;
2578 event
.xclient
.message_type
= message_type
;
2579 event
.xclient
.display
= dpyinfo
->display
;
2581 /* Some clients (metacity for example) expects sending window to be here
2582 when sending to the root window. */
2583 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2585 memset (event
.xclient
.data
.l
, 0, sizeof (event
.xclient
.data
.l
));
2586 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2587 event
.xclient
.format
);
2589 /* If event mask is 0 the event is sent to the client that created
2590 the destination window. But if we are sending to the root window,
2591 there is no such client. Then we set the event mask to 0xffffff. The
2592 event then goes to clients selecting for events on the root window. */
2593 x_catch_errors (dpyinfo
->display
);
2595 int propagate
= to_root
? False
: True
;
2596 long mask
= to_root
? 0xffffff : 0;
2598 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2599 XFlush (dpyinfo
->display
);
2601 x_uncatch_errors ();
2607 syms_of_xselect (void)
2609 defsubr (&Sx_get_selection_internal
);
2610 defsubr (&Sx_own_selection_internal
);
2611 defsubr (&Sx_disown_selection_internal
);
2612 defsubr (&Sx_selection_owner_p
);
2613 defsubr (&Sx_selection_exists_p
);
2615 defsubr (&Sx_get_atom_name
);
2616 defsubr (&Sx_send_client_message
);
2617 defsubr (&Sx_register_dnd_atom
);
2619 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2620 staticpro (&reading_selection_reply
);
2621 reading_selection_window
= 0;
2622 reading_which_selection
= 0;
2624 property_change_wait_list
= 0;
2625 prop_location_identifier
= 0;
2626 property_change_reply
= Fcons (Qnil
, Qnil
);
2627 staticpro (&property_change_reply
);
2629 converted_selections
= NULL
;
2630 conversion_fail_tag
= None
;
2632 /* FIXME: Duplicate definition in nsselect.c. */
2633 DEFVAR_LISP ("selection-converter-alist", Vselection_converter_alist
,
2634 doc
: /* An alist associating X Windows selection-types with functions.
2635 These functions are called to convert the selection, with three args:
2636 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2637 a desired type to which the selection should be converted;
2638 and the local selection value (whatever was given to
2639 `x-own-selection-internal').
2641 The function should return the value to send to the X server
2642 \(typically a string). A return value of nil
2643 means that the conversion could not be done.
2644 A return value which is the symbol `NULL'
2645 means that a side-effect was executed,
2646 and there is no meaningful selection value. */);
2647 Vselection_converter_alist
= Qnil
;
2649 DEFVAR_LISP ("x-lost-selection-functions", Vx_lost_selection_functions
,
2650 doc
: /* A list of functions to be called when Emacs loses an X selection.
2651 \(This happens when some other X client makes its own selection
2652 or when a Lisp program explicitly clears the selection.)
2653 The functions are called with one argument, the selection type
2654 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2655 Vx_lost_selection_functions
= Qnil
;
2657 DEFVAR_LISP ("x-sent-selection-functions", Vx_sent_selection_functions
,
2658 doc
: /* A list of functions to be called when Emacs answers a selection request.
2659 The functions are called with three arguments:
2660 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2661 - the selection-type which Emacs was asked to convert the
2662 selection into before sending (for example, `STRING' or `LENGTH');
2663 - a flag indicating success or failure for responding to the request.
2664 We might have failed (and declined the request) for any number of reasons,
2665 including being asked for a selection that we no longer own, or being asked
2666 to convert into a type that we don't know about or that is inappropriate.
2667 This hook doesn't let you change the behavior of Emacs's selection replies,
2668 it merely informs you that they have happened. */);
2669 Vx_sent_selection_functions
= Qnil
;
2671 DEFVAR_LISP ("x-select-enable-clipboard-manager",
2672 Vx_select_enable_clipboard_manager
,
2673 doc
: /* Whether to enable X clipboard manager support.
2674 If non-nil, then whenever Emacs is killed or an Emacs frame is deleted
2675 while owning the X clipboard, the clipboard contents are saved to the
2676 clipboard manager if one is present. */);
2677 Vx_select_enable_clipboard_manager
= Qt
;
2679 DEFVAR_INT ("x-selection-timeout", x_selection_timeout
,
2680 doc
: /* Number of milliseconds to wait for a selection reply.
2681 If the selection owner doesn't reply in this time, we give up.
2682 A value of 0 means wait as long as necessary. This is initialized from the
2683 \"*selectionTimeout\" resource. */);
2684 x_selection_timeout
= 0;
2686 /* QPRIMARY is defined in keyboard.c. */
2687 DEFSYM (QSECONDARY
, "SECONDARY");
2688 DEFSYM (QSTRING
, "STRING");
2689 DEFSYM (QINTEGER
, "INTEGER");
2690 DEFSYM (QCLIPBOARD
, "CLIPBOARD");
2691 DEFSYM (QTIMESTAMP
, "TIMESTAMP");
2692 DEFSYM (QTEXT
, "TEXT");
2693 DEFSYM (QCOMPOUND_TEXT
, "COMPOUND_TEXT");
2694 DEFSYM (QUTF8_STRING
, "UTF8_STRING");
2695 DEFSYM (QDELETE
, "DELETE");
2696 DEFSYM (QMULTIPLE
, "MULTIPLE");
2697 DEFSYM (QINCR
, "INCR");
2698 DEFSYM (QEMACS_TMP
, "_EMACS_TMP_");
2699 DEFSYM (QTARGETS
, "TARGETS");
2700 DEFSYM (QATOM
, "ATOM");
2701 DEFSYM (QATOM_PAIR
, "ATOM_PAIR");
2702 DEFSYM (QCLIPBOARD_MANAGER
, "CLIPBOARD_MANAGER");
2703 DEFSYM (QSAVE_TARGETS
, "SAVE_TARGETS");
2704 DEFSYM (QNULL
, "NULL");
2705 DEFSYM (Qcompound_text_with_extensions
, "compound-text-with-extensions");
2706 DEFSYM (Qforeign_selection
, "foreign-selection");
2707 DEFSYM (Qx_lost_selection_functions
, "x-lost-selection-functions");
2708 DEFSYM (Qx_sent_selection_functions
, "x-sent-selection-functions");