1 /* X Selection processing for SXEmacs
2 Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
4 This file is part of SXEmacs
6 SXEmacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 SXEmacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* Synched up with: Not synched with FSF. */
22 /* Rewritten by jwz */
28 #include "console-x.h"
29 #include "objects-x.h"
34 #include "ui/select.h"
36 int lisp_to_time(Lisp_Object, time_t *);
37 Lisp_Object time_to_lisp(time_t);
39 #ifdef LWLIB_USES_MOTIF
40 # define MOTIF_CLIPBOARDS
43 #ifdef MOTIF_CLIPBOARDS
44 # include <Xm/CutPaste.h>
45 static void hack_motif_clipboard_selection(Atom selection_atom,
46 Lisp_Object selection_value,
47 Time thyme, Display * display,
48 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 Fixnum x_selection_timeout;
77 /* Enable motif selection optimizations. */
78 int x_selection_strict_motif_ownership;
80 /* Utility functions */
82 static void lisp_data_to_selection_data(struct device *, Lisp_Object obj,
83 unsigned char **data_ret, Atom * type_ret,
84 unsigned int *size_ret, int *format_ret);
85 static Lisp_Object selection_data_to_lisp_data(struct device *, Extbyte * data,
86 size_t size, Atom type, int format);
87 static Lisp_Object x_get_window_property_as_lisp_data(Display *, Window, Atom property,
88 Lisp_Object target_type, Atom selection_atom);
90 static int expect_property_change(Display *, Window, Atom prop, int state);
91 static void wait_for_property_change(long);
92 static void unexpect_property_change(int);
94 waiting_for_other_props_on_window(Display *, Window)
96 __attribute__((unused));
99 /* This converts a Lisp symbol to a server Atom, avoiding a server
100 roundtrip whenever possible.
103 symbol_to_x_atom(struct device *d, Lisp_Object sym, int only_if_exists)
105 Display *display = DEVICE_X_DISPLAY(d);
111 if (EQ(sym, QPRIMARY))
113 if (EQ(sym, QSECONDARY))
115 if (EQ(sym, QSTRING))
117 if (EQ(sym, QINTEGER))
121 if (EQ(sym, QCLIPBOARD))
122 return DEVICE_XATOM_CLIPBOARD(d);
123 if (EQ(sym, QTIMESTAMP))
124 return DEVICE_XATOM_TIMESTAMP(d);
126 return DEVICE_XATOM_TEXT(d);
127 if (EQ(sym, QDELETE))
128 return DEVICE_XATOM_DELETE(d);
129 if (EQ(sym, QMULTIPLE))
130 return DEVICE_XATOM_MULTIPLE(d);
132 return DEVICE_XATOM_INCR(d);
133 if (EQ(sym, QEMACS_TMP))
134 return DEVICE_XATOM_EMACS_TMP(d);
135 if (EQ(sym, QTARGETS))
136 return DEVICE_XATOM_TARGETS(d);
138 return DEVICE_XATOM_NULL(d);
139 if (EQ(sym, QATOM_PAIR))
140 return DEVICE_XATOM_ATOM_PAIR(d);
141 if (EQ(sym, QCOMPOUND_TEXT))
142 return DEVICE_XATOM_COMPOUND_TEXT(d);
144 #ifdef CUT_BUFFER_SUPPORT
145 if (EQ(sym, QCUT_BUFFER0))
146 return XA_CUT_BUFFER0;
147 if (EQ(sym, QCUT_BUFFER1))
148 return XA_CUT_BUFFER1;
149 if (EQ(sym, QCUT_BUFFER2))
150 return XA_CUT_BUFFER2;
151 if (EQ(sym, QCUT_BUFFER3))
152 return XA_CUT_BUFFER3;
153 if (EQ(sym, QCUT_BUFFER4))
154 return XA_CUT_BUFFER4;
155 if (EQ(sym, QCUT_BUFFER5))
156 return XA_CUT_BUFFER5;
157 if (EQ(sym, QCUT_BUFFER6))
158 return XA_CUT_BUFFER6;
159 if (EQ(sym, QCUT_BUFFER7))
160 return XA_CUT_BUFFER7;
161 #endif /* CUT_BUFFER_SUPPORT */
165 LISP_STRING_TO_EXTERNAL(Fsymbol_name(sym), nameext, Qctext);
166 return XInternAtom(display, nameext,
167 only_if_exists ? True : False);
171 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
172 and calls to intern whenever possible.
175 x_atom_to_symbol(struct device *d, Atom atom)
177 Display *display = DEVICE_X_DISPLAY(d);
181 if (atom == XA_PRIMARY)
183 if (atom == XA_SECONDARY)
185 if (atom == XA_STRING)
187 if (atom == XA_INTEGER)
191 if (atom == DEVICE_XATOM_CLIPBOARD(d))
193 if (atom == DEVICE_XATOM_TIMESTAMP(d))
195 if (atom == DEVICE_XATOM_TEXT(d))
197 if (atom == DEVICE_XATOM_DELETE(d))
199 if (atom == DEVICE_XATOM_MULTIPLE(d))
201 if (atom == DEVICE_XATOM_INCR(d))
203 if (atom == DEVICE_XATOM_EMACS_TMP(d))
205 if (atom == DEVICE_XATOM_TARGETS(d))
207 if (atom == DEVICE_XATOM_NULL(d))
209 if (atom == DEVICE_XATOM_ATOM_PAIR(d))
211 if (atom == DEVICE_XATOM_COMPOUND_TEXT(d))
212 return QCOMPOUND_TEXT;
214 #ifdef CUT_BUFFER_SUPPORT
215 if (atom == XA_CUT_BUFFER0)
217 if (atom == XA_CUT_BUFFER1)
219 if (atom == XA_CUT_BUFFER2)
221 if (atom == XA_CUT_BUFFER3)
223 if (atom == XA_CUT_BUFFER4)
225 if (atom == XA_CUT_BUFFER5)
227 if (atom == XA_CUT_BUFFER6)
229 if (atom == XA_CUT_BUFFER7)
235 char *str = XGetAtomName(display, atom);
240 TO_INTERNAL_FORMAT(C_STRING, str,
241 C_STRING_ALLOCA, intstr, Qctext);
243 return intern(intstr);
247 /* Do protocol to assert ourself as a selection owner.
250 x_own_selection(Lisp_Object selection_name, Lisp_Object selection_value,
251 Lisp_Object how_to_add, Lisp_Object selection_type, int owned_p)
253 struct device *d = decode_x_device(Qnil);
254 Display *display = DEVICE_X_DISPLAY(d);
255 struct frame *sel_frame = selected_frame();
256 Window selecting_window = XtWindow(FRAME_X_TEXT_WIDGET(sel_frame));
257 Lisp_Object selection_time;
258 /* Use the time of the last-read mouse or keyboard event.
259 For selection purposes, we use this as a sleazy way of knowing what the
260 current time is in server-time. This assumes that the most recently read
261 mouse or keyboard event has something to do with the assertion of the
262 selection, which is probably true.
264 Time thyme = DEVICE_X_MOUSE_TIMESTAMP(d);
267 CHECK_SYMBOL(selection_name);
268 selection_atom = symbol_to_x_atom(d, selection_name, 0);
270 XSetSelectionOwner(display, selection_atom, selecting_window, thyme);
272 /* We do NOT use time_to_lisp() here any more, like we used to.
273 That assumed equivalence of time_t and Time, which is not
274 necessarily the case (e.g. under OSF on the Alphas, where
275 Time is a 64-bit quantity and time_t is a 32-bit quantity).
277 Opaque pointers are the clean way to go here.
279 selection_time = make_opaque(&thyme, sizeof(thyme));
281 #ifdef MOTIF_CLIPBOARDS
282 hack_motif_clipboard_selection(selection_atom, selection_value,
283 thyme, display, selecting_window,
286 return selection_time;
289 #ifdef MOTIF_CLIPBOARDS /* Bend over baby. Take it and like it. */
291 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
292 static void motif_clipboard_cb();
296 hack_motif_clipboard_selection(Atom selection_atom,
297 Lisp_Object selection_value,
300 Window selecting_window, int owned_p)
302 struct device *d = get_device_from_display(display);
303 /* Those Motif wankers can't be bothered to follow the ICCCM, and do
304 their own non-Xlib non-Xt clipboard processing. So we have to do
305 this so that linked-in Motif widgets don't get themselves wedged.
307 if (selection_atom == DEVICE_XATOM_CLIPBOARD(d)
308 && STRINGP(selection_value)
310 /* If we already own the clipboard, don't own it again in the Motif
311 way. This might lose in some subtle way, since the timestamp won't
312 be current, but owning the selection on the Motif way does a
313 SHITLOAD of X protocol, and it makes killing text be incredibly
314 slow when using an X terminal. ARRRRGGGHHH!!!!
316 /* No, this is no good, because then Motif text fields don't bother
317 to look up the new value, and you can't Copy from a buffer, Paste
318 into a text field, then Copy something else from the buffer and
319 paste it into the text field -- it pastes the first thing again. */
321 /* Selectively re-enable this because for most users its
322 just too painful - especially over a remote link. */
323 || x_selection_strict_motif_ownership)
325 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
326 Widget widget = FRAME_X_TEXT_WIDGET(selected_frame());
329 #if XmVersion >= 1002
332 int dataid; /* 1.2 wants long, but 1.1.5 wants int... */
335 String encoding = "STRING";
336 const Bufbyte *data = XSTRING_DATA(selection_value);
337 Bytecount bytes = XSTRING_LENGTH(selection_value);
341 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
342 const Bufbyte *ptr = data, *end = ptr + bytes;
343 /* Optimize for the common ASCII case */
345 if (BYTE_ASCII_P(*ptr)) {
350 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1 ||
351 (*ptr) == LEADING_BYTE_CONTROL_1) {
361 if (chartypes == LATIN_1)
362 TO_EXTERNAL_FORMAT(LISP_STRING, selection_value,
363 ALLOCA, (data, bytes),
365 else if (chartypes == WORLD) {
366 TO_EXTERNAL_FORMAT(LISP_STRING, selection_value,
367 ALLOCA, (data, bytes),
369 encoding = "COMPOUND_TEXT";
374 fmh = XmStringCreateLtoR("Clipboard", XmSTRING_DEFAULT_CHARSET);
375 while (ClipboardSuccess !=
376 XmClipboardStartCopy(display, selecting_window, fmh,
378 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
379 widget, motif_clipboard_cb,
385 while (ClipboardSuccess !=
386 XmClipboardCopy(display, selecting_window, itemid,
388 #ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
389 /* O'Reilly examples say size can be 0,
390 but this clearly is not the case. */
391 0, bytes, (int)selecting_window, /* private id */
392 #else /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
393 (XtPointer) data, bytes, 0,
394 #endif /* !MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
396 while (ClipboardSuccess !=
397 XmClipboardEndCopy(display, selecting_window, itemid)) ;
401 # ifdef MOTIF_INCREMENTAL_CLIPBOARDS_WORK
402 /* I tried to treat the clipboard like a real selection, and not send
403 the data until it was requested, but it looks like that just doesn't
404 work at all unless the selection owner and requestor are in different
405 processes. From reading the Motif source, it looks like they never
406 even considered having two widgets in the same application transfer
407 data between each other using "by-name" clipboard values. What a
411 motif_clipboard_cb(Widget widget, int *data_id, int *private_id, int *reason)
414 case XmCR_CLIPBOARD_DATA_REQUEST: {
415 Display *dpy = XtDisplay(widget);
416 Window window = (Window) * private_id;
417 Lisp_Object selection =
418 select_convert_out(QCLIPBOARD, Qnil, Qnil);
420 /* Whichever lazy git wrote this originally just called abort()
421 when anything didn't go their way... */
423 /* Try some other text types */
426 select_convert_out(QCLIPBOARD, QSTRING,
430 select_convert_out(QCLIPBOARD, QTEXT, Qnil);
433 select_convert_out(QCLIPBOARD,
434 QCOMPOUND_TEXT, Qnil);
436 if (CONSP(selection) && SYMBOLP(XCAR(selection))
437 && (EQ(XCAR(selection), QSTRING)
438 || EQ(XCAR(selection), QTEXT)
439 || EQ(XCAR(selection), QCOMPOUND_TEXT)))
440 selection = XCDR(selection);
443 signal_error(Qselection_conversion_error,
444 build_string("no selection"));
446 if (!STRINGP(selection))
447 signal_error(Qselection_conversion_error,
449 ("couldn't convert selection to string"));
451 XmClipboardCopyByName(dpy, window, *data_id,
452 (char *)XSTRING_DATA(selection),
453 XSTRING_LENGTH(selection) + 1, 0);
456 case XmCR_CLIPBOARD_DATA_DELETE:
458 /* don't need to free anything */
462 # endif /* MOTIF_INCREMENTAL_CLIPBOARDS_WORK */
463 #endif /* MOTIF_CLIPBOARDS */
465 /* Send a SelectionNotify event to the requestor with property=None, meaning
466 we were unable to do what they wanted.
469 x_decline_selection_request(XSelectionRequestEvent * event)
471 XSelectionEvent reply;
472 reply.type = SelectionNotify;
473 reply.display = event->display;
474 reply.requestor = event->requestor;
475 reply.selection = event->selection;
476 reply.time = event->time;
477 reply.target = event->target;
478 reply.property = None;
480 XSendEvent(reply.display, reply.requestor, False, 0L,
482 XFlush(reply.display);
485 /* Used as an unwind-protect clause so that, if a selection-converter signals
486 an error, we tell the requestor that we were unable to do what they wanted
487 before we throw to top-level or go into the debugger or whatever.
490 x_selection_request_lisp_error(Lisp_Object closure)
492 XSelectionRequestEvent *event = (XSelectionRequestEvent *)
493 get_opaque_ptr(closure);
495 free_opaque_ptr(closure);
496 if (event->type == 0) /* we set this to mean "completed normally" */
498 x_decline_selection_request(event);
502 /* Convert our selection to the requested type, and put that data where the
503 requestor wants it. Then tell them whether we've succeeded.
506 x_reply_selection_request(XSelectionRequestEvent * event, int format,
507 unsigned char *data, int size, Atom type)
509 /* This function can GC */
510 XSelectionEvent reply;
511 Display *display = event->display;
512 #ifdef HAVE_XTREGISTERDRAWABLE
513 struct device *d = get_device_from_display(display);
515 Window window = event->requestor;
517 int format_bytes = format / 8;
518 int max_bytes = SELECTION_QUANTUM(display);
519 if (max_bytes > MAX_SELECTION_QUANTUM)
520 max_bytes = MAX_SELECTION_QUANTUM;
522 reply.type = SelectionNotify;
523 reply.display = display;
524 reply.requestor = window;
525 reply.selection = event->selection;
526 reply.time = event->time;
527 reply.target = event->target;
529 (event->property == None ? event->target : event->property);
531 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
533 /* Store the data on the requested property.
534 If the selection is large, only store the first N bytes of it.
536 bytes_remaining = size * format_bytes;
537 if (bytes_remaining <= max_bytes) {
538 /* Send all the data at once, with minimal handshaking. */
540 stderr_out("\nStoring all %d\n", bytes_remaining);
542 XChangeProperty(display, window, reply.property, type, format,
543 PropModeReplace, data, size);
544 /* At this point, the selection was successfully stored; ack it. */
545 XSendEvent(display, window, False, 0L, (XEvent *) & reply);
548 #ifndef HAVE_XTREGISTERDRAWABLE
549 invalid_operation("Copying that much data requires X11R6.", Qunbound);
551 /* Send an INCR selection. */
553 Widget widget = FRAME_X_TEXT_WIDGET (XFRAME(DEVICE_SELECTED_FRAME(d)));
555 if (x_window_to_frame(d, window)) /* #### debug */
556 error("attempt to transfer an INCR to ourself!");
558 stderr_out("\nINCR %d\n", bytes_remaining);
560 /* Tell Xt not to drop PropertyNotify events that arrive for the
561 target window, rather, pass them to us. This would be a hack, but
562 the Xt selection routines are broken for our purposes--we can't
563 pass them callbacks from Lisp, for example. Let's call it a
566 The call to wait_for_property_change means we can break out of that
567 function, switch to another frame on the same display (which will
568 be another Xt widget), select a huge amount of text, and have the
569 same (foreign) app ask for another incremental selection
570 transfer. Programming like X11 made sense, would mean that, in that
571 case, XtRegisterDrawable is called twice with different widgets.
573 Since the results of calling XtRegisterDrawable when the drawable
574 is already registered with another widget are undefined, we want to
575 avoid that--so, only call it when XtWindowToWidget returns NULL,
576 which it will only do with a valid Window if it's not already
578 if (NULL == XtWindowToWidget(display, window)) {
579 XtRegisterDrawable(display, (Drawable)window, widget);
583 expect_property_change(display, window, reply.property,
586 XChangeProperty(display, window, reply.property,
587 DEVICE_XATOM_INCR(d), 32, PropModeReplace,
589 &bytes_remaining, 1);
590 XSelectInput(display, window, PropertyChangeMask);
591 /* Tell 'em the INCR data is there... */
592 XSendEvent(display, window, False, 0L, (XEvent *) & reply);
595 /* First, wait for the requestor to ack by deleting the property.
596 This can run random lisp code (process handlers) or signal.
598 wait_for_property_change(prop_id);
600 while (bytes_remaining) {
601 int i = ((bytes_remaining < max_bytes)
602 ? bytes_remaining : max_bytes);
604 expect_property_change(display, window,
608 stderr_out(" INCR adding %d\n", i);
610 /* Append the next chunk of data to the property. */
611 XChangeProperty(display, window, reply.property, type,
612 format, PropModeAppend, data,
614 bytes_remaining -= i;
617 /* Now wait for the requestor to ack this chunk by deleting the
618 property. This can run random lisp code or signal.
620 wait_for_property_change(prop_id);
622 /* Now write a zero-length chunk to the property to tell the requestor
625 stderr_out(" INCR done\n");
627 if (!waiting_for_other_props_on_window(display, window)) {
628 XSelectInput(display, window, 0L);
629 XtUnregisterDrawable(display, (Drawable)window);
632 XChangeProperty(display, window, reply.property, type, format,
633 PropModeReplace, data, 0);
634 #endif /* HAVE_XTREGISTERDRAWABLE */
638 /* Called from the event-loop in response to a SelectionRequest event.
641 x_handle_selection_request(XSelectionRequestEvent * event)
643 /* This function can GC */
644 struct gcpro gcpro1, gcpro2;
645 Lisp_Object temp_obj;
646 Lisp_Object selection_symbol;
647 Lisp_Object target_symbol = Qnil;
648 Lisp_Object converted_selection = Qnil;
649 Time local_selection_time;
650 Lisp_Object successful_p = Qnil;
652 struct device *d = get_device_from_display(event->display);
654 GCPRO2(converted_selection, target_symbol);
656 selection_symbol = x_atom_to_symbol(d, event->selection);
657 target_symbol = x_atom_to_symbol(d, event->target);
659 #if 0 /* #### MULTIPLE doesn't work yet */
660 if (EQ(target_symbol, QMULTIPLE))
661 target_symbol = fetch_multiple_target(event);
664 temp_obj = Fget_selection_timestamp(selection_symbol);
666 if (NILP(temp_obj)) {
667 /* We don't appear to have the selection. */
668 x_decline_selection_request(event);
673 local_selection_time = *(Time *) XOPAQUE_DATA(temp_obj);
675 if (event->time != CurrentTime && local_selection_time > event->time) {
676 /* Someone asked for the selection, and we have one, but not the one
677 they're looking for. */
678 x_decline_selection_request(event);
682 converted_selection = select_convert_out(selection_symbol,
683 target_symbol, Qnil);
685 /* #### Is this the right thing to do? I'm no X expert. -- ajh */
686 if (NILP(converted_selection)) {
687 /* We don't appear to have a selection in that data type. */
688 x_decline_selection_request(event);
692 count = specpdl_depth();
693 record_unwind_protect(x_selection_request_lisp_error,
694 make_opaque_ptr(event));
701 lisp_data_to_selection_data(d, converted_selection,
702 &data, &type, &size, &format);
704 x_reply_selection_request(event, format, data, size, type);
706 /* Tell x_selection_request_lisp_error() it's cool. */
711 unbind_to(count, Qnil);
717 /* Let random lisp code notice that the selection has been asked for. */
719 Lisp_Object val = Vx_sent_selection_hooks;
720 if (!UNBOUNDP(val) && !NILP(val)) {
722 if (CONSP(val) && !EQ(XCAR(val), Qlambda))
723 for (rest = val; !NILP(rest); rest = Fcdr(rest))
724 call3(Fcar(rest), selection_symbol,
725 target_symbol, successful_p);
727 call3(val, selection_symbol, target_symbol,
733 /* Called from the event-loop in response to a SelectionClear event.
736 x_handle_selection_clear(XSelectionClearEvent * event)
738 Display *display = event->display;
739 struct device *d = get_device_from_display(display);
740 Atom selection = event->selection;
741 Time changed_owner_time = event->time;
743 Lisp_Object selection_symbol, local_selection_time_lisp;
744 Time local_selection_time;
746 selection_symbol = x_atom_to_symbol(d, selection);
748 local_selection_time_lisp = Fget_selection_timestamp(selection_symbol);
750 /* We don't own the selection, so that's fine. */
751 if (NILP(local_selection_time_lisp))
754 local_selection_time =
755 *(Time *) XOPAQUE_DATA(local_selection_time_lisp);
757 /* This SelectionClear is for a selection that we no longer own, so we can
758 disregard it. (That is, we have reasserted the selection since this
759 request was generated.)
761 if (changed_owner_time != CurrentTime &&
762 local_selection_time > changed_owner_time)
765 handle_selection_clear(selection_symbol);
768 /* This stuff is so that INCR selections are reentrant (that is, so we can
769 be servicing multiple INCR selection requests simultaneously). I haven't
770 actually tested that yet.
773 static int prop_location_tick;
775 static struct prop_location {
781 struct prop_location *next;
782 } *for_whom_the_bell_tolls;
785 property_deleted_p(void *tick)
787 struct prop_location *rest = for_whom_the_bell_tolls;
789 if (rest->tick == (long)tick)
797 waiting_for_other_props_on_window(Display * display, Window window)
799 struct prop_location *rest = for_whom_the_bell_tolls;
801 if (rest->display == display && rest->window == window)
809 expect_property_change(Display * display, Window window,
810 Atom property, int state)
812 struct prop_location *pl = xnew(struct prop_location);
813 pl->tick = ++prop_location_tick;
814 pl->display = display;
816 pl->property = property;
817 pl->desired_state = state;
818 pl->next = for_whom_the_bell_tolls;
819 for_whom_the_bell_tolls = pl;
824 unexpect_property_change(int tick)
826 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
828 if (rest->tick == tick) {
830 prev->next = rest->next;
832 for_whom_the_bell_tolls = rest->next;
842 wait_for_property_change(long tick)
844 /* This function can GC */
845 wait_delaying_user_input(property_deleted_p, (void *)tick);
849 * Called from the event-loop in response to a PropertyNotify event.
852 x_handle_property_notify(XPropertyEvent * event)
854 struct prop_location *prev = 0, *rest = for_whom_the_bell_tolls;
856 if (rest->property == event->atom &&
857 rest->window == event->window &&
858 rest->display == event->display &&
859 rest->desired_state == event->state)
862 prev->next = rest->next;
864 for_whom_the_bell_tolls = rest->next;
868 prev = rest; rest = rest->next;
873 #if 0 /* #### MULTIPLE doesn't work yet */
875 fetch_multiple_target(XSelectionRequestEvent * event)
877 /* This function can GC */
878 Display * display = event->display;
879 Window window = event->requestor;
880 Atom target = event->target;
881 Atom selection_atom = event->selection;
884 return Fcons(QMULTIPLE, x_get_window_property_as_lisp_data
885 (display, window, target, QMULTIPLE, selection_atom));
889 copy_multiple_data(Lisp_Object obj)
895 return Fcons(XCAR(obj), copy_multiple_data(XCDR(obj)));
897 CHECK_VECTOR(obj); len = XVECTOR_LENGTH(obj);
898 vec = make_vector(len, Qnil);
899 for (i = 0; i < len; i++) {
900 Lisp_Object vec2 = XVECTOR_DATA(obj)[i];
902 if (XVECTOR_LENGTH(vec2) != 2)
903 signal_error(Qerror, list2(build_string ("vectors must be of length 2"), vec2));
904 XVECTOR_DATA(vec)[i] = make_vector(2, Qnil);
905 XVECTOR_DATA(XVECTOR_DATA(vec)[i])[0] =
906 XVECTOR_DATA(vec2)[0];
907 XVECTOR_DATA(XVECTOR_DATA(vec)[i])[1] =
908 XVECTOR_DATA(vec2)[1];
915 static Window reading_selection_reply;
916 static Atom reading_which_selection;
917 static int selection_reply_timed_out;
920 selection_reply_done(void *ignore)
922 return !reading_selection_reply;
925 static Lisp_Object Qx_selection_reply_timeout_internal;
927 DEFUN("x-selection-reply-timeout-internal", Fx_selection_reply_timeout_internal, 1, 1, 0, /*
931 selection_reply_timed_out = 1;
932 reading_selection_reply = 0;
938 * Do protocol to read selection-data from the server.
939 * Converts this to lisp data and returns it.
942 x_get_foreign_selection(Lisp_Object selection_symbol, Lisp_Object target_type)
944 /* This function can GC */
945 struct device *d = decode_x_device(Qnil);
946 Display * display = DEVICE_X_DISPLAY(d);
947 struct frame *sel_frame = selected_frame();
948 Window requestor_window = XtWindow(FRAME_X_TEXT_WIDGET(sel_frame));
949 Time requestor_time = CurrentTime;
950 Atom target_property = DEVICE_XATOM_EMACS_TMP(d);
951 Atom selection_atom = symbol_to_x_atom(d, selection_symbol, 0);
953 Atom type_atom = symbol_to_x_atom(d, (CONSP(target_type) ? XCAR(target_type) : target_type), 0);
955 XConvertSelection(display, selection_atom, type_atom, target_property,
956 requestor_window, requestor_time);
957 /* Block until the reply has been read. */
958 reading_selection_reply = requestor_window;
959 reading_which_selection = selection_atom;
960 selection_reply_timed_out = 0;
961 speccount = specpdl_depth();
962 /* add a timeout handler */
963 if (x_selection_timeout > 0) {
964 Lisp_Object id = Fadd_timeout(make_int(x_selection_timeout),
965 Qx_selection_reply_timeout_internal,
967 record_unwind_protect(Fdisable_timeout, id);
971 wait_delaying_user_input(selection_reply_done, 0);
972 if (selection_reply_timed_out)
973 error("timed out waiting for reply from selection owner");
974 unbind_to(speccount, Qnil);
975 /* otherwise, the selection is waiting for us on the requested property. */
976 return select_convert_in(selection_symbol, target_type,
977 x_get_window_property_as_lisp_data (display, requestor_window,
978 target_property, target_type,
983 x_get_window_property(Display * display, Window window, Atom property,
984 Extbyte ** data_ret, int *bytes_ret, Atom * actual_type_ret,
985 int *actual_format_ret, unsigned long *actual_size_ret,
989 unsigned long bytes_remaining;
990 int offset = 0; unsigned char *tmp_data = 0;
992 int buffer_size = SELECTION_QUANTUM(display);
994 if (buffer_size > MAX_SELECTION_QUANTUM)
995 buffer_size = MAX_SELECTION_QUANTUM;
996 /* First probe the thing to find out how big it is. */
997 result = XGetWindowProperty(display, window, property, 0, 0,
998 False, AnyPropertyType, actual_type_ret,
999 actual_format_ret, actual_size_ret,
1000 &bytes_remaining, &tmp_data);
1001 if (result != Success) {
1006 XFree((char *)tmp_data);
1007 if (*actual_type_ret == None || *actual_format_ret == 0) {
1009 XDeleteProperty(display, window, property);
1015 total_size = bytes_remaining + 1;
1016 *data_ret = (Extbyte *) xmalloc_atomic(total_size);
1017 /* Now read, until we've gotten it all. */
1018 while (bytes_remaining) {
1019 result = XGetWindowProperty(display, window, property,
1020 offset / 4, buffer_size / 4,
1021 (delete_p ? True : False),
1022 AnyPropertyType, actual_type_ret,
1023 actual_format_ret, actual_size_ret,
1024 &bytes_remaining, &tmp_data);
1026 /* If this doesn't return Success at this point, it means that
1027 some clod deleted the selection while we were in the midst of
1028 reading it. Deal with that, I guess....
1030 if (result != Success)
1032 *actual_size_ret *= *actual_format_ret / 8;
1033 memcpy((*data_ret) + offset, tmp_data, *actual_size_ret);
1034 offset += *actual_size_ret;
1035 XFree((char *)tmp_data);
1037 *bytes_ret = offset;
1041 receive_incremental_selection(Display * display, Window window, Atom property,
1042 /* this one is for error messages only */
1043 Lisp_Object target_type, unsigned int min_size_bytes,
1044 Extbyte ** data_ret, int *size_bytes_ret,
1045 Atom * type_ret, int *format_ret,
1046 unsigned long *size_ret)
1048 /* This function can GC */
1052 *size_bytes_ret = min_size_bytes;
1053 *data_ret = (Extbyte *) xmalloc_atomic(*size_bytes_ret);
1055 /* At this point, we have read an INCR property, and deleted it (which
1056 is how we ack its receipt: the sending window will be selecting
1057 PropertyNotify events on our window to notice this).
1059 Now, we must loop, waiting for the sending window to put a value on
1060 that property, then reading the property, then deleting it to ack.
1061 We are done when the sender places a property of length 0.
1063 prop_id = expect_property_change(display, window, property, PropertyNewValue);
1065 Extbyte * tmp_data; int tmp_size_bytes;
1066 wait_for_property_change(prop_id);
1067 /* expect it again immediately, because x_get_window_property may
1068 .. no it won't, I don't get it.
1069 .. Ok, I get it now, the Xt code that implements INCR is broken.
1071 prop_id = expect_property_change(display, window, property, PropertyNewValue);
1072 x_get_window_property(display, window, property, &tmp_data, &tmp_size_bytes,
1073 type_ret, format_ret, size_ret, 1);
1074 if (tmp_size_bytes == 0) { /* we're done */
1075 unexpect_property_change(prop_id);
1076 if (tmp_data) xfree(tmp_data);
1079 if (*size_bytes_ret < offset + tmp_size_bytes) {
1080 *size_bytes_ret = offset + tmp_size_bytes;
1081 *data_ret = (Extbyte *) xrealloc(*data_ret, *size_bytes_ret);
1083 memcpy((*data_ret) + offset, tmp_data, tmp_size_bytes);
1084 offset += tmp_size_bytes; xfree(tmp_data);
1089 x_get_window_property_as_lisp_data(Display * display, Window window, Atom property,
1090 /* next two for error messages only */
1091 Lisp_Object target_type, Atom selection_atom)
1093 /* This function can GC */
1096 unsigned long actual_size;
1097 Extbyte * data = NULL;
1100 struct device *d = get_device_from_display(display);
1102 x_get_window_property(display, window, property, &data, &bytes, &actual_type,
1103 &actual_format, &actual_size, 1);
1105 if (XGetSelectionOwner(display, selection_atom))
1106 /* there is a selection owner */
1107 signal_error(Qselection_conversion_error,
1108 Fcons(build_string("selection owner couldn't convert"),
1109 Fcons(x_atom_to_symbol (d, selection_atom),
1110 actual_type ? list2(target_type, x_atom_to_symbol (d, actual_type))
1111 : list1(target_type))));
1113 signal_error(Qerror, list2(build_string ("no selection"),
1114 x_atom_to_symbol(d, selection_atom)));
1117 if (actual_type == DEVICE_XATOM_INCR(d)) {
1118 /* Ok, that data wasn't *the* data, it was just the beginning. */
1119 unsigned int min_size_bytes = *((unsigned int *)data); xfree(data);
1120 receive_incremental_selection(display, window, property, target_type,
1121 min_size_bytes, &data, &bytes, &actual_type,
1122 &actual_format, &actual_size);
1125 /* It's been read. Now convert it to a lisp object in some semi-rational
1127 val = selection_data_to_lisp_data(d, data, bytes, actual_type, actual_format);
1133 /* #### These are going to move into Lisp code(!) with the aid of
1134 some new functions I'm working on - ajh */
1136 /* These functions convert from the selection data read from the server into
1137 something that we can use from elisp, and vice versa.
1139 Type: Format: Size: Elisp Type:
1140 ----- ------- ----- -----------
1143 ATOM 32 > 1 Vector of Symbols
1145 * 16 > 1 Vector of Integers
1146 * 32 1 if <=16 bits: Integer
1147 if > 16 bits: Cons of top16, bot16
1148 * 32 > 1 Vector of the above
1150 When converting a Lisp number to C, it is assumed to be of format 16 if
1151 it is an integer, and of format 32 if it is a cons of two integers.
1153 When converting a vector of numbers from Elisp to C, it is assumed to be
1154 of format 16 if every element in the vector is an integer, and is assumed
1155 to be of format 32 if any element is a cons of two integers.
1157 When converting an object to C, it may be of the form (SYMBOL . <data>)
1158 where SYMBOL is what we should claim that the type is. Format and
1159 representation are as above.
1161 NOTE: Under Mule, when someone shoves us a string without a type, we
1162 set the type to 'COMPOUND_TEXT and automatically convert to Compound
1163 Text. If the string has a type, we assume that the user wants the
1164 data sent as-is so we just do "binary" conversion.
1168 selection_data_to_lisp_data(struct device *d, Extbyte * data,
1169 size_t size, Atom type, int format)
1171 if (type == DEVICE_XATOM_NULL(d))
1173 /* Convert any 8-bit data to a string, for compactness. */
1174 else if (format == 8)
1175 return make_ext_string(data, size, type == DEVICE_XATOM_TEXT(d)
1176 || type == DEVICE_XATOM_COMPOUND_TEXT(d) ? Qctext : Qbinary);
1177 /* Convert a single atom to a Lisp Symbol.
1178 Convert a set of atoms to a vector of symbols. */
1179 else if (type == XA_ATOM) {
1180 if (size == sizeof(Atom))
1181 return x_atom_to_symbol(d, *((Atom *) data));
1184 int len = size / sizeof(Atom);
1185 Lisp_Object v = Fmake_vector(make_int(len), Qzero);
1186 for (i = 0; i < len; i++)
1187 Faset(v, make_int(i), x_atom_to_symbol(d, ((Atom *) data)[i]));
1192 /* Convert a single 16 or small 32 bit number to a Lisp Int.
1193 If the number is > 16 bits, convert it to a cons of integers,
1194 16 bits in each half.
1196 else if (format == 32 && size == sizeof(long))
1197 return word_to_lisp(((unsigned long *)data)[0]);
1198 else if (format == 16 && size == sizeof(short))
1199 return make_int((int)(((unsigned short *)data)[0]));
1200 /* Convert any other kind of data to a vector of numbers, represented
1201 as above (as an integer, or a cons of two 16 bit integers).
1203 #### Perhaps we should return the actual type to lisp as well.
1205 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1208 and perhaps it should be
1210 (x-get-selection-internal 'PRIMARY 'LINE_NUMBER)
1213 Right now the fact that the return type was SPAN is discarded before
1214 lisp code gets to see it.
1216 else if (format == 16) {
1218 Lisp_Object v = make_vector(size / 4, Qzero);
1219 for (i = 0; i < (int)size / 4; i++) {
1220 int j = (int)((unsigned short *)data)[i];
1221 Faset(v, make_int(i), make_int(j));
1226 Lisp_Object v = make_vector(size / 4, Qzero);
1227 for (i = 0; i < (int)size / 4; i++) {
1228 unsigned long j = ((unsigned long *)data)[i];
1229 Faset(v, make_int(i), word_to_lisp(j));
1236 "all elements of the vector must be of the same type"
1238 "elements of the vector must be vectors of exactly two elements"
1240 "all elements of the vector must be of the same type"
1242 "all elements of the vector must be integers or conses of integers"
1245 lisp_data_to_selection_data(struct device *d, Lisp_Object obj,
1246 unsigned char **data_ret, Atom * type_ret,
1247 unsigned int *size_ret, int *format_ret)
1249 Lisp_Object type = Qnil;
1251 if (CONSP(obj) && SYMBOLP(XCAR(obj))) {
1252 type = XCAR(obj); obj = XCDR(obj);
1253 if (CONSP(obj) && NILP(XCDR(obj)))
1256 if (EQ(obj, QNULL) || (EQ(type, QNULL))) {
1257 /* This is not the same as declining */
1259 *size_ret = 0; *data_ret = 0; type = QNULL;
1260 } else if (STRINGP(obj)) {
1261 const Extbyte * extval = NULL;
1263 TO_EXTERNAL_FORMAT(LISP_STRING, obj, ALLOCA, (extval, extvallen),
1264 (NILP(type) ? Qctext : Qbinary));
1265 if ( extval != NULL ) {
1267 *size_ret = extvallen;
1268 *data_ret = (unsigned char *)xmalloc_atomic(*size_ret);
1269 memcpy(*data_ret, extval, *size_ret);
1271 error("Could not transcode string");
1275 type = QCOMPOUND_TEXT;
1277 if (NILP(type)) type = QSTRING;
1279 } else if (CHARP(obj)) {
1280 Bufbyte buf[MAX_EMCHAR_LEN];
1282 const Extbyte * extval = NULL;
1285 len = set_charptr_emchar(buf, XCHAR(obj));
1286 TO_EXTERNAL_FORMAT(DATA, (buf, len), ALLOCA, (extval, extvallen),
1288 if ( extval != NULL ) {
1289 *size_ret = extvallen;
1290 *data_ret = (unsigned char *)xmalloc_atomic(*size_ret);
1291 memcpy(*data_ret, extval, *size_ret);
1293 error("Could not transcode data");
1297 type = QCOMPOUND_TEXT;
1302 } else if (SYMBOLP(obj)) {
1306 (unsigned char *)xmalloc_atomic(sizeof(Atom) + 1);
1307 (*data_ret)[sizeof(Atom)] = 0;
1308 (*(Atom **) data_ret)[0] =
1309 symbol_to_x_atom(d, obj, 0);
1310 if (NILP(type)) type = QATOM;
1311 } else if (INTP(obj) && XINT(obj) <= 0x7FFF && XINT(obj) >= -0x8000) {
1314 *data_ret = (unsigned char *)xmalloc_atomic(sizeof(short) + 1);
1315 (*data_ret)[sizeof(short)] = 0;
1316 (*(short **)data_ret)[0] = (short)XINT(obj);
1319 } else if (INTP(obj) || CONSP(obj)) {
1322 *data_ret = (unsigned char *)xmalloc_atomic(sizeof(long) + 1);
1323 (*data_ret)[sizeof(long)] = 0;
1324 (*(unsigned long **)data_ret)[0] = lisp_to_word(obj);
1327 } else if (VECTORP(obj)) {
1328 /* Lisp Vectors may represent a set of ATOMs;
1329 a set of 16 or 32 bit INTEGERs;
1330 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1333 if (SYMBOLP(XVECTOR_DATA(obj)[0])) {
1334 /* This vector is an ATOM set */
1338 *size_ret = XVECTOR_LENGTH(obj);
1340 *data_ret = (unsigned char *)xmalloc_atomic(
1341 (*size_ret) * sizeof(Atom));
1342 for (i = 0; i < (int)(*size_ret); i++) {
1343 if (SYMBOLP(XVECTOR_DATA(obj)[i])) {
1344 (*(Atom **) data_ret)[i] =
1347 XVECTOR_DATA(obj)[i], 0);
1349 /* was: Qselection_error */
1352 list2(build_string(tmp_err_1),
1357 #if 0 /* #### MULTIPLE doesn't work yet */
1358 } else if (VECTORP(XVECTOR_DATA(obj)[0])) {
1359 /* This vector is an ATOM_PAIR set */
1360 if (NILP(type)) type = QATOM_PAIR;
1361 *size_ret = XVECTOR_LENGTH(obj);
1363 *data_ret = (unsigned char *)
1364 xmalloc_atomic((*size_ret) * sizeof(Atom) * 2);
1365 for (i = 0; i < *size_ret; i++) {
1366 if (VECTORP(XVECTOR_DATA(obj)[i])) {
1367 Lisp_Object pair = XVECTOR_DATA(obj)[i];
1368 if (XVECTOR_LENGTH(pair) != 2) {
1375 (*(Atom **) data_ret)[i * 2] =
1378 XVECTOR_DATA(pair)[0], 0);
1379 (*(Atom **) data_ret)[(i * 2) + 1] =
1382 XVECTOR_DATA(pair)[1], 0);
1384 signal_error(Qerror,
1392 /* This vector is an INTEGER set or something like it */
1393 *size_ret = XVECTOR_LENGTH(obj);
1398 for (i = 0; i < (int)(*size_ret); i++) {
1399 if (CONSP(XVECTOR_DATA(obj)[i])) {
1402 if (!INTP(XVECTOR_DATA(obj)[i])) {
1403 /* was: Qselection_error */
1412 *data_ret = xmalloc_atomic(*size_ret *
1414 for (i = 0; i < (int)(*size_ret); i++)
1415 if (*format_ret == 32)
1416 (*((unsigned long **)data_ret))[i] =
1417 lisp_to_word(XVECTOR_DATA(obj)[i]);
1419 (*((unsigned short **)data_ret))[i] =
1420 (unsigned short) lisp_to_word(XVECTOR_DATA(obj)[i]);
1423 signal_error(Qerror, /* Qselection_error */
1424 list2(build_string("unrecognized selection data"),
1427 *type_ret = symbol_to_x_atom(d, type, 0);
1431 /* Called from the event loop to handle SelectionNotify events.
1432 I don't think this needs to be reentrant.
1435 x_handle_selection_notify(XSelectionEvent * event)
1437 if (!reading_selection_reply)
1438 message("received an unexpected SelectionNotify event");
1439 else if (event->requestor != reading_selection_reply)
1440 message("received a SelectionNotify event for the wrong window");
1441 else if (event->selection != reading_which_selection)
1442 message("received the wrong selection type in SelectionNotify!");
1444 reading_selection_reply = 0; /* we're done now. */
1448 x_disown_selection(Lisp_Object selection, Lisp_Object timeval)
1450 struct device *d = decode_x_device(Qnil);
1451 Display * display = DEVICE_X_DISPLAY(d);
1453 Atom selection_atom;
1455 CHECK_SYMBOL(selection);
1457 timestamp = DEVICE_X_MOUSE_TIMESTAMP(d);
1459 /* #### This is bogus. See the comment above about problems
1460 on OSF/1 and DEC Alphas. Yet another reason why it sucks
1461 to have the implementation (i.e. cons of two 16-bit
1462 integers) exposed. */
1464 lisp_to_time(timeval, &the_time);
1465 timestamp = (Time) the_time;
1468 selection_atom = symbol_to_x_atom(d, selection, 0);
1469 XSetSelectionOwner(display, selection_atom, None, timestamp);
1473 x_selection_exists_p(Lisp_Object selection, Lisp_Object selection_type)
1475 struct device *d = decode_x_device(Qnil);
1476 Display * dpy = DEVICE_X_DISPLAY(d);
1477 return XGetSelectionOwner(dpy, symbol_to_x_atom(d, selection, 0)) != None ? Qt : Qnil;
1481 #ifdef CUT_BUFFER_SUPPORT
1483 static int cut_buffers_initialized; /* Whether we're sure they all exist */
1484 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1486 initialize_cut_buffers(Display * display, Window window)
1488 static unsigned const char *const data = (unsigned const char *)"";
1489 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1490 PropModeAppend, data, 0)
1491 FROB(XA_CUT_BUFFER0);
1492 FROB(XA_CUT_BUFFER1);
1493 FROB(XA_CUT_BUFFER2);
1494 FROB(XA_CUT_BUFFER3);
1495 FROB(XA_CUT_BUFFER4);
1496 FROB(XA_CUT_BUFFER5);
1497 FROB(XA_CUT_BUFFER6);
1498 FROB(XA_CUT_BUFFER7);
1500 cut_buffers_initialized = 1;
1503 #define CHECK_CUTBUFFER(symbol) do { \
1504 CHECK_SYMBOL (symbol); \
1505 if (! (EQ (symbol, QCUT_BUFFER0) || \
1506 EQ (symbol, QCUT_BUFFER1) || \
1507 EQ (symbol, QCUT_BUFFER2) || \
1508 EQ (symbol, QCUT_BUFFER3) || \
1509 EQ (symbol, QCUT_BUFFER4) || \
1510 EQ (symbol, QCUT_BUFFER5) || \
1511 EQ (symbol, QCUT_BUFFER6) || \
1512 EQ (symbol, QCUT_BUFFER7))) \
1513 signal_simple_error ("Doesn't name a cutbuffer", symbol); \
1516 DEFUN("x-get-cutbuffer-internal", Fx_get_cutbuffer_internal, 1, 1, 0, /*
1517 Return the value of the named CUTBUFFER (typically CUT_BUFFER0).
1521 struct device *d = decode_x_device(Qnil);
1522 Display * display = DEVICE_X_DISPLAY(d);
1523 Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1524 Atom cut_buffer_atom;
1532 CHECK_CUTBUFFER(cutbuffer);
1533 cut_buffer_atom = symbol_to_x_atom(d, cutbuffer, 0);
1534 x_get_window_property(display, window, cut_buffer_atom, &data,
1535 &bytes, &type, &format, &size, 0);
1538 if (format != 8 || type != XA_STRING)
1539 signal_simple_error_2("Cut buffer doesn't contain 8-bit STRING data",
1540 x_atom_to_symbol(d, type), make_int(format));
1541 /* We cheat - if the string contains an ESC character, that's
1542 technically not allowed in a STRING, so we assume it's
1543 COMPOUND_TEXT that we stored there ourselves earlier,
1544 in x-store-cutbuffer-internal */
1545 ret = (bytes ? make_ext_string(data, bytes, memchr(data, 0x1b, bytes) ? Qctext : Qbinary) : Qnil);
1550 DEFUN("x-store-cutbuffer-internal", Fx_store_cutbuffer_internal, 2, 2, 0, /*
1551 Set the value of the named CUTBUFFER (typically CUT_BUFFER0) to STRING.
1553 (cutbuffer, string))
1555 struct device *d = decode_x_device(Qnil);
1556 Display * display = DEVICE_X_DISPLAY(d);
1557 Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1558 Atom cut_buffer_atom;
1559 const Bufbyte * data = XSTRING_DATA(string);
1560 Bytecount bytes = XSTRING_LENGTH(string);
1561 Bytecount bytes_remaining;
1562 int max_bytes = SELECTION_QUANTUM(display);
1564 const Bufbyte * ptr, *end;
1565 enum { ASCII, LATIN_1, WORLD } chartypes = ASCII;
1567 if (max_bytes > MAX_SELECTION_QUANTUM)
1568 max_bytes = MAX_SELECTION_QUANTUM;
1569 CHECK_CUTBUFFER(cutbuffer);
1570 CHECK_STRING(string);
1572 symbol_to_x_atom(d, cutbuffer, 0);
1573 if (!cut_buffers_initialized)
1574 initialize_cut_buffers(display, window);
1575 /* We use the STRING encoding (Latin-1 only) if we can, else COMPOUND_TEXT.
1576 We cheat and use type = `STRING' even when using COMPOUND_TEXT.
1577 The ICCCM requires that this be so, and other clients assume it,
1578 as we do ourselves in initialize_cut_buffers. */
1580 /* Optimize for the common ASCII case */
1581 for (ptr = data, end = ptr + bytes; ptr <= end;) {
1582 if (BYTE_ASCII_P(*ptr)) {
1587 if ((*ptr) == LEADING_BYTE_LATIN_ISO8859_1
1588 || (*ptr) == LEADING_BYTE_CONTROL_1) {
1589 chartypes = LATIN_1;
1598 if (chartypes == LATIN_1)
1599 TO_EXTERNAL_FORMAT(LISP_STRING, string, ALLOCA, (data, bytes), Qbinary);
1600 else if (chartypes == WORLD)
1601 TO_EXTERNAL_FORMAT(LISP_STRING, string, ALLOCA, (data, bytes), Qctext);
1603 bytes_remaining = bytes;
1604 while (bytes_remaining) {
1605 int chunk = bytes_remaining < max_bytes ? bytes_remaining : max_bytes;
1606 XChangeProperty(display, window, cut_buffer_atom, XA_STRING, 8,
1607 (bytes_remaining == bytes ? PropModeReplace : PropModeAppend),
1610 bytes_remaining -= chunk;
1615 DEFUN("x-rotate-cutbuffers-internal", Fx_rotate_cutbuffers_internal, 1, 1, 0, /*
1616 Rotate the values of the cutbuffers by the given number of steps;
1617 positive means move values forward, negative means backward.
1621 struct device *d = decode_x_device(Qnil);
1622 Display * display = DEVICE_X_DISPLAY(d);
1623 Window window = RootWindow(display, 0); /* Cutbuffers are on frame 0 */
1629 if (!cut_buffers_initialized)
1630 initialize_cut_buffers(display, window);
1631 props[0] = XA_CUT_BUFFER0;
1632 props[1] = XA_CUT_BUFFER1;
1633 props[2] = XA_CUT_BUFFER2;
1634 props[3] = XA_CUT_BUFFER3;
1635 props[4] = XA_CUT_BUFFER4;
1636 props[5] = XA_CUT_BUFFER5;
1637 props[6] = XA_CUT_BUFFER6;
1638 props[7] = XA_CUT_BUFFER7;
1639 XRotateWindowProperties(display, window, props, 8, XINT(n));
1642 #endif /* CUT_BUFFER_SUPPORT */
1645 /************************************************************************/
1646 /* initialization */
1647 /************************************************************************/
1650 syms_of_select_x(void)
1652 #ifdef CUT_BUFFER_SUPPORT
1653 DEFSUBR(Fx_get_cutbuffer_internal);
1654 DEFSUBR(Fx_store_cutbuffer_internal);
1655 DEFSUBR(Fx_rotate_cutbuffers_internal);
1656 #endif /* CUT_BUFFER_SUPPORT */
1657 /* Unfortunately, timeout handlers must be lisp functions. */
1658 defsymbol (&Qx_selection_reply_timeout_internal,
1659 "x-selection-reply-timeout-internal");
1660 DEFSUBR(Fx_selection_reply_timeout_internal);
1661 #ifdef CUT_BUFFER_SUPPORT
1662 defsymbol(&QCUT_BUFFER0, "CUT_BUFFER0");
1663 defsymbol(&QCUT_BUFFER1, "CUT_BUFFER1");
1664 defsymbol(&QCUT_BUFFER2, "CUT_BUFFER2");
1665 defsymbol(&QCUT_BUFFER3, "CUT_BUFFER3");
1666 defsymbol(&QCUT_BUFFER4, "CUT_BUFFER4");
1667 defsymbol(&QCUT_BUFFER5, "CUT_BUFFER5");
1668 defsymbol(&QCUT_BUFFER6, "CUT_BUFFER6");
1669 defsymbol(&QCUT_BUFFER7, "CUT_BUFFER7");
1670 #endif /* CUT_BUFFER_SUPPORT */
1674 console_type_create_select_x(void)
1676 CONSOLE_HAS_METHOD(x, own_selection);
1677 CONSOLE_HAS_METHOD(x, disown_selection);
1678 CONSOLE_HAS_METHOD(x, get_foreign_selection);
1679 CONSOLE_HAS_METHOD(x, selection_exists_p);
1683 reinit_vars_of_select_x(void)
1685 reading_selection_reply = 0;
1686 reading_which_selection = 0;
1687 selection_reply_timed_out = 0;
1688 for_whom_the_bell_tolls = 0;
1689 prop_location_tick = 0;
1693 vars_of_select_x(void)
1695 reinit_vars_of_select_x();
1696 #ifdef CUT_BUFFER_SUPPORT
1697 cut_buffers_initialized = 0;
1698 Fprovide(intern("cut-buffer"));
1700 DEFVAR_LISP("x-sent-selection-hooks", &Vx_sent_selection_hooks /*
1701 A function or functions to be called after we have responded to some
1702 other client's request for the value of a selection that we own. The
1703 function(s) will be called with four arguments:
1704 - the name of the selection (typically PRIMARY, SECONDARY, or CLIPBOARD);
1705 - the name of the selection-type which we were requested to convert the
1706 selection into before sending (for example, STRING or LENGTH);
1707 - and whether we successfully transmitted the selection.
1708 We might have failed (and declined the request) for any number of reasons,
1709 including being asked for a selection that we no longer own, or being asked
1710 to convert into a type that we don't know about or that is inappropriate.
1711 This hook doesn't let you change the behavior of emacs's selection replies,
1712 it merely informs you that they have happened.
1714 Vx_sent_selection_hooks = Qunbound;
1716 DEFVAR_INT("x-selection-timeout", &x_selection_timeout /*
1717 If the selection owner doesn't reply in this many seconds, we give up.
1718 A value of 0 means wait as long as necessary. This is initialized from the
1719 \"*selectionTimeout\" resource (which is expressed in milliseconds).
1721 x_selection_timeout = 0;
1723 DEFVAR_BOOL("x-selection-strict-motif-ownership", &x_selection_strict_motif_ownership /*
1724 *If nil and SXEmacs already owns the clipboard, don't own it again in the
1725 Motif way. Owning the selection on the Motif way does a huge amount of
1726 X protocol, and it makes killing text incredibly slow when using an
1727 X terminal. However, when enabled Motif text fields don't bother to look up
1728 the new value, and you can't Copy from a buffer, Paste into a text
1729 field, then Copy something else from the buffer and paste it into the
1730 text field; it pastes the first thing again.
1732 x_selection_strict_motif_ownership = 1;
1736 Xatoms_of_select_x(struct device *d)
1738 Display * D = DEVICE_X_DISPLAY(d);
1739 /* Non-predefined atoms that we might end up using a lot */
1740 DEVICE_XATOM_CLIPBOARD(d) =
1741 XInternAtom(D, "CLIPBOARD", False);
1742 DEVICE_XATOM_TIMESTAMP(d) =
1743 XInternAtom(D, "TIMESTAMP", False);
1744 DEVICE_XATOM_TEXT(d) =
1745 XInternAtom(D, "TEXT", False);
1746 DEVICE_XATOM_DELETE(d) =
1747 XInternAtom(D, "DELETE", False);
1748 DEVICE_XATOM_MULTIPLE(d) =
1749 XInternAtom(D, "MULTIPLE", False);
1750 DEVICE_XATOM_INCR(d) =
1751 XInternAtom(D, "INCR", False);
1752 DEVICE_XATOM_TARGETS(d) =
1753 XInternAtom(D, "TARGETS", False);
1754 DEVICE_XATOM_NULL(d) =
1755 XInternAtom(D, "NULL", False);
1756 DEVICE_XATOM_ATOM_PAIR(d) =
1757 XInternAtom(D, "ATOM_PAIR", False);
1758 DEVICE_XATOM_COMPOUND_TEXT(d) =
1759 XInternAtom(D, "COMPOUND_TEXT", False);
1760 /* #### I don't like the looks of this... what is it for? - ajh */
1761 DEVICE_XATOM_EMACS_TMP(d) =
1762 XInternAtom(D, "_EMACS_TMP_", False);