1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Rewritten by jwz */
27 #include "xterm.h" /* for all of the X includes */
28 #include "dispextern.h" /* frame.h seems to want this */
29 #include "frame.h" /* Need this to get the X window of selected_frame */
30 #include "blockinput.h"
35 #include "composite.h"
39 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
40 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
42 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
43 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
));
44 static void x_decline_selection_request
P_ ((struct input_event
*));
45 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
46 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
47 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
48 static void x_reply_selection_request
P_ ((struct input_event
*, int,
49 unsigned char *, int, Atom
));
50 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
51 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
53 static void unexpect_property_change
P_ ((struct prop_location
*));
54 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
55 static void wait_for_property_change
P_ ((struct prop_location
*));
56 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
, Lisp_Object
));
57 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
58 unsigned char **, int *,
59 Atom
*, int *, unsigned long *, int));
60 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
61 Lisp_Object
, unsigned,
62 unsigned char **, int *,
63 Atom
*, int *, unsigned long *));
64 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
67 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
69 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
70 unsigned char **, Atom
*,
71 unsigned *, int *, int *));
72 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
73 static void initialize_cut_buffers
P_ ((Display
*, Window
));
76 /* Printing traces to stderr. */
78 #ifdef TRACE_SELECTION
80 fprintf (stderr, "%d: " fmt "\n", getpid ())
81 #define TRACE1(fmt, a0) \
82 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
83 #define TRACE2(fmt, a0, a1) \
84 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
86 #define TRACE0(fmt) (void) 0
87 #define TRACE1(fmt, a0) (void) 0
88 #define TRACE2(fmt, a0, a1) (void) 0
92 #define CUT_BUFFER_SUPPORT
94 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
95 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
98 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
100 Lisp_Object Qcompound_text_with_extensions
;
102 #ifdef CUT_BUFFER_SUPPORT
103 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
104 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
107 static Lisp_Object Vx_lost_selection_hooks
;
108 static Lisp_Object Vx_sent_selection_hooks
;
109 /* Coding system for communicating with other X clients via cutbuffer,
110 selection, and clipboard. */
111 static Lisp_Object Vselection_coding_system
;
113 /* Coding system for the next communicating with other X clients. */
114 static Lisp_Object Vnext_selection_coding_system
;
116 /* If this is a smaller number than the max-request-size of the display,
117 emacs will use INCR selection transfer when the selection is larger
118 than this. The max-request-size is usually around 64k, so if you want
119 emacs to use incremental selection transfers when the selection is
120 smaller than that, set this. I added this mostly for debugging the
121 incremental transfer stuff, but it might improve server performance. */
122 #define MAX_SELECTION_QUANTUM 0xFFFFFF
125 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
127 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
130 /* The timestamp of the last input event Emacs received from the X server. */
131 /* Defined in keyboard.c. */
132 extern unsigned long last_event_timestamp
;
134 /* This is an association list whose elements are of the form
135 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
136 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
137 SELECTION-VALUE is the value that emacs owns for that selection.
138 It may be any kind of Lisp object.
139 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
140 as a cons of two 16-bit numbers (making a 32 bit time.)
141 FRAME is the frame for which we made the selection.
142 If there is an entry in this alist, then it can be assumed that Emacs owns
144 The only (eq) parts of this list that are visible from Lisp are the
146 static Lisp_Object Vselection_alist
;
148 /* This is an alist whose CARs are selection-types (whose names are the same
149 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
150 call to convert the given Emacs selection value to a string representing
151 the given selection type. This is for Lisp-level extension of the emacs
152 selection handling. */
153 static Lisp_Object Vselection_converter_alist
;
155 /* If the selection owner takes too long to reply to a selection request,
156 we give up on it. This is in milliseconds (0 = no timeout.) */
157 static EMACS_INT x_selection_timeout
;
159 /* Utility functions */
161 static void lisp_data_to_selection_data ();
162 static Lisp_Object
selection_data_to_lisp_data ();
163 static Lisp_Object
x_get_window_property_as_lisp_data ();
165 /* This converts a Lisp symbol to a server Atom, avoiding a server
166 roundtrip whenever possible. */
169 symbol_to_x_atom (dpyinfo
, display
, sym
)
170 struct x_display_info
*dpyinfo
;
175 if (NILP (sym
)) return 0;
176 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
177 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
178 if (EQ (sym
, QSTRING
)) return XA_STRING
;
179 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
180 if (EQ (sym
, QATOM
)) return XA_ATOM
;
181 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
182 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
183 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
184 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
185 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
186 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
187 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
188 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
189 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
190 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
191 #ifdef CUT_BUFFER_SUPPORT
192 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
193 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
194 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
195 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
196 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
197 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
198 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
199 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
201 if (!SYMBOLP (sym
)) abort ();
203 TRACE1 (" XInternAtom %s", (char *) XSYMBOL (sym
)->name
->data
);
205 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
211 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
212 and calls to intern whenever possible. */
215 x_atom_to_symbol (dpy
, atom
)
219 struct x_display_info
*dpyinfo
;
238 #ifdef CUT_BUFFER_SUPPORT
258 dpyinfo
= x_display_info_for_display (dpy
);
259 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
261 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
263 if (atom
== dpyinfo
->Xatom_TEXT
)
265 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
266 return QCOMPOUND_TEXT
;
267 if (atom
== dpyinfo
->Xatom_DELETE
)
269 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
271 if (atom
== dpyinfo
->Xatom_INCR
)
273 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
275 if (atom
== dpyinfo
->Xatom_TARGETS
)
277 if (atom
== dpyinfo
->Xatom_NULL
)
281 str
= XGetAtomName (dpy
, atom
);
283 TRACE1 ("XGetAtomName --> %s", str
);
284 if (! str
) return Qnil
;
287 /* This was allocated by Xlib, so use XFree. */
293 /* Do protocol to assert ourself as a selection owner.
294 Update the Vselection_alist so that we can reply to later requests for
298 x_own_selection (selection_name
, selection_value
)
299 Lisp_Object selection_name
, selection_value
;
301 struct frame
*sf
= SELECTED_FRAME ();
302 Window selecting_window
= FRAME_X_WINDOW (sf
);
303 Display
*display
= FRAME_X_DISPLAY (sf
);
304 Time time
= last_event_timestamp
;
306 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
309 CHECK_SYMBOL (selection_name
);
310 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
313 count
= x_catch_errors (display
);
314 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
315 x_check_errors (display
, "Can't set selection: %s");
316 x_uncatch_errors (display
, count
);
319 /* Now update the local cache */
321 Lisp_Object selection_time
;
322 Lisp_Object selection_data
;
323 Lisp_Object prev_value
;
325 selection_time
= long_to_cons ((unsigned long) time
);
326 selection_data
= Fcons (selection_name
,
327 Fcons (selection_value
,
328 Fcons (selection_time
,
329 Fcons (selected_frame
, Qnil
))));
330 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
332 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
334 /* If we already owned the selection, remove the old selection data.
335 Perhaps we should destructively modify it instead.
336 Don't use Fdelq as that may QUIT. */
337 if (!NILP (prev_value
))
339 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
340 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
341 if (EQ (prev_value
, Fcar (XCDR (rest
))))
343 XSETCDR (rest
, Fcdr (XCDR (rest
)));
350 /* Given a selection-name and desired type, look up our local copy of
351 the selection value and convert it to the type.
352 The value is nil or a string.
353 This function is used both for remote requests
354 and for local x-get-selection-internal.
356 This calls random Lisp code, and may signal or gc. */
359 x_get_local_selection (selection_symbol
, target_type
)
360 Lisp_Object selection_symbol
, target_type
;
362 Lisp_Object local_value
;
363 Lisp_Object handler_fn
, value
, type
, check
;
366 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
368 if (NILP (local_value
)) return Qnil
;
370 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
371 if (EQ (target_type
, QTIMESTAMP
))
374 value
= XCAR (XCDR (XCDR (local_value
)));
377 else if (EQ (target_type
, QDELETE
))
380 Fx_disown_selection_internal
382 XCAR (XCDR (XCDR (local_value
))));
387 #if 0 /* #### MULTIPLE doesn't work yet */
388 else if (CONSP (target_type
)
389 && XCAR (target_type
) == QMULTIPLE
)
394 pairs
= XCDR (target_type
);
395 size
= XVECTOR (pairs
)->size
;
396 /* If the target is MULTIPLE, then target_type looks like
397 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
398 We modify the second element of each pair in the vector and
399 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
401 for (i
= 0; i
< size
; i
++)
404 pair
= XVECTOR (pairs
)->contents
[i
];
405 XVECTOR (pair
)->contents
[1]
406 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
407 XVECTOR (pair
)->contents
[1]);
414 /* Don't allow a quit within the converter.
415 When the user types C-g, he would be surprised
416 if by luck it came during a converter. */
417 count
= specpdl_ptr
- specpdl
;
418 specbind (Qinhibit_quit
, Qt
);
420 CHECK_SYMBOL (target_type
);
421 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
422 if (!NILP (handler_fn
))
423 value
= call3 (handler_fn
,
424 selection_symbol
, target_type
,
425 XCAR (XCDR (local_value
)));
428 unbind_to (count
, Qnil
);
431 /* Make sure this value is of a type that we could transmit
432 to another X client. */
436 && SYMBOLP (XCAR (value
)))
438 check
= XCDR (value
);
446 /* Check for a value that cons_to_long could handle. */
447 else if (CONSP (check
)
448 && INTEGERP (XCAR (check
))
449 && (INTEGERP (XCDR (check
))
451 (CONSP (XCDR (check
))
452 && INTEGERP (XCAR (XCDR (check
)))
453 && NILP (XCDR (XCDR (check
))))))
458 Fcons (build_string ("invalid data returned by selection-conversion function"),
459 Fcons (handler_fn
, Fcons (value
, Qnil
))));
462 /* Subroutines of x_reply_selection_request. */
464 /* Send a SelectionNotify event to the requestor with property=None,
465 meaning we were unable to do what they wanted. */
468 x_decline_selection_request (event
)
469 struct input_event
*event
;
471 XSelectionEvent reply
;
474 reply
.type
= SelectionNotify
;
475 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
476 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
477 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
478 reply
.time
= SELECTION_EVENT_TIME (event
);
479 reply
.target
= SELECTION_EVENT_TARGET (event
);
480 reply
.property
= None
;
482 /* The reason for the error may be that the receiver has
483 died in the meantime. Handle that case. */
485 count
= x_catch_errors (reply
.display
);
486 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
487 XFlush (reply
.display
);
488 x_uncatch_errors (reply
.display
, count
);
492 /* This is the selection request currently being processed.
493 It is set to zero when the request is fully processed. */
494 static struct input_event
*x_selection_current_request
;
496 /* Display info in x_selection_request. */
498 static struct x_display_info
*selection_request_dpyinfo
;
500 /* Used as an unwind-protect clause so that, if a selection-converter signals
501 an error, we tell the requester that we were unable to do what they wanted
502 before we throw to top-level or go into the debugger or whatever. */
505 x_selection_request_lisp_error (ignore
)
508 if (x_selection_current_request
!= 0
509 && selection_request_dpyinfo
->display
)
510 x_decline_selection_request (x_selection_current_request
);
515 /* This stuff is so that INCR selections are reentrant (that is, so we can
516 be servicing multiple INCR selection requests simultaneously.) I haven't
517 actually tested that yet. */
519 /* Keep a list of the property changes that are awaited. */
529 struct prop_location
*next
;
532 static struct prop_location
*expect_property_change ();
533 static void wait_for_property_change ();
534 static void unexpect_property_change ();
535 static int waiting_for_other_props_on_window ();
537 static int prop_location_identifier
;
539 static Lisp_Object property_change_reply
;
541 static struct prop_location
*property_change_reply_object
;
543 static struct prop_location
*property_change_wait_list
;
546 queue_selection_requests_unwind (frame
)
549 FRAME_PTR f
= XFRAME (frame
);
552 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
556 /* Return some frame whose display info is DPYINFO.
557 Return nil if there is none. */
560 some_frame_on_display (dpyinfo
)
561 struct x_display_info
*dpyinfo
;
563 Lisp_Object list
, frame
;
565 FOR_EACH_FRAME (list
, frame
)
567 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
574 /* Send the reply to a selection request event EVENT.
575 TYPE is the type of selection data requested.
576 DATA and SIZE describe the data to send, already converted.
577 FORMAT is the unit-size (in bits) of the data to be transmitted. */
580 x_reply_selection_request (event
, format
, data
, size
, type
)
581 struct input_event
*event
;
586 XSelectionEvent reply
;
587 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
588 Window window
= SELECTION_EVENT_REQUESTOR (event
);
590 int format_bytes
= format
/8;
591 int max_bytes
= SELECTION_QUANTUM (display
);
592 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
595 if (max_bytes
> MAX_SELECTION_QUANTUM
)
596 max_bytes
= MAX_SELECTION_QUANTUM
;
598 reply
.type
= SelectionNotify
;
599 reply
.display
= display
;
600 reply
.requestor
= window
;
601 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
602 reply
.time
= SELECTION_EVENT_TIME (event
);
603 reply
.target
= SELECTION_EVENT_TARGET (event
);
604 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
605 if (reply
.property
== None
)
606 reply
.property
= reply
.target
;
608 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
610 count
= x_catch_errors (display
);
612 /* Store the data on the requested property.
613 If the selection is large, only store the first N bytes of it.
615 bytes_remaining
= size
* format_bytes
;
616 if (bytes_remaining
<= max_bytes
)
618 /* Send all the data at once, with minimal handshaking. */
619 TRACE1 ("Sending all %d bytes", bytes_remaining
);
620 XChangeProperty (display
, window
, reply
.property
, type
, format
,
621 PropModeReplace
, data
, size
);
622 /* At this point, the selection was successfully stored; ack it. */
623 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
627 /* Send an INCR selection. */
628 struct prop_location
*wait_object
;
632 frame
= some_frame_on_display (dpyinfo
);
634 /* If the display no longer has frames, we can't expect
635 to get many more selection requests from it, so don't
636 bother trying to queue them. */
639 x_start_queuing_selection_requests (display
);
641 record_unwind_protect (queue_selection_requests_unwind
,
645 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
646 error ("Attempt to transfer an INCR to ourself!");
648 TRACE2 ("Start sending %d bytes incrementally (%s)",
649 bytes_remaining
, XGetAtomName (display
, reply
.property
));
650 wait_object
= expect_property_change (display
, window
, reply
.property
,
653 TRACE1 ("Set %s to number of bytes to send",
654 XGetAtomName (display
, reply
.property
));
655 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
657 (unsigned char *) &bytes_remaining
, 1);
658 XSelectInput (display
, window
, PropertyChangeMask
);
660 /* Tell 'em the INCR data is there... */
661 TRACE0 ("Send SelectionNotify event");
662 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
665 had_errors
= x_had_errors_p (display
);
668 /* First, wait for the requester to ack by deleting the property.
669 This can run random lisp code (process handlers) or signal. */
672 TRACE1 ("Waiting for ACK (deletion of %s)",
673 XGetAtomName (display
, reply
.property
));
674 wait_for_property_change (wait_object
);
678 while (bytes_remaining
)
680 int i
= ((bytes_remaining
< max_bytes
)
687 = expect_property_change (display
, window
, reply
.property
,
690 TRACE1 ("Sending increment of %d bytes", i
);
691 TRACE1 ("Set %s to increment data",
692 XGetAtomName (display
, reply
.property
));
694 /* Append the next chunk of data to the property. */
695 XChangeProperty (display
, window
, reply
.property
, type
, format
,
696 PropModeAppend
, data
, i
/ format_bytes
);
697 bytes_remaining
-= i
;
700 had_errors
= x_had_errors_p (display
);
706 /* Now wait for the requester to ack this chunk by deleting the
707 property. This can run random lisp code or signal. */
708 TRACE1 ("Waiting for increment ACK (deletion of %s)",
709 XGetAtomName (display
, reply
.property
));
710 wait_for_property_change (wait_object
);
713 /* Now write a zero-length chunk to the property to tell the
714 requester that we're done. */
716 if (! waiting_for_other_props_on_window (display
, window
))
717 XSelectInput (display
, window
, 0L);
719 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
720 XGetAtomName (display
, reply
.property
));
721 XChangeProperty (display
, window
, reply
.property
, type
, format
,
722 PropModeReplace
, data
, 0);
723 TRACE0 ("Done sending incrementally");
726 /* The window we're communicating with may have been deleted
727 in the meantime (that's a real situation from a bug report).
728 In this case, there may be events in the event queue still
729 refering to the deleted window, and we'll get a BadWindow error
730 in XTread_socket when processing the events. I don't have
731 an idea how to fix that. gerd, 2001-01-98. */
733 x_uncatch_errors (display
, count
);
737 /* Handle a SelectionRequest event EVENT.
738 This is called from keyboard.c when such an event is found in the queue. */
741 x_handle_selection_request (event
)
742 struct input_event
*event
;
744 struct gcpro gcpro1
, gcpro2
, gcpro3
;
745 Lisp_Object local_selection_data
;
746 Lisp_Object selection_symbol
;
747 Lisp_Object target_symbol
;
748 Lisp_Object converted_selection
;
749 Time local_selection_time
;
750 Lisp_Object successful_p
;
752 struct x_display_info
*dpyinfo
753 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
755 local_selection_data
= Qnil
;
756 target_symbol
= Qnil
;
757 converted_selection
= Qnil
;
760 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
762 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
763 SELECTION_EVENT_SELECTION (event
));
765 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
767 if (NILP (local_selection_data
))
769 /* Someone asked for the selection, but we don't have it any more.
771 x_decline_selection_request (event
);
775 local_selection_time
= (Time
)
776 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
778 if (SELECTION_EVENT_TIME (event
) != CurrentTime
779 && local_selection_time
> SELECTION_EVENT_TIME (event
))
781 /* Someone asked for the selection, and we have one, but not the one
784 x_decline_selection_request (event
);
788 x_selection_current_request
= event
;
789 count
= BINDING_STACK_SIZE ();
790 selection_request_dpyinfo
= dpyinfo
;
791 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
793 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
794 SELECTION_EVENT_TARGET (event
));
796 #if 0 /* #### MULTIPLE doesn't work yet */
797 if (EQ (target_symbol
, QMULTIPLE
))
798 target_symbol
= fetch_multiple_target (event
);
801 /* Convert lisp objects back into binary data */
804 = x_get_local_selection (selection_symbol
, target_symbol
);
806 if (! NILP (converted_selection
))
814 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
816 &data
, &type
, &size
, &format
, &nofree
);
818 x_reply_selection_request (event
, format
, data
, size
, type
);
821 /* Indicate we have successfully processed this event. */
822 x_selection_current_request
= 0;
824 /* Use xfree, not XFree, because lisp_data_to_selection_data
825 calls xmalloc itself. */
829 unbind_to (count
, Qnil
);
835 /* Let random lisp code notice that the selection has been asked for. */
838 rest
= Vx_sent_selection_hooks
;
839 if (!EQ (rest
, Qunbound
))
840 for (; CONSP (rest
); rest
= Fcdr (rest
))
841 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
845 /* Handle a SelectionClear event EVENT, which indicates that some
846 client cleared out our previously asserted selection.
847 This is called from keyboard.c when such an event is found in the queue. */
850 x_handle_selection_clear (event
)
851 struct input_event
*event
;
853 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
854 Atom selection
= SELECTION_EVENT_SELECTION (event
);
855 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
857 Lisp_Object selection_symbol
, local_selection_data
;
858 Time local_selection_time
;
859 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
860 struct x_display_info
*t_dpyinfo
;
862 /* If the new selection owner is also Emacs,
863 don't clear the new selection. */
865 /* Check each display on the same terminal,
866 to see if this Emacs job now owns the selection
867 through that display. */
868 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
869 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
872 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
873 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
881 selection_symbol
= x_atom_to_symbol (display
, selection
);
883 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
885 /* Well, we already believe that we don't own it, so that's just fine. */
886 if (NILP (local_selection_data
)) return;
888 local_selection_time
= (Time
)
889 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
891 /* This SelectionClear is for a selection that we no longer own, so we can
892 disregard it. (That is, we have reasserted the selection since this
893 request was generated.) */
895 if (changed_owner_time
!= CurrentTime
896 && local_selection_time
> changed_owner_time
)
899 /* Otherwise, we're really honest and truly being told to drop it.
900 Don't use Fdelq as that may QUIT;. */
902 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
903 Vselection_alist
= Fcdr (Vselection_alist
);
907 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
908 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
910 XSETCDR (rest
, Fcdr (XCDR (rest
)));
915 /* Let random lisp code notice that the selection has been stolen. */
919 rest
= Vx_lost_selection_hooks
;
920 if (!EQ (rest
, Qunbound
))
922 for (; CONSP (rest
); rest
= Fcdr (rest
))
923 call1 (Fcar (rest
), selection_symbol
);
924 prepare_menu_bars ();
925 redisplay_preserve_echo_area (20);
930 /* Clear all selections that were made from frame F.
931 We do this when about to delete a frame. */
934 x_clear_frame_selections (f
)
940 XSETFRAME (frame
, f
);
942 /* Otherwise, we're really honest and truly being told to drop it.
943 Don't use Fdelq as that may QUIT;. */
945 /* Delete elements from the beginning of Vselection_alist. */
946 while (!NILP (Vselection_alist
)
947 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
949 /* Let random Lisp code notice that the selection has been stolen. */
950 Lisp_Object hooks
, selection_symbol
;
952 hooks
= Vx_lost_selection_hooks
;
953 selection_symbol
= Fcar (Fcar (Vselection_alist
));
955 if (!EQ (hooks
, Qunbound
))
957 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
958 call1 (Fcar (hooks
), selection_symbol
);
959 #if 0 /* This can crash when deleting a frame
960 from x_connection_closed. Anyway, it seems unnecessary;
961 something else should cause a redisplay. */
962 redisplay_preserve_echo_area (21);
966 Vselection_alist
= Fcdr (Vselection_alist
);
969 /* Delete elements after the beginning of Vselection_alist. */
970 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
971 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
973 /* Let random Lisp code notice that the selection has been stolen. */
974 Lisp_Object hooks
, selection_symbol
;
976 hooks
= Vx_lost_selection_hooks
;
977 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
979 if (!EQ (hooks
, Qunbound
))
981 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
982 call1 (Fcar (hooks
), selection_symbol
);
983 #if 0 /* See above */
984 redisplay_preserve_echo_area (22);
987 XSETCDR (rest
, Fcdr (XCDR (rest
)));
992 /* Nonzero if any properties for DISPLAY and WINDOW
993 are on the list of what we are waiting for. */
996 waiting_for_other_props_on_window (display
, window
)
1000 struct prop_location
*rest
= property_change_wait_list
;
1002 if (rest
->display
== display
&& rest
->window
== window
)
1009 /* Add an entry to the list of property changes we are waiting for.
1010 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1011 The return value is a number that uniquely identifies
1012 this awaited property change. */
1014 static struct prop_location
*
1015 expect_property_change (display
, window
, property
, state
)
1021 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1022 pl
->identifier
= ++prop_location_identifier
;
1023 pl
->display
= display
;
1024 pl
->window
= window
;
1025 pl
->property
= property
;
1026 pl
->desired_state
= state
;
1027 pl
->next
= property_change_wait_list
;
1029 property_change_wait_list
= pl
;
1033 /* Delete an entry from the list of property changes we are waiting for.
1034 IDENTIFIER is the number that uniquely identifies the entry. */
1037 unexpect_property_change (location
)
1038 struct prop_location
*location
;
1040 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1043 if (rest
== location
)
1046 prev
->next
= rest
->next
;
1048 property_change_wait_list
= rest
->next
;
1057 /* Remove the property change expectation element for IDENTIFIER. */
1060 wait_for_property_change_unwind (identifierval
)
1061 Lisp_Object identifierval
;
1063 unexpect_property_change ((struct prop_location
*)
1064 (XFASTINT (XCAR (identifierval
)) << 16
1065 | XFASTINT (XCDR (identifierval
))));
1069 /* Actually wait for a property change.
1070 IDENTIFIER should be the value that expect_property_change returned. */
1073 wait_for_property_change (location
)
1074 struct prop_location
*location
;
1077 int count
= specpdl_ptr
- specpdl
;
1080 tem
= Fcons (Qnil
, Qnil
);
1081 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1082 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1084 /* Make sure to do unexpect_property_change if we quit or err. */
1085 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1087 XSETCAR (property_change_reply
, Qnil
);
1089 property_change_reply_object
= location
;
1090 /* If the event we are waiting for arrives beyond here, it will set
1091 property_change_reply, because property_change_reply_object says so. */
1092 if (! location
->arrived
)
1094 secs
= x_selection_timeout
/ 1000;
1095 usecs
= (x_selection_timeout
% 1000) * 1000;
1096 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1097 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1099 if (NILP (XCAR (property_change_reply
)))
1101 TRACE0 (" Timed out");
1102 error ("Timed out waiting for property-notify event");
1106 unbind_to (count
, Qnil
);
1109 /* Called from XTread_socket in response to a PropertyNotify event. */
1112 x_handle_property_notify (event
)
1113 XPropertyEvent
*event
;
1115 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1119 if (rest
->property
== event
->atom
1120 && rest
->window
== event
->window
1121 && rest
->display
== event
->display
1122 && rest
->desired_state
== event
->state
)
1124 TRACE2 ("Expected %s of property %s",
1125 (event
->state
== PropertyDelete
? "deletion" : "change"),
1126 XGetAtomName (event
->display
, event
->atom
));
1130 /* If this is the one wait_for_property_change is waiting for,
1131 tell it to wake up. */
1132 if (rest
== property_change_reply_object
)
1133 XSETCAR (property_change_reply
, Qt
);
1136 prev
->next
= rest
->next
;
1138 property_change_wait_list
= rest
->next
;
1150 #if 0 /* #### MULTIPLE doesn't work yet */
1153 fetch_multiple_target (event
)
1154 XSelectionRequestEvent
*event
;
1156 Display
*display
= event
->display
;
1157 Window window
= event
->requestor
;
1158 Atom target
= event
->target
;
1159 Atom selection_atom
= event
->selection
;
1164 x_get_window_property_as_lisp_data (display
, window
, target
,
1165 QMULTIPLE
, selection_atom
));
1169 copy_multiple_data (obj
)
1176 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1179 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1180 for (i
= 0; i
< size
; i
++)
1182 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1183 CHECK_VECTOR (vec2
);
1184 if (XVECTOR (vec2
)->size
!= 2)
1185 /* ??? Confusing error message */
1186 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1187 Fcons (vec2
, Qnil
)));
1188 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1189 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1190 = XVECTOR (vec2
)->contents
[0];
1191 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1192 = XVECTOR (vec2
)->contents
[1];
1200 /* Variables for communication with x_handle_selection_notify. */
1201 static Atom reading_which_selection
;
1202 static Lisp_Object reading_selection_reply
;
1203 static Window reading_selection_window
;
1205 /* Do protocol to read selection-data from the server.
1206 Converts this to Lisp data and returns it. */
1209 x_get_foreign_selection (selection_symbol
, target_type
)
1210 Lisp_Object selection_symbol
, target_type
;
1212 struct frame
*sf
= SELECTED_FRAME ();
1213 Window requestor_window
= FRAME_X_WINDOW (sf
);
1214 Display
*display
= FRAME_X_DISPLAY (sf
);
1215 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1216 Time requestor_time
= last_event_timestamp
;
1217 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1218 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1224 if (CONSP (target_type
))
1225 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1227 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1231 count
= x_catch_errors (display
);
1233 TRACE2 ("Get selection %s, type %s",
1234 XGetAtomName (display
, type_atom
),
1235 XGetAtomName (display
, target_property
));
1237 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1238 requestor_window
, requestor_time
);
1241 /* Prepare to block until the reply has been read. */
1242 reading_selection_window
= requestor_window
;
1243 reading_which_selection
= selection_atom
;
1244 XSETCAR (reading_selection_reply
, Qnil
);
1246 frame
= some_frame_on_display (dpyinfo
);
1248 /* If the display no longer has frames, we can't expect
1249 to get many more selection requests from it, so don't
1250 bother trying to queue them. */
1253 x_start_queuing_selection_requests (display
);
1255 record_unwind_protect (queue_selection_requests_unwind
,
1260 /* This allows quits. Also, don't wait forever. */
1261 secs
= x_selection_timeout
/ 1000;
1262 usecs
= (x_selection_timeout
% 1000) * 1000;
1263 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1264 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1265 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1268 x_check_errors (display
, "Cannot get selection: %s");
1269 x_uncatch_errors (display
, count
);
1272 if (NILP (XCAR (reading_selection_reply
)))
1273 error ("Timed out waiting for reply from selection owner");
1274 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1275 error ("No `%s' selection", XSYMBOL (selection_symbol
)->name
->data
);
1277 /* Otherwise, the selection is waiting for us on the requested property. */
1279 x_get_window_property_as_lisp_data (display
, requestor_window
,
1280 target_property
, target_type
,
1284 /* Subroutines of x_get_window_property_as_lisp_data */
1286 /* Use xfree, not XFree, to free the data obtained with this function. */
1289 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1290 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1295 unsigned char **data_ret
;
1297 Atom
*actual_type_ret
;
1298 int *actual_format_ret
;
1299 unsigned long *actual_size_ret
;
1303 unsigned long bytes_remaining
;
1305 unsigned char *tmp_data
= 0;
1307 int buffer_size
= SELECTION_QUANTUM (display
);
1309 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1310 buffer_size
= MAX_SELECTION_QUANTUM
;
1314 /* First probe the thing to find out how big it is. */
1315 result
= XGetWindowProperty (display
, window
, property
,
1316 0L, 0L, False
, AnyPropertyType
,
1317 actual_type_ret
, actual_format_ret
,
1319 &bytes_remaining
, &tmp_data
);
1320 if (result
!= Success
)
1328 /* This was allocated by Xlib, so use XFree. */
1329 XFree ((char *) tmp_data
);
1331 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1337 total_size
= bytes_remaining
+ 1;
1338 *data_ret
= (unsigned char *) xmalloc (total_size
);
1340 /* Now read, until we've gotten it all. */
1341 while (bytes_remaining
)
1343 #ifdef TRACE_SELECTION
1344 int last
= bytes_remaining
;
1347 = XGetWindowProperty (display
, window
, property
,
1348 (long)offset
/4, (long)buffer_size
/4,
1351 actual_type_ret
, actual_format_ret
,
1352 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1354 TRACE2 ("Read %ld bytes from property %s",
1355 last
- bytes_remaining
,
1356 XGetAtomName (display
, property
));
1358 /* If this doesn't return Success at this point, it means that
1359 some clod deleted the selection while we were in the midst of
1360 reading it. Deal with that, I guess.... */
1361 if (result
!= Success
)
1363 *actual_size_ret
*= *actual_format_ret
/ 8;
1364 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1365 offset
+= *actual_size_ret
;
1367 /* This was allocated by Xlib, so use XFree. */
1368 XFree ((char *) tmp_data
);
1373 *bytes_ret
= offset
;
1376 /* Use xfree, not XFree, to free the data obtained with this function. */
1379 receive_incremental_selection (display
, window
, property
, target_type
,
1380 min_size_bytes
, data_ret
, size_bytes_ret
,
1381 type_ret
, format_ret
, size_ret
)
1385 Lisp_Object target_type
; /* for error messages only */
1386 unsigned int min_size_bytes
;
1387 unsigned char **data_ret
;
1388 int *size_bytes_ret
;
1390 unsigned long *size_ret
;
1394 struct prop_location
*wait_object
;
1395 *size_bytes_ret
= min_size_bytes
;
1396 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1398 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1400 /* At this point, we have read an INCR property.
1401 Delete the property to ack it.
1402 (But first, prepare to receive the next event in this handshake.)
1404 Now, we must loop, waiting for the sending window to put a value on
1405 that property, then reading the property, then deleting it to ack.
1406 We are done when the sender places a property of length 0.
1409 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1410 TRACE1 (" Delete property %s",
1411 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1412 XDeleteProperty (display
, window
, property
);
1413 TRACE1 (" Expect new value of property %s",
1414 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1415 wait_object
= expect_property_change (display
, window
, property
,
1422 unsigned char *tmp_data
;
1425 TRACE0 (" Wait for property change");
1426 wait_for_property_change (wait_object
);
1428 /* expect it again immediately, because x_get_window_property may
1429 .. no it won't, I don't get it.
1430 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1431 TRACE0 (" Get property value");
1432 x_get_window_property (display
, window
, property
,
1433 &tmp_data
, &tmp_size_bytes
,
1434 type_ret
, format_ret
, size_ret
, 1);
1436 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1438 if (tmp_size_bytes
== 0) /* we're done */
1440 TRACE0 ("Done reading incrementally");
1442 if (! waiting_for_other_props_on_window (display
, window
))
1443 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1444 unexpect_property_change (wait_object
);
1445 /* Use xfree, not XFree, because x_get_window_property
1446 calls xmalloc itself. */
1447 if (tmp_data
) xfree (tmp_data
);
1452 TRACE1 (" ACK by deleting property %s",
1453 XGetAtomName (display
, property
));
1454 XDeleteProperty (display
, window
, property
);
1455 wait_object
= expect_property_change (display
, window
, property
,
1460 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1462 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1463 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1466 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1467 offset
+= tmp_size_bytes
;
1469 /* Use xfree, not XFree, because x_get_window_property
1470 calls xmalloc itself. */
1476 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1477 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1478 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1481 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1486 Lisp_Object target_type
; /* for error messages only */
1487 Atom selection_atom
; /* for error messages only */
1491 unsigned long actual_size
;
1492 unsigned char *data
= 0;
1495 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1497 TRACE0 ("Reading selection data");
1499 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1500 &actual_type
, &actual_format
, &actual_size
, 1);
1503 int there_is_a_selection_owner
;
1505 there_is_a_selection_owner
1506 = XGetSelectionOwner (display
, selection_atom
);
1509 there_is_a_selection_owner
1510 ? Fcons (build_string ("selection owner couldn't convert"),
1512 ? Fcons (target_type
,
1513 Fcons (x_atom_to_symbol (display
,
1516 : Fcons (target_type
, Qnil
))
1517 : Fcons (build_string ("no selection"),
1518 Fcons (x_atom_to_symbol (display
,
1523 if (actual_type
== dpyinfo
->Xatom_INCR
)
1525 /* That wasn't really the data, just the beginning. */
1527 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1529 /* Use xfree, not XFree, because x_get_window_property
1530 calls xmalloc itself. */
1531 xfree ((char *) data
);
1533 receive_incremental_selection (display
, window
, property
, target_type
,
1534 min_size_bytes
, &data
, &bytes
,
1535 &actual_type
, &actual_format
,
1540 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1541 XDeleteProperty (display
, window
, property
);
1545 /* It's been read. Now convert it to a lisp object in some semi-rational
1547 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1548 actual_type
, actual_format
);
1550 /* Use xfree, not XFree, because x_get_window_property
1551 calls xmalloc itself. */
1552 xfree ((char *) data
);
1556 /* These functions convert from the selection data read from the server into
1557 something that we can use from Lisp, and vice versa.
1559 Type: Format: Size: Lisp Type:
1560 ----- ------- ----- -----------
1563 ATOM 32 > 1 Vector of Symbols
1565 * 16 > 1 Vector of Integers
1566 * 32 1 if <=16 bits: Integer
1567 if > 16 bits: Cons of top16, bot16
1568 * 32 > 1 Vector of the above
1570 When converting a Lisp number to C, it is assumed to be of format 16 if
1571 it is an integer, and of format 32 if it is a cons of two integers.
1573 When converting a vector of numbers from Lisp to C, it is assumed to be
1574 of format 16 if every element in the vector is an integer, and is assumed
1575 to be of format 32 if any element is a cons of two integers.
1577 When converting an object to C, it may be of the form (SYMBOL . <data>)
1578 where SYMBOL is what we should claim that the type is. Format and
1579 representation are as above. */
1584 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1586 unsigned char *data
;
1590 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1592 if (type
== dpyinfo
->Xatom_NULL
)
1595 /* Convert any 8-bit data to a string, for compactness. */
1596 else if (format
== 8)
1599 int require_encoding
= 0;
1605 ! NILP (buffer_defaults
.enable_multibyte_characters
)
1609 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1610 DATA to Emacs internal format because DATA may be encoded
1611 in compound text format. In addtion, if TYPE is `STRING'
1612 and DATA contains any 8-bit Latin-1 code, we should also
1614 if (type
== dpyinfo
->Xatom_TEXT
1615 || type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1616 require_encoding
= 1;
1617 else if (type
== XA_STRING
)
1620 for (i
= 0; i
< size
; i
++)
1622 if (data
[i
] >= 0x80)
1624 require_encoding
= 1;
1630 if (!require_encoding
)
1632 str
= make_unibyte_string ((char *) data
, size
);
1633 Vlast_coding_system_used
= Qraw_text
;
1639 struct coding_system coding
;
1641 if (NILP (Vnext_selection_coding_system
))
1642 Vnext_selection_coding_system
= Vselection_coding_system
;
1644 (Fcheck_coding_system(Vnext_selection_coding_system
), &coding
);
1645 coding
.src_multibyte
= 0;
1646 coding
.dst_multibyte
= 1;
1647 Vnext_selection_coding_system
= Qnil
;
1648 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
1649 bufsize
= decoding_buffer_size (&coding
, size
);
1650 buf
= (unsigned char *) xmalloc (bufsize
);
1651 decode_coding (&coding
, data
, buf
, size
, bufsize
);
1652 str
= make_string_from_bytes ((char *) buf
,
1653 coding
.produced_char
, coding
.produced
);
1656 if (SYMBOLP (coding
.post_read_conversion
)
1657 && !NILP (Ffboundp (coding
.post_read_conversion
)))
1658 str
= run_pre_post_conversion_on_str (str
, &coding
, 0);
1659 Vlast_coding_system_used
= coding
.symbol
;
1661 compose_chars_in_text (0, XSTRING (str
)->size
, str
);
1664 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1665 a vector of symbols.
1667 else if (type
== XA_ATOM
)
1670 if (size
== sizeof (Atom
))
1671 return x_atom_to_symbol (display
, *((Atom
*) data
));
1674 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1676 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1677 Faset (v
, make_number (i
),
1678 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1683 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1684 If the number is > 16 bits, convert it to a cons of integers,
1685 16 bits in each half.
1687 else if (format
== 32 && size
== sizeof (long))
1688 return long_to_cons (((unsigned long *) data
) [0]);
1689 else if (format
== 16 && size
== sizeof (short))
1690 return make_number ((int) (((unsigned short *) data
) [0]));
1692 /* Convert any other kind of data to a vector of numbers, represented
1693 as above (as an integer, or a cons of two 16 bit integers.)
1695 else if (format
== 16)
1699 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1700 for (i
= 0; i
< size
/ 2; i
++)
1702 int j
= (int) ((unsigned short *) data
) [i
];
1703 Faset (v
, make_number (i
), make_number (j
));
1710 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1711 for (i
= 0; i
< size
/ 4; i
++)
1713 unsigned long j
= ((unsigned long *) data
) [i
];
1714 Faset (v
, make_number (i
), long_to_cons (j
));
1721 /* Use xfree, not XFree, to free the data obtained with this function. */
1724 lisp_data_to_selection_data (display
, obj
,
1725 data_ret
, type_ret
, size_ret
,
1726 format_ret
, nofree_ret
)
1729 unsigned char **data_ret
;
1731 unsigned int *size_ret
;
1735 Lisp_Object type
= Qnil
;
1736 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1740 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1744 if (CONSP (obj
) && NILP (XCDR (obj
)))
1748 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1749 { /* This is not the same as declining */
1755 else if (STRINGP (obj
))
1757 /* Since we are now handling multilingual text, we must consider
1758 sending back compound text. */
1761 if (NILP (Vnext_selection_coding_system
))
1762 Vnext_selection_coding_system
= Vselection_coding_system
;
1765 *data_ret
= x_encode_text (obj
, Vnext_selection_coding_system
, 1,
1766 (int *) size_ret
, &stringp
);
1767 *nofree_ret
= (*data_ret
== XSTRING (obj
)->data
);
1770 if (stringp
&& *nofree_ret
)
1772 else if (EQ (Vnext_selection_coding_system
,
1773 Qcompound_text_with_extensions
))
1774 type
= QCOMPOUND_TEXT
;
1776 type
= (stringp
? QSTRING
: QCOMPOUND_TEXT
);
1778 Vlast_coding_system_used
= (*nofree_ret
1780 : Vnext_selection_coding_system
);
1781 Vnext_selection_coding_system
= Qnil
;
1783 else if (SYMBOLP (obj
))
1787 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1788 (*data_ret
) [sizeof (Atom
)] = 0;
1789 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1790 if (NILP (type
)) type
= QATOM
;
1792 else if (INTEGERP (obj
)
1793 && XINT (obj
) < 0xFFFF
1794 && XINT (obj
) > -0xFFFF)
1798 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1799 (*data_ret
) [sizeof (short)] = 0;
1800 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1801 if (NILP (type
)) type
= QINTEGER
;
1803 else if (INTEGERP (obj
)
1804 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1805 && (INTEGERP (XCDR (obj
))
1806 || (CONSP (XCDR (obj
))
1807 && INTEGERP (XCAR (XCDR (obj
)))))))
1811 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1812 (*data_ret
) [sizeof (long)] = 0;
1813 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1814 if (NILP (type
)) type
= QINTEGER
;
1816 else if (VECTORP (obj
))
1818 /* Lisp_Vectors may represent a set of ATOMs;
1819 a set of 16 or 32 bit INTEGERs;
1820 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1824 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1825 /* This vector is an ATOM set */
1827 if (NILP (type
)) type
= QATOM
;
1828 *size_ret
= XVECTOR (obj
)->size
;
1830 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1831 for (i
= 0; i
< *size_ret
; i
++)
1832 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1833 (*(Atom
**) data_ret
) [i
]
1834 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1836 Fsignal (Qerror
, /* Qselection_error */
1838 ("all elements of selection vector must have same type"),
1839 Fcons (obj
, Qnil
)));
1841 #if 0 /* #### MULTIPLE doesn't work yet */
1842 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1843 /* This vector is an ATOM_PAIR set */
1845 if (NILP (type
)) type
= QATOM_PAIR
;
1846 *size_ret
= XVECTOR (obj
)->size
;
1848 *data_ret
= (unsigned char *)
1849 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1850 for (i
= 0; i
< *size_ret
; i
++)
1851 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1853 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1854 if (XVECTOR (pair
)->size
!= 2)
1857 ("elements of the vector must be vectors of exactly two elements"),
1858 Fcons (pair
, Qnil
)));
1860 (*(Atom
**) data_ret
) [i
* 2]
1861 = symbol_to_x_atom (dpyinfo
, display
,
1862 XVECTOR (pair
)->contents
[0]);
1863 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1864 = symbol_to_x_atom (dpyinfo
, display
,
1865 XVECTOR (pair
)->contents
[1]);
1870 ("all elements of the vector must be of the same type"),
1871 Fcons (obj
, Qnil
)));
1876 /* This vector is an INTEGER set, or something like it */
1878 *size_ret
= XVECTOR (obj
)->size
;
1879 if (NILP (type
)) type
= QINTEGER
;
1881 for (i
= 0; i
< *size_ret
; i
++)
1882 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1884 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1885 Fsignal (Qerror
, /* Qselection_error */
1887 ("elements of selection vector must be integers or conses of integers"),
1888 Fcons (obj
, Qnil
)));
1890 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1891 for (i
= 0; i
< *size_ret
; i
++)
1892 if (*format_ret
== 32)
1893 (*((unsigned long **) data_ret
)) [i
]
1894 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1896 (*((unsigned short **) data_ret
)) [i
]
1897 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1901 Fsignal (Qerror
, /* Qselection_error */
1902 Fcons (build_string ("unrecognised selection data"),
1903 Fcons (obj
, Qnil
)));
1905 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1909 clean_local_selection_data (obj
)
1913 && INTEGERP (XCAR (obj
))
1914 && CONSP (XCDR (obj
))
1915 && INTEGERP (XCAR (XCDR (obj
)))
1916 && NILP (XCDR (XCDR (obj
))))
1917 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1920 && INTEGERP (XCAR (obj
))
1921 && INTEGERP (XCDR (obj
)))
1923 if (XINT (XCAR (obj
)) == 0)
1925 if (XINT (XCAR (obj
)) == -1)
1926 return make_number (- XINT (XCDR (obj
)));
1931 int size
= XVECTOR (obj
)->size
;
1934 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1935 copy
= Fmake_vector (make_number (size
), Qnil
);
1936 for (i
= 0; i
< size
; i
++)
1937 XVECTOR (copy
)->contents
[i
]
1938 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1944 /* Called from XTread_socket to handle SelectionNotify events.
1945 If it's the selection we are waiting for, stop waiting
1946 by setting the car of reading_selection_reply to non-nil.
1947 We store t there if the reply is successful, lambda if not. */
1950 x_handle_selection_notify (event
)
1951 XSelectionEvent
*event
;
1953 if (event
->requestor
!= reading_selection_window
)
1955 if (event
->selection
!= reading_which_selection
)
1958 TRACE0 ("Received SelectionNotify");
1959 XSETCAR (reading_selection_reply
,
1960 (event
->property
!= 0 ? Qt
: Qlambda
));
1964 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1965 Sx_own_selection_internal
, 2, 2, 0,
1966 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1967 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1968 \(Those are literal upper-case symbol names, since that's what X expects.)
1969 VALUE is typically a string, or a cons of two markers, but may be
1970 anything that the functions on `selection-converter-alist' know about. */)
1971 (selection_name
, selection_value
)
1972 Lisp_Object selection_name
, selection_value
;
1975 CHECK_SYMBOL (selection_name
);
1976 if (NILP (selection_value
)) error ("selection-value may not be nil");
1977 x_own_selection (selection_name
, selection_value
);
1978 return selection_value
;
1982 /* Request the selection value from the owner. If we are the owner,
1983 simply return our selection value. If we are not the owner, this
1984 will block until all of the data has arrived. */
1986 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1987 Sx_get_selection_internal
, 2, 2, 0,
1988 doc
: /* Return text selected from some X window.
1989 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1990 \(Those are literal upper-case symbol names, since that's what X expects.)
1991 TYPE is the type of data desired, typically `STRING'. */)
1992 (selection_symbol
, target_type
)
1993 Lisp_Object selection_symbol
, target_type
;
1995 Lisp_Object val
= Qnil
;
1996 struct gcpro gcpro1
, gcpro2
;
1997 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1999 CHECK_SYMBOL (selection_symbol
);
2001 #if 0 /* #### MULTIPLE doesn't work yet */
2002 if (CONSP (target_type
)
2003 && XCAR (target_type
) == QMULTIPLE
)
2005 CHECK_VECTOR (XCDR (target_type
));
2006 /* So we don't destructively modify this... */
2007 target_type
= copy_multiple_data (target_type
);
2011 CHECK_SYMBOL (target_type
);
2013 val
= x_get_local_selection (selection_symbol
, target_type
);
2017 val
= x_get_foreign_selection (selection_symbol
, target_type
);
2022 && SYMBOLP (XCAR (val
)))
2025 if (CONSP (val
) && NILP (XCDR (val
)))
2028 val
= clean_local_selection_data (val
);
2034 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2035 Sx_disown_selection_internal
, 1, 2, 0,
2036 doc
: /* If we own the selection SELECTION, disown it.
2037 Disowning it means there is no such selection. */)
2039 Lisp_Object selection
;
2043 Atom selection_atom
;
2044 struct selection_input_event event
;
2046 struct x_display_info
*dpyinfo
;
2047 struct frame
*sf
= SELECTED_FRAME ();
2050 display
= FRAME_X_DISPLAY (sf
);
2051 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2052 CHECK_SYMBOL (selection
);
2054 timestamp
= last_event_timestamp
;
2056 timestamp
= cons_to_long (time
);
2058 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2059 return Qnil
; /* Don't disown the selection when we're not the owner. */
2061 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2064 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2067 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2068 generated for a window which owns the selection when that window sets
2069 the selection owner to None. The NCD server does, the MIT Sun4 server
2070 doesn't. So we synthesize one; this means we might get two, but
2071 that's ok, because the second one won't have any effect. */
2072 SELECTION_EVENT_DISPLAY (&event
) = display
;
2073 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2074 SELECTION_EVENT_TIME (&event
) = timestamp
;
2075 x_handle_selection_clear ((struct input_event
*) &event
);
2080 /* Get rid of all the selections in buffer BUFFER.
2081 This is used when we kill a buffer. */
2084 x_disown_buffer_selections (buffer
)
2088 struct buffer
*buf
= XBUFFER (buffer
);
2090 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2092 Lisp_Object elt
, value
;
2095 if (CONSP (value
) && MARKERP (XCAR (value
))
2096 && XMARKER (XCAR (value
))->buffer
== buf
)
2097 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2101 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2103 doc
: /* Whether the current Emacs process owns the given X Selection.
2104 The arg should be the name of the selection in question, typically one of
2105 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2106 \(Those are literal upper-case symbol names, since that's what X expects.)
2107 For convenience, the symbol nil is the same as `PRIMARY',
2108 and t is the same as `SECONDARY'. */)
2110 Lisp_Object selection
;
2113 CHECK_SYMBOL (selection
);
2114 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2115 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2117 if (NILP (Fassq (selection
, Vselection_alist
)))
2122 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2124 doc
: /* Whether there is an owner for the given X Selection.
2125 The arg should be the name of the selection in question, typically one of
2126 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2127 \(Those are literal upper-case symbol names, since that's what X expects.)
2128 For convenience, the symbol nil is the same as `PRIMARY',
2129 and t is the same as `SECONDARY'. */)
2131 Lisp_Object selection
;
2136 struct frame
*sf
= SELECTED_FRAME ();
2138 /* It should be safe to call this before we have an X frame. */
2139 if (! FRAME_X_P (sf
))
2142 dpy
= FRAME_X_DISPLAY (sf
);
2143 CHECK_SYMBOL (selection
);
2144 if (!NILP (Fx_selection_owner_p (selection
)))
2146 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2147 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2148 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2152 owner
= XGetSelectionOwner (dpy
, atom
);
2154 return (owner
? Qt
: Qnil
);
2158 #ifdef CUT_BUFFER_SUPPORT
2160 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2162 initialize_cut_buffers (display
, window
)
2166 unsigned char *data
= (unsigned char *) "";
2168 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2169 PropModeAppend, data, 0)
2170 FROB (XA_CUT_BUFFER0
);
2171 FROB (XA_CUT_BUFFER1
);
2172 FROB (XA_CUT_BUFFER2
);
2173 FROB (XA_CUT_BUFFER3
);
2174 FROB (XA_CUT_BUFFER4
);
2175 FROB (XA_CUT_BUFFER5
);
2176 FROB (XA_CUT_BUFFER6
);
2177 FROB (XA_CUT_BUFFER7
);
2183 #define CHECK_CUT_BUFFER(symbol) \
2184 { CHECK_SYMBOL ((symbol)); \
2185 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2186 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2187 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2188 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2190 Fcons (build_string ("doesn't name a cut buffer"), \
2191 Fcons ((symbol), Qnil))); \
2194 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2195 Sx_get_cut_buffer_internal
, 1, 1, 0,
2196 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2202 unsigned char *data
;
2209 struct x_display_info
*dpyinfo
;
2210 struct frame
*sf
= SELECTED_FRAME ();
2213 display
= FRAME_X_DISPLAY (sf
);
2214 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2215 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2216 CHECK_CUT_BUFFER (buffer
);
2217 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2219 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2220 &type
, &format
, &size
, 0);
2221 if (!data
|| !format
)
2224 if (format
!= 8 || type
!= XA_STRING
)
2226 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2227 Fcons (x_atom_to_symbol (display
, type
),
2228 Fcons (make_number (format
), Qnil
))));
2230 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2231 /* Use xfree, not XFree, because x_get_window_property
2232 calls xmalloc itself. */
2238 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2239 Sx_store_cut_buffer_internal
, 2, 2, 0,
2240 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2242 Lisp_Object buffer
, string
;
2246 unsigned char *data
;
2248 int bytes_remaining
;
2251 struct frame
*sf
= SELECTED_FRAME ();
2254 display
= FRAME_X_DISPLAY (sf
);
2255 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2257 max_bytes
= SELECTION_QUANTUM (display
);
2258 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2259 max_bytes
= MAX_SELECTION_QUANTUM
;
2261 CHECK_CUT_BUFFER (buffer
);
2262 CHECK_STRING (string
);
2263 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2265 data
= (unsigned char *) XSTRING (string
)->data
;
2266 bytes
= STRING_BYTES (XSTRING (string
));
2267 bytes_remaining
= bytes
;
2269 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2271 initialize_cut_buffers (display
, window
);
2272 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2277 /* Don't mess up with an empty value. */
2278 if (!bytes_remaining
)
2279 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2280 PropModeReplace
, data
, 0);
2282 while (bytes_remaining
)
2284 int chunk
= (bytes_remaining
< max_bytes
2285 ? bytes_remaining
: max_bytes
);
2286 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2287 (bytes_remaining
== bytes
2292 bytes_remaining
-= chunk
;
2299 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2300 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2301 doc
: /* Rotate the values of the cut buffers by the given number of step.
2302 Positive means shift the values forward, negative means backward. */)
2309 struct frame
*sf
= SELECTED_FRAME ();
2312 display
= FRAME_X_DISPLAY (sf
);
2313 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2317 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2319 initialize_cut_buffers (display
, window
);
2320 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2323 props
[0] = XA_CUT_BUFFER0
;
2324 props
[1] = XA_CUT_BUFFER1
;
2325 props
[2] = XA_CUT_BUFFER2
;
2326 props
[3] = XA_CUT_BUFFER3
;
2327 props
[4] = XA_CUT_BUFFER4
;
2328 props
[5] = XA_CUT_BUFFER5
;
2329 props
[6] = XA_CUT_BUFFER6
;
2330 props
[7] = XA_CUT_BUFFER7
;
2332 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2342 defsubr (&Sx_get_selection_internal
);
2343 defsubr (&Sx_own_selection_internal
);
2344 defsubr (&Sx_disown_selection_internal
);
2345 defsubr (&Sx_selection_owner_p
);
2346 defsubr (&Sx_selection_exists_p
);
2348 #ifdef CUT_BUFFER_SUPPORT
2349 defsubr (&Sx_get_cut_buffer_internal
);
2350 defsubr (&Sx_store_cut_buffer_internal
);
2351 defsubr (&Sx_rotate_cut_buffers_internal
);
2354 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2355 staticpro (&reading_selection_reply
);
2356 reading_selection_window
= 0;
2357 reading_which_selection
= 0;
2359 property_change_wait_list
= 0;
2360 prop_location_identifier
= 0;
2361 property_change_reply
= Fcons (Qnil
, Qnil
);
2362 staticpro (&property_change_reply
);
2364 Vselection_alist
= Qnil
;
2365 staticpro (&Vselection_alist
);
2367 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2368 doc
: /* An alist associating X Windows selection-types with functions.
2369 These functions are called to convert the selection, with three args:
2370 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2371 a desired type to which the selection should be converted;
2372 and the local selection value (whatever was given to `x-own-selection').
2374 The function should return the value to send to the X server
2375 \(typically a string). A return value of nil
2376 means that the conversion could not be done.
2377 A return value which is the symbol `NULL'
2378 means that a side-effect was executed,
2379 and there is no meaningful selection value. */);
2380 Vselection_converter_alist
= Qnil
;
2382 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2383 doc
: /* A list of functions to be called when Emacs loses an X selection.
2384 \(This happens when some other X client makes its own selection
2385 or when a Lisp program explicitly clears the selection.)
2386 The functions are called with one argument, the selection type
2387 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2388 Vx_lost_selection_hooks
= Qnil
;
2390 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2391 doc
: /* A list of functions to be called when Emacs answers a selection request.
2392 The functions are called with four arguments:
2393 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2394 - the selection-type which Emacs was asked to convert the
2395 selection into before sending (for example, `STRING' or `LENGTH');
2396 - a flag indicating success or failure for responding to the request.
2397 We might have failed (and declined the request) for any number of reasons,
2398 including being asked for a selection that we no longer own, or being asked
2399 to convert into a type that we don't know about or that is inappropriate.
2400 This hook doesn't let you change the behavior of Emacs's selection replies,
2401 it merely informs you that they have happened. */);
2402 Vx_sent_selection_hooks
= Qnil
;
2404 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2405 doc
: /* Coding system for communicating with other X clients.
2406 When sending or receiving text via cut_buffer, selection, and clipboard,
2407 the text is encoded or decoded by this coding system.
2408 The default value is `compound-text-with-extensions'. */);
2409 Vselection_coding_system
= intern ("compound-text-with-extensions");
2411 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2412 doc
: /* Coding system for the next communication with other X clients.
2413 Usually, `selection-coding-system' is used for communicating with
2414 other X clients. But, if this variable is set, it is used for the
2415 next communication only. After the communication, this variable is
2417 Vnext_selection_coding_system
= Qnil
;
2419 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2420 doc
: /* Number of milliseconds to wait for a selection reply.
2421 If the selection owner doesn't reply in this time, we give up.
2422 A value of 0 means wait as long as necessary. This is initialized from the
2423 \"*selectionTimeout\" resource. */);
2424 x_selection_timeout
= 0;
2426 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2427 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2428 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2429 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2430 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2431 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2432 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2433 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2434 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2435 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2436 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2437 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2438 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2439 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2440 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2441 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2442 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2443 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2444 staticpro (&Qcompound_text_with_extensions
);
2446 #ifdef CUT_BUFFER_SUPPORT
2447 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2448 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2449 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2450 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2451 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2452 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2453 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2454 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);