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