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 #ifdef CUT_BUFFER_SUPPORT
101 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
102 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
105 static Lisp_Object Vx_lost_selection_hooks
;
106 static Lisp_Object Vx_sent_selection_hooks
;
107 /* Coding system for communicating with other X clients via cutbuffer,
108 selection, and clipboard. */
109 static Lisp_Object Vselection_coding_system
;
111 /* Coding system for the next communicating with other X clients. */
112 static Lisp_Object Vnext_selection_coding_system
;
114 /* If this is a smaller number than the max-request-size of the display,
115 emacs will use INCR selection transfer when the selection is larger
116 than this. The max-request-size is usually around 64k, so if you want
117 emacs to use incremental selection transfers when the selection is
118 smaller than that, set this. I added this mostly for debugging the
119 incremental transfer stuff, but it might improve server performance. */
120 #define MAX_SELECTION_QUANTUM 0xFFFFFF
123 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
125 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
128 /* The timestamp of the last input event Emacs received from the X server. */
129 /* Defined in keyboard.c. */
130 extern unsigned long last_event_timestamp
;
132 /* This is an association list whose elements are of the form
133 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
134 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
135 SELECTION-VALUE is the value that emacs owns for that selection.
136 It may be any kind of Lisp object.
137 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
138 as a cons of two 16-bit numbers (making a 32 bit time.)
139 FRAME is the frame for which we made the selection.
140 If there is an entry in this alist, then it can be assumed that Emacs owns
142 The only (eq) parts of this list that are visible from Lisp are the
144 static Lisp_Object Vselection_alist
;
146 /* This is an alist whose CARs are selection-types (whose names are the same
147 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
148 call to convert the given Emacs selection value to a string representing
149 the given selection type. This is for Lisp-level extension of the emacs
150 selection handling. */
151 static Lisp_Object Vselection_converter_alist
;
153 /* If the selection owner takes too long to reply to a selection request,
154 we give up on it. This is in milliseconds (0 = no timeout.) */
155 static int x_selection_timeout
;
157 /* Utility functions */
159 static void lisp_data_to_selection_data ();
160 static Lisp_Object
selection_data_to_lisp_data ();
161 static Lisp_Object
x_get_window_property_as_lisp_data ();
163 /* This converts a Lisp symbol to a server Atom, avoiding a server
164 roundtrip whenever possible. */
167 symbol_to_x_atom (dpyinfo
, display
, sym
)
168 struct x_display_info
*dpyinfo
;
173 if (NILP (sym
)) return 0;
174 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
175 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
176 if (EQ (sym
, QSTRING
)) return XA_STRING
;
177 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
178 if (EQ (sym
, QATOM
)) return XA_ATOM
;
179 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
180 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
181 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
182 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
183 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
184 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
185 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
186 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
187 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
188 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
189 #ifdef CUT_BUFFER_SUPPORT
190 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
191 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
192 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
193 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
194 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
195 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
196 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
197 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
199 if (!SYMBOLP (sym
)) abort ();
201 TRACE1 (" XInternAtom %s", (char *) XSYMBOL (sym
)->name
->data
);
203 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
209 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
210 and calls to intern whenever possible. */
213 x_atom_to_symbol (dpy
, atom
)
217 struct x_display_info
*dpyinfo
;
236 #ifdef CUT_BUFFER_SUPPORT
256 dpyinfo
= x_display_info_for_display (dpy
);
257 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
259 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
261 if (atom
== dpyinfo
->Xatom_TEXT
)
263 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
264 return QCOMPOUND_TEXT
;
265 if (atom
== dpyinfo
->Xatom_DELETE
)
267 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
269 if (atom
== dpyinfo
->Xatom_INCR
)
271 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
273 if (atom
== dpyinfo
->Xatom_TARGETS
)
275 if (atom
== dpyinfo
->Xatom_NULL
)
279 str
= XGetAtomName (dpy
, atom
);
281 TRACE1 ("XGetAtomName --> %s", str
);
282 if (! str
) return Qnil
;
285 /* This was allocated by Xlib, so use XFree. */
291 /* Do protocol to assert ourself as a selection owner.
292 Update the Vselection_alist so that we can reply to later requests for
296 x_own_selection (selection_name
, selection_value
)
297 Lisp_Object selection_name
, selection_value
;
299 struct frame
*sf
= SELECTED_FRAME ();
300 Window selecting_window
= FRAME_X_WINDOW (sf
);
301 Display
*display
= FRAME_X_DISPLAY (sf
);
302 Time time
= last_event_timestamp
;
304 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
307 CHECK_SYMBOL (selection_name
);
308 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
311 count
= x_catch_errors (display
);
312 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
313 x_check_errors (display
, "Can't set selection: %s");
314 x_uncatch_errors (display
, count
);
317 /* Now update the local cache */
319 Lisp_Object selection_time
;
320 Lisp_Object selection_data
;
321 Lisp_Object prev_value
;
323 selection_time
= long_to_cons ((unsigned long) time
);
324 selection_data
= Fcons (selection_name
,
325 Fcons (selection_value
,
326 Fcons (selection_time
,
327 Fcons (selected_frame
, Qnil
))));
328 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
330 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
332 /* If we already owned the selection, remove the old selection data.
333 Perhaps we should destructively modify it instead.
334 Don't use Fdelq as that may QUIT. */
335 if (!NILP (prev_value
))
337 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
338 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
339 if (EQ (prev_value
, Fcar (XCDR (rest
))))
341 XSETCDR (rest
, Fcdr (XCDR (rest
)));
348 /* Given a selection-name and desired type, look up our local copy of
349 the selection value and convert it to the type.
350 The value is nil or a string.
351 This function is used both for remote requests
352 and for local x-get-selection-internal.
354 This calls random Lisp code, and may signal or gc. */
357 x_get_local_selection (selection_symbol
, target_type
)
358 Lisp_Object selection_symbol
, target_type
;
360 Lisp_Object local_value
;
361 Lisp_Object handler_fn
, value
, type
, check
;
364 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
366 if (NILP (local_value
)) return Qnil
;
368 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
369 if (EQ (target_type
, QTIMESTAMP
))
372 value
= XCAR (XCDR (XCDR (local_value
)));
375 else if (EQ (target_type
, QDELETE
))
378 Fx_disown_selection_internal
380 XCAR (XCDR (XCDR (local_value
))));
385 #if 0 /* #### MULTIPLE doesn't work yet */
386 else if (CONSP (target_type
)
387 && XCAR (target_type
) == QMULTIPLE
)
392 pairs
= XCDR (target_type
);
393 size
= XVECTOR (pairs
)->size
;
394 /* If the target is MULTIPLE, then target_type looks like
395 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
396 We modify the second element of each pair in the vector and
397 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
399 for (i
= 0; i
< size
; i
++)
402 pair
= XVECTOR (pairs
)->contents
[i
];
403 XVECTOR (pair
)->contents
[1]
404 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
405 XVECTOR (pair
)->contents
[1]);
412 /* Don't allow a quit within the converter.
413 When the user types C-g, he would be surprised
414 if by luck it came during a converter. */
415 count
= specpdl_ptr
- specpdl
;
416 specbind (Qinhibit_quit
, Qt
);
418 CHECK_SYMBOL (target_type
);
419 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
420 if (!NILP (handler_fn
))
421 value
= call3 (handler_fn
,
422 selection_symbol
, target_type
,
423 XCAR (XCDR (local_value
)));
426 unbind_to (count
, Qnil
);
429 /* Make sure this value is of a type that we could transmit
430 to another X client. */
434 && SYMBOLP (XCAR (value
)))
436 check
= XCDR (value
);
444 /* Check for a value that cons_to_long could handle. */
445 else if (CONSP (check
)
446 && INTEGERP (XCAR (check
))
447 && (INTEGERP (XCDR (check
))
449 (CONSP (XCDR (check
))
450 && INTEGERP (XCAR (XCDR (check
)))
451 && NILP (XCDR (XCDR (check
))))))
456 Fcons (build_string ("invalid data returned by selection-conversion function"),
457 Fcons (handler_fn
, Fcons (value
, Qnil
))));
460 /* Subroutines of x_reply_selection_request. */
462 /* Send a SelectionNotify event to the requestor with property=None,
463 meaning we were unable to do what they wanted. */
466 x_decline_selection_request (event
)
467 struct input_event
*event
;
469 XSelectionEvent reply
;
472 reply
.type
= SelectionNotify
;
473 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
474 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
475 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
476 reply
.time
= SELECTION_EVENT_TIME (event
);
477 reply
.target
= SELECTION_EVENT_TARGET (event
);
478 reply
.property
= None
;
480 /* The reason for the error may be that the receiver has
481 died in the meantime. Handle that case. */
483 count
= x_catch_errors (reply
.display
);
484 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
485 XFlush (reply
.display
);
486 x_uncatch_errors (reply
.display
, count
);
490 /* This is the selection request currently being processed.
491 It is set to zero when the request is fully processed. */
492 static struct input_event
*x_selection_current_request
;
494 /* Display info in x_selection_request. */
496 static struct x_display_info
*selection_request_dpyinfo
;
498 /* Used as an unwind-protect clause so that, if a selection-converter signals
499 an error, we tell the requester that we were unable to do what they wanted
500 before we throw to top-level or go into the debugger or whatever. */
503 x_selection_request_lisp_error (ignore
)
506 if (x_selection_current_request
!= 0
507 && selection_request_dpyinfo
->display
)
508 x_decline_selection_request (x_selection_current_request
);
513 /* This stuff is so that INCR selections are reentrant (that is, so we can
514 be servicing multiple INCR selection requests simultaneously.) I haven't
515 actually tested that yet. */
517 /* Keep a list of the property changes that are awaited. */
527 struct prop_location
*next
;
530 static struct prop_location
*expect_property_change ();
531 static void wait_for_property_change ();
532 static void unexpect_property_change ();
533 static int waiting_for_other_props_on_window ();
535 static int prop_location_identifier
;
537 static Lisp_Object property_change_reply
;
539 static struct prop_location
*property_change_reply_object
;
541 static struct prop_location
*property_change_wait_list
;
544 queue_selection_requests_unwind (frame
)
547 FRAME_PTR f
= XFRAME (frame
);
550 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
554 /* Return some frame whose display info is DPYINFO.
555 Return nil if there is none. */
558 some_frame_on_display (dpyinfo
)
559 struct x_display_info
*dpyinfo
;
561 Lisp_Object list
, frame
;
563 FOR_EACH_FRAME (list
, frame
)
565 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
572 /* Send the reply to a selection request event EVENT.
573 TYPE is the type of selection data requested.
574 DATA and SIZE describe the data to send, already converted.
575 FORMAT is the unit-size (in bits) of the data to be transmitted. */
578 x_reply_selection_request (event
, format
, data
, size
, type
)
579 struct input_event
*event
;
584 XSelectionEvent reply
;
585 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
586 Window window
= SELECTION_EVENT_REQUESTOR (event
);
588 int format_bytes
= format
/8;
589 int max_bytes
= SELECTION_QUANTUM (display
);
590 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
593 if (max_bytes
> MAX_SELECTION_QUANTUM
)
594 max_bytes
= MAX_SELECTION_QUANTUM
;
596 reply
.type
= SelectionNotify
;
597 reply
.display
= display
;
598 reply
.requestor
= window
;
599 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
600 reply
.time
= SELECTION_EVENT_TIME (event
);
601 reply
.target
= SELECTION_EVENT_TARGET (event
);
602 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
603 if (reply
.property
== None
)
604 reply
.property
= reply
.target
;
606 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
608 count
= x_catch_errors (display
);
610 /* Store the data on the requested property.
611 If the selection is large, only store the first N bytes of it.
613 bytes_remaining
= size
* format_bytes
;
614 if (bytes_remaining
<= max_bytes
)
616 /* Send all the data at once, with minimal handshaking. */
617 TRACE1 ("Sending all %d bytes", bytes_remaining
);
618 XChangeProperty (display
, window
, reply
.property
, type
, format
,
619 PropModeReplace
, data
, size
);
620 /* At this point, the selection was successfully stored; ack it. */
621 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
625 /* Send an INCR selection. */
626 struct prop_location
*wait_object
;
630 frame
= some_frame_on_display (dpyinfo
);
632 /* If the display no longer has frames, we can't expect
633 to get many more selection requests from it, so don't
634 bother trying to queue them. */
637 x_start_queuing_selection_requests (display
);
639 record_unwind_protect (queue_selection_requests_unwind
,
643 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
644 error ("Attempt to transfer an INCR to ourself!");
646 TRACE2 ("Start sending %d bytes incrementally (%s)",
647 bytes_remaining
, XGetAtomName (display
, reply
.property
));
648 wait_object
= expect_property_change (display
, window
, reply
.property
,
651 TRACE1 ("Set %s to number of bytes to send",
652 XGetAtomName (display
, reply
.property
));
653 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
655 (unsigned char *) &bytes_remaining
, 1);
656 XSelectInput (display
, window
, PropertyChangeMask
);
658 /* Tell 'em the INCR data is there... */
659 TRACE0 ("Send SelectionNotify event");
660 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
663 had_errors
= x_had_errors_p (display
);
666 /* First, wait for the requester to ack by deleting the property.
667 This can run random lisp code (process handlers) or signal. */
670 TRACE1 ("Waiting for ACK (deletion of %s)",
671 XGetAtomName (display
, reply
.property
));
672 wait_for_property_change (wait_object
);
676 while (bytes_remaining
)
678 int i
= ((bytes_remaining
< max_bytes
)
685 = expect_property_change (display
, window
, reply
.property
,
688 TRACE1 ("Sending increment of %d bytes", i
);
689 TRACE1 ("Set %s to increment data",
690 XGetAtomName (display
, reply
.property
));
692 /* Append the next chunk of data to the property. */
693 XChangeProperty (display
, window
, reply
.property
, type
, format
,
694 PropModeAppend
, data
, i
/ format_bytes
);
695 bytes_remaining
-= i
;
698 had_errors
= x_had_errors_p (display
);
704 /* Now wait for the requester to ack this chunk by deleting the
705 property. This can run random lisp code or signal. */
706 TRACE1 ("Waiting for increment ACK (deletion of %s)",
707 XGetAtomName (display
, reply
.property
));
708 wait_for_property_change (wait_object
);
711 /* Now write a zero-length chunk to the property to tell the
712 requester that we're done. */
714 if (! waiting_for_other_props_on_window (display
, window
))
715 XSelectInput (display
, window
, 0L);
717 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
718 XGetAtomName (display
, reply
.property
));
719 XChangeProperty (display
, window
, reply
.property
, type
, format
,
720 PropModeReplace
, data
, 0);
721 TRACE0 ("Done sending incrementally");
724 /* The window we're communicating with may have been deleted
725 in the meantime (that's a real situation from a bug report).
726 In this case, there may be events in the event queue still
727 refering to the deleted window, and we'll get a BadWindow error
728 in XTread_socket when processing the events. I don't have
729 an idea how to fix that. gerd, 2001-01-98. */
731 x_uncatch_errors (display
, count
);
735 /* Handle a SelectionRequest event EVENT.
736 This is called from keyboard.c when such an event is found in the queue. */
739 x_handle_selection_request (event
)
740 struct input_event
*event
;
742 struct gcpro gcpro1
, gcpro2
, gcpro3
;
743 Lisp_Object local_selection_data
;
744 Lisp_Object selection_symbol
;
745 Lisp_Object target_symbol
;
746 Lisp_Object converted_selection
;
747 Time local_selection_time
;
748 Lisp_Object successful_p
;
750 struct x_display_info
*dpyinfo
751 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
753 local_selection_data
= Qnil
;
754 target_symbol
= Qnil
;
755 converted_selection
= Qnil
;
758 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
760 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
761 SELECTION_EVENT_SELECTION (event
));
763 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
765 if (NILP (local_selection_data
))
767 /* Someone asked for the selection, but we don't have it any more.
769 x_decline_selection_request (event
);
773 local_selection_time
= (Time
)
774 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
776 if (SELECTION_EVENT_TIME (event
) != CurrentTime
777 && local_selection_time
> SELECTION_EVENT_TIME (event
))
779 /* Someone asked for the selection, and we have one, but not the one
782 x_decline_selection_request (event
);
786 x_selection_current_request
= event
;
787 count
= BINDING_STACK_SIZE ();
788 selection_request_dpyinfo
= dpyinfo
;
789 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
791 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
792 SELECTION_EVENT_TARGET (event
));
794 #if 0 /* #### MULTIPLE doesn't work yet */
795 if (EQ (target_symbol
, QMULTIPLE
))
796 target_symbol
= fetch_multiple_target (event
);
799 /* Convert lisp objects back into binary data */
802 = x_get_local_selection (selection_symbol
, target_symbol
);
804 if (! NILP (converted_selection
))
812 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
814 &data
, &type
, &size
, &format
, &nofree
);
816 x_reply_selection_request (event
, format
, data
, size
, type
);
819 /* Indicate we have successfully processed this event. */
820 x_selection_current_request
= 0;
822 /* Use xfree, not XFree, because lisp_data_to_selection_data
823 calls xmalloc itself. */
827 unbind_to (count
, Qnil
);
833 /* Let random lisp code notice that the selection has been asked for. */
836 rest
= Vx_sent_selection_hooks
;
837 if (!EQ (rest
, Qunbound
))
838 for (; CONSP (rest
); rest
= Fcdr (rest
))
839 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
843 /* Handle a SelectionClear event EVENT, which indicates that some
844 client cleared out our previously asserted selection.
845 This is called from keyboard.c when such an event is found in the queue. */
848 x_handle_selection_clear (event
)
849 struct input_event
*event
;
851 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
852 Atom selection
= SELECTION_EVENT_SELECTION (event
);
853 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
855 Lisp_Object selection_symbol
, local_selection_data
;
856 Time local_selection_time
;
857 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
858 struct x_display_info
*t_dpyinfo
;
860 /* If the new selection owner is also Emacs,
861 don't clear the new selection. */
863 /* Check each display on the same terminal,
864 to see if this Emacs job now owns the selection
865 through that display. */
866 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
867 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
870 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
871 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
879 selection_symbol
= x_atom_to_symbol (display
, selection
);
881 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
883 /* Well, we already believe that we don't own it, so that's just fine. */
884 if (NILP (local_selection_data
)) return;
886 local_selection_time
= (Time
)
887 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
889 /* This SelectionClear is for a selection that we no longer own, so we can
890 disregard it. (That is, we have reasserted the selection since this
891 request was generated.) */
893 if (changed_owner_time
!= CurrentTime
894 && local_selection_time
> changed_owner_time
)
897 /* Otherwise, we're really honest and truly being told to drop it.
898 Don't use Fdelq as that may QUIT;. */
900 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
901 Vselection_alist
= Fcdr (Vselection_alist
);
905 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
906 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
908 XSETCDR (rest
, Fcdr (XCDR (rest
)));
913 /* Let random lisp code notice that the selection has been stolen. */
917 rest
= Vx_lost_selection_hooks
;
918 if (!EQ (rest
, Qunbound
))
920 for (; CONSP (rest
); rest
= Fcdr (rest
))
921 call1 (Fcar (rest
), selection_symbol
);
922 prepare_menu_bars ();
923 redisplay_preserve_echo_area (20);
928 /* Clear all selections that were made from frame F.
929 We do this when about to delete a frame. */
932 x_clear_frame_selections (f
)
938 XSETFRAME (frame
, f
);
940 /* Otherwise, we're really honest and truly being told to drop it.
941 Don't use Fdelq as that may QUIT;. */
943 /* Delete elements from the beginning of Vselection_alist. */
944 while (!NILP (Vselection_alist
)
945 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
947 /* Let random Lisp code notice that the selection has been stolen. */
948 Lisp_Object hooks
, selection_symbol
;
950 hooks
= Vx_lost_selection_hooks
;
951 selection_symbol
= Fcar (Fcar (Vselection_alist
));
953 if (!EQ (hooks
, Qunbound
))
955 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
956 call1 (Fcar (hooks
), selection_symbol
);
957 #if 0 /* This can crash when deleting a frame
958 from x_connection_closed. Anyway, it seems unnecessary;
959 something else should cause a redisplay. */
960 redisplay_preserve_echo_area (21);
964 Vselection_alist
= Fcdr (Vselection_alist
);
967 /* Delete elements after the beginning of Vselection_alist. */
968 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
969 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
971 /* Let random Lisp code notice that the selection has been stolen. */
972 Lisp_Object hooks
, selection_symbol
;
974 hooks
= Vx_lost_selection_hooks
;
975 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
977 if (!EQ (hooks
, Qunbound
))
979 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
980 call1 (Fcar (hooks
), selection_symbol
);
981 #if 0 /* See above */
982 redisplay_preserve_echo_area (22);
985 XSETCDR (rest
, Fcdr (XCDR (rest
)));
990 /* Nonzero if any properties for DISPLAY and WINDOW
991 are on the list of what we are waiting for. */
994 waiting_for_other_props_on_window (display
, window
)
998 struct prop_location
*rest
= property_change_wait_list
;
1000 if (rest
->display
== display
&& rest
->window
== window
)
1007 /* Add an entry to the list of property changes we are waiting for.
1008 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1009 The return value is a number that uniquely identifies
1010 this awaited property change. */
1012 static struct prop_location
*
1013 expect_property_change (display
, window
, property
, state
)
1019 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1020 pl
->identifier
= ++prop_location_identifier
;
1021 pl
->display
= display
;
1022 pl
->window
= window
;
1023 pl
->property
= property
;
1024 pl
->desired_state
= state
;
1025 pl
->next
= property_change_wait_list
;
1027 property_change_wait_list
= pl
;
1031 /* Delete an entry from the list of property changes we are waiting for.
1032 IDENTIFIER is the number that uniquely identifies the entry. */
1035 unexpect_property_change (location
)
1036 struct prop_location
*location
;
1038 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1041 if (rest
== location
)
1044 prev
->next
= rest
->next
;
1046 property_change_wait_list
= rest
->next
;
1055 /* Remove the property change expectation element for IDENTIFIER. */
1058 wait_for_property_change_unwind (identifierval
)
1059 Lisp_Object identifierval
;
1061 unexpect_property_change ((struct prop_location
*)
1062 (XFASTINT (XCAR (identifierval
)) << 16
1063 | XFASTINT (XCDR (identifierval
))));
1067 /* Actually wait for a property change.
1068 IDENTIFIER should be the value that expect_property_change returned. */
1071 wait_for_property_change (location
)
1072 struct prop_location
*location
;
1075 int count
= specpdl_ptr
- specpdl
;
1078 tem
= Fcons (Qnil
, Qnil
);
1079 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1080 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1082 /* Make sure to do unexpect_property_change if we quit or err. */
1083 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1085 XSETCAR (property_change_reply
, Qnil
);
1087 property_change_reply_object
= location
;
1088 /* If the event we are waiting for arrives beyond here, it will set
1089 property_change_reply, because property_change_reply_object says so. */
1090 if (! location
->arrived
)
1092 secs
= x_selection_timeout
/ 1000;
1093 usecs
= (x_selection_timeout
% 1000) * 1000;
1094 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1095 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1097 if (NILP (XCAR (property_change_reply
)))
1099 TRACE0 (" Timed out");
1100 error ("Timed out waiting for property-notify event");
1104 unbind_to (count
, Qnil
);
1107 /* Called from XTread_socket in response to a PropertyNotify event. */
1110 x_handle_property_notify (event
)
1111 XPropertyEvent
*event
;
1113 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1117 if (rest
->property
== event
->atom
1118 && rest
->window
== event
->window
1119 && rest
->display
== event
->display
1120 && rest
->desired_state
== event
->state
)
1122 TRACE2 ("Expected %s of property %s",
1123 (event
->state
== PropertyDelete
? "deletion" : "change"),
1124 XGetAtomName (event
->display
, event
->atom
));
1128 /* If this is the one wait_for_property_change is waiting for,
1129 tell it to wake up. */
1130 if (rest
== property_change_reply_object
)
1131 XSETCAR (property_change_reply
, Qt
);
1134 prev
->next
= rest
->next
;
1136 property_change_wait_list
= rest
->next
;
1148 #if 0 /* #### MULTIPLE doesn't work yet */
1151 fetch_multiple_target (event
)
1152 XSelectionRequestEvent
*event
;
1154 Display
*display
= event
->display
;
1155 Window window
= event
->requestor
;
1156 Atom target
= event
->target
;
1157 Atom selection_atom
= event
->selection
;
1162 x_get_window_property_as_lisp_data (display
, window
, target
,
1163 QMULTIPLE
, selection_atom
));
1167 copy_multiple_data (obj
)
1174 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1177 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1178 for (i
= 0; i
< size
; i
++)
1180 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1181 CHECK_VECTOR (vec2
);
1182 if (XVECTOR (vec2
)->size
!= 2)
1183 /* ??? Confusing error message */
1184 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1185 Fcons (vec2
, Qnil
)));
1186 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1187 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1188 = XVECTOR (vec2
)->contents
[0];
1189 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1190 = XVECTOR (vec2
)->contents
[1];
1198 /* Variables for communication with x_handle_selection_notify. */
1199 static Atom reading_which_selection
;
1200 static Lisp_Object reading_selection_reply
;
1201 static Window reading_selection_window
;
1203 /* Do protocol to read selection-data from the server.
1204 Converts this to Lisp data and returns it. */
1207 x_get_foreign_selection (selection_symbol
, target_type
)
1208 Lisp_Object selection_symbol
, target_type
;
1210 struct frame
*sf
= SELECTED_FRAME ();
1211 Window requestor_window
= FRAME_X_WINDOW (sf
);
1212 Display
*display
= FRAME_X_DISPLAY (sf
);
1213 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1214 Time requestor_time
= last_event_timestamp
;
1215 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1216 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1222 if (CONSP (target_type
))
1223 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1225 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1229 count
= x_catch_errors (display
);
1231 TRACE2 ("Get selection %s, type %s",
1232 XGetAtomName (display
, type_atom
),
1233 XGetAtomName (display
, target_property
));
1235 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1236 requestor_window
, requestor_time
);
1239 /* Prepare to block until the reply has been read. */
1240 reading_selection_window
= requestor_window
;
1241 reading_which_selection
= selection_atom
;
1242 XSETCAR (reading_selection_reply
, Qnil
);
1244 frame
= some_frame_on_display (dpyinfo
);
1246 /* If the display no longer has frames, we can't expect
1247 to get many more selection requests from it, so don't
1248 bother trying to queue them. */
1251 x_start_queuing_selection_requests (display
);
1253 record_unwind_protect (queue_selection_requests_unwind
,
1258 /* This allows quits. Also, don't wait forever. */
1259 secs
= x_selection_timeout
/ 1000;
1260 usecs
= (x_selection_timeout
% 1000) * 1000;
1261 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1262 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1263 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1266 x_check_errors (display
, "Cannot get selection: %s");
1267 x_uncatch_errors (display
, count
);
1270 if (NILP (XCAR (reading_selection_reply
)))
1271 error ("Timed out waiting for reply from selection owner");
1272 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1273 error ("No `%s' selection", XSYMBOL (selection_symbol
)->name
->data
);
1275 /* Otherwise, the selection is waiting for us on the requested property. */
1277 x_get_window_property_as_lisp_data (display
, requestor_window
,
1278 target_property
, target_type
,
1282 /* Subroutines of x_get_window_property_as_lisp_data */
1284 /* Use xfree, not XFree, to free the data obtained with this function. */
1287 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1288 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1293 unsigned char **data_ret
;
1295 Atom
*actual_type_ret
;
1296 int *actual_format_ret
;
1297 unsigned long *actual_size_ret
;
1301 unsigned long bytes_remaining
;
1303 unsigned char *tmp_data
= 0;
1305 int buffer_size
= SELECTION_QUANTUM (display
);
1307 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1308 buffer_size
= MAX_SELECTION_QUANTUM
;
1312 /* First probe the thing to find out how big it is. */
1313 result
= XGetWindowProperty (display
, window
, property
,
1314 0L, 0L, False
, AnyPropertyType
,
1315 actual_type_ret
, actual_format_ret
,
1317 &bytes_remaining
, &tmp_data
);
1318 if (result
!= Success
)
1326 /* This was allocated by Xlib, so use XFree. */
1327 XFree ((char *) tmp_data
);
1329 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1335 total_size
= bytes_remaining
+ 1;
1336 *data_ret
= (unsigned char *) xmalloc (total_size
);
1338 /* Now read, until we've gotten it all. */
1339 while (bytes_remaining
)
1341 #ifdef TRACE_SELECTION
1342 int last
= bytes_remaining
;
1345 = XGetWindowProperty (display
, window
, property
,
1346 (long)offset
/4, (long)buffer_size
/4,
1349 actual_type_ret
, actual_format_ret
,
1350 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1352 TRACE2 ("Read %ld bytes from property %s",
1353 last
- bytes_remaining
,
1354 XGetAtomName (display
, property
));
1356 /* If this doesn't return Success at this point, it means that
1357 some clod deleted the selection while we were in the midst of
1358 reading it. Deal with that, I guess.... */
1359 if (result
!= Success
)
1361 *actual_size_ret
*= *actual_format_ret
/ 8;
1362 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1363 offset
+= *actual_size_ret
;
1365 /* This was allocated by Xlib, so use XFree. */
1366 XFree ((char *) tmp_data
);
1371 *bytes_ret
= offset
;
1374 /* Use xfree, not XFree, to free the data obtained with this function. */
1377 receive_incremental_selection (display
, window
, property
, target_type
,
1378 min_size_bytes
, data_ret
, size_bytes_ret
,
1379 type_ret
, format_ret
, size_ret
)
1383 Lisp_Object target_type
; /* for error messages only */
1384 unsigned int min_size_bytes
;
1385 unsigned char **data_ret
;
1386 int *size_bytes_ret
;
1388 unsigned long *size_ret
;
1392 struct prop_location
*wait_object
;
1393 *size_bytes_ret
= min_size_bytes
;
1394 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1396 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1398 /* At this point, we have read an INCR property.
1399 Delete the property to ack it.
1400 (But first, prepare to receive the next event in this handshake.)
1402 Now, we must loop, waiting for the sending window to put a value on
1403 that property, then reading the property, then deleting it to ack.
1404 We are done when the sender places a property of length 0.
1407 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1408 TRACE1 (" Delete property %s",
1409 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1410 XDeleteProperty (display
, window
, property
);
1411 TRACE1 (" Expect new value of property %s",
1412 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1413 wait_object
= expect_property_change (display
, window
, property
,
1420 unsigned char *tmp_data
;
1423 TRACE0 (" Wait for property change");
1424 wait_for_property_change (wait_object
);
1426 /* expect it again immediately, because x_get_window_property may
1427 .. no it won't, I don't get it.
1428 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1429 TRACE0 (" Get property value");
1430 x_get_window_property (display
, window
, property
,
1431 &tmp_data
, &tmp_size_bytes
,
1432 type_ret
, format_ret
, size_ret
, 1);
1434 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1436 if (tmp_size_bytes
== 0) /* we're done */
1438 TRACE0 ("Done reading incrementally");
1440 if (! waiting_for_other_props_on_window (display
, window
))
1441 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1442 unexpect_property_change (wait_object
);
1443 /* Use xfree, not XFree, because x_get_window_property
1444 calls xmalloc itself. */
1445 if (tmp_data
) xfree (tmp_data
);
1450 TRACE1 (" ACK by deleting property %s",
1451 XGetAtomName (display
, property
));
1452 XDeleteProperty (display
, window
, property
);
1453 wait_object
= expect_property_change (display
, window
, property
,
1458 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1460 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1461 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1464 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1465 offset
+= tmp_size_bytes
;
1467 /* Use xfree, not XFree, because x_get_window_property
1468 calls xmalloc itself. */
1474 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1475 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1476 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1479 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1484 Lisp_Object target_type
; /* for error messages only */
1485 Atom selection_atom
; /* for error messages only */
1489 unsigned long actual_size
;
1490 unsigned char *data
= 0;
1493 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1495 TRACE0 ("Reading selection data");
1497 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1498 &actual_type
, &actual_format
, &actual_size
, 1);
1501 int there_is_a_selection_owner
;
1503 there_is_a_selection_owner
1504 = XGetSelectionOwner (display
, selection_atom
);
1507 there_is_a_selection_owner
1508 ? Fcons (build_string ("selection owner couldn't convert"),
1510 ? Fcons (target_type
,
1511 Fcons (x_atom_to_symbol (display
,
1514 : Fcons (target_type
, Qnil
))
1515 : Fcons (build_string ("no selection"),
1516 Fcons (x_atom_to_symbol (display
,
1521 if (actual_type
== dpyinfo
->Xatom_INCR
)
1523 /* That wasn't really the data, just the beginning. */
1525 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1527 /* Use xfree, not XFree, because x_get_window_property
1528 calls xmalloc itself. */
1529 xfree ((char *) data
);
1531 receive_incremental_selection (display
, window
, property
, target_type
,
1532 min_size_bytes
, &data
, &bytes
,
1533 &actual_type
, &actual_format
,
1538 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1539 XDeleteProperty (display
, window
, property
);
1543 /* It's been read. Now convert it to a lisp object in some semi-rational
1545 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1546 actual_type
, actual_format
);
1548 /* Use xfree, not XFree, because x_get_window_property
1549 calls xmalloc itself. */
1550 xfree ((char *) data
);
1554 /* These functions convert from the selection data read from the server into
1555 something that we can use from Lisp, and vice versa.
1557 Type: Format: Size: Lisp Type:
1558 ----- ------- ----- -----------
1561 ATOM 32 > 1 Vector of Symbols
1563 * 16 > 1 Vector of Integers
1564 * 32 1 if <=16 bits: Integer
1565 if > 16 bits: Cons of top16, bot16
1566 * 32 > 1 Vector of the above
1568 When converting a Lisp number to C, it is assumed to be of format 16 if
1569 it is an integer, and of format 32 if it is a cons of two integers.
1571 When converting a vector of numbers from Lisp to C, it is assumed to be
1572 of format 16 if every element in the vector is an integer, and is assumed
1573 to be of format 32 if any element is a cons of two integers.
1575 When converting an object to C, it may be of the form (SYMBOL . <data>)
1576 where SYMBOL is what we should claim that the type is. Format and
1577 representation are as above. */
1582 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1584 unsigned char *data
;
1588 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1590 if (type
== dpyinfo
->Xatom_NULL
)
1593 /* Convert any 8-bit data to a string, for compactness. */
1594 else if (format
== 8)
1597 int require_encoding
= 0;
1603 ! NILP (buffer_defaults
.enable_multibyte_characters
)
1607 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1608 DATA to Emacs internal format because DATA may be encoded
1609 in compound text format. In addtion, if TYPE is `STRING'
1610 and DATA contains any 8-bit Latin-1 code, we should also
1612 if (type
== dpyinfo
->Xatom_TEXT
1613 || type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1614 require_encoding
= 1;
1615 else if (type
== XA_STRING
)
1618 for (i
= 0; i
< size
; i
++)
1620 if (data
[i
] >= 0x80)
1622 require_encoding
= 1;
1628 if (!require_encoding
)
1630 str
= make_unibyte_string ((char *) data
, size
);
1631 Vlast_coding_system_used
= Qraw_text
;
1637 struct coding_system coding
;
1639 if (NILP (Vnext_selection_coding_system
))
1640 Vnext_selection_coding_system
= Vselection_coding_system
;
1642 (Fcheck_coding_system(Vnext_selection_coding_system
), &coding
);
1643 coding
.src_multibyte
= 0;
1644 coding
.dst_multibyte
= 1;
1645 Vnext_selection_coding_system
= Qnil
;
1646 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
1647 bufsize
= decoding_buffer_size (&coding
, size
);
1648 buf
= (unsigned char *) xmalloc (bufsize
);
1649 decode_coding (&coding
, data
, buf
, size
, bufsize
);
1650 str
= make_string_from_bytes ((char *) buf
,
1651 coding
.produced_char
, coding
.produced
);
1653 Vlast_coding_system_used
= coding
.symbol
;
1655 compose_chars_in_text (0, XSTRING (str
)->size
, str
);
1658 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1659 a vector of symbols.
1661 else if (type
== XA_ATOM
)
1664 if (size
== sizeof (Atom
))
1665 return x_atom_to_symbol (display
, *((Atom
*) data
));
1668 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1670 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1671 Faset (v
, make_number (i
),
1672 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1677 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1678 If the number is > 16 bits, convert it to a cons of integers,
1679 16 bits in each half.
1681 else if (format
== 32 && size
== sizeof (long))
1682 return long_to_cons (((unsigned long *) data
) [0]);
1683 else if (format
== 16 && size
== sizeof (short))
1684 return make_number ((int) (((unsigned short *) data
) [0]));
1686 /* Convert any other kind of data to a vector of numbers, represented
1687 as above (as an integer, or a cons of two 16 bit integers.)
1689 else if (format
== 16)
1693 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1694 for (i
= 0; i
< size
/ 2; i
++)
1696 int j
= (int) ((unsigned short *) data
) [i
];
1697 Faset (v
, make_number (i
), make_number (j
));
1704 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1705 for (i
= 0; i
< size
/ 4; i
++)
1707 unsigned long j
= ((unsigned long *) data
) [i
];
1708 Faset (v
, make_number (i
), long_to_cons (j
));
1715 /* Use xfree, not XFree, to free the data obtained with this function. */
1718 lisp_data_to_selection_data (display
, obj
,
1719 data_ret
, type_ret
, size_ret
,
1720 format_ret
, nofree_ret
)
1723 unsigned char **data_ret
;
1725 unsigned int *size_ret
;
1729 Lisp_Object type
= Qnil
;
1730 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1734 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1738 if (CONSP (obj
) && NILP (XCDR (obj
)))
1742 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1743 { /* This is not the same as declining */
1749 else if (STRINGP (obj
))
1751 /* Since we are now handling multilingual text, we must consider
1752 sending back compound text. */
1755 if (NILP (Vnext_selection_coding_system
))
1756 Vnext_selection_coding_system
= Vselection_coding_system
;
1759 *data_ret
= x_encode_text (obj
, Vnext_selection_coding_system
,
1760 (int *) size_ret
, &stringp
);
1761 *nofree_ret
= (*data_ret
== XSTRING (obj
)->data
);
1763 type
= (stringp
? QSTRING
: QCOMPOUND_TEXT
);
1764 Vlast_coding_system_used
= (*nofree_ret
1766 : Vnext_selection_coding_system
);
1767 Vnext_selection_coding_system
= Qnil
;
1769 else if (SYMBOLP (obj
))
1773 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1774 (*data_ret
) [sizeof (Atom
)] = 0;
1775 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1776 if (NILP (type
)) type
= QATOM
;
1778 else if (INTEGERP (obj
)
1779 && XINT (obj
) < 0xFFFF
1780 && XINT (obj
) > -0xFFFF)
1784 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1785 (*data_ret
) [sizeof (short)] = 0;
1786 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1787 if (NILP (type
)) type
= QINTEGER
;
1789 else if (INTEGERP (obj
)
1790 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1791 && (INTEGERP (XCDR (obj
))
1792 || (CONSP (XCDR (obj
))
1793 && INTEGERP (XCAR (XCDR (obj
)))))))
1797 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1798 (*data_ret
) [sizeof (long)] = 0;
1799 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1800 if (NILP (type
)) type
= QINTEGER
;
1802 else if (VECTORP (obj
))
1804 /* Lisp_Vectors may represent a set of ATOMs;
1805 a set of 16 or 32 bit INTEGERs;
1806 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1810 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1811 /* This vector is an ATOM set */
1813 if (NILP (type
)) type
= QATOM
;
1814 *size_ret
= XVECTOR (obj
)->size
;
1816 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1817 for (i
= 0; i
< *size_ret
; i
++)
1818 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1819 (*(Atom
**) data_ret
) [i
]
1820 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1822 Fsignal (Qerror
, /* Qselection_error */
1824 ("all elements of selection vector must have same type"),
1825 Fcons (obj
, Qnil
)));
1827 #if 0 /* #### MULTIPLE doesn't work yet */
1828 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1829 /* This vector is an ATOM_PAIR set */
1831 if (NILP (type
)) type
= QATOM_PAIR
;
1832 *size_ret
= XVECTOR (obj
)->size
;
1834 *data_ret
= (unsigned char *)
1835 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1836 for (i
= 0; i
< *size_ret
; i
++)
1837 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1839 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1840 if (XVECTOR (pair
)->size
!= 2)
1843 ("elements of the vector must be vectors of exactly two elements"),
1844 Fcons (pair
, Qnil
)));
1846 (*(Atom
**) data_ret
) [i
* 2]
1847 = symbol_to_x_atom (dpyinfo
, display
,
1848 XVECTOR (pair
)->contents
[0]);
1849 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1850 = symbol_to_x_atom (dpyinfo
, display
,
1851 XVECTOR (pair
)->contents
[1]);
1856 ("all elements of the vector must be of the same type"),
1857 Fcons (obj
, Qnil
)));
1862 /* This vector is an INTEGER set, or something like it */
1864 *size_ret
= XVECTOR (obj
)->size
;
1865 if (NILP (type
)) type
= QINTEGER
;
1867 for (i
= 0; i
< *size_ret
; i
++)
1868 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1870 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1871 Fsignal (Qerror
, /* Qselection_error */
1873 ("elements of selection vector must be integers or conses of integers"),
1874 Fcons (obj
, Qnil
)));
1876 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1877 for (i
= 0; i
< *size_ret
; i
++)
1878 if (*format_ret
== 32)
1879 (*((unsigned long **) data_ret
)) [i
]
1880 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1882 (*((unsigned short **) data_ret
)) [i
]
1883 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1887 Fsignal (Qerror
, /* Qselection_error */
1888 Fcons (build_string ("unrecognised selection data"),
1889 Fcons (obj
, Qnil
)));
1891 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1895 clean_local_selection_data (obj
)
1899 && INTEGERP (XCAR (obj
))
1900 && CONSP (XCDR (obj
))
1901 && INTEGERP (XCAR (XCDR (obj
)))
1902 && NILP (XCDR (XCDR (obj
))))
1903 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1906 && INTEGERP (XCAR (obj
))
1907 && INTEGERP (XCDR (obj
)))
1909 if (XINT (XCAR (obj
)) == 0)
1911 if (XINT (XCAR (obj
)) == -1)
1912 return make_number (- XINT (XCDR (obj
)));
1917 int size
= XVECTOR (obj
)->size
;
1920 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1921 copy
= Fmake_vector (make_number (size
), Qnil
);
1922 for (i
= 0; i
< size
; i
++)
1923 XVECTOR (copy
)->contents
[i
]
1924 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1930 /* Called from XTread_socket to handle SelectionNotify events.
1931 If it's the selection we are waiting for, stop waiting
1932 by setting the car of reading_selection_reply to non-nil.
1933 We store t there if the reply is successful, lambda if not. */
1936 x_handle_selection_notify (event
)
1937 XSelectionEvent
*event
;
1939 if (event
->requestor
!= reading_selection_window
)
1941 if (event
->selection
!= reading_which_selection
)
1944 TRACE0 ("Received SelectionNotify");
1945 XSETCAR (reading_selection_reply
,
1946 (event
->property
!= 0 ? Qt
: Qlambda
));
1950 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1951 Sx_own_selection_internal
, 2, 2, 0,
1952 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1953 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1954 \(Those are literal upper-case symbol names, since that's what X expects.)
1955 VALUE is typically a string, or a cons of two markers, but may be
1956 anything that the functions on `selection-converter-alist' know about. */)
1957 (selection_name
, selection_value
)
1958 Lisp_Object selection_name
, selection_value
;
1961 CHECK_SYMBOL (selection_name
);
1962 if (NILP (selection_value
)) error ("selection-value may not be nil");
1963 x_own_selection (selection_name
, selection_value
);
1964 return selection_value
;
1968 /* Request the selection value from the owner. If we are the owner,
1969 simply return our selection value. If we are not the owner, this
1970 will block until all of the data has arrived. */
1972 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1973 Sx_get_selection_internal
, 2, 2, 0,
1974 doc
: /* Return text selected from some X window.
1975 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1976 \(Those are literal upper-case symbol names, since that's what X expects.)
1977 TYPE is the type of data desired, typically `STRING'. */)
1978 (selection_symbol
, target_type
)
1979 Lisp_Object selection_symbol
, target_type
;
1981 Lisp_Object val
= Qnil
;
1982 struct gcpro gcpro1
, gcpro2
;
1983 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1985 CHECK_SYMBOL (selection_symbol
);
1987 #if 0 /* #### MULTIPLE doesn't work yet */
1988 if (CONSP (target_type
)
1989 && XCAR (target_type
) == QMULTIPLE
)
1991 CHECK_VECTOR (XCDR (target_type
));
1992 /* So we don't destructively modify this... */
1993 target_type
= copy_multiple_data (target_type
);
1997 CHECK_SYMBOL (target_type
);
1999 val
= x_get_local_selection (selection_symbol
, target_type
);
2003 val
= x_get_foreign_selection (selection_symbol
, target_type
);
2008 && SYMBOLP (XCAR (val
)))
2011 if (CONSP (val
) && NILP (XCDR (val
)))
2014 val
= clean_local_selection_data (val
);
2020 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2021 Sx_disown_selection_internal
, 1, 2, 0,
2022 doc
: /* If we own the selection SELECTION, disown it.
2023 Disowning it means there is no such selection. */)
2025 Lisp_Object selection
;
2029 Atom selection_atom
;
2030 struct selection_input_event event
;
2032 struct x_display_info
*dpyinfo
;
2033 struct frame
*sf
= SELECTED_FRAME ();
2036 display
= FRAME_X_DISPLAY (sf
);
2037 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2038 CHECK_SYMBOL (selection
);
2040 timestamp
= last_event_timestamp
;
2042 timestamp
= cons_to_long (time
);
2044 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2045 return Qnil
; /* Don't disown the selection when we're not the owner. */
2047 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2050 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2053 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2054 generated for a window which owns the selection when that window sets
2055 the selection owner to None. The NCD server does, the MIT Sun4 server
2056 doesn't. So we synthesize one; this means we might get two, but
2057 that's ok, because the second one won't have any effect. */
2058 SELECTION_EVENT_DISPLAY (&event
) = display
;
2059 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2060 SELECTION_EVENT_TIME (&event
) = timestamp
;
2061 x_handle_selection_clear ((struct input_event
*) &event
);
2066 /* Get rid of all the selections in buffer BUFFER.
2067 This is used when we kill a buffer. */
2070 x_disown_buffer_selections (buffer
)
2074 struct buffer
*buf
= XBUFFER (buffer
);
2076 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2078 Lisp_Object elt
, value
;
2081 if (CONSP (value
) && MARKERP (XCAR (value
))
2082 && XMARKER (XCAR (value
))->buffer
== buf
)
2083 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2087 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2089 doc
: /* Whether the current Emacs process owns the given X Selection.
2090 The arg should be the name of the selection in question, typically one of
2091 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2092 \(Those are literal upper-case symbol names, since that's what X expects.)
2093 For convenience, the symbol nil is the same as `PRIMARY',
2094 and t is the same as `SECONDARY'. */)
2096 Lisp_Object selection
;
2099 CHECK_SYMBOL (selection
);
2100 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2101 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2103 if (NILP (Fassq (selection
, Vselection_alist
)))
2108 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2110 doc
: /* Whether there is an owner for the given X Selection.
2111 The arg should be the name of the selection in question, typically one of
2112 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2113 \(Those are literal upper-case symbol names, since that's what X expects.)
2114 For convenience, the symbol nil is the same as `PRIMARY',
2115 and t is the same as `SECONDARY'. */)
2117 Lisp_Object selection
;
2122 struct frame
*sf
= SELECTED_FRAME ();
2124 /* It should be safe to call this before we have an X frame. */
2125 if (! FRAME_X_P (sf
))
2128 dpy
= FRAME_X_DISPLAY (sf
);
2129 CHECK_SYMBOL (selection
);
2130 if (!NILP (Fx_selection_owner_p (selection
)))
2132 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2133 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2134 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2138 owner
= XGetSelectionOwner (dpy
, atom
);
2140 return (owner
? Qt
: Qnil
);
2144 #ifdef CUT_BUFFER_SUPPORT
2146 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2148 initialize_cut_buffers (display
, window
)
2152 unsigned char *data
= (unsigned char *) "";
2154 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2155 PropModeAppend, data, 0)
2156 FROB (XA_CUT_BUFFER0
);
2157 FROB (XA_CUT_BUFFER1
);
2158 FROB (XA_CUT_BUFFER2
);
2159 FROB (XA_CUT_BUFFER3
);
2160 FROB (XA_CUT_BUFFER4
);
2161 FROB (XA_CUT_BUFFER5
);
2162 FROB (XA_CUT_BUFFER6
);
2163 FROB (XA_CUT_BUFFER7
);
2169 #define CHECK_CUT_BUFFER(symbol) \
2170 { CHECK_SYMBOL ((symbol)); \
2171 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2172 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2173 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2174 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2176 Fcons (build_string ("doesn't name a cut buffer"), \
2177 Fcons ((symbol), Qnil))); \
2180 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2181 Sx_get_cut_buffer_internal
, 1, 1, 0,
2182 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2188 unsigned char *data
;
2195 struct x_display_info
*dpyinfo
;
2196 struct frame
*sf
= SELECTED_FRAME ();
2199 display
= FRAME_X_DISPLAY (sf
);
2200 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2201 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2202 CHECK_CUT_BUFFER (buffer
);
2203 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2205 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2206 &type
, &format
, &size
, 0);
2207 if (!data
|| !format
)
2210 if (format
!= 8 || type
!= XA_STRING
)
2212 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2213 Fcons (x_atom_to_symbol (display
, type
),
2214 Fcons (make_number (format
), Qnil
))));
2216 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2217 /* Use xfree, not XFree, because x_get_window_property
2218 calls xmalloc itself. */
2224 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2225 Sx_store_cut_buffer_internal
, 2, 2, 0,
2226 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2228 Lisp_Object buffer
, string
;
2232 unsigned char *data
;
2234 int bytes_remaining
;
2237 struct frame
*sf
= SELECTED_FRAME ();
2240 display
= FRAME_X_DISPLAY (sf
);
2241 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2243 max_bytes
= SELECTION_QUANTUM (display
);
2244 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2245 max_bytes
= MAX_SELECTION_QUANTUM
;
2247 CHECK_CUT_BUFFER (buffer
);
2248 CHECK_STRING (string
);
2249 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2251 data
= (unsigned char *) XSTRING (string
)->data
;
2252 bytes
= STRING_BYTES (XSTRING (string
));
2253 bytes_remaining
= bytes
;
2255 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2257 initialize_cut_buffers (display
, window
);
2258 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2263 /* Don't mess up with an empty value. */
2264 if (!bytes_remaining
)
2265 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2266 PropModeReplace
, data
, 0);
2268 while (bytes_remaining
)
2270 int chunk
= (bytes_remaining
< max_bytes
2271 ? bytes_remaining
: max_bytes
);
2272 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2273 (bytes_remaining
== bytes
2278 bytes_remaining
-= chunk
;
2285 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2286 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2287 doc
: /* Rotate the values of the cut buffers by the given number of step.
2288 Positive means shift the values forward, negative means backward. */)
2295 struct frame
*sf
= SELECTED_FRAME ();
2298 display
= FRAME_X_DISPLAY (sf
);
2299 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2303 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2305 initialize_cut_buffers (display
, window
);
2306 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2309 props
[0] = XA_CUT_BUFFER0
;
2310 props
[1] = XA_CUT_BUFFER1
;
2311 props
[2] = XA_CUT_BUFFER2
;
2312 props
[3] = XA_CUT_BUFFER3
;
2313 props
[4] = XA_CUT_BUFFER4
;
2314 props
[5] = XA_CUT_BUFFER5
;
2315 props
[6] = XA_CUT_BUFFER6
;
2316 props
[7] = XA_CUT_BUFFER7
;
2318 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2328 defsubr (&Sx_get_selection_internal
);
2329 defsubr (&Sx_own_selection_internal
);
2330 defsubr (&Sx_disown_selection_internal
);
2331 defsubr (&Sx_selection_owner_p
);
2332 defsubr (&Sx_selection_exists_p
);
2334 #ifdef CUT_BUFFER_SUPPORT
2335 defsubr (&Sx_get_cut_buffer_internal
);
2336 defsubr (&Sx_store_cut_buffer_internal
);
2337 defsubr (&Sx_rotate_cut_buffers_internal
);
2340 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2341 staticpro (&reading_selection_reply
);
2342 reading_selection_window
= 0;
2343 reading_which_selection
= 0;
2345 property_change_wait_list
= 0;
2346 prop_location_identifier
= 0;
2347 property_change_reply
= Fcons (Qnil
, Qnil
);
2348 staticpro (&property_change_reply
);
2350 Vselection_alist
= Qnil
;
2351 staticpro (&Vselection_alist
);
2353 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2354 doc
: /* An alist associating X Windows selection-types with functions.
2355 These functions are called to convert the selection, with three args:
2356 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2357 a desired type to which the selection should be converted;
2358 and the local selection value (whatever was given to `x-own-selection').
2360 The function should return the value to send to the X server
2361 \(typically a string). A return value of nil
2362 means that the conversion could not be done.
2363 A return value which is the symbol `NULL'
2364 means that a side-effect was executed,
2365 and there is no meaningful selection value. */);
2366 Vselection_converter_alist
= Qnil
;
2368 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2369 doc
: /* A list of functions to be called when Emacs loses an X selection.
2370 \(This happens when some other X client makes its own selection
2371 or when a Lisp program explicitly clears the selection.)
2372 The functions are called with one argument, the selection type
2373 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2374 Vx_lost_selection_hooks
= Qnil
;
2376 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2377 doc
: /* A list of functions to be called when Emacs answers a selection request.
2378 The functions are called with four arguments:
2379 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2380 - the selection-type which Emacs was asked to convert the
2381 selection into before sending (for example, `STRING' or `LENGTH');
2382 - a flag indicating success or failure for responding to the request.
2383 We might have failed (and declined the request) for any number of reasons,
2384 including being asked for a selection that we no longer own, or being asked
2385 to convert into a type that we don't know about or that is inappropriate.
2386 This hook doesn't let you change the behavior of Emacs's selection replies,
2387 it merely informs you that they have happened. */);
2388 Vx_sent_selection_hooks
= Qnil
;
2390 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2391 doc
: /* Coding system for communicating with other X clients.
2392 When sending or receiving text via cut_buffer, selection, and clipboard,
2393 the text is encoded or decoded by this coding system.
2394 The default value is `compound-text'. */);
2395 Vselection_coding_system
= intern ("compound-text");
2397 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2398 doc
: /* Coding system for the next communication with other X clients.
2399 Usually, `selection-coding-system' is used for communicating with
2400 other X clients. But, if this variable is set, it is used for the
2401 next communication only. After the communication, this variable is
2403 Vnext_selection_coding_system
= Qnil
;
2405 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2406 doc
: /* Number of milliseconds to wait for a selection reply.
2407 If the selection owner doesn't reply in this time, we give up.
2408 A value of 0 means wait as long as necessary. This is initialized from the
2409 \"*selectionTimeout\" resource. */);
2410 x_selection_timeout
= 0;
2412 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2413 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2414 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2415 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2416 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2417 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2418 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2419 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2420 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2421 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2422 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2423 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2424 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2425 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2426 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2427 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2428 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2430 #ifdef CUT_BUFFER_SUPPORT
2431 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2432 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2433 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2434 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2435 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2436 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2437 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2438 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);