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"
34 #include "composite.h"
38 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
39 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
41 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
42 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
));
43 static void x_decline_selection_request
P_ ((struct input_event
*));
44 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
45 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
46 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
47 static void x_reply_selection_request
P_ ((struct input_event
*, int,
48 unsigned char *, int, Atom
));
49 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
50 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
52 static void unexpect_property_change
P_ ((struct prop_location
*));
53 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
54 static void wait_for_property_change
P_ ((struct prop_location
*));
55 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
, Lisp_Object
));
56 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
57 unsigned char **, int *,
58 Atom
*, int *, unsigned long *, int));
59 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
60 Lisp_Object
, unsigned,
61 unsigned char **, int *,
62 Atom
*, int *, unsigned long *));
63 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
66 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
68 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
69 unsigned char **, Atom
*,
70 unsigned *, int *, int *));
71 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
72 static void initialize_cut_buffers
P_ ((Display
*, Window
));
75 /* Printing traces to stderr. */
77 #ifdef TRACE_SELECTION
79 fprintf (stderr, "%d: " fmt "\n", getpid ())
80 #define TRACE1(fmt, a0) \
81 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
82 #define TRACE2(fmt, a0, a1) \
83 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
85 #define TRACE0(fmt) (void) 0
86 #define TRACE1(fmt, a0) (void) 0
87 #define TRACE2(fmt, a0, a1) (void) 0
91 #define CUT_BUFFER_SUPPORT
93 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
94 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
97 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
99 Lisp_Object Qcompound_text_with_extensions
;
101 #ifdef CUT_BUFFER_SUPPORT
102 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
103 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
106 static Lisp_Object Vx_lost_selection_hooks
;
107 static Lisp_Object Vx_sent_selection_hooks
;
108 /* Coding system for communicating with other X clients via cutbuffer,
109 selection, and clipboard. */
110 static Lisp_Object Vselection_coding_system
;
112 /* Coding system for the next communicating with other X clients. */
113 static Lisp_Object Vnext_selection_coding_system
;
115 /* If this is a smaller number than the max-request-size of the display,
116 emacs will use INCR selection transfer when the selection is larger
117 than this. The max-request-size is usually around 64k, so if you want
118 emacs to use incremental selection transfers when the selection is
119 smaller than that, set this. I added this mostly for debugging the
120 incremental transfer stuff, but it might improve server performance. */
121 #define MAX_SELECTION_QUANTUM 0xFFFFFF
124 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
126 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
129 /* The timestamp of the last input event Emacs received from the X server. */
130 /* Defined in keyboard.c. */
131 extern unsigned long last_event_timestamp
;
133 /* This is an association list whose elements are of the form
134 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
135 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
136 SELECTION-VALUE is the value that emacs owns for that selection.
137 It may be any kind of Lisp object.
138 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
139 as a cons of two 16-bit numbers (making a 32 bit time.)
140 FRAME is the frame for which we made the selection.
141 If there is an entry in this alist, then it can be assumed that Emacs owns
143 The only (eq) parts of this list that are visible from Lisp are the
145 static Lisp_Object Vselection_alist
;
147 /* This is an alist whose CARs are selection-types (whose names are the same
148 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
149 call to convert the given Emacs selection value to a string representing
150 the given selection type. This is for Lisp-level extension of the emacs
151 selection handling. */
152 static Lisp_Object Vselection_converter_alist
;
154 /* If the selection owner takes too long to reply to a selection request,
155 we give up on it. This is in milliseconds (0 = no timeout.) */
156 static int x_selection_timeout
;
158 /* Utility functions */
160 static void lisp_data_to_selection_data ();
161 static Lisp_Object
selection_data_to_lisp_data ();
162 static Lisp_Object
x_get_window_property_as_lisp_data ();
164 /* This converts a Lisp symbol to a server Atom, avoiding a server
165 roundtrip whenever possible. */
168 symbol_to_x_atom (dpyinfo
, display
, sym
)
169 struct x_display_info
*dpyinfo
;
174 if (NILP (sym
)) return 0;
175 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
176 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
177 if (EQ (sym
, QSTRING
)) return XA_STRING
;
178 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
179 if (EQ (sym
, QATOM
)) return XA_ATOM
;
180 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
181 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
182 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
183 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
184 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
185 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
186 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
187 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
188 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
189 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
190 #ifdef CUT_BUFFER_SUPPORT
191 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
192 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
193 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
194 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
195 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
196 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
197 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
198 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
200 if (!SYMBOLP (sym
)) abort ();
202 TRACE1 (" XInternAtom %s", (char *) XSYMBOL (sym
)->name
->data
);
204 val
= XInternAtom (display
, (char *) XSYMBOL (sym
)->name
->data
, False
);
210 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
211 and calls to intern whenever possible. */
214 x_atom_to_symbol (dpy
, atom
)
218 struct x_display_info
*dpyinfo
;
237 #ifdef CUT_BUFFER_SUPPORT
257 dpyinfo
= x_display_info_for_display (dpy
);
258 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
260 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
262 if (atom
== dpyinfo
->Xatom_TEXT
)
264 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
265 return QCOMPOUND_TEXT
;
266 if (atom
== dpyinfo
->Xatom_DELETE
)
268 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
270 if (atom
== dpyinfo
->Xatom_INCR
)
272 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
274 if (atom
== dpyinfo
->Xatom_TARGETS
)
276 if (atom
== dpyinfo
->Xatom_NULL
)
280 str
= XGetAtomName (dpy
, atom
);
282 TRACE1 ("XGetAtomName --> %s", str
);
283 if (! str
) return Qnil
;
286 /* This was allocated by Xlib, so use XFree. */
292 /* Do protocol to assert ourself as a selection owner.
293 Update the Vselection_alist so that we can reply to later requests for
297 x_own_selection (selection_name
, selection_value
)
298 Lisp_Object selection_name
, selection_value
;
300 struct frame
*sf
= SELECTED_FRAME ();
301 Window selecting_window
= FRAME_X_WINDOW (sf
);
302 Display
*display
= FRAME_X_DISPLAY (sf
);
303 Time time
= last_event_timestamp
;
305 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
308 CHECK_SYMBOL (selection_name
);
309 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
312 count
= x_catch_errors (display
);
313 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
314 x_check_errors (display
, "Can't set selection: %s");
315 x_uncatch_errors (display
, count
);
318 /* Now update the local cache */
320 Lisp_Object selection_time
;
321 Lisp_Object selection_data
;
322 Lisp_Object prev_value
;
324 selection_time
= long_to_cons ((unsigned long) time
);
325 selection_data
= Fcons (selection_name
,
326 Fcons (selection_value
,
327 Fcons (selection_time
,
328 Fcons (selected_frame
, Qnil
))));
329 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
331 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
333 /* If we already owned the selection, remove the old selection data.
334 Perhaps we should destructively modify it instead.
335 Don't use Fdelq as that may QUIT. */
336 if (!NILP (prev_value
))
338 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
339 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
340 if (EQ (prev_value
, Fcar (XCDR (rest
))))
342 XSETCDR (rest
, Fcdr (XCDR (rest
)));
349 /* Given a selection-name and desired type, look up our local copy of
350 the selection value and convert it to the type.
351 The value is nil or a string.
352 This function is used both for remote requests
353 and for local x-get-selection-internal.
355 This calls random Lisp code, and may signal or gc. */
358 x_get_local_selection (selection_symbol
, target_type
)
359 Lisp_Object selection_symbol
, target_type
;
361 Lisp_Object local_value
;
362 Lisp_Object handler_fn
, value
, type
, check
;
365 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
367 if (NILP (local_value
)) return Qnil
;
369 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
370 if (EQ (target_type
, QTIMESTAMP
))
373 value
= XCAR (XCDR (XCDR (local_value
)));
376 else if (EQ (target_type
, QDELETE
))
379 Fx_disown_selection_internal
381 XCAR (XCDR (XCDR (local_value
))));
386 #if 0 /* #### MULTIPLE doesn't work yet */
387 else if (CONSP (target_type
)
388 && XCAR (target_type
) == QMULTIPLE
)
393 pairs
= XCDR (target_type
);
394 size
= XVECTOR (pairs
)->size
;
395 /* If the target is MULTIPLE, then target_type looks like
396 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
397 We modify the second element of each pair in the vector and
398 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
400 for (i
= 0; i
< size
; i
++)
403 pair
= XVECTOR (pairs
)->contents
[i
];
404 XVECTOR (pair
)->contents
[1]
405 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
406 XVECTOR (pair
)->contents
[1]);
413 /* Don't allow a quit within the converter.
414 When the user types C-g, he would be surprised
415 if by luck it came during a converter. */
416 count
= specpdl_ptr
- specpdl
;
417 specbind (Qinhibit_quit
, Qt
);
419 CHECK_SYMBOL (target_type
);
420 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
421 if (!NILP (handler_fn
))
422 value
= call3 (handler_fn
,
423 selection_symbol
, target_type
,
424 XCAR (XCDR (local_value
)));
427 unbind_to (count
, Qnil
);
430 /* Make sure this value is of a type that we could transmit
431 to another X client. */
435 && SYMBOLP (XCAR (value
)))
437 check
= XCDR (value
);
445 /* Check for a value that cons_to_long could handle. */
446 else if (CONSP (check
)
447 && INTEGERP (XCAR (check
))
448 && (INTEGERP (XCDR (check
))
450 (CONSP (XCDR (check
))
451 && INTEGERP (XCAR (XCDR (check
)))
452 && NILP (XCDR (XCDR (check
))))))
457 Fcons (build_string ("invalid data returned by selection-conversion function"),
458 Fcons (handler_fn
, Fcons (value
, Qnil
))));
461 /* Subroutines of x_reply_selection_request. */
463 /* Send a SelectionNotify event to the requestor with property=None,
464 meaning we were unable to do what they wanted. */
467 x_decline_selection_request (event
)
468 struct input_event
*event
;
470 XSelectionEvent reply
;
473 reply
.type
= SelectionNotify
;
474 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
475 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
476 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
477 reply
.time
= SELECTION_EVENT_TIME (event
);
478 reply
.target
= SELECTION_EVENT_TARGET (event
);
479 reply
.property
= None
;
481 /* The reason for the error may be that the receiver has
482 died in the meantime. Handle that case. */
484 count
= x_catch_errors (reply
.display
);
485 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
486 XFlush (reply
.display
);
487 x_uncatch_errors (reply
.display
, count
);
491 /* This is the selection request currently being processed.
492 It is set to zero when the request is fully processed. */
493 static struct input_event
*x_selection_current_request
;
495 /* Display info in x_selection_request. */
497 static struct x_display_info
*selection_request_dpyinfo
;
499 /* Used as an unwind-protect clause so that, if a selection-converter signals
500 an error, we tell the requester that we were unable to do what they wanted
501 before we throw to top-level or go into the debugger or whatever. */
504 x_selection_request_lisp_error (ignore
)
507 if (x_selection_current_request
!= 0
508 && selection_request_dpyinfo
->display
)
509 x_decline_selection_request (x_selection_current_request
);
514 /* This stuff is so that INCR selections are reentrant (that is, so we can
515 be servicing multiple INCR selection requests simultaneously.) I haven't
516 actually tested that yet. */
518 /* Keep a list of the property changes that are awaited. */
528 struct prop_location
*next
;
531 static struct prop_location
*expect_property_change ();
532 static void wait_for_property_change ();
533 static void unexpect_property_change ();
534 static int waiting_for_other_props_on_window ();
536 static int prop_location_identifier
;
538 static Lisp_Object property_change_reply
;
540 static struct prop_location
*property_change_reply_object
;
542 static struct prop_location
*property_change_wait_list
;
545 queue_selection_requests_unwind (frame
)
548 FRAME_PTR f
= XFRAME (frame
);
551 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
555 /* Return some frame whose display info is DPYINFO.
556 Return nil if there is none. */
559 some_frame_on_display (dpyinfo
)
560 struct x_display_info
*dpyinfo
;
562 Lisp_Object list
, frame
;
564 FOR_EACH_FRAME (list
, frame
)
566 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
573 /* Send the reply to a selection request event EVENT.
574 TYPE is the type of selection data requested.
575 DATA and SIZE describe the data to send, already converted.
576 FORMAT is the unit-size (in bits) of the data to be transmitted. */
579 x_reply_selection_request (event
, format
, data
, size
, type
)
580 struct input_event
*event
;
585 XSelectionEvent reply
;
586 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
587 Window window
= SELECTION_EVENT_REQUESTOR (event
);
589 int format_bytes
= format
/8;
590 int max_bytes
= SELECTION_QUANTUM (display
);
591 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
594 if (max_bytes
> MAX_SELECTION_QUANTUM
)
595 max_bytes
= MAX_SELECTION_QUANTUM
;
597 reply
.type
= SelectionNotify
;
598 reply
.display
= display
;
599 reply
.requestor
= window
;
600 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
601 reply
.time
= SELECTION_EVENT_TIME (event
);
602 reply
.target
= SELECTION_EVENT_TARGET (event
);
603 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
604 if (reply
.property
== None
)
605 reply
.property
= reply
.target
;
607 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
609 count
= x_catch_errors (display
);
611 /* Store the data on the requested property.
612 If the selection is large, only store the first N bytes of it.
614 bytes_remaining
= size
* format_bytes
;
615 if (bytes_remaining
<= max_bytes
)
617 /* Send all the data at once, with minimal handshaking. */
618 TRACE1 ("Sending all %d bytes", bytes_remaining
);
619 XChangeProperty (display
, window
, reply
.property
, type
, format
,
620 PropModeReplace
, data
, size
);
621 /* At this point, the selection was successfully stored; ack it. */
622 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
626 /* Send an INCR selection. */
627 struct prop_location
*wait_object
;
631 frame
= some_frame_on_display (dpyinfo
);
633 /* If the display no longer has frames, we can't expect
634 to get many more selection requests from it, so don't
635 bother trying to queue them. */
638 x_start_queuing_selection_requests (display
);
640 record_unwind_protect (queue_selection_requests_unwind
,
644 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
645 error ("Attempt to transfer an INCR to ourself!");
647 TRACE2 ("Start sending %d bytes incrementally (%s)",
648 bytes_remaining
, XGetAtomName (display
, reply
.property
));
649 wait_object
= expect_property_change (display
, window
, reply
.property
,
652 TRACE1 ("Set %s to number of bytes to send",
653 XGetAtomName (display
, reply
.property
));
654 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
656 (unsigned char *) &bytes_remaining
, 1);
657 XSelectInput (display
, window
, PropertyChangeMask
);
659 /* Tell 'em the INCR data is there... */
660 TRACE0 ("Send SelectionNotify event");
661 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
664 had_errors
= x_had_errors_p (display
);
667 /* First, wait for the requester to ack by deleting the property.
668 This can run random lisp code (process handlers) or signal. */
671 TRACE1 ("Waiting for ACK (deletion of %s)",
672 XGetAtomName (display
, reply
.property
));
673 wait_for_property_change (wait_object
);
677 while (bytes_remaining
)
679 int i
= ((bytes_remaining
< max_bytes
)
686 = expect_property_change (display
, window
, reply
.property
,
689 TRACE1 ("Sending increment of %d bytes", i
);
690 TRACE1 ("Set %s to increment data",
691 XGetAtomName (display
, reply
.property
));
693 /* Append the next chunk of data to the property. */
694 XChangeProperty (display
, window
, reply
.property
, type
, format
,
695 PropModeAppend
, data
, i
/ format_bytes
);
696 bytes_remaining
-= i
;
699 had_errors
= x_had_errors_p (display
);
705 /* Now wait for the requester to ack this chunk by deleting the
706 property. This can run random lisp code or signal. */
707 TRACE1 ("Waiting for increment ACK (deletion of %s)",
708 XGetAtomName (display
, reply
.property
));
709 wait_for_property_change (wait_object
);
712 /* Now write a zero-length chunk to the property to tell the
713 requester that we're done. */
715 if (! waiting_for_other_props_on_window (display
, window
))
716 XSelectInput (display
, window
, 0L);
718 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
719 XGetAtomName (display
, reply
.property
));
720 XChangeProperty (display
, window
, reply
.property
, type
, format
,
721 PropModeReplace
, data
, 0);
722 TRACE0 ("Done sending incrementally");
725 /* The window we're communicating with may have been deleted
726 in the meantime (that's a real situation from a bug report).
727 In this case, there may be events in the event queue still
728 refering to the deleted window, and we'll get a BadWindow error
729 in XTread_socket when processing the events. I don't have
730 an idea how to fix that. gerd, 2001-01-98. */
732 x_uncatch_errors (display
, count
);
736 /* Handle a SelectionRequest event EVENT.
737 This is called from keyboard.c when such an event is found in the queue. */
740 x_handle_selection_request (event
)
741 struct input_event
*event
;
743 struct gcpro gcpro1
, gcpro2
, gcpro3
;
744 Lisp_Object local_selection_data
;
745 Lisp_Object selection_symbol
;
746 Lisp_Object target_symbol
;
747 Lisp_Object converted_selection
;
748 Time local_selection_time
;
749 Lisp_Object successful_p
;
751 struct x_display_info
*dpyinfo
752 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
754 local_selection_data
= Qnil
;
755 target_symbol
= Qnil
;
756 converted_selection
= Qnil
;
759 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
761 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
762 SELECTION_EVENT_SELECTION (event
));
764 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
766 if (NILP (local_selection_data
))
768 /* Someone asked for the selection, but we don't have it any more.
770 x_decline_selection_request (event
);
774 local_selection_time
= (Time
)
775 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
777 if (SELECTION_EVENT_TIME (event
) != CurrentTime
778 && local_selection_time
> SELECTION_EVENT_TIME (event
))
780 /* Someone asked for the selection, and we have one, but not the one
783 x_decline_selection_request (event
);
787 x_selection_current_request
= event
;
788 count
= BINDING_STACK_SIZE ();
789 selection_request_dpyinfo
= dpyinfo
;
790 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
792 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
793 SELECTION_EVENT_TARGET (event
));
795 #if 0 /* #### MULTIPLE doesn't work yet */
796 if (EQ (target_symbol
, QMULTIPLE
))
797 target_symbol
= fetch_multiple_target (event
);
800 /* Convert lisp objects back into binary data */
803 = x_get_local_selection (selection_symbol
, target_symbol
);
805 if (! NILP (converted_selection
))
813 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
815 &data
, &type
, &size
, &format
, &nofree
);
817 x_reply_selection_request (event
, format
, data
, size
, type
);
820 /* Indicate we have successfully processed this event. */
821 x_selection_current_request
= 0;
823 /* Use xfree, not XFree, because lisp_data_to_selection_data
824 calls xmalloc itself. */
828 unbind_to (count
, Qnil
);
834 /* Let random lisp code notice that the selection has been asked for. */
837 rest
= Vx_sent_selection_hooks
;
838 if (!EQ (rest
, Qunbound
))
839 for (; CONSP (rest
); rest
= Fcdr (rest
))
840 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
844 /* Handle a SelectionClear event EVENT, which indicates that some
845 client cleared out our previously asserted selection.
846 This is called from keyboard.c when such an event is found in the queue. */
849 x_handle_selection_clear (event
)
850 struct input_event
*event
;
852 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
853 Atom selection
= SELECTION_EVENT_SELECTION (event
);
854 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
856 Lisp_Object selection_symbol
, local_selection_data
;
857 Time local_selection_time
;
858 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
859 struct x_display_info
*t_dpyinfo
;
861 /* If the new selection owner is also Emacs,
862 don't clear the new selection. */
864 /* Check each display on the same terminal,
865 to see if this Emacs job now owns the selection
866 through that display. */
867 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
868 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
871 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
872 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
880 selection_symbol
= x_atom_to_symbol (display
, selection
);
882 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
884 /* Well, we already believe that we don't own it, so that's just fine. */
885 if (NILP (local_selection_data
)) return;
887 local_selection_time
= (Time
)
888 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
890 /* This SelectionClear is for a selection that we no longer own, so we can
891 disregard it. (That is, we have reasserted the selection since this
892 request was generated.) */
894 if (changed_owner_time
!= CurrentTime
895 && local_selection_time
> changed_owner_time
)
898 /* Otherwise, we're really honest and truly being told to drop it.
899 Don't use Fdelq as that may QUIT;. */
901 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
902 Vselection_alist
= Fcdr (Vselection_alist
);
906 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
907 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
909 XSETCDR (rest
, Fcdr (XCDR (rest
)));
914 /* Let random lisp code notice that the selection has been stolen. */
918 rest
= Vx_lost_selection_hooks
;
919 if (!EQ (rest
, Qunbound
))
921 for (; CONSP (rest
); rest
= Fcdr (rest
))
922 call1 (Fcar (rest
), selection_symbol
);
923 prepare_menu_bars ();
924 redisplay_preserve_echo_area (20);
929 /* Clear all selections that were made from frame F.
930 We do this when about to delete a frame. */
933 x_clear_frame_selections (f
)
939 XSETFRAME (frame
, f
);
941 /* Otherwise, we're really honest and truly being told to drop it.
942 Don't use Fdelq as that may QUIT;. */
944 /* Delete elements from the beginning of Vselection_alist. */
945 while (!NILP (Vselection_alist
)
946 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
948 /* Let random Lisp code notice that the selection has been stolen. */
949 Lisp_Object hooks
, selection_symbol
;
951 hooks
= Vx_lost_selection_hooks
;
952 selection_symbol
= Fcar (Fcar (Vselection_alist
));
954 if (!EQ (hooks
, Qunbound
))
956 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
957 call1 (Fcar (hooks
), selection_symbol
);
958 #if 0 /* This can crash when deleting a frame
959 from x_connection_closed. Anyway, it seems unnecessary;
960 something else should cause a redisplay. */
961 redisplay_preserve_echo_area (21);
965 Vselection_alist
= Fcdr (Vselection_alist
);
968 /* Delete elements after the beginning of Vselection_alist. */
969 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
970 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
972 /* Let random Lisp code notice that the selection has been stolen. */
973 Lisp_Object hooks
, selection_symbol
;
975 hooks
= Vx_lost_selection_hooks
;
976 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
978 if (!EQ (hooks
, Qunbound
))
980 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
981 call1 (Fcar (hooks
), selection_symbol
);
982 #if 0 /* See above */
983 redisplay_preserve_echo_area (22);
986 XSETCDR (rest
, Fcdr (XCDR (rest
)));
991 /* Nonzero if any properties for DISPLAY and WINDOW
992 are on the list of what we are waiting for. */
995 waiting_for_other_props_on_window (display
, window
)
999 struct prop_location
*rest
= property_change_wait_list
;
1001 if (rest
->display
== display
&& rest
->window
== window
)
1008 /* Add an entry to the list of property changes we are waiting for.
1009 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1010 The return value is a number that uniquely identifies
1011 this awaited property change. */
1013 static struct prop_location
*
1014 expect_property_change (display
, window
, property
, state
)
1020 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1021 pl
->identifier
= ++prop_location_identifier
;
1022 pl
->display
= display
;
1023 pl
->window
= window
;
1024 pl
->property
= property
;
1025 pl
->desired_state
= state
;
1026 pl
->next
= property_change_wait_list
;
1028 property_change_wait_list
= pl
;
1032 /* Delete an entry from the list of property changes we are waiting for.
1033 IDENTIFIER is the number that uniquely identifies the entry. */
1036 unexpect_property_change (location
)
1037 struct prop_location
*location
;
1039 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1042 if (rest
== location
)
1045 prev
->next
= rest
->next
;
1047 property_change_wait_list
= rest
->next
;
1056 /* Remove the property change expectation element for IDENTIFIER. */
1059 wait_for_property_change_unwind (identifierval
)
1060 Lisp_Object identifierval
;
1062 unexpect_property_change ((struct prop_location
*)
1063 (XFASTINT (XCAR (identifierval
)) << 16
1064 | XFASTINT (XCDR (identifierval
))));
1068 /* Actually wait for a property change.
1069 IDENTIFIER should be the value that expect_property_change returned. */
1072 wait_for_property_change (location
)
1073 struct prop_location
*location
;
1076 int count
= specpdl_ptr
- specpdl
;
1079 tem
= Fcons (Qnil
, Qnil
);
1080 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1081 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1083 /* Make sure to do unexpect_property_change if we quit or err. */
1084 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1086 XSETCAR (property_change_reply
, Qnil
);
1088 property_change_reply_object
= location
;
1089 /* If the event we are waiting for arrives beyond here, it will set
1090 property_change_reply, because property_change_reply_object says so. */
1091 if (! location
->arrived
)
1093 secs
= x_selection_timeout
/ 1000;
1094 usecs
= (x_selection_timeout
% 1000) * 1000;
1095 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1096 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1098 if (NILP (XCAR (property_change_reply
)))
1100 TRACE0 (" Timed out");
1101 error ("Timed out waiting for property-notify event");
1105 unbind_to (count
, Qnil
);
1108 /* Called from XTread_socket in response to a PropertyNotify event. */
1111 x_handle_property_notify (event
)
1112 XPropertyEvent
*event
;
1114 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1118 if (rest
->property
== event
->atom
1119 && rest
->window
== event
->window
1120 && rest
->display
== event
->display
1121 && rest
->desired_state
== event
->state
)
1123 TRACE2 ("Expected %s of property %s",
1124 (event
->state
== PropertyDelete
? "deletion" : "change"),
1125 XGetAtomName (event
->display
, event
->atom
));
1129 /* If this is the one wait_for_property_change is waiting for,
1130 tell it to wake up. */
1131 if (rest
== property_change_reply_object
)
1132 XSETCAR (property_change_reply
, Qt
);
1135 prev
->next
= rest
->next
;
1137 property_change_wait_list
= rest
->next
;
1149 #if 0 /* #### MULTIPLE doesn't work yet */
1152 fetch_multiple_target (event
)
1153 XSelectionRequestEvent
*event
;
1155 Display
*display
= event
->display
;
1156 Window window
= event
->requestor
;
1157 Atom target
= event
->target
;
1158 Atom selection_atom
= event
->selection
;
1163 x_get_window_property_as_lisp_data (display
, window
, target
,
1164 QMULTIPLE
, selection_atom
));
1168 copy_multiple_data (obj
)
1175 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1178 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1179 for (i
= 0; i
< size
; i
++)
1181 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1182 CHECK_VECTOR (vec2
);
1183 if (XVECTOR (vec2
)->size
!= 2)
1184 /* ??? Confusing error message */
1185 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1186 Fcons (vec2
, Qnil
)));
1187 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1188 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1189 = XVECTOR (vec2
)->contents
[0];
1190 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1191 = XVECTOR (vec2
)->contents
[1];
1199 /* Variables for communication with x_handle_selection_notify. */
1200 static Atom reading_which_selection
;
1201 static Lisp_Object reading_selection_reply
;
1202 static Window reading_selection_window
;
1204 /* Do protocol to read selection-data from the server.
1205 Converts this to Lisp data and returns it. */
1208 x_get_foreign_selection (selection_symbol
, target_type
)
1209 Lisp_Object selection_symbol
, target_type
;
1211 struct frame
*sf
= SELECTED_FRAME ();
1212 Window requestor_window
= FRAME_X_WINDOW (sf
);
1213 Display
*display
= FRAME_X_DISPLAY (sf
);
1214 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1215 Time requestor_time
= last_event_timestamp
;
1216 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1217 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1223 if (CONSP (target_type
))
1224 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1226 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1230 count
= x_catch_errors (display
);
1232 TRACE2 ("Get selection %s, type %s",
1233 XGetAtomName (display
, type_atom
),
1234 XGetAtomName (display
, target_property
));
1236 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1237 requestor_window
, requestor_time
);
1240 /* Prepare to block until the reply has been read. */
1241 reading_selection_window
= requestor_window
;
1242 reading_which_selection
= selection_atom
;
1243 XSETCAR (reading_selection_reply
, Qnil
);
1245 frame
= some_frame_on_display (dpyinfo
);
1247 /* If the display no longer has frames, we can't expect
1248 to get many more selection requests from it, so don't
1249 bother trying to queue them. */
1252 x_start_queuing_selection_requests (display
);
1254 record_unwind_protect (queue_selection_requests_unwind
,
1259 /* This allows quits. Also, don't wait forever. */
1260 secs
= x_selection_timeout
/ 1000;
1261 usecs
= (x_selection_timeout
% 1000) * 1000;
1262 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1263 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1264 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1267 x_check_errors (display
, "Cannot get selection: %s");
1268 x_uncatch_errors (display
, count
);
1271 if (NILP (XCAR (reading_selection_reply
)))
1272 error ("Timed out waiting for reply from selection owner");
1273 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1274 error ("No `%s' selection", XSYMBOL (selection_symbol
)->name
->data
);
1276 /* Otherwise, the selection is waiting for us on the requested property. */
1278 x_get_window_property_as_lisp_data (display
, requestor_window
,
1279 target_property
, target_type
,
1283 /* Subroutines of x_get_window_property_as_lisp_data */
1285 /* Use xfree, not XFree, to free the data obtained with this function. */
1288 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1289 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1294 unsigned char **data_ret
;
1296 Atom
*actual_type_ret
;
1297 int *actual_format_ret
;
1298 unsigned long *actual_size_ret
;
1302 unsigned long bytes_remaining
;
1304 unsigned char *tmp_data
= 0;
1306 int buffer_size
= SELECTION_QUANTUM (display
);
1308 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1309 buffer_size
= MAX_SELECTION_QUANTUM
;
1313 /* First probe the thing to find out how big it is. */
1314 result
= XGetWindowProperty (display
, window
, property
,
1315 0L, 0L, False
, AnyPropertyType
,
1316 actual_type_ret
, actual_format_ret
,
1318 &bytes_remaining
, &tmp_data
);
1319 if (result
!= Success
)
1327 /* This was allocated by Xlib, so use XFree. */
1328 XFree ((char *) tmp_data
);
1330 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1336 total_size
= bytes_remaining
+ 1;
1337 *data_ret
= (unsigned char *) xmalloc (total_size
);
1339 /* Now read, until we've gotten it all. */
1340 while (bytes_remaining
)
1342 #ifdef TRACE_SELECTION
1343 int last
= bytes_remaining
;
1346 = XGetWindowProperty (display
, window
, property
,
1347 (long)offset
/4, (long)buffer_size
/4,
1350 actual_type_ret
, actual_format_ret
,
1351 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1353 TRACE2 ("Read %ld bytes from property %s",
1354 last
- bytes_remaining
,
1355 XGetAtomName (display
, property
));
1357 /* If this doesn't return Success at this point, it means that
1358 some clod deleted the selection while we were in the midst of
1359 reading it. Deal with that, I guess.... */
1360 if (result
!= Success
)
1362 *actual_size_ret
*= *actual_format_ret
/ 8;
1363 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1364 offset
+= *actual_size_ret
;
1366 /* This was allocated by Xlib, so use XFree. */
1367 XFree ((char *) tmp_data
);
1372 *bytes_ret
= offset
;
1375 /* Use xfree, not XFree, to free the data obtained with this function. */
1378 receive_incremental_selection (display
, window
, property
, target_type
,
1379 min_size_bytes
, data_ret
, size_bytes_ret
,
1380 type_ret
, format_ret
, size_ret
)
1384 Lisp_Object target_type
; /* for error messages only */
1385 unsigned int min_size_bytes
;
1386 unsigned char **data_ret
;
1387 int *size_bytes_ret
;
1389 unsigned long *size_ret
;
1393 struct prop_location
*wait_object
;
1394 *size_bytes_ret
= min_size_bytes
;
1395 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1397 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1399 /* At this point, we have read an INCR property.
1400 Delete the property to ack it.
1401 (But first, prepare to receive the next event in this handshake.)
1403 Now, we must loop, waiting for the sending window to put a value on
1404 that property, then reading the property, then deleting it to ack.
1405 We are done when the sender places a property of length 0.
1408 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1409 TRACE1 (" Delete property %s",
1410 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1411 XDeleteProperty (display
, window
, property
);
1412 TRACE1 (" Expect new value of property %s",
1413 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1414 wait_object
= expect_property_change (display
, window
, property
,
1421 unsigned char *tmp_data
;
1424 TRACE0 (" Wait for property change");
1425 wait_for_property_change (wait_object
);
1427 /* expect it again immediately, because x_get_window_property may
1428 .. no it won't, I don't get it.
1429 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1430 TRACE0 (" Get property value");
1431 x_get_window_property (display
, window
, property
,
1432 &tmp_data
, &tmp_size_bytes
,
1433 type_ret
, format_ret
, size_ret
, 1);
1435 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1437 if (tmp_size_bytes
== 0) /* we're done */
1439 TRACE0 ("Done reading incrementally");
1441 if (! waiting_for_other_props_on_window (display
, window
))
1442 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1443 unexpect_property_change (wait_object
);
1444 /* Use xfree, not XFree, because x_get_window_property
1445 calls xmalloc itself. */
1446 if (tmp_data
) xfree (tmp_data
);
1451 TRACE1 (" ACK by deleting property %s",
1452 XGetAtomName (display
, property
));
1453 XDeleteProperty (display
, window
, property
);
1454 wait_object
= expect_property_change (display
, window
, property
,
1459 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1461 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1462 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1465 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1466 offset
+= tmp_size_bytes
;
1468 /* Use xfree, not XFree, because x_get_window_property
1469 calls xmalloc itself. */
1475 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1476 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1477 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1480 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1485 Lisp_Object target_type
; /* for error messages only */
1486 Atom selection_atom
; /* for error messages only */
1490 unsigned long actual_size
;
1491 unsigned char *data
= 0;
1494 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1496 TRACE0 ("Reading selection data");
1498 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1499 &actual_type
, &actual_format
, &actual_size
, 1);
1502 int there_is_a_selection_owner
;
1504 there_is_a_selection_owner
1505 = XGetSelectionOwner (display
, selection_atom
);
1508 there_is_a_selection_owner
1509 ? Fcons (build_string ("selection owner couldn't convert"),
1511 ? Fcons (target_type
,
1512 Fcons (x_atom_to_symbol (display
,
1515 : Fcons (target_type
, Qnil
))
1516 : Fcons (build_string ("no selection"),
1517 Fcons (x_atom_to_symbol (display
,
1522 if (actual_type
== dpyinfo
->Xatom_INCR
)
1524 /* That wasn't really the data, just the beginning. */
1526 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1528 /* Use xfree, not XFree, because x_get_window_property
1529 calls xmalloc itself. */
1530 xfree ((char *) data
);
1532 receive_incremental_selection (display
, window
, property
, target_type
,
1533 min_size_bytes
, &data
, &bytes
,
1534 &actual_type
, &actual_format
,
1539 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1540 XDeleteProperty (display
, window
, property
);
1544 /* It's been read. Now convert it to a lisp object in some semi-rational
1546 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1547 actual_type
, actual_format
);
1549 /* Use xfree, not XFree, because x_get_window_property
1550 calls xmalloc itself. */
1551 xfree ((char *) data
);
1555 /* These functions convert from the selection data read from the server into
1556 something that we can use from Lisp, and vice versa.
1558 Type: Format: Size: Lisp Type:
1559 ----- ------- ----- -----------
1562 ATOM 32 > 1 Vector of Symbols
1564 * 16 > 1 Vector of Integers
1565 * 32 1 if <=16 bits: Integer
1566 if > 16 bits: Cons of top16, bot16
1567 * 32 > 1 Vector of the above
1569 When converting a Lisp number to C, it is assumed to be of format 16 if
1570 it is an integer, and of format 32 if it is a cons of two integers.
1572 When converting a vector of numbers from Lisp to C, it is assumed to be
1573 of format 16 if every element in the vector is an integer, and is assumed
1574 to be of format 32 if any element is a cons of two integers.
1576 When converting an object to C, it may be of the form (SYMBOL . <data>)
1577 where SYMBOL is what we should claim that the type is. Format and
1578 representation are as above. */
1583 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1585 unsigned char *data
;
1589 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1591 if (type
== dpyinfo
->Xatom_NULL
)
1594 /* Convert any 8-bit data to a string, for compactness. */
1595 else if (format
== 8)
1598 int require_encoding
= 0;
1604 ! NILP (buffer_defaults
.enable_multibyte_characters
)
1608 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1609 DATA to Emacs internal format because DATA may be encoded
1610 in compound text format. In addtion, if TYPE is `STRING'
1611 and DATA contains any 8-bit Latin-1 code, we should also
1613 if (type
== dpyinfo
->Xatom_TEXT
1614 || type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1615 require_encoding
= 1;
1616 else if (type
== XA_STRING
)
1619 for (i
= 0; i
< size
; i
++)
1621 if (data
[i
] >= 0x80)
1623 require_encoding
= 1;
1629 if (!require_encoding
)
1631 str
= make_unibyte_string ((char *) data
, size
);
1632 Vlast_coding_system_used
= Qraw_text
;
1636 struct coding_system coding
;
1638 if (NILP (Vnext_selection_coding_system
))
1639 Vnext_selection_coding_system
= Vselection_coding_system
;
1640 if (! CODING_SYSTEM_P (Vnext_selection_coding_system
))
1642 Vnext_selection_coding_system
= Vselection_coding_system
;
1643 if (! CODING_SYSTEM_P (Vnext_selection_coding_system
))
1644 Vnext_selection_coding_system
= Qraw_text
;
1646 setup_coding_system (Vnext_selection_coding_system
, &coding
);
1647 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
1648 decode_coding_c_string (&coding
, data
, size
, Qt
);
1649 str
= coding
.dst_object
;
1650 Vlast_coding_system_used
= Vnext_selection_coding_system
;
1651 Vnext_selection_coding_system
= Qnil
;
1655 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1656 a vector of symbols.
1658 else if (type
== XA_ATOM
)
1661 if (size
== sizeof (Atom
))
1662 return x_atom_to_symbol (display
, *((Atom
*) data
));
1665 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1667 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1668 Faset (v
, make_number (i
),
1669 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1674 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1675 If the number is > 16 bits, convert it to a cons of integers,
1676 16 bits in each half.
1678 else if (format
== 32 && size
== sizeof (long))
1679 return long_to_cons (((unsigned long *) data
) [0]);
1680 else if (format
== 16 && size
== sizeof (short))
1681 return make_number ((int) (((unsigned short *) data
) [0]));
1683 /* Convert any other kind of data to a vector of numbers, represented
1684 as above (as an integer, or a cons of two 16 bit integers.)
1686 else if (format
== 16)
1690 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1691 for (i
= 0; i
< size
/ 2; i
++)
1693 int j
= (int) ((unsigned short *) data
) [i
];
1694 Faset (v
, make_number (i
), make_number (j
));
1701 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1702 for (i
= 0; i
< size
/ 4; i
++)
1704 unsigned long j
= ((unsigned long *) data
) [i
];
1705 Faset (v
, make_number (i
), long_to_cons (j
));
1712 /* Use xfree, not XFree, to free the data obtained with this function. */
1715 lisp_data_to_selection_data (display
, obj
,
1716 data_ret
, type_ret
, size_ret
,
1717 format_ret
, nofree_ret
)
1720 unsigned char **data_ret
;
1722 unsigned int *size_ret
;
1726 Lisp_Object type
= Qnil
;
1727 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1731 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1735 if (CONSP (obj
) && NILP (XCDR (obj
)))
1739 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1740 { /* This is not the same as declining */
1746 else if (STRINGP (obj
))
1748 /* Since we are now handling multilingual text, we must consider
1749 sending back compound text. */
1752 if (NILP (Vnext_selection_coding_system
))
1753 Vnext_selection_coding_system
= Vselection_coding_system
;
1756 *data_ret
= x_encode_text (obj
, Vnext_selection_coding_system
, 1,
1757 (int *) size_ret
, &stringp
);
1758 *nofree_ret
= (*data_ret
== XSTRING (obj
)->data
);
1759 if (EQ (Vnext_selection_coding_system
,
1760 Qcompound_text_with_extensions
))
1761 type
= QCOMPOUND_TEXT
;
1762 else if (NILP (type
))
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-with-extensions'. */);
2395 Vselection_coding_system
= intern ("compound-text-with-extensions");
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
);
2429 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2430 staticpro (&Qcompound_text_with_extensions
);
2432 #ifdef CUT_BUFFER_SUPPORT
2433 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2434 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2435 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2436 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2437 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2438 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2439 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2440 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);