(make-doctor-variables): Eliminate `observation-list' also.
[emacs.git] / src / xselect.c
blob053d7f0fa3e1d4daa7fe18b01ca3d32205989671
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs 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 2, or (at your option)
9 any later version.
11 GNU Emacs 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 GNU Emacs; 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. */
22 /* Rewritten by jwz */
24 #include <config.h>
25 #include "lisp.h"
26 #include "xterm.h" /* for all of the X includes */
27 #include "dispextern.h" /* frame.h seems to want this */
28 #include "frame.h" /* Need this to get the X window of selected_frame */
29 #include "blockinput.h"
31 #define CUT_BUFFER_SUPPORT
33 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
34 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
35 QATOM_PAIR;
37 #ifdef CUT_BUFFER_SUPPORT
38 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
39 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
40 #endif
42 static Lisp_Object Vx_lost_selection_hooks;
43 static Lisp_Object Vx_sent_selection_hooks;
45 /* If this is a smaller number than the max-request-size of the display,
46 emacs will use INCR selection transfer when the selection is larger
47 than this. The max-request-size is usually around 64k, so if you want
48 emacs to use incremental selection transfers when the selection is
49 smaller than that, set this. I added this mostly for debugging the
50 incremental transfer stuff, but it might improve server performance. */
51 #define MAX_SELECTION_QUANTUM 0xFFFFFF
53 #ifdef HAVE_X11R4
54 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
55 #else
56 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
57 #endif
59 /* The timestamp of the last input event Emacs received from the X server. */
60 /* Defined in keyboard.c. */
61 extern unsigned long last_event_timestamp;
63 /* This is an association list whose elements are of the form
64 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
65 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
66 SELECTION-VALUE is the value that emacs owns for that selection.
67 It may be any kind of Lisp object.
68 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
69 as a cons of two 16-bit numbers (making a 32 bit time.)
70 FRAME is the frame for which we made the selection.
71 If there is an entry in this alist, then it can be assumed that Emacs owns
72 that selection.
73 The only (eq) parts of this list that are visible from Lisp are the
74 selection-values. */
75 static Lisp_Object Vselection_alist;
77 /* This is an alist whose CARs are selection-types (whose names are the same
78 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
79 call to convert the given Emacs selection value to a string representing
80 the given selection type. This is for Lisp-level extension of the emacs
81 selection handling. */
82 static Lisp_Object Vselection_converter_alist;
84 /* If the selection owner takes too long to reply to a selection request,
85 we give up on it. This is in milliseconds (0 = no timeout.) */
86 static int x_selection_timeout;
88 /* Utility functions */
90 static void lisp_data_to_selection_data ();
91 static Lisp_Object selection_data_to_lisp_data ();
92 static Lisp_Object x_get_window_property_as_lisp_data ();
94 /* This converts a Lisp symbol to a server Atom, avoiding a server
95 roundtrip whenever possible. */
97 static Atom
98 symbol_to_x_atom (dpyinfo, display, sym)
99 struct x_display_info *dpyinfo;
100 Display *display;
101 Lisp_Object sym;
103 Atom val;
104 if (NILP (sym)) return 0;
105 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
106 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
107 if (EQ (sym, QSTRING)) return XA_STRING;
108 if (EQ (sym, QINTEGER)) return XA_INTEGER;
109 if (EQ (sym, QATOM)) return XA_ATOM;
110 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
111 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
112 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
113 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
114 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
115 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
116 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
117 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
118 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
119 #ifdef CUT_BUFFER_SUPPORT
120 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
121 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
122 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
123 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
124 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
125 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
126 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
127 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
128 #endif
129 if (!SYMBOLP (sym)) abort ();
131 #if 0
132 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
133 #endif
134 BLOCK_INPUT;
135 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
136 UNBLOCK_INPUT;
137 return val;
141 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
142 and calls to intern whenever possible. */
144 static Lisp_Object
145 x_atom_to_symbol (dpyinfo, display, atom)
146 struct x_display_info *dpyinfo;
147 Display *display;
148 Atom atom;
150 char *str;
151 Lisp_Object val;
152 if (! atom) return Qnil;
153 switch (atom)
155 case XA_PRIMARY:
156 return QPRIMARY;
157 case XA_SECONDARY:
158 return QSECONDARY;
159 case XA_STRING:
160 return QSTRING;
161 case XA_INTEGER:
162 return QINTEGER;
163 case XA_ATOM:
164 return QATOM;
165 #ifdef CUT_BUFFER_SUPPORT
166 case XA_CUT_BUFFER0:
167 return QCUT_BUFFER0;
168 case XA_CUT_BUFFER1:
169 return QCUT_BUFFER1;
170 case XA_CUT_BUFFER2:
171 return QCUT_BUFFER2;
172 case XA_CUT_BUFFER3:
173 return QCUT_BUFFER3;
174 case XA_CUT_BUFFER4:
175 return QCUT_BUFFER4;
176 case XA_CUT_BUFFER5:
177 return QCUT_BUFFER5;
178 case XA_CUT_BUFFER6:
179 return QCUT_BUFFER6;
180 case XA_CUT_BUFFER7:
181 return QCUT_BUFFER7;
182 #endif
185 if (atom == dpyinfo->Xatom_CLIPBOARD)
186 return QCLIPBOARD;
187 if (atom == dpyinfo->Xatom_TIMESTAMP)
188 return QTIMESTAMP;
189 if (atom == dpyinfo->Xatom_TEXT)
190 return QTEXT;
191 if (atom == dpyinfo->Xatom_DELETE)
192 return QDELETE;
193 if (atom == dpyinfo->Xatom_MULTIPLE)
194 return QMULTIPLE;
195 if (atom == dpyinfo->Xatom_INCR)
196 return QINCR;
197 if (atom == dpyinfo->Xatom_EMACS_TMP)
198 return QEMACS_TMP;
199 if (atom == dpyinfo->Xatom_TARGETS)
200 return QTARGETS;
201 if (atom == dpyinfo->Xatom_NULL)
202 return QNULL;
204 BLOCK_INPUT;
205 str = XGetAtomName (display, atom);
206 UNBLOCK_INPUT;
207 #if 0
208 fprintf (stderr, " XGetAtomName --> %s\n", str);
209 #endif
210 if (! str) return Qnil;
211 val = intern (str);
212 BLOCK_INPUT;
213 /* This was allocated by Xlib, so use XFree. */
214 XFree (str);
215 UNBLOCK_INPUT;
216 return val;
219 /* Do protocol to assert ourself as a selection owner.
220 Update the Vselection_alist so that we can reply to later requests for
221 our selection. */
223 static void
224 x_own_selection (selection_name, selection_value)
225 Lisp_Object selection_name, selection_value;
227 Window selecting_window = FRAME_X_WINDOW (selected_frame);
228 Display *display = FRAME_X_DISPLAY (selected_frame);
229 Time time = last_event_timestamp;
230 Atom selection_atom;
231 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
233 CHECK_SYMBOL (selection_name, 0);
234 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
236 BLOCK_INPUT;
237 x_catch_errors (display);
238 XSetSelectionOwner (display, selection_atom, selecting_window, time);
239 x_check_errors (display, "Can't set selection: %s");
240 x_uncatch_errors (display);
241 UNBLOCK_INPUT;
243 /* Now update the local cache */
245 Lisp_Object selection_time;
246 Lisp_Object selection_data;
247 Lisp_Object prev_value;
249 selection_time = long_to_cons ((unsigned long) time);
250 selection_data = Fcons (selection_name,
251 Fcons (selection_value,
252 Fcons (selection_time,
253 Fcons (Fselected_frame (), Qnil))));
254 prev_value = assq_no_quit (selection_name, Vselection_alist);
256 Vselection_alist = Fcons (selection_data, Vselection_alist);
258 /* If we already owned the selection, remove the old selection data.
259 Perhaps we should destructively modify it instead.
260 Don't use Fdelq as that may QUIT. */
261 if (!NILP (prev_value))
263 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
264 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
265 if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
267 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
268 break;
274 /* Given a selection-name and desired type, look up our local copy of
275 the selection value and convert it to the type.
276 The value is nil or a string.
277 This function is used both for remote requests
278 and for local x-get-selection-internal.
280 This calls random Lisp code, and may signal or gc. */
282 static Lisp_Object
283 x_get_local_selection (selection_symbol, target_type)
284 Lisp_Object selection_symbol, target_type;
286 Lisp_Object local_value;
287 Lisp_Object handler_fn, value, type, check;
288 int count;
290 local_value = assq_no_quit (selection_symbol, Vselection_alist);
292 if (NILP (local_value)) return Qnil;
294 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
295 if (EQ (target_type, QTIMESTAMP))
297 handler_fn = Qnil;
298 value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
300 #if 0
301 else if (EQ (target_type, QDELETE))
303 handler_fn = Qnil;
304 Fx_disown_selection_internal
305 (selection_symbol,
306 XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
307 value = QNULL;
309 #endif
311 #if 0 /* #### MULTIPLE doesn't work yet */
312 else if (CONSP (target_type)
313 && XCONS (target_type)->car == QMULTIPLE)
315 Lisp_Object pairs;
316 int size;
317 int i;
318 pairs = XCONS (target_type)->cdr;
319 size = XVECTOR (pairs)->size;
320 /* If the target is MULTIPLE, then target_type looks like
321 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
322 We modify the second element of each pair in the vector and
323 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
325 for (i = 0; i < size; i++)
327 Lisp_Object pair;
328 pair = XVECTOR (pairs)->contents [i];
329 XVECTOR (pair)->contents [1]
330 = x_get_local_selection (XVECTOR (pair)->contents [0],
331 XVECTOR (pair)->contents [1]);
333 return pairs;
335 #endif
336 else
338 /* Don't allow a quit within the converter.
339 When the user types C-g, he would be surprised
340 if by luck it came during a converter. */
341 count = specpdl_ptr - specpdl;
342 specbind (Qinhibit_quit, Qt);
344 CHECK_SYMBOL (target_type, 0);
345 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
346 if (!NILP (handler_fn))
347 value = call3 (handler_fn,
348 selection_symbol, target_type,
349 XCONS (XCONS (local_value)->cdr)->car);
350 else
351 value = Qnil;
352 unbind_to (count, Qnil);
355 /* Make sure this value is of a type that we could transmit
356 to another X client. */
358 check = value;
359 if (CONSP (value)
360 && SYMBOLP (XCONS (value)->car))
361 type = XCONS (value)->car,
362 check = XCONS (value)->cdr;
364 if (STRINGP (check)
365 || VECTORP (check)
366 || SYMBOLP (check)
367 || INTEGERP (check)
368 || NILP (value))
369 return value;
370 /* Check for a value that cons_to_long could handle. */
371 else if (CONSP (check)
372 && INTEGERP (XCONS (check)->car)
373 && (INTEGERP (XCONS (check)->cdr)
375 (CONSP (XCONS (check)->cdr)
376 && INTEGERP (XCONS (XCONS (check)->cdr)->car)
377 && NILP (XCONS (XCONS (check)->cdr)->cdr))))
378 return value;
379 else
380 return
381 Fsignal (Qerror,
382 Fcons (build_string ("invalid data returned by selection-conversion function"),
383 Fcons (handler_fn, Fcons (value, Qnil))));
386 /* Subroutines of x_reply_selection_request. */
388 /* Send a SelectionNotify event to the requestor with property=None,
389 meaning we were unable to do what they wanted. */
391 static void
392 x_decline_selection_request (event)
393 struct input_event *event;
395 XSelectionEvent reply;
396 reply.type = SelectionNotify;
397 reply.display = SELECTION_EVENT_DISPLAY (event);
398 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
399 reply.selection = SELECTION_EVENT_SELECTION (event);
400 reply.time = SELECTION_EVENT_TIME (event);
401 reply.target = SELECTION_EVENT_TARGET (event);
402 reply.property = None;
404 BLOCK_INPUT;
405 XSendEvent (reply.display, reply.requestor, False, 0L,
406 (XEvent *) &reply);
407 XFlush (reply.display);
408 UNBLOCK_INPUT;
411 /* This is the selection request currently being processed.
412 It is set to zero when the request is fully processed. */
413 static struct input_event *x_selection_current_request;
415 /* Used as an unwind-protect clause so that, if a selection-converter signals
416 an error, we tell the requester that we were unable to do what they wanted
417 before we throw to top-level or go into the debugger or whatever. */
419 static Lisp_Object
420 x_selection_request_lisp_error (ignore)
421 Lisp_Object ignore;
423 if (x_selection_current_request != 0)
424 x_decline_selection_request (x_selection_current_request);
425 return Qnil;
429 /* This stuff is so that INCR selections are reentrant (that is, so we can
430 be servicing multiple INCR selection requests simultaneously.) I haven't
431 actually tested that yet. */
433 /* Keep a list of the property changes that are awaited. */
435 struct prop_location
437 int identifier;
438 Display *display;
439 Window window;
440 Atom property;
441 int desired_state;
442 int arrived;
443 struct prop_location *next;
446 static struct prop_location *expect_property_change ();
447 static void wait_for_property_change ();
448 static void unexpect_property_change ();
449 static int waiting_for_other_props_on_window ();
451 static int prop_location_identifier;
453 static Lisp_Object property_change_reply;
455 static struct prop_location *property_change_reply_object;
457 static struct prop_location *property_change_wait_list;
459 static Lisp_Object
460 queue_selection_requests_unwind (frame)
461 Lisp_Object frame;
463 FRAME_PTR f = XFRAME (frame);
465 if (! NILP (frame))
466 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
467 return Qnil;
470 /* Return some frame whose display info is DPYINFO.
471 Return nil if there is none. */
473 static Lisp_Object
474 some_frame_on_display (dpyinfo)
475 struct x_display_info *dpyinfo;
477 Lisp_Object list, frame;
479 FOR_EACH_FRAME (list, frame)
481 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
482 return frame;
485 return Qnil;
488 /* Send the reply to a selection request event EVENT.
489 TYPE is the type of selection data requested.
490 DATA and SIZE describe the data to send, already converted.
491 FORMAT is the unit-size (in bits) of the data to be transmitted. */
493 static void
494 x_reply_selection_request (event, format, data, size, type)
495 struct input_event *event;
496 int format, size;
497 unsigned char *data;
498 Atom type;
500 XSelectionEvent reply;
501 Display *display = SELECTION_EVENT_DISPLAY (event);
502 Window window = SELECTION_EVENT_REQUESTOR (event);
503 int bytes_remaining;
504 int format_bytes = format/8;
505 int max_bytes = SELECTION_QUANTUM (display);
506 struct x_display_info *dpyinfo = x_display_info_for_display (display);
508 if (max_bytes > MAX_SELECTION_QUANTUM)
509 max_bytes = MAX_SELECTION_QUANTUM;
511 reply.type = SelectionNotify;
512 reply.display = display;
513 reply.requestor = window;
514 reply.selection = SELECTION_EVENT_SELECTION (event);
515 reply.time = SELECTION_EVENT_TIME (event);
516 reply.target = SELECTION_EVENT_TARGET (event);
517 reply.property = SELECTION_EVENT_PROPERTY (event);
518 if (reply.property == None)
519 reply.property = reply.target;
521 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
522 BLOCK_INPUT;
523 x_catch_errors (display);
525 /* Store the data on the requested property.
526 If the selection is large, only store the first N bytes of it.
528 bytes_remaining = size * format_bytes;
529 if (bytes_remaining <= max_bytes)
531 /* Send all the data at once, with minimal handshaking. */
532 #if 0
533 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
534 #endif
535 XChangeProperty (display, window, reply.property, type, format,
536 PropModeReplace, data, size);
537 /* At this point, the selection was successfully stored; ack it. */
538 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
540 else
542 /* Send an INCR selection. */
543 struct prop_location *wait_object;
544 int had_errors;
545 int count = specpdl_ptr - specpdl;
546 Lisp_Object frame;
548 frame = some_frame_on_display (dpyinfo);
550 /* If the display no longer has frames, we can't expect
551 to get many more selection requests from it, so don't
552 bother trying to queue them. */
553 if (!NILP (frame))
555 x_start_queuing_selection_requests (display);
557 record_unwind_protect (queue_selection_requests_unwind,
558 frame);
561 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
562 error ("Attempt to transfer an INCR to ourself!");
563 #if 0
564 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
565 #endif
566 wait_object = expect_property_change (display, window, reply.property,
567 PropertyDelete);
569 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
570 32, PropModeReplace,
571 (unsigned char *) &bytes_remaining, 1);
572 XSelectInput (display, window, PropertyChangeMask);
573 /* Tell 'em the INCR data is there... */
574 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
575 XFlush (display);
577 had_errors = x_had_errors_p (display);
578 UNBLOCK_INPUT;
580 /* First, wait for the requester to ack by deleting the property.
581 This can run random lisp code (process handlers) or signal. */
582 if (! had_errors)
583 wait_for_property_change (wait_object);
585 while (bytes_remaining)
587 int i = ((bytes_remaining < max_bytes)
588 ? bytes_remaining
589 : max_bytes);
591 BLOCK_INPUT;
593 wait_object
594 = expect_property_change (display, window, reply.property,
595 PropertyDelete);
596 #if 0
597 fprintf (stderr," INCR adding %d\n", i);
598 #endif
599 /* Append the next chunk of data to the property. */
600 XChangeProperty (display, window, reply.property, type, format,
601 PropModeAppend, data, i / format_bytes);
602 bytes_remaining -= i;
603 data += i;
604 XFlush (display);
605 had_errors = x_had_errors_p (display);
606 UNBLOCK_INPUT;
608 if (had_errors)
609 break;
611 /* Now wait for the requester to ack this chunk by deleting the
612 property. This can run random lisp code or signal.
614 wait_for_property_change (wait_object);
616 /* Now write a zero-length chunk to the property to tell the requester
617 that we're done. */
618 #if 0
619 fprintf (stderr," INCR done\n");
620 #endif
621 BLOCK_INPUT;
622 if (! waiting_for_other_props_on_window (display, window))
623 XSelectInput (display, window, 0L);
625 XChangeProperty (display, window, reply.property, type, format,
626 PropModeReplace, data, 0);
628 unbind_to (count, Qnil);
631 XFlush (display);
632 x_uncatch_errors (display);
633 UNBLOCK_INPUT;
636 /* Handle a SelectionRequest event EVENT.
637 This is called from keyboard.c when such an event is found in the queue. */
639 void
640 x_handle_selection_request (event)
641 struct input_event *event;
643 struct gcpro gcpro1, gcpro2, gcpro3;
644 Lisp_Object local_selection_data;
645 Lisp_Object selection_symbol;
646 Lisp_Object target_symbol;
647 Lisp_Object converted_selection;
648 Time local_selection_time;
649 Lisp_Object successful_p;
650 int count;
651 struct x_display_info *dpyinfo
652 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
654 local_selection_data = Qnil;
655 target_symbol = Qnil;
656 converted_selection = Qnil;
657 successful_p = Qnil;
659 GCPRO3 (local_selection_data, converted_selection, target_symbol);
661 selection_symbol = x_atom_to_symbol (dpyinfo,
662 SELECTION_EVENT_DISPLAY (event),
663 SELECTION_EVENT_SELECTION (event));
665 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
667 if (NILP (local_selection_data))
669 /* Someone asked for the selection, but we don't have it any more.
671 x_decline_selection_request (event);
672 goto DONE;
675 local_selection_time = (Time)
676 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
678 if (SELECTION_EVENT_TIME (event) != CurrentTime
679 && local_selection_time > SELECTION_EVENT_TIME (event))
681 /* Someone asked for the selection, and we have one, but not the one
682 they're looking for.
684 x_decline_selection_request (event);
685 goto DONE;
688 count = specpdl_ptr - specpdl;
689 x_selection_current_request = event;
690 record_unwind_protect (x_selection_request_lisp_error, Qnil);
692 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
693 SELECTION_EVENT_TARGET (event));
695 #if 0 /* #### MULTIPLE doesn't work yet */
696 if (EQ (target_symbol, QMULTIPLE))
697 target_symbol = fetch_multiple_target (event);
698 #endif
700 /* Convert lisp objects back into binary data */
702 converted_selection
703 = x_get_local_selection (selection_symbol, target_symbol);
705 if (! NILP (converted_selection))
707 unsigned char *data;
708 unsigned int size;
709 int format;
710 Atom type;
711 int nofree;
713 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
714 converted_selection,
715 &data, &type, &size, &format, &nofree);
717 x_reply_selection_request (event, format, data, size, type);
718 successful_p = Qt;
720 /* Indicate we have successfully processed this event. */
721 x_selection_current_request = 0;
723 /* Use free, not XFree, because lisp_data_to_selection_data
724 calls xmalloc itself. */
725 if (!nofree)
726 free (data);
728 unbind_to (count, Qnil);
730 DONE:
732 UNGCPRO;
734 /* Let random lisp code notice that the selection has been asked for. */
736 Lisp_Object rest;
737 rest = Vx_sent_selection_hooks;
738 if (!EQ (rest, Qunbound))
739 for (; CONSP (rest); rest = Fcdr (rest))
740 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
744 /* Handle a SelectionClear event EVENT, which indicates that some other
745 client cleared out our previously asserted selection.
746 This is called from keyboard.c when such an event is found in the queue. */
748 void
749 x_handle_selection_clear (event)
750 struct input_event *event;
752 Display *display = SELECTION_EVENT_DISPLAY (event);
753 Atom selection = SELECTION_EVENT_SELECTION (event);
754 Time changed_owner_time = SELECTION_EVENT_TIME (event);
756 Lisp_Object selection_symbol, local_selection_data;
757 Time local_selection_time;
758 struct x_display_info *dpyinfo = x_display_info_for_display (display);
760 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
762 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
764 /* Well, we already believe that we don't own it, so that's just fine. */
765 if (NILP (local_selection_data)) return;
767 local_selection_time = (Time)
768 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
770 /* This SelectionClear is for a selection that we no longer own, so we can
771 disregard it. (That is, we have reasserted the selection since this
772 request was generated.) */
774 if (changed_owner_time != CurrentTime
775 && local_selection_time > changed_owner_time)
776 return;
778 /* Otherwise, we're really honest and truly being told to drop it.
779 Don't use Fdelq as that may QUIT;. */
781 if (EQ (local_selection_data, Fcar (Vselection_alist)))
782 Vselection_alist = Fcdr (Vselection_alist);
783 else
785 Lisp_Object rest;
786 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
787 if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
789 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
790 break;
794 /* Let random lisp code notice that the selection has been stolen. */
797 Lisp_Object rest;
798 rest = Vx_lost_selection_hooks;
799 if (!EQ (rest, Qunbound))
801 for (; CONSP (rest); rest = Fcdr (rest))
802 call1 (Fcar (rest), selection_symbol);
803 prepare_menu_bars ();
804 redisplay_preserve_echo_area ();
809 /* Clear all selections that were made from frame F.
810 We do this when about to delete a frame. */
812 void
813 x_clear_frame_selections (f)
814 FRAME_PTR f;
816 Lisp_Object frame;
817 Lisp_Object rest;
819 XSETFRAME (frame, f);
821 /* Otherwise, we're really honest and truly being told to drop it.
822 Don't use Fdelq as that may QUIT;. */
824 /* Delete elements from the beginning of Vselection_alist. */
825 while (!NILP (Vselection_alist)
826 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
828 /* Let random Lisp code notice that the selection has been stolen. */
829 Lisp_Object hooks, selection_symbol;
831 hooks = Vx_lost_selection_hooks;
832 selection_symbol = Fcar (Fcar (Vselection_alist));
834 if (!EQ (hooks, Qunbound))
836 for (; CONSP (hooks); hooks = Fcdr (hooks))
837 call1 (Fcar (hooks), selection_symbol);
838 #if 0 /* This can crash when deleting a frame
839 from x_connection_closed. Anyway, it seems unnecessary;
840 something else should cause a redisplay. */
841 redisplay_preserve_echo_area ();
842 #endif
845 Vselection_alist = Fcdr (Vselection_alist);
848 /* Delete elements after the beginning of Vselection_alist. */
849 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
850 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
852 /* Let random Lisp code notice that the selection has been stolen. */
853 Lisp_Object hooks, selection_symbol;
855 hooks = Vx_lost_selection_hooks;
856 selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
858 if (!EQ (hooks, Qunbound))
860 for (; CONSP (hooks); hooks = Fcdr (hooks))
861 call1 (Fcar (hooks), selection_symbol);
862 #if 0 /* See above */
863 redisplay_preserve_echo_area ();
864 #endif
866 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
867 break;
871 /* Nonzero if any properties for DISPLAY and WINDOW
872 are on the list of what we are waiting for. */
874 static int
875 waiting_for_other_props_on_window (display, window)
876 Display *display;
877 Window window;
879 struct prop_location *rest = property_change_wait_list;
880 while (rest)
881 if (rest->display == display && rest->window == window)
882 return 1;
883 else
884 rest = rest->next;
885 return 0;
888 /* Add an entry to the list of property changes we are waiting for.
889 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
890 The return value is a number that uniquely identifies
891 this awaited property change. */
893 static struct prop_location *
894 expect_property_change (display, window, property, state)
895 Display *display;
896 Window window;
897 Lisp_Object property;
898 int state;
900 struct prop_location *pl
901 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
902 pl->identifier = ++prop_location_identifier;
903 pl->display = display;
904 pl->window = window;
905 pl->property = property;
906 pl->desired_state = state;
907 pl->next = property_change_wait_list;
908 pl->arrived = 0;
909 property_change_wait_list = pl;
910 return pl;
913 /* Delete an entry from the list of property changes we are waiting for.
914 IDENTIFIER is the number that uniquely identifies the entry. */
916 static void
917 unexpect_property_change (location)
918 struct prop_location *location;
920 struct prop_location *prev = 0, *rest = property_change_wait_list;
921 while (rest)
923 if (rest == location)
925 if (prev)
926 prev->next = rest->next;
927 else
928 property_change_wait_list = rest->next;
929 free (rest);
930 return;
932 prev = rest;
933 rest = rest->next;
937 /* Remove the property change expectation element for IDENTIFIER. */
939 static Lisp_Object
940 wait_for_property_change_unwind (identifierval)
941 Lisp_Object identifierval;
943 unexpect_property_change ((struct prop_location *)
944 (XFASTINT (XCONS (identifierval)->car) << 16
945 | XFASTINT (XCONS (identifierval)->cdr)));
946 return Qnil;
949 /* Actually wait for a property change.
950 IDENTIFIER should be the value that expect_property_change returned. */
952 static void
953 wait_for_property_change (location)
954 struct prop_location *location;
956 int secs, usecs;
957 int count = specpdl_ptr - specpdl;
958 Lisp_Object tem;
960 tem = Fcons (Qnil, Qnil);
961 XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
962 XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
964 /* Make sure to do unexpect_property_change if we quit or err. */
965 record_unwind_protect (wait_for_property_change_unwind, tem);
967 XCONS (property_change_reply)->car = Qnil;
969 property_change_reply_object = location;
970 /* If the event we are waiting for arrives beyond here, it will set
971 property_change_reply, because property_change_reply_object says so. */
972 if (! location->arrived)
974 secs = x_selection_timeout / 1000;
975 usecs = (x_selection_timeout % 1000) * 1000;
976 wait_reading_process_input (secs, usecs, property_change_reply, 0);
978 if (NILP (XCONS (property_change_reply)->car))
979 error ("Timed out waiting for property-notify event");
982 unbind_to (count, Qnil);
985 /* Called from XTread_socket in response to a PropertyNotify event. */
987 void
988 x_handle_property_notify (event)
989 XPropertyEvent *event;
991 struct prop_location *prev = 0, *rest = property_change_wait_list;
992 while (rest)
994 if (rest->property == event->atom
995 && rest->window == event->window
996 && rest->display == event->display
997 && rest->desired_state == event->state)
999 #if 0
1000 fprintf (stderr, "Saw expected prop-%s on %s\n",
1001 (event->state == PropertyDelete ? "delete" : "change"),
1002 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
1003 event->atom))
1004 ->name->data);
1005 #endif
1007 rest->arrived = 1;
1009 /* If this is the one wait_for_property_change is waiting for,
1010 tell it to wake up. */
1011 if (rest == property_change_reply_object)
1012 XCONS (property_change_reply)->car = Qt;
1014 if (prev)
1015 prev->next = rest->next;
1016 else
1017 property_change_wait_list = rest->next;
1018 free (rest);
1019 return;
1021 prev = rest;
1022 rest = rest->next;
1024 #if 0
1025 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1026 (event->state == PropertyDelete ? "delete" : "change"),
1027 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1028 event->display, event->atom))
1029 ->name->data);
1030 #endif
1035 #if 0 /* #### MULTIPLE doesn't work yet */
1037 static Lisp_Object
1038 fetch_multiple_target (event)
1039 XSelectionRequestEvent *event;
1041 Display *display = event->display;
1042 Window window = event->requestor;
1043 Atom target = event->target;
1044 Atom selection_atom = event->selection;
1045 int result;
1047 return
1048 Fcons (QMULTIPLE,
1049 x_get_window_property_as_lisp_data (display, window, target,
1050 QMULTIPLE, selection_atom));
1053 static Lisp_Object
1054 copy_multiple_data (obj)
1055 Lisp_Object obj;
1057 Lisp_Object vec;
1058 int i;
1059 int size;
1060 if (CONSP (obj))
1061 return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
1063 CHECK_VECTOR (obj, 0);
1064 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1065 for (i = 0; i < size; i++)
1067 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1068 CHECK_VECTOR (vec2, 0);
1069 if (XVECTOR (vec2)->size != 2)
1070 /* ??? Confusing error message */
1071 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1072 Fcons (vec2, Qnil)));
1073 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1074 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1075 = XVECTOR (vec2)->contents [0];
1076 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1077 = XVECTOR (vec2)->contents [1];
1079 return vec;
1082 #endif
1085 /* Variables for communication with x_handle_selection_notify. */
1086 static Atom reading_which_selection;
1087 static Lisp_Object reading_selection_reply;
1088 static Window reading_selection_window;
1090 /* Do protocol to read selection-data from the server.
1091 Converts this to Lisp data and returns it. */
1093 static Lisp_Object
1094 x_get_foreign_selection (selection_symbol, target_type)
1095 Lisp_Object selection_symbol, target_type;
1097 Window requestor_window = FRAME_X_WINDOW (selected_frame);
1098 Display *display = FRAME_X_DISPLAY (selected_frame);
1099 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1100 Time requestor_time = last_event_timestamp;
1101 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1102 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1103 Atom type_atom;
1104 int secs, usecs;
1105 int count = specpdl_ptr - specpdl;
1106 Lisp_Object frame;
1108 if (CONSP (target_type))
1109 type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
1110 else
1111 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1113 BLOCK_INPUT;
1114 x_catch_errors (display);
1115 XConvertSelection (display, selection_atom, type_atom, target_property,
1116 requestor_window, requestor_time);
1117 XFlush (display);
1119 /* Prepare to block until the reply has been read. */
1120 reading_selection_window = requestor_window;
1121 reading_which_selection = selection_atom;
1122 XCONS (reading_selection_reply)->car = Qnil;
1124 frame = some_frame_on_display (dpyinfo);
1126 /* If the display no longer has frames, we can't expect
1127 to get many more selection requests from it, so don't
1128 bother trying to queue them. */
1129 if (!NILP (frame))
1131 x_start_queuing_selection_requests (display);
1133 record_unwind_protect (queue_selection_requests_unwind,
1134 frame);
1136 UNBLOCK_INPUT;
1138 /* This allows quits. Also, don't wait forever. */
1139 secs = x_selection_timeout / 1000;
1140 usecs = (x_selection_timeout % 1000) * 1000;
1141 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1143 BLOCK_INPUT;
1144 x_check_errors (display, "Cannot get selection: %s");
1145 x_uncatch_errors (display);
1146 unbind_to (count, Qnil);
1147 UNBLOCK_INPUT;
1149 if (NILP (XCONS (reading_selection_reply)->car))
1150 error ("Timed out waiting for reply from selection owner");
1151 if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
1152 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
1154 /* Otherwise, the selection is waiting for us on the requested property. */
1155 return
1156 x_get_window_property_as_lisp_data (display, requestor_window,
1157 target_property, target_type,
1158 selection_atom);
1161 /* Subroutines of x_get_window_property_as_lisp_data */
1163 /* Use free, not XFree, to free the data obtained with this function. */
1165 static void
1166 x_get_window_property (display, window, property, data_ret, bytes_ret,
1167 actual_type_ret, actual_format_ret, actual_size_ret,
1168 delete_p)
1169 Display *display;
1170 Window window;
1171 Atom property;
1172 unsigned char **data_ret;
1173 int *bytes_ret;
1174 Atom *actual_type_ret;
1175 int *actual_format_ret;
1176 unsigned long *actual_size_ret;
1177 int delete_p;
1179 int total_size;
1180 unsigned long bytes_remaining;
1181 int offset = 0;
1182 unsigned char *tmp_data = 0;
1183 int result;
1184 int buffer_size = SELECTION_QUANTUM (display);
1185 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1187 BLOCK_INPUT;
1188 /* First probe the thing to find out how big it is. */
1189 result = XGetWindowProperty (display, window, property,
1190 0L, 0L, False, AnyPropertyType,
1191 actual_type_ret, actual_format_ret,
1192 actual_size_ret,
1193 &bytes_remaining, &tmp_data);
1194 if (result != Success)
1196 UNBLOCK_INPUT;
1197 *data_ret = 0;
1198 *bytes_ret = 0;
1199 return;
1201 /* This was allocated by Xlib, so use XFree. */
1202 XFree ((char *) tmp_data);
1204 if (*actual_type_ret == None || *actual_format_ret == 0)
1206 UNBLOCK_INPUT;
1207 return;
1210 total_size = bytes_remaining + 1;
1211 *data_ret = (unsigned char *) xmalloc (total_size);
1213 /* Now read, until we've gotten it all. */
1214 while (bytes_remaining)
1216 #if 0
1217 int last = bytes_remaining;
1218 #endif
1219 result
1220 = XGetWindowProperty (display, window, property,
1221 (long)offset/4, (long)buffer_size/4,
1222 False,
1223 AnyPropertyType,
1224 actual_type_ret, actual_format_ret,
1225 actual_size_ret, &bytes_remaining, &tmp_data);
1226 #if 0
1227 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1228 #endif
1229 /* If this doesn't return Success at this point, it means that
1230 some clod deleted the selection while we were in the midst of
1231 reading it. Deal with that, I guess....
1233 if (result != Success) break;
1234 *actual_size_ret *= *actual_format_ret / 8;
1235 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1236 offset += *actual_size_ret;
1237 /* This was allocated by Xlib, so use XFree. */
1238 XFree ((char *) tmp_data);
1241 XFlush (display);
1242 UNBLOCK_INPUT;
1243 *bytes_ret = offset;
1246 /* Use free, not XFree, to free the data obtained with this function. */
1248 static void
1249 receive_incremental_selection (display, window, property, target_type,
1250 min_size_bytes, data_ret, size_bytes_ret,
1251 type_ret, format_ret, size_ret)
1252 Display *display;
1253 Window window;
1254 Atom property;
1255 Lisp_Object target_type; /* for error messages only */
1256 unsigned int min_size_bytes;
1257 unsigned char **data_ret;
1258 int *size_bytes_ret;
1259 Atom *type_ret;
1260 unsigned long *size_ret;
1261 int *format_ret;
1263 int offset = 0;
1264 struct prop_location *wait_object;
1265 *size_bytes_ret = min_size_bytes;
1266 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1267 #if 0
1268 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1269 #endif
1271 /* At this point, we have read an INCR property.
1272 Delete the property to ack it.
1273 (But first, prepare to receive the next event in this handshake.)
1275 Now, we must loop, waiting for the sending window to put a value on
1276 that property, then reading the property, then deleting it to ack.
1277 We are done when the sender places a property of length 0.
1279 BLOCK_INPUT;
1280 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1281 XDeleteProperty (display, window, property);
1282 wait_object = expect_property_change (display, window, property,
1283 PropertyNewValue);
1284 XFlush (display);
1285 UNBLOCK_INPUT;
1287 while (1)
1289 unsigned char *tmp_data;
1290 int tmp_size_bytes;
1291 wait_for_property_change (wait_object);
1292 /* expect it again immediately, because x_get_window_property may
1293 .. no it won't, I don't get it.
1294 .. Ok, I get it now, the Xt code that implements INCR is broken.
1296 x_get_window_property (display, window, property,
1297 &tmp_data, &tmp_size_bytes,
1298 type_ret, format_ret, size_ret, 1);
1300 if (tmp_size_bytes == 0) /* we're done */
1302 #if 0
1303 fprintf (stderr, " read INCR done\n");
1304 #endif
1305 if (! waiting_for_other_props_on_window (display, window))
1306 XSelectInput (display, window, STANDARD_EVENT_SET);
1307 unexpect_property_change (wait_object);
1308 /* Use free, not XFree, because x_get_window_property
1309 calls xmalloc itself. */
1310 if (tmp_data) free (tmp_data);
1311 break;
1314 BLOCK_INPUT;
1315 XDeleteProperty (display, window, property);
1316 wait_object = expect_property_change (display, window, property,
1317 PropertyNewValue);
1318 XFlush (display);
1319 UNBLOCK_INPUT;
1321 #if 0
1322 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1323 #endif
1324 if (*size_bytes_ret < offset + tmp_size_bytes)
1326 #if 0
1327 fprintf (stderr, " read INCR realloc %d -> %d\n",
1328 *size_bytes_ret, offset + tmp_size_bytes);
1329 #endif
1330 *size_bytes_ret = offset + tmp_size_bytes;
1331 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1333 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1334 offset += tmp_size_bytes;
1335 /* Use free, not XFree, because x_get_window_property
1336 calls xmalloc itself. */
1337 free (tmp_data);
1341 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1342 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1343 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1345 static Lisp_Object
1346 x_get_window_property_as_lisp_data (display, window, property, target_type,
1347 selection_atom)
1348 Display *display;
1349 Window window;
1350 Atom property;
1351 Lisp_Object target_type; /* for error messages only */
1352 Atom selection_atom; /* for error messages only */
1354 Atom actual_type;
1355 int actual_format;
1356 unsigned long actual_size;
1357 unsigned char *data = 0;
1358 int bytes = 0;
1359 Lisp_Object val;
1360 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1362 x_get_window_property (display, window, property, &data, &bytes,
1363 &actual_type, &actual_format, &actual_size, 1);
1364 if (! data)
1366 int there_is_a_selection_owner;
1367 BLOCK_INPUT;
1368 there_is_a_selection_owner
1369 = XGetSelectionOwner (display, selection_atom);
1370 UNBLOCK_INPUT;
1371 while (1) /* Note debugger can no longer return, so this is obsolete */
1372 Fsignal (Qerror,
1373 there_is_a_selection_owner ?
1374 Fcons (build_string ("selection owner couldn't convert"),
1375 actual_type
1376 ? Fcons (target_type,
1377 Fcons (x_atom_to_symbol (dpyinfo, display,
1378 actual_type),
1379 Qnil))
1380 : Fcons (target_type, Qnil))
1381 : Fcons (build_string ("no selection"),
1382 Fcons (x_atom_to_symbol (dpyinfo, display,
1383 selection_atom),
1384 Qnil)));
1387 if (actual_type == dpyinfo->Xatom_INCR)
1389 /* That wasn't really the data, just the beginning. */
1391 unsigned int min_size_bytes = * ((unsigned int *) data);
1392 BLOCK_INPUT;
1393 /* Use free, not XFree, because x_get_window_property
1394 calls xmalloc itself. */
1395 free ((char *) data);
1396 UNBLOCK_INPUT;
1397 receive_incremental_selection (display, window, property, target_type,
1398 min_size_bytes, &data, &bytes,
1399 &actual_type, &actual_format,
1400 &actual_size);
1403 BLOCK_INPUT;
1404 XDeleteProperty (display, window, property);
1405 XFlush (display);
1406 UNBLOCK_INPUT;
1408 /* It's been read. Now convert it to a lisp object in some semi-rational
1409 manner. */
1410 val = selection_data_to_lisp_data (display, data, bytes,
1411 actual_type, actual_format);
1413 /* Use free, not XFree, because x_get_window_property
1414 calls xmalloc itself. */
1415 free ((char *) data);
1416 return val;
1419 /* These functions convert from the selection data read from the server into
1420 something that we can use from Lisp, and vice versa.
1422 Type: Format: Size: Lisp Type:
1423 ----- ------- ----- -----------
1424 * 8 * String
1425 ATOM 32 1 Symbol
1426 ATOM 32 > 1 Vector of Symbols
1427 * 16 1 Integer
1428 * 16 > 1 Vector of Integers
1429 * 32 1 if <=16 bits: Integer
1430 if > 16 bits: Cons of top16, bot16
1431 * 32 > 1 Vector of the above
1433 When converting a Lisp number to C, it is assumed to be of format 16 if
1434 it is an integer, and of format 32 if it is a cons of two integers.
1436 When converting a vector of numbers from Lisp to C, it is assumed to be
1437 of format 16 if every element in the vector is an integer, and is assumed
1438 to be of format 32 if any element is a cons of two integers.
1440 When converting an object to C, it may be of the form (SYMBOL . <data>)
1441 where SYMBOL is what we should claim that the type is. Format and
1442 representation are as above. */
1446 static Lisp_Object
1447 selection_data_to_lisp_data (display, data, size, type, format)
1448 Display *display;
1449 unsigned char *data;
1450 Atom type;
1451 int size, format;
1453 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1455 if (type == dpyinfo->Xatom_NULL)
1456 return QNULL;
1458 /* Convert any 8-bit data to a string, for compactness. */
1459 else if (format == 8)
1460 return make_string ((char *) data, size);
1462 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1463 a vector of symbols.
1465 else if (type == XA_ATOM)
1467 int i;
1468 if (size == sizeof (Atom))
1469 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
1470 else
1472 Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
1473 for (i = 0; i < size / sizeof (Atom); i++)
1474 Faset (v, i, x_atom_to_symbol (dpyinfo, display,
1475 ((Atom *) data) [i]));
1476 return v;
1480 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1481 If the number is > 16 bits, convert it to a cons of integers,
1482 16 bits in each half.
1484 else if (format == 32 && size == sizeof (long))
1485 return long_to_cons (((unsigned long *) data) [0]);
1486 else if (format == 16 && size == sizeof (short))
1487 return make_number ((int) (((unsigned short *) data) [0]));
1489 /* Convert any other kind of data to a vector of numbers, represented
1490 as above (as an integer, or a cons of two 16 bit integers.)
1492 else if (format == 16)
1494 int i;
1495 Lisp_Object v = Fmake_vector (size / 4, 0);
1496 for (i = 0; i < size / 4; i++)
1498 int j = (int) ((unsigned short *) data) [i];
1499 Faset (v, i, make_number (j));
1501 return v;
1503 else
1505 int i;
1506 Lisp_Object v = Fmake_vector (size / 4, 0);
1507 for (i = 0; i < size / 4; i++)
1509 unsigned long j = ((unsigned long *) data) [i];
1510 Faset (v, i, long_to_cons (j));
1512 return v;
1517 /* Use free, not XFree, to free the data obtained with this function. */
1519 static void
1520 lisp_data_to_selection_data (display, obj,
1521 data_ret, type_ret, size_ret,
1522 format_ret, nofree_ret)
1523 Display *display;
1524 Lisp_Object obj;
1525 unsigned char **data_ret;
1526 Atom *type_ret;
1527 unsigned int *size_ret;
1528 int *format_ret;
1529 int *nofree_ret;
1531 Lisp_Object type = Qnil;
1532 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1534 *nofree_ret = 0;
1536 if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
1538 type = XCONS (obj)->car;
1539 obj = XCONS (obj)->cdr;
1540 if (CONSP (obj) && NILP (XCONS (obj)->cdr))
1541 obj = XCONS (obj)->car;
1544 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1545 { /* This is not the same as declining */
1546 *format_ret = 32;
1547 *size_ret = 0;
1548 *data_ret = 0;
1549 type = QNULL;
1551 else if (STRINGP (obj))
1553 *format_ret = 8;
1554 *size_ret = XSTRING (obj)->size;
1555 *data_ret = XSTRING (obj)->data;
1556 *nofree_ret = 1;
1557 if (NILP (type)) type = QSTRING;
1559 else if (SYMBOLP (obj))
1561 *format_ret = 32;
1562 *size_ret = 1;
1563 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1564 (*data_ret) [sizeof (Atom)] = 0;
1565 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1566 if (NILP (type)) type = QATOM;
1568 else if (INTEGERP (obj)
1569 && XINT (obj) < 0xFFFF
1570 && XINT (obj) > -0xFFFF)
1572 *format_ret = 16;
1573 *size_ret = 1;
1574 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1575 (*data_ret) [sizeof (short)] = 0;
1576 (*(short **) data_ret) [0] = (short) XINT (obj);
1577 if (NILP (type)) type = QINTEGER;
1579 else if (INTEGERP (obj)
1580 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
1581 && (INTEGERP (XCONS (obj)->cdr)
1582 || (CONSP (XCONS (obj)->cdr)
1583 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
1585 *format_ret = 32;
1586 *size_ret = 1;
1587 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1588 (*data_ret) [sizeof (long)] = 0;
1589 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1590 if (NILP (type)) type = QINTEGER;
1592 else if (VECTORP (obj))
1594 /* Lisp_Vectors may represent a set of ATOMs;
1595 a set of 16 or 32 bit INTEGERs;
1596 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1598 int i;
1600 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1601 /* This vector is an ATOM set */
1603 if (NILP (type)) type = QATOM;
1604 *size_ret = XVECTOR (obj)->size;
1605 *format_ret = 32;
1606 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1607 for (i = 0; i < *size_ret; i++)
1608 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1609 (*(Atom **) data_ret) [i]
1610 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1611 else
1612 Fsignal (Qerror, /* Qselection_error */
1613 Fcons (build_string
1614 ("all elements of selection vector must have same type"),
1615 Fcons (obj, Qnil)));
1617 #if 0 /* #### MULTIPLE doesn't work yet */
1618 else if (VECTORP (XVECTOR (obj)->contents [0]))
1619 /* This vector is an ATOM_PAIR set */
1621 if (NILP (type)) type = QATOM_PAIR;
1622 *size_ret = XVECTOR (obj)->size;
1623 *format_ret = 32;
1624 *data_ret = (unsigned char *)
1625 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1626 for (i = 0; i < *size_ret; i++)
1627 if (VECTORP (XVECTOR (obj)->contents [i]))
1629 Lisp_Object pair = XVECTOR (obj)->contents [i];
1630 if (XVECTOR (pair)->size != 2)
1631 Fsignal (Qerror,
1632 Fcons (build_string
1633 ("elements of the vector must be vectors of exactly two elements"),
1634 Fcons (pair, Qnil)));
1636 (*(Atom **) data_ret) [i * 2]
1637 = symbol_to_x_atom (dpyinfo, display,
1638 XVECTOR (pair)->contents [0]);
1639 (*(Atom **) data_ret) [(i * 2) + 1]
1640 = symbol_to_x_atom (dpyinfo, display,
1641 XVECTOR (pair)->contents [1]);
1643 else
1644 Fsignal (Qerror,
1645 Fcons (build_string
1646 ("all elements of the vector must be of the same type"),
1647 Fcons (obj, Qnil)));
1650 #endif
1651 else
1652 /* This vector is an INTEGER set, or something like it */
1654 *size_ret = XVECTOR (obj)->size;
1655 if (NILP (type)) type = QINTEGER;
1656 *format_ret = 16;
1657 for (i = 0; i < *size_ret; i++)
1658 if (CONSP (XVECTOR (obj)->contents [i]))
1659 *format_ret = 32;
1660 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1661 Fsignal (Qerror, /* Qselection_error */
1662 Fcons (build_string
1663 ("elements of selection vector must be integers or conses of integers"),
1664 Fcons (obj, Qnil)));
1666 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1667 for (i = 0; i < *size_ret; i++)
1668 if (*format_ret == 32)
1669 (*((unsigned long **) data_ret)) [i]
1670 = cons_to_long (XVECTOR (obj)->contents [i]);
1671 else
1672 (*((unsigned short **) data_ret)) [i]
1673 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1676 else
1677 Fsignal (Qerror, /* Qselection_error */
1678 Fcons (build_string ("unrecognised selection data"),
1679 Fcons (obj, Qnil)));
1681 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1684 static Lisp_Object
1685 clean_local_selection_data (obj)
1686 Lisp_Object obj;
1688 if (CONSP (obj)
1689 && INTEGERP (XCONS (obj)->car)
1690 && CONSP (XCONS (obj)->cdr)
1691 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
1692 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
1693 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
1695 if (CONSP (obj)
1696 && INTEGERP (XCONS (obj)->car)
1697 && INTEGERP (XCONS (obj)->cdr))
1699 if (XINT (XCONS (obj)->car) == 0)
1700 return XCONS (obj)->cdr;
1701 if (XINT (XCONS (obj)->car) == -1)
1702 return make_number (- XINT (XCONS (obj)->cdr));
1704 if (VECTORP (obj))
1706 int i;
1707 int size = XVECTOR (obj)->size;
1708 Lisp_Object copy;
1709 if (size == 1)
1710 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1711 copy = Fmake_vector (size, Qnil);
1712 for (i = 0; i < size; i++)
1713 XVECTOR (copy)->contents [i]
1714 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1715 return copy;
1717 return obj;
1720 /* Called from XTread_socket to handle SelectionNotify events.
1721 If it's the selection we are waiting for, stop waiting
1722 by setting the car of reading_selection_reply to non-nil.
1723 We store t there if the reply is successful, lambda if not. */
1725 void
1726 x_handle_selection_notify (event)
1727 XSelectionEvent *event;
1729 if (event->requestor != reading_selection_window)
1730 return;
1731 if (event->selection != reading_which_selection)
1732 return;
1734 XCONS (reading_selection_reply)->car
1735 = (event->property != 0 ? Qt : Qlambda);
1739 DEFUN ("x-own-selection-internal",
1740 Fx_own_selection_internal, Sx_own_selection_internal,
1741 2, 2, 0,
1742 "Assert an X selection of the given TYPE with the given VALUE.\n\
1743 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1744 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1745 VALUE is typically a string, or a cons of two markers, but may be\n\
1746 anything that the functions on `selection-converter-alist' know about.")
1747 (selection_name, selection_value)
1748 Lisp_Object selection_name, selection_value;
1750 check_x ();
1751 CHECK_SYMBOL (selection_name, 0);
1752 if (NILP (selection_value)) error ("selection-value may not be nil");
1753 x_own_selection (selection_name, selection_value);
1754 return selection_value;
1758 /* Request the selection value from the owner. If we are the owner,
1759 simply return our selection value. If we are not the owner, this
1760 will block until all of the data has arrived. */
1762 DEFUN ("x-get-selection-internal",
1763 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
1764 "Return text selected from some X window.\n\
1765 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1766 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1767 TYPE is the type of data desired, typically `STRING'.")
1768 (selection_symbol, target_type)
1769 Lisp_Object selection_symbol, target_type;
1771 Lisp_Object val = Qnil;
1772 struct gcpro gcpro1, gcpro2;
1773 GCPRO2 (target_type, val); /* we store newly consed data into these */
1774 check_x ();
1775 CHECK_SYMBOL (selection_symbol, 0);
1777 #if 0 /* #### MULTIPLE doesn't work yet */
1778 if (CONSP (target_type)
1779 && XCONS (target_type)->car == QMULTIPLE)
1781 CHECK_VECTOR (XCONS (target_type)->cdr, 0);
1782 /* So we don't destructively modify this... */
1783 target_type = copy_multiple_data (target_type);
1785 else
1786 #endif
1787 CHECK_SYMBOL (target_type, 0);
1789 val = x_get_local_selection (selection_symbol, target_type);
1791 if (NILP (val))
1793 val = x_get_foreign_selection (selection_symbol, target_type);
1794 goto DONE;
1797 if (CONSP (val)
1798 && SYMBOLP (XCONS (val)->car))
1800 val = XCONS (val)->cdr;
1801 if (CONSP (val) && NILP (XCONS (val)->cdr))
1802 val = XCONS (val)->car;
1804 val = clean_local_selection_data (val);
1805 DONE:
1806 UNGCPRO;
1807 return val;
1810 DEFUN ("x-disown-selection-internal",
1811 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
1812 "If we own the selection SELECTION, disown it.\n\
1813 Disowning it means there is no such selection.")
1814 (selection, time)
1815 Lisp_Object selection;
1816 Lisp_Object time;
1818 Time timestamp;
1819 Atom selection_atom;
1820 XSelectionClearEvent event;
1821 Display *display;
1822 struct x_display_info *dpyinfo;
1824 check_x ();
1825 display = FRAME_X_DISPLAY (selected_frame);
1826 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1827 CHECK_SYMBOL (selection, 0);
1828 if (NILP (time))
1829 timestamp = last_event_timestamp;
1830 else
1831 timestamp = cons_to_long (time);
1833 if (NILP (assq_no_quit (selection, Vselection_alist)))
1834 return Qnil; /* Don't disown the selection when we're not the owner. */
1836 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
1838 BLOCK_INPUT;
1839 XSetSelectionOwner (display, selection_atom, None, timestamp);
1840 UNBLOCK_INPUT;
1842 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1843 generated for a window which owns the selection when that window sets
1844 the selection owner to None. The NCD server does, the MIT Sun4 server
1845 doesn't. So we synthesize one; this means we might get two, but
1846 that's ok, because the second one won't have any effect. */
1847 SELECTION_EVENT_DISPLAY (&event) = display;
1848 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1849 SELECTION_EVENT_TIME (&event) = timestamp;
1850 x_handle_selection_clear (&event);
1852 return Qt;
1855 /* Get rid of all the selections in buffer BUFFER.
1856 This is used when we kill a buffer. */
1858 void
1859 x_disown_buffer_selections (buffer)
1860 Lisp_Object buffer;
1862 Lisp_Object tail;
1863 struct buffer *buf = XBUFFER (buffer);
1865 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1867 Lisp_Object elt, value;
1868 elt = XCONS (tail)->car;
1869 value = XCONS (elt)->cdr;
1870 if (CONSP (value) && MARKERP (XCONS (value)->car)
1871 && XMARKER (XCONS (value)->car)->buffer == buf)
1872 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
1876 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1877 0, 1, 0,
1878 "Whether the current Emacs process owns the given X Selection.\n\
1879 The arg should be the name of the selection in question, typically one of\n\
1880 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1881 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1882 For convenience, the symbol nil is the same as `PRIMARY',\n\
1883 and t is the same as `SECONDARY'.)")
1884 (selection)
1885 Lisp_Object selection;
1887 check_x ();
1888 CHECK_SYMBOL (selection, 0);
1889 if (EQ (selection, Qnil)) selection = QPRIMARY;
1890 if (EQ (selection, Qt)) selection = QSECONDARY;
1892 if (NILP (Fassq (selection, Vselection_alist)))
1893 return Qnil;
1894 return Qt;
1897 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
1898 0, 1, 0,
1899 "Whether there is an owner for the given X Selection.\n\
1900 The arg should be the name of the selection in question, typically one of\n\
1901 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1902 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1903 For convenience, the symbol nil is the same as `PRIMARY',\n\
1904 and t is the same as `SECONDARY'.)")
1905 (selection)
1906 Lisp_Object selection;
1908 Window owner;
1909 Atom atom;
1910 Display *dpy;
1912 /* It should be safe to call this before we have an X frame. */
1913 if (! FRAME_X_P (selected_frame))
1914 return Qnil;
1916 dpy = FRAME_X_DISPLAY (selected_frame);
1917 CHECK_SYMBOL (selection, 0);
1918 if (!NILP (Fx_selection_owner_p (selection)))
1919 return Qt;
1920 if (EQ (selection, Qnil)) selection = QPRIMARY;
1921 if (EQ (selection, Qt)) selection = QSECONDARY;
1922 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
1923 dpy, selection);
1924 if (atom == 0)
1925 return Qnil;
1926 BLOCK_INPUT;
1927 owner = XGetSelectionOwner (dpy, atom);
1928 UNBLOCK_INPUT;
1929 return (owner ? Qt : Qnil);
1933 #ifdef CUT_BUFFER_SUPPORT
1935 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1936 static void
1937 initialize_cut_buffers (display, window)
1938 Display *display;
1939 Window window;
1941 unsigned char *data = (unsigned char *) "";
1942 BLOCK_INPUT;
1943 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1944 PropModeAppend, data, 0)
1945 FROB (XA_CUT_BUFFER0);
1946 FROB (XA_CUT_BUFFER1);
1947 FROB (XA_CUT_BUFFER2);
1948 FROB (XA_CUT_BUFFER3);
1949 FROB (XA_CUT_BUFFER4);
1950 FROB (XA_CUT_BUFFER5);
1951 FROB (XA_CUT_BUFFER6);
1952 FROB (XA_CUT_BUFFER7);
1953 #undef FROB
1954 UNBLOCK_INPUT;
1958 #define CHECK_CUT_BUFFER(symbol,n) \
1959 { CHECK_SYMBOL ((symbol), (n)); \
1960 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1961 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1962 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1963 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1964 Fsignal (Qerror, \
1965 Fcons (build_string ("doesn't name a cut buffer"), \
1966 Fcons ((symbol), Qnil))); \
1969 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
1970 Sx_get_cut_buffer_internal, 1, 1, 0,
1971 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1972 (buffer)
1973 Lisp_Object buffer;
1975 Window window;
1976 Atom buffer_atom;
1977 unsigned char *data;
1978 int bytes;
1979 Atom type;
1980 int format;
1981 unsigned long size;
1982 Lisp_Object ret;
1983 Display *display;
1984 struct x_display_info *dpyinfo;
1986 check_x ();
1987 display = FRAME_X_DISPLAY (selected_frame);
1988 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1989 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1990 CHECK_CUT_BUFFER (buffer, 0);
1991 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
1993 x_get_window_property (display, window, buffer_atom, &data, &bytes,
1994 &type, &format, &size, 0);
1995 if (!data) return Qnil;
1997 if (format != 8 || type != XA_STRING)
1998 Fsignal (Qerror,
1999 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2000 Fcons (x_atom_to_symbol (dpyinfo, display, type),
2001 Fcons (make_number (format), Qnil))));
2003 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2004 /* Use free, not XFree, because x_get_window_property
2005 calls xmalloc itself. */
2006 free (data);
2007 return ret;
2011 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2012 Sx_store_cut_buffer_internal, 2, 2, 0,
2013 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2014 (buffer, string)
2015 Lisp_Object buffer, string;
2017 Window window;
2018 Atom buffer_atom;
2019 unsigned char *data;
2020 int bytes;
2021 int bytes_remaining;
2022 int max_bytes;
2023 Display *display;
2025 check_x ();
2026 display = FRAME_X_DISPLAY (selected_frame);
2027 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2029 max_bytes = SELECTION_QUANTUM (display);
2030 if (max_bytes > MAX_SELECTION_QUANTUM)
2031 max_bytes = MAX_SELECTION_QUANTUM;
2033 CHECK_CUT_BUFFER (buffer, 0);
2034 CHECK_STRING (string, 0);
2035 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
2036 display, buffer);
2037 data = (unsigned char *) XSTRING (string)->data;
2038 bytes = XSTRING (string)->size;
2039 bytes_remaining = bytes;
2041 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2043 initialize_cut_buffers (display, window);
2044 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2047 BLOCK_INPUT;
2049 /* Don't mess up with an empty value. */
2050 if (!bytes_remaining)
2051 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2052 PropModeReplace, data, 0);
2054 while (bytes_remaining)
2056 int chunk = (bytes_remaining < max_bytes
2057 ? bytes_remaining : max_bytes);
2058 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2059 (bytes_remaining == bytes
2060 ? PropModeReplace
2061 : PropModeAppend),
2062 data, chunk);
2063 data += chunk;
2064 bytes_remaining -= chunk;
2066 UNBLOCK_INPUT;
2067 return string;
2071 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2072 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2073 "Rotate the values of the cut buffers by the given number of steps;\n\
2074 positive means move values forward, negative means backward.")
2076 Lisp_Object n;
2078 Window window;
2079 Atom props[8];
2080 Display *display;
2082 check_x ();
2083 display = FRAME_X_DISPLAY (selected_frame);
2084 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2085 CHECK_NUMBER (n, 0);
2086 if (XINT (n) == 0)
2087 return n;
2088 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2090 initialize_cut_buffers (display, window);
2091 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2094 props[0] = XA_CUT_BUFFER0;
2095 props[1] = XA_CUT_BUFFER1;
2096 props[2] = XA_CUT_BUFFER2;
2097 props[3] = XA_CUT_BUFFER3;
2098 props[4] = XA_CUT_BUFFER4;
2099 props[5] = XA_CUT_BUFFER5;
2100 props[6] = XA_CUT_BUFFER6;
2101 props[7] = XA_CUT_BUFFER7;
2102 BLOCK_INPUT;
2103 XRotateWindowProperties (display, window, props, 8, XINT (n));
2104 UNBLOCK_INPUT;
2105 return n;
2108 #endif
2110 void
2111 syms_of_xselect ()
2113 defsubr (&Sx_get_selection_internal);
2114 defsubr (&Sx_own_selection_internal);
2115 defsubr (&Sx_disown_selection_internal);
2116 defsubr (&Sx_selection_owner_p);
2117 defsubr (&Sx_selection_exists_p);
2119 #ifdef CUT_BUFFER_SUPPORT
2120 defsubr (&Sx_get_cut_buffer_internal);
2121 defsubr (&Sx_store_cut_buffer_internal);
2122 defsubr (&Sx_rotate_cut_buffers_internal);
2123 #endif
2125 reading_selection_reply = Fcons (Qnil, Qnil);
2126 staticpro (&reading_selection_reply);
2127 reading_selection_window = 0;
2128 reading_which_selection = 0;
2130 property_change_wait_list = 0;
2131 prop_location_identifier = 0;
2132 property_change_reply = Fcons (Qnil, Qnil);
2133 staticpro (&property_change_reply);
2135 Vselection_alist = Qnil;
2136 staticpro (&Vselection_alist);
2138 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2139 "An alist associating X Windows selection-types with functions.\n\
2140 These functions are called to convert the selection, with three args:\n\
2141 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2142 a desired type to which the selection should be converted;\n\
2143 and the local selection value (whatever was given to `x-own-selection').\n\
2145 The function should return the value to send to the X server\n\
2146 \(typically a string). A return value of nil\n\
2147 means that the conversion could not be done.\n\
2148 A return value which is the symbol `NULL'\n\
2149 means that a side-effect was executed,\n\
2150 and there is no meaningful selection value.");
2151 Vselection_converter_alist = Qnil;
2153 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2154 "A list of functions to be called when Emacs loses an X selection.\n\
2155 \(This happens when some other X client makes its own selection\n\
2156 or when a Lisp program explicitly clears the selection.)\n\
2157 The functions are called with one argument, the selection type\n\
2158 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2159 Vx_lost_selection_hooks = Qnil;
2161 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2162 "A list of functions to be called when Emacs answers a selection request.\n\
2163 The functions are called with four arguments:\n\
2164 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2165 - the selection-type which Emacs was asked to convert the\n\
2166 selection into before sending (for example, `STRING' or `LENGTH');\n\
2167 - a flag indicating success or failure for responding to the request.\n\
2168 We might have failed (and declined the request) for any number of reasons,\n\
2169 including being asked for a selection that we no longer own, or being asked\n\
2170 to convert into a type that we don't know about or that is inappropriate.\n\
2171 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2172 it merely informs you that they have happened.");
2173 Vx_sent_selection_hooks = Qnil;
2175 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2176 "Number of milliseconds to wait for a selection reply.\n\
2177 If the selection owner doesn't reply in this time, we give up.\n\
2178 A value of 0 means wait as long as necessary. This is initialized from the\n\
2179 \"*selectionTimeout\" resource.");
2180 x_selection_timeout = 0;
2182 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2183 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2184 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2185 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2186 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2187 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2188 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2189 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2190 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2191 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2192 QINCR = intern ("INCR"); staticpro (&QINCR);
2193 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2194 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2195 QATOM = intern ("ATOM"); staticpro (&QATOM);
2196 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2197 QNULL = intern ("NULL"); staticpro (&QNULL);
2199 #ifdef CUT_BUFFER_SUPPORT
2200 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2201 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2202 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2203 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2204 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2205 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2206 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2207 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2208 #endif