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 LISP_STRING_TO_EXTERNAL (Fsymbol_name (sym), nameext, Qctext);
143 return XInternAtom (display, nameext, only_if_exists ? True : False);
148 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
149 and calls to intern whenever possible.
152 x_atom_to_symbol (struct device *d, Atom atom)
154 Display *display = DEVICE_X_DISPLAY (d);
156 if (! atom) return Qnil;
157 if (atom == XA_PRIMARY) return QPRIMARY;
158 if (atom == XA_SECONDARY) return QSECONDARY;
159 if (atom == XA_STRING) return QSTRING;
160 if (atom == XA_INTEGER) return QINTEGER;
161 if (atom == XA_ATOM) return QATOM;
162 if (atom == DEVICE_XATOM_CLIPBOARD (d)) return QCLIPBOARD;
163 if (atom == DEVICE_XATOM_TIMESTAMP (d)) return QTIMESTAMP;
164 if (atom == DEVICE_XATOM_TEXT (d)) return QTEXT;
165 if (atom == DEVICE_XATOM_DELETE (d)) return QDELETE;
166 if (atom == DEVICE_XATOM_MULTIPLE (d)) return QMULTIPLE;
167 if (atom == DEVICE_XATOM_INCR (d)) return QINCR;
168 if (atom == DEVICE_XATOM_EMACS_TMP (d)) return QEMACS_TMP;
169 if (atom == DEVICE_XATOM_TARGETS (d)) return QTARGETS;
170 if (atom == DEVICE_XATOM_NULL (d)) return QNULL;
171 if (atom == DEVICE_XATOM_ATOM_PAIR (d)) return QATOM_PAIR;
172 if (atom == DEVICE_XATOM_COMPOUND_TEXT (d)) return QCOMPOUND_TEXT;
174 #ifdef CUT_BUFFER_SUPPORT
175 if (atom == XA_CUT_BUFFER0) return QCUT_BUFFER0;
176 if (atom == XA_CUT_BUFFER1) return QCUT_BUFFER1;
177 if (atom == XA_CUT_BUFFER2) return QCUT_BUFFER2;
178 if (atom == XA_CUT_BUFFER3) return QCUT_BUFFER3;
179 if (atom == XA_CUT_BUFFER4) return QCUT_BUFFER4;
180 if (atom == XA_CUT_BUFFER5) return QCUT_BUFFER5;
181 if (atom == XA_CUT_BUFFER6) return QCUT_BUFFER6;
182 if (atom == XA_CUT_BUFFER7) return QCUT_BUFFER7;
187 char *str = XGetAtomName (display, atom);
189 if (! str) return Qnil;
191 TO_INTERNAL_FORMAT (C_STRING, str,
192 C_STRING_ALLOCA, intstr,
195 return intern (intstr);
200 /* Do protocol to assert ourself as a selection owner.
203 x_own_selection (Lisp_Object selection_name, Lisp_Object selection_value,
204 Lisp_Object how_to_add, Lisp_Object selection_type)
206 struct device *d = decode_x_device (Qnil);
207 Display *display = DEVICE_X_DISPLAY (d);
208 struct frame *sel_frame = selected_frame ();
209 Window selecting_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
210 Lisp_Object selection_time;
211 /* Use the time of the last-read mouse or keyboard event.
212 For selection purposes, we use this as a sleazy way of knowing what the
213 current time is in server-time. This assumes that the most recently read
214 mouse or keyboard event has something to do with the assertion of the
215 selection, which is probably true.
217 Time thyme = DEVICE_X_MOUSE_TIMESTAMP (d);
220 CHECK_SYMBOL (selection_name);
221 selection_atom = symbol_to_x_atom (d, selection_name, 0);
223 XSetSelectionOwner (display, selection_atom, selecting_window, thyme);
225 /* We do NOT use time_to_lisp() here any more, like we used to.
226 That assumed equivalence of time_t and Time, which is not
227 necessarily the case (e.g. under OSF on the Alphas, where
228 Time is a 64-bit quantity and time_t is a 32-bit quantity).
230 Opaque pointers are the clean way to go here.
232 selection_time = make_opaque (&thyme, sizeof (thyme));
234 #ifdef MOTIF_CLIPBOARDS
235 hack_motif_clipboard_selection (selection_atom, selection_value,
236 thyme, display, selecting_window);
238 return selection_time;
241 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
243 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
244 static void motif_clipboard_cb ();
248 hack_motif_clipboard_selection (Atom selection_atom,
249 Lisp_Object selection_value,
252 Window selecting_window)
255 struct device *d = get_device_from_display (display);
256 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
257 their own non-Xlib non-Xt clipboard processing. So we have to do
258 this so that linked-in Motif widgets don't get themselves wedged.
260 if (selection_atom == DEVICE_XATOM_CLIPBOARD (d)
261 && STRINGP (selection_value)
263 /* If we already own the clipboard, don't own it again in the Motif
264 way. This might lose in some subtle way, since the timestamp won't
265 be current, but owning the selection on the Motif way does a
266 SHITLOAD of X protocol, and it makes killing text be incredibly
267 slow when using an X terminal. ARRRRGGGHHH!!!!
269 /* No, this is no good, because then Motif text fields don't bother
270 to look up the new value, and you can't Copy from a buffer, Paste
271 into a text field, then Copy something else from the buffer and
272 paste it into the text field -- it pastes the first thing again. */
276 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
277 Widget widget = FRAME_X_TEXT_WIDGET (selected_frame());
280 #if XmVersion >= 1002
283 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
286 String encoding = "STRING";
287 const Bufbyte *data = XSTRING_DATA (selection_value);
288 Bytecount bytes = XSTRING_LENGTH (selection_value);
292 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
293 const Bufbyte *ptr = data, *end = ptr + bytes;
294 /* Optimize for the common ASCII case */
297 if (BYTE_ASCII_P (*ptr))
303 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
304 (*ptr) == LEADING_BYTE_CONTROL_1)
315 if (chartypes == LATIN_1)
316 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
317 ALLOCA, (data, bytes),
319 else if (chartypes == WORLD)
321 TO_EXTERNAL_FORMAT (LISP_STRING, selection_value,
322 ALLOCA, (data, bytes),
324 encoding = "COMPOUND_TEXT";
329 fmh = XmStringCreateLtoR ("Clipboard", XmSTRING_DEFAULT_CHARSET);
330 while (ClipboardSuccess !=
331 XmClipboardStartCopy (display, selecting_window, fmh, thyme,
332 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
333 widget, motif_clipboard_cb,
340 while (ClipboardSuccess !=
341 XmClipboardCopy (display, selecting_window, itemid, encoding,
342 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
343 /* O'Reilly examples say size can be 0,
344 but this clearly is not the case. */
345 0, bytes, (int) selecting_window, /* private id */
346 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
347 (XtPointer) data, bytes, 0,
348 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
351 while (ClipboardSuccess !=
352 XmClipboardEndCopy (display, selecting_window, itemid))
357 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
358 /* I tried to treat the clipboard like a real selection, and not send
359 the data until it was requested, but it looks like that just doesn't
360 work at all unless the selection owner and requestor are in different
361 processes. From reading the Motif source, it looks like they never
362 even considered having two widgets in the same application transfer
363 data between each other using "by-name" clipboard values. What a
367 motif_clipboard_cb (Widget widget, int *data_id, int *private_id, int *reason)
371 case XmCR_CLIPBOARD_DATA_REQUEST:
373 Display *dpy = XtDisplay (widget);
374 Window window = (Window) *private_id;
375 Lisp_Object selection = select_convert_out (QCLIPBOARD, Qnil, Qnil);
377 /* Whichever lazy git wrote this originally just called abort()
378 when anything didn't go their way... */
380 /* Try some other text types */
381 if (NILP (selection))
382 selection = select_convert_out (QCLIPBOARD, QSTRING, Qnil);
383 if (NILP (selection))
384 selection = select_convert_out (QCLIPBOARD, QTEXT, Qnil);
385 if (NILP (selection))
386 selection = select_convert_out (QCLIPBOARD, QCOMPOUND_TEXT, Qnil);
388 if (CONSP (selection) && SYMBOLP (XCAR (selection))
389 && (EQ (XCAR (selection), QSTRING)
390 || EQ (XCAR (selection), QTEXT)
391 || EQ (XCAR (selection), QCOMPOUND_TEXT)))
392 selection = XCDR (selection);
394 if (NILP (selection))
395 signal_error (Qselection_conversion_error,
396 build_string ("no selection"));
398 if (!STRINGP (selection))
399 signal_error (Qselection_conversion_error,
400 build_string ("couldn't convert selection to string"));
403 XmClipboardCopyByName (dpy, window, *data_id,
404 (char *) XSTRING_DATA (selection),
405 XSTRING_LENGTH (selection) + 1,
409 case XmCR_CLIPBOARD_DATA_DELETE:
411 /* don't need to free anything */
415 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
416 #endif /* MOTIF_CLIPBOARDS */
421 /* Send a SelectionNotify event to the requestor with property=None, meaning
422 we were unable to do what they wanted.
425 x_decline_selection_request (XSelectionRequestEvent *event)
427 XSelectionEvent reply;
428 reply.type = SelectionNotify;
429 reply.display = event->display;
430 reply.requestor = event->requestor;
431 reply.selection = event->selection;
432 reply.time = event->time;
433 reply.target = event->target;
434 reply.property = None;
436 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
437 XFlush (reply.display);
441 /* Used as an unwind-protect clause so that, if a selection-converter signals
442 an error, we tell the requestor that we were unable to do what they wanted
443 before we throw to top-level or go into the debugger or whatever.
446 x_selection_request_lisp_error (Lisp_Object closure)
448 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
449 get_opaque_ptr (closure);
451 free_opaque_ptr (closure);
452 if (event->type == 0) /* we set this to mean "completed normally" */
454 x_decline_selection_request (event);
459 /* Convert our selection to the requested type, and put that data where the
460 requestor wants it. Then tell them whether we've succeeded.
463 x_reply_selection_request (XSelectionRequestEvent *event, int format,
464 unsigned char *data, int size, Atom type)
466 /* This function can GC */
467 XSelectionEvent reply;
468 Display *display = event->display;
469 struct device *d = get_device_from_display (display);
470 Window window = event->requestor;
472 int format_bytes = format/8;
473 int max_bytes = SELECTION_QUANTUM (display);
474 if (max_bytes > MAX_SELECTION_QUANTUM) max_bytes = MAX_SELECTION_QUANTUM;
476 reply.type = SelectionNotify;
477 reply.display = display;
478 reply.requestor = window;
479 reply.selection = event->selection;
480 reply.time = event->time;
481 reply.target = event->target;
482 reply.property = (event->property == None ? event->target : event->property);
484 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
486 /* Store the data on the requested property.
487 If the selection is large, only store the first N bytes of it.
489 bytes_remaining = size * format_bytes;
490 if (bytes_remaining <= max_bytes)
492 /* Send all the data at once, with minimal handshaking. */
494 stderr_out ("\nStoring all %d\n", bytes_remaining);
496 XChangeProperty (display, window, reply.property, type, format,
497 PropModeReplace, data, size);
498 /* At this point, the selection was successfully stored; ack it. */
499 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
504 /* Send an INCR selection. */
507 if (x_window_to_frame (d, window)) /* #### debug */
508 error ("attempt to transfer an INCR to ourself!");
510 stderr_out ("\nINCR %d\n", bytes_remaining);
512 prop_id = expect_property_change (display, window, reply.property,
515 XChangeProperty (display, window, reply.property, DEVICE_XATOM_INCR (d),
516 32, PropModeReplace, (unsigned char *)
517 &bytes_remaining, 1);
518 XSelectInput (display, window, PropertyChangeMask);
519 /* Tell 'em the INCR data is there... */
520 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
523 /* First, wait for the requestor to ack by deleting the property.
524 This can run random lisp code (process handlers) or signal.
526 wait_for_property_change (prop_id);
528 while (bytes_remaining)
530 int i = ((bytes_remaining < max_bytes)
533 prop_id = expect_property_change (display, window, reply.property,
536 stderr_out (" INCR adding %d\n", i);
538 /* Append the next chunk of data to the property. */
539 XChangeProperty (display, window, reply.property, type, format,
540 PropModeAppend, data, i / format_bytes);
541 bytes_remaining -= i;
544 /* Now wait for the requestor to ack this chunk by deleting the
545 property. This can run random lisp code or signal.
547 wait_for_property_change (prop_id);
549 /* Now write a zero-length chunk to the property to tell the requestor
552 stderr_out (" INCR done\n");
554 if (! waiting_for_other_props_on_window (display, window))
555 XSelectInput (display, window, 0L);
557 XChangeProperty (display, window, reply.property, type, format,
558 PropModeReplace, data, 0);
564 /* Called from the event-loop in response to a SelectionRequest event.
567 x_handle_selection_request (XSelectionRequestEvent *event)
569 /* This function can GC */
570 struct gcpro gcpro1, gcpro2;
571 Lisp_Object temp_obj;
572 Lisp_Object selection_symbol;
573 Lisp_Object target_symbol = Qnil;
574 Lisp_Object converted_selection = Qnil;
575 Time local_selection_time;
576 Lisp_Object successful_p = Qnil;
578 struct device *d = get_device_from_display (event->display);
580 GCPRO2 (converted_selection, target_symbol);
582 selection_symbol = x_atom_to_symbol (d, event->selection);
583 target_symbol = x_atom_to_symbol (d, event->target);
585 #if 0 /* #### MULTIPLE doesn't work yet */
586 if (EQ (target_symbol, QMULTIPLE))
587 target_symbol = fetch_multiple_target (event);
590 temp_obj = Fget_selection_timestamp (selection_symbol);
594 /* We don't appear to have the selection. */
595 x_decline_selection_request (event);
600 local_selection_time = * (Time *) XOPAQUE_DATA (temp_obj);
602 if (event->time != CurrentTime &&
603 local_selection_time > event->time)
605 /* Someone asked for the selection, and we have one, but not the one
606 they're looking for. */
607 x_decline_selection_request (event);
611 converted_selection = select_convert_out (selection_symbol,
612 target_symbol, Qnil);
614 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
615 if (NILP (converted_selection))
617 /* We don't appear to have a selection in that data type. */
618 x_decline_selection_request (event);
622 count = specpdl_depth ();
623 record_unwind_protect (x_selection_request_lisp_error,
624 make_opaque_ptr (event));
631 lisp_data_to_selection_data (d, converted_selection,
632 &data, &type, &size, &format);
634 x_reply_selection_request (event, format, data, size, type);
636 /* Tell x_selection_request_lisp_error() it's cool. */
641 unbind_to (count, Qnil);
647 /* Let random lisp code notice that the selection has been asked for. */
649 Lisp_Object val = Vx_sent_selection_hooks;
650 if (!UNBOUNDP (val) && !NILP (val))
653 if (CONSP (val) && !EQ (XCAR (val), Qlambda))
654 for (rest = val; !NILP (rest); rest = Fcdr (rest))
655 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
657 call3 (val, selection_symbol, target_symbol, successful_p);
663 /* Called from the event-loop in response to a SelectionClear event.
666 x_handle_selection_clear (XSelectionClearEvent *event)
668 Display *display = event->display;
669 struct device *d = get_device_from_display (display);
670 Atom selection = event->selection;
671 Time changed_owner_time = event->time;
673 Lisp_Object selection_symbol, local_selection_time_lisp;
674 Time local_selection_time;
676 selection_symbol = x_atom_to_symbol (d, selection);
678 local_selection_time_lisp = Fget_selection_timestamp (selection_symbol);
680 /* We don't own the selection, so that's fine. */
681 if (NILP (local_selection_time_lisp))
684 local_selection_time = * (Time *) XOPAQUE_DATA (local_selection_time_lisp);
686 /* This SelectionClear is for a selection that we no longer own, so we can
687 disregard it. (That is, we have reasserted the selection since this
688 request was generated.)
690 if (changed_owner_time != CurrentTime &&
691 local_selection_time > changed_owner_time)
694 handle_selection_clear (selection_symbol);
698 /* This stuff is so that INCR selections are reentrant (that is, so we can
699 be servicing multiple INCR selection requests simultaneously). I haven't
700 actually tested that yet.
703 static int prop_location_tick;
705 static struct prop_location {
711 struct prop_location *next;
712 } *for_whom_the_bell_tolls;
716 property_deleted_p (void *tick)
718 struct prop_location *rest = for_whom_the_bell_tolls;
720 if (rest->tick == (long) tick)
728 waiting_for_other_props_on_window (Display *display, Window window)
730 struct prop_location *rest = for_whom_the_bell_tolls;
732 if (rest->display == display && rest->window == window)
741 expect_property_change (Display *display, Window window,
742 Atom property, int state)
744 struct prop_location *pl = xnew (struct prop_location);
745 pl->tick = ++prop_location_tick;
746 pl->display = display;
748 pl->property = property;
749 pl->desired_state = state;
750 pl->next = for_whom_the_bell_tolls;
751 for_whom_the_bell_tolls = pl;
756 unexpect_property_change (int tick)
758 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
761 if (rest->tick == tick)
764 prev->next = rest->next;
766 for_whom_the_bell_tolls = rest->next;
776 wait_for_property_change (long tick)
778 /* This function can GC */
779 wait_delaying_user_input (property_deleted_p, (void *) tick);
783 /* Called from the event-loop in response to a PropertyNotify event.
786 x_handle_property_notify (XPropertyEvent *event)
788 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
791 if (rest->property == event->atom &&
792 rest->window == event->window &&
793 rest->display == event->display &&
794 rest->desired_state == event->state)
797 stderr_out ("Saw expected 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);
802 prev->next = rest->next;
804 for_whom_the_bell_tolls = rest->next;
812 stderr_out ("Saw UNexpected prop-%s on %s\n",
813 (event->state == PropertyDelete ? "delete" : "change"),
814 (char *) string_data (XSYMBOL (x_atom_to_symbol (get_device_from_display (event->display), event->atom))->name));
820 #if 0 /* #### MULTIPLE doesn't work yet */
823 fetch_multiple_target (XSelectionRequestEvent *event)
825 /* This function can GC */
826 Display *display = event->display;
827 Window window = event->requestor;
828 Atom target = event->target;
829 Atom selection_atom = event->selection;
834 x_get_window_property_as_lisp_data (display, window, target,
840 copy_multiple_data (Lisp_Object obj)
846 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
849 len = XVECTOR_LENGTH (obj);
850 vec = make_vector (len, Qnil);
851 for (i = 0; i < len; i++)
853 Lisp_Object vec2 = XVECTOR_DATA (obj) [i];
855 if (XVECTOR_LENGTH (vec2) != 2)
856 signal_error (Qerror, list2 (build_string
857 ("vectors must be of length 2"),
859 XVECTOR_DATA (vec) [i] = make_vector (2, Qnil);
860 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [0] = XVECTOR_DATA (vec2) [0];
861 XVECTOR_DATA (XVECTOR_DATA (vec) [i]) [1] = XVECTOR_DATA (vec2) [1];
869 static Window reading_selection_reply;
870 static Atom reading_which_selection;
871 static int selection_reply_timed_out;
874 selection_reply_done (void *ignore)
876 return !reading_selection_reply;
879 static Lisp_Object Qx_selection_reply_timeout_internal;
881 DEFUN ("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal,
886 selection_reply_timed_out = 1;
887 reading_selection_reply = 0;
892 /* Do protocol to read selection-data from the server.
893 Converts this to lisp data and returns it.
896 x_get_foreign_selection (Lisp_Object selection_symbol, Lisp_Object target_type)
898 /* This function can GC */
899 struct device *d = decode_x_device (Qnil);
900 Display *display = DEVICE_X_DISPLAY (d);
901 struct frame *sel_frame = selected_frame ();
902 Window requestor_window = XtWindow (FRAME_X_TEXT_WIDGET (sel_frame));
903 Time requestor_time = DEVICE_X_MOUSE_TIMESTAMP (d);
904 Atom target_property = DEVICE_XATOM_EMACS_TMP (d);
905 Atom selection_atom = symbol_to_x_atom (d, selection_symbol, 0);
907 Atom type_atom = symbol_to_x_atom (d, (CONSP (target_type) ?
908 XCAR (target_type) : target_type), 0);
910 XConvertSelection (display, selection_atom, type_atom, target_property,
911 requestor_window, requestor_time);
913 /* Block until the reply has been read. */
914 reading_selection_reply = requestor_window;
915 reading_which_selection = selection_atom;
916 selection_reply_timed_out = 0;
918 speccount = specpdl_depth ();
920 /* add a timeout handler */
921 if (x_selection_timeout > 0)
923 Lisp_Object id = Fadd_timeout (make_int (x_selection_timeout),
924 Qx_selection_reply_timeout_internal,
926 record_unwind_protect (Fdisable_timeout, id);
930 wait_delaying_user_input (selection_reply_done, 0);
932 if (selection_reply_timed_out)
933 error ("timed out waiting for reply from selection owner");
935 unbind_to (speccount, Qnil);
937 /* otherwise, the selection is waiting for us on the requested property. */
939 return select_convert_in (selection_symbol,
941 x_get_window_property_as_lisp_data(display,
950 x_get_window_property (Display *display, Window window, Atom property,
951 Extbyte **data_ret, int *bytes_ret,
952 Atom *actual_type_ret, int *actual_format_ret,
953 unsigned long *actual_size_ret, int delete_p)
956 unsigned long bytes_remaining;
958 unsigned char *tmp_data = 0;
960 int buffer_size = SELECTION_QUANTUM (display);
961 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
963 /* First probe the thing to find out how big it is. */
964 result = XGetWindowProperty (display, window, property,
965 0, 0, False, AnyPropertyType,
966 actual_type_ret, actual_format_ret,
968 &bytes_remaining, &tmp_data);
969 if (result != Success)
975 XFree ((char *) tmp_data);
977 if (*actual_type_ret == None || *actual_format_ret == 0)
979 if (delete_p) XDeleteProperty (display, window, property);
985 total_size = bytes_remaining + 1;
986 *data_ret = (Extbyte *) xmalloc (total_size);
988 /* Now read, until we've gotten it all. */
989 while (bytes_remaining)
992 int last = bytes_remaining;
995 XGetWindowProperty (display, window, property,
996 offset/4, buffer_size/4,
997 (delete_p ? True : False),
999 actual_type_ret, actual_format_ret,
1000 actual_size_ret, &bytes_remaining, &tmp_data);
1002 stderr_out ("<< read %d\n", last-bytes_remaining);
1004 /* If this doesn't return Success at this point, it means that
1005 some clod deleted the selection while we were in the midst of
1006 reading it. Deal with that, I guess....
1008 if (result != Success) break;
1009 *actual_size_ret *= *actual_format_ret / 8;
1010 memcpy ((*data_ret) + offset, tmp_data, *actual_size_ret);
1011 offset += *actual_size_ret;
1012 XFree ((char *) tmp_data);
1014 *bytes_ret = offset;
1019 receive_incremental_selection (Display *display, Window window, Atom property,
1020 /* this one is for error messages only */
1021 Lisp_Object target_type,
1022 unsigned int min_size_bytes,
1023 Extbyte **data_ret, int *size_bytes_ret,
1024 Atom *type_ret, int *format_ret,
1025 unsigned long *size_ret)
1027 /* This function can GC */
1030 *size_bytes_ret = min_size_bytes;
1031 *data_ret = (Extbyte *) xmalloc (*size_bytes_ret);
1033 stderr_out ("\nread INCR %d\n", min_size_bytes);
1035 /* At this point, we have read an INCR property, and deleted it (which
1036 is how we ack its receipt: the sending window will be selecting
1037 PropertyNotify events on our window to notice this).
1039 Now, we must loop, waiting for the sending window to put a value on
1040 that property, then reading the property, then deleting it to ack.
1041 We are done when the sender places a property of length 0.
1043 prop_id = expect_property_change (display, window, property,
1049 wait_for_property_change (prop_id);
1050 /* expect it again immediately, because x_get_window_property may
1051 .. no it won't, I don't get it.
1052 .. Ok, I get it now, the Xt code that implements INCR is broken.
1054 prop_id = expect_property_change (display, window, property,
1056 x_get_window_property (display, window, property,
1057 &tmp_data, &tmp_size_bytes,
1058 type_ret, format_ret, size_ret, 1);
1060 if (tmp_size_bytes == 0) /* we're done */
1063 stderr_out (" read INCR done\n");
1065 unexpect_property_change (prop_id);
1066 if (tmp_data) xfree (tmp_data);
1070 stderr_out (" read INCR %d\n", tmp_size_bytes);
1072 if (*size_bytes_ret < offset + tmp_size_bytes)
1075 stderr_out (" read INCR realloc %d -> %d\n",
1076 *size_bytes_ret, offset + tmp_size_bytes);
1078 *size_bytes_ret = offset + tmp_size_bytes;
1079 *data_ret = (Extbyte *) xrealloc (*data_ret, *size_bytes_ret);
1081 memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes);
1082 offset += tmp_size_bytes;
1089 x_get_window_property_as_lisp_data (Display *display,
1092 /* next two for error messages only */
1093 Lisp_Object target_type,
1094 Atom selection_atom)
1096 /* This function can GC */
1099 unsigned long actual_size;
1100 Extbyte *data = NULL;
1103 struct device *d = get_device_from_display (display);
1105 x_get_window_property (display, window, property, &data, &bytes,
1106 &actual_type, &actual_format, &actual_size, 1);
1109 if (XGetSelectionOwner (display, selection_atom))
1110 /* there is a selection owner */
1112 (Qselection_conversion_error,
1113 Fcons (build_string ("selection owner couldn't convert"),
1114 Fcons (x_atom_to_symbol (d, selection_atom),
1116 list2 (target_type, x_atom_to_symbol (d, actual_type)) :
1117 list1 (target_type))));
1119 signal_error (Qerror,
1120 list2 (build_string ("no selection"),
1121 x_atom_to_symbol (d, selection_atom)));
1124 if (actual_type == DEVICE_XATOM_INCR (d))
1126 /* Ok, that data wasn't *the* data, it was just the beginning. */
1128 unsigned int min_size_bytes = * ((unsigned int *) data);
1130 receive_incremental_selection (display, window, property, target_type,
1131 min_size_bytes, &data, &bytes,
1132 &actual_type, &actual_format,
1136 /* It's been read. Now convert it to a lisp object in some semi-rational
1138 val = selection_data_to_lisp_data (d, data, bytes,
1139 actual_type, actual_format);
1145 /* #### These are going to move into Lisp code(!) with the aid of
1146 some new functions I'm working on - ajh */
1148 /* These functions convert from the selection data read from the server into
1149 something that we can use from elisp, and vice versa.
1151 Type: Format: Size: Elisp Type:
1152 ----- ------- ----- -----------
1155 ATOM 32 > 1 Vector of Symbols
1157 * 16 > 1 Vector of Integers
1158 * 32 1 if <=16 bits: Integer
1159 if > 16 bits: Cons of top16, bot16
1160 * 32 > 1 Vector of the above
1162 When converting a Lisp number to C, it is assumed to be of format 16 if
1163 it is an integer, and of format 32 if it is a cons of two integers.
1165 When converting a vector of numbers from Elisp to C, it is assumed to be
1166 of format 16 if every element in the vector is an integer, and is assumed
1167 to be of format 32 if any element is a cons of two integers.
1169 When converting an object to C, it may be of the form (SYMBOL . <data>)
1170 where SYMBOL is what we should claim that the type is. Format and
1171 representation are as above.
1173 NOTE: Under Mule, when someone shoves us a string without a type, we
1174 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1175 Text. If the string has a type, we assume that the user wants the
1176 data sent as-is so we just do "binary" conversion.
1181 selection_data_to_lisp_data (struct device *d,
1187 if (type == DEVICE_XATOM_NULL (d))
1190 /* Convert any 8-bit data to a string, for compactness. */
1191 else if (format == 8)
1192 return make_ext_string (data, size,
1193 type == DEVICE_XATOM_TEXT (d) ||
1194 type == DEVICE_XATOM_COMPOUND_TEXT (d)
1195 ? Qctext : Qbinary);
1197 /* Convert a single atom to a Lisp Symbol.
1198 Convert a set of atoms to a vector of symbols. */
1199 else if (type == XA_ATOM)
1201 if (size == sizeof (Atom))
1202 return x_atom_to_symbol (d, *((Atom *) data));
1206 int len = size / sizeof (Atom);
1207 Lisp_Object v = Fmake_vector (make_int (len), Qzero);
1208 for (i = 0; i < len; i++)
1209 Faset (v, make_int (i), x_atom_to_symbol (d, ((Atom *) data) [i]));
1214 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1215 If the number is > 16 bits, convert it to a cons of integers,
1216 16 bits in each half.
1218 else if (format == 32 && size == sizeof (long))
1219 return word_to_lisp (((unsigned long *) data) [0]);
1220 else if (format == 16 && size == sizeof (short))
1221 return make_int ((int) (((unsigned short *) data) [0]));
1223 /* Convert any other kind of data to a vector of numbers, represented
1224 as above (as an integer, or a cons of two 16 bit integers).
1226 #### Perhaps we should return the actual type to lisp as well.
1228 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1231 and perhaps it should be
1233 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1236 Right now the fact that the return type was SPAN is discarded before
1237 lisp code gets to see it.
1239 else if (format == 16)
1242 Lisp_Object v = make_vector (size / 4, Qzero);
1243 for (i = 0; i < (int) size / 4; i++)
1245 int j = (int) ((unsigned short *) data) [i];
1246 Faset (v, make_int (i), make_int (j));
1253 Lisp_Object v = make_vector (size / 4, Qzero);
1254 for (i = 0; i < (int) size / 4; i++)
1256 unsigned long j = ((unsigned long *) data) [i];
1257 Faset (v, make_int (i), word_to_lisp (j));
1265 lisp_data_to_selection_data (struct device *d,
1267 unsigned char **data_ret,
1269 unsigned int *size_ret,
1272 Lisp_Object type = Qnil;
1274 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1278 if (CONSP (obj) && NILP (XCDR (obj)))
1282 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1283 { /* This is not the same as declining */
1289 else if (STRINGP (obj))
1291 const Extbyte *extval;
1294 TO_EXTERNAL_FORMAT (LISP_STRING, obj,
1295 ALLOCA, (extval, extvallen),
1296 (NILP (type) ? Qctext : Qbinary));
1298 *size_ret = extvallen;
1299 *data_ret = (unsigned char *) xmalloc (*size_ret);
1300 memcpy (*data_ret, extval, *size_ret);
1302 if (NILP (type)) type = QCOMPOUND_TEXT;
1304 if (NILP (type)) type = QSTRING;
1307 else if (CHARP (obj))
1309 Bufbyte buf[MAX_EMCHAR_LEN];
1311 const Extbyte *extval;
1315 len = set_charptr_emchar (buf, XCHAR (obj));
1316 TO_EXTERNAL_FORMAT (DATA, (buf, len),
1317 ALLOCA, (extval, extvallen),
1319 *size_ret = extvallen;
1320 *data_ret = (unsigned char *) xmalloc (*size_ret);
1321 memcpy (*data_ret, extval, *size_ret);
1323 if (NILP (type)) type = QCOMPOUND_TEXT;
1325 if (NILP (type)) type = QSTRING;
1328 else if (SYMBOLP (obj))
1332 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1333 (*data_ret) [sizeof (Atom)] = 0;
1334 (*(Atom **) data_ret) [0] = symbol_to_x_atom (d, obj, 0);
1335 if (NILP (type)) type = QATOM;
1337 else if (INTP (obj) &&
1338 XINT (obj) <= 0x7FFF &&
1339 XINT (obj) >= -0x8000)
1343 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1344 (*data_ret) [sizeof (short)] = 0;
1345 (*(short **) data_ret) [0] = (short) XINT (obj);
1346 if (NILP (type)) type = QINTEGER;
1348 else if (INTP (obj) || CONSP (obj))
1352 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1353 (*data_ret) [sizeof (long)] = 0;
1354 (*(unsigned long **) data_ret) [0] = lisp_to_word (obj);
1355 if (NILP (type)) type = QINTEGER;
1357 else if (VECTORP (obj))
1359 /* Lisp Vectors may represent a set of ATOMs;
1360 a set of 16 or 32 bit INTEGERs;
1361 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1365 if (SYMBOLP (XVECTOR_DATA (obj) [0]))
1366 /* This vector is an ATOM set */
1368 if (NILP (type)) type = QATOM;
1369 *size_ret = XVECTOR_LENGTH (obj);
1371 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1372 for (i = 0; i < (int) (*size_ret); i++)
1373 if (SYMBOLP (XVECTOR_DATA (obj) [i]))
1374 (*(Atom **) data_ret) [i] =
1375 symbol_to_x_atom (d, XVECTOR_DATA (obj) [i], 0);
1377 signal_error (Qerror, /* Qselection_error */
1379 ("all elements of the vector must be of the same type"),
1382 #if 0 /* #### MULTIPLE doesn't work yet */
1383 else if (VECTORP (XVECTOR_DATA (obj) [0]))
1384 /* This vector is an ATOM_PAIR set */
1386 if (NILP (type)) type = QATOM_PAIR;
1387 *size_ret = XVECTOR_LENGTH (obj);
1389 *data_ret = (unsigned char *)
1390 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1391 for (i = 0; i < *size_ret; i++)
1392 if (VECTORP (XVECTOR_DATA (obj) [i]))
1394 Lisp_Object pair = XVECTOR_DATA (obj) [i];
1395 if (XVECTOR_LENGTH (pair) != 2)
1396 signal_error (Qerror,
1398 ("elements of the vector must be vectors of exactly two elements"),
1401 (*(Atom **) data_ret) [i * 2] =
1402 symbol_to_x_atom (d, XVECTOR_DATA (pair) [0], 0);
1403 (*(Atom **) data_ret) [(i * 2) + 1] =
1404 symbol_to_x_atom (d, XVECTOR_DATA (pair) [1], 0);
1407 signal_error (Qerror,
1409 ("all elements of the vector must be of the same type"),
1414 /* This vector is an INTEGER set, or something like it */
1416 *size_ret = XVECTOR_LENGTH (obj);
1417 if (NILP (type)) type = QINTEGER;
1419 for (i = 0; i < (int) (*size_ret); i++)
1420 if (CONSP (XVECTOR_DATA (obj) [i]))
1422 else if (!INTP (XVECTOR_DATA (obj) [i]))
1423 signal_error (Qerror, /* Qselection_error */
1425 ("all elements of the vector must be integers or conses of integers"),
1428 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1429 for (i = 0; i < (int) (*size_ret); i++)
1430 if (*format_ret == 32)
1431 (*((unsigned long **) data_ret)) [i] =
1432 lisp_to_word (XVECTOR_DATA (obj) [i]);
1434 (*((unsigned short **) data_ret)) [i] =
1435 (unsigned short) lisp_to_word (XVECTOR_DATA (obj) [i]);
1439 signal_error (Qerror, /* Qselection_error */
1440 list2 (build_string ("unrecognized selection data"),
1443 *type_ret = symbol_to_x_atom (d, type, 0);
1448 /* Called from the event loop to handle SelectionNotify events.
1449 I don't think this needs to be reentrant.
1452 x_handle_selection_notify (XSelectionEvent *event)
1454 if (! reading_selection_reply)
1455 message ("received an unexpected SelectionNotify event");
1456 else if (event->requestor != reading_selection_reply)
1457 message ("received a SelectionNotify event for the wrong window");
1458 else if (event->selection != reading_which_selection)
1459 message ("received the wrong selection type in SelectionNotify!");
1461 reading_selection_reply = 0; /* we're done now. */
1465 x_disown_selection (Lisp_Object selection, Lisp_Object timeval)
1467 struct device *d = decode_x_device (Qnil);
1468 Display *display = DEVICE_X_DISPLAY (d);
1470 Atom selection_atom;
1472 CHECK_SYMBOL (selection);
1474 timestamp = DEVICE_X_MOUSE_TIMESTAMP (d);
1477 /* #### This is bogus. See the comment above about problems
1478 on OSF/1 and DEC Alphas. Yet another reason why it sucks
1479 to have the implementation (i.e. cons of two 16-bit
1480 integers) exposed. */
1482 lisp_to_time (timeval, &the_time);
1483 timestamp = (Time) the_time;
1486 selection_atom = symbol_to_x_atom (d, selection, 0);
1488 XSetSelectionOwner (display, selection_atom, None, timestamp);
1492 x_selection_exists_p (Lisp_Object selection,
1493 Lisp_Object selection_type)
1495 struct device *d = decode_x_device (Qnil);
1496 Display *dpy = DEVICE_X_DISPLAY (d);
1497 return XGetSelectionOwner (dpy, symbol_to_x_atom (d, selection, 0)) != None ?
1502 #ifdef CUT_BUFFER_SUPPORT
1504 static int cut_buffers_initialized; /* Whether we're sure they all exist */
1506 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1508 initialize_cut_buffers (Display *display, Window window)
1510 static unsigned const char * const data = (unsigned const char *) "";
1511 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1512 PropModeAppend, data, 0)
1513 FROB (XA_CUT_BUFFER0);
1514 FROB (XA_CUT_BUFFER1);
1515 FROB (XA_CUT_BUFFER2);
1516 FROB (XA_CUT_BUFFER3);
1517 FROB (XA_CUT_BUFFER4);
1518 FROB (XA_CUT_BUFFER5);
1519 FROB (XA_CUT_BUFFER6);
1520 FROB (XA_CUT_BUFFER7);
1522 cut_buffers_initialized = 1;
1525 #define CHECK_CUTBUFFER(symbol) do { \
1526 CHECK_SYMBOL (symbol); \
1527 if (! (EQ (symbol, QCUT_BUFFER0) || \
1528 EQ (symbol, QCUT_BUFFER1) || \
1529 EQ (symbol, QCUT_BUFFER2) || \
1530 EQ (symbol, QCUT_BUFFER3) || \
1531 EQ (symbol, QCUT_BUFFER4) || \
1532 EQ (symbol, QCUT_BUFFER5) || \
1533 EQ (symbol, QCUT_BUFFER6) || \
1534 EQ (symbol, QCUT_BUFFER7))) \
1535 signal_simple_error ("Doesn't name a cutbuffer", symbol); \
1538 DEFUN ("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1539 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1543 struct device *d = decode_x_device (Qnil);
1544 Display *display = DEVICE_X_DISPLAY (d);
1545 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1546 Atom cut_buffer_atom;
1554 CHECK_CUTBUFFER (cutbuffer);
1555 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1557 x_get_window_property (display, window, cut_buffer_atom, &data, &bytes,
1558 &type, &format, &size, 0);
1559 if (!data) return Qnil;
1561 if (format != 8 || type != XA_STRING)
1562 signal_simple_error_2 ("Cut buffer doesn't contain 8-bit STRING data",
1563 x_atom_to_symbol (d, type),
1566 /* We cheat - if the string contains an ESC character, that's
1567 technically not allowed in a STRING, so we assume it's
1568 COMPOUND_TEXT that we stored there ourselves earlier,
1569 in x-store-cutbuffer-internal */
1571 make_ext_string (data, bytes,
1572 memchr (data, 0x1b, bytes) ?
1580 DEFUN ("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
1581 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1583 (cutbuffer, string))
1585 struct device *d = decode_x_device (Qnil);
1586 Display *display = DEVICE_X_DISPLAY (d);
1587 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1588 Atom cut_buffer_atom;
1589 const Bufbyte *data = XSTRING_DATA (string);
1590 Bytecount bytes = XSTRING_LENGTH (string);
1591 Bytecount bytes_remaining;
1592 int max_bytes = SELECTION_QUANTUM (display);
1594 const Bufbyte *ptr, *end;
1595 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1598 if (max_bytes > MAX_SELECTION_QUANTUM)
1599 max_bytes = MAX_SELECTION_QUANTUM;
1601 CHECK_CUTBUFFER (cutbuffer);
1602 CHECK_STRING (string);
1603 cut_buffer_atom = symbol_to_x_atom (d, cutbuffer, 0);
1605 if (! cut_buffers_initialized)
1606 initialize_cut_buffers (display, window);
1608 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1609 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1610 The ICCCM requires that this be so, and other clients assume it,
1611 as we do ourselves in initialize_cut_buffers. */
1614 /* Optimize for the common ASCII case */
1615 for (ptr = data, end = ptr + bytes; ptr <= end; )
1617 if (BYTE_ASCII_P (*ptr))
1626 chartypes = LATIN_1;
1631 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
1632 (*ptr) == LEADING_BYTE_CONTROL_1)
1634 chartypes = LATIN_1;
1644 if (chartypes == LATIN_1)
1645 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1646 ALLOCA, (data, bytes),
1648 else if (chartypes == WORLD)
1649 TO_EXTERNAL_FORMAT (LISP_STRING, string,
1650 ALLOCA, (data, bytes),
1654 bytes_remaining = bytes;
1656 while (bytes_remaining)
1658 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1659 XChangeProperty (display, window, cut_buffer_atom, XA_STRING, 8,
1660 (bytes_remaining == bytes
1661 ? PropModeReplace : PropModeAppend),
1664 bytes_remaining -= chunk;
1670 DEFUN ("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
1671 Rotate the values of the cutbuffers by the given number of steps;
1672 positive means move values forward, negative means backward.
1676 struct device *d = decode_x_device (Qnil);
1677 Display *display = DEVICE_X_DISPLAY (d);
1678 Window window = RootWindow (display, 0); /* Cutbuffers are on frame 0 */
1684 if (! cut_buffers_initialized)
1685 initialize_cut_buffers (display, window);
1686 props[0] = XA_CUT_BUFFER0;
1687 props[1] = XA_CUT_BUFFER1;
1688 props[2] = XA_CUT_BUFFER2;
1689 props[3] = XA_CUT_BUFFER3;
1690 props[4] = XA_CUT_BUFFER4;
1691 props[5] = XA_CUT_BUFFER5;
1692 props[6] = XA_CUT_BUFFER6;
1693 props[7] = XA_CUT_BUFFER7;
1694 XRotateWindowProperties (display, window, props, 8, XINT (n));
1698 #endif /* CUT_BUFFER_SUPPORT */
1702 /************************************************************************/
1703 /* initialization */
1704 /************************************************************************/
1707 syms_of_select_x (void)
1710 #ifdef CUT_BUFFER_SUPPORT
1711 DEFSUBR (Fx_get_cutbuffer_internal);
1712 DEFSUBR (Fx_store_cutbuffer_internal);
1713 DEFSUBR (Fx_rotate_cutbuffers_internal);
1714 #endif /* CUT_BUFFER_SUPPORT */
1716 /* Unfortunately, timeout handlers must be lisp functions. */
1717 defsymbol (&Qx_selection_reply_timeout_internal,
1718 "x-selection-reply-timeout-internal");
1719 DEFSUBR (Fx_selection_reply_timeout_internal);
1721 #ifdef CUT_BUFFER_SUPPORT
1722 defsymbol (&QCUT_BUFFER0, "CUT_BUFFER0");
1723 defsymbol (&QCUT_BUFFER1, "CUT_BUFFER1");
1724 defsymbol (&QCUT_BUFFER2, "CUT_BUFFER2");
1725 defsymbol (&QCUT_BUFFER3, "CUT_BUFFER3");
1726 defsymbol (&QCUT_BUFFER4, "CUT_BUFFER4");
1727 defsymbol (&QCUT_BUFFER5, "CUT_BUFFER5");
1728 defsymbol (&QCUT_BUFFER6, "CUT_BUFFER6");
1729 defsymbol (&QCUT_BUFFER7, "CUT_BUFFER7");
1730 #endif /* CUT_BUFFER_SUPPORT */
1734 console_type_create_select_x (void)
1736 CONSOLE_HAS_METHOD (x, own_selection);
1737 CONSOLE_HAS_METHOD (x, disown_selection);
1738 CONSOLE_HAS_METHOD (x, get_foreign_selection);
1739 CONSOLE_HAS_METHOD (x, selection_exists_p);
1743 reinit_vars_of_select_x (void)
1745 reading_selection_reply = 0;
1746 reading_which_selection = 0;
1747 selection_reply_timed_out = 0;
1748 for_whom_the_bell_tolls = 0;
1749 prop_location_tick = 0;
1753 vars_of_select_x (void)
1755 reinit_vars_of_select_x ();
1757 #ifdef CUT_BUFFER_SUPPORT
1758 cut_buffers_initialized = 0;
1759 Fprovide (intern ("cut-buffer"));
1762 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
1763 A function or functions to be called after we have responded to some
1764 other client's request for the value of a selection that we own. The
1765 function(s) will be called with four arguments:
1766 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1767 - the name of the selection-type which we were requested to convert the
1768 selection into before sending (for example, STRING or LENGTH);
1769 - and whether we successfully transmitted the selection.
1770 We might have failed (and declined the request) for any number of reasons,
1771 including being asked for a selection that we no longer own, or being asked
1772 to convert into a type that we don't know about or that is inappropriate.
1773 This hook doesn't let you change the behavior of emacs's selection replies,
1774 it merely informs you that they have happened.
1776 Vx_sent_selection_hooks = Qunbound;
1778 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout /*
1779 If the selection owner doesn't reply in this many seconds, we give up.
1780 A value of 0 means wait as long as necessary. This is initialized from the
1781 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1783 x_selection_timeout = 0;
1787 Xatoms_of_select_x (struct device *d)
1789 Display *D = DEVICE_X_DISPLAY (d);
1791 /* Non-predefined atoms that we might end up using a lot */
1792 DEVICE_XATOM_CLIPBOARD (d) = XInternAtom (D, "CLIPBOARD", False);
1793 DEVICE_XATOM_TIMESTAMP (d) = XInternAtom (D, "TIMESTAMP", False);
1794 DEVICE_XATOM_TEXT (d) = XInternAtom (D, "TEXT", False);
1795 DEVICE_XATOM_DELETE (d) = XInternAtom (D, "DELETE", False);
1796 DEVICE_XATOM_MULTIPLE (d) = XInternAtom (D, "MULTIPLE", False);
1797 DEVICE_XATOM_INCR (d) = XInternAtom (D, "INCR", False);
1798 DEVICE_XATOM_TARGETS (d) = XInternAtom (D, "TARGETS", False);
1799 DEVICE_XATOM_NULL (d) = XInternAtom (D, "NULL", False);
1800 DEVICE_XATOM_ATOM_PAIR (d) = XInternAtom (D, "ATOM_PAIR", False);
1801 DEVICE_XATOM_COMPOUND_TEXT (d) = XInternAtom (D, "COMPOUND_TEXT", False);
1803 /* #### I don't like the looks of this... what is it for? - ajh */
1804 DEVICE_XATOM_EMACS_TMP (d) = XInternAtom (D, "_EMACS_TMP_", False);