1 /* X Selection processing for XEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of XEmacs.
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* Synched up with: Not synched with FSF. */
23 /* Rewritten by jwz */
29 #include "console-x.h"
30 #include "objects-x.h"
37 int lisp_to_time (Lisp_Object, time_t *);
38 Lisp_Object time_to_lisp (time_t);
40 #ifdef LWLIB_USES_MOTIF
41 # define MOTIF_CLIPBOARDS
44 #ifdef MOTIF_CLIPBOARDS
45 # include <Xm/CutPaste.h>
46 static void hack_motif_clipboard_selection (Atom selection_atom,
47 Lisp_Object selection_value,
48 Time thyme, Display *display,
49 Window selecting_window);
52 #define CUT_BUFFER_SUPPORT
54 #ifdef CUT_BUFFER_SUPPORT
55 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
56 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
59 Lisp_Object Vx_sent_selection_hooks;
61 /* If this is a smaller number than the max-request-size of the display,
62 emacs will use INCR selection transfer when the selection is larger
63 than this. The max-request-size is usually around 64k, so if you want
64 emacs to use incremental selection transfers when the selection is
65 smaller than that, set this. I added this mostly for debugging the
66 incremental transfer stuff, but it might improve server performance.
68 #define MAX_SELECTION_QUANTUM 0xFFFFFF
70 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize (dpy) << 2) - 100)
72 /* If the selection owner takes too long to reply to a selection request,
73 we give up on it. This is in seconds (0 = no timeout).
75 int x_selection_timeout;
78 /* Utility functions */
80 static void lisp_data_to_selection_data (struct device *,
82 unsigned char **data_ret,
84 unsigned int *size_ret,
86 static Lisp_Object selection_data_to_lisp_data (struct device *,
91 static Lisp_Object x_get_window_property_as_lisp_data (Display *,
94 Lisp_Object target_type,
97 static int expect_property_change (Display *, Window, Atom prop, int state);
98 static void wait_for_property_change (long);
99 static void unexpect_property_change (int);
100 static int waiting_for_other_props_on_window (Display *, Window);
102 /* This converts a Lisp symbol to a server Atom, avoiding a server
103 roundtrip whenever possible.
106 symbol_to_x_atom (struct device *d, Lisp_Object sym, int only_if_exists)
108 Display *display = DEVICE_X_DISPLAY (d);
110 if (NILP (sym)) return XA_PRIMARY;
111 if (EQ (sym, Qt)) return XA_SECONDARY;
112 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
113 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
114 if (EQ (sym, QSTRING)) return XA_STRING;
115 if (EQ (sym, QINTEGER)) return XA_INTEGER;
116 if (EQ (sym, QATOM)) return XA_ATOM;
117 if (EQ (sym, QCLIPBOARD)) return DEVICE_XATOM_CLIPBOARD (d);
118 if (EQ (sym, QTIMESTAMP)) return DEVICE_XATOM_TIMESTAMP (d);
119 if (EQ (sym, QTEXT)) return DEVICE_XATOM_TEXT (d);
120 if (EQ (sym, QDELETE)) return DEVICE_XATOM_DELETE (d);
121 if (EQ (sym, QMULTIPLE)) return DEVICE_XATOM_MULTIPLE (d);
122 if (EQ (sym, QINCR)) return DEVICE_XATOM_INCR (d);
123 if (EQ (sym, QEMACS_TMP)) return DEVICE_XATOM_EMACS_TMP (d);
124 if (EQ (sym, QTARGETS)) return DEVICE_XATOM_TARGETS (d);
125 if (EQ (sym, QNULL)) return DEVICE_XATOM_NULL (d);
126 if (EQ (sym, QATOM_PAIR)) return DEVICE_XATOM_ATOM_PAIR (d);
127 if (EQ (sym, QCOMPOUND_TEXT)) return DEVICE_XATOM_COMPOUND_TEXT (d);
129 #ifdef CUT_BUFFER_SUPPORT
130 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
131 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
132 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
133 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
134 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
135 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
136 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
137 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
138 #endif /* CUT_BUFFER_SUPPORT */
142 GET_C_STRING_CTEXT_DATA_ALLOCA (Fsymbol_name (sym), nameext);
143 return XInternAtom (display, nameext, only_if_exists ? True : False);
148 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
149 and calls to intern whenever possible.
152 x_atom_to_symbol (struct device *d, Atom atom)
154 Display *display = DEVICE_X_DISPLAY (d);
156 if (! atom) return Qnil;
157 if (atom == XA_PRIMARY) return QPRIMARY;
158 if (atom == XA_SECONDARY) return QSECONDARY;
159 if (atom == XA_STRING) return QSTRING;
160 if (atom == XA_INTEGER) return QINTEGER;
161 if (atom == XA_ATOM) return QATOM;
162 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
163 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
164 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
165 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
166 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
167 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
168 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
169 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
170 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
171 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
172 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
174 #ifdef CUT_BUFFER_SUPPORT
175 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
176 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
177 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
178 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
179 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
180 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
181 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
182 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
187 CONST Bufbyte *intstr;
188 char *str = XGetAtomName (display, atom);
190 if (! str) return Qnil;
192 GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA (str, intstr);
193 newsym = intern ((char *) intstr);
200 /* Do protocol to assert ourself as a selection owner.
201 Update the Vselection_alist so that we can reply to later requests for
205 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
207 struct device *d = decode_x_device (Qnil);
208 Display *display = DEVICE_X_DISPLAY (d);
209 struct frame *sel_frame = selected_frame ();
210 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
211 Lisp_Object selection_time;
212 /* Use the time of the last-read mouse or keyboard event.
213 For selection purposes, we use this as a sleazy way of knowing what the
214 current time is in server-time. This assumes that the most recently read
215 mouse or keyboard event has something to do with the assertion of the
216 selection, which is probably true.
218 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
221 CHECK_SYMBOL (selection_name);
222 selection_atom = symbol_to_x_atom (d, selection_name, 0);
224 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
226 /* We do NOT use time_to_lisp() here any more, like we used to.
227 That assumed equivalence of time_t and Time, which is not
228 necessarily the case (e.g. under OSF on the Alphas, where
229 Time is a 64-bit quantity and time_t is a 32-bit quantity).
231 Opaque pointers are the clean way to go here.
233 selection_time = make_opaque (sizeof (thyme), (void *) &thyme);
235 #ifdef MOTIF_CLIPBOARDS
236 hack_motif_clipboard_selection (selection_atom, selection_value,
237 thyme, display, selecting_window);
239 return selection_time;
242 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
244 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
245 static void motif_clipboard_cb ();
249 hack_motif_clipboard_selection (Atom selection_atom,
250 Lisp_Object selection_value,
253 Window selecting_window)
256 struct device *d = get_device_from_display (display);
257 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
258 their own non-Xlib non-Xt clipboard processing. So we have to do
259 this so that linked-in Motif widgets don't get themselves wedged.
261 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
262 && STRINGP (selection_value)
264 /* If we already own the clipboard, don't own it again in the Motif
265 way. This might lose in some subtle way, since the timestamp won't
266 be current, but owning the selection on the Motif way does a
267 SHITLOAD of X protocol, and it makes killing text be incredibly
268 slow when using an X terminal. ARRRRGGGHHH!!!!
270 /* No, this is no good, because then Motif text fields don't bother
271 to look up the new value, and you can't Copy from a buffer, Paste
272 into a text field, then Copy something else from the buffer and
273 paste it into the text field -- it pastes the first thing again. */
277 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
278 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
281 #if XmVersion >= 1002
284 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
287 String encoding = "STRING";
288 CONST Extbyte *data = XSTRING_DATA (selection_value);
289 Extcount bytes = XSTRING_LENGTH (selection_value);
293 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
294 CONST Bufbyte *ptr = data, *end = ptr + bytes;
295 /* Optimize for the common ASCII case */
298 if (BYTE_ASCII_P (*ptr))
304 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
305 (*ptr) == LEADING_BYTE_CONTROL_1)
316 if (chartypes == LATIN_1)
317 GET_STRING_BINARY_DATA_ALLOCA (selection_value, data, bytes);
318 else if (chartypes == WORLD)
320 GET_STRING_CTEXT_DATA_ALLOCA (selection_value, data, bytes);
321 encoding = "COMPOUND_TEXT";
326 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
327 while (ClipboardSuccess !=
328 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
329 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
330 widget, motif_clipboard_cb,
337 while (ClipboardSuccess !=
338 XmClipboardCopy (display, selecting_window, itemid, encoding,
339 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
340 /* O'Reilly examples say size can be 0,
341 but this clearly is not the case. */
342 0, bytes, (int) selecting_window, /* private id */
343 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
344 (XtPointer) data, bytes, 0,
345 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
348 while (ClipboardSuccess !=
349 XmClipboardEndCopy (display, selecting_window, itemid))
354 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
355 /* I tried to treat the clipboard like a real selection, and not send
356 the data until it was requested, but it looks like that just doesn't
357 work at all unless the selection owner and requestor are in different
358 processes. From reading the Motif source, it looks like they never
359 even considered having two widgets in the same application transfer
360 data between each other using "by-name" clipboard values. What a
364 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
368 case XmCR_CLIPBOARD_DATA_REQUEST:
370 Display *dpy = XtDisplay (widget);
371 Window window = (Window) *private_id;
372 Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist);
373 if (NILP (selection)) abort ();
374 selection = XCDR (selection);
375 if (!STRINGP (selection)) abort ();
376 XmClipboardCopyByName (dpy, window, *data_id,
377 (char *) XSTRING_DATA (selection),
378 XSTRING_LENGTH (selection) + 1,
382 case XmCR_CLIPBOARD_DATA_DELETE:
384 /* don't need to free anything */
388 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
389 #endif /* MOTIF_CLIPBOARDS */
394 /* Send a SelectionNotify event to the requestor with property=None, meaning
395 we were unable to do what they wanted.
398 x_decline_selection_request (XSelectionRequestEvent *event)
400 XSelectionEvent reply;
401 reply.type = SelectionNotify;
402 reply.display = event->display;
403 reply.requestor = event->requestor;
404 reply.selection = event->selection;
405 reply.time = event->time;
406 reply.target = event->target;
407 reply.property = None;
409 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
410 XFlush (reply.display);
414 /* Used as an unwind-protect clause so that, if a selection-converter signals
415 an error, we tell the requestor that we were unable to do what they wanted
416 before we throw to top-level or go into the debugger or whatever.
419 x_selection_request_lisp_error (Lisp_Object closure)
421 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
422 get_opaque_ptr (closure);
424 free_opaque_ptr (closure);
425 if (event->type == 0) /* we set this to mean "completed normally" */
427 x_decline_selection_request (event);
432 /* Convert our selection to the requested type, and put that data where the
433 requestor wants it. Then tell them whether we've succeeded.
436 x_reply_selection_request (XSelectionRequestEvent *event, int format,
437 unsigned char *data, int size, Atom type)
439 /* This function can GC */
440 XSelectionEvent reply;
441 Display *display = event->display;
442 struct device *d = get_device_from_display (display);
443 Window window = event->requestor;
445 int format_bytes = format/8;
446 int max_bytes = SELECTION_QUANTUM (display);
447 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
449 reply.type = SelectionNotify;
450 reply.display = display;
451 reply.requestor = window;
452 reply.selection = event->selection;
453 reply.time = event->time;
454 reply.target = event->target;
455 reply.property = (event->property == None ? event->target : event->property);
457 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
459 /* Store the data on the requested property.
460 If the selection is large, only store the first N bytes of it.
462 bytes_remaining = size * format_bytes;
463 if (bytes_remaining <= max_bytes)
465 /* Send all the data at once, with minimal handshaking. */
467 stderr_out ("\nStoring all %d\n", bytes_remaining);
469 XChangeProperty (display, window, reply.property, type, format,
470 PropModeReplace, data, size);
471 /* At this point, the selection was successfully stored; ack it. */
472 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
477 /* Send an INCR selection. */
480 if (x_window_to_frame (d, window)) /* #### debug */
481 error ("attempt to transfer an INCR to ourself!");
483 stderr_out ("\nINCR %d\n", bytes_remaining);
485 prop_id = expect_property_change (display, window, reply.property,
488 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
489 32, PropModeReplace, (unsigned char *)
490 &bytes_remaining, 1);
491 XSelectInput (display, window, PropertyChangeMask);
492 /* Tell 'em the INCR data is there... */
493 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
496 /* First, wait for the requestor to ack by deleting the property.
497 This can run random lisp code (process handlers) or signal.
499 wait_for_property_change (prop_id);
501 while (bytes_remaining)
503 int i = ((bytes_remaining < max_bytes)
506 prop_id = expect_property_change (display, window, reply.property,
509 stderr_out (" INCR adding %d\n", i);
511 /* Append the next chunk of data to the property. */
512 XChangeProperty (display, window, reply.property, type, format,
513 PropModeAppend, data, i / format_bytes);
514 bytes_remaining -= i;
517 /* Now wait for the requestor to ack this chunk by deleting the
518 property. This can run random lisp code or signal.
520 wait_for_property_change (prop_id);
522 /* Now write a zero-length chunk to the property to tell the requestor
525 stderr_out (" INCR done\n");
527 if (! waiting_for_other_props_on_window (display, window))
528 XSelectInput (display, window, 0L);
530 XChangeProperty (display, window, reply.property, type, format,
531 PropModeReplace, data, 0);
537 /* Called from the event-loop in response to a SelectionRequest event.
540 x_handle_selection_request (XSelectionRequestEvent *event)
542 /* This function can GC */
543 struct gcpro gcpro1, gcpro2, gcpro3;
544 Lisp_Object local_selection_data = Qnil;
545 Lisp_Object selection_symbol;
546 Lisp_Object target_symbol = Qnil;
547 Lisp_Object converted_selection = Qnil;
548 Time local_selection_time;
549 Lisp_Object successful_p = Qnil;
551 struct device *d = get_device_from_display (event->display);
553 GCPRO3 (local_selection_data, converted_selection, target_symbol);
555 selection_symbol = x_atom_to_symbol (d, event->selection);
557 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
560 /* This list isn't user-visible, so it can't "go bad." */
561 assert (CONSP (local_selection_data));
562 assert (CONSP (XCDR (local_selection_data)));
563 assert (CONSP (XCDR (XCDR (local_selection_data))));
564 assert (NILP (XCDR (XCDR (XCDR (local_selection_data)))));
565 assert (CONSP (XCAR (XCDR (XCDR (local_selection_data)))));
566 assert (INTP (XCAR (XCAR (XCDR (XCDR (local_selection_data))))));
567 assert (INTP (XCDR (XCAR (XCDR (XCDR (local_selection_data))))));
570 if (NILP (local_selection_data))
572 /* Someone asked for the selection, but we don't have it any more. */
573 x_decline_selection_request (event);
577 local_selection_time =
578 * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
580 if (event->time != CurrentTime &&
581 local_selection_time > event->time)
583 /* Someone asked for the selection, and we have one, but not the one
584 they're looking for. */
585 x_decline_selection_request (event);
589 count = specpdl_depth ();
590 record_unwind_protect (x_selection_request_lisp_error,
591 make_opaque_ptr (event));
592 target_symbol = x_atom_to_symbol (d, event->target);
594 #if 0 /* #### MULTIPLE doesn't work yet */
595 if (EQ (target_symbol, QMULTIPLE))
596 target_symbol = fetch_multiple_target (event);
599 /* Convert lisp objects back into binary data */
601 converted_selection =
602 get_local_selection (selection_symbol, target_symbol);
604 if (! NILP (converted_selection))
610 lisp_data_to_selection_data (d, converted_selection,
611 &data, &type, &size, &format);
613 x_reply_selection_request (event, format, data, size, type);
615 /* Tell x_selection_request_lisp_error() it's cool. */ event->type = 0;
618 unbind_to (count, Qnil);
624 /* Let random lisp code notice that the selection has been asked for. */
627 Lisp_Object val = Vx_sent_selection_hooks;
628 if (!UNBOUNDP (val) && !NILP (val))
630 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
631 for (rest = val; !NILP (rest); rest = Fcdr (rest))
632 call3 (Fcar(rest), selection_symbol, target_symbol,
635 call3 (val, selection_symbol, target_symbol,
642 /* Called from the event-loop in response to a SelectionClear event.
645 x_handle_selection_clear (XSelectionClearEvent *event)
647 Display *display = event->display;
648 struct device *d = get_device_from_display (display);
649 Atom selection = event->selection;
650 Time changed_owner_time = event->time;
652 Lisp_Object selection_symbol, local_selection_data;
653 Time local_selection_time;
655 selection_symbol = x_atom_to_symbol (d, selection);
657 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
659 /* Well, we already believe that we don't own it, so that's just fine. */
660 if (NILP (local_selection_data)) return;
662 local_selection_time =
663 * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
665 /* This SelectionClear is for a selection that we no longer own, so we can
666 disregard it. (That is, we have reasserted the selection since this
667 request was generated.)
669 if (changed_owner_time != CurrentTime &&
670 local_selection_time > changed_owner_time)
673 handle_selection_clear (selection_symbol);
677 /* This stuff is so that INCR selections are reentrant (that is, so we can
678 be servicing multiple INCR selection requests simultaneously). I haven't
679 actually tested that yet.
682 static int prop_location_tick;
684 static struct prop_location {
690 struct prop_location *next;
691 } *for_whom_the_bell_tolls;
695 property_deleted_p (void *tick)
697 struct prop_location *rest = for_whom_the_bell_tolls;
699 if (rest->tick == (long) tick)
707 waiting_for_other_props_on_window (Display *display, Window window)
709 struct prop_location *rest = for_whom_the_bell_tolls;
711 if (rest->display == display && rest->window == window)
720 expect_property_change (Display *display, Window window,
721 Atom property, int state)
723 struct prop_location *pl = xnew (struct prop_location);
724 pl->tick = ++prop_location_tick;
725 pl->display = display;
727 pl->property = property;
728 pl->desired_state = state;
729 pl->next = for_whom_the_bell_tolls;
730 for_whom_the_bell_tolls = pl;
735 unexpect_property_change (int tick)
737 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
740 if (rest->tick == tick)
743 prev->next = rest->next;
745 for_whom_the_bell_tolls = rest->next;
755 wait_for_property_change (long tick)
757 /* This function can GC */
758 wait_delaying_user_input (property_deleted_p, (void *) tick);
762 /* Called from the event-loop in response to a PropertyNotify event.
765 x_handle_property_notify (XPropertyEvent *event)
767 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
770 if (rest->property == event->atom &&
771 rest->window == event->window &&
772 rest->display == event->display &&
773 rest->desired_state == event->state)
776 stderr_out ("Saw expected prop-%s on %s\n",
777 (event->state == PropertyDelete ? "delete" : "change"),
778 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name);
781 prev->next = rest->next;
783 for_whom_the_bell_tolls = rest->next;
791 stderr_out ("Saw UNexpected prop-%s on %s\n",
792 (event->state == PropertyDelete ? "delete" : "change"),
793 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
799 #if 0 /* #### MULTIPLE doesn't work yet */
802 fetch_multiple_target (XSelectionRequestEvent *event)
804 /* This function can GC */
805 Display *display = event->display;
806 Window window = event->requestor;
807 Atom target = event->target;
808 Atom selection_atom = event->selection;
813 x_get_window_property_as_lisp_data (display, window, target,
819 copy_multiple_data (Lisp_Object obj)
825 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
828 len = XVECTOR_LENGTH (obj);
829 vec = make_vector (len, Qnil);
830 for (i = 0; i < len; i++)
832 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
834 if (XVECTOR_LENGTH (vec2) != 2)
835 signal_error (Qerror, list2 (build_string
836 ("vectors must be of length 2"),
838 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
839 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
840 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
848 static Window reading_selection_reply;
849 static Atom reading_which_selection;
850 static int selection_reply_timed_out;
853 selection_reply_done (void *ignore)
855 return !reading_selection_reply;
858 static Lisp_Object Qx_selection_reply_timeout_internal;
860 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
865 selection_reply_timed_out = 1;
866 reading_selection_reply = 0;
871 /* Do protocol to read selection-data from the server.
872 Converts this to lisp data and returns it.
875 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
877 /* This function can GC */
878 struct device *d = decode_x_device (Qnil);
879 Display *display = DEVICE_X_DISPLAY (d);
880 struct frame *sel_frame = selected_frame ();
881 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
882 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
883 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
884 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
886 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
887 XCAR (target_type) : target_type), 0);
889 XConvertSelection (display, selection_atom, type_atom, target_property,
890 requestor_window, requestor_time);
892 /* Block until the reply has been read. */
893 reading_selection_reply = requestor_window;
894 reading_which_selection = selection_atom;
895 selection_reply_timed_out = 0;
897 speccount = specpdl_depth ();
899 /* add a timeout handler */
900 if (x_selection_timeout > 0)
902 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
903 Qx_selection_reply_timeout_internal,
905 record_unwind_protect (Fdisable_timeout, id);
909 wait_delaying_user_input (selection_reply_done, 0);
911 if (selection_reply_timed_out)
912 error ("timed out waiting for reply from selection owner");
914 unbind_to (speccount, Qnil);
916 /* otherwise, the selection is waiting for us on the requested property. */
918 x_get_window_property_as_lisp_data (display, requestor_window,
919 target_property, target_type,
925 x_get_window_property (Display *display, Window window, Atom property,
926 unsigned char **data_ret, int *bytes_ret,
927 Atom *actual_type_ret, int *actual_format_ret,
928 unsigned long *actual_size_ret, int delete_p)
931 unsigned long bytes_remaining;
933 unsigned char *tmp_data = 0;
935 int buffer_size = SELECTION_QUANTUM (display);
936 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
938 /* First probe the thing to find out how big it is. */
939 result = XGetWindowProperty (display, window, property,
940 0, 0, False, AnyPropertyType,
941 actual_type_ret, actual_format_ret,
943 &bytes_remaining, &tmp_data);
944 if (result != Success)
950 XFree ((char *) tmp_data);
952 if (*actual_type_ret == None || *actual_format_ret == 0)
954 if (delete_p) XDeleteProperty (display, window, property);
960 total_size = bytes_remaining + 1;
961 *data_ret = (unsigned char *) xmalloc (total_size);
963 /* Now read, until we've gotten it all. */
964 while (bytes_remaining)
967 int last = bytes_remaining;
970 XGetWindowProperty (display, window, property,
971 offset/4, buffer_size/4,
972 (delete_p ? True : False),
974 actual_type_ret, actual_format_ret,
975 actual_size_ret, &bytes_remaining, &tmp_data);
977 stderr_out ("<< read %d\n", last-bytes_remaining);
979 /* If this doesn't return Success at this point, it means that
980 some clod deleted the selection while we were in the midst of
981 reading it. Deal with that, I guess....
983 if (result != Success) break;
984 *actual_size_ret *= *actual_format_ret / 8;
985 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
986 offset += *actual_size_ret;
987 XFree ((char *) tmp_data);
994 receive_incremental_selection (Display *display, Window window, Atom property,
995 /* this one is for error messages only */
996 Lisp_Object target_type,
997 unsigned int min_size_bytes,
998 unsigned char **data_ret, int *size_bytes_ret,
999 Atom *type_ret, int *format_ret,
1000 unsigned long *size_ret)
1002 /* This function can GC */
1005 *size_bytes_ret = min_size_bytes;
1006 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1008 stderr_out ("\nread INCR %d\n", min_size_bytes);
1010 /* At this point, we have read an INCR property, and deleted it (which
1011 is how we ack its receipt: the sending window will be selecting
1012 PropertyNotify events on our window to notice this).
1014 Now, we must loop, waiting for the sending window to put a value on
1015 that property, then reading the property, then deleting it to ack.
1016 We are done when the sender places a property of length 0.
1018 prop_id = expect_property_change (display, window, property,
1022 unsigned char *tmp_data;
1024 wait_for_property_change (prop_id);
1025 /* expect it again immediately, because x_get_window_property may
1026 .. no it won't, I don't get it.
1027 .. Ok, I get it now, the Xt code that implements INCR is broken.
1029 prop_id = expect_property_change (display, window, property,
1031 x_get_window_property (display, window, property,
1032 &tmp_data, &tmp_size_bytes,
1033 type_ret, format_ret, size_ret, 1);
1035 if (tmp_size_bytes == 0) /* we're done */
1038 stderr_out (" read INCR done\n");
1040 unexpect_property_change (prop_id);
1041 if (tmp_data) xfree (tmp_data);
1045 stderr_out (" read INCR %d\n", tmp_size_bytes);
1047 if (*size_bytes_ret < offset + tmp_size_bytes)
1050 stderr_out (" read INCR realloc %d -> %d\n",
1051 *size_bytes_ret, offset + tmp_size_bytes);
1053 *size_bytes_ret = offset + tmp_size_bytes;
1054 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1056 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1057 offset += tmp_size_bytes;
1064 x_get_window_property_as_lisp_data (Display *display,
1067 /* next two for error messages only */
1068 Lisp_Object target_type,
1069 Atom selection_atom)
1071 /* This function can GC */
1074 unsigned long actual_size;
1075 unsigned char *data = NULL;
1078 struct device *d = get_device_from_display (display);
1080 x_get_window_property (display, window, property, &data, &bytes,
1081 &actual_type, &actual_format, &actual_size, 1);
1084 if (XGetSelectionOwner (display, selection_atom))
1085 /* there is a selection owner */
1087 (Qselection_conversion_error,
1088 Fcons (build_string ("selection owner couldn't convert"),
1089 Fcons (x_atom_to_symbol (d, selection_atom),
1091 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
1092 list1 (target_type))));
1094 signal_error (Qerror,
1095 list2 (build_string ("no selection"),
1096 x_atom_to_symbol (d, selection_atom)));
1099 if (actual_type == DEVICE_XATOM_INCR (d))
1101 /* Ok, that data wasn't *the* data, it was just the beginning. */
1103 unsigned int min_size_bytes = * ((unsigned int *) data);
1105 receive_incremental_selection (display, window, property, target_type,
1106 min_size_bytes, &data, &bytes,
1107 &actual_type, &actual_format,
1111 /* It's been read. Now convert it to a lisp object in some semi-rational
1113 val = selection_data_to_lisp_data (d, data, bytes,
1114 actual_type, actual_format);
1120 /* These functions convert from the selection data read from the server into
1121 something that we can use from elisp, and vice versa.
1123 Type: Format: Size: Elisp Type:
1124 ----- ------- ----- -----------
1127 ATOM 32 > 1 Vector of Symbols
1129 * 16 > 1 Vector of Integers
1130 * 32 1 if <=16 bits: Integer
1131 if > 16 bits: Cons of top16, bot16
1132 * 32 > 1 Vector of the above
1134 When converting a Lisp number to C, it is assumed to be of format 16 if
1135 it is an integer, and of format 32 if it is a cons of two integers.
1137 When converting a vector of numbers from Elisp to C, it is assumed to be
1138 of format 16 if every element in the vector is an integer, and is assumed
1139 to be of format 32 if any element is a cons of two integers.
1141 When converting an object to C, it may be of the form (SYMBOL . <data>)
1142 where SYMBOL is what we should claim that the type is. Format and
1143 representation are as above.
1145 NOTE: Under Mule, when someone shoves us a string without a type, we
1146 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1147 Text. If the string has a type, we assume that the user wants the
1148 data sent as-is so we just do "binary" conversion.
1153 selection_data_to_lisp_data (struct device *d,
1154 unsigned char *data,
1159 if (type == DEVICE_XATOM_NULL (d))
1162 /* Convert any 8-bit data to a string, for compactness. */
1163 else if (format == 8)
1164 return make_ext_string (data, size,
1165 type == DEVICE_XATOM_TEXT (d) ||
1166 type == DEVICE_XATOM_COMPOUND_TEXT (d)
1167 ? FORMAT_CTEXT : FORMAT_BINARY);
1169 /* Convert a single atom to a Lisp Symbol.
1170 Convert a set of atoms to a vector of symbols. */
1171 else if (type == XA_ATOM)
1173 if (size == sizeof (Atom))
1174 return x_atom_to_symbol (d, *((Atom *) data));
1178 int len = size / sizeof (Atom);
1179 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
1180 for (i = 0; i < len; i++)
1181 Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
1186 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1187 If the number is > 16 bits, convert it to a cons of integers,
1188 16 bits in each half.
1190 else if (format == 32 && size == sizeof (long))
1191 return word_to_lisp (((unsigned long *) data) [0]);
1192 else if (format == 16 && size == sizeof (short))
1193 return make_int ((int) (((unsigned short *) data) [0]));
1195 /* Convert any other kind of data to a vector of numbers, represented
1196 as above (as an integer, or a cons of two 16 bit integers).
1198 #### Perhaps we should return the actual type to lisp as well.
1200 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1203 and perhaps it should be
1205 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1208 Right now the fact that the return type was SPAN is discarded before
1209 lisp code gets to see it.
1211 else if (format == 16)
1214 Lisp_Object v = make_vector (size / 4, Qzero);
1215 for (i = 0; i < (int) size / 4; i++)
1217 int j = (int) ((unsigned short *) data) [i];
1218 Faset (v, make_int (i), make_int (j));
1225 Lisp_Object v = make_vector (size / 4, Qzero);
1226 for (i = 0; i < (int) size / 4; i++)
1228 unsigned long j = ((unsigned long *) data) [i];
1229 Faset (v, make_int (i), word_to_lisp (j));
1237 lisp_data_to_selection_data (struct device *d,
1239 unsigned char **data_ret,
1241 unsigned int *size_ret,
1244 Lisp_Object type = Qnil;
1246 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1250 if (CONSP (obj) && NILP (XCDR (obj)))
1254 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1255 { /* This is not the same as declining */
1261 else if (STRINGP (obj))
1263 CONST Extbyte *extval;
1267 GET_STRING_CTEXT_DATA_ALLOCA (obj, extval, extvallen);
1269 GET_STRING_BINARY_DATA_ALLOCA (obj, extval, extvallen);
1271 *size_ret = extvallen;
1272 *data_ret = (unsigned char *) xmalloc (*size_ret);
1273 memcpy (*data_ret, extval, *size_ret);
1275 if (NILP (type)) type = QCOMPOUND_TEXT;
1277 if (NILP (type)) type = QSTRING;
1280 else if (CHARP (obj))
1282 Bufbyte buf[MAX_EMCHAR_LEN];
1284 CONST Extbyte *extval;
1288 len = set_charptr_emchar (buf, XCHAR (obj));
1289 GET_CHARPTR_EXT_CTEXT_DATA_ALLOCA (buf, len, extval, extvallen);
1290 *size_ret = extvallen;
1291 *data_ret = (unsigned char *) xmalloc (*size_ret);
1292 memcpy (*data_ret, extval, *size_ret);
1294 if (NILP (type)) type = QCOMPOUND_TEXT;
1296 if (NILP (type)) type = QSTRING;
1299 else if (SYMBOLP (obj))
1303 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1304 (*data_ret) [sizeof (Atom)] = 0;
1305 (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
1306 if (NILP (type)) type = QATOM;
1308 else if (INTP (obj) &&
1309 XINT (obj) <= 0x7FFF &&
1310 XINT (obj) >= -0x8000)
1314 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1315 (*data_ret) [sizeof (short)] = 0;
1316 (*(short **) data_ret) [0] = (short) XINT (obj);
1317 if (NILP (type)) type = QINTEGER;
1319 else if (INTP (obj) || CONSP (obj))
1323 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1324 (*data_ret) [sizeof (long)] = 0;
1325 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
1326 if (NILP (type)) type = QINTEGER;
1328 else if (VECTORP (obj))
1330 /* Lisp Vectors may represent a set of ATOMs;
1331 a set of 16 or 32 bit INTEGERs;
1332 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1336 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
1337 /* This vector is an ATOM set */
1339 if (NILP (type)) type = QATOM;
1340 *size_ret = XVECTOR_LENGTH (obj);
1342 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1343 for (i = 0; i < (int) (*size_ret); i++)
1344 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
1345 (*(Atom **) data_ret) [i] =
1346 symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
1348 signal_error (Qerror, /* Qselection_error */
1350 ("all elements of the vector must be of the same type"),
1353 #if 0 /* #### MULTIPLE doesn't work yet */
1354 else if (VECTORP (XVECTOR_DATA (obj) [0]))
1355 /* This vector is an ATOM_PAIR set */
1357 if (NILP (type)) type = QATOM_PAIR;
1358 *size_ret = XVECTOR_LENGTH (obj);
1360 *data_ret = (unsigned char *)
1361 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1362 for (i = 0; i < *size_ret; i++)
1363 if (VECTORP (XVECTOR_DATA (obj) [i]))
1365 Lisp_Object pair = XVECTOR_DATA (obj) [i];
1366 if (XVECTOR_LENGTH (pair) != 2)
1367 signal_error (Qerror,
1369 ("elements of the vector must be vectors of exactly two elements"),
1372 (*(Atom **) data_ret) [i * 2] =
1373 symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
1374 (*(Atom **) data_ret) [(i * 2) + 1] =
1375 symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
1378 signal_error (Qerror,
1380 ("all elements of the vector must be of the same type"),
1385 /* This vector is an INTEGER set, or something like it */
1387 *size_ret = XVECTOR_LENGTH (obj);
1388 if (NILP (type)) type = QINTEGER;
1390 for (i = 0; i < (int) (*size_ret); i++)
1391 if (CONSP (XVECTOR_DATA (obj) [i]))
1393 else if (!INTP (XVECTOR_DATA (obj) [i]))
1394 signal_error (Qerror, /* Qselection_error */
1396 ("all elements of the vector must be integers or conses of integers"),
1399 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1400 for (i = 0; i < (int) (*size_ret); i++)
1401 if (*format_ret == 32)
1402 (*((unsigned long **) data_ret)) [i] =
1403 lisp_to_word (XVECTOR_DATA (obj) [i]);
1405 (*((unsigned short **) data_ret)) [i] =
1406 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
1410 signal_error (Qerror, /* Qselection_error */
1411 list2 (build_string ("unrecognized selection data"),
1414 *type_ret = symbol_to_x_atom (d, type, 0);
1419 /* Called from the event loop to handle SelectionNotify events.
1420 I don't think this needs to be reentrant.
1423 x_handle_selection_notify (XSelectionEvent *event)
1425 if (! reading_selection_reply)
1426 message ("received an unexpected SelectionNotify event");
1427 else if (event->requestor != reading_selection_reply)
1428 message ("received a SelectionNotify event for the wrong window");
1429 else if (event->selection != reading_which_selection)
1430 message ("received the wrong selection type in SelectionNotify!");
1432 reading_selection_reply = 0; /* we're done now. */
1436 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
1438 struct device *d = decode_x_device (Qnil);
1439 Display *display = DEVICE_X_DISPLAY (d);
1441 Atom selection_atom;
1443 CHECK_SYMBOL (selection);
1445 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
1448 /* #### This is bogus. See the comment above about problems
1449 on OSF/1 and DEC Alphas. Yet another reason why it sucks
1450 to have the implementation (i.e. cons of two 16-bit
1451 integers) exposed. */
1453 lisp_to_time (timeval, &the_time);
1454 timestamp = (Time) the_time;
1457 selection_atom = symbol_to_x_atom (d, selection, 0);
1459 XSetSelectionOwner (display, selection_atom, None, timestamp);
1463 x_selection_exists_p (Lisp_Object selection)
1465 struct device *d = decode_x_device (Qnil);
1466 Display *dpy = DEVICE_X_DISPLAY (d);
1467 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
1472 #ifdef CUT_BUFFER_SUPPORT
1474 static int cut_buffers_initialized; /* Whether we're sure they all exist */
1476 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1478 initialize_cut_buffers (Display *display, Window window)
1480 static unsigned CONST char * CONST data = (unsigned CONST char *) "";
1481 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1482 PropModeAppend, data, 0)
1483 FROB (XA_CUT_BUFFER0);
1484 FROB (XA_CUT_BUFFER1);
1485 FROB (XA_CUT_BUFFER2);
1486 FROB (XA_CUT_BUFFER3);
1487 FROB (XA_CUT_BUFFER4);
1488 FROB (XA_CUT_BUFFER5);
1489 FROB (XA_CUT_BUFFER6);
1490 FROB (XA_CUT_BUFFER7);
1492 cut_buffers_initialized = 1;
1495 #define CHECK_CUTBUFFER(symbol) \
1496 { CHECK_SYMBOL (symbol); \
1497 if (!EQ((symbol),QCUT_BUFFER0) && !EQ((symbol),QCUT_BUFFER1) && \
1498 !EQ((symbol),QCUT_BUFFER2) && !EQ((symbol),QCUT_BUFFER3) && \
1499 !EQ((symbol),QCUT_BUFFER4) && !EQ((symbol),QCUT_BUFFER5) && \
1500 !EQ((symbol),QCUT_BUFFER6) && !EQ((symbol),QCUT_BUFFER7)) \
1501 signal_error (Qerror, list2 (build_string ("Doesn't name a cutbuffer"), \
1505 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1506 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1510 struct device *d = decode_x_device (Qnil);
1511 Display *display = DEVICE_X_DISPLAY (d);
1512 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1513 Atom cut_buffer_atom;
1514 unsigned char *data;
1521 CHECK_CUTBUFFER (cutbuffer);
1522 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1524 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
1525 &type, &format, &size, 0);
1526 if (!data) return Qnil;
1528 if (format != 8 || type != XA_STRING)
1529 signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data",
1530 x_atom_to_symbol (d, type),
1533 /* We cheat - if the string contains an ESC character, that's
1534 technically not allowed in a STRING, so we assume it's
1535 COMPOUND_TEXT that we stored there ourselves earlier,
1536 in x-store-cutbuffer-internal */
1538 make_ext_string (data, bytes,
1539 memchr (data, 0x1b, bytes) ?
1540 FORMAT_CTEXT : FORMAT_BINARY)
1547 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
1548 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1550 (cutbuffer, string))
1552 struct device *d = decode_x_device (Qnil);
1553 Display *display = DEVICE_X_DISPLAY (d);
1554 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1555 Atom cut_buffer_atom;
1556 CONST Extbyte *data = XSTRING_DATA (string);
1557 Extcount bytes = XSTRING_LENGTH (string);
1558 Extcount bytes_remaining;
1559 int max_bytes = SELECTION_QUANTUM (display);
1561 CONST Bufbyte *ptr, *end;
1562 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1565 if (max_bytes > MAX_SELECTION_QUANTUM)
1566 max_bytes = MAX_SELECTION_QUANTUM;
1568 CHECK_CUTBUFFER (cutbuffer);
1569 CHECK_STRING (string);
1570 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1572 if (! cut_buffers_initialized)
1573 initialize_cut_buffers (display, window);
1575 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1576 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1577 The ICCCM requires that this be so, and other clients assume it,
1578 as we do ourselves in initialize_cut_buffers. */
1581 /* Optimize for the common ASCII case */
1582 for (ptr = data, end = ptr + bytes; ptr <= end; )
1584 if (BYTE_ASCII_P (*ptr))
1590 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
1591 (*ptr) == LEADING_BYTE_CONTROL_1)
1593 chartypes = LATIN_1;
1602 if (chartypes == LATIN_1)
1603 GET_STRING_BINARY_DATA_ALLOCA (string, data, bytes);
1604 else if (chartypes == WORLD)
1605 GET_STRING_CTEXT_DATA_ALLOCA (string, data, bytes);
1608 bytes_remaining = bytes;
1610 while (bytes_remaining)
1612 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1613 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
1614 (bytes_remaining == bytes
1615 ? PropModeReplace : PropModeAppend),
1618 bytes_remaining -= chunk;
1624 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
1625 Rotate the values of the cutbuffers by the given number of steps;
1626 positive means move values forward, negative means backward.
1630 struct device *d = decode_x_device (Qnil);
1631 Display *display = DEVICE_X_DISPLAY (d);
1632 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1638 if (! cut_buffers_initialized)
1639 initialize_cut_buffers (display, window);
1640 props[0] = XA_CUT_BUFFER0;
1641 props[1] = XA_CUT_BUFFER1;
1642 props[2] = XA_CUT_BUFFER2;
1643 props[3] = XA_CUT_BUFFER3;
1644 props[4] = XA_CUT_BUFFER4;
1645 props[5] = XA_CUT_BUFFER5;
1646 props[6] = XA_CUT_BUFFER6;
1647 props[7] = XA_CUT_BUFFER7;
1648 XRotateWindowProperties (display, window, props, 8, XINT (n));
1652 #endif /* CUT_BUFFER_SUPPORT */
1656 /************************************************************************/
1657 /* initialization */
1658 /************************************************************************/
1661 syms_of_xselect (void)
1664 #ifdef CUT_BUFFER_SUPPORT
1665 DEFSUBR (Fx_get_cutbuffer_internal);
1666 DEFSUBR (Fx_store_cutbuffer_internal);
1667 DEFSUBR (Fx_rotate_cutbuffers_internal);
1668 #endif /* CUT_BUFFER_SUPPORT */
1670 /* Unfortunately, timeout handlers must be lisp functions. */
1671 defsymbol (&Qx_selection_reply_timeout_internal,
1672 "x-selection-reply-timeout-internal");
1673 DEFSUBR (Fx_selection_reply_timeout_internal);
1675 #ifdef CUT_BUFFER_SUPPORT
1676 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
1677 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
1678 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
1679 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
1680 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
1681 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
1682 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
1683 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
1684 #endif /* CUT_BUFFER_SUPPORT */
1688 console_type_create_select_x (void)
1690 CONSOLE_HAS_METHOD (x, own_selection);
1691 CONSOLE_HAS_METHOD (x, disown_selection);
1692 CONSOLE_HAS_METHOD (x, get_foreign_selection);
1693 CONSOLE_HAS_METHOD (x, selection_exists_p);
1697 vars_of_xselect (void)
1699 #ifdef CUT_BUFFER_SUPPORT
1700 cut_buffers_initialized = 0;
1701 Fprovide (intern ("cut-buffer"));
1704 reading_selection_reply = 0;
1705 reading_which_selection = 0;
1706 selection_reply_timed_out = 0;
1707 for_whom_the_bell_tolls = 0;
1708 prop_location_tick = 0;
1710 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
1711 A function or functions to be called after we have responded to some
1712 other client's request for the value of a selection that we own. The
1713 function(s) will be called with four arguments:
1714 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1715 - the name of the selection-type which we were requested to convert the
1716 selection into before sending (for example, STRING or LENGTH);
1717 - and whether we successfully transmitted the selection.
1718 We might have failed (and declined the request) for any number of reasons,
1719 including being asked for a selection that we no longer own, or being asked
1720 to convert into a type that we don't know about or that is inappropriate.
1721 This hook doesn't let you change the behavior of emacs's selection replies,
1722 it merely informs you that they have happened.
1724 Vx_sent_selection_hooks = Qunbound;
1726 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
1727 If the selection owner doesn't reply in this many seconds, we give up.
1728 A value of 0 means wait as long as necessary. This is initialized from the
1729 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1731 x_selection_timeout = 0;
1735 Xatoms_of_xselect (struct device *d)
1737 Display *D = DEVICE_X_DISPLAY (d);
1739 /* Non-predefined atoms that we might end up using a lot */
1740 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
1741 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
1742 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
1743 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
1744 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
1745 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
1746 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
1747 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
1748 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
1749 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
1750 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);