(comint-quote-filename): Correctly handle backslash
[emacs.git] / src / xselect.c
blob8eda4b78464a3ed1b2ac32b31791861c2832a4bc
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Rewritten by jwz */
25 #include <config.h>
26 #include "lisp.h"
27 #include "xterm.h" /* for all of the X includes */
28 #include "dispextern.h" /* frame.h seems to want this */
29 #include "frame.h" /* Need this to get the X window of selected_frame */
30 #include "blockinput.h"
31 #include "buffer.h"
32 #include "process.h"
34 struct prop_location;
36 static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
37 static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
38 Lisp_Object));
39 static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
40 static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
41 static void x_decline_selection_request P_ ((struct input_event *));
42 static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
43 static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
44 static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
45 static void x_reply_selection_request P_ ((struct input_event *, int,
46 unsigned char *, int, Atom));
47 static int waiting_for_other_props_on_window P_ ((Display *, Window));
48 static struct prop_location *expect_property_change P_ ((Display *, Window,
49 Atom, int));
50 static void unexpect_property_change P_ ((struct prop_location *));
51 static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
52 static void wait_for_property_change P_ ((struct prop_location *));
53 static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object, Lisp_Object));
54 static void x_get_window_property P_ ((Display *, Window, Atom,
55 unsigned char **, int *,
56 Atom *, int *, unsigned long *, int));
57 static void receive_incremental_selection P_ ((Display *, Window, Atom,
58 Lisp_Object, unsigned,
59 unsigned char **, int *,
60 Atom *, int *, unsigned long *));
61 static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
62 Window, Atom,
63 Lisp_Object, Atom));
64 static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
65 int, Atom, int));
66 static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
67 unsigned char **, Atom *,
68 unsigned *, int *, int *));
69 static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
70 static void initialize_cut_buffers P_ ((Display *, Window));
73 /* Printing traces to stderr. */
75 #ifdef TRACE_SELECTION
76 #define TRACE0(fmt) \
77 fprintf (stderr, "%d: " fmt "\n", getpid ())
78 #define TRACE1(fmt, a0) \
79 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
80 #define TRACE2(fmt, a0, a1) \
81 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
82 #else
83 #define TRACE0(fmt) (void) 0
84 #define TRACE1(fmt, a0) (void) 0
85 #define TRACE2(fmt, a0, a1) (void) 0
86 #endif
89 #define CUT_BUFFER_SUPPORT
91 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
92 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
93 QATOM_PAIR;
95 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
96 Lisp_Object QUTF8_STRING; /* This is a type of selection. */
98 Lisp_Object Qcompound_text_with_extensions;
100 #ifdef CUT_BUFFER_SUPPORT
101 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
102 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
103 #endif
105 static Lisp_Object Vx_lost_selection_hooks;
106 static Lisp_Object Vx_sent_selection_hooks;
107 /* Coding system for communicating with other X clients via cutbuffer,
108 selection, and clipboard. */
109 static Lisp_Object Vselection_coding_system;
111 /* Coding system for the next communicating with other X clients. */
112 static Lisp_Object Vnext_selection_coding_system;
114 static Lisp_Object Qforeign_selection;
116 /* If this is a smaller number than the max-request-size of the display,
117 emacs will use INCR selection transfer when the selection is larger
118 than this. The max-request-size is usually around 64k, so if you want
119 emacs to use incremental selection transfers when the selection is
120 smaller than that, set this. I added this mostly for debugging the
121 incremental transfer stuff, but it might improve server performance. */
122 #define MAX_SELECTION_QUANTUM 0xFFFFFF
124 #ifdef HAVE_X11R4
125 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
126 #else
127 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
128 #endif
130 /* The timestamp of the last input event Emacs received from the X server. */
131 /* Defined in keyboard.c. */
132 extern unsigned long last_event_timestamp;
134 /* This is an association list whose elements are of the form
135 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
136 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
137 SELECTION-VALUE is the value that emacs owns for that selection.
138 It may be any kind of Lisp object.
139 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
140 as a cons of two 16-bit numbers (making a 32 bit time.)
141 FRAME is the frame for which we made the selection.
142 If there is an entry in this alist, then it can be assumed that Emacs owns
143 that selection.
144 The only (eq) parts of this list that are visible from Lisp are the
145 selection-values. */
146 static Lisp_Object Vselection_alist;
148 /* This is an alist whose CARs are selection-types (whose names are the same
149 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
150 call to convert the given Emacs selection value to a string representing
151 the given selection type. This is for Lisp-level extension of the emacs
152 selection handling. */
153 static Lisp_Object Vselection_converter_alist;
155 /* If the selection owner takes too long to reply to a selection request,
156 we give up on it. This is in milliseconds (0 = no timeout.) */
157 static EMACS_INT x_selection_timeout;
159 /* Utility functions */
161 static void lisp_data_to_selection_data ();
162 static Lisp_Object selection_data_to_lisp_data ();
163 static Lisp_Object x_get_window_property_as_lisp_data ();
165 /* This converts a Lisp symbol to a server Atom, avoiding a server
166 roundtrip whenever possible. */
168 static Atom
169 symbol_to_x_atom (dpyinfo, display, sym)
170 struct x_display_info *dpyinfo;
171 Display *display;
172 Lisp_Object sym;
174 Atom val;
175 if (NILP (sym)) return 0;
176 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
177 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
178 if (EQ (sym, QSTRING)) return XA_STRING;
179 if (EQ (sym, QINTEGER)) return XA_INTEGER;
180 if (EQ (sym, QATOM)) return XA_ATOM;
181 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
182 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
183 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
184 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
185 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
186 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
187 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
188 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
189 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
190 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
191 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
192 #ifdef CUT_BUFFER_SUPPORT
193 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
194 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
195 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
196 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
197 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
198 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
199 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
200 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
201 #endif
202 if (!SYMBOLP (sym)) abort ();
204 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
205 BLOCK_INPUT;
206 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
207 UNBLOCK_INPUT;
208 return val;
212 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
213 and calls to intern whenever possible. */
215 static Lisp_Object
216 x_atom_to_symbol (dpy, atom)
217 Display *dpy;
218 Atom atom;
220 struct x_display_info *dpyinfo;
221 char *str;
222 Lisp_Object val;
224 if (! atom)
225 return Qnil;
227 switch (atom)
229 case XA_PRIMARY:
230 return QPRIMARY;
231 case XA_SECONDARY:
232 return QSECONDARY;
233 case XA_STRING:
234 return QSTRING;
235 case XA_INTEGER:
236 return QINTEGER;
237 case XA_ATOM:
238 return QATOM;
239 #ifdef CUT_BUFFER_SUPPORT
240 case XA_CUT_BUFFER0:
241 return QCUT_BUFFER0;
242 case XA_CUT_BUFFER1:
243 return QCUT_BUFFER1;
244 case XA_CUT_BUFFER2:
245 return QCUT_BUFFER2;
246 case XA_CUT_BUFFER3:
247 return QCUT_BUFFER3;
248 case XA_CUT_BUFFER4:
249 return QCUT_BUFFER4;
250 case XA_CUT_BUFFER5:
251 return QCUT_BUFFER5;
252 case XA_CUT_BUFFER6:
253 return QCUT_BUFFER6;
254 case XA_CUT_BUFFER7:
255 return QCUT_BUFFER7;
256 #endif
259 dpyinfo = x_display_info_for_display (dpy);
260 if (atom == dpyinfo->Xatom_CLIPBOARD)
261 return QCLIPBOARD;
262 if (atom == dpyinfo->Xatom_TIMESTAMP)
263 return QTIMESTAMP;
264 if (atom == dpyinfo->Xatom_TEXT)
265 return QTEXT;
266 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
267 return QCOMPOUND_TEXT;
268 if (atom == dpyinfo->Xatom_UTF8_STRING)
269 return QUTF8_STRING;
270 if (atom == dpyinfo->Xatom_DELETE)
271 return QDELETE;
272 if (atom == dpyinfo->Xatom_MULTIPLE)
273 return QMULTIPLE;
274 if (atom == dpyinfo->Xatom_INCR)
275 return QINCR;
276 if (atom == dpyinfo->Xatom_EMACS_TMP)
277 return QEMACS_TMP;
278 if (atom == dpyinfo->Xatom_TARGETS)
279 return QTARGETS;
280 if (atom == dpyinfo->Xatom_NULL)
281 return QNULL;
283 BLOCK_INPUT;
284 str = XGetAtomName (dpy, atom);
285 UNBLOCK_INPUT;
286 TRACE1 ("XGetAtomName --> %s", str);
287 if (! str) return Qnil;
288 val = intern (str);
289 BLOCK_INPUT;
290 /* This was allocated by Xlib, so use XFree. */
291 XFree (str);
292 UNBLOCK_INPUT;
293 return val;
296 /* Do protocol to assert ourself as a selection owner.
297 Update the Vselection_alist so that we can reply to later requests for
298 our selection. */
300 static void
301 x_own_selection (selection_name, selection_value)
302 Lisp_Object selection_name, selection_value;
304 struct frame *sf = SELECTED_FRAME ();
305 Window selecting_window = FRAME_X_WINDOW (sf);
306 Display *display = FRAME_X_DISPLAY (sf);
307 Time time = last_event_timestamp;
308 Atom selection_atom;
309 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
310 int count;
312 CHECK_SYMBOL (selection_name);
313 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
315 BLOCK_INPUT;
316 count = x_catch_errors (display);
317 XSetSelectionOwner (display, selection_atom, selecting_window, time);
318 x_check_errors (display, "Can't set selection: %s");
319 x_uncatch_errors (display, count);
320 UNBLOCK_INPUT;
322 /* Now update the local cache */
324 Lisp_Object selection_time;
325 Lisp_Object selection_data;
326 Lisp_Object prev_value;
328 selection_time = long_to_cons ((unsigned long) time);
329 selection_data = Fcons (selection_name,
330 Fcons (selection_value,
331 Fcons (selection_time,
332 Fcons (selected_frame, Qnil))));
333 prev_value = assq_no_quit (selection_name, Vselection_alist);
335 Vselection_alist = Fcons (selection_data, Vselection_alist);
337 /* If we already owned the selection, remove the old selection data.
338 Perhaps we should destructively modify it instead.
339 Don't use Fdelq as that may QUIT. */
340 if (!NILP (prev_value))
342 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
343 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
344 if (EQ (prev_value, Fcar (XCDR (rest))))
346 XSETCDR (rest, Fcdr (XCDR (rest)));
347 break;
353 /* Given a selection-name and desired type, look up our local copy of
354 the selection value and convert it to the type.
355 The value is nil or a string.
356 This function is used both for remote requests (LOCAL_REQUEST is zero)
357 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
359 This calls random Lisp code, and may signal or gc. */
361 static Lisp_Object
362 x_get_local_selection (selection_symbol, target_type, local_request)
363 Lisp_Object selection_symbol, target_type;
364 int local_request;
366 Lisp_Object local_value;
367 Lisp_Object handler_fn, value, type, check;
368 int count;
370 local_value = assq_no_quit (selection_symbol, Vselection_alist);
372 if (NILP (local_value)) return Qnil;
374 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
375 if (EQ (target_type, QTIMESTAMP))
377 handler_fn = Qnil;
378 value = XCAR (XCDR (XCDR (local_value)));
380 #if 0
381 else if (EQ (target_type, QDELETE))
383 handler_fn = Qnil;
384 Fx_disown_selection_internal
385 (selection_symbol,
386 XCAR (XCDR (XCDR (local_value))));
387 value = QNULL;
389 #endif
391 #if 0 /* #### MULTIPLE doesn't work yet */
392 else if (CONSP (target_type)
393 && XCAR (target_type) == QMULTIPLE)
395 Lisp_Object pairs;
396 int size;
397 int i;
398 pairs = XCDR (target_type);
399 size = XVECTOR (pairs)->size;
400 /* If the target is MULTIPLE, then target_type looks like
401 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
402 We modify the second element of each pair in the vector and
403 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
405 for (i = 0; i < size; i++)
407 Lisp_Object pair;
408 pair = XVECTOR (pairs)->contents [i];
409 XVECTOR (pair)->contents [1]
410 = x_get_local_selection (XVECTOR (pair)->contents [0],
411 XVECTOR (pair)->contents [1],
412 local_request);
414 return pairs;
416 #endif
417 else
419 /* Don't allow a quit within the converter.
420 When the user types C-g, he would be surprised
421 if by luck it came during a converter. */
422 count = SPECPDL_INDEX ();
423 specbind (Qinhibit_quit, Qt);
425 CHECK_SYMBOL (target_type);
426 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
427 /* gcpro is not needed here since nothing but HANDLER_FN
428 is live, and that ought to be a symbol. */
430 if (!NILP (handler_fn))
431 value = call3 (handler_fn,
432 selection_symbol, (local_request ? Qnil : target_type),
433 XCAR (XCDR (local_value)));
434 else
435 value = Qnil;
436 unbind_to (count, Qnil);
439 /* Make sure this value is of a type that we could transmit
440 to another X client. */
442 check = value;
443 if (CONSP (value)
444 && SYMBOLP (XCAR (value)))
445 type = XCAR (value),
446 check = XCDR (value);
448 if (STRINGP (check)
449 || VECTORP (check)
450 || SYMBOLP (check)
451 || INTEGERP (check)
452 || NILP (value))
453 return value;
454 /* Check for a value that cons_to_long could handle. */
455 else if (CONSP (check)
456 && INTEGERP (XCAR (check))
457 && (INTEGERP (XCDR (check))
459 (CONSP (XCDR (check))
460 && INTEGERP (XCAR (XCDR (check)))
461 && NILP (XCDR (XCDR (check))))))
462 return value;
463 else
464 return
465 Fsignal (Qerror,
466 Fcons (build_string ("invalid data returned by selection-conversion function"),
467 Fcons (handler_fn, Fcons (value, Qnil))));
470 /* Subroutines of x_reply_selection_request. */
472 /* Send a SelectionNotify event to the requestor with property=None,
473 meaning we were unable to do what they wanted. */
475 static void
476 x_decline_selection_request (event)
477 struct input_event *event;
479 XSelectionEvent reply;
480 int count;
482 reply.type = SelectionNotify;
483 reply.display = SELECTION_EVENT_DISPLAY (event);
484 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
485 reply.selection = SELECTION_EVENT_SELECTION (event);
486 reply.time = SELECTION_EVENT_TIME (event);
487 reply.target = SELECTION_EVENT_TARGET (event);
488 reply.property = None;
490 /* The reason for the error may be that the receiver has
491 died in the meantime. Handle that case. */
492 BLOCK_INPUT;
493 count = x_catch_errors (reply.display);
494 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
495 XFlush (reply.display);
496 x_uncatch_errors (reply.display, count);
497 UNBLOCK_INPUT;
500 /* This is the selection request currently being processed.
501 It is set to zero when the request is fully processed. */
502 static struct input_event *x_selection_current_request;
504 /* Display info in x_selection_request. */
506 static struct x_display_info *selection_request_dpyinfo;
508 /* Used as an unwind-protect clause so that, if a selection-converter signals
509 an error, we tell the requester that we were unable to do what they wanted
510 before we throw to top-level or go into the debugger or whatever. */
512 static Lisp_Object
513 x_selection_request_lisp_error (ignore)
514 Lisp_Object ignore;
516 if (x_selection_current_request != 0
517 && selection_request_dpyinfo->display)
518 x_decline_selection_request (x_selection_current_request);
519 return Qnil;
523 /* This stuff is so that INCR selections are reentrant (that is, so we can
524 be servicing multiple INCR selection requests simultaneously.) I haven't
525 actually tested that yet. */
527 /* Keep a list of the property changes that are awaited. */
529 struct prop_location
531 int identifier;
532 Display *display;
533 Window window;
534 Atom property;
535 int desired_state;
536 int arrived;
537 struct prop_location *next;
540 static struct prop_location *expect_property_change ();
541 static void wait_for_property_change ();
542 static void unexpect_property_change ();
543 static int waiting_for_other_props_on_window ();
545 static int prop_location_identifier;
547 static Lisp_Object property_change_reply;
549 static struct prop_location *property_change_reply_object;
551 static struct prop_location *property_change_wait_list;
553 static Lisp_Object
554 queue_selection_requests_unwind (frame)
555 Lisp_Object frame;
557 FRAME_PTR f = XFRAME (frame);
559 if (! NILP (frame))
560 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
561 return Qnil;
564 /* Return some frame whose display info is DPYINFO.
565 Return nil if there is none. */
567 static Lisp_Object
568 some_frame_on_display (dpyinfo)
569 struct x_display_info *dpyinfo;
571 Lisp_Object list, frame;
573 FOR_EACH_FRAME (list, frame)
575 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
576 return frame;
579 return Qnil;
582 /* Send the reply to a selection request event EVENT.
583 TYPE is the type of selection data requested.
584 DATA and SIZE describe the data to send, already converted.
585 FORMAT is the unit-size (in bits) of the data to be transmitted. */
587 static void
588 x_reply_selection_request (event, format, data, size, type)
589 struct input_event *event;
590 int format, size;
591 unsigned char *data;
592 Atom type;
594 XSelectionEvent reply;
595 Display *display = SELECTION_EVENT_DISPLAY (event);
596 Window window = SELECTION_EVENT_REQUESTOR (event);
597 int bytes_remaining;
598 int format_bytes = format/8;
599 int max_bytes = SELECTION_QUANTUM (display);
600 struct x_display_info *dpyinfo = x_display_info_for_display (display);
601 int count;
603 if (max_bytes > MAX_SELECTION_QUANTUM)
604 max_bytes = MAX_SELECTION_QUANTUM;
606 reply.type = SelectionNotify;
607 reply.display = display;
608 reply.requestor = window;
609 reply.selection = SELECTION_EVENT_SELECTION (event);
610 reply.time = SELECTION_EVENT_TIME (event);
611 reply.target = SELECTION_EVENT_TARGET (event);
612 reply.property = SELECTION_EVENT_PROPERTY (event);
613 if (reply.property == None)
614 reply.property = reply.target;
616 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
617 BLOCK_INPUT;
618 count = x_catch_errors (display);
620 /* Store the data on the requested property.
621 If the selection is large, only store the first N bytes of it.
623 bytes_remaining = size * format_bytes;
624 if (bytes_remaining <= max_bytes)
626 /* Send all the data at once, with minimal handshaking. */
627 TRACE1 ("Sending all %d bytes", bytes_remaining);
628 XChangeProperty (display, window, reply.property, type, format,
629 PropModeReplace, data, size);
630 /* At this point, the selection was successfully stored; ack it. */
631 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
633 else
635 /* Send an INCR selection. */
636 struct prop_location *wait_object;
637 int had_errors;
638 Lisp_Object frame;
640 frame = some_frame_on_display (dpyinfo);
642 /* If the display no longer has frames, we can't expect
643 to get many more selection requests from it, so don't
644 bother trying to queue them. */
645 if (!NILP (frame))
647 x_start_queuing_selection_requests (display);
649 record_unwind_protect (queue_selection_requests_unwind,
650 frame);
653 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
654 error ("Attempt to transfer an INCR to ourself!");
656 TRACE2 ("Start sending %d bytes incrementally (%s)",
657 bytes_remaining, XGetAtomName (display, reply.property));
658 wait_object = expect_property_change (display, window, reply.property,
659 PropertyDelete);
661 TRACE1 ("Set %s to number of bytes to send",
662 XGetAtomName (display, reply.property));
663 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
664 32, PropModeReplace,
665 (unsigned char *) &bytes_remaining, 1);
666 XSelectInput (display, window, PropertyChangeMask);
668 /* Tell 'em the INCR data is there... */
669 TRACE0 ("Send SelectionNotify event");
670 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
671 XFlush (display);
673 had_errors = x_had_errors_p (display);
674 UNBLOCK_INPUT;
676 /* First, wait for the requester to ack by deleting the property.
677 This can run random lisp code (process handlers) or signal. */
678 if (! had_errors)
680 TRACE1 ("Waiting for ACK (deletion of %s)",
681 XGetAtomName (display, reply.property));
682 wait_for_property_change (wait_object);
685 TRACE0 ("Got ACK");
686 while (bytes_remaining)
688 int i = ((bytes_remaining < max_bytes)
689 ? bytes_remaining
690 : max_bytes);
692 BLOCK_INPUT;
694 wait_object
695 = expect_property_change (display, window, reply.property,
696 PropertyDelete);
698 TRACE1 ("Sending increment of %d bytes", i);
699 TRACE1 ("Set %s to increment data",
700 XGetAtomName (display, reply.property));
702 /* Append the next chunk of data to the property. */
703 XChangeProperty (display, window, reply.property, type, format,
704 PropModeAppend, data, i / format_bytes);
705 bytes_remaining -= i;
706 data += i;
707 XFlush (display);
708 had_errors = x_had_errors_p (display);
709 UNBLOCK_INPUT;
711 if (had_errors)
712 break;
714 /* Now wait for the requester to ack this chunk by deleting the
715 property. This can run random lisp code or signal. */
716 TRACE1 ("Waiting for increment ACK (deletion of %s)",
717 XGetAtomName (display, reply.property));
718 wait_for_property_change (wait_object);
721 /* Now write a zero-length chunk to the property to tell the
722 requester that we're done. */
723 BLOCK_INPUT;
724 if (! waiting_for_other_props_on_window (display, window))
725 XSelectInput (display, window, 0L);
727 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
728 XGetAtomName (display, reply.property));
729 XChangeProperty (display, window, reply.property, type, format,
730 PropModeReplace, data, 0);
731 TRACE0 ("Done sending incrementally");
734 /* rms, 2003-01-03: I think I have fixed this bug. */
735 /* The window we're communicating with may have been deleted
736 in the meantime (that's a real situation from a bug report).
737 In this case, there may be events in the event queue still
738 refering to the deleted window, and we'll get a BadWindow error
739 in XTread_socket when processing the events. I don't have
740 an idea how to fix that. gerd, 2001-01-98. */
741 XFlush (display);
742 x_uncatch_errors (display, count);
743 UNBLOCK_INPUT;
746 /* Handle a SelectionRequest event EVENT.
747 This is called from keyboard.c when such an event is found in the queue. */
749 void
750 x_handle_selection_request (event)
751 struct input_event *event;
753 struct gcpro gcpro1, gcpro2, gcpro3;
754 Lisp_Object local_selection_data;
755 Lisp_Object selection_symbol;
756 Lisp_Object target_symbol;
757 Lisp_Object converted_selection;
758 Time local_selection_time;
759 Lisp_Object successful_p;
760 int count;
761 struct x_display_info *dpyinfo
762 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
764 local_selection_data = Qnil;
765 target_symbol = Qnil;
766 converted_selection = Qnil;
767 successful_p = Qnil;
769 GCPRO3 (local_selection_data, converted_selection, target_symbol);
771 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
772 SELECTION_EVENT_SELECTION (event));
774 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
776 if (NILP (local_selection_data))
778 /* Someone asked for the selection, but we don't have it any more.
780 x_decline_selection_request (event);
781 goto DONE;
784 local_selection_time = (Time)
785 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
787 if (SELECTION_EVENT_TIME (event) != CurrentTime
788 && local_selection_time > SELECTION_EVENT_TIME (event))
790 /* Someone asked for the selection, and we have one, but not the one
791 they're looking for.
793 x_decline_selection_request (event);
794 goto DONE;
797 x_selection_current_request = event;
798 count = SPECPDL_INDEX ();
799 selection_request_dpyinfo = dpyinfo;
800 record_unwind_protect (x_selection_request_lisp_error, Qnil);
802 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
803 SELECTION_EVENT_TARGET (event));
805 #if 0 /* #### MULTIPLE doesn't work yet */
806 if (EQ (target_symbol, QMULTIPLE))
807 target_symbol = fetch_multiple_target (event);
808 #endif
810 /* Convert lisp objects back into binary data */
812 converted_selection
813 = x_get_local_selection (selection_symbol, target_symbol, 0);
815 if (! NILP (converted_selection))
817 unsigned char *data;
818 unsigned int size;
819 int format;
820 Atom type;
821 int nofree;
823 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
824 converted_selection,
825 &data, &type, &size, &format, &nofree);
827 x_reply_selection_request (event, format, data, size, type);
828 successful_p = Qt;
830 /* Indicate we have successfully processed this event. */
831 x_selection_current_request = 0;
833 /* Use xfree, not XFree, because lisp_data_to_selection_data
834 calls xmalloc itself. */
835 if (!nofree)
836 xfree (data);
838 unbind_to (count, Qnil);
840 DONE:
842 /* Let random lisp code notice that the selection has been asked for. */
844 Lisp_Object rest;
845 rest = Vx_sent_selection_hooks;
846 if (!EQ (rest, Qunbound))
847 for (; CONSP (rest); rest = Fcdr (rest))
848 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
851 UNGCPRO;
854 /* Handle a SelectionClear event EVENT, which indicates that some
855 client cleared out our previously asserted selection.
856 This is called from keyboard.c when such an event is found in the queue. */
858 void
859 x_handle_selection_clear (event)
860 struct input_event *event;
862 Display *display = SELECTION_EVENT_DISPLAY (event);
863 Atom selection = SELECTION_EVENT_SELECTION (event);
864 Time changed_owner_time = SELECTION_EVENT_TIME (event);
866 Lisp_Object selection_symbol, local_selection_data;
867 Time local_selection_time;
868 struct x_display_info *dpyinfo = x_display_info_for_display (display);
869 struct x_display_info *t_dpyinfo;
871 /* If the new selection owner is also Emacs,
872 don't clear the new selection. */
873 BLOCK_INPUT;
874 /* Check each display on the same terminal,
875 to see if this Emacs job now owns the selection
876 through that display. */
877 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
878 if (t_dpyinfo->kboard == dpyinfo->kboard)
880 Window owner_window
881 = XGetSelectionOwner (t_dpyinfo->display, selection);
882 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
884 UNBLOCK_INPUT;
885 return;
888 UNBLOCK_INPUT;
890 selection_symbol = x_atom_to_symbol (display, selection);
892 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
894 /* Well, we already believe that we don't own it, so that's just fine. */
895 if (NILP (local_selection_data)) return;
897 local_selection_time = (Time)
898 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
900 /* This SelectionClear is for a selection that we no longer own, so we can
901 disregard it. (That is, we have reasserted the selection since this
902 request was generated.) */
904 if (changed_owner_time != CurrentTime
905 && local_selection_time > changed_owner_time)
906 return;
908 /* Otherwise, we're really honest and truly being told to drop it.
909 Don't use Fdelq as that may QUIT;. */
911 if (EQ (local_selection_data, Fcar (Vselection_alist)))
912 Vselection_alist = Fcdr (Vselection_alist);
913 else
915 Lisp_Object rest;
916 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
917 if (EQ (local_selection_data, Fcar (XCDR (rest))))
919 XSETCDR (rest, Fcdr (XCDR (rest)));
920 break;
924 /* Let random lisp code notice that the selection has been stolen. */
927 Lisp_Object rest;
928 rest = Vx_lost_selection_hooks;
929 if (!EQ (rest, Qunbound))
931 for (; CONSP (rest); rest = Fcdr (rest))
932 call1 (Fcar (rest), selection_symbol);
933 prepare_menu_bars ();
934 redisplay_preserve_echo_area (20);
939 /* Clear all selections that were made from frame F.
940 We do this when about to delete a frame. */
942 void
943 x_clear_frame_selections (f)
944 FRAME_PTR f;
946 Lisp_Object frame;
947 Lisp_Object rest;
949 XSETFRAME (frame, f);
951 /* Otherwise, we're really honest and truly being told to drop it.
952 Don't use Fdelq as that may QUIT;. */
954 /* Delete elements from the beginning of Vselection_alist. */
955 while (!NILP (Vselection_alist)
956 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
958 /* Let random Lisp code notice that the selection has been stolen. */
959 Lisp_Object hooks, selection_symbol;
961 hooks = Vx_lost_selection_hooks;
962 selection_symbol = Fcar (Fcar (Vselection_alist));
964 if (!EQ (hooks, Qunbound))
966 for (; CONSP (hooks); hooks = Fcdr (hooks))
967 call1 (Fcar (hooks), selection_symbol);
968 #if 0 /* This can crash when deleting a frame
969 from x_connection_closed. Anyway, it seems unnecessary;
970 something else should cause a redisplay. */
971 redisplay_preserve_echo_area (21);
972 #endif
975 Vselection_alist = Fcdr (Vselection_alist);
978 /* Delete elements after the beginning of Vselection_alist. */
979 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
980 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
982 /* Let random Lisp code notice that the selection has been stolen. */
983 Lisp_Object hooks, selection_symbol;
985 hooks = Vx_lost_selection_hooks;
986 selection_symbol = Fcar (Fcar (XCDR (rest)));
988 if (!EQ (hooks, Qunbound))
990 for (; CONSP (hooks); hooks = Fcdr (hooks))
991 call1 (Fcar (hooks), selection_symbol);
992 #if 0 /* See above */
993 redisplay_preserve_echo_area (22);
994 #endif
996 XSETCDR (rest, Fcdr (XCDR (rest)));
997 break;
1001 /* Nonzero if any properties for DISPLAY and WINDOW
1002 are on the list of what we are waiting for. */
1004 static int
1005 waiting_for_other_props_on_window (display, window)
1006 Display *display;
1007 Window window;
1009 struct prop_location *rest = property_change_wait_list;
1010 while (rest)
1011 if (rest->display == display && rest->window == window)
1012 return 1;
1013 else
1014 rest = rest->next;
1015 return 0;
1018 /* Add an entry to the list of property changes we are waiting for.
1019 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1020 The return value is a number that uniquely identifies
1021 this awaited property change. */
1023 static struct prop_location *
1024 expect_property_change (display, window, property, state)
1025 Display *display;
1026 Window window;
1027 Atom property;
1028 int state;
1030 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
1031 pl->identifier = ++prop_location_identifier;
1032 pl->display = display;
1033 pl->window = window;
1034 pl->property = property;
1035 pl->desired_state = state;
1036 pl->next = property_change_wait_list;
1037 pl->arrived = 0;
1038 property_change_wait_list = pl;
1039 return pl;
1042 /* Delete an entry from the list of property changes we are waiting for.
1043 IDENTIFIER is the number that uniquely identifies the entry. */
1045 static void
1046 unexpect_property_change (location)
1047 struct prop_location *location;
1049 struct prop_location *prev = 0, *rest = property_change_wait_list;
1050 while (rest)
1052 if (rest == location)
1054 if (prev)
1055 prev->next = rest->next;
1056 else
1057 property_change_wait_list = rest->next;
1058 xfree (rest);
1059 return;
1061 prev = rest;
1062 rest = rest->next;
1066 /* Remove the property change expectation element for IDENTIFIER. */
1068 static Lisp_Object
1069 wait_for_property_change_unwind (identifierval)
1070 Lisp_Object identifierval;
1072 unexpect_property_change ((struct prop_location *)
1073 (XFASTINT (XCAR (identifierval)) << 16
1074 | XFASTINT (XCDR (identifierval))));
1075 return Qnil;
1078 /* Actually wait for a property change.
1079 IDENTIFIER should be the value that expect_property_change returned. */
1081 static void
1082 wait_for_property_change (location)
1083 struct prop_location *location;
1085 int secs, usecs;
1086 int count = SPECPDL_INDEX ();
1087 Lisp_Object tem;
1089 tem = Fcons (Qnil, Qnil);
1090 XSETCARFASTINT (tem, (EMACS_UINT)location >> 16);
1091 XSETCDRFASTINT (tem, (EMACS_UINT)location & 0xffff);
1093 /* Make sure to do unexpect_property_change if we quit or err. */
1094 record_unwind_protect (wait_for_property_change_unwind, tem);
1096 XSETCAR (property_change_reply, Qnil);
1098 property_change_reply_object = location;
1099 /* If the event we are waiting for arrives beyond here, it will set
1100 property_change_reply, because property_change_reply_object says so. */
1101 if (! location->arrived)
1103 secs = x_selection_timeout / 1000;
1104 usecs = (x_selection_timeout % 1000) * 1000;
1105 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
1106 wait_reading_process_input (secs, usecs, property_change_reply, 0);
1108 if (NILP (XCAR (property_change_reply)))
1110 TRACE0 (" Timed out");
1111 error ("Timed out waiting for property-notify event");
1115 unbind_to (count, Qnil);
1118 /* Called from XTread_socket in response to a PropertyNotify event. */
1120 void
1121 x_handle_property_notify (event)
1122 XPropertyEvent *event;
1124 struct prop_location *prev = 0, *rest = property_change_wait_list;
1126 while (rest)
1128 if (rest->property == event->atom
1129 && rest->window == event->window
1130 && rest->display == event->display
1131 && rest->desired_state == event->state)
1133 TRACE2 ("Expected %s of property %s",
1134 (event->state == PropertyDelete ? "deletion" : "change"),
1135 XGetAtomName (event->display, event->atom));
1137 rest->arrived = 1;
1139 /* If this is the one wait_for_property_change is waiting for,
1140 tell it to wake up. */
1141 if (rest == property_change_reply_object)
1142 XSETCAR (property_change_reply, Qt);
1144 if (prev)
1145 prev->next = rest->next;
1146 else
1147 property_change_wait_list = rest->next;
1148 xfree (rest);
1149 return;
1152 prev = rest;
1153 rest = rest->next;
1159 #if 0 /* #### MULTIPLE doesn't work yet */
1161 static Lisp_Object
1162 fetch_multiple_target (event)
1163 XSelectionRequestEvent *event;
1165 Display *display = event->display;
1166 Window window = event->requestor;
1167 Atom target = event->target;
1168 Atom selection_atom = event->selection;
1169 int result;
1171 return
1172 Fcons (QMULTIPLE,
1173 x_get_window_property_as_lisp_data (display, window, target,
1174 QMULTIPLE, selection_atom));
1177 static Lisp_Object
1178 copy_multiple_data (obj)
1179 Lisp_Object obj;
1181 Lisp_Object vec;
1182 int i;
1183 int size;
1184 if (CONSP (obj))
1185 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1187 CHECK_VECTOR (obj);
1188 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1189 for (i = 0; i < size; i++)
1191 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1192 CHECK_VECTOR (vec2);
1193 if (XVECTOR (vec2)->size != 2)
1194 /* ??? Confusing error message */
1195 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1196 Fcons (vec2, Qnil)));
1197 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1198 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1199 = XVECTOR (vec2)->contents [0];
1200 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1201 = XVECTOR (vec2)->contents [1];
1203 return vec;
1206 #endif
1209 /* Variables for communication with x_handle_selection_notify. */
1210 static Atom reading_which_selection;
1211 static Lisp_Object reading_selection_reply;
1212 static Window reading_selection_window;
1214 /* Do protocol to read selection-data from the server.
1215 Converts this to Lisp data and returns it. */
1217 static Lisp_Object
1218 x_get_foreign_selection (selection_symbol, target_type)
1219 Lisp_Object selection_symbol, target_type;
1221 struct frame *sf = SELECTED_FRAME ();
1222 Window requestor_window = FRAME_X_WINDOW (sf);
1223 Display *display = FRAME_X_DISPLAY (sf);
1224 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1225 Time requestor_time = last_event_timestamp;
1226 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1227 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1228 Atom type_atom;
1229 int secs, usecs;
1230 int count;
1231 Lisp_Object frame;
1233 if (CONSP (target_type))
1234 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
1235 else
1236 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1238 BLOCK_INPUT;
1240 count = x_catch_errors (display);
1242 TRACE2 ("Get selection %s, type %s",
1243 XGetAtomName (display, type_atom),
1244 XGetAtomName (display, target_property));
1246 XConvertSelection (display, selection_atom, type_atom, target_property,
1247 requestor_window, requestor_time);
1248 XFlush (display);
1250 /* Prepare to block until the reply has been read. */
1251 reading_selection_window = requestor_window;
1252 reading_which_selection = selection_atom;
1253 XSETCAR (reading_selection_reply, Qnil);
1255 frame = some_frame_on_display (dpyinfo);
1257 /* If the display no longer has frames, we can't expect
1258 to get many more selection requests from it, so don't
1259 bother trying to queue them. */
1260 if (!NILP (frame))
1262 x_start_queuing_selection_requests (display);
1264 record_unwind_protect (queue_selection_requests_unwind,
1265 frame);
1267 UNBLOCK_INPUT;
1269 /* This allows quits. Also, don't wait forever. */
1270 secs = x_selection_timeout / 1000;
1271 usecs = (x_selection_timeout % 1000) * 1000;
1272 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
1273 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1274 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
1276 BLOCK_INPUT;
1277 x_check_errors (display, "Cannot get selection: %s");
1278 x_uncatch_errors (display, count);
1279 UNBLOCK_INPUT;
1281 if (NILP (XCAR (reading_selection_reply)))
1282 error ("Timed out waiting for reply from selection owner");
1283 if (EQ (XCAR (reading_selection_reply), Qlambda))
1284 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
1286 /* Otherwise, the selection is waiting for us on the requested property. */
1287 return
1288 x_get_window_property_as_lisp_data (display, requestor_window,
1289 target_property, target_type,
1290 selection_atom);
1293 /* Subroutines of x_get_window_property_as_lisp_data */
1295 /* Use xfree, not XFree, to free the data obtained with this function. */
1297 static void
1298 x_get_window_property (display, window, property, data_ret, bytes_ret,
1299 actual_type_ret, actual_format_ret, actual_size_ret,
1300 delete_p)
1301 Display *display;
1302 Window window;
1303 Atom property;
1304 unsigned char **data_ret;
1305 int *bytes_ret;
1306 Atom *actual_type_ret;
1307 int *actual_format_ret;
1308 unsigned long *actual_size_ret;
1309 int delete_p;
1311 int total_size;
1312 unsigned long bytes_remaining;
1313 int offset = 0;
1314 unsigned char *tmp_data = 0;
1315 int result;
1316 int buffer_size = SELECTION_QUANTUM (display);
1318 if (buffer_size > MAX_SELECTION_QUANTUM)
1319 buffer_size = MAX_SELECTION_QUANTUM;
1321 BLOCK_INPUT;
1323 /* First probe the thing to find out how big it is. */
1324 result = XGetWindowProperty (display, window, property,
1325 0L, 0L, False, AnyPropertyType,
1326 actual_type_ret, actual_format_ret,
1327 actual_size_ret,
1328 &bytes_remaining, &tmp_data);
1329 if (result != Success)
1331 UNBLOCK_INPUT;
1332 *data_ret = 0;
1333 *bytes_ret = 0;
1334 return;
1337 /* This was allocated by Xlib, so use XFree. */
1338 XFree ((char *) tmp_data);
1340 if (*actual_type_ret == None || *actual_format_ret == 0)
1342 UNBLOCK_INPUT;
1343 return;
1346 total_size = bytes_remaining + 1;
1347 *data_ret = (unsigned char *) xmalloc (total_size);
1349 /* Now read, until we've gotten it all. */
1350 while (bytes_remaining)
1352 #ifdef TRACE_SELECTION
1353 int last = bytes_remaining;
1354 #endif
1355 result
1356 = XGetWindowProperty (display, window, property,
1357 (long)offset/4, (long)buffer_size/4,
1358 False,
1359 AnyPropertyType,
1360 actual_type_ret, actual_format_ret,
1361 actual_size_ret, &bytes_remaining, &tmp_data);
1363 TRACE2 ("Read %ld bytes from property %s",
1364 last - bytes_remaining,
1365 XGetAtomName (display, property));
1367 /* If this doesn't return Success at this point, it means that
1368 some clod deleted the selection while we were in the midst of
1369 reading it. Deal with that, I guess.... */
1370 if (result != Success)
1371 break;
1372 *actual_size_ret *= *actual_format_ret / 8;
1373 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1374 offset += *actual_size_ret;
1376 /* This was allocated by Xlib, so use XFree. */
1377 XFree ((char *) tmp_data);
1380 XFlush (display);
1381 UNBLOCK_INPUT;
1382 *bytes_ret = offset;
1385 /* Use xfree, not XFree, to free the data obtained with this function. */
1387 static void
1388 receive_incremental_selection (display, window, property, target_type,
1389 min_size_bytes, data_ret, size_bytes_ret,
1390 type_ret, format_ret, size_ret)
1391 Display *display;
1392 Window window;
1393 Atom property;
1394 Lisp_Object target_type; /* for error messages only */
1395 unsigned int min_size_bytes;
1396 unsigned char **data_ret;
1397 int *size_bytes_ret;
1398 Atom *type_ret;
1399 unsigned long *size_ret;
1400 int *format_ret;
1402 int offset = 0;
1403 struct prop_location *wait_object;
1404 *size_bytes_ret = min_size_bytes;
1405 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1407 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
1409 /* At this point, we have read an INCR property.
1410 Delete the property to ack it.
1411 (But first, prepare to receive the next event in this handshake.)
1413 Now, we must loop, waiting for the sending window to put a value on
1414 that property, then reading the property, then deleting it to ack.
1415 We are done when the sender places a property of length 0.
1417 BLOCK_INPUT;
1418 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1419 TRACE1 (" Delete property %s",
1420 XSYMBOL (x_atom_to_symbol (display, property))->name->data);
1421 XDeleteProperty (display, window, property);
1422 TRACE1 (" Expect new value of property %s",
1423 XSYMBOL (x_atom_to_symbol (display, property))->name->data);
1424 wait_object = expect_property_change (display, window, property,
1425 PropertyNewValue);
1426 XFlush (display);
1427 UNBLOCK_INPUT;
1429 while (1)
1431 unsigned char *tmp_data;
1432 int tmp_size_bytes;
1434 TRACE0 (" Wait for property change");
1435 wait_for_property_change (wait_object);
1437 /* expect it again immediately, because x_get_window_property may
1438 .. no it won't, I don't get it.
1439 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1440 TRACE0 (" Get property value");
1441 x_get_window_property (display, window, property,
1442 &tmp_data, &tmp_size_bytes,
1443 type_ret, format_ret, size_ret, 1);
1445 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1447 if (tmp_size_bytes == 0) /* we're done */
1449 TRACE0 ("Done reading incrementally");
1451 if (! waiting_for_other_props_on_window (display, window))
1452 XSelectInput (display, window, STANDARD_EVENT_SET);
1453 unexpect_property_change (wait_object);
1454 /* Use xfree, not XFree, because x_get_window_property
1455 calls xmalloc itself. */
1456 if (tmp_data) xfree (tmp_data);
1457 break;
1460 BLOCK_INPUT;
1461 TRACE1 (" ACK by deleting property %s",
1462 XGetAtomName (display, property));
1463 XDeleteProperty (display, window, property);
1464 wait_object = expect_property_change (display, window, property,
1465 PropertyNewValue);
1466 XFlush (display);
1467 UNBLOCK_INPUT;
1469 if (*size_bytes_ret < offset + tmp_size_bytes)
1471 *size_bytes_ret = offset + tmp_size_bytes;
1472 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1475 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1476 offset += tmp_size_bytes;
1478 /* Use xfree, not XFree, because x_get_window_property
1479 calls xmalloc itself. */
1480 xfree (tmp_data);
1485 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1486 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1487 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1489 static Lisp_Object
1490 x_get_window_property_as_lisp_data (display, window, property, target_type,
1491 selection_atom)
1492 Display *display;
1493 Window window;
1494 Atom property;
1495 Lisp_Object target_type; /* for error messages only */
1496 Atom selection_atom; /* for error messages only */
1498 Atom actual_type;
1499 int actual_format;
1500 unsigned long actual_size;
1501 unsigned char *data = 0;
1502 int bytes = 0;
1503 Lisp_Object val;
1504 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1506 TRACE0 ("Reading selection data");
1508 x_get_window_property (display, window, property, &data, &bytes,
1509 &actual_type, &actual_format, &actual_size, 1);
1510 if (! data)
1512 int there_is_a_selection_owner;
1513 BLOCK_INPUT;
1514 there_is_a_selection_owner
1515 = XGetSelectionOwner (display, selection_atom);
1516 UNBLOCK_INPUT;
1517 Fsignal (Qerror,
1518 there_is_a_selection_owner
1519 ? Fcons (build_string ("selection owner couldn't convert"),
1520 actual_type
1521 ? Fcons (target_type,
1522 Fcons (x_atom_to_symbol (display,
1523 actual_type),
1524 Qnil))
1525 : Fcons (target_type, Qnil))
1526 : Fcons (build_string ("no selection"),
1527 Fcons (x_atom_to_symbol (display,
1528 selection_atom),
1529 Qnil)));
1532 if (actual_type == dpyinfo->Xatom_INCR)
1534 /* That wasn't really the data, just the beginning. */
1536 unsigned int min_size_bytes = * ((unsigned int *) data);
1537 BLOCK_INPUT;
1538 /* Use xfree, not XFree, because x_get_window_property
1539 calls xmalloc itself. */
1540 xfree ((char *) data);
1541 UNBLOCK_INPUT;
1542 receive_incremental_selection (display, window, property, target_type,
1543 min_size_bytes, &data, &bytes,
1544 &actual_type, &actual_format,
1545 &actual_size);
1548 BLOCK_INPUT;
1549 TRACE1 (" Delete property %s", XGetAtomName (display, property));
1550 XDeleteProperty (display, window, property);
1551 XFlush (display);
1552 UNBLOCK_INPUT;
1554 /* It's been read. Now convert it to a lisp object in some semi-rational
1555 manner. */
1556 val = selection_data_to_lisp_data (display, data, bytes,
1557 actual_type, actual_format);
1559 /* Use xfree, not XFree, because x_get_window_property
1560 calls xmalloc itself. */
1561 xfree ((char *) data);
1562 return val;
1565 /* These functions convert from the selection data read from the server into
1566 something that we can use from Lisp, and vice versa.
1568 Type: Format: Size: Lisp Type:
1569 ----- ------- ----- -----------
1570 * 8 * String
1571 ATOM 32 1 Symbol
1572 ATOM 32 > 1 Vector of Symbols
1573 * 16 1 Integer
1574 * 16 > 1 Vector of Integers
1575 * 32 1 if <=16 bits: Integer
1576 if > 16 bits: Cons of top16, bot16
1577 * 32 > 1 Vector of the above
1579 When converting a Lisp number to C, it is assumed to be of format 16 if
1580 it is an integer, and of format 32 if it is a cons of two integers.
1582 When converting a vector of numbers from Lisp to C, it is assumed to be
1583 of format 16 if every element in the vector is an integer, and is assumed
1584 to be of format 32 if any element is a cons of two integers.
1586 When converting an object to C, it may be of the form (SYMBOL . <data>)
1587 where SYMBOL is what we should claim that the type is. Format and
1588 representation are as above. */
1592 static Lisp_Object
1593 selection_data_to_lisp_data (display, data, size, type, format)
1594 Display *display;
1595 unsigned char *data;
1596 Atom type;
1597 int size, format;
1599 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1601 if (type == dpyinfo->Xatom_NULL)
1602 return QNULL;
1604 /* Convert any 8-bit data to a string, for compactness. */
1605 else if (format == 8)
1607 Lisp_Object str, lispy_type;
1609 str = make_unibyte_string ((char *) data, size);
1610 /* Indicate that this string is from foreign selection by a text
1611 property `foreign-selection' so that the caller of
1612 x-get-selection-internal (usually x-get-selection) can know
1613 that the string must be decode. */
1614 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1615 lispy_type = QCOMPOUND_TEXT;
1616 else if (type == dpyinfo->Xatom_UTF8_STRING)
1617 lispy_type = QUTF8_STRING;
1618 else
1619 lispy_type = QSTRING;
1620 Fput_text_property (make_number (0), make_number (size),
1621 Qforeign_selection, lispy_type, str);
1622 return str;
1624 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1625 a vector of symbols.
1627 else if (type == XA_ATOM)
1629 int i;
1630 if (size == sizeof (Atom))
1631 return x_atom_to_symbol (display, *((Atom *) data));
1632 else
1634 Lisp_Object v = Fmake_vector (make_number (size / sizeof (Atom)),
1635 make_number (0));
1636 for (i = 0; i < size / sizeof (Atom); i++)
1637 Faset (v, make_number (i),
1638 x_atom_to_symbol (display, ((Atom *) data) [i]));
1639 return v;
1643 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1644 If the number is > 16 bits, convert it to a cons of integers,
1645 16 bits in each half.
1647 else if (format == 32 && size == sizeof (int))
1648 return long_to_cons (((unsigned int *) data) [0]);
1649 else if (format == 16 && size == sizeof (short))
1650 return make_number ((int) (((unsigned short *) data) [0]));
1652 /* Convert any other kind of data to a vector of numbers, represented
1653 as above (as an integer, or a cons of two 16 bit integers.)
1655 else if (format == 16)
1657 int i;
1658 Lisp_Object v;
1659 v = Fmake_vector (make_number (size / 2), make_number (0));
1660 for (i = 0; i < size / 2; i++)
1662 int j = (int) ((unsigned short *) data) [i];
1663 Faset (v, make_number (i), make_number (j));
1665 return v;
1667 else
1669 int i;
1670 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
1671 for (i = 0; i < size / 4; i++)
1673 unsigned int j = ((unsigned int *) data) [i];
1674 Faset (v, make_number (i), long_to_cons (j));
1676 return v;
1681 /* Use xfree, not XFree, to free the data obtained with this function. */
1683 static void
1684 lisp_data_to_selection_data (display, obj,
1685 data_ret, type_ret, size_ret,
1686 format_ret, nofree_ret)
1687 Display *display;
1688 Lisp_Object obj;
1689 unsigned char **data_ret;
1690 Atom *type_ret;
1691 unsigned int *size_ret;
1692 int *format_ret;
1693 int *nofree_ret;
1695 Lisp_Object type = Qnil;
1696 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1698 *nofree_ret = 0;
1700 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
1702 type = XCAR (obj);
1703 obj = XCDR (obj);
1704 if (CONSP (obj) && NILP (XCDR (obj)))
1705 obj = XCAR (obj);
1708 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1709 { /* This is not the same as declining */
1710 *format_ret = 32;
1711 *size_ret = 0;
1712 *data_ret = 0;
1713 type = QNULL;
1715 else if (STRINGP (obj))
1717 xassert (! STRING_MULTIBYTE (obj));
1718 if (NILP (type))
1719 type = QSTRING;
1720 *format_ret = 8;
1721 *size_ret = SBYTES (obj);
1722 *data_ret = SDATA (obj);
1723 *nofree_ret = 1;
1725 else if (SYMBOLP (obj))
1727 *format_ret = 32;
1728 *size_ret = 1;
1729 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1730 (*data_ret) [sizeof (Atom)] = 0;
1731 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1732 if (NILP (type)) type = QATOM;
1734 else if (INTEGERP (obj)
1735 && XINT (obj) < 0xFFFF
1736 && XINT (obj) > -0xFFFF)
1738 *format_ret = 16;
1739 *size_ret = 1;
1740 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1741 (*data_ret) [sizeof (short)] = 0;
1742 (*(short **) data_ret) [0] = (short) XINT (obj);
1743 if (NILP (type)) type = QINTEGER;
1745 else if (INTEGERP (obj)
1746 || (CONSP (obj) && INTEGERP (XCAR (obj))
1747 && (INTEGERP (XCDR (obj))
1748 || (CONSP (XCDR (obj))
1749 && INTEGERP (XCAR (XCDR (obj)))))))
1751 *format_ret = 32;
1752 *size_ret = 1;
1753 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1754 (*data_ret) [sizeof (long)] = 0;
1755 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1756 if (NILP (type)) type = QINTEGER;
1758 else if (VECTORP (obj))
1760 /* Lisp_Vectors may represent a set of ATOMs;
1761 a set of 16 or 32 bit INTEGERs;
1762 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1764 int i;
1766 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1767 /* This vector is an ATOM set */
1769 if (NILP (type)) type = QATOM;
1770 *size_ret = XVECTOR (obj)->size;
1771 *format_ret = 32;
1772 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1773 for (i = 0; i < *size_ret; i++)
1774 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1775 (*(Atom **) data_ret) [i]
1776 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1777 else
1778 Fsignal (Qerror, /* Qselection_error */
1779 Fcons (build_string
1780 ("all elements of selection vector must have same type"),
1781 Fcons (obj, Qnil)));
1783 #if 0 /* #### MULTIPLE doesn't work yet */
1784 else if (VECTORP (XVECTOR (obj)->contents [0]))
1785 /* This vector is an ATOM_PAIR set */
1787 if (NILP (type)) type = QATOM_PAIR;
1788 *size_ret = XVECTOR (obj)->size;
1789 *format_ret = 32;
1790 *data_ret = (unsigned char *)
1791 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1792 for (i = 0; i < *size_ret; i++)
1793 if (VECTORP (XVECTOR (obj)->contents [i]))
1795 Lisp_Object pair = XVECTOR (obj)->contents [i];
1796 if (XVECTOR (pair)->size != 2)
1797 Fsignal (Qerror,
1798 Fcons (build_string
1799 ("elements of the vector must be vectors of exactly two elements"),
1800 Fcons (pair, Qnil)));
1802 (*(Atom **) data_ret) [i * 2]
1803 = symbol_to_x_atom (dpyinfo, display,
1804 XVECTOR (pair)->contents [0]);
1805 (*(Atom **) data_ret) [(i * 2) + 1]
1806 = symbol_to_x_atom (dpyinfo, display,
1807 XVECTOR (pair)->contents [1]);
1809 else
1810 Fsignal (Qerror,
1811 Fcons (build_string
1812 ("all elements of the vector must be of the same type"),
1813 Fcons (obj, Qnil)));
1816 #endif
1817 else
1818 /* This vector is an INTEGER set, or something like it */
1820 *size_ret = XVECTOR (obj)->size;
1821 if (NILP (type)) type = QINTEGER;
1822 *format_ret = 16;
1823 for (i = 0; i < *size_ret; i++)
1824 if (CONSP (XVECTOR (obj)->contents [i]))
1825 *format_ret = 32;
1826 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1827 Fsignal (Qerror, /* Qselection_error */
1828 Fcons (build_string
1829 ("elements of selection vector must be integers or conses of integers"),
1830 Fcons (obj, Qnil)));
1832 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1833 for (i = 0; i < *size_ret; i++)
1834 if (*format_ret == 32)
1835 (*((unsigned long **) data_ret)) [i]
1836 = cons_to_long (XVECTOR (obj)->contents [i]);
1837 else
1838 (*((unsigned short **) data_ret)) [i]
1839 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1842 else
1843 Fsignal (Qerror, /* Qselection_error */
1844 Fcons (build_string ("unrecognised selection data"),
1845 Fcons (obj, Qnil)));
1847 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1850 static Lisp_Object
1851 clean_local_selection_data (obj)
1852 Lisp_Object obj;
1854 if (CONSP (obj)
1855 && INTEGERP (XCAR (obj))
1856 && CONSP (XCDR (obj))
1857 && INTEGERP (XCAR (XCDR (obj)))
1858 && NILP (XCDR (XCDR (obj))))
1859 obj = Fcons (XCAR (obj), XCDR (obj));
1861 if (CONSP (obj)
1862 && INTEGERP (XCAR (obj))
1863 && INTEGERP (XCDR (obj)))
1865 if (XINT (XCAR (obj)) == 0)
1866 return XCDR (obj);
1867 if (XINT (XCAR (obj)) == -1)
1868 return make_number (- XINT (XCDR (obj)));
1870 if (VECTORP (obj))
1872 int i;
1873 int size = XVECTOR (obj)->size;
1874 Lisp_Object copy;
1875 if (size == 1)
1876 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1877 copy = Fmake_vector (make_number (size), Qnil);
1878 for (i = 0; i < size; i++)
1879 XVECTOR (copy)->contents [i]
1880 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1881 return copy;
1883 return obj;
1886 /* Called from XTread_socket to handle SelectionNotify events.
1887 If it's the selection we are waiting for, stop waiting
1888 by setting the car of reading_selection_reply to non-nil.
1889 We store t there if the reply is successful, lambda if not. */
1891 void
1892 x_handle_selection_notify (event)
1893 XSelectionEvent *event;
1895 if (event->requestor != reading_selection_window)
1896 return;
1897 if (event->selection != reading_which_selection)
1898 return;
1900 TRACE0 ("Received SelectionNotify");
1901 XSETCAR (reading_selection_reply,
1902 (event->property != 0 ? Qt : Qlambda));
1906 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
1907 Sx_own_selection_internal, 2, 2, 0,
1908 doc: /* Assert an X selection of the given TYPE with the given VALUE.
1909 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1910 \(Those are literal upper-case symbol names, since that's what X expects.)
1911 VALUE is typically a string, or a cons of two markers, but may be
1912 anything that the functions on `selection-converter-alist' know about. */)
1913 (selection_name, selection_value)
1914 Lisp_Object selection_name, selection_value;
1916 check_x ();
1917 CHECK_SYMBOL (selection_name);
1918 if (NILP (selection_value)) error ("selection-value may not be nil");
1919 x_own_selection (selection_name, selection_value);
1920 return selection_value;
1924 /* Request the selection value from the owner. If we are the owner,
1925 simply return our selection value. If we are not the owner, this
1926 will block until all of the data has arrived. */
1928 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
1929 Sx_get_selection_internal, 2, 2, 0,
1930 doc: /* Return text selected from some X window.
1931 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1932 \(Those are literal upper-case symbol names, since that's what X expects.)
1933 TYPE is the type of data desired, typically `STRING'. */)
1934 (selection_symbol, target_type)
1935 Lisp_Object selection_symbol, target_type;
1937 Lisp_Object val = Qnil;
1938 struct gcpro gcpro1, gcpro2;
1939 GCPRO2 (target_type, val); /* we store newly consed data into these */
1940 check_x ();
1941 CHECK_SYMBOL (selection_symbol);
1943 #if 0 /* #### MULTIPLE doesn't work yet */
1944 if (CONSP (target_type)
1945 && XCAR (target_type) == QMULTIPLE)
1947 CHECK_VECTOR (XCDR (target_type));
1948 /* So we don't destructively modify this... */
1949 target_type = copy_multiple_data (target_type);
1951 else
1952 #endif
1953 CHECK_SYMBOL (target_type);
1955 val = x_get_local_selection (selection_symbol, target_type, 1);
1957 if (NILP (val))
1959 val = x_get_foreign_selection (selection_symbol, target_type);
1960 goto DONE;
1963 if (CONSP (val)
1964 && SYMBOLP (XCAR (val)))
1966 val = XCDR (val);
1967 if (CONSP (val) && NILP (XCDR (val)))
1968 val = XCAR (val);
1970 val = clean_local_selection_data (val);
1971 DONE:
1972 UNGCPRO;
1973 return val;
1976 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
1977 Sx_disown_selection_internal, 1, 2, 0,
1978 doc: /* If we own the selection SELECTION, disown it.
1979 Disowning it means there is no such selection. */)
1980 (selection, time)
1981 Lisp_Object selection;
1982 Lisp_Object time;
1984 Time timestamp;
1985 Atom selection_atom;
1986 struct selection_input_event event;
1987 Display *display;
1988 struct x_display_info *dpyinfo;
1989 struct frame *sf = SELECTED_FRAME ();
1991 check_x ();
1992 display = FRAME_X_DISPLAY (sf);
1993 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
1994 CHECK_SYMBOL (selection);
1995 if (NILP (time))
1996 timestamp = last_event_timestamp;
1997 else
1998 timestamp = cons_to_long (time);
2000 if (NILP (assq_no_quit (selection, Vselection_alist)))
2001 return Qnil; /* Don't disown the selection when we're not the owner. */
2003 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
2005 BLOCK_INPUT;
2006 XSetSelectionOwner (display, selection_atom, None, timestamp);
2007 UNBLOCK_INPUT;
2009 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2010 generated for a window which owns the selection when that window sets
2011 the selection owner to None. The NCD server does, the MIT Sun4 server
2012 doesn't. So we synthesize one; this means we might get two, but
2013 that's ok, because the second one won't have any effect. */
2014 SELECTION_EVENT_DISPLAY (&event) = display;
2015 SELECTION_EVENT_SELECTION (&event) = selection_atom;
2016 SELECTION_EVENT_TIME (&event) = timestamp;
2017 x_handle_selection_clear ((struct input_event *) &event);
2019 return Qt;
2022 /* Get rid of all the selections in buffer BUFFER.
2023 This is used when we kill a buffer. */
2025 void
2026 x_disown_buffer_selections (buffer)
2027 Lisp_Object buffer;
2029 Lisp_Object tail;
2030 struct buffer *buf = XBUFFER (buffer);
2032 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
2034 Lisp_Object elt, value;
2035 elt = XCAR (tail);
2036 value = XCDR (elt);
2037 if (CONSP (value) && MARKERP (XCAR (value))
2038 && XMARKER (XCAR (value))->buffer == buf)
2039 Fx_disown_selection_internal (XCAR (elt), Qnil);
2043 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
2044 0, 1, 0,
2045 doc: /* Whether the current Emacs process owns the given X Selection.
2046 The arg should be the name of the selection in question, typically one of
2047 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2048 \(Those are literal upper-case symbol names, since that's what X expects.)
2049 For convenience, the symbol nil is the same as `PRIMARY',
2050 and t is the same as `SECONDARY'. */)
2051 (selection)
2052 Lisp_Object selection;
2054 check_x ();
2055 CHECK_SYMBOL (selection);
2056 if (EQ (selection, Qnil)) selection = QPRIMARY;
2057 if (EQ (selection, Qt)) selection = QSECONDARY;
2059 if (NILP (Fassq (selection, Vselection_alist)))
2060 return Qnil;
2061 return Qt;
2064 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
2065 0, 1, 0,
2066 doc: /* Whether there is an owner for the given X Selection.
2067 The arg should be the name of the selection in question, typically one of
2068 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2069 \(Those are literal upper-case symbol names, since that's what X expects.)
2070 For convenience, the symbol nil is the same as `PRIMARY',
2071 and t is the same as `SECONDARY'. */)
2072 (selection)
2073 Lisp_Object selection;
2075 Window owner;
2076 Atom atom;
2077 Display *dpy;
2078 struct frame *sf = SELECTED_FRAME ();
2080 /* It should be safe to call this before we have an X frame. */
2081 if (! FRAME_X_P (sf))
2082 return Qnil;
2084 dpy = FRAME_X_DISPLAY (sf);
2085 CHECK_SYMBOL (selection);
2086 if (!NILP (Fx_selection_owner_p (selection)))
2087 return Qt;
2088 if (EQ (selection, Qnil)) selection = QPRIMARY;
2089 if (EQ (selection, Qt)) selection = QSECONDARY;
2090 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
2091 if (atom == 0)
2092 return Qnil;
2093 BLOCK_INPUT;
2094 owner = XGetSelectionOwner (dpy, atom);
2095 UNBLOCK_INPUT;
2096 return (owner ? Qt : Qnil);
2100 #ifdef CUT_BUFFER_SUPPORT
2102 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2103 static void
2104 initialize_cut_buffers (display, window)
2105 Display *display;
2106 Window window;
2108 unsigned char *data = (unsigned char *) "";
2109 BLOCK_INPUT;
2110 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2111 PropModeAppend, data, 0)
2112 FROB (XA_CUT_BUFFER0);
2113 FROB (XA_CUT_BUFFER1);
2114 FROB (XA_CUT_BUFFER2);
2115 FROB (XA_CUT_BUFFER3);
2116 FROB (XA_CUT_BUFFER4);
2117 FROB (XA_CUT_BUFFER5);
2118 FROB (XA_CUT_BUFFER6);
2119 FROB (XA_CUT_BUFFER7);
2120 #undef FROB
2121 UNBLOCK_INPUT;
2125 #define CHECK_CUT_BUFFER(symbol) \
2126 { CHECK_SYMBOL ((symbol)); \
2127 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2128 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2129 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2130 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2131 Fsignal (Qerror, \
2132 Fcons (build_string ("doesn't name a cut buffer"), \
2133 Fcons ((symbol), Qnil))); \
2136 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2137 Sx_get_cut_buffer_internal, 1, 1, 0,
2138 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2139 (buffer)
2140 Lisp_Object buffer;
2142 Window window;
2143 Atom buffer_atom;
2144 unsigned char *data;
2145 int bytes;
2146 Atom type;
2147 int format;
2148 unsigned long size;
2149 Lisp_Object ret;
2150 Display *display;
2151 struct x_display_info *dpyinfo;
2152 struct frame *sf = SELECTED_FRAME ();
2154 check_x ();
2155 display = FRAME_X_DISPLAY (sf);
2156 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
2157 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2158 CHECK_CUT_BUFFER (buffer);
2159 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2161 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2162 &type, &format, &size, 0);
2163 if (!data || !format)
2164 return Qnil;
2166 if (format != 8 || type != XA_STRING)
2167 Fsignal (Qerror,
2168 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2169 Fcons (x_atom_to_symbol (display, type),
2170 Fcons (make_number (format), Qnil))));
2172 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2173 /* Use xfree, not XFree, because x_get_window_property
2174 calls xmalloc itself. */
2175 xfree (data);
2176 return ret;
2180 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2181 Sx_store_cut_buffer_internal, 2, 2, 0,
2182 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2183 (buffer, string)
2184 Lisp_Object buffer, string;
2186 Window window;
2187 Atom buffer_atom;
2188 unsigned char *data;
2189 int bytes;
2190 int bytes_remaining;
2191 int max_bytes;
2192 Display *display;
2193 struct frame *sf = SELECTED_FRAME ();
2195 check_x ();
2196 display = FRAME_X_DISPLAY (sf);
2197 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2199 max_bytes = SELECTION_QUANTUM (display);
2200 if (max_bytes > MAX_SELECTION_QUANTUM)
2201 max_bytes = MAX_SELECTION_QUANTUM;
2203 CHECK_CUT_BUFFER (buffer);
2204 CHECK_STRING (string);
2205 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
2206 display, buffer);
2207 data = (unsigned char *) SDATA (string);
2208 bytes = SBYTES (string);
2209 bytes_remaining = bytes;
2211 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2213 initialize_cut_buffers (display, window);
2214 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2217 BLOCK_INPUT;
2219 /* Don't mess up with an empty value. */
2220 if (!bytes_remaining)
2221 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2222 PropModeReplace, data, 0);
2224 while (bytes_remaining)
2226 int chunk = (bytes_remaining < max_bytes
2227 ? bytes_remaining : max_bytes);
2228 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2229 (bytes_remaining == bytes
2230 ? PropModeReplace
2231 : PropModeAppend),
2232 data, chunk);
2233 data += chunk;
2234 bytes_remaining -= chunk;
2236 UNBLOCK_INPUT;
2237 return string;
2241 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2242 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2243 doc: /* Rotate the values of the cut buffers by the given number of step.
2244 Positive means shift the values forward, negative means backward. */)
2246 Lisp_Object n;
2248 Window window;
2249 Atom props[8];
2250 Display *display;
2251 struct frame *sf = SELECTED_FRAME ();
2253 check_x ();
2254 display = FRAME_X_DISPLAY (sf);
2255 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2256 CHECK_NUMBER (n);
2257 if (XINT (n) == 0)
2258 return n;
2259 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
2261 initialize_cut_buffers (display, window);
2262 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
2265 props[0] = XA_CUT_BUFFER0;
2266 props[1] = XA_CUT_BUFFER1;
2267 props[2] = XA_CUT_BUFFER2;
2268 props[3] = XA_CUT_BUFFER3;
2269 props[4] = XA_CUT_BUFFER4;
2270 props[5] = XA_CUT_BUFFER5;
2271 props[6] = XA_CUT_BUFFER6;
2272 props[7] = XA_CUT_BUFFER7;
2273 BLOCK_INPUT;
2274 XRotateWindowProperties (display, window, props, 8, XINT (n));
2275 UNBLOCK_INPUT;
2276 return n;
2279 #endif
2281 void
2282 syms_of_xselect ()
2284 defsubr (&Sx_get_selection_internal);
2285 defsubr (&Sx_own_selection_internal);
2286 defsubr (&Sx_disown_selection_internal);
2287 defsubr (&Sx_selection_owner_p);
2288 defsubr (&Sx_selection_exists_p);
2290 #ifdef CUT_BUFFER_SUPPORT
2291 defsubr (&Sx_get_cut_buffer_internal);
2292 defsubr (&Sx_store_cut_buffer_internal);
2293 defsubr (&Sx_rotate_cut_buffers_internal);
2294 #endif
2296 reading_selection_reply = Fcons (Qnil, Qnil);
2297 staticpro (&reading_selection_reply);
2298 reading_selection_window = 0;
2299 reading_which_selection = 0;
2301 property_change_wait_list = 0;
2302 prop_location_identifier = 0;
2303 property_change_reply = Fcons (Qnil, Qnil);
2304 staticpro (&property_change_reply);
2306 Vselection_alist = Qnil;
2307 staticpro (&Vselection_alist);
2309 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2310 doc: /* An alist associating X Windows selection-types with functions.
2311 These functions are called to convert the selection, with three args:
2312 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2313 a desired type to which the selection should be converted;
2314 and the local selection value (whatever was given to `x-own-selection').
2316 The function should return the value to send to the X server
2317 \(typically a string). A return value of nil
2318 means that the conversion could not be done.
2319 A return value which is the symbol `NULL'
2320 means that a side-effect was executed,
2321 and there is no meaningful selection value. */);
2322 Vselection_converter_alist = Qnil;
2324 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2325 doc: /* A list of functions to be called when Emacs loses an X selection.
2326 \(This happens when some other X client makes its own selection
2327 or when a Lisp program explicitly clears the selection.)
2328 The functions are called with one argument, the selection type
2329 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2330 Vx_lost_selection_hooks = Qnil;
2332 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2333 doc: /* A list of functions to be called when Emacs answers a selection request.
2334 The functions are called with four arguments:
2335 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2336 - the selection-type which Emacs was asked to convert the
2337 selection into before sending (for example, `STRING' or `LENGTH');
2338 - a flag indicating success or failure for responding to the request.
2339 We might have failed (and declined the request) for any number of reasons,
2340 including being asked for a selection that we no longer own, or being asked
2341 to convert into a type that we don't know about or that is inappropriate.
2342 This hook doesn't let you change the behavior of Emacs's selection replies,
2343 it merely informs you that they have happened. */);
2344 Vx_sent_selection_hooks = Qnil;
2346 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
2347 doc: /* Coding system for communicating with other X clients.
2348 When sending or receiving text via cut_buffer, selection, and clipboard,
2349 the text is encoded or decoded by this coding system.
2350 The default value is `compound-text-with-extensions'. */);
2351 Vselection_coding_system = intern ("compound-text-with-extensions");
2353 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
2354 doc: /* Coding system for the next communication with other X clients.
2355 Usually, `selection-coding-system' is used for communicating with
2356 other X clients. But, if this variable is set, it is used for the
2357 next communication only. After the communication, this variable is
2358 set to nil. */);
2359 Vnext_selection_coding_system = Qnil;
2361 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2362 doc: /* Number of milliseconds to wait for a selection reply.
2363 If the selection owner doesn't reply in this time, we give up.
2364 A value of 0 means wait as long as necessary. This is initialized from the
2365 \"*selectionTimeout\" resource. */);
2366 x_selection_timeout = 0;
2368 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2369 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2370 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2371 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2372 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2373 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2374 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2375 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2376 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
2377 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2378 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2379 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2380 QINCR = intern ("INCR"); staticpro (&QINCR);
2381 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2382 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2383 QATOM = intern ("ATOM"); staticpro (&QATOM);
2384 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2385 QNULL = intern ("NULL"); staticpro (&QNULL);
2386 Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
2387 staticpro (&Qcompound_text_with_extensions);
2389 #ifdef CUT_BUFFER_SUPPORT
2390 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2391 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2392 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2393 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2394 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2395 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2396 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2397 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2398 #endif
2400 Qforeign_selection = intern ("foreign-selection");
2401 staticpro (&Qforeign_selection);
2404 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2405 (do not change this comment) */