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 TO_EXTERNAL_FORMAT (LISP_STRING, Fsymbol_name (sym),
143 C_STRING_ALLOCA, nameext,
145 return XInternAtom (display, nameext, only_if_exists ? True : False);
150 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
151 and calls to intern whenever possible.
154 x_atom_to_symbol (struct device *d, Atom atom)
156 Display *display = DEVICE_X_DISPLAY (d);
158 if (! atom) return Qnil;
159 if (atom == XA_PRIMARY) return QPRIMARY;
160 if (atom == XA_SECONDARY) return QSECONDARY;
161 if (atom == XA_STRING) return QSTRING;
162 if (atom == XA_INTEGER) return QINTEGER;
163 if (atom == XA_ATOM) return QATOM;
164 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
165 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
166 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
167 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
168 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
169 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
170 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
171 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
172 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
173 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
174 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
176 #ifdef CUT_BUFFER_SUPPORT
177 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
178 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
179 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
180 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
181 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
182 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
183 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
184 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
189 char *str = XGetAtomName (display, atom);
191 if (! str) return Qnil;
193 TO_INTERNAL_FORMAT (C_STRING, str,
194 C_STRING_ALLOCA, intstr,
197 return intern (intstr);
202 /* Do protocol to assert ourself as a selection owner.
203 Update the Vselection_alist so that we can reply to later requests for
207 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value)
209 struct device *d = decode_x_device (Qnil);
210 Display *display = DEVICE_X_DISPLAY (d);
211 struct frame *sel_frame = selected_frame ();
212 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
213 Lisp_Object selection_time;
214 /* Use the time of the last-read mouse or keyboard event.
215 For selection purposes, we use this as a sleazy way of knowing what the
216 current time is in server-time. This assumes that the most recently read
217 mouse or keyboard event has something to do with the assertion of the
218 selection, which is probably true.
220 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
223 CHECK_SYMBOL (selection_name);
224 selection_atom = symbol_to_x_atom (d, selection_name, 0);
226 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
228 /* We do NOT use time_to_lisp() here any more, like we used to.
229 That assumed equivalence of time_t and Time, which is not
230 necessarily the case (e.g. under OSF on the Alphas, where
231 Time is a 64-bit quantity and time_t is a 32-bit quantity).
233 Opaque pointers are the clean way to go here.
235 selection_time = make_opaque (&thyme, sizeof (thyme));
237 #ifdef MOTIF_CLIPBOARDS
238 hack_motif_clipboard_selection (selection_atom, selection_value,
239 thyme, display, selecting_window);
241 return selection_time;
244 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
246 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
247 static void motif_clipboard_cb ();
251 hack_motif_clipboard_selection (Atom selection_atom,
252 Lisp_Object selection_value,
255 Window selecting_window)
258 struct device *d = get_device_from_display (display);
259 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
260 their own non-Xlib non-Xt clipboard processing. So we have to do
261 this so that linked-in Motif widgets don't get themselves wedged.
263 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
264 && STRINGP (selection_value)
266 /* If we already own the clipboard, don't own it again in the Motif
267 way. This might lose in some subtle way, since the timestamp won't
268 be current, but owning the selection on the Motif way does a
269 SHITLOAD of X protocol, and it makes killing text be incredibly
270 slow when using an X terminal. ARRRRGGGHHH!!!!
272 /* No, this is no good, because then Motif text fields don't bother
273 to look up the new value, and you can't Copy from a buffer, Paste
274 into a text field, then Copy something else from the buffer and
275 paste it into the text field -- it pastes the first thing again. */
279 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
280 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
283 #if XmVersion >= 1002
286 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
289 String encoding = "STRING";
290 const Extbyte *data = XSTRING_DATA (selection_value);
291 Extcount bytes = XSTRING_LENGTH (selection_value);
295 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
296 const Bufbyte *ptr = data, *end = ptr + bytes;
297 /* Optimize for the common ASCII case */
300 if (BYTE_ASCII_P (*ptr))
306 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
307 (*ptr) == LEADING_BYTE_CONTROL_1)
318 if (chartypes == LATIN_1)
319 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
320 ALLOCA, (data, bytes),
322 else if (chartypes == WORLD)
324 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
325 ALLOCA, (data, bytes),
327 encoding = "COMPOUND_TEXT";
332 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
333 while (ClipboardSuccess !=
334 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
335 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
336 widget, motif_clipboard_cb,
343 while (ClipboardSuccess !=
344 XmClipboardCopy (display, selecting_window, itemid, encoding,
345 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
346 /* O'Reilly examples say size can be 0,
347 but this clearly is not the case. */
348 0, bytes, (int) selecting_window, /* private id */
349 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
350 (XtPointer) data, bytes, 0,
351 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
354 while (ClipboardSuccess !=
355 XmClipboardEndCopy (display, selecting_window, itemid))
360 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
361 /* I tried to treat the clipboard like a real selection, and not send
362 the data until it was requested, but it looks like that just doesn't
363 work at all unless the selection owner and requestor are in different
364 processes. From reading the Motif source, it looks like they never
365 even considered having two widgets in the same application transfer
366 data between each other using "by-name" clipboard values. What a
370 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
374 case XmCR_CLIPBOARD_DATA_REQUEST:
376 Display *dpy = XtDisplay (widget);
377 Window window = (Window) *private_id;
378 Lisp_Object selection = assq_no_quit (QCLIPBOARD, Vselection_alist);
379 if (NILP (selection)) abort ();
380 selection = XCDR (selection);
381 if (!STRINGP (selection)) abort ();
382 XmClipboardCopyByName (dpy, window, *data_id,
383 (char *) XSTRING_DATA (selection),
384 XSTRING_LENGTH (selection) + 1,
388 case XmCR_CLIPBOARD_DATA_DELETE:
390 /* don't need to free anything */
394 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
395 #endif /* MOTIF_CLIPBOARDS */
400 /* Send a SelectionNotify event to the requestor with property=None, meaning
401 we were unable to do what they wanted.
404 x_decline_selection_request (XSelectionRequestEvent *event)
406 XSelectionEvent reply;
407 reply.type = SelectionNotify;
408 reply.display = event->display;
409 reply.requestor = event->requestor;
410 reply.selection = event->selection;
411 reply.time = event->time;
412 reply.target = event->target;
413 reply.property = None;
415 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
416 XFlush (reply.display);
420 /* Used as an unwind-protect clause so that, if a selection-converter signals
421 an error, we tell the requestor that we were unable to do what they wanted
422 before we throw to top-level or go into the debugger or whatever.
425 x_selection_request_lisp_error (Lisp_Object closure)
427 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
428 get_opaque_ptr (closure);
430 free_opaque_ptr (closure);
431 if (event->type == 0) /* we set this to mean "completed normally" */
433 x_decline_selection_request (event);
438 /* Convert our selection to the requested type, and put that data where the
439 requestor wants it. Then tell them whether we've succeeded.
442 x_reply_selection_request (XSelectionRequestEvent *event, int format,
443 unsigned char *data, int size, Atom type)
445 /* This function can GC */
446 XSelectionEvent reply;
447 Display *display = event->display;
448 struct device *d = get_device_from_display (display);
449 Window window = event->requestor;
451 int format_bytes = format/8;
452 int max_bytes = SELECTION_QUANTUM (display);
453 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
455 reply.type = SelectionNotify;
456 reply.display = display;
457 reply.requestor = window;
458 reply.selection = event->selection;
459 reply.time = event->time;
460 reply.target = event->target;
461 reply.property = (event->property == None ? event->target : event->property);
463 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
465 /* Store the data on the requested property.
466 If the selection is large, only store the first N bytes of it.
468 bytes_remaining = size * format_bytes;
469 if (bytes_remaining <= max_bytes)
471 /* Send all the data at once, with minimal handshaking. */
473 stderr_out ("\nStoring all %d\n", bytes_remaining);
475 XChangeProperty (display, window, reply.property, type, format,
476 PropModeReplace, data, size);
477 /* At this point, the selection was successfully stored; ack it. */
478 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
483 /* Send an INCR selection. */
486 if (x_window_to_frame (d, window)) /* #### debug */
487 error ("attempt to transfer an INCR to ourself!");
489 stderr_out ("\nINCR %d\n", bytes_remaining);
491 prop_id = expect_property_change (display, window, reply.property,
494 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
495 32, PropModeReplace, (unsigned char *)
496 &bytes_remaining, 1);
497 XSelectInput (display, window, PropertyChangeMask);
498 /* Tell 'em the INCR data is there... */
499 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
502 /* First, wait for the requestor to ack by deleting the property.
503 This can run random lisp code (process handlers) or signal.
505 wait_for_property_change (prop_id);
507 while (bytes_remaining)
509 int i = ((bytes_remaining < max_bytes)
512 prop_id = expect_property_change (display, window, reply.property,
515 stderr_out (" INCR adding %d\n", i);
517 /* Append the next chunk of data to the property. */
518 XChangeProperty (display, window, reply.property, type, format,
519 PropModeAppend, data, i / format_bytes);
520 bytes_remaining -= i;
523 /* Now wait for the requestor to ack this chunk by deleting the
524 property. This can run random lisp code or signal.
526 wait_for_property_change (prop_id);
528 /* Now write a zero-length chunk to the property to tell the requestor
531 stderr_out (" INCR done\n");
533 if (! waiting_for_other_props_on_window (display, window))
534 XSelectInput (display, window, 0L);
536 XChangeProperty (display, window, reply.property, type, format,
537 PropModeReplace, data, 0);
543 /* Called from the event-loop in response to a SelectionRequest event.
546 x_handle_selection_request (XSelectionRequestEvent *event)
548 /* This function can GC */
549 struct gcpro gcpro1, gcpro2, gcpro3;
550 Lisp_Object local_selection_data = Qnil;
551 Lisp_Object selection_symbol;
552 Lisp_Object target_symbol = Qnil;
553 Lisp_Object converted_selection = Qnil;
554 Time local_selection_time;
555 Lisp_Object successful_p = Qnil;
557 struct device *d = get_device_from_display (event->display);
559 GCPRO3 (local_selection_data, converted_selection, target_symbol);
561 selection_symbol = x_atom_to_symbol (d, event->selection);
563 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
566 /* This list isn't user-visible, so it can't "go bad." */
567 assert (CONSP (local_selection_data));
568 assert (CONSP (XCDR (local_selection_data)));
569 assert (CONSP (XCDR (XCDR (local_selection_data))));
570 assert (NILP (XCDR (XCDR (XCDR (local_selection_data)))));
571 assert (CONSP (XCAR (XCDR (XCDR (local_selection_data)))));
572 assert (INTP (XCAR (XCAR (XCDR (XCDR (local_selection_data))))));
573 assert (INTP (XCDR (XCAR (XCDR (XCDR (local_selection_data))))));
576 if (NILP (local_selection_data))
578 /* Someone asked for the selection, but we don't have it any more. */
579 x_decline_selection_request (event);
583 local_selection_time =
584 * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
586 if (event->time != CurrentTime &&
587 local_selection_time > event->time)
589 /* Someone asked for the selection, and we have one, but not the one
590 they're looking for. */
591 x_decline_selection_request (event);
595 count = specpdl_depth ();
596 record_unwind_protect (x_selection_request_lisp_error,
597 make_opaque_ptr (event));
598 target_symbol = x_atom_to_symbol (d, event->target);
600 #if 0 /* #### MULTIPLE doesn't work yet */
601 if (EQ (target_symbol, QMULTIPLE))
602 target_symbol = fetch_multiple_target (event);
605 /* Convert lisp objects back into binary data */
607 converted_selection =
608 get_local_selection (selection_symbol, target_symbol);
610 if (! NILP (converted_selection))
616 lisp_data_to_selection_data (d, converted_selection,
617 &data, &type, &size, &format);
619 x_reply_selection_request (event, format, data, size, type);
621 /* Tell x_selection_request_lisp_error() it's cool. */ event->type = 0;
624 unbind_to (count, Qnil);
630 /* Let random lisp code notice that the selection has been asked for. */
633 Lisp_Object val = Vx_sent_selection_hooks;
634 if (!UNBOUNDP (val) && !NILP (val))
636 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
637 for (rest = val; !NILP (rest); rest = Fcdr (rest))
638 call3 (Fcar(rest), selection_symbol, target_symbol,
641 call3 (val, selection_symbol, target_symbol,
648 /* Called from the event-loop in response to a SelectionClear event.
651 x_handle_selection_clear (XSelectionClearEvent *event)
653 Display *display = event->display;
654 struct device *d = get_device_from_display (display);
655 Atom selection = event->selection;
656 Time changed_owner_time = event->time;
658 Lisp_Object selection_symbol, local_selection_data;
659 Time local_selection_time;
661 selection_symbol = x_atom_to_symbol (d, selection);
663 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
665 /* Well, we already believe that we don't own it, so that's just fine. */
666 if (NILP (local_selection_data)) return;
668 local_selection_time =
669 * (Time *) XOPAQUE_DATA (XCAR (XCDR (XCDR (local_selection_data))));
671 /* This SelectionClear is for a selection that we no longer own, so we can
672 disregard it. (That is, we have reasserted the selection since this
673 request was generated.)
675 if (changed_owner_time != CurrentTime &&
676 local_selection_time > changed_owner_time)
679 handle_selection_clear (selection_symbol);
683 /* This stuff is so that INCR selections are reentrant (that is, so we can
684 be servicing multiple INCR selection requests simultaneously). I haven't
685 actually tested that yet.
688 static int prop_location_tick;
690 static struct prop_location {
696 struct prop_location *next;
697 } *for_whom_the_bell_tolls;
701 property_deleted_p (void *tick)
703 struct prop_location *rest = for_whom_the_bell_tolls;
705 if (rest->tick == (long) tick)
713 waiting_for_other_props_on_window (Display *display, Window window)
715 struct prop_location *rest = for_whom_the_bell_tolls;
717 if (rest->display == display && rest->window == window)
726 expect_property_change (Display *display, Window window,
727 Atom property, int state)
729 struct prop_location *pl = xnew (struct prop_location);
730 pl->tick = ++prop_location_tick;
731 pl->display = display;
733 pl->property = property;
734 pl->desired_state = state;
735 pl->next = for_whom_the_bell_tolls;
736 for_whom_the_bell_tolls = pl;
741 unexpect_property_change (int tick)
743 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
746 if (rest->tick == tick)
749 prev->next = rest->next;
751 for_whom_the_bell_tolls = rest->next;
761 wait_for_property_change (long tick)
763 /* This function can GC */
764 wait_delaying_user_input (property_deleted_p, (void *) tick);
768 /* Called from the event-loop in response to a PropertyNotify event.
771 x_handle_property_notify (XPropertyEvent *event)
773 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
776 if (rest->property == event->atom &&
777 rest->window == event->window &&
778 rest->display == event->display &&
779 rest->desired_state == event->state)
782 stderr_out ("Saw expected prop-%s on %s\n",
783 (event->state == PropertyDelete ? "delete" : "change"),
784 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name);
787 prev->next = rest->next;
789 for_whom_the_bell_tolls = rest->next;
797 stderr_out ("Saw UNexpected prop-%s on %s\n",
798 (event->state == PropertyDelete ? "delete" : "change"),
799 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
805 #if 0 /* #### MULTIPLE doesn't work yet */
808 fetch_multiple_target (XSelectionRequestEvent *event)
810 /* This function can GC */
811 Display *display = event->display;
812 Window window = event->requestor;
813 Atom target = event->target;
814 Atom selection_atom = event->selection;
819 x_get_window_property_as_lisp_data (display, window, target,
825 copy_multiple_data (Lisp_Object obj)
831 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
834 len = XVECTOR_LENGTH (obj);
835 vec = make_vector (len, Qnil);
836 for (i = 0; i < len; i++)
838 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
840 if (XVECTOR_LENGTH (vec2) != 2)
841 signal_error (Qerror, list2 (build_string
842 ("vectors must be of length 2"),
844 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
845 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
846 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
854 static Window reading_selection_reply;
855 static Atom reading_which_selection;
856 static int selection_reply_timed_out;
859 selection_reply_done (void *ignore)
861 return !reading_selection_reply;
864 static Lisp_Object Qx_selection_reply_timeout_internal;
866 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
871 selection_reply_timed_out = 1;
872 reading_selection_reply = 0;
877 /* Do protocol to read selection-data from the server.
878 Converts this to lisp data and returns it.
881 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
883 /* This function can GC */
884 struct device *d = decode_x_device (Qnil);
885 Display *display = DEVICE_X_DISPLAY (d);
886 struct frame *sel_frame = selected_frame ();
887 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
888 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
889 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
890 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
892 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
893 XCAR (target_type) : target_type), 0);
895 XConvertSelection (display, selection_atom, type_atom, target_property,
896 requestor_window, requestor_time);
898 /* Block until the reply has been read. */
899 reading_selection_reply = requestor_window;
900 reading_which_selection = selection_atom;
901 selection_reply_timed_out = 0;
903 speccount = specpdl_depth ();
905 /* add a timeout handler */
906 if (x_selection_timeout > 0)
908 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
909 Qx_selection_reply_timeout_internal,
911 record_unwind_protect (Fdisable_timeout, id);
915 wait_delaying_user_input (selection_reply_done, 0);
917 if (selection_reply_timed_out)
918 error ("timed out waiting for reply from selection owner");
920 unbind_to (speccount, Qnil);
922 /* otherwise, the selection is waiting for us on the requested property. */
924 x_get_window_property_as_lisp_data (display, requestor_window,
925 target_property, target_type,
931 x_get_window_property (Display *display, Window window, Atom property,
932 unsigned char **data_ret, int *bytes_ret,
933 Atom *actual_type_ret, int *actual_format_ret,
934 unsigned long *actual_size_ret, int delete_p)
937 unsigned long bytes_remaining;
939 unsigned char *tmp_data = 0;
941 int buffer_size = SELECTION_QUANTUM (display);
942 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
944 /* First probe the thing to find out how big it is. */
945 result = XGetWindowProperty (display, window, property,
946 0, 0, False, AnyPropertyType,
947 actual_type_ret, actual_format_ret,
949 &bytes_remaining, &tmp_data);
950 if (result != Success)
956 XFree ((char *) tmp_data);
958 if (*actual_type_ret == None || *actual_format_ret == 0)
960 if (delete_p) XDeleteProperty (display, window, property);
966 total_size = bytes_remaining + 1;
967 *data_ret = (unsigned char *) xmalloc (total_size);
969 /* Now read, until we've gotten it all. */
970 while (bytes_remaining)
973 int last = bytes_remaining;
976 XGetWindowProperty (display, window, property,
977 offset/4, buffer_size/4,
978 (delete_p ? True : False),
980 actual_type_ret, actual_format_ret,
981 actual_size_ret, &bytes_remaining, &tmp_data);
983 stderr_out ("<< read %d\n", last-bytes_remaining);
985 /* If this doesn't return Success at this point, it means that
986 some clod deleted the selection while we were in the midst of
987 reading it. Deal with that, I guess....
989 if (result != Success) break;
990 *actual_size_ret *= *actual_format_ret / 8;
991 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
992 offset += *actual_size_ret;
993 XFree ((char *) tmp_data);
1000 receive_incremental_selection (Display *display, Window window, Atom property,
1001 /* this one is for error messages only */
1002 Lisp_Object target_type,
1003 unsigned int min_size_bytes,
1004 unsigned char **data_ret, int *size_bytes_ret,
1005 Atom *type_ret, int *format_ret,
1006 unsigned long *size_ret)
1008 /* This function can GC */
1011 *size_bytes_ret = min_size_bytes;
1012 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1014 stderr_out ("\nread INCR %d\n", min_size_bytes);
1016 /* At this point, we have read an INCR property, and deleted it (which
1017 is how we ack its receipt: the sending window will be selecting
1018 PropertyNotify events on our window to notice this).
1020 Now, we must loop, waiting for the sending window to put a value on
1021 that property, then reading the property, then deleting it to ack.
1022 We are done when the sender places a property of length 0.
1024 prop_id = expect_property_change (display, window, property,
1028 unsigned char *tmp_data;
1030 wait_for_property_change (prop_id);
1031 /* expect it again immediately, because x_get_window_property may
1032 .. no it won't, I don't get it.
1033 .. Ok, I get it now, the Xt code that implements INCR is broken.
1035 prop_id = expect_property_change (display, window, property,
1037 x_get_window_property (display, window, property,
1038 &tmp_data, &tmp_size_bytes,
1039 type_ret, format_ret, size_ret, 1);
1041 if (tmp_size_bytes == 0) /* we're done */
1044 stderr_out (" read INCR done\n");
1046 unexpect_property_change (prop_id);
1047 if (tmp_data) xfree (tmp_data);
1051 stderr_out (" read INCR %d\n", tmp_size_bytes);
1053 if (*size_bytes_ret < offset + tmp_size_bytes)
1056 stderr_out (" read INCR realloc %d -> %d\n",
1057 *size_bytes_ret, offset + tmp_size_bytes);
1059 *size_bytes_ret = offset + tmp_size_bytes;
1060 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1062 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1063 offset += tmp_size_bytes;
1070 x_get_window_property_as_lisp_data (Display *display,
1073 /* next two for error messages only */
1074 Lisp_Object target_type,
1075 Atom selection_atom)
1077 /* This function can GC */
1080 unsigned long actual_size;
1081 unsigned char *data = NULL;
1084 struct device *d = get_device_from_display (display);
1086 x_get_window_property (display, window, property, &data, &bytes,
1087 &actual_type, &actual_format, &actual_size, 1);
1090 if (XGetSelectionOwner (display, selection_atom))
1091 /* there is a selection owner */
1093 (Qselection_conversion_error,
1094 Fcons (build_string ("selection owner couldn't convert"),
1095 Fcons (x_atom_to_symbol (d, selection_atom),
1097 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
1098 list1 (target_type))));
1100 signal_error (Qerror,
1101 list2 (build_string ("no selection"),
1102 x_atom_to_symbol (d, selection_atom)));
1105 if (actual_type == DEVICE_XATOM_INCR (d))
1107 /* Ok, that data wasn't *the* data, it was just the beginning. */
1109 unsigned int min_size_bytes = * ((unsigned int *) data);
1111 receive_incremental_selection (display, window, property, target_type,
1112 min_size_bytes, &data, &bytes,
1113 &actual_type, &actual_format,
1117 /* It's been read. Now convert it to a lisp object in some semi-rational
1119 val = selection_data_to_lisp_data (d, data, bytes,
1120 actual_type, actual_format);
1126 /* These functions convert from the selection data read from the server into
1127 something that we can use from elisp, and vice versa.
1129 Type: Format: Size: Elisp Type:
1130 ----- ------- ----- -----------
1133 ATOM 32 > 1 Vector of Symbols
1135 * 16 > 1 Vector of Integers
1136 * 32 1 if <=16 bits: Integer
1137 if > 16 bits: Cons of top16, bot16
1138 * 32 > 1 Vector of the above
1140 When converting a Lisp number to C, it is assumed to be of format 16 if
1141 it is an integer, and of format 32 if it is a cons of two integers.
1143 When converting a vector of numbers from Elisp to C, it is assumed to be
1144 of format 16 if every element in the vector is an integer, and is assumed
1145 to be of format 32 if any element is a cons of two integers.
1147 When converting an object to C, it may be of the form (SYMBOL . <data>)
1148 where SYMBOL is what we should claim that the type is. Format and
1149 representation are as above.
1151 NOTE: Under Mule, when someone shoves us a string without a type, we
1152 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1153 Text. If the string has a type, we assume that the user wants the
1154 data sent as-is so we just do "binary" conversion.
1159 selection_data_to_lisp_data (struct device *d,
1160 unsigned char *data,
1165 if (type == DEVICE_XATOM_NULL (d))
1168 /* Convert any 8-bit data to a string, for compactness. */
1169 else if (format == 8)
1170 return make_ext_string (data, size,
1171 type == DEVICE_XATOM_TEXT (d) ||
1172 type == DEVICE_XATOM_COMPOUND_TEXT (d)
1173 ? Qctext : Qbinary);
1175 /* Convert a single atom to a Lisp Symbol.
1176 Convert a set of atoms to a vector of symbols. */
1177 else if (type == XA_ATOM)
1179 if (size == sizeof (Atom))
1180 return x_atom_to_symbol (d, *((Atom *) data));
1184 int len = size / sizeof (Atom);
1185 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
1186 for (i = 0; i < len; i++)
1187 Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
1192 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1193 If the number is > 16 bits, convert it to a cons of integers,
1194 16 bits in each half.
1196 else if (format == 32 && size == sizeof (long))
1197 return word_to_lisp (((unsigned long *) data) [0]);
1198 else if (format == 16 && size == sizeof (short))
1199 return make_int ((int) (((unsigned short *) data) [0]));
1201 /* Convert any other kind of data to a vector of numbers, represented
1202 as above (as an integer, or a cons of two 16 bit integers).
1204 #### Perhaps we should return the actual type to lisp as well.
1206 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1209 and perhaps it should be
1211 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1214 Right now the fact that the return type was SPAN is discarded before
1215 lisp code gets to see it.
1217 else if (format == 16)
1220 Lisp_Object v = make_vector (size / 4, Qzero);
1221 for (i = 0; i < (int) size / 4; i++)
1223 int j = (int) ((unsigned short *) data) [i];
1224 Faset (v, make_int (i), make_int (j));
1231 Lisp_Object v = make_vector (size / 4, Qzero);
1232 for (i = 0; i < (int) size / 4; i++)
1234 unsigned long j = ((unsigned long *) data) [i];
1235 Faset (v, make_int (i), word_to_lisp (j));
1243 lisp_data_to_selection_data (struct device *d,
1245 unsigned char **data_ret,
1247 unsigned int *size_ret,
1250 Lisp_Object type = Qnil;
1252 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1256 if (CONSP (obj) && NILP (XCDR (obj)))
1260 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1261 { /* This is not the same as declining */
1267 else if (STRINGP (obj))
1269 const Extbyte *extval;
1272 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
1273 ALLOCA, (extval, extvallen),
1274 (NILP (type) ? Qctext : Qbinary));
1276 *size_ret = extvallen;
1277 *data_ret = (unsigned char *) xmalloc (*size_ret);
1278 memcpy (*data_ret, extval, *size_ret);
1280 if (NILP (type)) type = QCOMPOUND_TEXT;
1282 if (NILP (type)) type = QSTRING;
1285 else if (CHARP (obj))
1287 Bufbyte buf[MAX_EMCHAR_LEN];
1289 const Extbyte *extval;
1293 len = set_charptr_emchar (buf, XCHAR (obj));
1294 TO_EXTERNAL_FORMAT (DATA, (buf, len),
1295 ALLOCA, (extval, extvallen),
1297 *size_ret = extvallen;
1298 *data_ret = (unsigned char *) xmalloc (*size_ret);
1299 memcpy (*data_ret, extval, *size_ret);
1301 if (NILP (type)) type = QCOMPOUND_TEXT;
1303 if (NILP (type)) type = QSTRING;
1306 else if (SYMBOLP (obj))
1310 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1311 (*data_ret) [sizeof (Atom)] = 0;
1312 (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
1313 if (NILP (type)) type = QATOM;
1315 else if (INTP (obj) &&
1316 XINT (obj) <= 0x7FFF &&
1317 XINT (obj) >= -0x8000)
1321 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1322 (*data_ret) [sizeof (short)] = 0;
1323 (*(short **) data_ret) [0] = (short) XINT (obj);
1324 if (NILP (type)) type = QINTEGER;
1326 else if (INTP (obj) || CONSP (obj))
1330 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1331 (*data_ret) [sizeof (long)] = 0;
1332 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
1333 if (NILP (type)) type = QINTEGER;
1335 else if (VECTORP (obj))
1337 /* Lisp Vectors may represent a set of ATOMs;
1338 a set of 16 or 32 bit INTEGERs;
1339 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1343 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
1344 /* This vector is an ATOM set */
1346 if (NILP (type)) type = QATOM;
1347 *size_ret = XVECTOR_LENGTH (obj);
1349 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1350 for (i = 0; i < (int) (*size_ret); i++)
1351 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
1352 (*(Atom **) data_ret) [i] =
1353 symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
1355 signal_error (Qerror, /* Qselection_error */
1357 ("all elements of the vector must be of the same type"),
1360 #if 0 /* #### MULTIPLE doesn't work yet */
1361 else if (VECTORP (XVECTOR_DATA (obj) [0]))
1362 /* This vector is an ATOM_PAIR set */
1364 if (NILP (type)) type = QATOM_PAIR;
1365 *size_ret = XVECTOR_LENGTH (obj);
1367 *data_ret = (unsigned char *)
1368 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1369 for (i = 0; i < *size_ret; i++)
1370 if (VECTORP (XVECTOR_DATA (obj) [i]))
1372 Lisp_Object pair = XVECTOR_DATA (obj) [i];
1373 if (XVECTOR_LENGTH (pair) != 2)
1374 signal_error (Qerror,
1376 ("elements of the vector must be vectors of exactly two elements"),
1379 (*(Atom **) data_ret) [i * 2] =
1380 symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
1381 (*(Atom **) data_ret) [(i * 2) + 1] =
1382 symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
1385 signal_error (Qerror,
1387 ("all elements of the vector must be of the same type"),
1392 /* This vector is an INTEGER set, or something like it */
1394 *size_ret = XVECTOR_LENGTH (obj);
1395 if (NILP (type)) type = QINTEGER;
1397 for (i = 0; i < (int) (*size_ret); i++)
1398 if (CONSP (XVECTOR_DATA (obj) [i]))
1400 else if (!INTP (XVECTOR_DATA (obj) [i]))
1401 signal_error (Qerror, /* Qselection_error */
1403 ("all elements of the vector must be integers or conses of integers"),
1406 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1407 for (i = 0; i < (int) (*size_ret); i++)
1408 if (*format_ret == 32)
1409 (*((unsigned long **) data_ret)) [i] =
1410 lisp_to_word (XVECTOR_DATA (obj) [i]);
1412 (*((unsigned short **) data_ret)) [i] =
1413 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
1417 signal_error (Qerror, /* Qselection_error */
1418 list2 (build_string ("unrecognized selection data"),
1421 *type_ret = symbol_to_x_atom (d, type, 0);
1426 /* Called from the event loop to handle SelectionNotify events.
1427 I don't think this needs to be reentrant.
1430 x_handle_selection_notify (XSelectionEvent *event)
1432 if (! reading_selection_reply)
1433 message ("received an unexpected SelectionNotify event");
1434 else if (event->requestor != reading_selection_reply)
1435 message ("received a SelectionNotify event for the wrong window");
1436 else if (event->selection != reading_which_selection)
1437 message ("received the wrong selection type in SelectionNotify!");
1439 reading_selection_reply = 0; /* we're done now. */
1443 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
1445 struct device *d = decode_x_device (Qnil);
1446 Display *display = DEVICE_X_DISPLAY (d);
1448 Atom selection_atom;
1450 CHECK_SYMBOL (selection);
1452 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
1455 /* #### This is bogus. See the comment above about problems
1456 on OSF/1 and DEC Alphas. Yet another reason why it sucks
1457 to have the implementation (i.e. cons of two 16-bit
1458 integers) exposed. */
1460 lisp_to_time (timeval, &the_time);
1461 timestamp = (Time) the_time;
1464 selection_atom = symbol_to_x_atom (d, selection, 0);
1466 XSetSelectionOwner (display, selection_atom, None, timestamp);
1470 x_selection_exists_p (Lisp_Object selection)
1472 struct device *d = decode_x_device (Qnil);
1473 Display *dpy = DEVICE_X_DISPLAY (d);
1474 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
1479 #ifdef CUT_BUFFER_SUPPORT
1481 static int cut_buffers_initialized; /* Whether we're sure they all exist */
1483 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1485 initialize_cut_buffers (Display *display, Window window)
1487 static unsigned const char * const data = (unsigned const char *) "";
1488 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1489 PropModeAppend, data, 0)
1490 FROB (XA_CUT_BUFFER0);
1491 FROB (XA_CUT_BUFFER1);
1492 FROB (XA_CUT_BUFFER2);
1493 FROB (XA_CUT_BUFFER3);
1494 FROB (XA_CUT_BUFFER4);
1495 FROB (XA_CUT_BUFFER5);
1496 FROB (XA_CUT_BUFFER6);
1497 FROB (XA_CUT_BUFFER7);
1499 cut_buffers_initialized = 1;
1502 #define CHECK_CUTBUFFER(symbol) do { \
1503 CHECK_SYMBOL (symbol); \
1504 if (! (EQ (symbol, QCUT_BUFFER0) || \
1505 EQ (symbol, QCUT_BUFFER1) || \
1506 EQ (symbol, QCUT_BUFFER2) || \
1507 EQ (symbol, QCUT_BUFFER3) || \
1508 EQ (symbol, QCUT_BUFFER4) || \
1509 EQ (symbol, QCUT_BUFFER5) || \
1510 EQ (symbol, QCUT_BUFFER6) || \
1511 EQ (symbol, QCUT_BUFFER7))) \
1512 signal_simple_error ("Doesn't name a cutbuffer", symbol); \
1515 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1516 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1520 struct device *d = decode_x_device (Qnil);
1521 Display *display = DEVICE_X_DISPLAY (d);
1522 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1523 Atom cut_buffer_atom;
1524 unsigned char *data;
1531 CHECK_CUTBUFFER (cutbuffer);
1532 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1534 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
1535 &type, &format, &size, 0);
1536 if (!data) return Qnil;
1538 if (format != 8 || type != XA_STRING)
1539 signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data",
1540 x_atom_to_symbol (d, type),
1543 /* We cheat - if the string contains an ESC character, that's
1544 technically not allowed in a STRING, so we assume it's
1545 COMPOUND_TEXT that we stored there ourselves earlier,
1546 in x-store-cutbuffer-internal */
1548 make_ext_string (data, bytes,
1549 memchr (data, 0x1b, bytes) ?
1557 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
1558 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1560 (cutbuffer, string))
1562 struct device *d = decode_x_device (Qnil);
1563 Display *display = DEVICE_X_DISPLAY (d);
1564 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1565 Atom cut_buffer_atom;
1566 const Extbyte *data = XSTRING_DATA (string);
1567 Extcount bytes = XSTRING_LENGTH (string);
1568 Extcount bytes_remaining;
1569 int max_bytes = SELECTION_QUANTUM (display);
1571 const Bufbyte *ptr, *end;
1572 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1575 if (max_bytes > MAX_SELECTION_QUANTUM)
1576 max_bytes = MAX_SELECTION_QUANTUM;
1578 CHECK_CUTBUFFER (cutbuffer);
1579 CHECK_STRING (string);
1580 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1582 if (! cut_buffers_initialized)
1583 initialize_cut_buffers (display, window);
1585 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1586 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1587 The ICCCM requires that this be so, and other clients assume it,
1588 as we do ourselves in initialize_cut_buffers. */
1591 /* Optimize for the common ASCII case */
1592 for (ptr = data, end = ptr + bytes; ptr <= end; )
1594 if (BYTE_ASCII_P (*ptr))
1600 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
1601 (*ptr) == LEADING_BYTE_CONTROL_1)
1603 chartypes = LATIN_1;
1612 if (chartypes == LATIN_1)
1613 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1614 ALLOCA, (data, bytes),
1616 else if (chartypes == WORLD)
1617 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1618 ALLOCA, (data, bytes),
1622 bytes_remaining = bytes;
1624 while (bytes_remaining)
1626 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1627 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
1628 (bytes_remaining == bytes
1629 ? PropModeReplace : PropModeAppend),
1632 bytes_remaining -= chunk;
1638 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
1639 Rotate the values of the cutbuffers by the given number of steps;
1640 positive means move values forward, negative means backward.
1644 struct device *d = decode_x_device (Qnil);
1645 Display *display = DEVICE_X_DISPLAY (d);
1646 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1652 if (! cut_buffers_initialized)
1653 initialize_cut_buffers (display, window);
1654 props[0] = XA_CUT_BUFFER0;
1655 props[1] = XA_CUT_BUFFER1;
1656 props[2] = XA_CUT_BUFFER2;
1657 props[3] = XA_CUT_BUFFER3;
1658 props[4] = XA_CUT_BUFFER4;
1659 props[5] = XA_CUT_BUFFER5;
1660 props[6] = XA_CUT_BUFFER6;
1661 props[7] = XA_CUT_BUFFER7;
1662 XRotateWindowProperties (display, window, props, 8, XINT (n));
1666 #endif /* CUT_BUFFER_SUPPORT */
1670 /************************************************************************/
1671 /* initialization */
1672 /************************************************************************/
1675 syms_of_select_x (void)
1678 #ifdef CUT_BUFFER_SUPPORT
1679 DEFSUBR (Fx_get_cutbuffer_internal);
1680 DEFSUBR (Fx_store_cutbuffer_internal);
1681 DEFSUBR (Fx_rotate_cutbuffers_internal);
1682 #endif /* CUT_BUFFER_SUPPORT */
1684 /* Unfortunately, timeout handlers must be lisp functions. */
1685 defsymbol (&Qx_selection_reply_timeout_internal,
1686 "x-selection-reply-timeout-internal");
1687 DEFSUBR (Fx_selection_reply_timeout_internal);
1689 #ifdef CUT_BUFFER_SUPPORT
1690 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
1691 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
1692 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
1693 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
1694 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
1695 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
1696 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
1697 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
1698 #endif /* CUT_BUFFER_SUPPORT */
1702 console_type_create_select_x (void)
1704 CONSOLE_HAS_METHOD (x, own_selection);
1705 CONSOLE_HAS_METHOD (x, disown_selection);
1706 CONSOLE_HAS_METHOD (x, get_foreign_selection);
1707 CONSOLE_HAS_METHOD (x, selection_exists_p);
1711 reinit_vars_of_select_x (void)
1713 reading_selection_reply = 0;
1714 reading_which_selection = 0;
1715 selection_reply_timed_out = 0;
1716 for_whom_the_bell_tolls = 0;
1717 prop_location_tick = 0;
1721 vars_of_select_x (void)
1723 reinit_vars_of_select_x ();
1725 #ifdef CUT_BUFFER_SUPPORT
1726 cut_buffers_initialized = 0;
1727 Fprovide (intern ("cut-buffer"));
1730 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
1731 A function or functions to be called after we have responded to some
1732 other client's request for the value of a selection that we own. The
1733 function(s) will be called with four arguments:
1734 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1735 - the name of the selection-type which we were requested to convert the
1736 selection into before sending (for example, STRING or LENGTH);
1737 - and whether we successfully transmitted the selection.
1738 We might have failed (and declined the request) for any number of reasons,
1739 including being asked for a selection that we no longer own, or being asked
1740 to convert into a type that we don't know about or that is inappropriate.
1741 This hook doesn't let you change the behavior of emacs's selection replies,
1742 it merely informs you that they have happened.
1744 Vx_sent_selection_hooks = Qunbound;
1746 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
1747 If the selection owner doesn't reply in this many seconds, we give up.
1748 A value of 0 means wait as long as necessary. This is initialized from the
1749 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1751 x_selection_timeout = 0;
1755 Xatoms_of_select_x (struct device *d)
1757 Display *D = DEVICE_X_DISPLAY (d);
1759 /* Non-predefined atoms that we might end up using a lot */
1760 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
1761 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
1762 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
1763 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
1764 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
1765 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
1766 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
1767 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
1768 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
1769 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
1770 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);