(texinfo-block-default): New var.
[emacs.git] / src / xselect.c
blob289d01e03b93e039139773aa3c7e39e71fdf572d
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997 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"
30 #include "buffer.h"
31 #include "charset.h"
32 #include "coding.h"
33 #include "process.h"
34 #include "composite.h"
36 #define CUT_BUFFER_SUPPORT
38 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
39 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
40 QATOM_PAIR;
42 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
44 #ifdef CUT_BUFFER_SUPPORT
45 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
46 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
47 #endif
49 static Lisp_Object Vx_lost_selection_hooks;
50 static Lisp_Object Vx_sent_selection_hooks;
51 /* Coding system for communicating with other X clients via cutbuffer,
52 selection, and clipboard. */
53 static Lisp_Object Vselection_coding_system;
55 /* Coding system for the next communicating with other X clients. */
56 static Lisp_Object Vnext_selection_coding_system;
58 /* If this is a smaller number than the max-request-size of the display,
59 emacs will use INCR selection transfer when the selection is larger
60 than this. The max-request-size is usually around 64k, so if you want
61 emacs to use incremental selection transfers when the selection is
62 smaller than that, set this. I added this mostly for debugging the
63 incremental transfer stuff, but it might improve server performance. */
64 #define MAX_SELECTION_QUANTUM 0xFFFFFF
66 #ifdef HAVE_X11R4
67 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
68 #else
69 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
70 #endif
72 /* The timestamp of the last input event Emacs received from the X server. */
73 /* Defined in keyboard.c. */
74 extern unsigned long last_event_timestamp;
76 /* This is an association list whose elements are of the form
77 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
78 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
79 SELECTION-VALUE is the value that emacs owns for that selection.
80 It may be any kind of Lisp object.
81 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
82 as a cons of two 16-bit numbers (making a 32 bit time.)
83 FRAME is the frame for which we made the selection.
84 If there is an entry in this alist, then it can be assumed that Emacs owns
85 that selection.
86 The only (eq) parts of this list that are visible from Lisp are the
87 selection-values. */
88 static Lisp_Object Vselection_alist;
90 /* This is an alist whose CARs are selection-types (whose names are the same
91 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
92 call to convert the given Emacs selection value to a string representing
93 the given selection type. This is for Lisp-level extension of the emacs
94 selection handling. */
95 static Lisp_Object Vselection_converter_alist;
97 /* If the selection owner takes too long to reply to a selection request,
98 we give up on it. This is in milliseconds (0 = no timeout.) */
99 static int x_selection_timeout;
101 /* Utility functions */
103 static void lisp_data_to_selection_data ();
104 static Lisp_Object selection_data_to_lisp_data ();
105 static Lisp_Object x_get_window_property_as_lisp_data ();
107 /* This converts a Lisp symbol to a server Atom, avoiding a server
108 roundtrip whenever possible. */
110 static Atom
111 symbol_to_x_atom (dpyinfo, display, sym)
112 struct x_display_info *dpyinfo;
113 Display *display;
114 Lisp_Object sym;
116 Atom val;
117 if (NILP (sym)) return 0;
118 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
119 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
120 if (EQ (sym, QSTRING)) return XA_STRING;
121 if (EQ (sym, QINTEGER)) return XA_INTEGER;
122 if (EQ (sym, QATOM)) return XA_ATOM;
123 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
124 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
125 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
126 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
127 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
128 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
129 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
130 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
131 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
132 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
133 #ifdef CUT_BUFFER_SUPPORT
134 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
135 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
136 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
137 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
138 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
139 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
140 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
141 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
142 #endif
143 if (!SYMBOLP (sym)) abort ();
145 #if 0
146 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
147 #endif
148 BLOCK_INPUT;
149 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
150 UNBLOCK_INPUT;
151 return val;
155 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
156 and calls to intern whenever possible. */
158 static Lisp_Object
159 x_atom_to_symbol (dpyinfo, display, atom)
160 struct x_display_info *dpyinfo;
161 Display *display;
162 Atom atom;
164 char *str;
165 Lisp_Object val;
166 if (! atom) return Qnil;
167 switch (atom)
169 case XA_PRIMARY:
170 return QPRIMARY;
171 case XA_SECONDARY:
172 return QSECONDARY;
173 case XA_STRING:
174 return QSTRING;
175 case XA_INTEGER:
176 return QINTEGER;
177 case XA_ATOM:
178 return QATOM;
179 #ifdef CUT_BUFFER_SUPPORT
180 case XA_CUT_BUFFER0:
181 return QCUT_BUFFER0;
182 case XA_CUT_BUFFER1:
183 return QCUT_BUFFER1;
184 case XA_CUT_BUFFER2:
185 return QCUT_BUFFER2;
186 case XA_CUT_BUFFER3:
187 return QCUT_BUFFER3;
188 case XA_CUT_BUFFER4:
189 return QCUT_BUFFER4;
190 case XA_CUT_BUFFER5:
191 return QCUT_BUFFER5;
192 case XA_CUT_BUFFER6:
193 return QCUT_BUFFER6;
194 case XA_CUT_BUFFER7:
195 return QCUT_BUFFER7;
196 #endif
199 if (atom == dpyinfo->Xatom_CLIPBOARD)
200 return QCLIPBOARD;
201 if (atom == dpyinfo->Xatom_TIMESTAMP)
202 return QTIMESTAMP;
203 if (atom == dpyinfo->Xatom_TEXT)
204 return QTEXT;
205 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
206 return QCOMPOUND_TEXT;
207 if (atom == dpyinfo->Xatom_DELETE)
208 return QDELETE;
209 if (atom == dpyinfo->Xatom_MULTIPLE)
210 return QMULTIPLE;
211 if (atom == dpyinfo->Xatom_INCR)
212 return QINCR;
213 if (atom == dpyinfo->Xatom_EMACS_TMP)
214 return QEMACS_TMP;
215 if (atom == dpyinfo->Xatom_TARGETS)
216 return QTARGETS;
217 if (atom == dpyinfo->Xatom_NULL)
218 return QNULL;
220 BLOCK_INPUT;
221 str = XGetAtomName (display, atom);
222 UNBLOCK_INPUT;
223 #if 0
224 fprintf (stderr, " XGetAtomName --> %s\n", str);
225 #endif
226 if (! str) return Qnil;
227 val = intern (str);
228 BLOCK_INPUT;
229 /* This was allocated by Xlib, so use XFree. */
230 XFree (str);
231 UNBLOCK_INPUT;
232 return val;
235 /* Do protocol to assert ourself as a selection owner.
236 Update the Vselection_alist so that we can reply to later requests for
237 our selection. */
239 static void
240 x_own_selection (selection_name, selection_value)
241 Lisp_Object selection_name, selection_value;
243 struct frame *sf = SELECTED_FRAME ();
244 Window selecting_window = FRAME_X_WINDOW (sf);
245 Display *display = FRAME_X_DISPLAY (sf);
246 Time time = last_event_timestamp;
247 Atom selection_atom;
248 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
249 int count;
251 CHECK_SYMBOL (selection_name, 0);
252 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
254 BLOCK_INPUT;
255 count = x_catch_errors (display);
256 XSetSelectionOwner (display, selection_atom, selecting_window, time);
257 x_check_errors (display, "Can't set selection: %s");
258 x_uncatch_errors (display, count);
259 UNBLOCK_INPUT;
261 /* Now update the local cache */
263 Lisp_Object selection_time;
264 Lisp_Object selection_data;
265 Lisp_Object prev_value;
267 selection_time = long_to_cons ((unsigned long) time);
268 selection_data = Fcons (selection_name,
269 Fcons (selection_value,
270 Fcons (selection_time,
271 Fcons (selected_frame, Qnil))));
272 prev_value = assq_no_quit (selection_name, Vselection_alist);
274 Vselection_alist = Fcons (selection_data, Vselection_alist);
276 /* If we already owned the selection, remove the old selection data.
277 Perhaps we should destructively modify it instead.
278 Don't use Fdelq as that may QUIT. */
279 if (!NILP (prev_value))
281 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
282 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
283 if (EQ (prev_value, Fcar (XCDR (rest))))
285 XCDR (rest) = Fcdr (XCDR (rest));
286 break;
292 /* Given a selection-name and desired type, look up our local copy of
293 the selection value and convert it to the type.
294 The value is nil or a string.
295 This function is used both for remote requests
296 and for local x-get-selection-internal.
298 This calls random Lisp code, and may signal or gc. */
300 static Lisp_Object
301 x_get_local_selection (selection_symbol, target_type)
302 Lisp_Object selection_symbol, target_type;
304 Lisp_Object local_value;
305 Lisp_Object handler_fn, value, type, check;
306 int count;
308 local_value = assq_no_quit (selection_symbol, Vselection_alist);
310 if (NILP (local_value)) return Qnil;
312 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
313 if (EQ (target_type, QTIMESTAMP))
315 handler_fn = Qnil;
316 value = XCAR (XCDR (XCDR (local_value)));
318 #if 0
319 else if (EQ (target_type, QDELETE))
321 handler_fn = Qnil;
322 Fx_disown_selection_internal
323 (selection_symbol,
324 XCAR (XCDR (XCDR (local_value))));
325 value = QNULL;
327 #endif
329 #if 0 /* #### MULTIPLE doesn't work yet */
330 else if (CONSP (target_type)
331 && XCAR (target_type) == QMULTIPLE)
333 Lisp_Object pairs;
334 int size;
335 int i;
336 pairs = XCDR (target_type);
337 size = XVECTOR (pairs)->size;
338 /* If the target is MULTIPLE, then target_type looks like
339 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
340 We modify the second element of each pair in the vector and
341 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
343 for (i = 0; i < size; i++)
345 Lisp_Object pair;
346 pair = XVECTOR (pairs)->contents [i];
347 XVECTOR (pair)->contents [1]
348 = x_get_local_selection (XVECTOR (pair)->contents [0],
349 XVECTOR (pair)->contents [1]);
351 return pairs;
353 #endif
354 else
356 /* Don't allow a quit within the converter.
357 When the user types C-g, he would be surprised
358 if by luck it came during a converter. */
359 count = specpdl_ptr - specpdl;
360 specbind (Qinhibit_quit, Qt);
362 CHECK_SYMBOL (target_type, 0);
363 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
364 if (!NILP (handler_fn))
365 value = call3 (handler_fn,
366 selection_symbol, target_type,
367 XCAR (XCDR (local_value)));
368 else
369 value = Qnil;
370 unbind_to (count, Qnil);
373 /* Make sure this value is of a type that we could transmit
374 to another X client. */
376 check = value;
377 if (CONSP (value)
378 && SYMBOLP (XCAR (value)))
379 type = XCAR (value),
380 check = XCDR (value);
382 if (STRINGP (check)
383 || VECTORP (check)
384 || SYMBOLP (check)
385 || INTEGERP (check)
386 || NILP (value))
387 return value;
388 /* Check for a value that cons_to_long could handle. */
389 else if (CONSP (check)
390 && INTEGERP (XCAR (check))
391 && (INTEGERP (XCDR (check))
393 (CONSP (XCDR (check))
394 && INTEGERP (XCAR (XCDR (check)))
395 && NILP (XCDR (XCDR (check))))))
396 return value;
397 else
398 return
399 Fsignal (Qerror,
400 Fcons (build_string ("invalid data returned by selection-conversion function"),
401 Fcons (handler_fn, Fcons (value, Qnil))));
404 /* Subroutines of x_reply_selection_request. */
406 /* Send a SelectionNotify event to the requestor with property=None,
407 meaning we were unable to do what they wanted. */
409 static void
410 x_decline_selection_request (event)
411 struct input_event *event;
413 XSelectionEvent reply;
414 reply.type = SelectionNotify;
415 reply.display = SELECTION_EVENT_DISPLAY (event);
416 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
417 reply.selection = SELECTION_EVENT_SELECTION (event);
418 reply.time = SELECTION_EVENT_TIME (event);
419 reply.target = SELECTION_EVENT_TARGET (event);
420 reply.property = None;
422 BLOCK_INPUT;
423 XSendEvent (reply.display, reply.requestor, False, 0L,
424 (XEvent *) &reply);
425 XFlush (reply.display);
426 UNBLOCK_INPUT;
429 /* This is the selection request currently being processed.
430 It is set to zero when the request is fully processed. */
431 static struct input_event *x_selection_current_request;
433 /* Used as an unwind-protect clause so that, if a selection-converter signals
434 an error, we tell the requester that we were unable to do what they wanted
435 before we throw to top-level or go into the debugger or whatever. */
437 static Lisp_Object
438 x_selection_request_lisp_error (ignore)
439 Lisp_Object ignore;
441 if (x_selection_current_request != 0)
442 x_decline_selection_request (x_selection_current_request);
443 return Qnil;
447 /* This stuff is so that INCR selections are reentrant (that is, so we can
448 be servicing multiple INCR selection requests simultaneously.) I haven't
449 actually tested that yet. */
451 /* Keep a list of the property changes that are awaited. */
453 struct prop_location
455 int identifier;
456 Display *display;
457 Window window;
458 Atom property;
459 int desired_state;
460 int arrived;
461 struct prop_location *next;
464 static struct prop_location *expect_property_change ();
465 static void wait_for_property_change ();
466 static void unexpect_property_change ();
467 static int waiting_for_other_props_on_window ();
469 static int prop_location_identifier;
471 static Lisp_Object property_change_reply;
473 static struct prop_location *property_change_reply_object;
475 static struct prop_location *property_change_wait_list;
477 static Lisp_Object
478 queue_selection_requests_unwind (frame)
479 Lisp_Object frame;
481 FRAME_PTR f = XFRAME (frame);
483 if (! NILP (frame))
484 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
485 return Qnil;
488 /* Return some frame whose display info is DPYINFO.
489 Return nil if there is none. */
491 static Lisp_Object
492 some_frame_on_display (dpyinfo)
493 struct x_display_info *dpyinfo;
495 Lisp_Object list, frame;
497 FOR_EACH_FRAME (list, frame)
499 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
500 return frame;
503 return Qnil;
506 /* Send the reply to a selection request event EVENT.
507 TYPE is the type of selection data requested.
508 DATA and SIZE describe the data to send, already converted.
509 FORMAT is the unit-size (in bits) of the data to be transmitted. */
511 static void
512 x_reply_selection_request (event, format, data, size, type)
513 struct input_event *event;
514 int format, size;
515 unsigned char *data;
516 Atom type;
518 XSelectionEvent reply;
519 Display *display = SELECTION_EVENT_DISPLAY (event);
520 Window window = SELECTION_EVENT_REQUESTOR (event);
521 int bytes_remaining;
522 int format_bytes = format/8;
523 int max_bytes = SELECTION_QUANTUM (display);
524 struct x_display_info *dpyinfo = x_display_info_for_display (display);
525 int count;
527 if (max_bytes > MAX_SELECTION_QUANTUM)
528 max_bytes = MAX_SELECTION_QUANTUM;
530 reply.type = SelectionNotify;
531 reply.display = display;
532 reply.requestor = window;
533 reply.selection = SELECTION_EVENT_SELECTION (event);
534 reply.time = SELECTION_EVENT_TIME (event);
535 reply.target = SELECTION_EVENT_TARGET (event);
536 reply.property = SELECTION_EVENT_PROPERTY (event);
537 if (reply.property == None)
538 reply.property = reply.target;
540 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
541 BLOCK_INPUT;
542 count = x_catch_errors (display);
544 /* Store the data on the requested property.
545 If the selection is large, only store the first N bytes of it.
547 bytes_remaining = size * format_bytes;
548 if (bytes_remaining <= max_bytes)
550 /* Send all the data at once, with minimal handshaking. */
551 #if 0
552 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
553 #endif
554 XChangeProperty (display, window, reply.property, type, format,
555 PropModeReplace, data, size);
556 /* At this point, the selection was successfully stored; ack it. */
557 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
559 else
561 /* Send an INCR selection. */
562 struct prop_location *wait_object;
563 int had_errors;
564 Lisp_Object frame;
566 frame = some_frame_on_display (dpyinfo);
568 /* If the display no longer has frames, we can't expect
569 to get many more selection requests from it, so don't
570 bother trying to queue them. */
571 if (!NILP (frame))
573 x_start_queuing_selection_requests (display);
575 record_unwind_protect (queue_selection_requests_unwind,
576 frame);
579 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
580 error ("Attempt to transfer an INCR to ourself!");
581 #if 0
582 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
583 #endif
584 wait_object = expect_property_change (display, window, reply.property,
585 PropertyDelete);
587 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
588 32, PropModeReplace,
589 (unsigned char *) &bytes_remaining, 1);
590 XSelectInput (display, window, PropertyChangeMask);
591 /* Tell 'em the INCR data is there... */
592 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
593 XFlush (display);
595 had_errors = x_had_errors_p (display);
596 UNBLOCK_INPUT;
598 /* First, wait for the requester to ack by deleting the property.
599 This can run random lisp code (process handlers) or signal. */
600 if (! had_errors)
601 wait_for_property_change (wait_object);
603 while (bytes_remaining)
605 int i = ((bytes_remaining < max_bytes)
606 ? bytes_remaining
607 : max_bytes);
609 BLOCK_INPUT;
611 wait_object
612 = expect_property_change (display, window, reply.property,
613 PropertyDelete);
614 #if 0
615 fprintf (stderr," INCR adding %d\n", i);
616 #endif
617 /* Append the next chunk of data to the property. */
618 XChangeProperty (display, window, reply.property, type, format,
619 PropModeAppend, data, i / format_bytes);
620 bytes_remaining -= i;
621 data += i;
622 XFlush (display);
623 had_errors = x_had_errors_p (display);
624 UNBLOCK_INPUT;
626 if (had_errors)
627 break;
629 /* Now wait for the requester to ack this chunk by deleting the
630 property. This can run random lisp code or signal.
632 wait_for_property_change (wait_object);
634 /* Now write a zero-length chunk to the property to tell the requester
635 that we're done. */
636 #if 0
637 fprintf (stderr," INCR done\n");
638 #endif
639 BLOCK_INPUT;
640 if (! waiting_for_other_props_on_window (display, window))
641 XSelectInput (display, window, 0L);
643 XChangeProperty (display, window, reply.property, type, format,
644 PropModeReplace, data, 0);
647 XFlush (display);
648 x_uncatch_errors (display, count);
649 UNBLOCK_INPUT;
652 /* Handle a SelectionRequest event EVENT.
653 This is called from keyboard.c when such an event is found in the queue. */
655 void
656 x_handle_selection_request (event)
657 struct input_event *event;
659 struct gcpro gcpro1, gcpro2, gcpro3;
660 Lisp_Object local_selection_data;
661 Lisp_Object selection_symbol;
662 Lisp_Object target_symbol;
663 Lisp_Object converted_selection;
664 Time local_selection_time;
665 Lisp_Object successful_p;
666 int count;
667 struct x_display_info *dpyinfo
668 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
670 local_selection_data = Qnil;
671 target_symbol = Qnil;
672 converted_selection = Qnil;
673 successful_p = Qnil;
675 GCPRO3 (local_selection_data, converted_selection, target_symbol);
677 selection_symbol = x_atom_to_symbol (dpyinfo,
678 SELECTION_EVENT_DISPLAY (event),
679 SELECTION_EVENT_SELECTION (event));
681 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
683 if (NILP (local_selection_data))
685 /* Someone asked for the selection, but we don't have it any more.
687 x_decline_selection_request (event);
688 goto DONE;
691 local_selection_time = (Time)
692 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
694 if (SELECTION_EVENT_TIME (event) != CurrentTime
695 && local_selection_time > SELECTION_EVENT_TIME (event))
697 /* Someone asked for the selection, and we have one, but not the one
698 they're looking for.
700 x_decline_selection_request (event);
701 goto DONE;
704 count = specpdl_ptr - specpdl;
705 x_selection_current_request = event;
706 record_unwind_protect (x_selection_request_lisp_error, Qnil);
708 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
709 SELECTION_EVENT_TARGET (event));
711 #if 0 /* #### MULTIPLE doesn't work yet */
712 if (EQ (target_symbol, QMULTIPLE))
713 target_symbol = fetch_multiple_target (event);
714 #endif
716 /* Convert lisp objects back into binary data */
718 converted_selection
719 = x_get_local_selection (selection_symbol, target_symbol);
721 if (! NILP (converted_selection))
723 unsigned char *data;
724 unsigned int size;
725 int format;
726 Atom type;
727 int nofree;
729 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
730 converted_selection,
731 &data, &type, &size, &format, &nofree);
733 x_reply_selection_request (event, format, data, size, type);
734 successful_p = Qt;
736 /* Indicate we have successfully processed this event. */
737 x_selection_current_request = 0;
739 /* Use xfree, not XFree, because lisp_data_to_selection_data
740 calls xmalloc itself. */
741 if (!nofree)
742 xfree (data);
744 unbind_to (count, Qnil);
746 DONE:
748 UNGCPRO;
750 /* Let random lisp code notice that the selection has been asked for. */
752 Lisp_Object rest;
753 rest = Vx_sent_selection_hooks;
754 if (!EQ (rest, Qunbound))
755 for (; CONSP (rest); rest = Fcdr (rest))
756 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
760 /* Handle a SelectionClear event EVENT, which indicates that some
761 client cleared out our previously asserted selection.
762 This is called from keyboard.c when such an event is found in the queue. */
764 void
765 x_handle_selection_clear (event)
766 struct input_event *event;
768 Display *display = SELECTION_EVENT_DISPLAY (event);
769 Atom selection = SELECTION_EVENT_SELECTION (event);
770 Time changed_owner_time = SELECTION_EVENT_TIME (event);
772 Lisp_Object selection_symbol, local_selection_data;
773 Time local_selection_time;
774 struct x_display_info *dpyinfo = x_display_info_for_display (display);
775 struct x_display_info *t_dpyinfo;
777 /* If the new selection owner is also Emacs,
778 don't clear the new selection. */
779 BLOCK_INPUT;
780 /* Check each display on the same terminal,
781 to see if this Emacs job now owns the selection
782 through that display. */
783 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
784 if (t_dpyinfo->kboard == dpyinfo->kboard)
786 Window owner_window
787 = XGetSelectionOwner (t_dpyinfo->display, selection);
788 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
790 UNBLOCK_INPUT;
791 return;
794 UNBLOCK_INPUT;
796 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
798 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
800 /* Well, we already believe that we don't own it, so that's just fine. */
801 if (NILP (local_selection_data)) return;
803 local_selection_time = (Time)
804 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
806 /* This SelectionClear is for a selection that we no longer own, so we can
807 disregard it. (That is, we have reasserted the selection since this
808 request was generated.) */
810 if (changed_owner_time != CurrentTime
811 && local_selection_time > changed_owner_time)
812 return;
814 /* Otherwise, we're really honest and truly being told to drop it.
815 Don't use Fdelq as that may QUIT;. */
817 if (EQ (local_selection_data, Fcar (Vselection_alist)))
818 Vselection_alist = Fcdr (Vselection_alist);
819 else
821 Lisp_Object rest;
822 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
823 if (EQ (local_selection_data, Fcar (XCDR (rest))))
825 XCDR (rest) = Fcdr (XCDR (rest));
826 break;
830 /* Let random lisp code notice that the selection has been stolen. */
833 Lisp_Object rest;
834 rest = Vx_lost_selection_hooks;
835 if (!EQ (rest, Qunbound))
837 for (; CONSP (rest); rest = Fcdr (rest))
838 call1 (Fcar (rest), selection_symbol);
839 prepare_menu_bars ();
840 redisplay_preserve_echo_area ();
845 /* Clear all selections that were made from frame F.
846 We do this when about to delete a frame. */
848 void
849 x_clear_frame_selections (f)
850 FRAME_PTR f;
852 Lisp_Object frame;
853 Lisp_Object rest;
855 XSETFRAME (frame, f);
857 /* Otherwise, we're really honest and truly being told to drop it.
858 Don't use Fdelq as that may QUIT;. */
860 /* Delete elements from the beginning of Vselection_alist. */
861 while (!NILP (Vselection_alist)
862 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
864 /* Let random Lisp code notice that the selection has been stolen. */
865 Lisp_Object hooks, selection_symbol;
867 hooks = Vx_lost_selection_hooks;
868 selection_symbol = Fcar (Fcar (Vselection_alist));
870 if (!EQ (hooks, Qunbound))
872 for (; CONSP (hooks); hooks = Fcdr (hooks))
873 call1 (Fcar (hooks), selection_symbol);
874 #if 0 /* This can crash when deleting a frame
875 from x_connection_closed. Anyway, it seems unnecessary;
876 something else should cause a redisplay. */
877 redisplay_preserve_echo_area ();
878 #endif
881 Vselection_alist = Fcdr (Vselection_alist);
884 /* Delete elements after the beginning of Vselection_alist. */
885 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
886 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
888 /* Let random Lisp code notice that the selection has been stolen. */
889 Lisp_Object hooks, selection_symbol;
891 hooks = Vx_lost_selection_hooks;
892 selection_symbol = Fcar (Fcar (XCDR (rest)));
894 if (!EQ (hooks, Qunbound))
896 for (; CONSP (hooks); hooks = Fcdr (hooks))
897 call1 (Fcar (hooks), selection_symbol);
898 #if 0 /* See above */
899 redisplay_preserve_echo_area ();
900 #endif
902 XCDR (rest) = Fcdr (XCDR (rest));
903 break;
907 /* Nonzero if any properties for DISPLAY and WINDOW
908 are on the list of what we are waiting for. */
910 static int
911 waiting_for_other_props_on_window (display, window)
912 Display *display;
913 Window window;
915 struct prop_location *rest = property_change_wait_list;
916 while (rest)
917 if (rest->display == display && rest->window == window)
918 return 1;
919 else
920 rest = rest->next;
921 return 0;
924 /* Add an entry to the list of property changes we are waiting for.
925 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
926 The return value is a number that uniquely identifies
927 this awaited property change. */
929 static struct prop_location *
930 expect_property_change (display, window, property, state)
931 Display *display;
932 Window window;
933 Atom property;
934 int state;
936 struct prop_location *pl
937 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
938 pl->identifier = ++prop_location_identifier;
939 pl->display = display;
940 pl->window = window;
941 pl->property = property;
942 pl->desired_state = state;
943 pl->next = property_change_wait_list;
944 pl->arrived = 0;
945 property_change_wait_list = pl;
946 return pl;
949 /* Delete an entry from the list of property changes we are waiting for.
950 IDENTIFIER is the number that uniquely identifies the entry. */
952 static void
953 unexpect_property_change (location)
954 struct prop_location *location;
956 struct prop_location *prev = 0, *rest = property_change_wait_list;
957 while (rest)
959 if (rest == location)
961 if (prev)
962 prev->next = rest->next;
963 else
964 property_change_wait_list = rest->next;
965 xfree (rest);
966 return;
968 prev = rest;
969 rest = rest->next;
973 /* Remove the property change expectation element for IDENTIFIER. */
975 static Lisp_Object
976 wait_for_property_change_unwind (identifierval)
977 Lisp_Object identifierval;
979 unexpect_property_change ((struct prop_location *)
980 (XFASTINT (XCAR (identifierval)) << 16
981 | XFASTINT (XCDR (identifierval))));
982 return Qnil;
985 /* Actually wait for a property change.
986 IDENTIFIER should be the value that expect_property_change returned. */
988 static void
989 wait_for_property_change (location)
990 struct prop_location *location;
992 int secs, usecs;
993 int count = specpdl_ptr - specpdl;
994 Lisp_Object tem;
996 tem = Fcons (Qnil, Qnil);
997 XSETFASTINT (XCAR (tem), (EMACS_UINT)location >> 16);
998 XSETFASTINT (XCDR (tem), (EMACS_UINT)location & 0xffff);
1000 /* Make sure to do unexpect_property_change if we quit or err. */
1001 record_unwind_protect (wait_for_property_change_unwind, tem);
1003 XCAR (property_change_reply) = Qnil;
1005 property_change_reply_object = location;
1006 /* If the event we are waiting for arrives beyond here, it will set
1007 property_change_reply, because property_change_reply_object says so. */
1008 if (! location->arrived)
1010 secs = x_selection_timeout / 1000;
1011 usecs = (x_selection_timeout % 1000) * 1000;
1012 wait_reading_process_input (secs, usecs, property_change_reply, 0);
1014 if (NILP (XCAR (property_change_reply)))
1015 error ("Timed out waiting for property-notify event");
1018 unbind_to (count, Qnil);
1021 /* Called from XTread_socket in response to a PropertyNotify event. */
1023 void
1024 x_handle_property_notify (event)
1025 XPropertyEvent *event;
1027 struct prop_location *prev = 0, *rest = property_change_wait_list;
1028 while (rest)
1030 if (rest->property == event->atom
1031 && rest->window == event->window
1032 && rest->display == event->display
1033 && rest->desired_state == event->state)
1035 #if 0
1036 fprintf (stderr, "Saw expected prop-%s on %s\n",
1037 (event->state == PropertyDelete ? "delete" : "change"),
1038 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
1039 event->atom))
1040 ->name->data);
1041 #endif
1043 rest->arrived = 1;
1045 /* If this is the one wait_for_property_change is waiting for,
1046 tell it to wake up. */
1047 if (rest == property_change_reply_object)
1048 XCAR (property_change_reply) = Qt;
1050 if (prev)
1051 prev->next = rest->next;
1052 else
1053 property_change_wait_list = rest->next;
1054 xfree (rest);
1055 return;
1057 prev = rest;
1058 rest = rest->next;
1060 #if 0
1061 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1062 (event->state == PropertyDelete ? "delete" : "change"),
1063 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1064 event->display, event->atom))
1065 ->name->data);
1066 #endif
1071 #if 0 /* #### MULTIPLE doesn't work yet */
1073 static Lisp_Object
1074 fetch_multiple_target (event)
1075 XSelectionRequestEvent *event;
1077 Display *display = event->display;
1078 Window window = event->requestor;
1079 Atom target = event->target;
1080 Atom selection_atom = event->selection;
1081 int result;
1083 return
1084 Fcons (QMULTIPLE,
1085 x_get_window_property_as_lisp_data (display, window, target,
1086 QMULTIPLE, selection_atom));
1089 static Lisp_Object
1090 copy_multiple_data (obj)
1091 Lisp_Object obj;
1093 Lisp_Object vec;
1094 int i;
1095 int size;
1096 if (CONSP (obj))
1097 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1099 CHECK_VECTOR (obj, 0);
1100 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1101 for (i = 0; i < size; i++)
1103 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1104 CHECK_VECTOR (vec2, 0);
1105 if (XVECTOR (vec2)->size != 2)
1106 /* ??? Confusing error message */
1107 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1108 Fcons (vec2, Qnil)));
1109 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1110 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1111 = XVECTOR (vec2)->contents [0];
1112 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1113 = XVECTOR (vec2)->contents [1];
1115 return vec;
1118 #endif
1121 /* Variables for communication with x_handle_selection_notify. */
1122 static Atom reading_which_selection;
1123 static Lisp_Object reading_selection_reply;
1124 static Window reading_selection_window;
1126 /* Do protocol to read selection-data from the server.
1127 Converts this to Lisp data and returns it. */
1129 static Lisp_Object
1130 x_get_foreign_selection (selection_symbol, target_type)
1131 Lisp_Object selection_symbol, target_type;
1133 struct frame *sf = SELECTED_FRAME ();
1134 Window requestor_window = FRAME_X_WINDOW (sf);
1135 Display *display = FRAME_X_DISPLAY (sf);
1136 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1137 Time requestor_time = last_event_timestamp;
1138 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1139 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1140 Atom type_atom;
1141 int secs, usecs;
1142 int count;
1143 Lisp_Object frame;
1145 if (CONSP (target_type))
1146 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1147 else
1148 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1150 BLOCK_INPUT;
1151 count = x_catch_errors (display);
1152 XConvertSelection (display, selection_atom, type_atom, target_property,
1153 requestor_window, requestor_time);
1154 XFlush (display);
1156 /* Prepare to block until the reply has been read. */
1157 reading_selection_window = requestor_window;
1158 reading_which_selection = selection_atom;
1159 XCAR (reading_selection_reply) = Qnil;
1161 frame = some_frame_on_display (dpyinfo);
1163 /* If the display no longer has frames, we can't expect
1164 to get many more selection requests from it, so don't
1165 bother trying to queue them. */
1166 if (!NILP (frame))
1168 x_start_queuing_selection_requests (display);
1170 record_unwind_protect (queue_selection_requests_unwind,
1171 frame);
1173 UNBLOCK_INPUT;
1175 /* This allows quits. Also, don't wait forever. */
1176 secs = x_selection_timeout / 1000;
1177 usecs = (x_selection_timeout % 1000) * 1000;
1178 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1180 BLOCK_INPUT;
1181 x_check_errors (display, "Cannot get selection: %s");
1182 x_uncatch_errors (display, count);
1183 UNBLOCK_INPUT;
1185 if (NILP (XCAR (reading_selection_reply)))
1186 error ("Timed out waiting for reply from selection owner");
1187 if (EQ (XCAR (reading_selection_reply), Qlambda))
1188 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
1190 /* Otherwise, the selection is waiting for us on the requested property. */
1191 return
1192 x_get_window_property_as_lisp_data (display, requestor_window,
1193 target_property, target_type,
1194 selection_atom);
1197 /* Subroutines of x_get_window_property_as_lisp_data */
1199 /* Use xfree, not XFree, to free the data obtained with this function. */
1201 static void
1202 x_get_window_property (display, window, property, data_ret, bytes_ret,
1203 actual_type_ret, actual_format_ret, actual_size_ret,
1204 delete_p)
1205 Display *display;
1206 Window window;
1207 Atom property;
1208 unsigned char **data_ret;
1209 int *bytes_ret;
1210 Atom *actual_type_ret;
1211 int *actual_format_ret;
1212 unsigned long *actual_size_ret;
1213 int delete_p;
1215 int total_size;
1216 unsigned long bytes_remaining;
1217 int offset = 0;
1218 unsigned char *tmp_data = 0;
1219 int result;
1220 int buffer_size = SELECTION_QUANTUM (display);
1221 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1223 BLOCK_INPUT;
1224 /* First probe the thing to find out how big it is. */
1225 result = XGetWindowProperty (display, window, property,
1226 0L, 0L, False, AnyPropertyType,
1227 actual_type_ret, actual_format_ret,
1228 actual_size_ret,
1229 &bytes_remaining, &tmp_data);
1230 if (result != Success)
1232 UNBLOCK_INPUT;
1233 *data_ret = 0;
1234 *bytes_ret = 0;
1235 return;
1237 /* This was allocated by Xlib, so use XFree. */
1238 XFree ((char *) tmp_data);
1240 if (*actual_type_ret == None || *actual_format_ret == 0)
1242 UNBLOCK_INPUT;
1243 return;
1246 total_size = bytes_remaining + 1;
1247 *data_ret = (unsigned char *) xmalloc (total_size);
1249 /* Now read, until we've gotten it all. */
1250 while (bytes_remaining)
1252 #if 0
1253 int last = bytes_remaining;
1254 #endif
1255 result
1256 = XGetWindowProperty (display, window, property,
1257 (long)offset/4, (long)buffer_size/4,
1258 False,
1259 AnyPropertyType,
1260 actual_type_ret, actual_format_ret,
1261 actual_size_ret, &bytes_remaining, &tmp_data);
1262 #if 0
1263 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1264 #endif
1265 /* If this doesn't return Success at this point, it means that
1266 some clod deleted the selection while we were in the midst of
1267 reading it. Deal with that, I guess....
1269 if (result != Success) break;
1270 *actual_size_ret *= *actual_format_ret / 8;
1271 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1272 offset += *actual_size_ret;
1273 /* This was allocated by Xlib, so use XFree. */
1274 XFree ((char *) tmp_data);
1277 XFlush (display);
1278 UNBLOCK_INPUT;
1279 *bytes_ret = offset;
1282 /* Use xfree, not XFree, to free the data obtained with this function. */
1284 static void
1285 receive_incremental_selection (display, window, property, target_type,
1286 min_size_bytes, data_ret, size_bytes_ret,
1287 type_ret, format_ret, size_ret)
1288 Display *display;
1289 Window window;
1290 Atom property;
1291 Lisp_Object target_type; /* for error messages only */
1292 unsigned int min_size_bytes;
1293 unsigned char **data_ret;
1294 int *size_bytes_ret;
1295 Atom *type_ret;
1296 unsigned long *size_ret;
1297 int *format_ret;
1299 int offset = 0;
1300 struct prop_location *wait_object;
1301 *size_bytes_ret = min_size_bytes;
1302 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1303 #if 0
1304 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1305 #endif
1307 /* At this point, we have read an INCR property.
1308 Delete the property to ack it.
1309 (But first, prepare to receive the next event in this handshake.)
1311 Now, we must loop, waiting for the sending window to put a value on
1312 that property, then reading the property, then deleting it to ack.
1313 We are done when the sender places a property of length 0.
1315 BLOCK_INPUT;
1316 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1317 XDeleteProperty (display, window, property);
1318 wait_object = expect_property_change (display, window, property,
1319 PropertyNewValue);
1320 XFlush (display);
1321 UNBLOCK_INPUT;
1323 while (1)
1325 unsigned char *tmp_data;
1326 int tmp_size_bytes;
1327 wait_for_property_change (wait_object);
1328 /* expect it again immediately, because x_get_window_property may
1329 .. no it won't, I don't get it.
1330 .. Ok, I get it now, the Xt code that implements INCR is broken.
1332 x_get_window_property (display, window, property,
1333 &tmp_data, &tmp_size_bytes,
1334 type_ret, format_ret, size_ret, 1);
1336 if (tmp_size_bytes == 0) /* we're done */
1338 #if 0
1339 fprintf (stderr, " read INCR done\n");
1340 #endif
1341 if (! waiting_for_other_props_on_window (display, window))
1342 XSelectInput (display, window, STANDARD_EVENT_SET);
1343 unexpect_property_change (wait_object);
1344 /* Use xfree, not XFree, because x_get_window_property
1345 calls xmalloc itself. */
1346 if (tmp_data) xfree (tmp_data);
1347 break;
1350 BLOCK_INPUT;
1351 XDeleteProperty (display, window, property);
1352 wait_object = expect_property_change (display, window, property,
1353 PropertyNewValue);
1354 XFlush (display);
1355 UNBLOCK_INPUT;
1357 #if 0
1358 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1359 #endif
1360 if (*size_bytes_ret < offset + tmp_size_bytes)
1362 #if 0
1363 fprintf (stderr, " read INCR realloc %d -> %d\n",
1364 *size_bytes_ret, offset + tmp_size_bytes);
1365 #endif
1366 *size_bytes_ret = offset + tmp_size_bytes;
1367 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1369 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1370 offset += tmp_size_bytes;
1371 /* Use xfree, not XFree, because x_get_window_property
1372 calls xmalloc itself. */
1373 xfree (tmp_data);
1377 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1378 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1379 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1381 static Lisp_Object
1382 x_get_window_property_as_lisp_data (display, window, property, target_type,
1383 selection_atom)
1384 Display *display;
1385 Window window;
1386 Atom property;
1387 Lisp_Object target_type; /* for error messages only */
1388 Atom selection_atom; /* for error messages only */
1390 Atom actual_type;
1391 int actual_format;
1392 unsigned long actual_size;
1393 unsigned char *data = 0;
1394 int bytes = 0;
1395 Lisp_Object val;
1396 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1398 x_get_window_property (display, window, property, &data, &bytes,
1399 &actual_type, &actual_format, &actual_size, 1);
1400 if (! data)
1402 int there_is_a_selection_owner;
1403 BLOCK_INPUT;
1404 there_is_a_selection_owner
1405 = XGetSelectionOwner (display, selection_atom);
1406 UNBLOCK_INPUT;
1407 Fsignal (Qerror,
1408 there_is_a_selection_owner
1409 ? Fcons (build_string ("selection owner couldn't convert"),
1410 actual_type
1411 ? Fcons (target_type,
1412 Fcons (x_atom_to_symbol (dpyinfo, display,
1413 actual_type),
1414 Qnil))
1415 : Fcons (target_type, Qnil))
1416 : Fcons (build_string ("no selection"),
1417 Fcons (x_atom_to_symbol (dpyinfo, display,
1418 selection_atom),
1419 Qnil)));
1422 if (actual_type == dpyinfo->Xatom_INCR)
1424 /* That wasn't really the data, just the beginning. */
1426 unsigned int min_size_bytes = * ((unsigned int *) data);
1427 BLOCK_INPUT;
1428 /* Use xfree, not XFree, because x_get_window_property
1429 calls xmalloc itself. */
1430 xfree ((char *) data);
1431 UNBLOCK_INPUT;
1432 receive_incremental_selection (display, window, property, target_type,
1433 min_size_bytes, &data, &bytes,
1434 &actual_type, &actual_format,
1435 &actual_size);
1438 BLOCK_INPUT;
1439 XDeleteProperty (display, window, property);
1440 XFlush (display);
1441 UNBLOCK_INPUT;
1443 /* It's been read. Now convert it to a lisp object in some semi-rational
1444 manner. */
1445 val = selection_data_to_lisp_data (display, data, bytes,
1446 actual_type, actual_format);
1448 /* Use xfree, not XFree, because x_get_window_property
1449 calls xmalloc itself. */
1450 xfree ((char *) data);
1451 return val;
1454 /* These functions convert from the selection data read from the server into
1455 something that we can use from Lisp, and vice versa.
1457 Type: Format: Size: Lisp Type:
1458 ----- ------- ----- -----------
1459 * 8 * String
1460 ATOM 32 1 Symbol
1461 ATOM 32 > 1 Vector of Symbols
1462 * 16 1 Integer
1463 * 16 > 1 Vector of Integers
1464 * 32 1 if <=16 bits: Integer
1465 if > 16 bits: Cons of top16, bot16
1466 * 32 > 1 Vector of the above
1468 When converting a Lisp number to C, it is assumed to be of format 16 if
1469 it is an integer, and of format 32 if it is a cons of two integers.
1471 When converting a vector of numbers from Lisp to C, it is assumed to be
1472 of format 16 if every element in the vector is an integer, and is assumed
1473 to be of format 32 if any element is a cons of two integers.
1475 When converting an object to C, it may be of the form (SYMBOL . <data>)
1476 where SYMBOL is what we should claim that the type is. Format and
1477 representation are as above. */
1481 static Lisp_Object
1482 selection_data_to_lisp_data (display, data, size, type, format)
1483 Display *display;
1484 unsigned char *data;
1485 Atom type;
1486 int size, format;
1488 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1490 if (type == dpyinfo->Xatom_NULL)
1491 return QNULL;
1493 /* Convert any 8-bit data to a string, for compactness. */
1494 else if (format == 8)
1496 Lisp_Object str;
1497 int require_encoding = 0;
1499 if (
1500 #if 1
1502 #else
1503 ! NILP (buffer_defaults.enable_multibyte_characters)
1504 #endif
1507 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1508 DATA to Emacs internal format because DATA may be encoded
1509 in compound text format. In addtion, if TYPE is `STRING'
1510 and DATA contains any 8-bit Latin-1 code, we should also
1511 decode it. */
1512 if (type == dpyinfo->Xatom_TEXT
1513 || type == dpyinfo->Xatom_COMPOUND_TEXT)
1514 require_encoding = 1;
1515 else if (type == XA_STRING)
1517 int i;
1518 for (i = 0; i < size; i++)
1520 if (data[i] >= 0x80)
1522 require_encoding = 1;
1523 break;
1528 if (!require_encoding)
1530 str = make_unibyte_string ((char *) data, size);
1531 Vlast_coding_system_used = Qraw_text;
1533 else
1535 int bufsize;
1536 unsigned char *buf;
1537 struct coding_system coding;
1539 if (NILP (Vnext_selection_coding_system))
1540 Vnext_selection_coding_system = Vselection_coding_system;
1541 setup_coding_system
1542 (Fcheck_coding_system(Vnext_selection_coding_system), &coding);
1543 coding.src_multibyte = 0;
1544 coding.dst_multibyte = 1;
1545 Vnext_selection_coding_system = Qnil;
1546 coding.mode |= CODING_MODE_LAST_BLOCK;
1547 bufsize = decoding_buffer_size (&coding, size);
1548 buf = (unsigned char *) xmalloc (bufsize);
1549 decode_coding (&coding, data, buf, size, bufsize);
1550 str = make_string_from_bytes ((char *) buf,
1551 coding.produced_char, coding.produced);
1552 xfree (buf);
1553 Vlast_coding_system_used = coding.symbol;
1555 compose_chars_in_text (0, XSTRING (str)->size, str);
1556 return str;
1558 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1559 a vector of symbols.
1561 else if (type == XA_ATOM)
1563 int i;
1564 if (size == sizeof (Atom))
1565 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
1566 else
1568 Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
1569 make_number (0));
1570 for (i = 0; i < size / sizeof (Atom); i++)
1571 Faset (v, make_number (i),
1572 x_atom_to_symbol (dpyinfo, display, ((Atom *) data) [i]));
1573 return v;
1577 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1578 If the number is > 16 bits, convert it to a cons of integers,
1579 16 bits in each half.
1581 else if (format == 32 && size == sizeof (long))
1582 return long_to_cons (((unsigned long *) data) [0]);
1583 else if (format == 16 && size == sizeof (short))
1584 return make_number ((int) (((unsigned short *) data) [0]));
1586 /* Convert any other kind of data to a vector of numbers, represented
1587 as above (as an integer, or a cons of two 16 bit integers.)
1589 else if (format == 16)
1591 int i;
1592 Lisp_Object v;
1593 v = Fmake_vector (make_number (size / 2), make_number (0));
1594 for (i = 0; i < size / 2; i++)
1596 int j = (int) ((unsigned short *) data) [i];
1597 Faset (v, make_number (i), make_number (j));
1599 return v;
1601 else
1603 int i;
1604 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1605 for (i = 0; i < size / 4; i++)
1607 unsigned long j = ((unsigned long *) data) [i];
1608 Faset (v, make_number (i), long_to_cons (j));
1610 return v;
1615 /* Use xfree, not XFree, to free the data obtained with this function. */
1617 static void
1618 lisp_data_to_selection_data (display, obj,
1619 data_ret, type_ret, size_ret,
1620 format_ret, nofree_ret)
1621 Display *display;
1622 Lisp_Object obj;
1623 unsigned char **data_ret;
1624 Atom *type_ret;
1625 unsigned int *size_ret;
1626 int *format_ret;
1627 int *nofree_ret;
1629 Lisp_Object type = Qnil;
1630 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1632 *nofree_ret = 0;
1634 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1636 type = XCAR (obj);
1637 obj = XCDR (obj);
1638 if (CONSP (obj) && NILP (XCDR (obj)))
1639 obj = XCAR (obj);
1642 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1643 { /* This is not the same as declining */
1644 *format_ret = 32;
1645 *size_ret = 0;
1646 *data_ret = 0;
1647 type = QNULL;
1649 else if (STRINGP (obj))
1651 /* Since we are now handling multilingual text, we must consider
1652 sending back compound text. */
1653 int stringp;
1655 if (NILP (Vnext_selection_coding_system))
1656 Vnext_selection_coding_system = Vselection_coding_system;
1658 *format_ret = 8;
1659 *data_ret = x_encode_text (obj, Vnext_selection_coding_system,
1660 (int *) size_ret, &stringp);
1661 *nofree_ret = (*data_ret == XSTRING (obj)->data);
1662 if (NILP (type))
1663 type = (stringp ? QSTRING : QCOMPOUND_TEXT);
1664 Vlast_coding_system_used = (*nofree_ret
1665 ? Qraw_text
1666 : Vnext_selection_coding_system);
1667 Vnext_selection_coding_system = Qnil;
1669 else if (SYMBOLP (obj))
1671 *format_ret = 32;
1672 *size_ret = 1;
1673 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1674 (*data_ret) [sizeof (Atom)] = 0;
1675 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1676 if (NILP (type)) type = QATOM;
1678 else if (INTEGERP (obj)
1679 && XINT (obj) < 0xFFFF
1680 && XINT (obj) > -0xFFFF)
1682 *format_ret = 16;
1683 *size_ret = 1;
1684 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1685 (*data_ret) [sizeof (short)] = 0;
1686 (*(short **) data_ret) [0] = (short) XINT (obj);
1687 if (NILP (type)) type = QINTEGER;
1689 else if (INTEGERP (obj)
1690 || (CONSP (obj) && INTEGERP (XCAR (obj))
1691 && (INTEGERP (XCDR (obj))
1692 || (CONSP (XCDR (obj))
1693 && INTEGERP (XCAR (XCDR (obj)))))))
1695 *format_ret = 32;
1696 *size_ret = 1;
1697 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1698 (*data_ret) [sizeof (long)] = 0;
1699 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1700 if (NILP (type)) type = QINTEGER;
1702 else if (VECTORP (obj))
1704 /* Lisp_Vectors may represent a set of ATOMs;
1705 a set of 16 or 32 bit INTEGERs;
1706 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1708 int i;
1710 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1711 /* This vector is an ATOM set */
1713 if (NILP (type)) type = QATOM;
1714 *size_ret = XVECTOR (obj)->size;
1715 *format_ret = 32;
1716 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1717 for (i = 0; i < *size_ret; i++)
1718 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1719 (*(Atom **) data_ret) [i]
1720 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1721 else
1722 Fsignal (Qerror, /* Qselection_error */
1723 Fcons (build_string
1724 ("all elements of selection vector must have same type"),
1725 Fcons (obj, Qnil)));
1727 #if 0 /* #### MULTIPLE doesn't work yet */
1728 else if (VECTORP (XVECTOR (obj)->contents [0]))
1729 /* This vector is an ATOM_PAIR set */
1731 if (NILP (type)) type = QATOM_PAIR;
1732 *size_ret = XVECTOR (obj)->size;
1733 *format_ret = 32;
1734 *data_ret = (unsigned char *)
1735 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1736 for (i = 0; i < *size_ret; i++)
1737 if (VECTORP (XVECTOR (obj)->contents [i]))
1739 Lisp_Object pair = XVECTOR (obj)->contents [i];
1740 if (XVECTOR (pair)->size != 2)
1741 Fsignal (Qerror,
1742 Fcons (build_string
1743 ("elements of the vector must be vectors of exactly two elements"),
1744 Fcons (pair, Qnil)));
1746 (*(Atom **) data_ret) [i * 2]
1747 = symbol_to_x_atom (dpyinfo, display,
1748 XVECTOR (pair)->contents [0]);
1749 (*(Atom **) data_ret) [(i * 2) + 1]
1750 = symbol_to_x_atom (dpyinfo, display,
1751 XVECTOR (pair)->contents [1]);
1753 else
1754 Fsignal (Qerror,
1755 Fcons (build_string
1756 ("all elements of the vector must be of the same type"),
1757 Fcons (obj, Qnil)));
1760 #endif
1761 else
1762 /* This vector is an INTEGER set, or something like it */
1764 *size_ret = XVECTOR (obj)->size;
1765 if (NILP (type)) type = QINTEGER;
1766 *format_ret = 16;
1767 for (i = 0; i < *size_ret; i++)
1768 if (CONSP (XVECTOR (obj)->contents [i]))
1769 *format_ret = 32;
1770 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1771 Fsignal (Qerror, /* Qselection_error */
1772 Fcons (build_string
1773 ("elements of selection vector must be integers or conses of integers"),
1774 Fcons (obj, Qnil)));
1776 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1777 for (i = 0; i < *size_ret; i++)
1778 if (*format_ret == 32)
1779 (*((unsigned long **) data_ret)) [i]
1780 = cons_to_long (XVECTOR (obj)->contents [i]);
1781 else
1782 (*((unsigned short **) data_ret)) [i]
1783 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1786 else
1787 Fsignal (Qerror, /* Qselection_error */
1788 Fcons (build_string ("unrecognised selection data"),
1789 Fcons (obj, Qnil)));
1791 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1794 static Lisp_Object
1795 clean_local_selection_data (obj)
1796 Lisp_Object obj;
1798 if (CONSP (obj)
1799 && INTEGERP (XCAR (obj))
1800 && CONSP (XCDR (obj))
1801 && INTEGERP (XCAR (XCDR (obj)))
1802 && NILP (XCDR (XCDR (obj))))
1803 obj = Fcons (XCAR (obj), XCDR (obj));
1805 if (CONSP (obj)
1806 && INTEGERP (XCAR (obj))
1807 && INTEGERP (XCDR (obj)))
1809 if (XINT (XCAR (obj)) == 0)
1810 return XCDR (obj);
1811 if (XINT (XCAR (obj)) == -1)
1812 return make_number (- XINT (XCDR (obj)));
1814 if (VECTORP (obj))
1816 int i;
1817 int size = XVECTOR (obj)->size;
1818 Lisp_Object copy;
1819 if (size == 1)
1820 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1821 copy = Fmake_vector (make_number (size), Qnil);
1822 for (i = 0; i < size; i++)
1823 XVECTOR (copy)->contents [i]
1824 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1825 return copy;
1827 return obj;
1830 /* Called from XTread_socket to handle SelectionNotify events.
1831 If it's the selection we are waiting for, stop waiting
1832 by setting the car of reading_selection_reply to non-nil.
1833 We store t there if the reply is successful, lambda if not. */
1835 void
1836 x_handle_selection_notify (event)
1837 XSelectionEvent *event;
1839 if (event->requestor != reading_selection_window)
1840 return;
1841 if (event->selection != reading_which_selection)
1842 return;
1844 XCAR (reading_selection_reply)
1845 = (event->property != 0 ? Qt : Qlambda);
1849 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
1850 Sx_own_selection_internal, 2, 2, 0,
1851 "Assert an X selection of the given TYPE with the given VALUE.\n\
1852 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1853 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1854 VALUE is typically a string, or a cons of two markers, but may be\n\
1855 anything that the functions on `selection-converter-alist' know about.")
1856 (selection_name, selection_value)
1857 Lisp_Object selection_name, selection_value;
1859 check_x ();
1860 CHECK_SYMBOL (selection_name, 0);
1861 if (NILP (selection_value)) error ("selection-value may not be nil");
1862 x_own_selection (selection_name, selection_value);
1863 return selection_value;
1867 /* Request the selection value from the owner. If we are the owner,
1868 simply return our selection value. If we are not the owner, this
1869 will block until all of the data has arrived. */
1871 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
1872 Sx_get_selection_internal, 2, 2, 0,
1873 "Return text selected from some X window.\n\
1874 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1875 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1876 TYPE is the type of data desired, typically `STRING'.")
1877 (selection_symbol, target_type)
1878 Lisp_Object selection_symbol, target_type;
1880 Lisp_Object val = Qnil;
1881 struct gcpro gcpro1, gcpro2;
1882 GCPRO2 (target_type, val); /* we store newly consed data into these */
1883 check_x ();
1884 CHECK_SYMBOL (selection_symbol, 0);
1886 #if 0 /* #### MULTIPLE doesn't work yet */
1887 if (CONSP (target_type)
1888 && XCAR (target_type) == QMULTIPLE)
1890 CHECK_VECTOR (XCDR (target_type), 0);
1891 /* So we don't destructively modify this... */
1892 target_type = copy_multiple_data (target_type);
1894 else
1895 #endif
1896 CHECK_SYMBOL (target_type, 0);
1898 val = x_get_local_selection (selection_symbol, target_type);
1900 if (NILP (val))
1902 val = x_get_foreign_selection (selection_symbol, target_type);
1903 goto DONE;
1906 if (CONSP (val)
1907 && SYMBOLP (XCAR (val)))
1909 val = XCDR (val);
1910 if (CONSP (val) && NILP (XCDR (val)))
1911 val = XCAR (val);
1913 val = clean_local_selection_data (val);
1914 DONE:
1915 UNGCPRO;
1916 return val;
1919 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
1920 Sx_disown_selection_internal, 1, 2, 0,
1921 "If we own the selection SELECTION, disown it.\n\
1922 Disowning it means there is no such selection.")
1923 (selection, time)
1924 Lisp_Object selection;
1925 Lisp_Object time;
1927 Time timestamp;
1928 Atom selection_atom;
1929 struct selection_input_event event;
1930 Display *display;
1931 struct x_display_info *dpyinfo;
1932 struct frame *sf = SELECTED_FRAME ();
1934 check_x ();
1935 display = FRAME_X_DISPLAY (sf);
1936 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1937 CHECK_SYMBOL (selection, 0);
1938 if (NILP (time))
1939 timestamp = last_event_timestamp;
1940 else
1941 timestamp = cons_to_long (time);
1943 if (NILP (assq_no_quit (selection, Vselection_alist)))
1944 return Qnil; /* Don't disown the selection when we're not the owner. */
1946 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
1948 BLOCK_INPUT;
1949 XSetSelectionOwner (display, selection_atom, None, timestamp);
1950 UNBLOCK_INPUT;
1952 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1953 generated for a window which owns the selection when that window sets
1954 the selection owner to None. The NCD server does, the MIT Sun4 server
1955 doesn't. So we synthesize one; this means we might get two, but
1956 that's ok, because the second one won't have any effect. */
1957 SELECTION_EVENT_DISPLAY (&event) = display;
1958 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1959 SELECTION_EVENT_TIME (&event) = timestamp;
1960 x_handle_selection_clear ((struct input_event *) &event);
1962 return Qt;
1965 /* Get rid of all the selections in buffer BUFFER.
1966 This is used when we kill a buffer. */
1968 void
1969 x_disown_buffer_selections (buffer)
1970 Lisp_Object buffer;
1972 Lisp_Object tail;
1973 struct buffer *buf = XBUFFER (buffer);
1975 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
1977 Lisp_Object elt, value;
1978 elt = XCAR (tail);
1979 value = XCDR (elt);
1980 if (CONSP (value) && MARKERP (XCAR (value))
1981 && XMARKER (XCAR (value))->buffer == buf)
1982 Fx_disown_selection_internal (XCAR (elt), Qnil);
1986 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1987 0, 1, 0,
1988 "Whether the current Emacs process owns the given X Selection.\n\
1989 The arg should be the name of the selection in question, typically one of\n\
1990 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1991 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1992 For convenience, the symbol nil is the same as `PRIMARY',\n\
1993 and t is the same as `SECONDARY'.)")
1994 (selection)
1995 Lisp_Object selection;
1997 check_x ();
1998 CHECK_SYMBOL (selection, 0);
1999 if (EQ (selection, Qnil)) selection = QPRIMARY;
2000 if (EQ (selection, Qt)) selection = QSECONDARY;
2002 if (NILP (Fassq (selection, Vselection_alist)))
2003 return Qnil;
2004 return Qt;
2007 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2008 0, 1, 0,
2009 "Whether there is an owner for the given X Selection.\n\
2010 The arg should be the name of the selection in question, typically one of\n\
2011 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
2012 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
2013 For convenience, the symbol nil is the same as `PRIMARY',\n\
2014 and t is the same as `SECONDARY'.)")
2015 (selection)
2016 Lisp_Object selection;
2018 Window owner;
2019 Atom atom;
2020 Display *dpy;
2021 struct frame *sf = SELECTED_FRAME ();
2023 /* It should be safe to call this before we have an X frame. */
2024 if (! FRAME_X_P (sf))
2025 return Qnil;
2027 dpy = FRAME_X_DISPLAY (sf);
2028 CHECK_SYMBOL (selection, 0);
2029 if (!NILP (Fx_selection_owner_p (selection)))
2030 return Qt;
2031 if (EQ (selection, Qnil)) selection = QPRIMARY;
2032 if (EQ (selection, Qt)) selection = QSECONDARY;
2033 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2034 if (atom == 0)
2035 return Qnil;
2036 BLOCK_INPUT;
2037 owner = XGetSelectionOwner (dpy, atom);
2038 UNBLOCK_INPUT;
2039 return (owner ? Qt : Qnil);
2043 #ifdef CUT_BUFFER_SUPPORT
2045 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2046 static void
2047 initialize_cut_buffers (display, window)
2048 Display *display;
2049 Window window;
2051 unsigned char *data = (unsigned char *) "";
2052 BLOCK_INPUT;
2053 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2054 PropModeAppend, data, 0)
2055 FROB (XA_CUT_BUFFER0);
2056 FROB (XA_CUT_BUFFER1);
2057 FROB (XA_CUT_BUFFER2);
2058 FROB (XA_CUT_BUFFER3);
2059 FROB (XA_CUT_BUFFER4);
2060 FROB (XA_CUT_BUFFER5);
2061 FROB (XA_CUT_BUFFER6);
2062 FROB (XA_CUT_BUFFER7);
2063 #undef FROB
2064 UNBLOCK_INPUT;
2068 #define CHECK_CUT_BUFFER(symbol,n) \
2069 { CHECK_SYMBOL ((symbol), (n)); \
2070 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2071 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2072 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2073 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2074 Fsignal (Qerror, \
2075 Fcons (build_string ("doesn't name a cut buffer"), \
2076 Fcons ((symbol), Qnil))); \
2079 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2080 Sx_get_cut_buffer_internal, 1, 1, 0,
2081 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
2082 (buffer)
2083 Lisp_Object buffer;
2085 Window window;
2086 Atom buffer_atom;
2087 unsigned char *data;
2088 int bytes;
2089 Atom type;
2090 int format;
2091 unsigned long size;
2092 Lisp_Object ret;
2093 Display *display;
2094 struct x_display_info *dpyinfo;
2095 struct frame *sf = SELECTED_FRAME ();
2097 check_x ();
2098 display = FRAME_X_DISPLAY (sf);
2099 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2100 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2101 CHECK_CUT_BUFFER (buffer, 0);
2102 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2104 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2105 &type, &format, &size, 0);
2106 if (!data || !format)
2107 return Qnil;
2109 if (format != 8 || type != XA_STRING)
2110 Fsignal (Qerror,
2111 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2112 Fcons (x_atom_to_symbol (dpyinfo, display, type),
2113 Fcons (make_number (format), Qnil))));
2115 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2116 /* Use xfree, not XFree, because x_get_window_property
2117 calls xmalloc itself. */
2118 xfree (data);
2119 return ret;
2123 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2124 Sx_store_cut_buffer_internal, 2, 2, 0,
2125 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2126 (buffer, string)
2127 Lisp_Object buffer, string;
2129 Window window;
2130 Atom buffer_atom;
2131 unsigned char *data;
2132 int bytes;
2133 int bytes_remaining;
2134 int max_bytes;
2135 Display *display;
2136 struct frame *sf = SELECTED_FRAME ();
2138 check_x ();
2139 display = FRAME_X_DISPLAY (sf);
2140 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2142 max_bytes = SELECTION_QUANTUM (display);
2143 if (max_bytes > MAX_SELECTION_QUANTUM)
2144 max_bytes = MAX_SELECTION_QUANTUM;
2146 CHECK_CUT_BUFFER (buffer, 0);
2147 CHECK_STRING (string, 0);
2148 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2149 display, buffer);
2150 data = (unsigned char *) XSTRING (string)->data;
2151 bytes = STRING_BYTES (XSTRING (string));
2152 bytes_remaining = bytes;
2154 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2156 initialize_cut_buffers (display, window);
2157 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2160 BLOCK_INPUT;
2162 /* Don't mess up with an empty value. */
2163 if (!bytes_remaining)
2164 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2165 PropModeReplace, data, 0);
2167 while (bytes_remaining)
2169 int chunk = (bytes_remaining < max_bytes
2170 ? bytes_remaining : max_bytes);
2171 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2172 (bytes_remaining == bytes
2173 ? PropModeReplace
2174 : PropModeAppend),
2175 data, chunk);
2176 data += chunk;
2177 bytes_remaining -= chunk;
2179 UNBLOCK_INPUT;
2180 return string;
2184 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2185 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2186 "Rotate the values of the cut buffers by the given number of step.\n\
2187 Positive means shift the values forward, negative means backward.")
2189 Lisp_Object n;
2191 Window window;
2192 Atom props[8];
2193 Display *display;
2194 struct frame *sf = SELECTED_FRAME ();
2196 check_x ();
2197 display = FRAME_X_DISPLAY (sf);
2198 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2199 CHECK_NUMBER (n, 0);
2200 if (XINT (n) == 0)
2201 return n;
2202 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2204 initialize_cut_buffers (display, window);
2205 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2208 props[0] = XA_CUT_BUFFER0;
2209 props[1] = XA_CUT_BUFFER1;
2210 props[2] = XA_CUT_BUFFER2;
2211 props[3] = XA_CUT_BUFFER3;
2212 props[4] = XA_CUT_BUFFER4;
2213 props[5] = XA_CUT_BUFFER5;
2214 props[6] = XA_CUT_BUFFER6;
2215 props[7] = XA_CUT_BUFFER7;
2216 BLOCK_INPUT;
2217 XRotateWindowProperties (display, window, props, 8, XINT (n));
2218 UNBLOCK_INPUT;
2219 return n;
2222 #endif
2224 void
2225 syms_of_xselect ()
2227 defsubr (&Sx_get_selection_internal);
2228 defsubr (&Sx_own_selection_internal);
2229 defsubr (&Sx_disown_selection_internal);
2230 defsubr (&Sx_selection_owner_p);
2231 defsubr (&Sx_selection_exists_p);
2233 #ifdef CUT_BUFFER_SUPPORT
2234 defsubr (&Sx_get_cut_buffer_internal);
2235 defsubr (&Sx_store_cut_buffer_internal);
2236 defsubr (&Sx_rotate_cut_buffers_internal);
2237 #endif
2239 reading_selection_reply = Fcons (Qnil, Qnil);
2240 staticpro (&reading_selection_reply);
2241 reading_selection_window = 0;
2242 reading_which_selection = 0;
2244 property_change_wait_list = 0;
2245 prop_location_identifier = 0;
2246 property_change_reply = Fcons (Qnil, Qnil);
2247 staticpro (&property_change_reply);
2249 Vselection_alist = Qnil;
2250 staticpro (&Vselection_alist);
2252 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2253 "An alist associating X Windows selection-types with functions.\n\
2254 These functions are called to convert the selection, with three args:\n\
2255 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2256 a desired type to which the selection should be converted;\n\
2257 and the local selection value (whatever was given to `x-own-selection').\n\
2259 The function should return the value to send to the X server\n\
2260 \(typically a string). A return value of nil\n\
2261 means that the conversion could not be done.\n\
2262 A return value which is the symbol `NULL'\n\
2263 means that a side-effect was executed,\n\
2264 and there is no meaningful selection value.");
2265 Vselection_converter_alist = Qnil;
2267 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2268 "A list of functions to be called when Emacs loses an X selection.\n\
2269 \(This happens when some other X client makes its own selection\n\
2270 or when a Lisp program explicitly clears the selection.)\n\
2271 The functions are called with one argument, the selection type\n\
2272 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2273 Vx_lost_selection_hooks = Qnil;
2275 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2276 "A list of functions to be called when Emacs answers a selection request.\n\
2277 The functions are called with four arguments:\n\
2278 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2279 - the selection-type which Emacs was asked to convert the\n\
2280 selection into before sending (for example, `STRING' or `LENGTH');\n\
2281 - a flag indicating success or failure for responding to the request.\n\
2282 We might have failed (and declined the request) for any number of reasons,\n\
2283 including being asked for a selection that we no longer own, or being asked\n\
2284 to convert into a type that we don't know about or that is inappropriate.\n\
2285 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2286 it merely informs you that they have happened.");
2287 Vx_sent_selection_hooks = Qnil;
2289 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2290 "Coding system for communicating with other X clients.\n\
2291 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
2292 the text is encoded or decoded by this coding system.\n\
2293 The default value is `compound-text'.");
2294 Vselection_coding_system = intern ("compound-text");
2296 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2297 "Coding system for the next communication with other X clients.\n\
2298 Usually, `selection-coding-system' is used for communicating with\n\
2299 other X clients. But, if this variable is set, it is used for the\n\
2300 next communication only. After the communication, this variable is\n\
2301 set to nil.");
2302 Vnext_selection_coding_system = Qnil;
2304 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2305 "Number of milliseconds to wait for a selection reply.\n\
2306 If the selection owner doesn't reply in this time, we give up.\n\
2307 A value of 0 means wait as long as necessary. This is initialized from the\n\
2308 \"*selectionTimeout\" resource.");
2309 x_selection_timeout = 0;
2311 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2312 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2313 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2314 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2315 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2316 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2317 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2318 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2319 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2320 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2321 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2322 QINCR = intern ("INCR"); staticpro (&QINCR);
2323 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2324 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2325 QATOM = intern ("ATOM"); staticpro (&QATOM);
2326 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2327 QNULL = intern ("NULL"); staticpro (&QNULL);
2329 #ifdef CUT_BUFFER_SUPPORT
2330 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2331 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2332 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2333 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2334 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2335 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2336 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2337 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2338 #endif