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