(mail-hist-previous-input, mail-hist-next-input): do the obvious code
[emacs.git] / src / xselect.c
blobac2601607812d607bbcf7f22ba9e9727f2258090
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"
35 #define CUT_BUFFER_SUPPORT
37 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
38 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
39 QATOM_PAIR;
41 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
43 #ifdef CUT_BUFFER_SUPPORT
44 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
45 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
46 #endif
48 static Lisp_Object Vx_lost_selection_hooks;
49 static Lisp_Object Vx_sent_selection_hooks;
50 /* Coding system for communicating with other X clients via cutbuffer,
51 selection, and clipboard. */
52 static Lisp_Object Vselection_coding_system;
54 /* Coding system for the next communicating with other X clients. */
55 static Lisp_Object Vnext_selection_coding_system;
57 /* If this is a smaller number than the max-request-size of the display,
58 emacs will use INCR selection transfer when the selection is larger
59 than this. The max-request-size is usually around 64k, so if you want
60 emacs to use incremental selection transfers when the selection is
61 smaller than that, set this. I added this mostly for debugging the
62 incremental transfer stuff, but it might improve server performance. */
63 #define MAX_SELECTION_QUANTUM 0xFFFFFF
65 #ifdef HAVE_X11R4
66 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
67 #else
68 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
69 #endif
71 /* The timestamp of the last input event Emacs received from the X server. */
72 /* Defined in keyboard.c. */
73 extern unsigned long last_event_timestamp;
75 /* This is an association list whose elements are of the form
76 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
77 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
78 SELECTION-VALUE is the value that emacs owns for that selection.
79 It may be any kind of Lisp object.
80 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
81 as a cons of two 16-bit numbers (making a 32 bit time.)
82 FRAME is the frame for which we made the selection.
83 If there is an entry in this alist, then it can be assumed that Emacs owns
84 that selection.
85 The only (eq) parts of this list that are visible from Lisp are the
86 selection-values. */
87 static Lisp_Object Vselection_alist;
89 /* This is an alist whose CARs are selection-types (whose names are the same
90 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
91 call to convert the given Emacs selection value to a string representing
92 the given selection type. This is for Lisp-level extension of the emacs
93 selection handling. */
94 static Lisp_Object Vselection_converter_alist;
96 /* If the selection owner takes too long to reply to a selection request,
97 we give up on it. This is in milliseconds (0 = no timeout.) */
98 static int x_selection_timeout;
100 /* Utility functions */
102 static void lisp_data_to_selection_data ();
103 static Lisp_Object selection_data_to_lisp_data ();
104 static Lisp_Object x_get_window_property_as_lisp_data ();
106 /* This converts a Lisp symbol to a server Atom, avoiding a server
107 roundtrip whenever possible. */
109 static Atom
110 symbol_to_x_atom (dpyinfo, display, sym)
111 struct x_display_info *dpyinfo;
112 Display *display;
113 Lisp_Object sym;
115 Atom val;
116 if (NILP (sym)) return 0;
117 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
118 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
119 if (EQ (sym, QSTRING)) return XA_STRING;
120 if (EQ (sym, QINTEGER)) return XA_INTEGER;
121 if (EQ (sym, QATOM)) return XA_ATOM;
122 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
123 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
124 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
125 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
126 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
127 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
128 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
129 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
130 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
131 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
132 #ifdef CUT_BUFFER_SUPPORT
133 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
134 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
135 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
136 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
137 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
138 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
139 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
140 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
141 #endif
142 if (!SYMBOLP (sym)) abort ();
144 #if 0
145 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
146 #endif
147 BLOCK_INPUT;
148 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
149 UNBLOCK_INPUT;
150 return val;
154 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
155 and calls to intern whenever possible. */
157 static Lisp_Object
158 x_atom_to_symbol (dpyinfo, display, atom)
159 struct x_display_info *dpyinfo;
160 Display *display;
161 Atom atom;
163 char *str;
164 Lisp_Object val;
165 if (! atom) return Qnil;
166 switch (atom)
168 case XA_PRIMARY:
169 return QPRIMARY;
170 case XA_SECONDARY:
171 return QSECONDARY;
172 case XA_STRING:
173 return QSTRING;
174 case XA_INTEGER:
175 return QINTEGER;
176 case XA_ATOM:
177 return QATOM;
178 #ifdef CUT_BUFFER_SUPPORT
179 case XA_CUT_BUFFER0:
180 return QCUT_BUFFER0;
181 case XA_CUT_BUFFER1:
182 return QCUT_BUFFER1;
183 case XA_CUT_BUFFER2:
184 return QCUT_BUFFER2;
185 case XA_CUT_BUFFER3:
186 return QCUT_BUFFER3;
187 case XA_CUT_BUFFER4:
188 return QCUT_BUFFER4;
189 case XA_CUT_BUFFER5:
190 return QCUT_BUFFER5;
191 case XA_CUT_BUFFER6:
192 return QCUT_BUFFER6;
193 case XA_CUT_BUFFER7:
194 return QCUT_BUFFER7;
195 #endif
198 if (atom == dpyinfo->Xatom_CLIPBOARD)
199 return QCLIPBOARD;
200 if (atom == dpyinfo->Xatom_TIMESTAMP)
201 return QTIMESTAMP;
202 if (atom == dpyinfo->Xatom_TEXT)
203 return QTEXT;
204 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
205 return QCOMPOUND_TEXT;
206 if (atom == dpyinfo->Xatom_DELETE)
207 return QDELETE;
208 if (atom == dpyinfo->Xatom_MULTIPLE)
209 return QMULTIPLE;
210 if (atom == dpyinfo->Xatom_INCR)
211 return QINCR;
212 if (atom == dpyinfo->Xatom_EMACS_TMP)
213 return QEMACS_TMP;
214 if (atom == dpyinfo->Xatom_TARGETS)
215 return QTARGETS;
216 if (atom == dpyinfo->Xatom_NULL)
217 return QNULL;
219 BLOCK_INPUT;
220 str = XGetAtomName (display, atom);
221 UNBLOCK_INPUT;
222 #if 0
223 fprintf (stderr, " XGetAtomName --> %s\n", str);
224 #endif
225 if (! str) return Qnil;
226 val = intern (str);
227 BLOCK_INPUT;
228 /* This was allocated by Xlib, so use XFree. */
229 XFree (str);
230 UNBLOCK_INPUT;
231 return val;
234 /* Do protocol to assert ourself as a selection owner.
235 Update the Vselection_alist so that we can reply to later requests for
236 our selection. */
238 static void
239 x_own_selection (selection_name, selection_value)
240 Lisp_Object selection_name, selection_value;
242 struct frame *sf = SELECTED_FRAME ();
243 Window selecting_window = FRAME_X_WINDOW (sf);
244 Display *display = FRAME_X_DISPLAY (sf);
245 Time time = last_event_timestamp;
246 Atom selection_atom;
247 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
248 int count;
250 CHECK_SYMBOL (selection_name, 0);
251 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
253 BLOCK_INPUT;
254 count = x_catch_errors (display);
255 XSetSelectionOwner (display, selection_atom, selecting_window, time);
256 x_check_errors (display, "Can't set selection: %s");
257 x_uncatch_errors (display, count);
258 UNBLOCK_INPUT;
260 /* Now update the local cache */
262 Lisp_Object selection_time;
263 Lisp_Object selection_data;
264 Lisp_Object prev_value;
266 selection_time = long_to_cons ((unsigned long) time);
267 selection_data = Fcons (selection_name,
268 Fcons (selection_value,
269 Fcons (selection_time,
270 Fcons (selected_frame, Qnil))));
271 prev_value = assq_no_quit (selection_name, Vselection_alist);
273 Vselection_alist = Fcons (selection_data, Vselection_alist);
275 /* If we already owned the selection, remove the old selection data.
276 Perhaps we should destructively modify it instead.
277 Don't use Fdelq as that may QUIT. */
278 if (!NILP (prev_value))
280 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
281 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
282 if (EQ (prev_value, Fcar (XCDR (rest))))
284 XCDR (rest) = Fcdr (XCDR (rest));
285 break;
291 /* Given a selection-name and desired type, look up our local copy of
292 the selection value and convert it to the type.
293 The value is nil or a string.
294 This function is used both for remote requests
295 and for local x-get-selection-internal.
297 This calls random Lisp code, and may signal or gc. */
299 static Lisp_Object
300 x_get_local_selection (selection_symbol, target_type)
301 Lisp_Object selection_symbol, target_type;
303 Lisp_Object local_value;
304 Lisp_Object handler_fn, value, type, check;
305 int count;
307 local_value = assq_no_quit (selection_symbol, Vselection_alist);
309 if (NILP (local_value)) return Qnil;
311 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
312 if (EQ (target_type, QTIMESTAMP))
314 handler_fn = Qnil;
315 value = XCAR (XCDR (XCDR (local_value)));
317 #if 0
318 else if (EQ (target_type, QDELETE))
320 handler_fn = Qnil;
321 Fx_disown_selection_internal
322 (selection_symbol,
323 XCAR (XCDR (XCDR (local_value))));
324 value = QNULL;
326 #endif
328 #if 0 /* #### MULTIPLE doesn't work yet */
329 else if (CONSP (target_type)
330 && XCAR (target_type) == QMULTIPLE)
332 Lisp_Object pairs;
333 int size;
334 int i;
335 pairs = XCDR (target_type);
336 size = XVECTOR (pairs)->size;
337 /* If the target is MULTIPLE, then target_type looks like
338 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
339 We modify the second element of each pair in the vector and
340 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
342 for (i = 0; i < size; i++)
344 Lisp_Object pair;
345 pair = XVECTOR (pairs)->contents [i];
346 XVECTOR (pair)->contents [1]
347 = x_get_local_selection (XVECTOR (pair)->contents [0],
348 XVECTOR (pair)->contents [1]);
350 return pairs;
352 #endif
353 else
355 /* Don't allow a quit within the converter.
356 When the user types C-g, he would be surprised
357 if by luck it came during a converter. */
358 count = specpdl_ptr - specpdl;
359 specbind (Qinhibit_quit, Qt);
361 CHECK_SYMBOL (target_type, 0);
362 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
363 if (!NILP (handler_fn))
364 value = call3 (handler_fn,
365 selection_symbol, target_type,
366 XCAR (XCDR (local_value)));
367 else
368 value = Qnil;
369 unbind_to (count, Qnil);
372 /* Make sure this value is of a type that we could transmit
373 to another X client. */
375 check = value;
376 if (CONSP (value)
377 && SYMBOLP (XCAR (value)))
378 type = XCAR (value),
379 check = XCDR (value);
381 if (STRINGP (check)
382 || VECTORP (check)
383 || SYMBOLP (check)
384 || INTEGERP (check)
385 || NILP (value))
386 return value;
387 /* Check for a value that cons_to_long could handle. */
388 else if (CONSP (check)
389 && INTEGERP (XCAR (check))
390 && (INTEGERP (XCDR (check))
392 (CONSP (XCDR (check))
393 && INTEGERP (XCAR (XCDR (check)))
394 && NILP (XCDR (XCDR (check))))))
395 return value;
396 else
397 return
398 Fsignal (Qerror,
399 Fcons (build_string ("invalid data returned by selection-conversion function"),
400 Fcons (handler_fn, Fcons (value, Qnil))));
403 /* Subroutines of x_reply_selection_request. */
405 /* Send a SelectionNotify event to the requestor with property=None,
406 meaning we were unable to do what they wanted. */
408 static void
409 x_decline_selection_request (event)
410 struct input_event *event;
412 XSelectionEvent reply;
413 reply.type = SelectionNotify;
414 reply.display = SELECTION_EVENT_DISPLAY (event);
415 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
416 reply.selection = SELECTION_EVENT_SELECTION (event);
417 reply.time = SELECTION_EVENT_TIME (event);
418 reply.target = SELECTION_EVENT_TARGET (event);
419 reply.property = None;
421 BLOCK_INPUT;
422 XSendEvent (reply.display, reply.requestor, False, 0L,
423 (XEvent *) &reply);
424 XFlush (reply.display);
425 UNBLOCK_INPUT;
428 /* This is the selection request currently being processed.
429 It is set to zero when the request is fully processed. */
430 static struct input_event *x_selection_current_request;
432 /* Used as an unwind-protect clause so that, if a selection-converter signals
433 an error, we tell the requester that we were unable to do what they wanted
434 before we throw to top-level or go into the debugger or whatever. */
436 static Lisp_Object
437 x_selection_request_lisp_error (ignore)
438 Lisp_Object ignore;
440 if (x_selection_current_request != 0)
441 x_decline_selection_request (x_selection_current_request);
442 return Qnil;
446 /* This stuff is so that INCR selections are reentrant (that is, so we can
447 be servicing multiple INCR selection requests simultaneously.) I haven't
448 actually tested that yet. */
450 /* Keep a list of the property changes that are awaited. */
452 struct prop_location
454 int identifier;
455 Display *display;
456 Window window;
457 Atom property;
458 int desired_state;
459 int arrived;
460 struct prop_location *next;
463 static struct prop_location *expect_property_change ();
464 static void wait_for_property_change ();
465 static void unexpect_property_change ();
466 static int waiting_for_other_props_on_window ();
468 static int prop_location_identifier;
470 static Lisp_Object property_change_reply;
472 static struct prop_location *property_change_reply_object;
474 static struct prop_location *property_change_wait_list;
476 static Lisp_Object
477 queue_selection_requests_unwind (frame)
478 Lisp_Object frame;
480 FRAME_PTR f = XFRAME (frame);
482 if (! NILP (frame))
483 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
484 return Qnil;
487 /* Return some frame whose display info is DPYINFO.
488 Return nil if there is none. */
490 static Lisp_Object
491 some_frame_on_display (dpyinfo)
492 struct x_display_info *dpyinfo;
494 Lisp_Object list, frame;
496 FOR_EACH_FRAME (list, frame)
498 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
499 return frame;
502 return Qnil;
505 /* Send the reply to a selection request event EVENT.
506 TYPE is the type of selection data requested.
507 DATA and SIZE describe the data to send, already converted.
508 FORMAT is the unit-size (in bits) of the data to be transmitted. */
510 static void
511 x_reply_selection_request (event, format, data, size, type)
512 struct input_event *event;
513 int format, size;
514 unsigned char *data;
515 Atom type;
517 XSelectionEvent reply;
518 Display *display = SELECTION_EVENT_DISPLAY (event);
519 Window window = SELECTION_EVENT_REQUESTOR (event);
520 int bytes_remaining;
521 int format_bytes = format/8;
522 int max_bytes = SELECTION_QUANTUM (display);
523 struct x_display_info *dpyinfo = x_display_info_for_display (display);
524 int count;
526 if (max_bytes > MAX_SELECTION_QUANTUM)
527 max_bytes = MAX_SELECTION_QUANTUM;
529 reply.type = SelectionNotify;
530 reply.display = display;
531 reply.requestor = window;
532 reply.selection = SELECTION_EVENT_SELECTION (event);
533 reply.time = SELECTION_EVENT_TIME (event);
534 reply.target = SELECTION_EVENT_TARGET (event);
535 reply.property = SELECTION_EVENT_PROPERTY (event);
536 if (reply.property == None)
537 reply.property = reply.target;
539 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
540 BLOCK_INPUT;
541 count = x_catch_errors (display);
543 /* Store the data on the requested property.
544 If the selection is large, only store the first N bytes of it.
546 bytes_remaining = size * format_bytes;
547 if (bytes_remaining <= max_bytes)
549 /* Send all the data at once, with minimal handshaking. */
550 #if 0
551 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
552 #endif
553 XChangeProperty (display, window, reply.property, type, format,
554 PropModeReplace, data, size);
555 /* At this point, the selection was successfully stored; ack it. */
556 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
558 else
560 /* Send an INCR selection. */
561 struct prop_location *wait_object;
562 int had_errors;
563 Lisp_Object frame;
565 frame = some_frame_on_display (dpyinfo);
567 /* If the display no longer has frames, we can't expect
568 to get many more selection requests from it, so don't
569 bother trying to queue them. */
570 if (!NILP (frame))
572 x_start_queuing_selection_requests (display);
574 record_unwind_protect (queue_selection_requests_unwind,
575 frame);
578 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
579 error ("Attempt to transfer an INCR to ourself!");
580 #if 0
581 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
582 #endif
583 wait_object = expect_property_change (display, window, reply.property,
584 PropertyDelete);
586 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
587 32, PropModeReplace,
588 (unsigned char *) &bytes_remaining, 1);
589 XSelectInput (display, window, PropertyChangeMask);
590 /* Tell 'em the INCR data is there... */
591 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
592 XFlush (display);
594 had_errors = x_had_errors_p (display);
595 UNBLOCK_INPUT;
597 /* First, wait for the requester to ack by deleting the property.
598 This can run random lisp code (process handlers) or signal. */
599 if (! had_errors)
600 wait_for_property_change (wait_object);
602 while (bytes_remaining)
604 int i = ((bytes_remaining < max_bytes)
605 ? bytes_remaining
606 : max_bytes);
608 BLOCK_INPUT;
610 wait_object
611 = expect_property_change (display, window, reply.property,
612 PropertyDelete);
613 #if 0
614 fprintf (stderr," INCR adding %d\n", i);
615 #endif
616 /* Append the next chunk of data to the property. */
617 XChangeProperty (display, window, reply.property, type, format,
618 PropModeAppend, data, i / format_bytes);
619 bytes_remaining -= i;
620 data += i;
621 XFlush (display);
622 had_errors = x_had_errors_p (display);
623 UNBLOCK_INPUT;
625 if (had_errors)
626 break;
628 /* Now wait for the requester to ack this chunk by deleting the
629 property. This can run random lisp code or signal.
631 wait_for_property_change (wait_object);
633 /* Now write a zero-length chunk to the property to tell the requester
634 that we're done. */
635 #if 0
636 fprintf (stderr," INCR done\n");
637 #endif
638 BLOCK_INPUT;
639 if (! waiting_for_other_props_on_window (display, window))
640 XSelectInput (display, window, 0L);
642 XChangeProperty (display, window, reply.property, type, format,
643 PropModeReplace, data, 0);
646 XFlush (display);
647 x_uncatch_errors (display, count);
648 UNBLOCK_INPUT;
651 /* Handle a SelectionRequest event EVENT.
652 This is called from keyboard.c when such an event is found in the queue. */
654 void
655 x_handle_selection_request (event)
656 struct input_event *event;
658 struct gcpro gcpro1, gcpro2, gcpro3;
659 Lisp_Object local_selection_data;
660 Lisp_Object selection_symbol;
661 Lisp_Object target_symbol;
662 Lisp_Object converted_selection;
663 Time local_selection_time;
664 Lisp_Object successful_p;
665 int count;
666 struct x_display_info *dpyinfo
667 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
669 local_selection_data = Qnil;
670 target_symbol = Qnil;
671 converted_selection = Qnil;
672 successful_p = Qnil;
674 GCPRO3 (local_selection_data, converted_selection, target_symbol);
676 selection_symbol = x_atom_to_symbol (dpyinfo,
677 SELECTION_EVENT_DISPLAY (event),
678 SELECTION_EVENT_SELECTION (event));
680 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
682 if (NILP (local_selection_data))
684 /* Someone asked for the selection, but we don't have it any more.
686 x_decline_selection_request (event);
687 goto DONE;
690 local_selection_time = (Time)
691 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
693 if (SELECTION_EVENT_TIME (event) != CurrentTime
694 && local_selection_time > SELECTION_EVENT_TIME (event))
696 /* Someone asked for the selection, and we have one, but not the one
697 they're looking for.
699 x_decline_selection_request (event);
700 goto DONE;
703 count = specpdl_ptr - specpdl;
704 x_selection_current_request = event;
705 record_unwind_protect (x_selection_request_lisp_error, Qnil);
707 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
708 SELECTION_EVENT_TARGET (event));
710 #if 0 /* #### MULTIPLE doesn't work yet */
711 if (EQ (target_symbol, QMULTIPLE))
712 target_symbol = fetch_multiple_target (event);
713 #endif
715 /* Convert lisp objects back into binary data */
717 converted_selection
718 = x_get_local_selection (selection_symbol, target_symbol);
720 if (! NILP (converted_selection))
722 unsigned char *data;
723 unsigned int size;
724 int format;
725 Atom type;
726 int nofree;
728 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
729 converted_selection,
730 &data, &type, &size, &format, &nofree);
732 x_reply_selection_request (event, format, data, size, type);
733 successful_p = Qt;
735 /* Indicate we have successfully processed this event. */
736 x_selection_current_request = 0;
738 /* Use xfree, not XFree, because lisp_data_to_selection_data
739 calls xmalloc itself. */
740 if (!nofree)
741 xfree (data);
743 unbind_to (count, Qnil);
745 DONE:
747 UNGCPRO;
749 /* Let random lisp code notice that the selection has been asked for. */
751 Lisp_Object rest;
752 rest = Vx_sent_selection_hooks;
753 if (!EQ (rest, Qunbound))
754 for (; CONSP (rest); rest = Fcdr (rest))
755 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
759 /* Handle a SelectionClear event EVENT, which indicates that some
760 client cleared out our previously asserted selection.
761 This is called from keyboard.c when such an event is found in the queue. */
763 void
764 x_handle_selection_clear (event)
765 struct input_event *event;
767 Display *display = SELECTION_EVENT_DISPLAY (event);
768 Atom selection = SELECTION_EVENT_SELECTION (event);
769 Time changed_owner_time = SELECTION_EVENT_TIME (event);
771 Lisp_Object selection_symbol, local_selection_data;
772 Time local_selection_time;
773 struct x_display_info *dpyinfo = x_display_info_for_display (display);
774 struct x_display_info *t_dpyinfo;
776 /* If the new selection owner is also Emacs,
777 don't clear the new selection. */
778 BLOCK_INPUT;
779 /* Check each display on the same terminal,
780 to see if this Emacs job now owns the selection
781 through that display. */
782 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
783 if (t_dpyinfo->kboard == dpyinfo->kboard)
785 Window owner_window
786 = XGetSelectionOwner (t_dpyinfo->display, selection);
787 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
789 UNBLOCK_INPUT;
790 return;
793 UNBLOCK_INPUT;
795 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
797 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
799 /* Well, we already believe that we don't own it, so that's just fine. */
800 if (NILP (local_selection_data)) return;
802 local_selection_time = (Time)
803 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
805 /* This SelectionClear is for a selection that we no longer own, so we can
806 disregard it. (That is, we have reasserted the selection since this
807 request was generated.) */
809 if (changed_owner_time != CurrentTime
810 && local_selection_time > changed_owner_time)
811 return;
813 /* Otherwise, we're really honest and truly being told to drop it.
814 Don't use Fdelq as that may QUIT;. */
816 if (EQ (local_selection_data, Fcar (Vselection_alist)))
817 Vselection_alist = Fcdr (Vselection_alist);
818 else
820 Lisp_Object rest;
821 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
822 if (EQ (local_selection_data, Fcar (XCDR (rest))))
824 XCDR (rest) = Fcdr (XCDR (rest));
825 break;
829 /* Let random lisp code notice that the selection has been stolen. */
832 Lisp_Object rest;
833 rest = Vx_lost_selection_hooks;
834 if (!EQ (rest, Qunbound))
836 for (; CONSP (rest); rest = Fcdr (rest))
837 call1 (Fcar (rest), selection_symbol);
838 prepare_menu_bars ();
839 redisplay_preserve_echo_area ();
844 /* Clear all selections that were made from frame F.
845 We do this when about to delete a frame. */
847 void
848 x_clear_frame_selections (f)
849 FRAME_PTR f;
851 Lisp_Object frame;
852 Lisp_Object rest;
854 XSETFRAME (frame, f);
856 /* Otherwise, we're really honest and truly being told to drop it.
857 Don't use Fdelq as that may QUIT;. */
859 /* Delete elements from the beginning of Vselection_alist. */
860 while (!NILP (Vselection_alist)
861 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
863 /* Let random Lisp code notice that the selection has been stolen. */
864 Lisp_Object hooks, selection_symbol;
866 hooks = Vx_lost_selection_hooks;
867 selection_symbol = Fcar (Fcar (Vselection_alist));
869 if (!EQ (hooks, Qunbound))
871 for (; CONSP (hooks); hooks = Fcdr (hooks))
872 call1 (Fcar (hooks), selection_symbol);
873 #if 0 /* This can crash when deleting a frame
874 from x_connection_closed. Anyway, it seems unnecessary;
875 something else should cause a redisplay. */
876 redisplay_preserve_echo_area ();
877 #endif
880 Vselection_alist = Fcdr (Vselection_alist);
883 /* Delete elements after the beginning of Vselection_alist. */
884 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
885 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
887 /* Let random Lisp code notice that the selection has been stolen. */
888 Lisp_Object hooks, selection_symbol;
890 hooks = Vx_lost_selection_hooks;
891 selection_symbol = Fcar (Fcar (XCDR (rest)));
893 if (!EQ (hooks, Qunbound))
895 for (; CONSP (hooks); hooks = Fcdr (hooks))
896 call1 (Fcar (hooks), selection_symbol);
897 #if 0 /* See above */
898 redisplay_preserve_echo_area ();
899 #endif
901 XCDR (rest) = Fcdr (XCDR (rest));
902 break;
906 /* Nonzero if any properties for DISPLAY and WINDOW
907 are on the list of what we are waiting for. */
909 static int
910 waiting_for_other_props_on_window (display, window)
911 Display *display;
912 Window window;
914 struct prop_location *rest = property_change_wait_list;
915 while (rest)
916 if (rest->display == display && rest->window == window)
917 return 1;
918 else
919 rest = rest->next;
920 return 0;
923 /* Add an entry to the list of property changes we are waiting for.
924 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
925 The return value is a number that uniquely identifies
926 this awaited property change. */
928 static struct prop_location *
929 expect_property_change (display, window, property, state)
930 Display *display;
931 Window window;
932 Atom property;
933 int state;
935 struct prop_location *pl
936 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
937 pl->identifier = ++prop_location_identifier;
938 pl->display = display;
939 pl->window = window;
940 pl->property = property;
941 pl->desired_state = state;
942 pl->next = property_change_wait_list;
943 pl->arrived = 0;
944 property_change_wait_list = pl;
945 return pl;
948 /* Delete an entry from the list of property changes we are waiting for.
949 IDENTIFIER is the number that uniquely identifies the entry. */
951 static void
952 unexpect_property_change (location)
953 struct prop_location *location;
955 struct prop_location *prev = 0, *rest = property_change_wait_list;
956 while (rest)
958 if (rest == location)
960 if (prev)
961 prev->next = rest->next;
962 else
963 property_change_wait_list = rest->next;
964 xfree (rest);
965 return;
967 prev = rest;
968 rest = rest->next;
972 /* Remove the property change expectation element for IDENTIFIER. */
974 static Lisp_Object
975 wait_for_property_change_unwind (identifierval)
976 Lisp_Object identifierval;
978 unexpect_property_change ((struct prop_location *)
979 (XFASTINT (XCAR (identifierval)) << 16
980 | XFASTINT (XCDR (identifierval))));
981 return Qnil;
984 /* Actually wait for a property change.
985 IDENTIFIER should be the value that expect_property_change returned. */
987 static void
988 wait_for_property_change (location)
989 struct prop_location *location;
991 int secs, usecs;
992 int count = specpdl_ptr - specpdl;
993 Lisp_Object tem;
995 tem = Fcons (Qnil, Qnil);
996 XSETFASTINT (XCAR (tem), (EMACS_UINT)location >> 16);
997 XSETFASTINT (XCDR (tem), (EMACS_UINT)location & 0xffff);
999 /* Make sure to do unexpect_property_change if we quit or err. */
1000 record_unwind_protect (wait_for_property_change_unwind, tem);
1002 XCAR (property_change_reply) = Qnil;
1004 property_change_reply_object = location;
1005 /* If the event we are waiting for arrives beyond here, it will set
1006 property_change_reply, because property_change_reply_object says so. */
1007 if (! location->arrived)
1009 secs = x_selection_timeout / 1000;
1010 usecs = (x_selection_timeout % 1000) * 1000;
1011 wait_reading_process_input (secs, usecs, property_change_reply, 0);
1013 if (NILP (XCAR (property_change_reply)))
1014 error ("Timed out waiting for property-notify event");
1017 unbind_to (count, Qnil);
1020 /* Called from XTread_socket in response to a PropertyNotify event. */
1022 void
1023 x_handle_property_notify (event)
1024 XPropertyEvent *event;
1026 struct prop_location *prev = 0, *rest = property_change_wait_list;
1027 while (rest)
1029 if (rest->property == event->atom
1030 && rest->window == event->window
1031 && rest->display == event->display
1032 && rest->desired_state == event->state)
1034 #if 0
1035 fprintf (stderr, "Saw expected prop-%s on %s\n",
1036 (event->state == PropertyDelete ? "delete" : "change"),
1037 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
1038 event->atom))
1039 ->name->data);
1040 #endif
1042 rest->arrived = 1;
1044 /* If this is the one wait_for_property_change is waiting for,
1045 tell it to wake up. */
1046 if (rest == property_change_reply_object)
1047 XCAR (property_change_reply) = Qt;
1049 if (prev)
1050 prev->next = rest->next;
1051 else
1052 property_change_wait_list = rest->next;
1053 xfree (rest);
1054 return;
1056 prev = rest;
1057 rest = rest->next;
1059 #if 0
1060 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1061 (event->state == PropertyDelete ? "delete" : "change"),
1062 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1063 event->display, event->atom))
1064 ->name->data);
1065 #endif
1070 #if 0 /* #### MULTIPLE doesn't work yet */
1072 static Lisp_Object
1073 fetch_multiple_target (event)
1074 XSelectionRequestEvent *event;
1076 Display *display = event->display;
1077 Window window = event->requestor;
1078 Atom target = event->target;
1079 Atom selection_atom = event->selection;
1080 int result;
1082 return
1083 Fcons (QMULTIPLE,
1084 x_get_window_property_as_lisp_data (display, window, target,
1085 QMULTIPLE, selection_atom));
1088 static Lisp_Object
1089 copy_multiple_data (obj)
1090 Lisp_Object obj;
1092 Lisp_Object vec;
1093 int i;
1094 int size;
1095 if (CONSP (obj))
1096 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1098 CHECK_VECTOR (obj, 0);
1099 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1100 for (i = 0; i < size; i++)
1102 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1103 CHECK_VECTOR (vec2, 0);
1104 if (XVECTOR (vec2)->size != 2)
1105 /* ??? Confusing error message */
1106 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1107 Fcons (vec2, Qnil)));
1108 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1109 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1110 = XVECTOR (vec2)->contents [0];
1111 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1112 = XVECTOR (vec2)->contents [1];
1114 return vec;
1117 #endif
1120 /* Variables for communication with x_handle_selection_notify. */
1121 static Atom reading_which_selection;
1122 static Lisp_Object reading_selection_reply;
1123 static Window reading_selection_window;
1125 /* Do protocol to read selection-data from the server.
1126 Converts this to Lisp data and returns it. */
1128 static Lisp_Object
1129 x_get_foreign_selection (selection_symbol, target_type)
1130 Lisp_Object selection_symbol, target_type;
1132 struct frame *sf = SELECTED_FRAME ();
1133 Window requestor_window = FRAME_X_WINDOW (sf);
1134 Display *display = FRAME_X_DISPLAY (sf);
1135 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1136 Time requestor_time = last_event_timestamp;
1137 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1138 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1139 Atom type_atom;
1140 int secs, usecs;
1141 int count;
1142 Lisp_Object frame;
1144 if (CONSP (target_type))
1145 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1146 else
1147 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1149 BLOCK_INPUT;
1150 count = x_catch_errors (display);
1151 XConvertSelection (display, selection_atom, type_atom, target_property,
1152 requestor_window, requestor_time);
1153 XFlush (display);
1155 /* Prepare to block until the reply has been read. */
1156 reading_selection_window = requestor_window;
1157 reading_which_selection = selection_atom;
1158 XCAR (reading_selection_reply) = Qnil;
1160 frame = some_frame_on_display (dpyinfo);
1162 /* If the display no longer has frames, we can't expect
1163 to get many more selection requests from it, so don't
1164 bother trying to queue them. */
1165 if (!NILP (frame))
1167 x_start_queuing_selection_requests (display);
1169 record_unwind_protect (queue_selection_requests_unwind,
1170 frame);
1172 UNBLOCK_INPUT;
1174 /* This allows quits. Also, don't wait forever. */
1175 secs = x_selection_timeout / 1000;
1176 usecs = (x_selection_timeout % 1000) * 1000;
1177 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1179 BLOCK_INPUT;
1180 x_check_errors (display, "Cannot get selection: %s");
1181 x_uncatch_errors (display, count);
1182 UNBLOCK_INPUT;
1184 if (NILP (XCAR (reading_selection_reply)))
1185 error ("Timed out waiting for reply from selection owner");
1186 if (EQ (XCAR (reading_selection_reply), Qlambda))
1187 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
1189 /* Otherwise, the selection is waiting for us on the requested property. */
1190 return
1191 x_get_window_property_as_lisp_data (display, requestor_window,
1192 target_property, target_type,
1193 selection_atom);
1196 /* Subroutines of x_get_window_property_as_lisp_data */
1198 /* Use xfree, not XFree, to free the data obtained with this function. */
1200 static void
1201 x_get_window_property (display, window, property, data_ret, bytes_ret,
1202 actual_type_ret, actual_format_ret, actual_size_ret,
1203 delete_p)
1204 Display *display;
1205 Window window;
1206 Atom property;
1207 unsigned char **data_ret;
1208 int *bytes_ret;
1209 Atom *actual_type_ret;
1210 int *actual_format_ret;
1211 unsigned long *actual_size_ret;
1212 int delete_p;
1214 int total_size;
1215 unsigned long bytes_remaining;
1216 int offset = 0;
1217 unsigned char *tmp_data = 0;
1218 int result;
1219 int buffer_size = SELECTION_QUANTUM (display);
1220 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1222 BLOCK_INPUT;
1223 /* First probe the thing to find out how big it is. */
1224 result = XGetWindowProperty (display, window, property,
1225 0L, 0L, False, AnyPropertyType,
1226 actual_type_ret, actual_format_ret,
1227 actual_size_ret,
1228 &bytes_remaining, &tmp_data);
1229 if (result != Success)
1231 UNBLOCK_INPUT;
1232 *data_ret = 0;
1233 *bytes_ret = 0;
1234 return;
1236 /* This was allocated by Xlib, so use XFree. */
1237 XFree ((char *) tmp_data);
1239 if (*actual_type_ret == None || *actual_format_ret == 0)
1241 UNBLOCK_INPUT;
1242 return;
1245 total_size = bytes_remaining + 1;
1246 *data_ret = (unsigned char *) xmalloc (total_size);
1248 /* Now read, until we've gotten it all. */
1249 while (bytes_remaining)
1251 #if 0
1252 int last = bytes_remaining;
1253 #endif
1254 result
1255 = XGetWindowProperty (display, window, property,
1256 (long)offset/4, (long)buffer_size/4,
1257 False,
1258 AnyPropertyType,
1259 actual_type_ret, actual_format_ret,
1260 actual_size_ret, &bytes_remaining, &tmp_data);
1261 #if 0
1262 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1263 #endif
1264 /* If this doesn't return Success at this point, it means that
1265 some clod deleted the selection while we were in the midst of
1266 reading it. Deal with that, I guess....
1268 if (result != Success) break;
1269 *actual_size_ret *= *actual_format_ret / 8;
1270 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1271 offset += *actual_size_ret;
1272 /* This was allocated by Xlib, so use XFree. */
1273 XFree ((char *) tmp_data);
1276 XFlush (display);
1277 UNBLOCK_INPUT;
1278 *bytes_ret = offset;
1281 /* Use xfree, not XFree, to free the data obtained with this function. */
1283 static void
1284 receive_incremental_selection (display, window, property, target_type,
1285 min_size_bytes, data_ret, size_bytes_ret,
1286 type_ret, format_ret, size_ret)
1287 Display *display;
1288 Window window;
1289 Atom property;
1290 Lisp_Object target_type; /* for error messages only */
1291 unsigned int min_size_bytes;
1292 unsigned char **data_ret;
1293 int *size_bytes_ret;
1294 Atom *type_ret;
1295 unsigned long *size_ret;
1296 int *format_ret;
1298 int offset = 0;
1299 struct prop_location *wait_object;
1300 *size_bytes_ret = min_size_bytes;
1301 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1302 #if 0
1303 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1304 #endif
1306 /* At this point, we have read an INCR property.
1307 Delete the property to ack it.
1308 (But first, prepare to receive the next event in this handshake.)
1310 Now, we must loop, waiting for the sending window to put a value on
1311 that property, then reading the property, then deleting it to ack.
1312 We are done when the sender places a property of length 0.
1314 BLOCK_INPUT;
1315 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1316 XDeleteProperty (display, window, property);
1317 wait_object = expect_property_change (display, window, property,
1318 PropertyNewValue);
1319 XFlush (display);
1320 UNBLOCK_INPUT;
1322 while (1)
1324 unsigned char *tmp_data;
1325 int tmp_size_bytes;
1326 wait_for_property_change (wait_object);
1327 /* expect it again immediately, because x_get_window_property may
1328 .. no it won't, I don't get it.
1329 .. Ok, I get it now, the Xt code that implements INCR is broken.
1331 x_get_window_property (display, window, property,
1332 &tmp_data, &tmp_size_bytes,
1333 type_ret, format_ret, size_ret, 1);
1335 if (tmp_size_bytes == 0) /* we're done */
1337 #if 0
1338 fprintf (stderr, " read INCR done\n");
1339 #endif
1340 if (! waiting_for_other_props_on_window (display, window))
1341 XSelectInput (display, window, STANDARD_EVENT_SET);
1342 unexpect_property_change (wait_object);
1343 /* Use xfree, not XFree, because x_get_window_property
1344 calls xmalloc itself. */
1345 if (tmp_data) xfree (tmp_data);
1346 break;
1349 BLOCK_INPUT;
1350 XDeleteProperty (display, window, property);
1351 wait_object = expect_property_change (display, window, property,
1352 PropertyNewValue);
1353 XFlush (display);
1354 UNBLOCK_INPUT;
1356 #if 0
1357 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1358 #endif
1359 if (*size_bytes_ret < offset + tmp_size_bytes)
1361 #if 0
1362 fprintf (stderr, " read INCR realloc %d -> %d\n",
1363 *size_bytes_ret, offset + tmp_size_bytes);
1364 #endif
1365 *size_bytes_ret = offset + tmp_size_bytes;
1366 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1368 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1369 offset += tmp_size_bytes;
1370 /* Use xfree, not XFree, because x_get_window_property
1371 calls xmalloc itself. */
1372 xfree (tmp_data);
1376 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1377 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1378 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1380 static Lisp_Object
1381 x_get_window_property_as_lisp_data (display, window, property, target_type,
1382 selection_atom)
1383 Display *display;
1384 Window window;
1385 Atom property;
1386 Lisp_Object target_type; /* for error messages only */
1387 Atom selection_atom; /* for error messages only */
1389 Atom actual_type;
1390 int actual_format;
1391 unsigned long actual_size;
1392 unsigned char *data = 0;
1393 int bytes = 0;
1394 Lisp_Object val;
1395 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1397 x_get_window_property (display, window, property, &data, &bytes,
1398 &actual_type, &actual_format, &actual_size, 1);
1399 if (! data)
1401 int there_is_a_selection_owner;
1402 BLOCK_INPUT;
1403 there_is_a_selection_owner
1404 = XGetSelectionOwner (display, selection_atom);
1405 UNBLOCK_INPUT;
1406 Fsignal (Qerror,
1407 there_is_a_selection_owner
1408 ? Fcons (build_string ("selection owner couldn't convert"),
1409 actual_type
1410 ? Fcons (target_type,
1411 Fcons (x_atom_to_symbol (dpyinfo, display,
1412 actual_type),
1413 Qnil))
1414 : Fcons (target_type, Qnil))
1415 : Fcons (build_string ("no selection"),
1416 Fcons (x_atom_to_symbol (dpyinfo, display,
1417 selection_atom),
1418 Qnil)));
1421 if (actual_type == dpyinfo->Xatom_INCR)
1423 /* That wasn't really the data, just the beginning. */
1425 unsigned int min_size_bytes = * ((unsigned int *) data);
1426 BLOCK_INPUT;
1427 /* Use xfree, not XFree, because x_get_window_property
1428 calls xmalloc itself. */
1429 xfree ((char *) data);
1430 UNBLOCK_INPUT;
1431 receive_incremental_selection (display, window, property, target_type,
1432 min_size_bytes, &data, &bytes,
1433 &actual_type, &actual_format,
1434 &actual_size);
1437 BLOCK_INPUT;
1438 XDeleteProperty (display, window, property);
1439 XFlush (display);
1440 UNBLOCK_INPUT;
1442 /* It's been read. Now convert it to a lisp object in some semi-rational
1443 manner. */
1444 val = selection_data_to_lisp_data (display, data, bytes,
1445 actual_type, actual_format);
1447 /* Use xfree, not XFree, because x_get_window_property
1448 calls xmalloc itself. */
1449 xfree ((char *) data);
1450 return val;
1453 /* These functions convert from the selection data read from the server into
1454 something that we can use from Lisp, and vice versa.
1456 Type: Format: Size: Lisp Type:
1457 ----- ------- ----- -----------
1458 * 8 * String
1459 ATOM 32 1 Symbol
1460 ATOM 32 > 1 Vector of Symbols
1461 * 16 1 Integer
1462 * 16 > 1 Vector of Integers
1463 * 32 1 if <=16 bits: Integer
1464 if > 16 bits: Cons of top16, bot16
1465 * 32 > 1 Vector of the above
1467 When converting a Lisp number to C, it is assumed to be of format 16 if
1468 it is an integer, and of format 32 if it is a cons of two integers.
1470 When converting a vector of numbers from Lisp to C, it is assumed to be
1471 of format 16 if every element in the vector is an integer, and is assumed
1472 to be of format 32 if any element is a cons of two integers.
1474 When converting an object to C, it may be of the form (SYMBOL . <data>)
1475 where SYMBOL is what we should claim that the type is. Format and
1476 representation are as above. */
1480 static Lisp_Object
1481 selection_data_to_lisp_data (display, data, size, type, format)
1482 Display *display;
1483 unsigned char *data;
1484 Atom type;
1485 int size, format;
1487 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1489 if (type == dpyinfo->Xatom_NULL)
1490 return QNULL;
1492 /* Convert any 8-bit data to a string, for compactness. */
1493 else if (format == 8)
1495 Lisp_Object str;
1496 int require_encoding = 0;
1498 if (
1499 #if 1
1501 #else
1502 ! NILP (buffer_defaults.enable_multibyte_characters)
1503 #endif
1506 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode
1507 DATA to Emacs internal format because DATA may be encoded
1508 in compound text format. In addtion, if TYPE is `STRING'
1509 and DATA contains any 8-bit Latin-1 code, we should also
1510 decode it. */
1511 if (type == dpyinfo->Xatom_TEXT
1512 || type == dpyinfo->Xatom_COMPOUND_TEXT)
1513 require_encoding = 1;
1514 else if (type == XA_STRING)
1516 int i;
1517 for (i = 0; i < size; i++)
1519 if (data[i] >= 0x80)
1521 require_encoding = 1;
1522 break;
1527 if (!require_encoding)
1529 str = make_unibyte_string ((char *) data, size);
1530 Vlast_coding_system_used = Qraw_text;
1532 else
1534 int bufsize;
1535 unsigned char *buf;
1536 struct coding_system coding;
1538 if (NILP (Vnext_selection_coding_system))
1539 Vnext_selection_coding_system = Vselection_coding_system;
1540 setup_coding_system
1541 (Fcheck_coding_system(Vnext_selection_coding_system), &coding);
1542 coding.src_multibyte = 0;
1543 coding.dst_multibyte = 1;
1544 Vnext_selection_coding_system = Qnil;
1545 coding.mode |= CODING_MODE_LAST_BLOCK;
1546 bufsize = decoding_buffer_size (&coding, size);
1547 buf = (unsigned char *) xmalloc (bufsize);
1548 decode_coding (&coding, data, buf, size, bufsize);
1549 str = make_string_from_bytes ((char *) buf,
1550 coding.produced_char, coding.produced);
1551 xfree (buf);
1552 Vlast_coding_system_used = coding.symbol;
1554 return str;
1556 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1557 a vector of symbols.
1559 else if (type == XA_ATOM)
1561 int i;
1562 if (size == sizeof (Atom))
1563 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
1564 else
1566 Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
1567 make_number (0));
1568 for (i = 0; i < size / sizeof (Atom); i++)
1569 Faset (v, make_number (i),
1570 x_atom_to_symbol (dpyinfo, display, ((Atom *) data) [i]));
1571 return v;
1575 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1576 If the number is > 16 bits, convert it to a cons of integers,
1577 16 bits in each half.
1579 else if (format == 32 && size == sizeof (long))
1580 return long_to_cons (((unsigned long *) data) [0]);
1581 else if (format == 16 && size == sizeof (short))
1582 return make_number ((int) (((unsigned short *) data) [0]));
1584 /* Convert any other kind of data to a vector of numbers, represented
1585 as above (as an integer, or a cons of two 16 bit integers.)
1587 else if (format == 16)
1589 int i;
1590 Lisp_Object v;
1591 v = Fmake_vector (make_number (size / 2), make_number (0));
1592 for (i = 0; i < size / 2; i++)
1594 int j = (int) ((unsigned short *) data) [i];
1595 Faset (v, make_number (i), make_number (j));
1597 return v;
1599 else
1601 int i;
1602 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1603 for (i = 0; i < size / 4; i++)
1605 unsigned long j = ((unsigned long *) data) [i];
1606 Faset (v, make_number (i), long_to_cons (j));
1608 return v;
1613 /* Use xfree, not XFree, to free the data obtained with this function. */
1615 static void
1616 lisp_data_to_selection_data (display, obj,
1617 data_ret, type_ret, size_ret,
1618 format_ret, nofree_ret)
1619 Display *display;
1620 Lisp_Object obj;
1621 unsigned char **data_ret;
1622 Atom *type_ret;
1623 unsigned int *size_ret;
1624 int *format_ret;
1625 int *nofree_ret;
1627 Lisp_Object type = Qnil;
1628 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1630 *nofree_ret = 0;
1632 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1634 type = XCAR (obj);
1635 obj = XCDR (obj);
1636 if (CONSP (obj) && NILP (XCDR (obj)))
1637 obj = XCAR (obj);
1640 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1641 { /* This is not the same as declining */
1642 *format_ret = 32;
1643 *size_ret = 0;
1644 *data_ret = 0;
1645 type = QNULL;
1647 else if (STRINGP (obj))
1649 /* Since we are now handling multilingual text, we must consider
1650 sending back compound text. */
1651 int stringp;
1653 if (NILP (Vnext_selection_coding_system))
1654 Vnext_selection_coding_system = Vselection_coding_system;
1656 *format_ret = 8;
1657 *data_ret = x_encode_text (obj, Vnext_selection_coding_system,
1658 (int *) size_ret, &stringp);
1659 *nofree_ret = (*data_ret == XSTRING (obj)->data);
1660 if (NILP (type))
1661 type = (stringp ? QSTRING : QCOMPOUND_TEXT);
1662 Vlast_coding_system_used = (*nofree_ret
1663 ? Qraw_text
1664 : Vnext_selection_coding_system);
1665 Vnext_selection_coding_system = Qnil;
1667 else if (SYMBOLP (obj))
1669 *format_ret = 32;
1670 *size_ret = 1;
1671 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1672 (*data_ret) [sizeof (Atom)] = 0;
1673 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1674 if (NILP (type)) type = QATOM;
1676 else if (INTEGERP (obj)
1677 && XINT (obj) < 0xFFFF
1678 && XINT (obj) > -0xFFFF)
1680 *format_ret = 16;
1681 *size_ret = 1;
1682 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1683 (*data_ret) [sizeof (short)] = 0;
1684 (*(short **) data_ret) [0] = (short) XINT (obj);
1685 if (NILP (type)) type = QINTEGER;
1687 else if (INTEGERP (obj)
1688 || (CONSP (obj) && INTEGERP (XCAR (obj))
1689 && (INTEGERP (XCDR (obj))
1690 || (CONSP (XCDR (obj))
1691 && INTEGERP (XCAR (XCDR (obj)))))))
1693 *format_ret = 32;
1694 *size_ret = 1;
1695 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1696 (*data_ret) [sizeof (long)] = 0;
1697 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1698 if (NILP (type)) type = QINTEGER;
1700 else if (VECTORP (obj))
1702 /* Lisp_Vectors may represent a set of ATOMs;
1703 a set of 16 or 32 bit INTEGERs;
1704 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1706 int i;
1708 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1709 /* This vector is an ATOM set */
1711 if (NILP (type)) type = QATOM;
1712 *size_ret = XVECTOR (obj)->size;
1713 *format_ret = 32;
1714 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1715 for (i = 0; i < *size_ret; i++)
1716 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1717 (*(Atom **) data_ret) [i]
1718 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1719 else
1720 Fsignal (Qerror, /* Qselection_error */
1721 Fcons (build_string
1722 ("all elements of selection vector must have same type"),
1723 Fcons (obj, Qnil)));
1725 #if 0 /* #### MULTIPLE doesn't work yet */
1726 else if (VECTORP (XVECTOR (obj)->contents [0]))
1727 /* This vector is an ATOM_PAIR set */
1729 if (NILP (type)) type = QATOM_PAIR;
1730 *size_ret = XVECTOR (obj)->size;
1731 *format_ret = 32;
1732 *data_ret = (unsigned char *)
1733 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1734 for (i = 0; i < *size_ret; i++)
1735 if (VECTORP (XVECTOR (obj)->contents [i]))
1737 Lisp_Object pair = XVECTOR (obj)->contents [i];
1738 if (XVECTOR (pair)->size != 2)
1739 Fsignal (Qerror,
1740 Fcons (build_string
1741 ("elements of the vector must be vectors of exactly two elements"),
1742 Fcons (pair, Qnil)));
1744 (*(Atom **) data_ret) [i * 2]
1745 = symbol_to_x_atom (dpyinfo, display,
1746 XVECTOR (pair)->contents [0]);
1747 (*(Atom **) data_ret) [(i * 2) + 1]
1748 = symbol_to_x_atom (dpyinfo, display,
1749 XVECTOR (pair)->contents [1]);
1751 else
1752 Fsignal (Qerror,
1753 Fcons (build_string
1754 ("all elements of the vector must be of the same type"),
1755 Fcons (obj, Qnil)));
1758 #endif
1759 else
1760 /* This vector is an INTEGER set, or something like it */
1762 *size_ret = XVECTOR (obj)->size;
1763 if (NILP (type)) type = QINTEGER;
1764 *format_ret = 16;
1765 for (i = 0; i < *size_ret; i++)
1766 if (CONSP (XVECTOR (obj)->contents [i]))
1767 *format_ret = 32;
1768 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1769 Fsignal (Qerror, /* Qselection_error */
1770 Fcons (build_string
1771 ("elements of selection vector must be integers or conses of integers"),
1772 Fcons (obj, Qnil)));
1774 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1775 for (i = 0; i < *size_ret; i++)
1776 if (*format_ret == 32)
1777 (*((unsigned long **) data_ret)) [i]
1778 = cons_to_long (XVECTOR (obj)->contents [i]);
1779 else
1780 (*((unsigned short **) data_ret)) [i]
1781 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1784 else
1785 Fsignal (Qerror, /* Qselection_error */
1786 Fcons (build_string ("unrecognised selection data"),
1787 Fcons (obj, Qnil)));
1789 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1792 static Lisp_Object
1793 clean_local_selection_data (obj)
1794 Lisp_Object obj;
1796 if (CONSP (obj)
1797 && INTEGERP (XCAR (obj))
1798 && CONSP (XCDR (obj))
1799 && INTEGERP (XCAR (XCDR (obj)))
1800 && NILP (XCDR (XCDR (obj))))
1801 obj = Fcons (XCAR (obj), XCDR (obj));
1803 if (CONSP (obj)
1804 && INTEGERP (XCAR (obj))
1805 && INTEGERP (XCDR (obj)))
1807 if (XINT (XCAR (obj)) == 0)
1808 return XCDR (obj);
1809 if (XINT (XCAR (obj)) == -1)
1810 return make_number (- XINT (XCDR (obj)));
1812 if (VECTORP (obj))
1814 int i;
1815 int size = XVECTOR (obj)->size;
1816 Lisp_Object copy;
1817 if (size == 1)
1818 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1819 copy = Fmake_vector (make_number (size), Qnil);
1820 for (i = 0; i < size; i++)
1821 XVECTOR (copy)->contents [i]
1822 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1823 return copy;
1825 return obj;
1828 /* Called from XTread_socket to handle SelectionNotify events.
1829 If it's the selection we are waiting for, stop waiting
1830 by setting the car of reading_selection_reply to non-nil.
1831 We store t there if the reply is successful, lambda if not. */
1833 void
1834 x_handle_selection_notify (event)
1835 XSelectionEvent *event;
1837 if (event->requestor != reading_selection_window)
1838 return;
1839 if (event->selection != reading_which_selection)
1840 return;
1842 XCAR (reading_selection_reply)
1843 = (event->property != 0 ? Qt : Qlambda);
1847 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
1848 Sx_own_selection_internal, 2, 2, 0,
1849 "Assert an X selection of the given TYPE with the given VALUE.\n\
1850 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1851 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1852 VALUE is typically a string, or a cons of two markers, but may be\n\
1853 anything that the functions on `selection-converter-alist' know about.")
1854 (selection_name, selection_value)
1855 Lisp_Object selection_name, selection_value;
1857 check_x ();
1858 CHECK_SYMBOL (selection_name, 0);
1859 if (NILP (selection_value)) error ("selection-value may not be nil");
1860 x_own_selection (selection_name, selection_value);
1861 return selection_value;
1865 /* Request the selection value from the owner. If we are the owner,
1866 simply return our selection value. If we are not the owner, this
1867 will block until all of the data has arrived. */
1869 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
1870 Sx_get_selection_internal, 2, 2, 0,
1871 "Return text selected from some X window.\n\
1872 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1873 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1874 TYPE is the type of data desired, typically `STRING'.")
1875 (selection_symbol, target_type)
1876 Lisp_Object selection_symbol, target_type;
1878 Lisp_Object val = Qnil;
1879 struct gcpro gcpro1, gcpro2;
1880 GCPRO2 (target_type, val); /* we store newly consed data into these */
1881 check_x ();
1882 CHECK_SYMBOL (selection_symbol, 0);
1884 #if 0 /* #### MULTIPLE doesn't work yet */
1885 if (CONSP (target_type)
1886 && XCAR (target_type) == QMULTIPLE)
1888 CHECK_VECTOR (XCDR (target_type), 0);
1889 /* So we don't destructively modify this... */
1890 target_type = copy_multiple_data (target_type);
1892 else
1893 #endif
1894 CHECK_SYMBOL (target_type, 0);
1896 val = x_get_local_selection (selection_symbol, target_type);
1898 if (NILP (val))
1900 val = x_get_foreign_selection (selection_symbol, target_type);
1901 goto DONE;
1904 if (CONSP (val)
1905 && SYMBOLP (XCAR (val)))
1907 val = XCDR (val);
1908 if (CONSP (val) && NILP (XCDR (val)))
1909 val = XCAR (val);
1911 val = clean_local_selection_data (val);
1912 DONE:
1913 UNGCPRO;
1914 return val;
1917 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
1918 Sx_disown_selection_internal, 1, 2, 0,
1919 "If we own the selection SELECTION, disown it.\n\
1920 Disowning it means there is no such selection.")
1921 (selection, time)
1922 Lisp_Object selection;
1923 Lisp_Object time;
1925 Time timestamp;
1926 Atom selection_atom;
1927 struct selection_input_event event;
1928 Display *display;
1929 struct x_display_info *dpyinfo;
1930 struct frame *sf = SELECTED_FRAME ();
1932 check_x ();
1933 display = FRAME_X_DISPLAY (sf);
1934 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1935 CHECK_SYMBOL (selection, 0);
1936 if (NILP (time))
1937 timestamp = last_event_timestamp;
1938 else
1939 timestamp = cons_to_long (time);
1941 if (NILP (assq_no_quit (selection, Vselection_alist)))
1942 return Qnil; /* Don't disown the selection when we're not the owner. */
1944 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
1946 BLOCK_INPUT;
1947 XSetSelectionOwner (display, selection_atom, None, timestamp);
1948 UNBLOCK_INPUT;
1950 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1951 generated for a window which owns the selection when that window sets
1952 the selection owner to None. The NCD server does, the MIT Sun4 server
1953 doesn't. So we synthesize one; this means we might get two, but
1954 that's ok, because the second one won't have any effect. */
1955 SELECTION_EVENT_DISPLAY (&event) = display;
1956 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1957 SELECTION_EVENT_TIME (&event) = timestamp;
1958 x_handle_selection_clear ((struct input_event *) &event);
1960 return Qt;
1963 /* Get rid of all the selections in buffer BUFFER.
1964 This is used when we kill a buffer. */
1966 void
1967 x_disown_buffer_selections (buffer)
1968 Lisp_Object buffer;
1970 Lisp_Object tail;
1971 struct buffer *buf = XBUFFER (buffer);
1973 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
1975 Lisp_Object elt, value;
1976 elt = XCAR (tail);
1977 value = XCDR (elt);
1978 if (CONSP (value) && MARKERP (XCAR (value))
1979 && XMARKER (XCAR (value))->buffer == buf)
1980 Fx_disown_selection_internal (XCAR (elt), Qnil);
1984 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1985 0, 1, 0,
1986 "Whether the current Emacs process owns the given X Selection.\n\
1987 The arg should be the name of the selection in question, typically one of\n\
1988 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1989 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1990 For convenience, the symbol nil is the same as `PRIMARY',\n\
1991 and t is the same as `SECONDARY'.)")
1992 (selection)
1993 Lisp_Object selection;
1995 check_x ();
1996 CHECK_SYMBOL (selection, 0);
1997 if (EQ (selection, Qnil)) selection = QPRIMARY;
1998 if (EQ (selection, Qt)) selection = QSECONDARY;
2000 if (NILP (Fassq (selection, Vselection_alist)))
2001 return Qnil;
2002 return Qt;
2005 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2006 0, 1, 0,
2007 "Whether there is an owner for the given X Selection.\n\
2008 The arg should be the name of the selection in question, typically one of\n\
2009 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
2010 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
2011 For convenience, the symbol nil is the same as `PRIMARY',\n\
2012 and t is the same as `SECONDARY'.)")
2013 (selection)
2014 Lisp_Object selection;
2016 Window owner;
2017 Atom atom;
2018 Display *dpy;
2019 struct frame *sf = SELECTED_FRAME ();
2021 /* It should be safe to call this before we have an X frame. */
2022 if (! FRAME_X_P (sf))
2023 return Qnil;
2025 dpy = FRAME_X_DISPLAY (sf);
2026 CHECK_SYMBOL (selection, 0);
2027 if (!NILP (Fx_selection_owner_p (selection)))
2028 return Qt;
2029 if (EQ (selection, Qnil)) selection = QPRIMARY;
2030 if (EQ (selection, Qt)) selection = QSECONDARY;
2031 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2032 if (atom == 0)
2033 return Qnil;
2034 BLOCK_INPUT;
2035 owner = XGetSelectionOwner (dpy, atom);
2036 UNBLOCK_INPUT;
2037 return (owner ? Qt : Qnil);
2041 #ifdef CUT_BUFFER_SUPPORT
2043 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2044 static void
2045 initialize_cut_buffers (display, window)
2046 Display *display;
2047 Window window;
2049 unsigned char *data = (unsigned char *) "";
2050 BLOCK_INPUT;
2051 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2052 PropModeAppend, data, 0)
2053 FROB (XA_CUT_BUFFER0);
2054 FROB (XA_CUT_BUFFER1);
2055 FROB (XA_CUT_BUFFER2);
2056 FROB (XA_CUT_BUFFER3);
2057 FROB (XA_CUT_BUFFER4);
2058 FROB (XA_CUT_BUFFER5);
2059 FROB (XA_CUT_BUFFER6);
2060 FROB (XA_CUT_BUFFER7);
2061 #undef FROB
2062 UNBLOCK_INPUT;
2066 #define CHECK_CUT_BUFFER(symbol,n) \
2067 { CHECK_SYMBOL ((symbol), (n)); \
2068 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2069 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2070 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2071 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2072 Fsignal (Qerror, \
2073 Fcons (build_string ("doesn't name a cut buffer"), \
2074 Fcons ((symbol), Qnil))); \
2077 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2078 Sx_get_cut_buffer_internal, 1, 1, 0,
2079 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
2080 (buffer)
2081 Lisp_Object buffer;
2083 Window window;
2084 Atom buffer_atom;
2085 unsigned char *data;
2086 int bytes;
2087 Atom type;
2088 int format;
2089 unsigned long size;
2090 Lisp_Object ret;
2091 Display *display;
2092 struct x_display_info *dpyinfo;
2093 struct frame *sf = SELECTED_FRAME ();
2095 check_x ();
2096 display = FRAME_X_DISPLAY (sf);
2097 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2098 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2099 CHECK_CUT_BUFFER (buffer, 0);
2100 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2102 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2103 &type, &format, &size, 0);
2104 if (!data || !format)
2105 return Qnil;
2107 if (format != 8 || type != XA_STRING)
2108 Fsignal (Qerror,
2109 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2110 Fcons (x_atom_to_symbol (dpyinfo, display, type),
2111 Fcons (make_number (format), Qnil))));
2113 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2114 /* Use xfree, not XFree, because x_get_window_property
2115 calls xmalloc itself. */
2116 xfree (data);
2117 return ret;
2121 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2122 Sx_store_cut_buffer_internal, 2, 2, 0,
2123 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2124 (buffer, string)
2125 Lisp_Object buffer, string;
2127 Window window;
2128 Atom buffer_atom;
2129 unsigned char *data;
2130 int bytes;
2131 int bytes_remaining;
2132 int max_bytes;
2133 Display *display;
2134 struct frame *sf = SELECTED_FRAME ();
2136 check_x ();
2137 display = FRAME_X_DISPLAY (sf);
2138 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2140 max_bytes = SELECTION_QUANTUM (display);
2141 if (max_bytes > MAX_SELECTION_QUANTUM)
2142 max_bytes = MAX_SELECTION_QUANTUM;
2144 CHECK_CUT_BUFFER (buffer, 0);
2145 CHECK_STRING (string, 0);
2146 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2147 display, buffer);
2148 data = (unsigned char *) XSTRING (string)->data;
2149 bytes = STRING_BYTES (XSTRING (string));
2150 bytes_remaining = bytes;
2152 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2154 initialize_cut_buffers (display, window);
2155 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2158 BLOCK_INPUT;
2160 /* Don't mess up with an empty value. */
2161 if (!bytes_remaining)
2162 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2163 PropModeReplace, data, 0);
2165 while (bytes_remaining)
2167 int chunk = (bytes_remaining < max_bytes
2168 ? bytes_remaining : max_bytes);
2169 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2170 (bytes_remaining == bytes
2171 ? PropModeReplace
2172 : PropModeAppend),
2173 data, chunk);
2174 data += chunk;
2175 bytes_remaining -= chunk;
2177 UNBLOCK_INPUT;
2178 return string;
2182 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2183 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2184 "Rotate the values of the cut buffers by the given number of step.\n\
2185 Positive means shift the values forward, negative means backward.")
2187 Lisp_Object n;
2189 Window window;
2190 Atom props[8];
2191 Display *display;
2192 struct frame *sf = SELECTED_FRAME ();
2194 check_x ();
2195 display = FRAME_X_DISPLAY (sf);
2196 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2197 CHECK_NUMBER (n, 0);
2198 if (XINT (n) == 0)
2199 return n;
2200 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2202 initialize_cut_buffers (display, window);
2203 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2206 props[0] = XA_CUT_BUFFER0;
2207 props[1] = XA_CUT_BUFFER1;
2208 props[2] = XA_CUT_BUFFER2;
2209 props[3] = XA_CUT_BUFFER3;
2210 props[4] = XA_CUT_BUFFER4;
2211 props[5] = XA_CUT_BUFFER5;
2212 props[6] = XA_CUT_BUFFER6;
2213 props[7] = XA_CUT_BUFFER7;
2214 BLOCK_INPUT;
2215 XRotateWindowProperties (display, window, props, 8, XINT (n));
2216 UNBLOCK_INPUT;
2217 return n;
2220 #endif
2222 void
2223 syms_of_xselect ()
2225 defsubr (&Sx_get_selection_internal);
2226 defsubr (&Sx_own_selection_internal);
2227 defsubr (&Sx_disown_selection_internal);
2228 defsubr (&Sx_selection_owner_p);
2229 defsubr (&Sx_selection_exists_p);
2231 #ifdef CUT_BUFFER_SUPPORT
2232 defsubr (&Sx_get_cut_buffer_internal);
2233 defsubr (&Sx_store_cut_buffer_internal);
2234 defsubr (&Sx_rotate_cut_buffers_internal);
2235 #endif
2237 reading_selection_reply = Fcons (Qnil, Qnil);
2238 staticpro (&reading_selection_reply);
2239 reading_selection_window = 0;
2240 reading_which_selection = 0;
2242 property_change_wait_list = 0;
2243 prop_location_identifier = 0;
2244 property_change_reply = Fcons (Qnil, Qnil);
2245 staticpro (&property_change_reply);
2247 Vselection_alist = Qnil;
2248 staticpro (&Vselection_alist);
2250 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2251 "An alist associating X Windows selection-types with functions.\n\
2252 These functions are called to convert the selection, with three args:\n\
2253 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2254 a desired type to which the selection should be converted;\n\
2255 and the local selection value (whatever was given to `x-own-selection').\n\
2257 The function should return the value to send to the X server\n\
2258 \(typically a string). A return value of nil\n\
2259 means that the conversion could not be done.\n\
2260 A return value which is the symbol `NULL'\n\
2261 means that a side-effect was executed,\n\
2262 and there is no meaningful selection value.");
2263 Vselection_converter_alist = Qnil;
2265 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2266 "A list of functions to be called when Emacs loses an X selection.\n\
2267 \(This happens when some other X client makes its own selection\n\
2268 or when a Lisp program explicitly clears the selection.)\n\
2269 The functions are called with one argument, the selection type\n\
2270 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2271 Vx_lost_selection_hooks = Qnil;
2273 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2274 "A list of functions to be called when Emacs answers a selection request.\n\
2275 The functions are called with four arguments:\n\
2276 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2277 - the selection-type which Emacs was asked to convert the\n\
2278 selection into before sending (for example, `STRING' or `LENGTH');\n\
2279 - a flag indicating success or failure for responding to the request.\n\
2280 We might have failed (and declined the request) for any number of reasons,\n\
2281 including being asked for a selection that we no longer own, or being asked\n\
2282 to convert into a type that we don't know about or that is inappropriate.\n\
2283 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2284 it merely informs you that they have happened.");
2285 Vx_sent_selection_hooks = Qnil;
2287 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2288 "Coding system for communicating with other X clients.\n\
2289 When sending or receiving text via cut_buffer, selection, and clipboard,\n\
2290 the text is encoded or decoded by this coding system.\n\
2291 The default value is `compound-text'.");
2292 Vselection_coding_system = intern ("compound-text");
2294 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2295 "Coding system for the next communication with other X clients.\n\
2296 Usually, `selection-coding-system' is used for communicating with\n\
2297 other X clients. But, if this variable is set, it is used for the\n\
2298 next communication only. After the communication, this variable is\n\
2299 set to nil.");
2300 Vnext_selection_coding_system = Qnil;
2302 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2303 "Number of milliseconds to wait for a selection reply.\n\
2304 If the selection owner doesn't reply in this time, we give up.\n\
2305 A value of 0 means wait as long as necessary. This is initialized from the\n\
2306 \"*selectionTimeout\" resource.");
2307 x_selection_timeout = 0;
2309 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2310 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2311 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2312 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2313 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2314 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2315 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2316 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2317 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2318 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2319 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2320 QINCR = intern ("INCR"); staticpro (&QINCR);
2321 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2322 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2323 QATOM = intern ("ATOM"); staticpro (&QATOM);
2324 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2325 QNULL = intern ("NULL"); staticpro (&QNULL);
2327 #ifdef CUT_BUFFER_SUPPORT
2328 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2329 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2330 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2331 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2332 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2333 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2334 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2335 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2336 #endif