(timeout-event-p): Function deleted.
[emacs.git] / src / xselect.c
blob9e4681f5dc4b3ace3f25c933b74de903eb4dd9e6
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 unsigned long last_event_timestamp;
62 /* This is an association list whose elements are of the form
63 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
64 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
65 SELECTION-VALUE is the value that emacs owns for that selection.
66 It may be any kind of Lisp object.
67 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
68 as a cons of two 16-bit numbers (making a 32 bit time.)
69 FRAME is the frame for which we made the selection.
70 If there is an entry in this alist, then it can be assumed that Emacs owns
71 that selection.
72 The only (eq) parts of this list that are visible from Lisp are the
73 selection-values. */
74 static Lisp_Object Vselection_alist;
76 /* This is an alist whose CARs are selection-types (whose names are the same
77 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
78 call to convert the given Emacs selection value to a string representing
79 the given selection type. This is for Lisp-level extension of the emacs
80 selection handling. */
81 static Lisp_Object Vselection_converter_alist;
83 /* If the selection owner takes too long to reply to a selection request,
84 we give up on it. This is in milliseconds (0 = no timeout.) */
85 static int x_selection_timeout;
87 /* Utility functions */
89 static void lisp_data_to_selection_data ();
90 static Lisp_Object selection_data_to_lisp_data ();
91 static Lisp_Object x_get_window_property_as_lisp_data ();
93 /* This converts a Lisp symbol to a server Atom, avoiding a server
94 roundtrip whenever possible. */
96 static Atom
97 symbol_to_x_atom (dpyinfo, display, sym)
98 struct x_display_info *dpyinfo;
99 Display *display;
100 Lisp_Object sym;
102 Atom val;
103 if (NILP (sym)) return 0;
104 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
105 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
106 if (EQ (sym, QSTRING)) return XA_STRING;
107 if (EQ (sym, QINTEGER)) return XA_INTEGER;
108 if (EQ (sym, QATOM)) return XA_ATOM;
109 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
110 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
111 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
112 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
113 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
114 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
115 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
116 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
117 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
118 #ifdef CUT_BUFFER_SUPPORT
119 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
120 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
121 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
122 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
123 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
124 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
125 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
126 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
127 #endif
128 if (!SYMBOLP (sym)) abort ();
130 #if 0
131 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
132 #endif
133 BLOCK_INPUT;
134 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
135 UNBLOCK_INPUT;
136 return val;
140 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
141 and calls to intern whenever possible. */
143 static Lisp_Object
144 x_atom_to_symbol (dpyinfo, display, atom)
145 struct x_display_info *dpyinfo;
146 Display *display;
147 Atom atom;
149 char *str;
150 Lisp_Object val;
151 if (! atom) return Qnil;
152 switch (atom)
154 case XA_PRIMARY:
155 return QPRIMARY;
156 case XA_SECONDARY:
157 return QSECONDARY;
158 case XA_STRING:
159 return QSTRING;
160 case XA_INTEGER:
161 return QINTEGER;
162 case XA_ATOM:
163 return QATOM;
164 #ifdef CUT_BUFFER_SUPPORT
165 case XA_CUT_BUFFER0:
166 return QCUT_BUFFER0;
167 case XA_CUT_BUFFER1:
168 return QCUT_BUFFER1;
169 case XA_CUT_BUFFER2:
170 return QCUT_BUFFER2;
171 case XA_CUT_BUFFER3:
172 return QCUT_BUFFER3;
173 case XA_CUT_BUFFER4:
174 return QCUT_BUFFER4;
175 case XA_CUT_BUFFER5:
176 return QCUT_BUFFER5;
177 case XA_CUT_BUFFER6:
178 return QCUT_BUFFER6;
179 case XA_CUT_BUFFER7:
180 return QCUT_BUFFER7;
181 #endif
184 if (atom == dpyinfo->Xatom_CLIPBOARD)
185 return QCLIPBOARD;
186 if (atom == dpyinfo->Xatom_TIMESTAMP)
187 return QTIMESTAMP;
188 if (atom == dpyinfo->Xatom_TEXT)
189 return QTEXT;
190 if (atom == dpyinfo->Xatom_DELETE)
191 return QDELETE;
192 if (atom == dpyinfo->Xatom_MULTIPLE)
193 return QMULTIPLE;
194 if (atom == dpyinfo->Xatom_INCR)
195 return QINCR;
196 if (atom == dpyinfo->Xatom_EMACS_TMP)
197 return QEMACS_TMP;
198 if (atom == dpyinfo->Xatom_TARGETS)
199 return QTARGETS;
200 if (atom == dpyinfo->Xatom_NULL)
201 return QNULL;
203 BLOCK_INPUT;
204 str = XGetAtomName (display, atom);
205 UNBLOCK_INPUT;
206 #if 0
207 fprintf (stderr, " XGetAtomName --> %s\n", str);
208 #endif
209 if (! str) return Qnil;
210 val = intern (str);
211 BLOCK_INPUT;
212 /* This was allocated by Xlib, so use XFree. */
213 XFree (str);
214 UNBLOCK_INPUT;
215 return val;
218 /* Do protocol to assert ourself as a selection owner.
219 Update the Vselection_alist so that we can reply to later requests for
220 our selection. */
222 static void
223 x_own_selection (selection_name, selection_value)
224 Lisp_Object selection_name, selection_value;
226 Window selecting_window = FRAME_X_WINDOW (selected_frame);
227 Display *display = FRAME_X_DISPLAY (selected_frame);
228 Time time = last_event_timestamp;
229 Atom selection_atom;
230 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
232 CHECK_SYMBOL (selection_name, 0);
233 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
235 BLOCK_INPUT;
236 x_catch_errors (display);
237 XSetSelectionOwner (display, selection_atom, selecting_window, time);
238 x_check_errors (display, "Can't set selection: %s");
239 x_uncatch_errors (display);
240 UNBLOCK_INPUT;
242 /* Now update the local cache */
244 Lisp_Object selection_time;
245 Lisp_Object selection_data;
246 Lisp_Object prev_value;
248 selection_time = long_to_cons ((unsigned long) time);
249 selection_data = Fcons (selection_name,
250 Fcons (selection_value,
251 Fcons (selection_time,
252 Fcons (Fselected_frame (), Qnil))));
253 prev_value = assq_no_quit (selection_name, Vselection_alist);
255 Vselection_alist = Fcons (selection_data, Vselection_alist);
257 /* If we already owned the selection, remove the old selection data.
258 Perhaps we should destructively modify it instead.
259 Don't use Fdelq as that may QUIT. */
260 if (!NILP (prev_value))
262 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
263 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
264 if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
266 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
267 break;
273 /* Given a selection-name and desired type, look up our local copy of
274 the selection value and convert it to the type.
275 The value is nil or a string.
276 This function is used both for remote requests
277 and for local x-get-selection-internal.
279 This calls random Lisp code, and may signal or gc. */
281 static Lisp_Object
282 x_get_local_selection (selection_symbol, target_type)
283 Lisp_Object selection_symbol, target_type;
285 Lisp_Object local_value;
286 Lisp_Object handler_fn, value, type, check;
287 int count;
289 local_value = assq_no_quit (selection_symbol, Vselection_alist);
291 if (NILP (local_value)) return Qnil;
293 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
294 if (EQ (target_type, QTIMESTAMP))
296 handler_fn = Qnil;
297 value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
299 #if 0
300 else if (EQ (target_type, QDELETE))
302 handler_fn = Qnil;
303 Fx_disown_selection_internal
304 (selection_symbol,
305 XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
306 value = QNULL;
308 #endif
310 #if 0 /* #### MULTIPLE doesn't work yet */
311 else if (CONSP (target_type)
312 && XCONS (target_type)->car == QMULTIPLE)
314 Lisp_Object pairs;
315 int size;
316 int i;
317 pairs = XCONS (target_type)->cdr;
318 size = XVECTOR (pairs)->size;
319 /* If the target is MULTIPLE, then target_type looks like
320 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
321 We modify the second element of each pair in the vector and
322 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
324 for (i = 0; i < size; i++)
326 Lisp_Object pair;
327 pair = XVECTOR (pairs)->contents [i];
328 XVECTOR (pair)->contents [1]
329 = x_get_local_selection (XVECTOR (pair)->contents [0],
330 XVECTOR (pair)->contents [1]);
332 return pairs;
334 #endif
335 else
337 /* Don't allow a quit within the converter.
338 When the user types C-g, he would be surprised
339 if by luck it came during a converter. */
340 count = specpdl_ptr - specpdl;
341 specbind (Qinhibit_quit, Qt);
343 CHECK_SYMBOL (target_type, 0);
344 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
345 if (!NILP (handler_fn))
346 value = call3 (handler_fn,
347 selection_symbol, target_type,
348 XCONS (XCONS (local_value)->cdr)->car);
349 else
350 value = Qnil;
351 unbind_to (count, Qnil);
354 /* Make sure this value is of a type that we could transmit
355 to another X client. */
357 check = value;
358 if (CONSP (value)
359 && SYMBOLP (XCONS (value)->car))
360 type = XCONS (value)->car,
361 check = XCONS (value)->cdr;
363 if (STRINGP (check)
364 || VECTORP (check)
365 || SYMBOLP (check)
366 || INTEGERP (check)
367 || NILP (value))
368 return value;
369 /* Check for a value that cons_to_long could handle. */
370 else if (CONSP (check)
371 && INTEGERP (XCONS (check)->car)
372 && (INTEGERP (XCONS (check)->cdr)
374 (CONSP (XCONS (check)->cdr)
375 && INTEGERP (XCONS (XCONS (check)->cdr)->car)
376 && NILP (XCONS (XCONS (check)->cdr)->cdr))))
377 return value;
378 else
379 return
380 Fsignal (Qerror,
381 Fcons (build_string ("invalid data returned by selection-conversion function"),
382 Fcons (handler_fn, Fcons (value, Qnil))));
385 /* Subroutines of x_reply_selection_request. */
387 /* Send a SelectionNotify event to the requestor with property=None,
388 meaning we were unable to do what they wanted. */
390 static void
391 x_decline_selection_request (event)
392 struct input_event *event;
394 XSelectionEvent reply;
395 reply.type = SelectionNotify;
396 reply.display = SELECTION_EVENT_DISPLAY (event);
397 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
398 reply.selection = SELECTION_EVENT_SELECTION (event);
399 reply.time = SELECTION_EVENT_TIME (event);
400 reply.target = SELECTION_EVENT_TARGET (event);
401 reply.property = None;
403 BLOCK_INPUT;
404 XSendEvent (reply.display, reply.requestor, False, 0L,
405 (XEvent *) &reply);
406 XFlush (reply.display);
407 UNBLOCK_INPUT;
410 /* This is the selection request currently being processed.
411 It is set to zero when the request is fully processed. */
412 static struct input_event *x_selection_current_request;
414 /* Used as an unwind-protect clause so that, if a selection-converter signals
415 an error, we tell the requester that we were unable to do what they wanted
416 before we throw to top-level or go into the debugger or whatever. */
418 static Lisp_Object
419 x_selection_request_lisp_error (ignore)
420 Lisp_Object ignore;
422 if (x_selection_current_request != 0)
423 x_decline_selection_request (x_selection_current_request);
424 return Qnil;
428 /* This stuff is so that INCR selections are reentrant (that is, so we can
429 be servicing multiple INCR selection requests simultaneously.) I haven't
430 actually tested that yet. */
432 /* Keep a list of the property changes that are awaited. */
434 struct prop_location
436 int identifier;
437 Display *display;
438 Window window;
439 Atom property;
440 int desired_state;
441 int arrived;
442 struct prop_location *next;
445 static struct prop_location *expect_property_change ();
446 static void wait_for_property_change ();
447 static void unexpect_property_change ();
448 static int waiting_for_other_props_on_window ();
450 static int prop_location_identifier;
452 static Lisp_Object property_change_reply;
454 static struct prop_location *property_change_reply_object;
456 static struct prop_location *property_change_wait_list;
458 static Lisp_Object
459 queue_selection_requests_unwind (frame)
460 Lisp_Object frame;
462 FRAME_PTR f = XFRAME (frame);
464 if (! NILP (frame))
465 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
466 return Qnil;
469 /* Return some frame whose display info is DPYINFO.
470 Return nil if there is none. */
472 static Lisp_Object
473 some_frame_on_display (dpyinfo)
474 struct x_display_info *dpyinfo;
476 Lisp_Object list, frame;
478 FOR_EACH_FRAME (list, frame)
480 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
481 return frame;
484 return Qnil;
487 /* Send the reply to a selection request event EVENT.
488 TYPE is the type of selection data requested.
489 DATA and SIZE describe the data to send, already converted.
490 FORMAT is the unit-size (in bits) of the data to be transmitted. */
492 static void
493 x_reply_selection_request (event, format, data, size, type)
494 struct input_event *event;
495 int format, size;
496 unsigned char *data;
497 Atom type;
499 XSelectionEvent reply;
500 Display *display = SELECTION_EVENT_DISPLAY (event);
501 Window window = SELECTION_EVENT_REQUESTOR (event);
502 int bytes_remaining;
503 int format_bytes = format/8;
504 int max_bytes = SELECTION_QUANTUM (display);
505 struct x_display_info *dpyinfo = x_display_info_for_display (display);
507 if (max_bytes > MAX_SELECTION_QUANTUM)
508 max_bytes = MAX_SELECTION_QUANTUM;
510 reply.type = SelectionNotify;
511 reply.display = display;
512 reply.requestor = window;
513 reply.selection = SELECTION_EVENT_SELECTION (event);
514 reply.time = SELECTION_EVENT_TIME (event);
515 reply.target = SELECTION_EVENT_TARGET (event);
516 reply.property = SELECTION_EVENT_PROPERTY (event);
517 if (reply.property == None)
518 reply.property = reply.target;
520 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
521 BLOCK_INPUT;
522 x_catch_errors (display);
524 /* Store the data on the requested property.
525 If the selection is large, only store the first N bytes of it.
527 bytes_remaining = size * format_bytes;
528 if (bytes_remaining <= max_bytes)
530 /* Send all the data at once, with minimal handshaking. */
531 #if 0
532 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
533 #endif
534 XChangeProperty (display, window, reply.property, type, format,
535 PropModeReplace, data, size);
536 /* At this point, the selection was successfully stored; ack it. */
537 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
539 else
541 /* Send an INCR selection. */
542 struct prop_location *wait_object;
543 int had_errors;
544 int count = specpdl_ptr - specpdl;
545 Lisp_Object frame;
547 frame = some_frame_on_display (dpyinfo);
549 /* If the display no longer has frames, we can't expect
550 to get many more selection requests from it, so don't
551 bother trying to queue them. */
552 if (!NILP (frame))
554 x_start_queuing_selection_requests (display);
556 record_unwind_protect (queue_selection_requests_unwind,
557 frame);
560 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
561 error ("Attempt to transfer an INCR to ourself!");
562 #if 0
563 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
564 #endif
565 wait_object = expect_property_change (display, window, reply.property,
566 PropertyDelete);
568 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
569 32, PropModeReplace,
570 (unsigned char *) &bytes_remaining, 1);
571 XSelectInput (display, window, PropertyChangeMask);
572 /* Tell 'em the INCR data is there... */
573 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
574 XFlush (display);
576 had_errors = x_had_errors_p (display);
577 UNBLOCK_INPUT;
579 /* First, wait for the requester to ack by deleting the property.
580 This can run random lisp code (process handlers) or signal. */
581 if (! had_errors)
582 wait_for_property_change (wait_object);
584 while (bytes_remaining)
586 int i = ((bytes_remaining < max_bytes)
587 ? bytes_remaining
588 : max_bytes);
590 BLOCK_INPUT;
592 wait_object
593 = expect_property_change (display, window, reply.property,
594 PropertyDelete);
595 #if 0
596 fprintf (stderr," INCR adding %d\n", i);
597 #endif
598 /* Append the next chunk of data to the property. */
599 XChangeProperty (display, window, reply.property, type, format,
600 PropModeAppend, data, i / format_bytes);
601 bytes_remaining -= i;
602 data += i;
603 XFlush (display);
604 had_errors = x_had_errors_p (display);
605 UNBLOCK_INPUT;
607 if (had_errors)
608 break;
610 /* Now wait for the requester to ack this chunk by deleting the
611 property. This can run random lisp code or signal.
613 wait_for_property_change (wait_object);
615 /* Now write a zero-length chunk to the property to tell the requester
616 that we're done. */
617 #if 0
618 fprintf (stderr," INCR done\n");
619 #endif
620 BLOCK_INPUT;
621 if (! waiting_for_other_props_on_window (display, window))
622 XSelectInput (display, window, 0L);
624 XChangeProperty (display, window, reply.property, type, format,
625 PropModeReplace, data, 0);
627 unbind_to (count, Qnil);
630 XFlush (display);
631 x_uncatch_errors (display);
632 UNBLOCK_INPUT;
635 /* Handle a SelectionRequest event EVENT.
636 This is called from keyboard.c when such an event is found in the queue. */
638 void
639 x_handle_selection_request (event)
640 struct input_event *event;
642 struct gcpro gcpro1, gcpro2, gcpro3;
643 Lisp_Object local_selection_data;
644 Lisp_Object selection_symbol;
645 Lisp_Object target_symbol;
646 Lisp_Object converted_selection;
647 Time local_selection_time;
648 Lisp_Object successful_p;
649 int count;
650 struct x_display_info *dpyinfo
651 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
653 local_selection_data = Qnil;
654 target_symbol = Qnil;
655 converted_selection = Qnil;
656 successful_p = Qnil;
658 GCPRO3 (local_selection_data, converted_selection, target_symbol);
660 selection_symbol = x_atom_to_symbol (dpyinfo,
661 SELECTION_EVENT_DISPLAY (event),
662 SELECTION_EVENT_SELECTION (event));
664 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
666 if (NILP (local_selection_data))
668 /* Someone asked for the selection, but we don't have it any more.
670 x_decline_selection_request (event);
671 goto DONE;
674 local_selection_time = (Time)
675 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
677 if (SELECTION_EVENT_TIME (event) != CurrentTime
678 && local_selection_time > SELECTION_EVENT_TIME (event))
680 /* Someone asked for the selection, and we have one, but not the one
681 they're looking for.
683 x_decline_selection_request (event);
684 goto DONE;
687 count = specpdl_ptr - specpdl;
688 x_selection_current_request = event;
689 record_unwind_protect (x_selection_request_lisp_error, Qnil);
691 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
692 SELECTION_EVENT_TARGET (event));
694 #if 0 /* #### MULTIPLE doesn't work yet */
695 if (EQ (target_symbol, QMULTIPLE))
696 target_symbol = fetch_multiple_target (event);
697 #endif
699 /* Convert lisp objects back into binary data */
701 converted_selection
702 = x_get_local_selection (selection_symbol, target_symbol);
704 if (! NILP (converted_selection))
706 unsigned char *data;
707 unsigned int size;
708 int format;
709 Atom type;
710 int nofree;
712 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
713 converted_selection,
714 &data, &type, &size, &format, &nofree);
716 x_reply_selection_request (event, format, data, size, type);
717 successful_p = Qt;
719 /* Indicate we have successfully processed this event. */
720 x_selection_current_request = 0;
722 /* Use free, not XFree, because lisp_data_to_selection_data
723 calls xmalloc itself. */
724 if (!nofree)
725 free (data);
727 unbind_to (count, Qnil);
729 DONE:
731 UNGCPRO;
733 /* Let random lisp code notice that the selection has been asked for. */
735 Lisp_Object rest;
736 rest = Vx_sent_selection_hooks;
737 if (!EQ (rest, Qunbound))
738 for (; CONSP (rest); rest = Fcdr (rest))
739 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
743 /* Handle a SelectionClear event EVENT, which indicates that some other
744 client cleared out our previously asserted selection.
745 This is called from keyboard.c when such an event is found in the queue. */
747 void
748 x_handle_selection_clear (event)
749 struct input_event *event;
751 Display *display = SELECTION_EVENT_DISPLAY (event);
752 Atom selection = SELECTION_EVENT_SELECTION (event);
753 Time changed_owner_time = SELECTION_EVENT_TIME (event);
755 Lisp_Object selection_symbol, local_selection_data;
756 Time local_selection_time;
757 struct x_display_info *dpyinfo = x_display_info_for_display (display);
759 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
761 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
763 /* Well, we already believe that we don't own it, so that's just fine. */
764 if (NILP (local_selection_data)) return;
766 local_selection_time = (Time)
767 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
769 /* This SelectionClear is for a selection that we no longer own, so we can
770 disregard it. (That is, we have reasserted the selection since this
771 request was generated.) */
773 if (changed_owner_time != CurrentTime
774 && local_selection_time > changed_owner_time)
775 return;
777 /* Otherwise, we're really honest and truly being told to drop it.
778 Don't use Fdelq as that may QUIT;. */
780 if (EQ (local_selection_data, Fcar (Vselection_alist)))
781 Vselection_alist = Fcdr (Vselection_alist);
782 else
784 Lisp_Object rest;
785 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
786 if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
788 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
789 break;
793 /* Let random lisp code notice that the selection has been stolen. */
796 Lisp_Object rest;
797 rest = Vx_lost_selection_hooks;
798 if (!EQ (rest, Qunbound))
800 for (; CONSP (rest); rest = Fcdr (rest))
801 call1 (Fcar (rest), selection_symbol);
802 prepare_menu_bars ();
803 redisplay_preserve_echo_area ();
808 /* Clear all selections that were made from frame F.
809 We do this when about to delete a frame. */
811 void
812 x_clear_frame_selections (f)
813 FRAME_PTR f;
815 Lisp_Object frame;
816 Lisp_Object rest;
818 XSETFRAME (frame, f);
820 /* Otherwise, we're really honest and truly being told to drop it.
821 Don't use Fdelq as that may QUIT;. */
823 /* Delete elements from the beginning of Vselection_alist. */
824 while (!NILP (Vselection_alist)
825 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
827 /* Let random Lisp code notice that the selection has been stolen. */
828 Lisp_Object hooks, selection_symbol;
830 hooks = Vx_lost_selection_hooks;
831 selection_symbol = Fcar (Fcar (Vselection_alist));
833 if (!EQ (hooks, Qunbound))
835 for (; CONSP (hooks); hooks = Fcdr (hooks))
836 call1 (Fcar (hooks), selection_symbol);
837 redisplay_preserve_echo_area ();
840 Vselection_alist = Fcdr (Vselection_alist);
843 /* Delete elements after the beginning of Vselection_alist. */
844 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
845 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
847 /* Let random Lisp code notice that the selection has been stolen. */
848 Lisp_Object hooks, selection_symbol;
850 hooks = Vx_lost_selection_hooks;
851 selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
853 if (!EQ (hooks, Qunbound))
855 for (; CONSP (hooks); hooks = Fcdr (hooks))
856 call1 (Fcar (hooks), selection_symbol);
857 redisplay_preserve_echo_area ();
859 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
860 break;
864 /* Nonzero if any properties for DISPLAY and WINDOW
865 are on the list of what we are waiting for. */
867 static int
868 waiting_for_other_props_on_window (display, window)
869 Display *display;
870 Window window;
872 struct prop_location *rest = property_change_wait_list;
873 while (rest)
874 if (rest->display == display && rest->window == window)
875 return 1;
876 else
877 rest = rest->next;
878 return 0;
881 /* Add an entry to the list of property changes we are waiting for.
882 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
883 The return value is a number that uniquely identifies
884 this awaited property change. */
886 static struct prop_location *
887 expect_property_change (display, window, property, state)
888 Display *display;
889 Window window;
890 Lisp_Object property;
891 int state;
893 struct prop_location *pl
894 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
895 pl->identifier = ++prop_location_identifier;
896 pl->display = display;
897 pl->window = window;
898 pl->property = property;
899 pl->desired_state = state;
900 pl->next = property_change_wait_list;
901 pl->arrived = 0;
902 property_change_wait_list = pl;
903 return pl;
906 /* Delete an entry from the list of property changes we are waiting for.
907 IDENTIFIER is the number that uniquely identifies the entry. */
909 static void
910 unexpect_property_change (location)
911 struct prop_location *location;
913 struct prop_location *prev = 0, *rest = property_change_wait_list;
914 while (rest)
916 if (rest == location)
918 if (prev)
919 prev->next = rest->next;
920 else
921 property_change_wait_list = rest->next;
922 free (rest);
923 return;
925 prev = rest;
926 rest = rest->next;
930 /* Remove the property change expectation element for IDENTIFIER. */
932 static Lisp_Object
933 wait_for_property_change_unwind (identifierval)
934 Lisp_Object identifierval;
936 unexpect_property_change ((struct prop_location *)
937 (XFASTINT (XCONS (identifierval)->car) << 16
938 | XFASTINT (XCONS (identifierval)->cdr)));
939 return Qnil;
942 /* Actually wait for a property change.
943 IDENTIFIER should be the value that expect_property_change returned. */
945 static void
946 wait_for_property_change (location)
947 struct prop_location *location;
949 int secs, usecs;
950 int count = specpdl_ptr - specpdl;
951 Lisp_Object tem;
953 tem = Fcons (Qnil, Qnil);
954 XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
955 XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
957 /* Make sure to do unexpect_property_change if we quit or err. */
958 record_unwind_protect (wait_for_property_change_unwind, tem);
960 XCONS (property_change_reply)->car = Qnil;
962 property_change_reply_object = location;
963 /* If the event we are waiting for arrives beyond here, it will set
964 property_change_reply, because property_change_reply_object says so. */
965 if (! location->arrived)
967 secs = x_selection_timeout / 1000;
968 usecs = (x_selection_timeout % 1000) * 1000;
969 wait_reading_process_input (secs, usecs, property_change_reply, 0);
971 if (NILP (XCONS (property_change_reply)->car))
972 error ("Timed out waiting for property-notify event");
975 unbind_to (count, Qnil);
978 /* Called from XTread_socket in response to a PropertyNotify event. */
980 void
981 x_handle_property_notify (event)
982 XPropertyEvent *event;
984 struct prop_location *prev = 0, *rest = property_change_wait_list;
985 while (rest)
987 if (rest->property == event->atom
988 && rest->window == event->window
989 && rest->display == event->display
990 && rest->desired_state == event->state)
992 #if 0
993 fprintf (stderr, "Saw expected prop-%s on %s\n",
994 (event->state == PropertyDelete ? "delete" : "change"),
995 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
996 event->atom))
997 ->name->data);
998 #endif
1000 rest->arrived = 1;
1002 /* If this is the one wait_for_property_change is waiting for,
1003 tell it to wake up. */
1004 if (rest == property_change_reply_object)
1005 XCONS (property_change_reply)->car = Qt;
1007 if (prev)
1008 prev->next = rest->next;
1009 else
1010 property_change_wait_list = rest->next;
1011 free (rest);
1012 return;
1014 prev = rest;
1015 rest = rest->next;
1017 #if 0
1018 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1019 (event->state == PropertyDelete ? "delete" : "change"),
1020 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1021 event->display, event->atom))
1022 ->name->data);
1023 #endif
1028 #if 0 /* #### MULTIPLE doesn't work yet */
1030 static Lisp_Object
1031 fetch_multiple_target (event)
1032 XSelectionRequestEvent *event;
1034 Display *display = event->display;
1035 Window window = event->requestor;
1036 Atom target = event->target;
1037 Atom selection_atom = event->selection;
1038 int result;
1040 return
1041 Fcons (QMULTIPLE,
1042 x_get_window_property_as_lisp_data (display, window, target,
1043 QMULTIPLE, selection_atom));
1046 static Lisp_Object
1047 copy_multiple_data (obj)
1048 Lisp_Object obj;
1050 Lisp_Object vec;
1051 int i;
1052 int size;
1053 if (CONSP (obj))
1054 return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
1056 CHECK_VECTOR (obj, 0);
1057 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1058 for (i = 0; i < size; i++)
1060 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1061 CHECK_VECTOR (vec2, 0);
1062 if (XVECTOR (vec2)->size != 2)
1063 /* ??? Confusing error message */
1064 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1065 Fcons (vec2, Qnil)));
1066 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1067 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1068 = XVECTOR (vec2)->contents [0];
1069 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1070 = XVECTOR (vec2)->contents [1];
1072 return vec;
1075 #endif
1078 /* Variables for communication with x_handle_selection_notify. */
1079 static Atom reading_which_selection;
1080 static Lisp_Object reading_selection_reply;
1081 static Window reading_selection_window;
1083 /* Do protocol to read selection-data from the server.
1084 Converts this to Lisp data and returns it. */
1086 static Lisp_Object
1087 x_get_foreign_selection (selection_symbol, target_type)
1088 Lisp_Object selection_symbol, target_type;
1090 Window requestor_window = FRAME_X_WINDOW (selected_frame);
1091 Display *display = FRAME_X_DISPLAY (selected_frame);
1092 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1093 Time requestor_time = last_event_timestamp;
1094 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1095 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1096 Atom type_atom;
1097 int secs, usecs;
1098 int count = specpdl_ptr - specpdl;
1099 Lisp_Object frame;
1101 if (CONSP (target_type))
1102 type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
1103 else
1104 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1106 BLOCK_INPUT;
1107 x_catch_errors (display);
1108 XConvertSelection (display, selection_atom, type_atom, target_property,
1109 requestor_window, requestor_time);
1110 XFlush (display);
1112 /* Prepare to block until the reply has been read. */
1113 reading_selection_window = requestor_window;
1114 reading_which_selection = selection_atom;
1115 XCONS (reading_selection_reply)->car = Qnil;
1117 frame = some_frame_on_display (dpyinfo);
1119 /* If the display no longer has frames, we can't expect
1120 to get many more selection requests from it, so don't
1121 bother trying to queue them. */
1122 if (!NILP (frame))
1124 x_start_queuing_selection_requests (display);
1126 record_unwind_protect (queue_selection_requests_unwind,
1127 frame);
1129 UNBLOCK_INPUT;
1131 /* This allows quits. Also, don't wait forever. */
1132 secs = x_selection_timeout / 1000;
1133 usecs = (x_selection_timeout % 1000) * 1000;
1134 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1136 BLOCK_INPUT;
1137 x_check_errors (display, "Cannot get selection: %s");
1138 x_uncatch_errors (display);
1139 unbind_to (count, Qnil);
1140 UNBLOCK_INPUT;
1142 if (NILP (XCONS (reading_selection_reply)->car))
1143 error ("Timed out waiting for reply from selection owner");
1144 if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
1145 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
1147 /* Otherwise, the selection is waiting for us on the requested property. */
1148 return
1149 x_get_window_property_as_lisp_data (display, requestor_window,
1150 target_property, target_type,
1151 selection_atom);
1154 /* Subroutines of x_get_window_property_as_lisp_data */
1156 /* Use free, not XFree, to free the data obtained with this function. */
1158 static void
1159 x_get_window_property (display, window, property, data_ret, bytes_ret,
1160 actual_type_ret, actual_format_ret, actual_size_ret,
1161 delete_p)
1162 Display *display;
1163 Window window;
1164 Atom property;
1165 unsigned char **data_ret;
1166 int *bytes_ret;
1167 Atom *actual_type_ret;
1168 int *actual_format_ret;
1169 unsigned long *actual_size_ret;
1170 int delete_p;
1172 int total_size;
1173 unsigned long bytes_remaining;
1174 int offset = 0;
1175 unsigned char *tmp_data = 0;
1176 int result;
1177 int buffer_size = SELECTION_QUANTUM (display);
1178 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1180 BLOCK_INPUT;
1181 /* First probe the thing to find out how big it is. */
1182 result = XGetWindowProperty (display, window, property,
1183 0L, 0L, False, AnyPropertyType,
1184 actual_type_ret, actual_format_ret,
1185 actual_size_ret,
1186 &bytes_remaining, &tmp_data);
1187 if (result != Success)
1189 UNBLOCK_INPUT;
1190 *data_ret = 0;
1191 *bytes_ret = 0;
1192 return;
1194 /* This was allocated by Xlib, so use XFree. */
1195 XFree ((char *) tmp_data);
1197 if (*actual_type_ret == None || *actual_format_ret == 0)
1199 UNBLOCK_INPUT;
1200 return;
1203 total_size = bytes_remaining + 1;
1204 *data_ret = (unsigned char *) xmalloc (total_size);
1206 /* Now read, until we've gotten it all. */
1207 while (bytes_remaining)
1209 #if 0
1210 int last = bytes_remaining;
1211 #endif
1212 result
1213 = XGetWindowProperty (display, window, property,
1214 (long)offset/4, (long)buffer_size/4,
1215 False,
1216 AnyPropertyType,
1217 actual_type_ret, actual_format_ret,
1218 actual_size_ret, &bytes_remaining, &tmp_data);
1219 #if 0
1220 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1221 #endif
1222 /* If this doesn't return Success at this point, it means that
1223 some clod deleted the selection while we were in the midst of
1224 reading it. Deal with that, I guess....
1226 if (result != Success) break;
1227 *actual_size_ret *= *actual_format_ret / 8;
1228 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1229 offset += *actual_size_ret;
1230 /* This was allocated by Xlib, so use XFree. */
1231 XFree ((char *) tmp_data);
1234 XFlush (display);
1235 UNBLOCK_INPUT;
1236 *bytes_ret = offset;
1239 /* Use free, not XFree, to free the data obtained with this function. */
1241 static void
1242 receive_incremental_selection (display, window, property, target_type,
1243 min_size_bytes, data_ret, size_bytes_ret,
1244 type_ret, format_ret, size_ret)
1245 Display *display;
1246 Window window;
1247 Atom property;
1248 Lisp_Object target_type; /* for error messages only */
1249 unsigned int min_size_bytes;
1250 unsigned char **data_ret;
1251 int *size_bytes_ret;
1252 Atom *type_ret;
1253 unsigned long *size_ret;
1254 int *format_ret;
1256 int offset = 0;
1257 struct prop_location *wait_object;
1258 *size_bytes_ret = min_size_bytes;
1259 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1260 #if 0
1261 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1262 #endif
1264 /* At this point, we have read an INCR property.
1265 Delete the property to ack it.
1266 (But first, prepare to receive the next event in this handshake.)
1268 Now, we must loop, waiting for the sending window to put a value on
1269 that property, then reading the property, then deleting it to ack.
1270 We are done when the sender places a property of length 0.
1272 BLOCK_INPUT;
1273 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1274 XDeleteProperty (display, window, property);
1275 wait_object = expect_property_change (display, window, property,
1276 PropertyNewValue);
1277 XFlush (display);
1278 UNBLOCK_INPUT;
1280 while (1)
1282 unsigned char *tmp_data;
1283 int tmp_size_bytes;
1284 wait_for_property_change (wait_object);
1285 /* expect it again immediately, because x_get_window_property may
1286 .. no it won't, I don't get it.
1287 .. Ok, I get it now, the Xt code that implements INCR is broken.
1289 x_get_window_property (display, window, property,
1290 &tmp_data, &tmp_size_bytes,
1291 type_ret, format_ret, size_ret, 1);
1293 if (tmp_size_bytes == 0) /* we're done */
1295 #if 0
1296 fprintf (stderr, " read INCR done\n");
1297 #endif
1298 if (! waiting_for_other_props_on_window (display, window))
1299 XSelectInput (display, window, STANDARD_EVENT_SET);
1300 unexpect_property_change (wait_object);
1301 /* Use free, not XFree, because x_get_window_property
1302 calls xmalloc itself. */
1303 if (tmp_data) free (tmp_data);
1304 break;
1307 BLOCK_INPUT;
1308 XDeleteProperty (display, window, property);
1309 wait_object = expect_property_change (display, window, property,
1310 PropertyNewValue);
1311 XFlush (display);
1312 UNBLOCK_INPUT;
1314 #if 0
1315 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1316 #endif
1317 if (*size_bytes_ret < offset + tmp_size_bytes)
1319 #if 0
1320 fprintf (stderr, " read INCR realloc %d -> %d\n",
1321 *size_bytes_ret, offset + tmp_size_bytes);
1322 #endif
1323 *size_bytes_ret = offset + tmp_size_bytes;
1324 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1326 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1327 offset += tmp_size_bytes;
1328 /* Use free, not XFree, because x_get_window_property
1329 calls xmalloc itself. */
1330 free (tmp_data);
1334 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1335 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1336 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1338 static Lisp_Object
1339 x_get_window_property_as_lisp_data (display, window, property, target_type,
1340 selection_atom)
1341 Display *display;
1342 Window window;
1343 Atom property;
1344 Lisp_Object target_type; /* for error messages only */
1345 Atom selection_atom; /* for error messages only */
1347 Atom actual_type;
1348 int actual_format;
1349 unsigned long actual_size;
1350 unsigned char *data = 0;
1351 int bytes = 0;
1352 Lisp_Object val;
1353 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1355 x_get_window_property (display, window, property, &data, &bytes,
1356 &actual_type, &actual_format, &actual_size, 1);
1357 if (! data)
1359 int there_is_a_selection_owner;
1360 BLOCK_INPUT;
1361 there_is_a_selection_owner
1362 = XGetSelectionOwner (display, selection_atom);
1363 UNBLOCK_INPUT;
1364 while (1) /* Note debugger can no longer return, so this is obsolete */
1365 Fsignal (Qerror,
1366 there_is_a_selection_owner ?
1367 Fcons (build_string ("selection owner couldn't convert"),
1368 actual_type
1369 ? Fcons (target_type,
1370 Fcons (x_atom_to_symbol (dpyinfo, display,
1371 actual_type),
1372 Qnil))
1373 : Fcons (target_type, Qnil))
1374 : Fcons (build_string ("no selection"),
1375 Fcons (x_atom_to_symbol (dpyinfo, display,
1376 selection_atom),
1377 Qnil)));
1380 if (actual_type == dpyinfo->Xatom_INCR)
1382 /* That wasn't really the data, just the beginning. */
1384 unsigned int min_size_bytes = * ((unsigned int *) data);
1385 BLOCK_INPUT;
1386 /* Use free, not XFree, because x_get_window_property
1387 calls xmalloc itself. */
1388 free ((char *) data);
1389 UNBLOCK_INPUT;
1390 receive_incremental_selection (display, window, property, target_type,
1391 min_size_bytes, &data, &bytes,
1392 &actual_type, &actual_format,
1393 &actual_size);
1396 BLOCK_INPUT;
1397 XDeleteProperty (display, window, property);
1398 XFlush (display);
1399 UNBLOCK_INPUT;
1401 /* It's been read. Now convert it to a lisp object in some semi-rational
1402 manner. */
1403 val = selection_data_to_lisp_data (display, data, bytes,
1404 actual_type, actual_format);
1406 /* Use free, not XFree, because x_get_window_property
1407 calls xmalloc itself. */
1408 free ((char *) data);
1409 return val;
1412 /* These functions convert from the selection data read from the server into
1413 something that we can use from Lisp, and vice versa.
1415 Type: Format: Size: Lisp Type:
1416 ----- ------- ----- -----------
1417 * 8 * String
1418 ATOM 32 1 Symbol
1419 ATOM 32 > 1 Vector of Symbols
1420 * 16 1 Integer
1421 * 16 > 1 Vector of Integers
1422 * 32 1 if <=16 bits: Integer
1423 if > 16 bits: Cons of top16, bot16
1424 * 32 > 1 Vector of the above
1426 When converting a Lisp number to C, it is assumed to be of format 16 if
1427 it is an integer, and of format 32 if it is a cons of two integers.
1429 When converting a vector of numbers from Lisp to C, it is assumed to be
1430 of format 16 if every element in the vector is an integer, and is assumed
1431 to be of format 32 if any element is a cons of two integers.
1433 When converting an object to C, it may be of the form (SYMBOL . <data>)
1434 where SYMBOL is what we should claim that the type is. Format and
1435 representation are as above. */
1439 static Lisp_Object
1440 selection_data_to_lisp_data (display, data, size, type, format)
1441 Display *display;
1442 unsigned char *data;
1443 Atom type;
1444 int size, format;
1446 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1448 if (type == dpyinfo->Xatom_NULL)
1449 return QNULL;
1451 /* Convert any 8-bit data to a string, for compactness. */
1452 else if (format == 8)
1453 return make_string ((char *) data, size);
1455 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1456 a vector of symbols.
1458 else if (type == XA_ATOM)
1460 int i;
1461 if (size == sizeof (Atom))
1462 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
1463 else
1465 Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
1466 for (i = 0; i < size / sizeof (Atom); i++)
1467 Faset (v, i, x_atom_to_symbol (dpyinfo, display,
1468 ((Atom *) data) [i]));
1469 return v;
1473 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1474 If the number is > 16 bits, convert it to a cons of integers,
1475 16 bits in each half.
1477 else if (format == 32 && size == sizeof (long))
1478 return long_to_cons (((unsigned long *) data) [0]);
1479 else if (format == 16 && size == sizeof (short))
1480 return make_number ((int) (((unsigned short *) data) [0]));
1482 /* Convert any other kind of data to a vector of numbers, represented
1483 as above (as an integer, or a cons of two 16 bit integers.)
1485 else if (format == 16)
1487 int i;
1488 Lisp_Object v = Fmake_vector (size / 4, 0);
1489 for (i = 0; i < size / 4; i++)
1491 int j = (int) ((unsigned short *) data) [i];
1492 Faset (v, i, make_number (j));
1494 return v;
1496 else
1498 int i;
1499 Lisp_Object v = Fmake_vector (size / 4, 0);
1500 for (i = 0; i < size / 4; i++)
1502 unsigned long j = ((unsigned long *) data) [i];
1503 Faset (v, i, long_to_cons (j));
1505 return v;
1510 /* Use free, not XFree, to free the data obtained with this function. */
1512 static void
1513 lisp_data_to_selection_data (display, obj,
1514 data_ret, type_ret, size_ret,
1515 format_ret, nofree_ret)
1516 Display *display;
1517 Lisp_Object obj;
1518 unsigned char **data_ret;
1519 Atom *type_ret;
1520 unsigned int *size_ret;
1521 int *format_ret;
1522 int *nofree_ret;
1524 Lisp_Object type = Qnil;
1525 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1527 *nofree_ret = 0;
1529 if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
1531 type = XCONS (obj)->car;
1532 obj = XCONS (obj)->cdr;
1533 if (CONSP (obj) && NILP (XCONS (obj)->cdr))
1534 obj = XCONS (obj)->car;
1537 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1538 { /* This is not the same as declining */
1539 *format_ret = 32;
1540 *size_ret = 0;
1541 *data_ret = 0;
1542 type = QNULL;
1544 else if (STRINGP (obj))
1546 *format_ret = 8;
1547 *size_ret = XSTRING (obj)->size;
1548 *data_ret = XSTRING (obj)->data;
1549 *nofree_ret = 1;
1550 if (NILP (type)) type = QSTRING;
1552 else if (SYMBOLP (obj))
1554 *format_ret = 32;
1555 *size_ret = 1;
1556 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1557 (*data_ret) [sizeof (Atom)] = 0;
1558 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1559 if (NILP (type)) type = QATOM;
1561 else if (INTEGERP (obj)
1562 && XINT (obj) < 0xFFFF
1563 && XINT (obj) > -0xFFFF)
1565 *format_ret = 16;
1566 *size_ret = 1;
1567 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1568 (*data_ret) [sizeof (short)] = 0;
1569 (*(short **) data_ret) [0] = (short) XINT (obj);
1570 if (NILP (type)) type = QINTEGER;
1572 else if (INTEGERP (obj)
1573 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
1574 && (INTEGERP (XCONS (obj)->cdr)
1575 || (CONSP (XCONS (obj)->cdr)
1576 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
1578 *format_ret = 32;
1579 *size_ret = 1;
1580 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1581 (*data_ret) [sizeof (long)] = 0;
1582 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1583 if (NILP (type)) type = QINTEGER;
1585 else if (VECTORP (obj))
1587 /* Lisp_Vectors may represent a set of ATOMs;
1588 a set of 16 or 32 bit INTEGERs;
1589 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1591 int i;
1593 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1594 /* This vector is an ATOM set */
1596 if (NILP (type)) type = QATOM;
1597 *size_ret = XVECTOR (obj)->size;
1598 *format_ret = 32;
1599 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1600 for (i = 0; i < *size_ret; i++)
1601 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1602 (*(Atom **) data_ret) [i]
1603 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1604 else
1605 Fsignal (Qerror, /* Qselection_error */
1606 Fcons (build_string
1607 ("all elements of selection vector must have same type"),
1608 Fcons (obj, Qnil)));
1610 #if 0 /* #### MULTIPLE doesn't work yet */
1611 else if (VECTORP (XVECTOR (obj)->contents [0]))
1612 /* This vector is an ATOM_PAIR set */
1614 if (NILP (type)) type = QATOM_PAIR;
1615 *size_ret = XVECTOR (obj)->size;
1616 *format_ret = 32;
1617 *data_ret = (unsigned char *)
1618 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1619 for (i = 0; i < *size_ret; i++)
1620 if (VECTORP (XVECTOR (obj)->contents [i]))
1622 Lisp_Object pair = XVECTOR (obj)->contents [i];
1623 if (XVECTOR (pair)->size != 2)
1624 Fsignal (Qerror,
1625 Fcons (build_string
1626 ("elements of the vector must be vectors of exactly two elements"),
1627 Fcons (pair, Qnil)));
1629 (*(Atom **) data_ret) [i * 2]
1630 = symbol_to_x_atom (dpyinfo, display,
1631 XVECTOR (pair)->contents [0]);
1632 (*(Atom **) data_ret) [(i * 2) + 1]
1633 = symbol_to_x_atom (dpyinfo, display,
1634 XVECTOR (pair)->contents [1]);
1636 else
1637 Fsignal (Qerror,
1638 Fcons (build_string
1639 ("all elements of the vector must be of the same type"),
1640 Fcons (obj, Qnil)));
1643 #endif
1644 else
1645 /* This vector is an INTEGER set, or something like it */
1647 *size_ret = XVECTOR (obj)->size;
1648 if (NILP (type)) type = QINTEGER;
1649 *format_ret = 16;
1650 for (i = 0; i < *size_ret; i++)
1651 if (CONSP (XVECTOR (obj)->contents [i]))
1652 *format_ret = 32;
1653 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1654 Fsignal (Qerror, /* Qselection_error */
1655 Fcons (build_string
1656 ("elements of selection vector must be integers or conses of integers"),
1657 Fcons (obj, Qnil)));
1659 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1660 for (i = 0; i < *size_ret; i++)
1661 if (*format_ret == 32)
1662 (*((unsigned long **) data_ret)) [i]
1663 = cons_to_long (XVECTOR (obj)->contents [i]);
1664 else
1665 (*((unsigned short **) data_ret)) [i]
1666 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1669 else
1670 Fsignal (Qerror, /* Qselection_error */
1671 Fcons (build_string ("unrecognised selection data"),
1672 Fcons (obj, Qnil)));
1674 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1677 static Lisp_Object
1678 clean_local_selection_data (obj)
1679 Lisp_Object obj;
1681 if (CONSP (obj)
1682 && INTEGERP (XCONS (obj)->car)
1683 && CONSP (XCONS (obj)->cdr)
1684 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
1685 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
1686 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
1688 if (CONSP (obj)
1689 && INTEGERP (XCONS (obj)->car)
1690 && INTEGERP (XCONS (obj)->cdr))
1692 if (XINT (XCONS (obj)->car) == 0)
1693 return XCONS (obj)->cdr;
1694 if (XINT (XCONS (obj)->car) == -1)
1695 return make_number (- XINT (XCONS (obj)->cdr));
1697 if (VECTORP (obj))
1699 int i;
1700 int size = XVECTOR (obj)->size;
1701 Lisp_Object copy;
1702 if (size == 1)
1703 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1704 copy = Fmake_vector (size, Qnil);
1705 for (i = 0; i < size; i++)
1706 XVECTOR (copy)->contents [i]
1707 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1708 return copy;
1710 return obj;
1713 /* Called from XTread_socket to handle SelectionNotify events.
1714 If it's the selection we are waiting for, stop waiting
1715 by setting the car of reading_selection_reply to non-nil.
1716 We store t there if the reply is successful, lambda if not. */
1718 void
1719 x_handle_selection_notify (event)
1720 XSelectionEvent *event;
1722 if (event->requestor != reading_selection_window)
1723 return;
1724 if (event->selection != reading_which_selection)
1725 return;
1727 XCONS (reading_selection_reply)->car
1728 = (event->property != 0 ? Qt : Qlambda);
1732 DEFUN ("x-own-selection-internal",
1733 Fx_own_selection_internal, Sx_own_selection_internal,
1734 2, 2, 0,
1735 "Assert an X selection of the given TYPE with the given VALUE.\n\
1736 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1737 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1738 VALUE is typically a string, or a cons of two markers, but may be\n\
1739 anything that the functions on `selection-converter-alist' know about.")
1740 (selection_name, selection_value)
1741 Lisp_Object selection_name, selection_value;
1743 check_x ();
1744 CHECK_SYMBOL (selection_name, 0);
1745 if (NILP (selection_value)) error ("selection-value may not be nil");
1746 x_own_selection (selection_name, selection_value);
1747 return selection_value;
1751 /* Request the selection value from the owner. If we are the owner,
1752 simply return our selection value. If we are not the owner, this
1753 will block until all of the data has arrived. */
1755 DEFUN ("x-get-selection-internal",
1756 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
1757 "Return text selected from some X window.\n\
1758 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1759 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1760 TYPE is the type of data desired, typically `STRING'.")
1761 (selection_symbol, target_type)
1762 Lisp_Object selection_symbol, target_type;
1764 Lisp_Object val = Qnil;
1765 struct gcpro gcpro1, gcpro2;
1766 GCPRO2 (target_type, val); /* we store newly consed data into these */
1767 check_x ();
1768 CHECK_SYMBOL (selection_symbol, 0);
1770 #if 0 /* #### MULTIPLE doesn't work yet */
1771 if (CONSP (target_type)
1772 && XCONS (target_type)->car == QMULTIPLE)
1774 CHECK_VECTOR (XCONS (target_type)->cdr, 0);
1775 /* So we don't destructively modify this... */
1776 target_type = copy_multiple_data (target_type);
1778 else
1779 #endif
1780 CHECK_SYMBOL (target_type, 0);
1782 val = x_get_local_selection (selection_symbol, target_type);
1784 if (NILP (val))
1786 val = x_get_foreign_selection (selection_symbol, target_type);
1787 goto DONE;
1790 if (CONSP (val)
1791 && SYMBOLP (XCONS (val)->car))
1793 val = XCONS (val)->cdr;
1794 if (CONSP (val) && NILP (XCONS (val)->cdr))
1795 val = XCONS (val)->car;
1797 val = clean_local_selection_data (val);
1798 DONE:
1799 UNGCPRO;
1800 return val;
1803 DEFUN ("x-disown-selection-internal",
1804 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
1805 "If we own the selection SELECTION, disown it.\n\
1806 Disowning it means there is no such selection.")
1807 (selection, time)
1808 Lisp_Object selection;
1809 Lisp_Object time;
1811 Time timestamp;
1812 Atom selection_atom;
1813 XSelectionClearEvent event;
1814 Display *display;
1815 struct x_display_info *dpyinfo;
1817 check_x ();
1818 display = FRAME_X_DISPLAY (selected_frame);
1819 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1820 CHECK_SYMBOL (selection, 0);
1821 if (NILP (time))
1822 timestamp = last_event_timestamp;
1823 else
1824 timestamp = cons_to_long (time);
1826 if (NILP (assq_no_quit (selection, Vselection_alist)))
1827 return Qnil; /* Don't disown the selection when we're not the owner. */
1829 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
1831 BLOCK_INPUT;
1832 XSetSelectionOwner (display, selection_atom, None, timestamp);
1833 UNBLOCK_INPUT;
1835 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1836 generated for a window which owns the selection when that window sets
1837 the selection owner to None. The NCD server does, the MIT Sun4 server
1838 doesn't. So we synthesize one; this means we might get two, but
1839 that's ok, because the second one won't have any effect. */
1840 SELECTION_EVENT_DISPLAY (&event) = display;
1841 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1842 SELECTION_EVENT_TIME (&event) = timestamp;
1843 x_handle_selection_clear (&event);
1845 return Qt;
1848 /* Get rid of all the selections in buffer BUFFER.
1849 This is used when we kill a buffer. */
1851 void
1852 x_disown_buffer_selections (buffer)
1853 Lisp_Object buffer;
1855 Lisp_Object tail;
1856 struct buffer *buf = XBUFFER (buffer);
1858 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1860 Lisp_Object elt, value;
1861 elt = XCONS (tail)->car;
1862 value = XCONS (elt)->cdr;
1863 if (CONSP (value) && MARKERP (XCONS (value)->car)
1864 && XMARKER (XCONS (value)->car)->buffer == buf)
1865 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
1869 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1870 0, 1, 0,
1871 "Whether the current Emacs process owns the given X Selection.\n\
1872 The arg should be the name of the selection in question, typically one of\n\
1873 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1874 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1875 For convenience, the symbol nil is the same as `PRIMARY',\n\
1876 and t is the same as `SECONDARY'.)")
1877 (selection)
1878 Lisp_Object selection;
1880 check_x ();
1881 CHECK_SYMBOL (selection, 0);
1882 if (EQ (selection, Qnil)) selection = QPRIMARY;
1883 if (EQ (selection, Qt)) selection = QSECONDARY;
1885 if (NILP (Fassq (selection, Vselection_alist)))
1886 return Qnil;
1887 return Qt;
1890 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
1891 0, 1, 0,
1892 "Whether there is an owner for the given X Selection.\n\
1893 The arg should be the name of the selection in question, typically one of\n\
1894 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1895 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1896 For convenience, the symbol nil is the same as `PRIMARY',\n\
1897 and t is the same as `SECONDARY'.)")
1898 (selection)
1899 Lisp_Object selection;
1901 Window owner;
1902 Atom atom;
1903 Display *dpy;
1905 /* It should be safe to call this before we have an X frame. */
1906 if (! FRAME_X_P (selected_frame))
1907 return Qnil;
1909 dpy = FRAME_X_DISPLAY (selected_frame);
1910 CHECK_SYMBOL (selection, 0);
1911 if (!NILP (Fx_selection_owner_p (selection)))
1912 return Qt;
1913 if (EQ (selection, Qnil)) selection = QPRIMARY;
1914 if (EQ (selection, Qt)) selection = QSECONDARY;
1915 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
1916 dpy, selection);
1917 if (atom == 0)
1918 return Qnil;
1919 BLOCK_INPUT;
1920 owner = XGetSelectionOwner (dpy, atom);
1921 UNBLOCK_INPUT;
1922 return (owner ? Qt : Qnil);
1926 #ifdef CUT_BUFFER_SUPPORT
1928 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1929 static void
1930 initialize_cut_buffers (display, window)
1931 Display *display;
1932 Window window;
1934 unsigned char *data = (unsigned char *) "";
1935 BLOCK_INPUT;
1936 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1937 PropModeAppend, data, 0)
1938 FROB (XA_CUT_BUFFER0);
1939 FROB (XA_CUT_BUFFER1);
1940 FROB (XA_CUT_BUFFER2);
1941 FROB (XA_CUT_BUFFER3);
1942 FROB (XA_CUT_BUFFER4);
1943 FROB (XA_CUT_BUFFER5);
1944 FROB (XA_CUT_BUFFER6);
1945 FROB (XA_CUT_BUFFER7);
1946 #undef FROB
1947 UNBLOCK_INPUT;
1951 #define CHECK_CUT_BUFFER(symbol,n) \
1952 { CHECK_SYMBOL ((symbol), (n)); \
1953 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1954 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1955 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1956 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1957 Fsignal (Qerror, \
1958 Fcons (build_string ("doesn't name a cut buffer"), \
1959 Fcons ((symbol), Qnil))); \
1962 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
1963 Sx_get_cut_buffer_internal, 1, 1, 0,
1964 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
1965 (buffer)
1966 Lisp_Object buffer;
1968 Window window;
1969 Atom buffer_atom;
1970 unsigned char *data;
1971 int bytes;
1972 Atom type;
1973 int format;
1974 unsigned long size;
1975 Lisp_Object ret;
1976 Display *display;
1977 struct x_display_info *dpyinfo;
1979 check_x ();
1980 display = FRAME_X_DISPLAY (selected_frame);
1981 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1982 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
1983 CHECK_CUT_BUFFER (buffer, 0);
1984 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
1986 x_get_window_property (display, window, buffer_atom, &data, &bytes,
1987 &type, &format, &size, 0);
1988 if (!data) return Qnil;
1990 if (format != 8 || type != XA_STRING)
1991 Fsignal (Qerror,
1992 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
1993 Fcons (x_atom_to_symbol (dpyinfo, display, type),
1994 Fcons (make_number (format), Qnil))));
1996 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
1997 /* Use free, not XFree, because x_get_window_property
1998 calls xmalloc itself. */
1999 free (data);
2000 return ret;
2004 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2005 Sx_store_cut_buffer_internal, 2, 2, 0,
2006 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2007 (buffer, string)
2008 Lisp_Object buffer, string;
2010 Window window;
2011 Atom buffer_atom;
2012 unsigned char *data;
2013 int bytes;
2014 int bytes_remaining;
2015 int max_bytes;
2016 Display *display;
2018 check_x ();
2019 display = FRAME_X_DISPLAY (selected_frame);
2020 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2022 max_bytes = SELECTION_QUANTUM (display);
2023 if (max_bytes > MAX_SELECTION_QUANTUM)
2024 max_bytes = MAX_SELECTION_QUANTUM;
2026 CHECK_CUT_BUFFER (buffer, 0);
2027 CHECK_STRING (string, 0);
2028 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
2029 display, buffer);
2030 data = (unsigned char *) XSTRING (string)->data;
2031 bytes = XSTRING (string)->size;
2032 bytes_remaining = bytes;
2034 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2036 initialize_cut_buffers (display, window);
2037 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2040 BLOCK_INPUT;
2042 /* Don't mess up with an empty value. */
2043 if (!bytes_remaining)
2044 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2045 PropModeReplace, data, 0);
2047 while (bytes_remaining)
2049 int chunk = (bytes_remaining < max_bytes
2050 ? bytes_remaining : max_bytes);
2051 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2052 (bytes_remaining == bytes
2053 ? PropModeReplace
2054 : PropModeAppend),
2055 data, chunk);
2056 data += chunk;
2057 bytes_remaining -= chunk;
2059 UNBLOCK_INPUT;
2060 return string;
2064 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2065 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2066 "Rotate the values of the cut buffers by the given number of steps;\n\
2067 positive means move values forward, negative means backward.")
2069 Lisp_Object n;
2071 Window window;
2072 Atom props[8];
2073 Display *display;
2075 check_x ();
2076 display = FRAME_X_DISPLAY (selected_frame);
2077 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2078 CHECK_NUMBER (n, 0);
2079 if (XINT (n) == 0)
2080 return n;
2081 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2083 initialize_cut_buffers (display, window);
2084 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2087 props[0] = XA_CUT_BUFFER0;
2088 props[1] = XA_CUT_BUFFER1;
2089 props[2] = XA_CUT_BUFFER2;
2090 props[3] = XA_CUT_BUFFER3;
2091 props[4] = XA_CUT_BUFFER4;
2092 props[5] = XA_CUT_BUFFER5;
2093 props[6] = XA_CUT_BUFFER6;
2094 props[7] = XA_CUT_BUFFER7;
2095 BLOCK_INPUT;
2096 XRotateWindowProperties (display, window, props, 8, XINT (n));
2097 UNBLOCK_INPUT;
2098 return n;
2101 #endif
2103 void
2104 syms_of_xselect ()
2106 defsubr (&Sx_get_selection_internal);
2107 defsubr (&Sx_own_selection_internal);
2108 defsubr (&Sx_disown_selection_internal);
2109 defsubr (&Sx_selection_owner_p);
2110 defsubr (&Sx_selection_exists_p);
2112 #ifdef CUT_BUFFER_SUPPORT
2113 defsubr (&Sx_get_cut_buffer_internal);
2114 defsubr (&Sx_store_cut_buffer_internal);
2115 defsubr (&Sx_rotate_cut_buffers_internal);
2116 #endif
2118 reading_selection_reply = Fcons (Qnil, Qnil);
2119 staticpro (&reading_selection_reply);
2120 reading_selection_window = 0;
2121 reading_which_selection = 0;
2123 property_change_wait_list = 0;
2124 prop_location_identifier = 0;
2125 property_change_reply = Fcons (Qnil, Qnil);
2126 staticpro (&property_change_reply);
2128 Vselection_alist = Qnil;
2129 staticpro (&Vselection_alist);
2131 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2132 "An alist associating X Windows selection-types with functions.\n\
2133 These functions are called to convert the selection, with three args:\n\
2134 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2135 a desired type to which the selection should be converted;\n\
2136 and the local selection value (whatever was given to `x-own-selection').\n\
2138 The function should return the value to send to the X server\n\
2139 \(typically a string). A return value of nil\n\
2140 means that the conversion could not be done.\n\
2141 A return value which is the symbol `NULL'\n\
2142 means that a side-effect was executed,\n\
2143 and there is no meaningful selection value.");
2144 Vselection_converter_alist = Qnil;
2146 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2147 "A list of functions to be called when Emacs loses an X selection.\n\
2148 \(This happens when some other X client makes its own selection\n\
2149 or when a Lisp program explicitly clears the selection.)\n\
2150 The functions are called with one argument, the selection type\n\
2151 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2152 Vx_lost_selection_hooks = Qnil;
2154 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2155 "A list of functions to be called when Emacs answers a selection request.\n\
2156 The functions are called with four arguments:\n\
2157 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2158 - the selection-type which Emacs was asked to convert the\n\
2159 selection into before sending (for example, `STRING' or `LENGTH');\n\
2160 - a flag indicating success or failure for responding to the request.\n\
2161 We might have failed (and declined the request) for any number of reasons,\n\
2162 including being asked for a selection that we no longer own, or being asked\n\
2163 to convert into a type that we don't know about or that is inappropriate.\n\
2164 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2165 it merely informs you that they have happened.");
2166 Vx_sent_selection_hooks = Qnil;
2168 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2169 "Number of milliseconds to wait for a selection reply.\n\
2170 If the selection owner doesn't reply in this time, we give up.\n\
2171 A value of 0 means wait as long as necessary. This is initialized from the\n\
2172 \"*selectionTimeout\" resource.");
2173 x_selection_timeout = 0;
2175 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2176 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2177 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2178 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2179 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2180 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2181 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2182 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2183 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2184 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2185 QINCR = intern ("INCR"); staticpro (&QINCR);
2186 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2187 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2188 QATOM = intern ("ATOM"); staticpro (&QATOM);
2189 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2190 QNULL = intern ("NULL"); staticpro (&QNULL);
2192 #ifdef CUT_BUFFER_SUPPORT
2193 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2194 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2195 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2196 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2197 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2198 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2199 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2200 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2201 #endif