1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
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
, int));
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. */
99 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
101 Lisp_Object Qcompound_text_with_extensions
;
103 #ifdef CUT_BUFFER_SUPPORT
104 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
105 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
108 static Lisp_Object Vx_lost_selection_hooks
;
109 static Lisp_Object Vx_sent_selection_hooks
;
110 /* Coding system for communicating with other X clients via cutbuffer,
111 selection, and clipboard. */
112 static Lisp_Object Vselection_coding_system
;
114 /* Coding system for the next communicating with other X clients. */
115 static Lisp_Object Vnext_selection_coding_system
;
117 /* If this is a smaller number than the max-request-size of the display,
118 emacs will use INCR selection transfer when the selection is larger
119 than this. The max-request-size is usually around 64k, so if you want
120 emacs to use incremental selection transfers when the selection is
121 smaller than that, set this. I added this mostly for debugging the
122 incremental transfer stuff, but it might improve server performance. */
123 #define MAX_SELECTION_QUANTUM 0xFFFFFF
126 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
128 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
131 /* The timestamp of the last input event Emacs received from the X server. */
132 /* Defined in keyboard.c. */
133 extern unsigned long last_event_timestamp
;
135 /* This is an association list whose elements are of the form
136 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
137 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
138 SELECTION-VALUE is the value that emacs owns for that selection.
139 It may be any kind of Lisp object.
140 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
141 as a cons of two 16-bit numbers (making a 32 bit time.)
142 FRAME is the frame for which we made the selection.
143 If there is an entry in this alist, then it can be assumed that Emacs owns
145 The only (eq) parts of this list that are visible from Lisp are the
147 static Lisp_Object Vselection_alist
;
149 /* This is an alist whose CARs are selection-types (whose names are the same
150 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
151 call to convert the given Emacs selection value to a string representing
152 the given selection type. This is for Lisp-level extension of the emacs
153 selection handling. */
154 static Lisp_Object Vselection_converter_alist
;
156 /* If the selection owner takes too long to reply to a selection request,
157 we give up on it. This is in milliseconds (0 = no timeout.) */
158 static EMACS_INT x_selection_timeout
;
160 /* Utility functions */
162 static void lisp_data_to_selection_data ();
163 static Lisp_Object
selection_data_to_lisp_data ();
164 static Lisp_Object
x_get_window_property_as_lisp_data ();
166 /* This converts a Lisp symbol to a server Atom, avoiding a server
167 roundtrip whenever possible. */
170 symbol_to_x_atom (dpyinfo
, display
, sym
)
171 struct x_display_info
*dpyinfo
;
176 if (NILP (sym
)) return 0;
177 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
178 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
179 if (EQ (sym
, QSTRING
)) return XA_STRING
;
180 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
181 if (EQ (sym
, QATOM
)) return XA_ATOM
;
182 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
183 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
184 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
185 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
186 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
187 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
188 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
189 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
190 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
191 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
192 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
193 #ifdef CUT_BUFFER_SUPPORT
194 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
195 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
196 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
197 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
198 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
199 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
200 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
201 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
203 if (!SYMBOLP (sym
)) abort ();
205 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
207 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
213 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
214 and calls to intern whenever possible. */
217 x_atom_to_symbol (dpy
, atom
)
221 struct x_display_info
*dpyinfo
;
240 #ifdef CUT_BUFFER_SUPPORT
260 dpyinfo
= x_display_info_for_display (dpy
);
261 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
263 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
265 if (atom
== dpyinfo
->Xatom_TEXT
)
267 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
268 return QCOMPOUND_TEXT
;
269 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
271 if (atom
== dpyinfo
->Xatom_DELETE
)
273 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
275 if (atom
== dpyinfo
->Xatom_INCR
)
277 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
279 if (atom
== dpyinfo
->Xatom_TARGETS
)
281 if (atom
== dpyinfo
->Xatom_NULL
)
285 str
= XGetAtomName (dpy
, atom
);
287 TRACE1 ("XGetAtomName --> %s", str
);
288 if (! str
) return Qnil
;
291 /* This was allocated by Xlib, so use XFree. */
297 /* Do protocol to assert ourself as a selection owner.
298 Update the Vselection_alist so that we can reply to later requests for
302 x_own_selection (selection_name
, selection_value
)
303 Lisp_Object selection_name
, selection_value
;
305 struct frame
*sf
= SELECTED_FRAME ();
306 Window selecting_window
= FRAME_X_WINDOW (sf
);
307 Display
*display
= FRAME_X_DISPLAY (sf
);
308 Time time
= last_event_timestamp
;
310 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
313 CHECK_SYMBOL (selection_name
);
314 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
317 count
= x_catch_errors (display
);
318 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
319 x_check_errors (display
, "Can't set selection: %s");
320 x_uncatch_errors (display
, count
);
323 /* Now update the local cache */
325 Lisp_Object selection_time
;
326 Lisp_Object selection_data
;
327 Lisp_Object prev_value
;
329 selection_time
= long_to_cons ((unsigned long) time
);
330 selection_data
= Fcons (selection_name
,
331 Fcons (selection_value
,
332 Fcons (selection_time
,
333 Fcons (selected_frame
, Qnil
))));
334 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
336 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
338 /* If we already owned the selection, remove the old selection data.
339 Perhaps we should destructively modify it instead.
340 Don't use Fdelq as that may QUIT. */
341 if (!NILP (prev_value
))
343 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
344 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
345 if (EQ (prev_value
, Fcar (XCDR (rest
))))
347 XSETCDR (rest
, Fcdr (XCDR (rest
)));
354 /* Given a selection-name and desired type, look up our local copy of
355 the selection value and convert it to the type.
356 The value is nil or a string.
357 This function is used both for remote requests (LOCAL_REQUEST is zero)
358 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
360 This calls random Lisp code, and may signal or gc. */
363 x_get_local_selection (selection_symbol
, target_type
, local_request
)
364 Lisp_Object selection_symbol
, target_type
;
367 Lisp_Object local_value
;
368 Lisp_Object handler_fn
, value
, type
, check
;
371 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
373 if (NILP (local_value
)) return Qnil
;
375 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
376 if (EQ (target_type
, QTIMESTAMP
))
379 value
= XCAR (XCDR (XCDR (local_value
)));
382 else if (EQ (target_type
, QDELETE
))
385 Fx_disown_selection_internal
387 XCAR (XCDR (XCDR (local_value
))));
392 #if 0 /* #### MULTIPLE doesn't work yet */
393 else if (CONSP (target_type
)
394 && XCAR (target_type
) == QMULTIPLE
)
399 pairs
= XCDR (target_type
);
400 size
= XVECTOR (pairs
)->size
;
401 /* If the target is MULTIPLE, then target_type looks like
402 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
403 We modify the second element of each pair in the vector and
404 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
406 for (i
= 0; i
< size
; i
++)
409 pair
= XVECTOR (pairs
)->contents
[i
];
410 XVECTOR (pair
)->contents
[1]
411 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
412 XVECTOR (pair
)->contents
[1],
420 /* Don't allow a quit within the converter.
421 When the user types C-g, he would be surprised
422 if by luck it came during a converter. */
423 count
= SPECPDL_INDEX ();
424 specbind (Qinhibit_quit
, Qt
);
426 CHECK_SYMBOL (target_type
);
427 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
428 /* gcpro is not needed here since nothing but HANDLER_FN
429 is live, and that ought to be a symbol. */
431 if (!NILP (handler_fn
))
432 value
= call3 (handler_fn
,
433 selection_symbol
, (local_request
? Qnil
: target_type
),
434 XCAR (XCDR (local_value
)));
437 unbind_to (count
, Qnil
);
440 /* Make sure this value is of a type that we could transmit
441 to another X client. */
445 && SYMBOLP (XCAR (value
)))
447 check
= XCDR (value
);
455 /* Check for a value that cons_to_long could handle. */
456 else if (CONSP (check
)
457 && INTEGERP (XCAR (check
))
458 && (INTEGERP (XCDR (check
))
460 (CONSP (XCDR (check
))
461 && INTEGERP (XCAR (XCDR (check
)))
462 && NILP (XCDR (XCDR (check
))))))
467 Fcons (build_string ("invalid data returned by selection-conversion function"),
468 Fcons (handler_fn
, Fcons (value
, Qnil
))));
471 /* Subroutines of x_reply_selection_request. */
473 /* Send a SelectionNotify event to the requestor with property=None,
474 meaning we were unable to do what they wanted. */
477 x_decline_selection_request (event
)
478 struct input_event
*event
;
480 XSelectionEvent reply
;
483 reply
.type
= SelectionNotify
;
484 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
485 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
486 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
487 reply
.time
= SELECTION_EVENT_TIME (event
);
488 reply
.target
= SELECTION_EVENT_TARGET (event
);
489 reply
.property
= None
;
491 /* The reason for the error may be that the receiver has
492 died in the meantime. Handle that case. */
494 count
= x_catch_errors (reply
.display
);
495 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
496 XFlush (reply
.display
);
497 x_uncatch_errors (reply
.display
, count
);
501 /* This is the selection request currently being processed.
502 It is set to zero when the request is fully processed. */
503 static struct input_event
*x_selection_current_request
;
505 /* Display info in x_selection_request. */
507 static struct x_display_info
*selection_request_dpyinfo
;
509 /* Used as an unwind-protect clause so that, if a selection-converter signals
510 an error, we tell the requester that we were unable to do what they wanted
511 before we throw to top-level or go into the debugger or whatever. */
514 x_selection_request_lisp_error (ignore
)
517 if (x_selection_current_request
!= 0
518 && selection_request_dpyinfo
->display
)
519 x_decline_selection_request (x_selection_current_request
);
524 /* This stuff is so that INCR selections are reentrant (that is, so we can
525 be servicing multiple INCR selection requests simultaneously.) I haven't
526 actually tested that yet. */
528 /* Keep a list of the property changes that are awaited. */
538 struct prop_location
*next
;
541 static struct prop_location
*expect_property_change ();
542 static void wait_for_property_change ();
543 static void unexpect_property_change ();
544 static int waiting_for_other_props_on_window ();
546 static int prop_location_identifier
;
548 static Lisp_Object property_change_reply
;
550 static struct prop_location
*property_change_reply_object
;
552 static struct prop_location
*property_change_wait_list
;
555 queue_selection_requests_unwind (frame
)
558 FRAME_PTR f
= XFRAME (frame
);
561 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
565 /* Return some frame whose display info is DPYINFO.
566 Return nil if there is none. */
569 some_frame_on_display (dpyinfo
)
570 struct x_display_info
*dpyinfo
;
572 Lisp_Object list
, frame
;
574 FOR_EACH_FRAME (list
, frame
)
576 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
583 /* Send the reply to a selection request event EVENT.
584 TYPE is the type of selection data requested.
585 DATA and SIZE describe the data to send, already converted.
586 FORMAT is the unit-size (in bits) of the data to be transmitted. */
589 x_reply_selection_request (event
, format
, data
, size
, type
)
590 struct input_event
*event
;
595 XSelectionEvent reply
;
596 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
597 Window window
= SELECTION_EVENT_REQUESTOR (event
);
599 int format_bytes
= format
/8;
600 int max_bytes
= SELECTION_QUANTUM (display
);
601 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
604 if (max_bytes
> MAX_SELECTION_QUANTUM
)
605 max_bytes
= MAX_SELECTION_QUANTUM
;
607 reply
.type
= SelectionNotify
;
608 reply
.display
= display
;
609 reply
.requestor
= window
;
610 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
611 reply
.time
= SELECTION_EVENT_TIME (event
);
612 reply
.target
= SELECTION_EVENT_TARGET (event
);
613 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
614 if (reply
.property
== None
)
615 reply
.property
= reply
.target
;
617 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
619 count
= x_catch_errors (display
);
621 /* Store the data on the requested property.
622 If the selection is large, only store the first N bytes of it.
624 bytes_remaining
= size
* format_bytes
;
625 if (bytes_remaining
<= max_bytes
)
627 /* Send all the data at once, with minimal handshaking. */
628 TRACE1 ("Sending all %d bytes", bytes_remaining
);
629 XChangeProperty (display
, window
, reply
.property
, type
, format
,
630 PropModeReplace
, data
, size
);
631 /* At this point, the selection was successfully stored; ack it. */
632 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
636 /* Send an INCR selection. */
637 struct prop_location
*wait_object
;
641 frame
= some_frame_on_display (dpyinfo
);
643 /* If the display no longer has frames, we can't expect
644 to get many more selection requests from it, so don't
645 bother trying to queue them. */
648 x_start_queuing_selection_requests (display
);
650 record_unwind_protect (queue_selection_requests_unwind
,
654 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
655 error ("Attempt to transfer an INCR to ourself!");
657 TRACE2 ("Start sending %d bytes incrementally (%s)",
658 bytes_remaining
, XGetAtomName (display
, reply
.property
));
659 wait_object
= expect_property_change (display
, window
, reply
.property
,
662 TRACE1 ("Set %s to number of bytes to send",
663 XGetAtomName (display
, reply
.property
));
664 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
666 (unsigned char *) &bytes_remaining
, 1);
667 XSelectInput (display
, window
, PropertyChangeMask
);
669 /* Tell 'em the INCR data is there... */
670 TRACE0 ("Send SelectionNotify event");
671 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
674 had_errors
= x_had_errors_p (display
);
677 /* First, wait for the requester to ack by deleting the property.
678 This can run random lisp code (process handlers) or signal. */
681 TRACE1 ("Waiting for ACK (deletion of %s)",
682 XGetAtomName (display
, reply
.property
));
683 wait_for_property_change (wait_object
);
687 while (bytes_remaining
)
689 int i
= ((bytes_remaining
< max_bytes
)
696 = expect_property_change (display
, window
, reply
.property
,
699 TRACE1 ("Sending increment of %d bytes", i
);
700 TRACE1 ("Set %s to increment data",
701 XGetAtomName (display
, reply
.property
));
703 /* Append the next chunk of data to the property. */
704 XChangeProperty (display
, window
, reply
.property
, type
, format
,
705 PropModeAppend
, data
, i
/ format_bytes
);
706 bytes_remaining
-= i
;
709 had_errors
= x_had_errors_p (display
);
715 /* Now wait for the requester to ack this chunk by deleting the
716 property. This can run random lisp code or signal. */
717 TRACE1 ("Waiting for increment ACK (deletion of %s)",
718 XGetAtomName (display
, reply
.property
));
719 wait_for_property_change (wait_object
);
722 /* Now write a zero-length chunk to the property to tell the
723 requester that we're done. */
725 if (! waiting_for_other_props_on_window (display
, window
))
726 XSelectInput (display
, window
, 0L);
728 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
729 XGetAtomName (display
, reply
.property
));
730 XChangeProperty (display
, window
, reply
.property
, type
, format
,
731 PropModeReplace
, data
, 0);
732 TRACE0 ("Done sending incrementally");
735 /* rms, 2003-01-03: I think I have fixed this bug. */
736 /* The window we're communicating with may have been deleted
737 in the meantime (that's a real situation from a bug report).
738 In this case, there may be events in the event queue still
739 refering to the deleted window, and we'll get a BadWindow error
740 in XTread_socket when processing the events. I don't have
741 an idea how to fix that. gerd, 2001-01-98. */
743 x_uncatch_errors (display
, count
);
747 /* Handle a SelectionRequest event EVENT.
748 This is called from keyboard.c when such an event is found in the queue. */
751 x_handle_selection_request (event
)
752 struct input_event
*event
;
754 struct gcpro gcpro1
, gcpro2
, gcpro3
;
755 Lisp_Object local_selection_data
;
756 Lisp_Object selection_symbol
;
757 Lisp_Object target_symbol
;
758 Lisp_Object converted_selection
;
759 Time local_selection_time
;
760 Lisp_Object successful_p
;
762 struct x_display_info
*dpyinfo
763 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
765 local_selection_data
= Qnil
;
766 target_symbol
= Qnil
;
767 converted_selection
= Qnil
;
770 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
772 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
773 SELECTION_EVENT_SELECTION (event
));
775 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
777 if (NILP (local_selection_data
))
779 /* Someone asked for the selection, but we don't have it any more.
781 x_decline_selection_request (event
);
785 local_selection_time
= (Time
)
786 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
788 if (SELECTION_EVENT_TIME (event
) != CurrentTime
789 && local_selection_time
> SELECTION_EVENT_TIME (event
))
791 /* Someone asked for the selection, and we have one, but not the one
794 x_decline_selection_request (event
);
798 x_selection_current_request
= event
;
799 count
= SPECPDL_INDEX ();
800 selection_request_dpyinfo
= dpyinfo
;
801 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
803 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
804 SELECTION_EVENT_TARGET (event
));
806 #if 0 /* #### MULTIPLE doesn't work yet */
807 if (EQ (target_symbol
, QMULTIPLE
))
808 target_symbol
= fetch_multiple_target (event
);
811 /* Convert lisp objects back into binary data */
814 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
816 if (! NILP (converted_selection
))
824 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
826 &data
, &type
, &size
, &format
, &nofree
);
828 x_reply_selection_request (event
, format
, data
, size
, type
);
831 /* Indicate we have successfully processed this event. */
832 x_selection_current_request
= 0;
834 /* Use xfree, not XFree, because lisp_data_to_selection_data
835 calls xmalloc itself. */
839 unbind_to (count
, Qnil
);
843 /* Let random lisp code notice that the selection has been asked for. */
846 rest
= Vx_sent_selection_hooks
;
847 if (!EQ (rest
, Qunbound
))
848 for (; CONSP (rest
); rest
= Fcdr (rest
))
849 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
855 /* Handle a SelectionClear event EVENT, which indicates that some
856 client cleared out our previously asserted selection.
857 This is called from keyboard.c when such an event is found in the queue. */
860 x_handle_selection_clear (event
)
861 struct input_event
*event
;
863 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
864 Atom selection
= SELECTION_EVENT_SELECTION (event
);
865 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
867 Lisp_Object selection_symbol
, local_selection_data
;
868 Time local_selection_time
;
869 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
870 struct x_display_info
*t_dpyinfo
;
872 /* If the new selection owner is also Emacs,
873 don't clear the new selection. */
875 /* Check each display on the same terminal,
876 to see if this Emacs job now owns the selection
877 through that display. */
878 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
879 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
882 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
883 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
891 selection_symbol
= x_atom_to_symbol (display
, selection
);
893 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
895 /* Well, we already believe that we don't own it, so that's just fine. */
896 if (NILP (local_selection_data
)) return;
898 local_selection_time
= (Time
)
899 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
901 /* This SelectionClear is for a selection that we no longer own, so we can
902 disregard it. (That is, we have reasserted the selection since this
903 request was generated.) */
905 if (changed_owner_time
!= CurrentTime
906 && local_selection_time
> changed_owner_time
)
909 /* Otherwise, we're really honest and truly being told to drop it.
910 Don't use Fdelq as that may QUIT;. */
912 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
913 Vselection_alist
= Fcdr (Vselection_alist
);
917 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
918 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
920 XSETCDR (rest
, Fcdr (XCDR (rest
)));
925 /* Let random lisp code notice that the selection has been stolen. */
929 rest
= Vx_lost_selection_hooks
;
930 if (!EQ (rest
, Qunbound
))
932 for (; CONSP (rest
); rest
= Fcdr (rest
))
933 call1 (Fcar (rest
), selection_symbol
);
934 prepare_menu_bars ();
935 redisplay_preserve_echo_area (20);
940 /* Clear all selections that were made from frame F.
941 We do this when about to delete a frame. */
944 x_clear_frame_selections (f
)
950 XSETFRAME (frame
, f
);
952 /* Otherwise, we're really honest and truly being told to drop it.
953 Don't use Fdelq as that may QUIT;. */
955 /* Delete elements from the beginning of Vselection_alist. */
956 while (!NILP (Vselection_alist
)
957 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
959 /* Let random Lisp code notice that the selection has been stolen. */
960 Lisp_Object hooks
, selection_symbol
;
962 hooks
= Vx_lost_selection_hooks
;
963 selection_symbol
= Fcar (Fcar (Vselection_alist
));
965 if (!EQ (hooks
, Qunbound
))
967 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
968 call1 (Fcar (hooks
), selection_symbol
);
969 #if 0 /* This can crash when deleting a frame
970 from x_connection_closed. Anyway, it seems unnecessary;
971 something else should cause a redisplay. */
972 redisplay_preserve_echo_area (21);
976 Vselection_alist
= Fcdr (Vselection_alist
);
979 /* Delete elements after the beginning of Vselection_alist. */
980 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
981 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
983 /* Let random Lisp code notice that the selection has been stolen. */
984 Lisp_Object hooks
, selection_symbol
;
986 hooks
= Vx_lost_selection_hooks
;
987 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
989 if (!EQ (hooks
, Qunbound
))
991 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
992 call1 (Fcar (hooks
), selection_symbol
);
993 #if 0 /* See above */
994 redisplay_preserve_echo_area (22);
997 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1002 /* Nonzero if any properties for DISPLAY and WINDOW
1003 are on the list of what we are waiting for. */
1006 waiting_for_other_props_on_window (display
, window
)
1010 struct prop_location
*rest
= property_change_wait_list
;
1012 if (rest
->display
== display
&& rest
->window
== window
)
1019 /* Add an entry to the list of property changes we are waiting for.
1020 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1021 The return value is a number that uniquely identifies
1022 this awaited property change. */
1024 static struct prop_location
*
1025 expect_property_change (display
, window
, property
, state
)
1031 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1032 pl
->identifier
= ++prop_location_identifier
;
1033 pl
->display
= display
;
1034 pl
->window
= window
;
1035 pl
->property
= property
;
1036 pl
->desired_state
= state
;
1037 pl
->next
= property_change_wait_list
;
1039 property_change_wait_list
= pl
;
1043 /* Delete an entry from the list of property changes we are waiting for.
1044 IDENTIFIER is the number that uniquely identifies the entry. */
1047 unexpect_property_change (location
)
1048 struct prop_location
*location
;
1050 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1053 if (rest
== location
)
1056 prev
->next
= rest
->next
;
1058 property_change_wait_list
= rest
->next
;
1067 /* Remove the property change expectation element for IDENTIFIER. */
1070 wait_for_property_change_unwind (identifierval
)
1071 Lisp_Object identifierval
;
1073 unexpect_property_change ((struct prop_location
*)
1074 (XFASTINT (XCAR (identifierval
)) << 16
1075 | XFASTINT (XCDR (identifierval
))));
1079 /* Actually wait for a property change.
1080 IDENTIFIER should be the value that expect_property_change returned. */
1083 wait_for_property_change (location
)
1084 struct prop_location
*location
;
1087 int count
= SPECPDL_INDEX ();
1090 tem
= Fcons (Qnil
, Qnil
);
1091 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1092 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1094 /* Make sure to do unexpect_property_change if we quit or err. */
1095 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1097 XSETCAR (property_change_reply
, Qnil
);
1099 property_change_reply_object
= location
;
1100 /* If the event we are waiting for arrives beyond here, it will set
1101 property_change_reply, because property_change_reply_object says so. */
1102 if (! location
->arrived
)
1104 secs
= x_selection_timeout
/ 1000;
1105 usecs
= (x_selection_timeout
% 1000) * 1000;
1106 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1107 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1109 if (NILP (XCAR (property_change_reply
)))
1111 TRACE0 (" Timed out");
1112 error ("Timed out waiting for property-notify event");
1116 unbind_to (count
, Qnil
);
1119 /* Called from XTread_socket in response to a PropertyNotify event. */
1122 x_handle_property_notify (event
)
1123 XPropertyEvent
*event
;
1125 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1129 if (rest
->property
== event
->atom
1130 && rest
->window
== event
->window
1131 && rest
->display
== event
->display
1132 && rest
->desired_state
== event
->state
)
1134 TRACE2 ("Expected %s of property %s",
1135 (event
->state
== PropertyDelete
? "deletion" : "change"),
1136 XGetAtomName (event
->display
, event
->atom
));
1140 /* If this is the one wait_for_property_change is waiting for,
1141 tell it to wake up. */
1142 if (rest
== property_change_reply_object
)
1143 XSETCAR (property_change_reply
, Qt
);
1146 prev
->next
= rest
->next
;
1148 property_change_wait_list
= rest
->next
;
1160 #if 0 /* #### MULTIPLE doesn't work yet */
1163 fetch_multiple_target (event
)
1164 XSelectionRequestEvent
*event
;
1166 Display
*display
= event
->display
;
1167 Window window
= event
->requestor
;
1168 Atom target
= event
->target
;
1169 Atom selection_atom
= event
->selection
;
1174 x_get_window_property_as_lisp_data (display
, window
, target
,
1175 QMULTIPLE
, selection_atom
));
1179 copy_multiple_data (obj
)
1186 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1189 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1190 for (i
= 0; i
< size
; i
++)
1192 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1193 CHECK_VECTOR (vec2
);
1194 if (XVECTOR (vec2
)->size
!= 2)
1195 /* ??? Confusing error message */
1196 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1197 Fcons (vec2
, Qnil
)));
1198 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1199 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1200 = XVECTOR (vec2
)->contents
[0];
1201 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1202 = XVECTOR (vec2
)->contents
[1];
1210 /* Variables for communication with x_handle_selection_notify. */
1211 static Atom reading_which_selection
;
1212 static Lisp_Object reading_selection_reply
;
1213 static Window reading_selection_window
;
1215 /* Do protocol to read selection-data from the server.
1216 Converts this to Lisp data and returns it. */
1219 x_get_foreign_selection (selection_symbol
, target_type
)
1220 Lisp_Object selection_symbol
, target_type
;
1222 struct frame
*sf
= SELECTED_FRAME ();
1223 Window requestor_window
= FRAME_X_WINDOW (sf
);
1224 Display
*display
= FRAME_X_DISPLAY (sf
);
1225 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1226 Time requestor_time
= last_event_timestamp
;
1227 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1228 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1234 if (CONSP (target_type
))
1235 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1237 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1241 count
= x_catch_errors (display
);
1243 TRACE2 ("Get selection %s, type %s",
1244 XGetAtomName (display
, type_atom
),
1245 XGetAtomName (display
, target_property
));
1247 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1248 requestor_window
, requestor_time
);
1251 /* Prepare to block until the reply has been read. */
1252 reading_selection_window
= requestor_window
;
1253 reading_which_selection
= selection_atom
;
1254 XSETCAR (reading_selection_reply
, Qnil
);
1256 frame
= some_frame_on_display (dpyinfo
);
1258 /* If the display no longer has frames, we can't expect
1259 to get many more selection requests from it, so don't
1260 bother trying to queue them. */
1263 x_start_queuing_selection_requests (display
);
1265 record_unwind_protect (queue_selection_requests_unwind
,
1270 /* This allows quits. Also, don't wait forever. */
1271 secs
= x_selection_timeout
/ 1000;
1272 usecs
= (x_selection_timeout
% 1000) * 1000;
1273 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1274 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1275 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1278 x_check_errors (display
, "Cannot get selection: %s");
1279 x_uncatch_errors (display
, count
);
1282 if (NILP (XCAR (reading_selection_reply
)))
1283 error ("Timed out waiting for reply from selection owner");
1284 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1285 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1287 /* Otherwise, the selection is waiting for us on the requested property. */
1289 x_get_window_property_as_lisp_data (display
, requestor_window
,
1290 target_property
, target_type
,
1294 /* Subroutines of x_get_window_property_as_lisp_data */
1296 /* Use xfree, not XFree, to free the data obtained with this function. */
1299 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1300 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1305 unsigned char **data_ret
;
1307 Atom
*actual_type_ret
;
1308 int *actual_format_ret
;
1309 unsigned long *actual_size_ret
;
1313 unsigned long bytes_remaining
;
1315 unsigned char *tmp_data
= 0;
1317 int buffer_size
= SELECTION_QUANTUM (display
);
1319 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1320 buffer_size
= MAX_SELECTION_QUANTUM
;
1324 /* First probe the thing to find out how big it is. */
1325 result
= XGetWindowProperty (display
, window
, property
,
1326 0L, 0L, False
, AnyPropertyType
,
1327 actual_type_ret
, actual_format_ret
,
1329 &bytes_remaining
, &tmp_data
);
1330 if (result
!= Success
)
1338 /* This was allocated by Xlib, so use XFree. */
1339 XFree ((char *) tmp_data
);
1341 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1347 total_size
= bytes_remaining
+ 1;
1348 *data_ret
= (unsigned char *) xmalloc (total_size
);
1350 /* Now read, until we've gotten it all. */
1351 while (bytes_remaining
)
1353 #ifdef TRACE_SELECTION
1354 int last
= bytes_remaining
;
1357 = XGetWindowProperty (display
, window
, property
,
1358 (long)offset
/4, (long)buffer_size
/4,
1361 actual_type_ret
, actual_format_ret
,
1362 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1364 TRACE2 ("Read %ld bytes from property %s",
1365 last
- bytes_remaining
,
1366 XGetAtomName (display
, property
));
1368 /* If this doesn't return Success at this point, it means that
1369 some clod deleted the selection while we were in the midst of
1370 reading it. Deal with that, I guess.... */
1371 if (result
!= Success
)
1373 *actual_size_ret
*= *actual_format_ret
/ 8;
1374 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1375 offset
+= *actual_size_ret
;
1377 /* This was allocated by Xlib, so use XFree. */
1378 XFree ((char *) tmp_data
);
1383 *bytes_ret
= offset
;
1386 /* Use xfree, not XFree, to free the data obtained with this function. */
1389 receive_incremental_selection (display
, window
, property
, target_type
,
1390 min_size_bytes
, data_ret
, size_bytes_ret
,
1391 type_ret
, format_ret
, size_ret
)
1395 Lisp_Object target_type
; /* for error messages only */
1396 unsigned int min_size_bytes
;
1397 unsigned char **data_ret
;
1398 int *size_bytes_ret
;
1400 unsigned long *size_ret
;
1404 struct prop_location
*wait_object
;
1405 *size_bytes_ret
= min_size_bytes
;
1406 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1408 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1410 /* At this point, we have read an INCR property.
1411 Delete the property to ack it.
1412 (But first, prepare to receive the next event in this handshake.)
1414 Now, we must loop, waiting for the sending window to put a value on
1415 that property, then reading the property, then deleting it to ack.
1416 We are done when the sender places a property of length 0.
1419 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1420 TRACE1 (" Delete property %s",
1421 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1422 XDeleteProperty (display
, window
, property
);
1423 TRACE1 (" Expect new value of property %s",
1424 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1425 wait_object
= expect_property_change (display
, window
, property
,
1432 unsigned char *tmp_data
;
1435 TRACE0 (" Wait for property change");
1436 wait_for_property_change (wait_object
);
1438 /* expect it again immediately, because x_get_window_property may
1439 .. no it won't, I don't get it.
1440 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1441 TRACE0 (" Get property value");
1442 x_get_window_property (display
, window
, property
,
1443 &tmp_data
, &tmp_size_bytes
,
1444 type_ret
, format_ret
, size_ret
, 1);
1446 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1448 if (tmp_size_bytes
== 0) /* we're done */
1450 TRACE0 ("Done reading incrementally");
1452 if (! waiting_for_other_props_on_window (display
, window
))
1453 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1454 unexpect_property_change (wait_object
);
1455 /* Use xfree, not XFree, because x_get_window_property
1456 calls xmalloc itself. */
1457 if (tmp_data
) xfree (tmp_data
);
1462 TRACE1 (" ACK by deleting property %s",
1463 XGetAtomName (display
, property
));
1464 XDeleteProperty (display
, window
, property
);
1465 wait_object
= expect_property_change (display
, window
, property
,
1470 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1472 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1473 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1476 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1477 offset
+= tmp_size_bytes
;
1479 /* Use xfree, not XFree, because x_get_window_property
1480 calls xmalloc itself. */
1486 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1487 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1488 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1491 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1496 Lisp_Object target_type
; /* for error messages only */
1497 Atom selection_atom
; /* for error messages only */
1501 unsigned long actual_size
;
1502 unsigned char *data
= 0;
1505 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1507 TRACE0 ("Reading selection data");
1509 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1510 &actual_type
, &actual_format
, &actual_size
, 1);
1513 int there_is_a_selection_owner
;
1515 there_is_a_selection_owner
1516 = XGetSelectionOwner (display
, selection_atom
);
1519 there_is_a_selection_owner
1520 ? Fcons (build_string ("selection owner couldn't convert"),
1522 ? Fcons (target_type
,
1523 Fcons (x_atom_to_symbol (display
,
1526 : Fcons (target_type
, Qnil
))
1527 : Fcons (build_string ("no selection"),
1528 Fcons (x_atom_to_symbol (display
,
1533 if (actual_type
== dpyinfo
->Xatom_INCR
)
1535 /* That wasn't really the data, just the beginning. */
1537 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1539 /* Use xfree, not XFree, because x_get_window_property
1540 calls xmalloc itself. */
1541 xfree ((char *) data
);
1543 receive_incremental_selection (display
, window
, property
, target_type
,
1544 min_size_bytes
, &data
, &bytes
,
1545 &actual_type
, &actual_format
,
1550 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1551 XDeleteProperty (display
, window
, property
);
1555 /* It's been read. Now convert it to a lisp object in some semi-rational
1557 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1558 actual_type
, actual_format
);
1560 /* Use xfree, not XFree, because x_get_window_property
1561 calls xmalloc itself. */
1562 xfree ((char *) data
);
1566 /* These functions convert from the selection data read from the server into
1567 something that we can use from Lisp, and vice versa.
1569 Type: Format: Size: Lisp Type:
1570 ----- ------- ----- -----------
1573 ATOM 32 > 1 Vector of Symbols
1575 * 16 > 1 Vector of Integers
1576 * 32 1 if <=16 bits: Integer
1577 if > 16 bits: Cons of top16, bot16
1578 * 32 > 1 Vector of the above
1580 When converting a Lisp number to C, it is assumed to be of format 16 if
1581 it is an integer, and of format 32 if it is a cons of two integers.
1583 When converting a vector of numbers from Lisp to C, it is assumed to be
1584 of format 16 if every element in the vector is an integer, and is assumed
1585 to be of format 32 if any element is a cons of two integers.
1587 When converting an object to C, it may be of the form (SYMBOL . <data>)
1588 where SYMBOL is what we should claim that the type is. Format and
1589 representation are as above. */
1594 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1596 unsigned char *data
;
1600 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1602 if (type
== dpyinfo
->Xatom_NULL
)
1605 /* Convert any 8-bit data to a string, for compactness. */
1606 else if (format
== 8)
1609 int require_encoding
= 0;
1615 ! NILP (buffer_defaults
.enable_multibyte_characters
)
1619 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1620 DATA to Emacs internal format because DATA may be encoded
1621 in compound text format. In addtion, if TYPE is `STRING'
1622 and DATA contains any 8-bit Latin-1 code, we should also
1624 if (type
== dpyinfo
->Xatom_TEXT
1625 || type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1626 require_encoding
= 1;
1627 else if (type
== XA_STRING
)
1630 for (i
= 0; i
< size
; i
++)
1632 if (data
[i
] >= 0x80)
1634 require_encoding
= 1;
1640 if (!require_encoding
)
1642 str
= make_unibyte_string ((char *) data
, size
);
1643 Vlast_coding_system_used
= Qraw_text
;
1649 struct coding_system coding
;
1651 if (NILP (Vnext_selection_coding_system
))
1652 Vnext_selection_coding_system
= Vselection_coding_system
;
1654 (Fcheck_coding_system(Vnext_selection_coding_system
), &coding
);
1655 coding
.src_multibyte
= 0;
1656 coding
.dst_multibyte
= 1;
1657 Vnext_selection_coding_system
= Qnil
;
1658 coding
.mode
|= CODING_MODE_LAST_BLOCK
;
1659 /* We explicitely disable composition handling because
1660 selection data should not contain any composition
1662 coding
.composing
= COMPOSITION_DISABLED
;
1663 bufsize
= decoding_buffer_size (&coding
, size
);
1664 buf
= (unsigned char *) xmalloc (bufsize
);
1665 decode_coding (&coding
, data
, buf
, size
, bufsize
);
1666 str
= make_string_from_bytes ((char *) buf
,
1667 coding
.produced_char
, coding
.produced
);
1670 if (SYMBOLP (coding
.post_read_conversion
)
1671 && !NILP (Ffboundp (coding
.post_read_conversion
)))
1672 str
= run_pre_post_conversion_on_str (str
, &coding
, 0);
1673 Vlast_coding_system_used
= coding
.symbol
;
1675 compose_chars_in_text (0, SCHARS (str
), str
);
1678 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1679 a vector of symbols.
1681 else if (type
== XA_ATOM
)
1684 if (size
== sizeof (Atom
))
1685 return x_atom_to_symbol (display
, *((Atom
*) data
));
1688 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1690 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1691 Faset (v
, make_number (i
),
1692 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1697 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1698 If the number is > 16 bits, convert it to a cons of integers,
1699 16 bits in each half.
1701 else if (format
== 32 && size
== sizeof (int))
1702 return long_to_cons (((unsigned int *) data
) [0]);
1703 else if (format
== 16 && size
== sizeof (short))
1704 return make_number ((int) (((unsigned short *) data
) [0]));
1706 /* Convert any other kind of data to a vector of numbers, represented
1707 as above (as an integer, or a cons of two 16 bit integers.)
1709 else if (format
== 16)
1713 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1714 for (i
= 0; i
< size
/ 2; i
++)
1716 int j
= (int) ((unsigned short *) data
) [i
];
1717 Faset (v
, make_number (i
), make_number (j
));
1724 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1725 for (i
= 0; i
< size
/ 4; i
++)
1727 unsigned int j
= ((unsigned int *) data
) [i
];
1728 Faset (v
, make_number (i
), long_to_cons (j
));
1735 /* Use xfree, not XFree, to free the data obtained with this function. */
1738 lisp_data_to_selection_data (display
, obj
,
1739 data_ret
, type_ret
, size_ret
,
1740 format_ret
, nofree_ret
)
1743 unsigned char **data_ret
;
1745 unsigned int *size_ret
;
1749 Lisp_Object type
= Qnil
;
1750 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1754 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1758 if (CONSP (obj
) && NILP (XCDR (obj
)))
1762 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1763 { /* This is not the same as declining */
1769 else if (STRINGP (obj
))
1771 xassert (! STRING_MULTIBYTE (obj
));
1775 *size_ret
= SBYTES (obj
);
1776 *data_ret
= SDATA (obj
);
1779 else if (SYMBOLP (obj
))
1783 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1784 (*data_ret
) [sizeof (Atom
)] = 0;
1785 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1786 if (NILP (type
)) type
= QATOM
;
1788 else if (INTEGERP (obj
)
1789 && XINT (obj
) < 0xFFFF
1790 && XINT (obj
) > -0xFFFF)
1794 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1795 (*data_ret
) [sizeof (short)] = 0;
1796 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1797 if (NILP (type
)) type
= QINTEGER
;
1799 else if (INTEGERP (obj
)
1800 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1801 && (INTEGERP (XCDR (obj
))
1802 || (CONSP (XCDR (obj
))
1803 && INTEGERP (XCAR (XCDR (obj
)))))))
1807 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1808 (*data_ret
) [sizeof (long)] = 0;
1809 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1810 if (NILP (type
)) type
= QINTEGER
;
1812 else if (VECTORP (obj
))
1814 /* Lisp_Vectors may represent a set of ATOMs;
1815 a set of 16 or 32 bit INTEGERs;
1816 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1820 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1821 /* This vector is an ATOM set */
1823 if (NILP (type
)) type
= QATOM
;
1824 *size_ret
= XVECTOR (obj
)->size
;
1826 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1827 for (i
= 0; i
< *size_ret
; i
++)
1828 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1829 (*(Atom
**) data_ret
) [i
]
1830 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1832 Fsignal (Qerror
, /* Qselection_error */
1834 ("all elements of selection vector must have same type"),
1835 Fcons (obj
, Qnil
)));
1837 #if 0 /* #### MULTIPLE doesn't work yet */
1838 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1839 /* This vector is an ATOM_PAIR set */
1841 if (NILP (type
)) type
= QATOM_PAIR
;
1842 *size_ret
= XVECTOR (obj
)->size
;
1844 *data_ret
= (unsigned char *)
1845 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1846 for (i
= 0; i
< *size_ret
; i
++)
1847 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1849 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1850 if (XVECTOR (pair
)->size
!= 2)
1853 ("elements of the vector must be vectors of exactly two elements"),
1854 Fcons (pair
, Qnil
)));
1856 (*(Atom
**) data_ret
) [i
* 2]
1857 = symbol_to_x_atom (dpyinfo
, display
,
1858 XVECTOR (pair
)->contents
[0]);
1859 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1860 = symbol_to_x_atom (dpyinfo
, display
,
1861 XVECTOR (pair
)->contents
[1]);
1866 ("all elements of the vector must be of the same type"),
1867 Fcons (obj
, Qnil
)));
1872 /* This vector is an INTEGER set, or something like it */
1874 *size_ret
= XVECTOR (obj
)->size
;
1875 if (NILP (type
)) type
= QINTEGER
;
1877 for (i
= 0; i
< *size_ret
; i
++)
1878 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1880 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1881 Fsignal (Qerror
, /* Qselection_error */
1883 ("elements of selection vector must be integers or conses of integers"),
1884 Fcons (obj
, Qnil
)));
1886 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1887 for (i
= 0; i
< *size_ret
; i
++)
1888 if (*format_ret
== 32)
1889 (*((unsigned long **) data_ret
)) [i
]
1890 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1892 (*((unsigned short **) data_ret
)) [i
]
1893 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1897 Fsignal (Qerror
, /* Qselection_error */
1898 Fcons (build_string ("unrecognised selection data"),
1899 Fcons (obj
, Qnil
)));
1901 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1905 clean_local_selection_data (obj
)
1909 && INTEGERP (XCAR (obj
))
1910 && CONSP (XCDR (obj
))
1911 && INTEGERP (XCAR (XCDR (obj
)))
1912 && NILP (XCDR (XCDR (obj
))))
1913 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1916 && INTEGERP (XCAR (obj
))
1917 && INTEGERP (XCDR (obj
)))
1919 if (XINT (XCAR (obj
)) == 0)
1921 if (XINT (XCAR (obj
)) == -1)
1922 return make_number (- XINT (XCDR (obj
)));
1927 int size
= XVECTOR (obj
)->size
;
1930 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1931 copy
= Fmake_vector (make_number (size
), Qnil
);
1932 for (i
= 0; i
< size
; i
++)
1933 XVECTOR (copy
)->contents
[i
]
1934 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1940 /* Called from XTread_socket to handle SelectionNotify events.
1941 If it's the selection we are waiting for, stop waiting
1942 by setting the car of reading_selection_reply to non-nil.
1943 We store t there if the reply is successful, lambda if not. */
1946 x_handle_selection_notify (event
)
1947 XSelectionEvent
*event
;
1949 if (event
->requestor
!= reading_selection_window
)
1951 if (event
->selection
!= reading_which_selection
)
1954 TRACE0 ("Received SelectionNotify");
1955 XSETCAR (reading_selection_reply
,
1956 (event
->property
!= 0 ? Qt
: Qlambda
));
1960 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1961 Sx_own_selection_internal
, 2, 2, 0,
1962 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1963 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1964 \(Those are literal upper-case symbol names, since that's what X expects.)
1965 VALUE is typically a string, or a cons of two markers, but may be
1966 anything that the functions on `selection-converter-alist' know about. */)
1967 (selection_name
, selection_value
)
1968 Lisp_Object selection_name
, selection_value
;
1971 CHECK_SYMBOL (selection_name
);
1972 if (NILP (selection_value
)) error ("selection-value may not be nil");
1973 x_own_selection (selection_name
, selection_value
);
1974 return selection_value
;
1978 /* Request the selection value from the owner. If we are the owner,
1979 simply return our selection value. If we are not the owner, this
1980 will block until all of the data has arrived. */
1982 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1983 Sx_get_selection_internal
, 2, 2, 0,
1984 doc
: /* Return text selected from some X window.
1985 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1986 \(Those are literal upper-case symbol names, since that's what X expects.)
1987 TYPE is the type of data desired, typically `STRING'. */)
1988 (selection_symbol
, target_type
)
1989 Lisp_Object selection_symbol
, target_type
;
1991 Lisp_Object val
= Qnil
;
1992 struct gcpro gcpro1
, gcpro2
;
1993 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1995 CHECK_SYMBOL (selection_symbol
);
1997 #if 0 /* #### MULTIPLE doesn't work yet */
1998 if (CONSP (target_type
)
1999 && XCAR (target_type
) == QMULTIPLE
)
2001 CHECK_VECTOR (XCDR (target_type
));
2002 /* So we don't destructively modify this... */
2003 target_type
= copy_multiple_data (target_type
);
2007 CHECK_SYMBOL (target_type
);
2009 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
2013 val
= x_get_foreign_selection (selection_symbol
, target_type
);
2018 && SYMBOLP (XCAR (val
)))
2021 if (CONSP (val
) && NILP (XCDR (val
)))
2024 val
= clean_local_selection_data (val
);
2030 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
2031 Sx_disown_selection_internal
, 1, 2, 0,
2032 doc
: /* If we own the selection SELECTION, disown it.
2033 Disowning it means there is no such selection. */)
2035 Lisp_Object selection
;
2039 Atom selection_atom
;
2040 struct selection_input_event event
;
2042 struct x_display_info
*dpyinfo
;
2043 struct frame
*sf
= SELECTED_FRAME ();
2046 display
= FRAME_X_DISPLAY (sf
);
2047 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2048 CHECK_SYMBOL (selection
);
2050 timestamp
= last_event_timestamp
;
2052 timestamp
= cons_to_long (time
);
2054 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2055 return Qnil
; /* Don't disown the selection when we're not the owner. */
2057 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2060 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2063 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2064 generated for a window which owns the selection when that window sets
2065 the selection owner to None. The NCD server does, the MIT Sun4 server
2066 doesn't. So we synthesize one; this means we might get two, but
2067 that's ok, because the second one won't have any effect. */
2068 SELECTION_EVENT_DISPLAY (&event
) = display
;
2069 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2070 SELECTION_EVENT_TIME (&event
) = timestamp
;
2071 x_handle_selection_clear ((struct input_event
*) &event
);
2076 /* Get rid of all the selections in buffer BUFFER.
2077 This is used when we kill a buffer. */
2080 x_disown_buffer_selections (buffer
)
2084 struct buffer
*buf
= XBUFFER (buffer
);
2086 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2088 Lisp_Object elt
, value
;
2091 if (CONSP (value
) && MARKERP (XCAR (value
))
2092 && XMARKER (XCAR (value
))->buffer
== buf
)
2093 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2097 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2099 doc
: /* Whether the current Emacs process owns the given X Selection.
2100 The arg should be the name of the selection in question, typically one of
2101 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2102 \(Those are literal upper-case symbol names, since that's what X expects.)
2103 For convenience, the symbol nil is the same as `PRIMARY',
2104 and t is the same as `SECONDARY'. */)
2106 Lisp_Object selection
;
2109 CHECK_SYMBOL (selection
);
2110 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2111 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2113 if (NILP (Fassq (selection
, Vselection_alist
)))
2118 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2120 doc
: /* Whether there is an owner for the given X Selection.
2121 The arg should be the name of the selection in question, typically one of
2122 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2123 \(Those are literal upper-case symbol names, since that's what X expects.)
2124 For convenience, the symbol nil is the same as `PRIMARY',
2125 and t is the same as `SECONDARY'. */)
2127 Lisp_Object selection
;
2132 struct frame
*sf
= SELECTED_FRAME ();
2134 /* It should be safe to call this before we have an X frame. */
2135 if (! FRAME_X_P (sf
))
2138 dpy
= FRAME_X_DISPLAY (sf
);
2139 CHECK_SYMBOL (selection
);
2140 if (!NILP (Fx_selection_owner_p (selection
)))
2142 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2143 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2144 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2148 owner
= XGetSelectionOwner (dpy
, atom
);
2150 return (owner
? Qt
: Qnil
);
2154 #ifdef CUT_BUFFER_SUPPORT
2156 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2158 initialize_cut_buffers (display
, window
)
2162 unsigned char *data
= (unsigned char *) "";
2164 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2165 PropModeAppend, data, 0)
2166 FROB (XA_CUT_BUFFER0
);
2167 FROB (XA_CUT_BUFFER1
);
2168 FROB (XA_CUT_BUFFER2
);
2169 FROB (XA_CUT_BUFFER3
);
2170 FROB (XA_CUT_BUFFER4
);
2171 FROB (XA_CUT_BUFFER5
);
2172 FROB (XA_CUT_BUFFER6
);
2173 FROB (XA_CUT_BUFFER7
);
2179 #define CHECK_CUT_BUFFER(symbol) \
2180 { CHECK_SYMBOL ((symbol)); \
2181 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2182 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2183 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2184 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2186 Fcons (build_string ("doesn't name a cut buffer"), \
2187 Fcons ((symbol), Qnil))); \
2190 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2191 Sx_get_cut_buffer_internal
, 1, 1, 0,
2192 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2198 unsigned char *data
;
2205 struct x_display_info
*dpyinfo
;
2206 struct frame
*sf
= SELECTED_FRAME ();
2209 display
= FRAME_X_DISPLAY (sf
);
2210 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2211 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2212 CHECK_CUT_BUFFER (buffer
);
2213 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2215 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2216 &type
, &format
, &size
, 0);
2217 if (!data
|| !format
)
2220 if (format
!= 8 || type
!= XA_STRING
)
2222 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2223 Fcons (x_atom_to_symbol (display
, type
),
2224 Fcons (make_number (format
), Qnil
))));
2226 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2227 /* Use xfree, not XFree, because x_get_window_property
2228 calls xmalloc itself. */
2234 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2235 Sx_store_cut_buffer_internal
, 2, 2, 0,
2236 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2238 Lisp_Object buffer
, string
;
2242 unsigned char *data
;
2244 int bytes_remaining
;
2247 struct frame
*sf
= SELECTED_FRAME ();
2250 display
= FRAME_X_DISPLAY (sf
);
2251 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2253 max_bytes
= SELECTION_QUANTUM (display
);
2254 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2255 max_bytes
= MAX_SELECTION_QUANTUM
;
2257 CHECK_CUT_BUFFER (buffer
);
2258 CHECK_STRING (string
);
2259 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2261 data
= (unsigned char *) SDATA (string
);
2262 bytes
= SBYTES (string
);
2263 bytes_remaining
= bytes
;
2265 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2267 initialize_cut_buffers (display
, window
);
2268 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2273 /* Don't mess up with an empty value. */
2274 if (!bytes_remaining
)
2275 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2276 PropModeReplace
, data
, 0);
2278 while (bytes_remaining
)
2280 int chunk
= (bytes_remaining
< max_bytes
2281 ? bytes_remaining
: max_bytes
);
2282 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2283 (bytes_remaining
== bytes
2288 bytes_remaining
-= chunk
;
2295 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2296 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2297 doc
: /* Rotate the values of the cut buffers by the given number of step.
2298 Positive means shift the values forward, negative means backward. */)
2305 struct frame
*sf
= SELECTED_FRAME ();
2308 display
= FRAME_X_DISPLAY (sf
);
2309 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2313 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2315 initialize_cut_buffers (display
, window
);
2316 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2319 props
[0] = XA_CUT_BUFFER0
;
2320 props
[1] = XA_CUT_BUFFER1
;
2321 props
[2] = XA_CUT_BUFFER2
;
2322 props
[3] = XA_CUT_BUFFER3
;
2323 props
[4] = XA_CUT_BUFFER4
;
2324 props
[5] = XA_CUT_BUFFER5
;
2325 props
[6] = XA_CUT_BUFFER6
;
2326 props
[7] = XA_CUT_BUFFER7
;
2328 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2338 defsubr (&Sx_get_selection_internal
);
2339 defsubr (&Sx_own_selection_internal
);
2340 defsubr (&Sx_disown_selection_internal
);
2341 defsubr (&Sx_selection_owner_p
);
2342 defsubr (&Sx_selection_exists_p
);
2344 #ifdef CUT_BUFFER_SUPPORT
2345 defsubr (&Sx_get_cut_buffer_internal
);
2346 defsubr (&Sx_store_cut_buffer_internal
);
2347 defsubr (&Sx_rotate_cut_buffers_internal
);
2350 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2351 staticpro (&reading_selection_reply
);
2352 reading_selection_window
= 0;
2353 reading_which_selection
= 0;
2355 property_change_wait_list
= 0;
2356 prop_location_identifier
= 0;
2357 property_change_reply
= Fcons (Qnil
, Qnil
);
2358 staticpro (&property_change_reply
);
2360 Vselection_alist
= Qnil
;
2361 staticpro (&Vselection_alist
);
2363 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2364 doc
: /* An alist associating X Windows selection-types with functions.
2365 These functions are called to convert the selection, with three args:
2366 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2367 a desired type to which the selection should be converted;
2368 and the local selection value (whatever was given to `x-own-selection').
2370 The function should return the value to send to the X server
2371 \(typically a string). A return value of nil
2372 means that the conversion could not be done.
2373 A return value which is the symbol `NULL'
2374 means that a side-effect was executed,
2375 and there is no meaningful selection value. */);
2376 Vselection_converter_alist
= Qnil
;
2378 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2379 doc
: /* A list of functions to be called when Emacs loses an X selection.
2380 \(This happens when some other X client makes its own selection
2381 or when a Lisp program explicitly clears the selection.)
2382 The functions are called with one argument, the selection type
2383 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2384 Vx_lost_selection_hooks
= Qnil
;
2386 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2387 doc
: /* A list of functions to be called when Emacs answers a selection request.
2388 The functions are called with four arguments:
2389 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2390 - the selection-type which Emacs was asked to convert the
2391 selection into before sending (for example, `STRING' or `LENGTH');
2392 - a flag indicating success or failure for responding to the request.
2393 We might have failed (and declined the request) for any number of reasons,
2394 including being asked for a selection that we no longer own, or being asked
2395 to convert into a type that we don't know about or that is inappropriate.
2396 This hook doesn't let you change the behavior of Emacs's selection replies,
2397 it merely informs you that they have happened. */);
2398 Vx_sent_selection_hooks
= Qnil
;
2400 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2401 doc
: /* Coding system for communicating with other X clients.
2402 When sending or receiving text via cut_buffer, selection, and clipboard,
2403 the text is encoded or decoded by this coding system.
2404 The default value is `compound-text-with-extensions'. */);
2405 Vselection_coding_system
= intern ("compound-text-with-extensions");
2407 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2408 doc
: /* Coding system for the next communication with other X clients.
2409 Usually, `selection-coding-system' is used for communicating with
2410 other X clients. But, if this variable is set, it is used for the
2411 next communication only. After the communication, this variable is
2413 Vnext_selection_coding_system
= Qnil
;
2415 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2416 doc
: /* Number of milliseconds to wait for a selection reply.
2417 If the selection owner doesn't reply in this time, we give up.
2418 A value of 0 means wait as long as necessary. This is initialized from the
2419 \"*selectionTimeout\" resource. */);
2420 x_selection_timeout
= 0;
2422 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2423 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2424 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2425 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2426 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2427 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2428 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2429 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2430 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2431 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2432 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2433 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2434 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2435 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2436 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2437 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2438 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2439 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2440 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2441 staticpro (&Qcompound_text_with_extensions
);
2443 #ifdef CUT_BUFFER_SUPPORT
2444 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2445 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2446 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2447 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2448 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2449 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2450 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2451 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);