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.
205 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
206 Lisp_Object how_to_add, Lisp_Object selection_type)
208 struct device *d = decode_x_device (Qnil);
209 Display *display = DEVICE_X_DISPLAY (d);
210 struct frame *sel_frame = selected_frame ();
211 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
212 Lisp_Object selection_time;
213 /* Use the time of the last-read mouse or keyboard event.
214 For selection purposes, we use this as a sleazy way of knowing what the
215 current time is in server-time. This assumes that the most recently read
216 mouse or keyboard event has something to do with the assertion of the
217 selection, which is probably true.
219 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
222 CHECK_SYMBOL (selection_name);
223 selection_atom = symbol_to_x_atom (d, selection_name, 0);
225 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
227 /* We do NOT use time_to_lisp() here any more, like we used to.
228 That assumed equivalence of time_t and Time, which is not
229 necessarily the case (e.g. under OSF on the Alphas, where
230 Time is a 64-bit quantity and time_t is a 32-bit quantity).
232 Opaque pointers are the clean way to go here.
234 selection_time = make_opaque (&thyme, sizeof (thyme));
236 #ifdef MOTIF_CLIPBOARDS
237 hack_motif_clipboard_selection (selection_atom, selection_value,
238 thyme, display, selecting_window);
240 return selection_time;
243 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
245 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
246 static void motif_clipboard_cb ();
250 hack_motif_clipboard_selection (Atom selection_atom,
251 Lisp_Object selection_value,
254 Window selecting_window)
257 struct device *d = get_device_from_display (display);
258 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
259 their own non-Xlib non-Xt clipboard processing. So we have to do
260 this so that linked-in Motif widgets don't get themselves wedged.
262 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
263 && STRINGP (selection_value)
265 /* If we already own the clipboard, don't own it again in the Motif
266 way. This might lose in some subtle way, since the timestamp won't
267 be current, but owning the selection on the Motif way does a
268 SHITLOAD of X protocol, and it makes killing text be incredibly
269 slow when using an X terminal. ARRRRGGGHHH!!!!
271 /* No, this is no good, because then Motif text fields don't bother
272 to look up the new value, and you can't Copy from a buffer, Paste
273 into a text field, then Copy something else from the buffer and
274 paste it into the text field -- it pastes the first thing again. */
278 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
279 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
282 #if XmVersion >= 1002
285 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
288 String encoding = "STRING";
289 const Extbyte *data = XSTRING_DATA (selection_value);
290 Extcount bytes = XSTRING_LENGTH (selection_value);
294 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
295 const Bufbyte *ptr = data, *end = ptr + bytes;
296 /* Optimize for the common ASCII case */
299 if (BYTE_ASCII_P (*ptr))
305 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
306 (*ptr) == LEADING_BYTE_CONTROL_1)
317 if (chartypes == LATIN_1)
318 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
319 ALLOCA, (data, bytes),
321 else if (chartypes == WORLD)
323 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
324 ALLOCA, (data, bytes),
326 encoding = "COMPOUND_TEXT";
331 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
332 while (ClipboardSuccess !=
333 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
334 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
335 widget, motif_clipboard_cb,
342 while (ClipboardSuccess !=
343 XmClipboardCopy (display, selecting_window, itemid, encoding,
344 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
345 /* O'Reilly examples say size can be 0,
346 but this clearly is not the case. */
347 0, bytes, (int) selecting_window, /* private id */
348 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
349 (XtPointer) data, bytes, 0,
350 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
353 while (ClipboardSuccess !=
354 XmClipboardEndCopy (display, selecting_window, itemid))
359 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
360 /* I tried to treat the clipboard like a real selection, and not send
361 the data until it was requested, but it looks like that just doesn't
362 work at all unless the selection owner and requestor are in different
363 processes. From reading the Motif source, it looks like they never
364 even considered having two widgets in the same application transfer
365 data between each other using "by-name" clipboard values. What a
369 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
373 case XmCR_CLIPBOARD_DATA_REQUEST:
375 Display *dpy = XtDisplay (widget);
376 Window window = (Window) *private_id;
377 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
379 /* Whichever lazy git wrote this originally just called abort()
380 when anything didn't go their way... */
382 /* Try some other text types */
383 if (NILP (selection))
384 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
385 if (NILP (selection))
386 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
387 if (NILP (selection))
388 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
390 if (CONSP (selection) && SYMBOLP (XCAR (selection))
391 && (EQ (XCAR (selection), QSTRING)
392 || EQ (XCAR (selection), QTEXT)
393 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
394 selection = XCDR (selection);
396 if (NILP (selection))
397 signal_error (Qselection_conversion_error,
398 build_string ("no selection"));
400 if (!STRINGP (selection))
401 signal_error (Qselection_conversion_error,
402 build_string ("couldn't convert selection to string"));
405 XmClipboardCopyByName (dpy, window, *data_id,
406 (char *) XSTRING_DATA (selection),
407 XSTRING_LENGTH (selection) + 1,
411 case XmCR_CLIPBOARD_DATA_DELETE:
413 /* don't need to free anything */
417 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
418 #endif /* MOTIF_CLIPBOARDS */
423 /* Send a SelectionNotify event to the requestor with property=None, meaning
424 we were unable to do what they wanted.
427 x_decline_selection_request (XSelectionRequestEvent *event)
429 XSelectionEvent reply;
430 reply.type = SelectionNotify;
431 reply.display = event->display;
432 reply.requestor = event->requestor;
433 reply.selection = event->selection;
434 reply.time = event->time;
435 reply.target = event->target;
436 reply.property = None;
438 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
439 XFlush (reply.display);
443 /* Used as an unwind-protect clause so that, if a selection-converter signals
444 an error, we tell the requestor that we were unable to do what they wanted
445 before we throw to top-level or go into the debugger or whatever.
448 x_selection_request_lisp_error (Lisp_Object closure)
450 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
451 get_opaque_ptr (closure);
453 free_opaque_ptr (closure);
454 if (event->type == 0) /* we set this to mean "completed normally" */
456 x_decline_selection_request (event);
461 /* Convert our selection to the requested type, and put that data where the
462 requestor wants it. Then tell them whether we've succeeded.
465 x_reply_selection_request (XSelectionRequestEvent *event, int format,
466 unsigned char *data, int size, Atom type)
468 /* This function can GC */
469 XSelectionEvent reply;
470 Display *display = event->display;
471 struct device *d = get_device_from_display (display);
472 Window window = event->requestor;
474 int format_bytes = format/8;
475 int max_bytes = SELECTION_QUANTUM (display);
476 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
478 reply.type = SelectionNotify;
479 reply.display = display;
480 reply.requestor = window;
481 reply.selection = event->selection;
482 reply.time = event->time;
483 reply.target = event->target;
484 reply.property = (event->property == None ? event->target : event->property);
486 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
488 /* Store the data on the requested property.
489 If the selection is large, only store the first N bytes of it.
491 bytes_remaining = size * format_bytes;
492 if (bytes_remaining <= max_bytes)
494 /* Send all the data at once, with minimal handshaking. */
496 stderr_out ("\nStoring all %d\n", bytes_remaining);
498 XChangeProperty (display, window, reply.property, type, format,
499 PropModeReplace, data, size);
500 /* At this point, the selection was successfully stored; ack it. */
501 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
506 /* Send an INCR selection. */
509 if (x_window_to_frame (d, window)) /* #### debug */
510 error ("attempt to transfer an INCR to ourself!");
512 stderr_out ("\nINCR %d\n", bytes_remaining);
514 prop_id = expect_property_change (display, window, reply.property,
517 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
518 32, PropModeReplace, (unsigned char *)
519 &bytes_remaining, 1);
520 XSelectInput (display, window, PropertyChangeMask);
521 /* Tell 'em the INCR data is there... */
522 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
525 /* First, wait for the requestor to ack by deleting the property.
526 This can run random lisp code (process handlers) or signal.
528 wait_for_property_change (prop_id);
530 while (bytes_remaining)
532 int i = ((bytes_remaining < max_bytes)
535 prop_id = expect_property_change (display, window, reply.property,
538 stderr_out (" INCR adding %d\n", i);
540 /* Append the next chunk of data to the property. */
541 XChangeProperty (display, window, reply.property, type, format,
542 PropModeAppend, data, i / format_bytes);
543 bytes_remaining -= i;
546 /* Now wait for the requestor to ack this chunk by deleting the
547 property. This can run random lisp code or signal.
549 wait_for_property_change (prop_id);
551 /* Now write a zero-length chunk to the property to tell the requestor
554 stderr_out (" INCR done\n");
556 if (! waiting_for_other_props_on_window (display, window))
557 XSelectInput (display, window, 0L);
559 XChangeProperty (display, window, reply.property, type, format,
560 PropModeReplace, data, 0);
566 /* Called from the event-loop in response to a SelectionRequest event.
569 x_handle_selection_request (XSelectionRequestEvent *event)
571 /* This function can GC */
572 struct gcpro gcpro1, gcpro2;
573 Lisp_Object temp_obj;
574 Lisp_Object selection_symbol;
575 Lisp_Object target_symbol = Qnil;
576 Lisp_Object converted_selection = Qnil;
577 Time local_selection_time;
578 Lisp_Object successful_p = Qnil;
580 struct device *d = get_device_from_display (event->display);
582 GCPRO2 (converted_selection, target_symbol);
584 selection_symbol = x_atom_to_symbol (d, event->selection);
585 target_symbol = x_atom_to_symbol (d, event->target);
587 #if 0 /* #### MULTIPLE doesn't work yet */
588 if (EQ (target_symbol, QMULTIPLE))
589 target_symbol = fetch_multiple_target (event);
592 temp_obj = Fget_selection_timestamp (selection_symbol);
596 /* We don't appear to have the selection. */
597 x_decline_selection_request (event);
602 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
604 if (event->time != CurrentTime &&
605 local_selection_time > event->time)
607 /* Someone asked for the selection, and we have one, but not the one
608 they're looking for. */
609 x_decline_selection_request (event);
613 converted_selection = select_convert_out (selection_symbol,
614 target_symbol, Qnil);
616 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
617 if (NILP (converted_selection))
619 /* We don't appear to have a selection in that data type. */
620 x_decline_selection_request (event);
624 count = specpdl_depth ();
625 record_unwind_protect (x_selection_request_lisp_error,
626 make_opaque_ptr (event));
633 lisp_data_to_selection_data (d, converted_selection,
634 &data, &type, &size, &format);
636 x_reply_selection_request (event, format, data, size, type);
638 /* Tell x_selection_request_lisp_error() it's cool. */
643 unbind_to (count, Qnil);
649 /* Let random lisp code notice that the selection has been asked for. */
651 Lisp_Object val = Vx_sent_selection_hooks;
652 if (!UNBOUNDP (val) && !NILP (val))
655 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
656 for (rest = val; !NILP (rest); rest = Fcdr (rest))
657 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
659 call3 (val, selection_symbol, target_symbol, successful_p);
665 /* Called from the event-loop in response to a SelectionClear event.
668 x_handle_selection_clear (XSelectionClearEvent *event)
670 Display *display = event->display;
671 struct device *d = get_device_from_display (display);
672 Atom selection = event->selection;
673 Time changed_owner_time = event->time;
675 Lisp_Object selection_symbol, local_selection_time_lisp;
676 Time local_selection_time;
678 selection_symbol = x_atom_to_symbol (d, selection);
680 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
682 /* We don't own the selection, so that's fine. */
683 if (NILP (local_selection_time_lisp))
686 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
688 /* This SelectionClear is for a selection that we no longer own, so we can
689 disregard it. (That is, we have reasserted the selection since this
690 request was generated.)
692 if (changed_owner_time != CurrentTime &&
693 local_selection_time > changed_owner_time)
696 handle_selection_clear (selection_symbol);
700 /* This stuff is so that INCR selections are reentrant (that is, so we can
701 be servicing multiple INCR selection requests simultaneously). I haven't
702 actually tested that yet.
705 static int prop_location_tick;
707 static struct prop_location {
713 struct prop_location *next;
714 } *for_whom_the_bell_tolls;
718 property_deleted_p (void *tick)
720 struct prop_location *rest = for_whom_the_bell_tolls;
722 if (rest->tick == (long) tick)
730 waiting_for_other_props_on_window (Display *display, Window window)
732 struct prop_location *rest = for_whom_the_bell_tolls;
734 if (rest->display == display && rest->window == window)
743 expect_property_change (Display *display, Window window,
744 Atom property, int state)
746 struct prop_location *pl = xnew (struct prop_location);
747 pl->tick = ++prop_location_tick;
748 pl->display = display;
750 pl->property = property;
751 pl->desired_state = state;
752 pl->next = for_whom_the_bell_tolls;
753 for_whom_the_bell_tolls = pl;
758 unexpect_property_change (int tick)
760 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
763 if (rest->tick == tick)
766 prev->next = rest->next;
768 for_whom_the_bell_tolls = rest->next;
778 wait_for_property_change (long tick)
780 /* This function can GC */
781 wait_delaying_user_input (property_deleted_p, (void *) tick);
785 /* Called from the event-loop in response to a PropertyNotify event.
788 x_handle_property_notify (XPropertyEvent *event)
790 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
793 if (rest->property == event->atom &&
794 rest->window == event->window &&
795 rest->display == event->display &&
796 rest->desired_state == event->state)
799 stderr_out ("Saw expected prop-%s on %s\n",
800 (event->state == PropertyDelete ? "delete" : "change"),
801 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name);
804 prev->next = rest->next;
806 for_whom_the_bell_tolls = rest->next;
814 stderr_out ("Saw UNexpected prop-%s on %s\n",
815 (event->state == PropertyDelete ? "delete" : "change"),
816 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
822 #if 0 /* #### MULTIPLE doesn't work yet */
825 fetch_multiple_target (XSelectionRequestEvent *event)
827 /* This function can GC */
828 Display *display = event->display;
829 Window window = event->requestor;
830 Atom target = event->target;
831 Atom selection_atom = event->selection;
836 x_get_window_property_as_lisp_data (display, window, target,
842 copy_multiple_data (Lisp_Object obj)
848 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
851 len = XVECTOR_LENGTH (obj);
852 vec = make_vector (len, Qnil);
853 for (i = 0; i < len; i++)
855 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
857 if (XVECTOR_LENGTH (vec2) != 2)
858 signal_error (Qerror, list2 (build_string
859 ("vectors must be of length 2"),
861 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
862 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
863 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
871 static Window reading_selection_reply;
872 static Atom reading_which_selection;
873 static int selection_reply_timed_out;
876 selection_reply_done (void *ignore)
878 return !reading_selection_reply;
881 static Lisp_Object Qx_selection_reply_timeout_internal;
883 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
888 selection_reply_timed_out = 1;
889 reading_selection_reply = 0;
894 /* Do protocol to read selection-data from the server.
895 Converts this to lisp data and returns it.
898 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
900 /* This function can GC */
901 struct device *d = decode_x_device (Qnil);
902 Display *display = DEVICE_X_DISPLAY (d);
903 struct frame *sel_frame = selected_frame ();
904 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
905 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
906 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
907 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
909 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
910 XCAR (target_type) : target_type), 0);
912 XConvertSelection (display, selection_atom, type_atom, target_property,
913 requestor_window, requestor_time);
915 /* Block until the reply has been read. */
916 reading_selection_reply = requestor_window;
917 reading_which_selection = selection_atom;
918 selection_reply_timed_out = 0;
920 speccount = specpdl_depth ();
922 /* add a timeout handler */
923 if (x_selection_timeout > 0)
925 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
926 Qx_selection_reply_timeout_internal,
928 record_unwind_protect (Fdisable_timeout, id);
932 wait_delaying_user_input (selection_reply_done, 0);
934 if (selection_reply_timed_out)
935 error ("timed out waiting for reply from selection owner");
937 unbind_to (speccount, Qnil);
939 /* otherwise, the selection is waiting for us on the requested property. */
941 return select_convert_in (selection_symbol,
943 x_get_window_property_as_lisp_data(display,
952 x_get_window_property (Display *display, Window window, Atom property,
953 unsigned char **data_ret, int *bytes_ret,
954 Atom *actual_type_ret, int *actual_format_ret,
955 unsigned long *actual_size_ret, int delete_p)
958 unsigned long bytes_remaining;
960 unsigned char *tmp_data = 0;
962 int buffer_size = SELECTION_QUANTUM (display);
963 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
965 /* First probe the thing to find out how big it is. */
966 result = XGetWindowProperty (display, window, property,
967 0, 0, False, AnyPropertyType,
968 actual_type_ret, actual_format_ret,
970 &bytes_remaining, &tmp_data);
971 if (result != Success)
977 XFree ((char *) tmp_data);
979 if (*actual_type_ret == None || *actual_format_ret == 0)
981 if (delete_p) XDeleteProperty (display, window, property);
987 total_size = bytes_remaining + 1;
988 *data_ret = (unsigned char *) xmalloc (total_size);
990 /* Now read, until we've gotten it all. */
991 while (bytes_remaining)
994 int last = bytes_remaining;
997 XGetWindowProperty (display, window, property,
998 offset/4, buffer_size/4,
999 (delete_p ? True : False),
1001 actual_type_ret, actual_format_ret,
1002 actual_size_ret, &bytes_remaining, &tmp_data);
1004 stderr_out ("<< read %d\n", last-bytes_remaining);
1006 /* If this doesn't return Success at this point, it means that
1007 some clod deleted the selection while we were in the midst of
1008 reading it. Deal with that, I guess....
1010 if (result != Success) break;
1011 *actual_size_ret *= *actual_format_ret / 8;
1012 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
1013 offset += *actual_size_ret;
1014 XFree ((char *) tmp_data);
1016 *bytes_ret = offset;
1021 receive_incremental_selection (Display *display, Window window, Atom property,
1022 /* this one is for error messages only */
1023 Lisp_Object target_type,
1024 unsigned int min_size_bytes,
1025 unsigned char **data_ret, int *size_bytes_ret,
1026 Atom *type_ret, int *format_ret,
1027 unsigned long *size_ret)
1029 /* This function can GC */
1032 *size_bytes_ret = min_size_bytes;
1033 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1035 stderr_out ("\nread INCR %d\n", min_size_bytes);
1037 /* At this point, we have read an INCR property, and deleted it (which
1038 is how we ack its receipt: the sending window will be selecting
1039 PropertyNotify events on our window to notice this).
1041 Now, we must loop, waiting for the sending window to put a value on
1042 that property, then reading the property, then deleting it to ack.
1043 We are done when the sender places a property of length 0.
1045 prop_id = expect_property_change (display, window, property,
1049 unsigned char *tmp_data;
1051 wait_for_property_change (prop_id);
1052 /* expect it again immediately, because x_get_window_property may
1053 .. no it won't, I don't get it.
1054 .. Ok, I get it now, the Xt code that implements INCR is broken.
1056 prop_id = expect_property_change (display, window, property,
1058 x_get_window_property (display, window, property,
1059 &tmp_data, &tmp_size_bytes,
1060 type_ret, format_ret, size_ret, 1);
1062 if (tmp_size_bytes == 0) /* we're done */
1065 stderr_out (" read INCR done\n");
1067 unexpect_property_change (prop_id);
1068 if (tmp_data) xfree (tmp_data);
1072 stderr_out (" read INCR %d\n", tmp_size_bytes);
1074 if (*size_bytes_ret < offset + tmp_size_bytes)
1077 stderr_out (" read INCR realloc %d -> %d\n",
1078 *size_bytes_ret, offset + tmp_size_bytes);
1080 *size_bytes_ret = offset + tmp_size_bytes;
1081 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1083 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1084 offset += tmp_size_bytes;
1091 x_get_window_property_as_lisp_data (Display *display,
1094 /* next two for error messages only */
1095 Lisp_Object target_type,
1096 Atom selection_atom)
1098 /* This function can GC */
1101 unsigned long actual_size;
1102 unsigned char *data = NULL;
1105 struct device *d = get_device_from_display (display);
1107 x_get_window_property (display, window, property, &data, &bytes,
1108 &actual_type, &actual_format, &actual_size, 1);
1111 if (XGetSelectionOwner (display, selection_atom))
1112 /* there is a selection owner */
1114 (Qselection_conversion_error,
1115 Fcons (build_string ("selection owner couldn't convert"),
1116 Fcons (x_atom_to_symbol (d, selection_atom),
1118 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
1119 list1 (target_type))));
1121 signal_error (Qerror,
1122 list2 (build_string ("no selection"),
1123 x_atom_to_symbol (d, selection_atom)));
1126 if (actual_type == DEVICE_XATOM_INCR (d))
1128 /* Ok, that data wasn't *the* data, it was just the beginning. */
1130 unsigned int min_size_bytes = * ((unsigned int *) data);
1132 receive_incremental_selection (display, window, property, target_type,
1133 min_size_bytes, &data, &bytes,
1134 &actual_type, &actual_format,
1138 /* It's been read. Now convert it to a lisp object in some semi-rational
1140 val = selection_data_to_lisp_data (d, data, bytes,
1141 actual_type, actual_format);
1147 /* #### These are going to move into Lisp code(!) with the aid of
1148 some new functions I'm working on - ajh */
1150 /* These functions convert from the selection data read from the server into
1151 something that we can use from elisp, and vice versa.
1153 Type: Format: Size: Elisp Type:
1154 ----- ------- ----- -----------
1157 ATOM 32 > 1 Vector of Symbols
1159 * 16 > 1 Vector of Integers
1160 * 32 1 if <=16 bits: Integer
1161 if > 16 bits: Cons of top16, bot16
1162 * 32 > 1 Vector of the above
1164 When converting a Lisp number to C, it is assumed to be of format 16 if
1165 it is an integer, and of format 32 if it is a cons of two integers.
1167 When converting a vector of numbers from Elisp to C, it is assumed to be
1168 of format 16 if every element in the vector is an integer, and is assumed
1169 to be of format 32 if any element is a cons of two integers.
1171 When converting an object to C, it may be of the form (SYMBOL . <data>)
1172 where SYMBOL is what we should claim that the type is. Format and
1173 representation are as above.
1175 NOTE: Under Mule, when someone shoves us a string without a type, we
1176 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1177 Text. If the string has a type, we assume that the user wants the
1178 data sent as-is so we just do "binary" conversion.
1183 selection_data_to_lisp_data (struct device *d,
1184 unsigned char *data,
1189 if (type == DEVICE_XATOM_NULL (d))
1192 /* Convert any 8-bit data to a string, for compactness. */
1193 else if (format == 8)
1194 return make_ext_string (data, size,
1195 type == DEVICE_XATOM_TEXT (d) ||
1196 type == DEVICE_XATOM_COMPOUND_TEXT (d)
1197 ? Qctext : Qbinary);
1199 /* Convert a single atom to a Lisp Symbol.
1200 Convert a set of atoms to a vector of symbols. */
1201 else if (type == XA_ATOM)
1203 if (size == sizeof (Atom))
1204 return x_atom_to_symbol (d, *((Atom *) data));
1208 int len = size / sizeof (Atom);
1209 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
1210 for (i = 0; i < len; i++)
1211 Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
1216 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1217 If the number is > 16 bits, convert it to a cons of integers,
1218 16 bits in each half.
1220 else if (format == 32 && size == sizeof (long))
1221 return word_to_lisp (((unsigned long *) data) [0]);
1222 else if (format == 16 && size == sizeof (short))
1223 return make_int ((int) (((unsigned short *) data) [0]));
1225 /* Convert any other kind of data to a vector of numbers, represented
1226 as above (as an integer, or a cons of two 16 bit integers).
1228 #### Perhaps we should return the actual type to lisp as well.
1230 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1233 and perhaps it should be
1235 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1238 Right now the fact that the return type was SPAN is discarded before
1239 lisp code gets to see it.
1241 else if (format == 16)
1244 Lisp_Object v = make_vector (size / 4, Qzero);
1245 for (i = 0; i < (int) size / 4; i++)
1247 int j = (int) ((unsigned short *) data) [i];
1248 Faset (v, make_int (i), make_int (j));
1255 Lisp_Object v = make_vector (size / 4, Qzero);
1256 for (i = 0; i < (int) size / 4; i++)
1258 unsigned long j = ((unsigned long *) data) [i];
1259 Faset (v, make_int (i), word_to_lisp (j));
1267 lisp_data_to_selection_data (struct device *d,
1269 unsigned char **data_ret,
1271 unsigned int *size_ret,
1274 Lisp_Object type = Qnil;
1276 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1280 if (CONSP (obj) && NILP (XCDR (obj)))
1284 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1285 { /* This is not the same as declining */
1291 else if (STRINGP (obj))
1293 const Extbyte *extval;
1296 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
1297 ALLOCA, (extval, extvallen),
1298 (NILP (type) ? Qctext : Qbinary));
1300 *size_ret = extvallen;
1301 *data_ret = (unsigned char *) xmalloc (*size_ret);
1302 memcpy (*data_ret, extval, *size_ret);
1304 if (NILP (type)) type = QCOMPOUND_TEXT;
1306 if (NILP (type)) type = QSTRING;
1309 else if (CHARP (obj))
1311 Bufbyte buf[MAX_EMCHAR_LEN];
1313 const Extbyte *extval;
1317 len = set_charptr_emchar (buf, XCHAR (obj));
1318 TO_EXTERNAL_FORMAT (DATA, (buf, len),
1319 ALLOCA, (extval, extvallen),
1321 *size_ret = extvallen;
1322 *data_ret = (unsigned char *) xmalloc (*size_ret);
1323 memcpy (*data_ret, extval, *size_ret);
1325 if (NILP (type)) type = QCOMPOUND_TEXT;
1327 if (NILP (type)) type = QSTRING;
1330 else if (SYMBOLP (obj))
1334 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1335 (*data_ret) [sizeof (Atom)] = 0;
1336 (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
1337 if (NILP (type)) type = QATOM;
1339 else if (INTP (obj) &&
1340 XINT (obj) <= 0x7FFF &&
1341 XINT (obj) >= -0x8000)
1345 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1346 (*data_ret) [sizeof (short)] = 0;
1347 (*(short **) data_ret) [0] = (short) XINT (obj);
1348 if (NILP (type)) type = QINTEGER;
1350 else if (INTP (obj) || CONSP (obj))
1354 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1355 (*data_ret) [sizeof (long)] = 0;
1356 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
1357 if (NILP (type)) type = QINTEGER;
1359 else if (VECTORP (obj))
1361 /* Lisp Vectors may represent a set of ATOMs;
1362 a set of 16 or 32 bit INTEGERs;
1363 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1367 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
1368 /* This vector is an ATOM set */
1370 if (NILP (type)) type = QATOM;
1371 *size_ret = XVECTOR_LENGTH (obj);
1373 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1374 for (i = 0; i < (int) (*size_ret); i++)
1375 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
1376 (*(Atom **) data_ret) [i] =
1377 symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
1379 signal_error (Qerror, /* Qselection_error */
1381 ("all elements of the vector must be of the same type"),
1384 #if 0 /* #### MULTIPLE doesn't work yet */
1385 else if (VECTORP (XVECTOR_DATA (obj) [0]))
1386 /* This vector is an ATOM_PAIR set */
1388 if (NILP (type)) type = QATOM_PAIR;
1389 *size_ret = XVECTOR_LENGTH (obj);
1391 *data_ret = (unsigned char *)
1392 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1393 for (i = 0; i < *size_ret; i++)
1394 if (VECTORP (XVECTOR_DATA (obj) [i]))
1396 Lisp_Object pair = XVECTOR_DATA (obj) [i];
1397 if (XVECTOR_LENGTH (pair) != 2)
1398 signal_error (Qerror,
1400 ("elements of the vector must be vectors of exactly two elements"),
1403 (*(Atom **) data_ret) [i * 2] =
1404 symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
1405 (*(Atom **) data_ret) [(i * 2) + 1] =
1406 symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
1409 signal_error (Qerror,
1411 ("all elements of the vector must be of the same type"),
1416 /* This vector is an INTEGER set, or something like it */
1418 *size_ret = XVECTOR_LENGTH (obj);
1419 if (NILP (type)) type = QINTEGER;
1421 for (i = 0; i < (int) (*size_ret); i++)
1422 if (CONSP (XVECTOR_DATA (obj) [i]))
1424 else if (!INTP (XVECTOR_DATA (obj) [i]))
1425 signal_error (Qerror, /* Qselection_error */
1427 ("all elements of the vector must be integers or conses of integers"),
1430 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1431 for (i = 0; i < (int) (*size_ret); i++)
1432 if (*format_ret == 32)
1433 (*((unsigned long **) data_ret)) [i] =
1434 lisp_to_word (XVECTOR_DATA (obj) [i]);
1436 (*((unsigned short **) data_ret)) [i] =
1437 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
1441 signal_error (Qerror, /* Qselection_error */
1442 list2 (build_string ("unrecognized selection data"),
1445 *type_ret = symbol_to_x_atom (d, type, 0);
1450 /* Called from the event loop to handle SelectionNotify events.
1451 I don't think this needs to be reentrant.
1454 x_handle_selection_notify (XSelectionEvent *event)
1456 if (! reading_selection_reply)
1457 message ("received an unexpected SelectionNotify event");
1458 else if (event->requestor != reading_selection_reply)
1459 message ("received a SelectionNotify event for the wrong window");
1460 else if (event->selection != reading_which_selection)
1461 message ("received the wrong selection type in SelectionNotify!");
1463 reading_selection_reply = 0; /* we're done now. */
1467 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
1469 struct device *d = decode_x_device (Qnil);
1470 Display *display = DEVICE_X_DISPLAY (d);
1472 Atom selection_atom;
1474 CHECK_SYMBOL (selection);
1476 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
1479 /* #### This is bogus. See the comment above about problems
1480 on OSF/1 and DEC Alphas. Yet another reason why it sucks
1481 to have the implementation (i.e. cons of two 16-bit
1482 integers) exposed. */
1484 lisp_to_time (timeval, &the_time);
1485 timestamp = (Time) the_time;
1488 selection_atom = symbol_to_x_atom (d, selection, 0);
1490 XSetSelectionOwner (display, selection_atom, None, timestamp);
1494 x_selection_exists_p (Lisp_Object selection,
1495 Lisp_Object selection_type)
1497 struct device *d = decode_x_device (Qnil);
1498 Display *dpy = DEVICE_X_DISPLAY (d);
1499 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
1504 #ifdef CUT_BUFFER_SUPPORT
1506 static int cut_buffers_initialized; /* Whether we're sure they all exist */
1508 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1510 initialize_cut_buffers (Display *display, Window window)
1512 static unsigned const char * const data = (unsigned const char *) "";
1513 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1514 PropModeAppend, data, 0)
1515 FROB (XA_CUT_BUFFER0);
1516 FROB (XA_CUT_BUFFER1);
1517 FROB (XA_CUT_BUFFER2);
1518 FROB (XA_CUT_BUFFER3);
1519 FROB (XA_CUT_BUFFER4);
1520 FROB (XA_CUT_BUFFER5);
1521 FROB (XA_CUT_BUFFER6);
1522 FROB (XA_CUT_BUFFER7);
1524 cut_buffers_initialized = 1;
1527 #define CHECK_CUTBUFFER(symbol) do { \
1528 CHECK_SYMBOL (symbol); \
1529 if (! (EQ (symbol, QCUT_BUFFER0) || \
1530 EQ (symbol, QCUT_BUFFER1) || \
1531 EQ (symbol, QCUT_BUFFER2) || \
1532 EQ (symbol, QCUT_BUFFER3) || \
1533 EQ (symbol, QCUT_BUFFER4) || \
1534 EQ (symbol, QCUT_BUFFER5) || \
1535 EQ (symbol, QCUT_BUFFER6) || \
1536 EQ (symbol, QCUT_BUFFER7))) \
1537 signal_simple_error ("Doesn't name a cutbuffer", symbol); \
1540 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1541 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1545 struct device *d = decode_x_device (Qnil);
1546 Display *display = DEVICE_X_DISPLAY (d);
1547 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1548 Atom cut_buffer_atom;
1549 unsigned char *data;
1556 CHECK_CUTBUFFER (cutbuffer);
1557 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1559 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
1560 &type, &format, &size, 0);
1561 if (!data) return Qnil;
1563 if (format != 8 || type != XA_STRING)
1564 signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data",
1565 x_atom_to_symbol (d, type),
1568 /* We cheat - if the string contains an ESC character, that's
1569 technically not allowed in a STRING, so we assume it's
1570 COMPOUND_TEXT that we stored there ourselves earlier,
1571 in x-store-cutbuffer-internal */
1573 make_ext_string (data, bytes,
1574 memchr (data, 0x1b, bytes) ?
1582 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
1583 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1585 (cutbuffer, string))
1587 struct device *d = decode_x_device (Qnil);
1588 Display *display = DEVICE_X_DISPLAY (d);
1589 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1590 Atom cut_buffer_atom;
1591 const Extbyte *data = XSTRING_DATA (string);
1592 Extcount bytes = XSTRING_LENGTH (string);
1593 Extcount bytes_remaining;
1594 int max_bytes = SELECTION_QUANTUM (display);
1596 const Bufbyte *ptr, *end;
1597 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1600 if (max_bytes > MAX_SELECTION_QUANTUM)
1601 max_bytes = MAX_SELECTION_QUANTUM;
1603 CHECK_CUTBUFFER (cutbuffer);
1604 CHECK_STRING (string);
1605 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1607 if (! cut_buffers_initialized)
1608 initialize_cut_buffers (display, window);
1610 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1611 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1612 The ICCCM requires that this be so, and other clients assume it,
1613 as we do ourselves in initialize_cut_buffers. */
1616 /* Optimize for the common ASCII case */
1617 for (ptr = data, end = ptr + bytes; ptr <= end; )
1619 if (BYTE_ASCII_P (*ptr))
1625 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
1626 (*ptr) == LEADING_BYTE_CONTROL_1)
1628 chartypes = LATIN_1;
1637 if (chartypes == LATIN_1)
1638 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1639 ALLOCA, (data, bytes),
1641 else if (chartypes == WORLD)
1642 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1643 ALLOCA, (data, bytes),
1647 bytes_remaining = bytes;
1649 while (bytes_remaining)
1651 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1652 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
1653 (bytes_remaining == bytes
1654 ? PropModeReplace : PropModeAppend),
1657 bytes_remaining -= chunk;
1663 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
1664 Rotate the values of the cutbuffers by the given number of steps;
1665 positive means move values forward, negative means backward.
1669 struct device *d = decode_x_device (Qnil);
1670 Display *display = DEVICE_X_DISPLAY (d);
1671 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1677 if (! cut_buffers_initialized)
1678 initialize_cut_buffers (display, window);
1679 props[0] = XA_CUT_BUFFER0;
1680 props[1] = XA_CUT_BUFFER1;
1681 props[2] = XA_CUT_BUFFER2;
1682 props[3] = XA_CUT_BUFFER3;
1683 props[4] = XA_CUT_BUFFER4;
1684 props[5] = XA_CUT_BUFFER5;
1685 props[6] = XA_CUT_BUFFER6;
1686 props[7] = XA_CUT_BUFFER7;
1687 XRotateWindowProperties (display, window, props, 8, XINT (n));
1691 #endif /* CUT_BUFFER_SUPPORT */
1695 /************************************************************************/
1696 /* initialization */
1697 /************************************************************************/
1700 syms_of_select_x (void)
1703 #ifdef CUT_BUFFER_SUPPORT
1704 DEFSUBR (Fx_get_cutbuffer_internal);
1705 DEFSUBR (Fx_store_cutbuffer_internal);
1706 DEFSUBR (Fx_rotate_cutbuffers_internal);
1707 #endif /* CUT_BUFFER_SUPPORT */
1709 /* Unfortunately, timeout handlers must be lisp functions. */
1710 defsymbol (&Qx_selection_reply_timeout_internal,
1711 "x-selection-reply-timeout-internal");
1712 DEFSUBR (Fx_selection_reply_timeout_internal);
1714 #ifdef CUT_BUFFER_SUPPORT
1715 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
1716 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
1717 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
1718 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
1719 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
1720 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
1721 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
1722 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
1723 #endif /* CUT_BUFFER_SUPPORT */
1727 console_type_create_select_x (void)
1729 CONSOLE_HAS_METHOD (x, own_selection);
1730 CONSOLE_HAS_METHOD (x, disown_selection);
1731 CONSOLE_HAS_METHOD (x, get_foreign_selection);
1732 CONSOLE_HAS_METHOD (x, selection_exists_p);
1736 reinit_vars_of_select_x (void)
1738 reading_selection_reply = 0;
1739 reading_which_selection = 0;
1740 selection_reply_timed_out = 0;
1741 for_whom_the_bell_tolls = 0;
1742 prop_location_tick = 0;
1746 vars_of_select_x (void)
1748 reinit_vars_of_select_x ();
1750 #ifdef CUT_BUFFER_SUPPORT
1751 cut_buffers_initialized = 0;
1752 Fprovide (intern ("cut-buffer"));
1755 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
1756 A function or functions to be called after we have responded to some
1757 other client's request for the value of a selection that we own. The
1758 function(s) will be called with four arguments:
1759 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1760 - the name of the selection-type which we were requested to convert the
1761 selection into before sending (for example, STRING or LENGTH);
1762 - and whether we successfully transmitted the selection.
1763 We might have failed (and declined the request) for any number of reasons,
1764 including being asked for a selection that we no longer own, or being asked
1765 to convert into a type that we don't know about or that is inappropriate.
1766 This hook doesn't let you change the behavior of emacs's selection replies,
1767 it merely informs you that they have happened.
1769 Vx_sent_selection_hooks = Qunbound;
1771 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
1772 If the selection owner doesn't reply in this many seconds, we give up.
1773 A value of 0 means wait as long as necessary. This is initialized from the
1774 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1776 x_selection_timeout = 0;
1780 Xatoms_of_select_x (struct device *d)
1782 Display *D = DEVICE_X_DISPLAY (d);
1784 /* Non-predefined atoms that we might end up using a lot */
1785 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
1786 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
1787 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
1788 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
1789 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
1790 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
1791 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
1792 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
1793 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
1794 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
1796 /* #### I don't like the looks of this... what is it for? - ajh */
1797 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);