(font-lock-mode): Don't add to after-change-functions
[bpt/emacs.git] / src / xselect.c
CommitLineData
2408b3a1 1/* X Selection processing for Emacs.
002bbc0e 2 Copyright (C) 1993, 1994, 1995, 1996 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 30
ede4db72
RS
31#define CUT_BUFFER_SUPPORT
32
ede4db72
RS
33Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
34 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
35 QATOM_PAIR;
36
37#ifdef CUT_BUFFER_SUPPORT
38Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
39 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
40#endif
41
8f4f023f
RS
42static Lisp_Object Vx_lost_selection_hooks;
43static Lisp_Object Vx_sent_selection_hooks;
ede4db72
RS
44
45/* If this is a smaller number than the max-request-size of the display,
46 emacs will use INCR selection transfer when the selection is larger
47 than this. The max-request-size is usually around 64k, so if you want
48 emacs to use incremental selection transfers when the selection is
49 smaller than that, set this. I added this mostly for debugging the
8f4f023f 50 incremental transfer stuff, but it might improve server performance. */
ede4db72
RS
51#define MAX_SELECTION_QUANTUM 0xFFFFFF
52
c3498e64
JB
53#ifdef HAVE_X11R4
54#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
55#else
56#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
57#endif
ede4db72 58
7da64e5c 59/* The timestamp of the last input event Emacs received from the X server. */
29674445
KH
60/* Defined in keyboard.c. */
61extern unsigned 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;
0158abbc 213 /* This was allocated by Xlib, so use XFree. */
ede4db72
RS
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
002bbc0e 723 /* Use free, not XFree, because lisp_data_to_selection_data
0158abbc 724 calls xmalloc itself. */
aca39f42 725 if (!nofree)
002bbc0e 726 free (data);
ede4db72
RS
727 }
728 unbind_to (count, Qnil);
729
730 DONE:
731
732 UNGCPRO;
733
734 /* Let random lisp code notice that the selection has been asked for. */
735 {
9d2d1dd8
KH
736 Lisp_Object rest;
737 rest = Vx_sent_selection_hooks;
ede4db72
RS
738 if (!EQ (rest, Qunbound))
739 for (; CONSP (rest); rest = Fcdr (rest))
740 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
741 }
742}
743\f
744/* Handle a SelectionClear event EVENT, which indicates that some other
745 client cleared out our previously asserted selection.
746 This is called from keyboard.c when such an event is found in the queue. */
747
748void
749x_handle_selection_clear (event)
750 struct input_event *event;
751{
752 Display *display = SELECTION_EVENT_DISPLAY (event);
753 Atom selection = SELECTION_EVENT_SELECTION (event);
754 Time changed_owner_time = SELECTION_EVENT_TIME (event);
755
756 Lisp_Object selection_symbol, local_selection_data;
757 Time local_selection_time;
5c3a351a 758 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 759
5c3a351a 760 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
ede4db72
RS
761
762 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
763
764 /* Well, we already believe that we don't own it, so that's just fine. */
765 if (NILP (local_selection_data)) return;
766
767 local_selection_time = (Time)
768 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
769
770 /* This SelectionClear is for a selection that we no longer own, so we can
771 disregard it. (That is, we have reasserted the selection since this
772 request was generated.) */
773
774 if (changed_owner_time != CurrentTime
775 && local_selection_time > changed_owner_time)
776 return;
777
778 /* Otherwise, we're really honest and truly being told to drop it.
779 Don't use Fdelq as that may QUIT;. */
780
781 if (EQ (local_selection_data, Fcar (Vselection_alist)))
782 Vselection_alist = Fcdr (Vselection_alist);
783 else
784 {
785 Lisp_Object rest;
786 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
787 if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
788 {
789 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
790 break;
791 }
792 }
793
794 /* Let random lisp code notice that the selection has been stolen. */
795
796 {
d1f21a66
RS
797 Lisp_Object rest;
798 rest = Vx_lost_selection_hooks;
ede4db72 799 if (!EQ (rest, Qunbound))
d1f21a66
RS
800 {
801 for (; CONSP (rest); rest = Fcdr (rest))
802 call1 (Fcar (rest), selection_symbol);
7c6b2ea4 803 prepare_menu_bars ();
d1f21a66
RS
804 redisplay_preserve_echo_area ();
805 }
ede4db72
RS
806 }
807}
808
118bd841
RS
809/* Clear all selections that were made from frame F.
810 We do this when about to delete a frame. */
811
812void
813x_clear_frame_selections (f)
814 FRAME_PTR f;
815{
816 Lisp_Object frame;
817 Lisp_Object rest;
818
90851bbe 819 XSETFRAME (frame, f);
118bd841
RS
820
821 /* Otherwise, we're really honest and truly being told to drop it.
822 Don't use Fdelq as that may QUIT;. */
823
0d199f9c
RS
824 /* Delete elements from the beginning of Vselection_alist. */
825 while (!NILP (Vselection_alist)
826 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
827 {
828 /* Let random Lisp code notice that the selection has been stolen. */
829 Lisp_Object hooks, selection_symbol;
830
831 hooks = Vx_lost_selection_hooks;
832 selection_symbol = Fcar (Fcar (Vselection_alist));
833
834 if (!EQ (hooks, Qunbound))
835 {
836 for (; CONSP (hooks); hooks = Fcdr (hooks))
837 call1 (Fcar (hooks), selection_symbol);
996b804d
MB
838#if 0 /* This can crash when deleting a frame
839 from x_connection_closed. Anyway, it seems unnecessary;
840 something else should cause a redisplay. */
0d199f9c 841 redisplay_preserve_echo_area ();
996b804d 842#endif
0d199f9c
RS
843 }
844
845 Vselection_alist = Fcdr (Vselection_alist);
846 }
847
848 /* Delete elements after the beginning of Vselection_alist. */
118bd841
RS
849 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
850 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
851 {
852 /* Let random Lisp code notice that the selection has been stolen. */
853 Lisp_Object hooks, selection_symbol;
854
855 hooks = Vx_lost_selection_hooks;
0d199f9c 856 selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
118bd841
RS
857
858 if (!EQ (hooks, Qunbound))
859 {
860 for (; CONSP (hooks); hooks = Fcdr (hooks))
861 call1 (Fcar (hooks), selection_symbol);
996b804d 862#if 0 /* See above */
118bd841 863 redisplay_preserve_echo_area ();
996b804d 864#endif
118bd841
RS
865 }
866 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
867 break;
868 }
869}
ede4db72 870\f
ede4db72
RS
871/* Nonzero if any properties for DISPLAY and WINDOW
872 are on the list of what we are waiting for. */
873
874static int
875waiting_for_other_props_on_window (display, window)
876 Display *display;
877 Window window;
878{
879 struct prop_location *rest = property_change_wait_list;
880 while (rest)
881 if (rest->display == display && rest->window == window)
882 return 1;
883 else
884 rest = rest->next;
885 return 0;
886}
887
888/* Add an entry to the list of property changes we are waiting for.
889 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
890 The return value is a number that uniquely identifies
891 this awaited property change. */
892
d1f21a66 893static struct prop_location *
ede4db72
RS
894expect_property_change (display, window, property, state)
895 Display *display;
896 Window window;
897 Lisp_Object property;
898 int state;
899{
900 struct prop_location *pl
901 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
2f65feb6 902 pl->identifier = ++prop_location_identifier;
ede4db72
RS
903 pl->display = display;
904 pl->window = window;
905 pl->property = property;
906 pl->desired_state = state;
907 pl->next = property_change_wait_list;
d1f21a66 908 pl->arrived = 0;
ede4db72 909 property_change_wait_list = pl;
d1f21a66 910 return pl;
ede4db72
RS
911}
912
913/* Delete an entry from the list of property changes we are waiting for.
2f65feb6 914 IDENTIFIER is the number that uniquely identifies the entry. */
ede4db72
RS
915
916static void
d1f21a66
RS
917unexpect_property_change (location)
918 struct prop_location *location;
ede4db72
RS
919{
920 struct prop_location *prev = 0, *rest = property_change_wait_list;
921 while (rest)
922 {
d1f21a66 923 if (rest == location)
ede4db72
RS
924 {
925 if (prev)
926 prev->next = rest->next;
927 else
928 property_change_wait_list = rest->next;
002bbc0e 929 free (rest);
ede4db72
RS
930 return;
931 }
932 prev = rest;
933 rest = rest->next;
934 }
935}
936
2f65feb6
RS
937/* Remove the property change expectation element for IDENTIFIER. */
938
939static Lisp_Object
940wait_for_property_change_unwind (identifierval)
941 Lisp_Object identifierval;
942{
c4898489
KH
943 unexpect_property_change ((struct prop_location *)
944 (XFASTINT (XCONS (identifierval)->car) << 16
945 | XFASTINT (XCONS (identifierval)->cdr)));
ab552306 946 return Qnil;
2f65feb6
RS
947}
948
ede4db72 949/* Actually wait for a property change.
2f65feb6 950 IDENTIFIER should be the value that expect_property_change returned. */
ede4db72
RS
951
952static void
d1f21a66
RS
953wait_for_property_change (location)
954 struct prop_location *location;
ede4db72 955{
2f65feb6
RS
956 int secs, usecs;
957 int count = specpdl_ptr - specpdl;
d1f21a66
RS
958 Lisp_Object tem;
959
c4898489
KH
960 tem = Fcons (Qnil, Qnil);
961 XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
962 XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
2f65feb6
RS
963
964 /* Make sure to do unexpect_property_change if we quit or err. */
d1f21a66 965 record_unwind_protect (wait_for_property_change_unwind, tem);
2f65feb6 966
ede4db72 967 XCONS (property_change_reply)->car = Qnil;
2f65feb6 968
afe1529d
RS
969 property_change_reply_object = location;
970 /* If the event we are waiting for arrives beyond here, it will set
971 property_change_reply, because property_change_reply_object says so. */
d1f21a66
RS
972 if (! location->arrived)
973 {
d1f21a66
RS
974 secs = x_selection_timeout / 1000;
975 usecs = (x_selection_timeout % 1000) * 1000;
976 wait_reading_process_input (secs, usecs, property_change_reply, 0);
977
978 if (NILP (XCONS (property_change_reply)->car))
606140dd 979 error ("Timed out waiting for property-notify event");
d1f21a66 980 }
2f65feb6
RS
981
982 unbind_to (count, Qnil);
ede4db72
RS
983}
984
985/* Called from XTread_socket in response to a PropertyNotify event. */
986
987void
988x_handle_property_notify (event)
989 XPropertyEvent *event;
990{
991 struct prop_location *prev = 0, *rest = property_change_wait_list;
992 while (rest)
993 {
994 if (rest->property == event->atom
995 && rest->window == event->window
996 && rest->display == event->display
997 && rest->desired_state == event->state)
998 {
999#if 0
1000 fprintf (stderr, "Saw expected prop-%s on %s\n",
1001 (event->state == PropertyDelete ? "delete" : "change"),
5c3a351a 1002 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
ede4db72
RS
1003 event->atom))
1004 ->name->data);
1005#endif
1006
d1f21a66
RS
1007 rest->arrived = 1;
1008
ede4db72
RS
1009 /* If this is the one wait_for_property_change is waiting for,
1010 tell it to wake up. */
d1f21a66 1011 if (rest == property_change_reply_object)
ede4db72
RS
1012 XCONS (property_change_reply)->car = Qt;
1013
1014 if (prev)
1015 prev->next = rest->next;
1016 else
1017 property_change_wait_list = rest->next;
002bbc0e 1018 free (rest);
ede4db72
RS
1019 return;
1020 }
1021 prev = rest;
1022 rest = rest->next;
1023 }
1024#if 0
1025 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1026 (event->state == PropertyDelete ? "delete" : "change"),
5c3a351a
RS
1027 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1028 event->display, event->atom))
ede4db72
RS
1029 ->name->data);
1030#endif
1031}
1032
1033
1034\f
1035#if 0 /* #### MULTIPLE doesn't work yet */
1036
1037static Lisp_Object
1038fetch_multiple_target (event)
1039 XSelectionRequestEvent *event;
1040{
1041 Display *display = event->display;
5d0ba25b 1042 Window window = event->requestor;
ede4db72
RS
1043 Atom target = event->target;
1044 Atom selection_atom = event->selection;
1045 int result;
1046
1047 return
1048 Fcons (QMULTIPLE,
1049 x_get_window_property_as_lisp_data (display, window, target,
1050 QMULTIPLE, selection_atom));
1051}
1052
1053static Lisp_Object
1054copy_multiple_data (obj)
1055 Lisp_Object obj;
1056{
1057 Lisp_Object vec;
1058 int i;
1059 int size;
1060 if (CONSP (obj))
1061 return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
1062
1063 CHECK_VECTOR (obj, 0);
1064 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1065 for (i = 0; i < size; i++)
1066 {
1067 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1068 CHECK_VECTOR (vec2, 0);
1069 if (XVECTOR (vec2)->size != 2)
1070 /* ??? Confusing error message */
1071 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1072 Fcons (vec2, Qnil)));
1073 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1074 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1075 = XVECTOR (vec2)->contents [0];
1076 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1077 = XVECTOR (vec2)->contents [1];
1078 }
1079 return vec;
1080}
1081
1082#endif
1083
1084\f
1085/* Variables for communication with x_handle_selection_notify. */
1086static Atom reading_which_selection;
1087static Lisp_Object reading_selection_reply;
1088static Window reading_selection_window;
1089
1090/* Do protocol to read selection-data from the server.
1091 Converts this to Lisp data and returns it. */
1092
1093static Lisp_Object
1094x_get_foreign_selection (selection_symbol, target_type)
1095 Lisp_Object selection_symbol, target_type;
1096{
5d0ba25b 1097 Window requestor_window = FRAME_X_WINDOW (selected_frame);
3834c318 1098 Display *display = FRAME_X_DISPLAY (selected_frame);
5c3a351a 1099 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
5d0ba25b 1100 Time requestor_time = last_event_timestamp;
5c3a351a
RS
1101 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1102 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
ede4db72 1103 Atom type_atom;
80da0190 1104 int secs, usecs;
55b2d45d
RS
1105 int count = specpdl_ptr - specpdl;
1106 Lisp_Object frame;
ede4db72
RS
1107
1108 if (CONSP (target_type))
5c3a351a 1109 type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
ede4db72 1110 else
5c3a351a 1111 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
ede4db72
RS
1112
1113 BLOCK_INPUT;
a7b24d46 1114 x_catch_errors (display);
ede4db72 1115 XConvertSelection (display, selection_atom, type_atom, target_property,
5d0ba25b 1116 requestor_window, requestor_time);
5c3a351a 1117 XFlush (display);
ede4db72
RS
1118
1119 /* Prepare to block until the reply has been read. */
5d0ba25b 1120 reading_selection_window = requestor_window;
ede4db72
RS
1121 reading_which_selection = selection_atom;
1122 XCONS (reading_selection_reply)->car = Qnil;
55b2d45d
RS
1123
1124 frame = some_frame_on_display (dpyinfo);
1125
1126 /* If the display no longer has frames, we can't expect
1127 to get many more selection requests from it, so don't
1128 bother trying to queue them. */
1129 if (!NILP (frame))
1130 {
1131 x_start_queuing_selection_requests (display);
1132
1133 record_unwind_protect (queue_selection_requests_unwind,
1134 frame);
1135 }
ede4db72
RS
1136 UNBLOCK_INPUT;
1137
80da0190
RS
1138 /* This allows quits. Also, don't wait forever. */
1139 secs = x_selection_timeout / 1000;
1140 usecs = (x_selection_timeout % 1000) * 1000;
1141 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
ede4db72 1142
7c6b2ea4 1143 BLOCK_INPUT;
a7b24d46
RS
1144 x_check_errors (display, "Cannot get selection: %s");
1145 x_uncatch_errors (display);
55b2d45d 1146 unbind_to (count, Qnil);
7c6b2ea4
RS
1147 UNBLOCK_INPUT;
1148
ede4db72 1149 if (NILP (XCONS (reading_selection_reply)->car))
606140dd
KH
1150 error ("Timed out waiting for reply from selection owner");
1151 if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
1152 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
ede4db72
RS
1153
1154 /* Otherwise, the selection is waiting for us on the requested property. */
1155 return
5d0ba25b 1156 x_get_window_property_as_lisp_data (display, requestor_window,
ede4db72
RS
1157 target_property, target_type,
1158 selection_atom);
1159}
1160\f
1161/* Subroutines of x_get_window_property_as_lisp_data */
1162
002bbc0e 1163/* Use free, not XFree, to free the data obtained with this function. */
0158abbc 1164
ede4db72
RS
1165static void
1166x_get_window_property (display, window, property, data_ret, bytes_ret,
1167 actual_type_ret, actual_format_ret, actual_size_ret,
1168 delete_p)
1169 Display *display;
1170 Window window;
1171 Atom property;
1172 unsigned char **data_ret;
1173 int *bytes_ret;
1174 Atom *actual_type_ret;
1175 int *actual_format_ret;
1176 unsigned long *actual_size_ret;
1177 int delete_p;
1178{
1179 int total_size;
1180 unsigned long bytes_remaining;
1181 int offset = 0;
1182 unsigned char *tmp_data = 0;
1183 int result;
1184 int buffer_size = SELECTION_QUANTUM (display);
1185 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1186
1187 BLOCK_INPUT;
1188 /* First probe the thing to find out how big it is. */
1189 result = XGetWindowProperty (display, window, property,
137edb72 1190 0L, 0L, False, AnyPropertyType,
ede4db72
RS
1191 actual_type_ret, actual_format_ret,
1192 actual_size_ret,
1193 &bytes_remaining, &tmp_data);
ede4db72
RS
1194 if (result != Success)
1195 {
2f65feb6 1196 UNBLOCK_INPUT;
ede4db72
RS
1197 *data_ret = 0;
1198 *bytes_ret = 0;
1199 return;
1200 }
0158abbc
RS
1201 /* This was allocated by Xlib, so use XFree. */
1202 XFree ((char *) tmp_data);
ede4db72
RS
1203
1204 if (*actual_type_ret == None || *actual_format_ret == 0)
1205 {
2f65feb6 1206 UNBLOCK_INPUT;
ede4db72
RS
1207 return;
1208 }
1209
1210 total_size = bytes_remaining + 1;
1211 *data_ret = (unsigned char *) xmalloc (total_size);
1212
2a1a4c9d 1213 /* Now read, until we've gotten it all. */
ede4db72
RS
1214 while (bytes_remaining)
1215 {
1216#if 0
1217 int last = bytes_remaining;
1218#endif
1219 result
1220 = XGetWindowProperty (display, window, property,
137edb72 1221 (long)offset/4, (long)buffer_size/4,
2f65feb6 1222 False,
ede4db72
RS
1223 AnyPropertyType,
1224 actual_type_ret, actual_format_ret,
1225 actual_size_ret, &bytes_remaining, &tmp_data);
1226#if 0
1227 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1228#endif
1229 /* If this doesn't return Success at this point, it means that
1230 some clod deleted the selection while we were in the midst of
1231 reading it. Deal with that, I guess....
1232 */
1233 if (result != Success) break;
1234 *actual_size_ret *= *actual_format_ret / 8;
1235 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1236 offset += *actual_size_ret;
0158abbc
RS
1237 /* This was allocated by Xlib, so use XFree. */
1238 XFree ((char *) tmp_data);
ede4db72 1239 }
2f65feb6 1240
5c3a351a 1241 XFlush (display);
ede4db72
RS
1242 UNBLOCK_INPUT;
1243 *bytes_ret = offset;
1244}
1245\f
002bbc0e 1246/* Use free, not XFree, to free the data obtained with this function. */
0158abbc 1247
ede4db72
RS
1248static void
1249receive_incremental_selection (display, window, property, target_type,
1250 min_size_bytes, data_ret, size_bytes_ret,
1251 type_ret, format_ret, size_ret)
1252 Display *display;
1253 Window window;
1254 Atom property;
1255 Lisp_Object target_type; /* for error messages only */
1256 unsigned int min_size_bytes;
1257 unsigned char **data_ret;
1258 int *size_bytes_ret;
1259 Atom *type_ret;
1260 unsigned long *size_ret;
1261 int *format_ret;
1262{
1263 int offset = 0;
d1f21a66 1264 struct prop_location *wait_object;
ede4db72
RS
1265 *size_bytes_ret = min_size_bytes;
1266 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1267#if 0
1268 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1269#endif
2f65feb6
RS
1270
1271 /* At this point, we have read an INCR property.
1272 Delete the property to ack it.
1273 (But first, prepare to receive the next event in this handshake.)
ede4db72
RS
1274
1275 Now, we must loop, waiting for the sending window to put a value on
1276 that property, then reading the property, then deleting it to ack.
1277 We are done when the sender places a property of length 0.
1278 */
2f65feb6
RS
1279 BLOCK_INPUT;
1280 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1281 XDeleteProperty (display, window, property);
d1f21a66
RS
1282 wait_object = expect_property_change (display, window, property,
1283 PropertyNewValue);
5c3a351a 1284 XFlush (display);
2f65feb6
RS
1285 UNBLOCK_INPUT;
1286
ede4db72
RS
1287 while (1)
1288 {
1289 unsigned char *tmp_data;
1290 int tmp_size_bytes;
d1f21a66 1291 wait_for_property_change (wait_object);
ede4db72 1292 /* expect it again immediately, because x_get_window_property may
2a1a4c9d 1293 .. no it won't, I don't get it.
ede4db72
RS
1294 .. Ok, I get it now, the Xt code that implements INCR is broken.
1295 */
ede4db72
RS
1296 x_get_window_property (display, window, property,
1297 &tmp_data, &tmp_size_bytes,
1298 type_ret, format_ret, size_ret, 1);
1299
1300 if (tmp_size_bytes == 0) /* we're done */
1301 {
1302#if 0
1303 fprintf (stderr, " read INCR done\n");
1304#endif
2f65feb6
RS
1305 if (! waiting_for_other_props_on_window (display, window))
1306 XSelectInput (display, window, STANDARD_EVENT_SET);
d1f21a66 1307 unexpect_property_change (wait_object);
002bbc0e 1308 /* Use free, not XFree, because x_get_window_property
0158abbc 1309 calls xmalloc itself. */
002bbc0e 1310 if (tmp_data) free (tmp_data);
ede4db72
RS
1311 break;
1312 }
2f65feb6
RS
1313
1314 BLOCK_INPUT;
1315 XDeleteProperty (display, window, property);
d1f21a66
RS
1316 wait_object = expect_property_change (display, window, property,
1317 PropertyNewValue);
5c3a351a 1318 XFlush (display);
2f65feb6
RS
1319 UNBLOCK_INPUT;
1320
ede4db72
RS
1321#if 0
1322 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1323#endif
1324 if (*size_bytes_ret < offset + tmp_size_bytes)
1325 {
1326#if 0
1327 fprintf (stderr, " read INCR realloc %d -> %d\n",
1328 *size_bytes_ret, offset + tmp_size_bytes);
1329#endif
1330 *size_bytes_ret = offset + tmp_size_bytes;
1331 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1332 }
018cfa07 1333 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
ede4db72 1334 offset += tmp_size_bytes;
002bbc0e 1335 /* Use free, not XFree, because x_get_window_property
0158abbc 1336 calls xmalloc itself. */
002bbc0e 1337 free (tmp_data);
ede4db72
RS
1338 }
1339}
1340\f
1341/* Once a requested selection is "ready" (we got a SelectionNotify event),
1342 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1343 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1344
1345static Lisp_Object
1346x_get_window_property_as_lisp_data (display, window, property, target_type,
1347 selection_atom)
1348 Display *display;
1349 Window window;
1350 Atom property;
1351 Lisp_Object target_type; /* for error messages only */
1352 Atom selection_atom; /* for error messages only */
1353{
1354 Atom actual_type;
1355 int actual_format;
1356 unsigned long actual_size;
1357 unsigned char *data = 0;
1358 int bytes = 0;
1359 Lisp_Object val;
5c3a351a 1360 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72
RS
1361
1362 x_get_window_property (display, window, property, &data, &bytes,
1363 &actual_type, &actual_format, &actual_size, 1);
1364 if (! data)
1365 {
1366 int there_is_a_selection_owner;
1367 BLOCK_INPUT;
1368 there_is_a_selection_owner
1369 = XGetSelectionOwner (display, selection_atom);
1370 UNBLOCK_INPUT;
1371 while (1) /* Note debugger can no longer return, so this is obsolete */
1372 Fsignal (Qerror,
1373 there_is_a_selection_owner ?
1374 Fcons (build_string ("selection owner couldn't convert"),
1375 actual_type
1376 ? Fcons (target_type,
5c3a351a
RS
1377 Fcons (x_atom_to_symbol (dpyinfo, display,
1378 actual_type),
ede4db72
RS
1379 Qnil))
1380 : Fcons (target_type, Qnil))
1381 : Fcons (build_string ("no selection"),
5c3a351a
RS
1382 Fcons (x_atom_to_symbol (dpyinfo, display,
1383 selection_atom),
ede4db72
RS
1384 Qnil)));
1385 }
1386
5c3a351a 1387 if (actual_type == dpyinfo->Xatom_INCR)
ede4db72
RS
1388 {
1389 /* That wasn't really the data, just the beginning. */
1390
1391 unsigned int min_size_bytes = * ((unsigned int *) data);
1392 BLOCK_INPUT;
002bbc0e 1393 /* Use free, not XFree, because x_get_window_property
0158abbc 1394 calls xmalloc itself. */
002bbc0e 1395 free ((char *) data);
ede4db72
RS
1396 UNBLOCK_INPUT;
1397 receive_incremental_selection (display, window, property, target_type,
1398 min_size_bytes, &data, &bytes,
1399 &actual_type, &actual_format,
1400 &actual_size);
1401 }
1402
2f65feb6
RS
1403 BLOCK_INPUT;
1404 XDeleteProperty (display, window, property);
5c3a351a 1405 XFlush (display);
2f65feb6
RS
1406 UNBLOCK_INPUT;
1407
ede4db72
RS
1408 /* It's been read. Now convert it to a lisp object in some semi-rational
1409 manner. */
1410 val = selection_data_to_lisp_data (display, data, bytes,
1411 actual_type, actual_format);
1412
002bbc0e 1413 /* Use free, not XFree, because x_get_window_property
0158abbc 1414 calls xmalloc itself. */
002bbc0e 1415 free ((char *) data);
ede4db72
RS
1416 return val;
1417}
1418\f
1419/* These functions convert from the selection data read from the server into
1420 something that we can use from Lisp, and vice versa.
1421
1422 Type: Format: Size: Lisp Type:
1423 ----- ------- ----- -----------
1424 * 8 * String
1425 ATOM 32 1 Symbol
1426 ATOM 32 > 1 Vector of Symbols
1427 * 16 1 Integer
1428 * 16 > 1 Vector of Integers
1429 * 32 1 if <=16 bits: Integer
1430 if > 16 bits: Cons of top16, bot16
1431 * 32 > 1 Vector of the above
1432
1433 When converting a Lisp number to C, it is assumed to be of format 16 if
1434 it is an integer, and of format 32 if it is a cons of two integers.
1435
1436 When converting a vector of numbers from Lisp to C, it is assumed to be
1437 of format 16 if every element in the vector is an integer, and is assumed
1438 to be of format 32 if any element is a cons of two integers.
1439
1440 When converting an object to C, it may be of the form (SYMBOL . <data>)
1441 where SYMBOL is what we should claim that the type is. Format and
1442 representation are as above. */
1443
1444
1445
1446static Lisp_Object
1447selection_data_to_lisp_data (display, data, size, type, format)
1448 Display *display;
1449 unsigned char *data;
1450 Atom type;
1451 int size, format;
1452{
5c3a351a 1453 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1454
5c3a351a 1455 if (type == dpyinfo->Xatom_NULL)
ede4db72
RS
1456 return QNULL;
1457
1458 /* Convert any 8-bit data to a string, for compactness. */
1459 else if (format == 8)
1460 return make_string ((char *) data, size);
1461
1462 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1463 a vector of symbols.
1464 */
1465 else if (type == XA_ATOM)
1466 {
1467 int i;
1468 if (size == sizeof (Atom))
5c3a351a 1469 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
ede4db72
RS
1470 else
1471 {
1472 Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
1473 for (i = 0; i < size / sizeof (Atom); i++)
5c3a351a
RS
1474 Faset (v, i, x_atom_to_symbol (dpyinfo, display,
1475 ((Atom *) data) [i]));
ede4db72
RS
1476 return v;
1477 }
1478 }
1479
1480 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1481 If the number is > 16 bits, convert it to a cons of integers,
1482 16 bits in each half.
1483 */
1484 else if (format == 32 && size == sizeof (long))
1485 return long_to_cons (((unsigned long *) data) [0]);
1486 else if (format == 16 && size == sizeof (short))
1487 return make_number ((int) (((unsigned short *) data) [0]));
1488
1489 /* Convert any other kind of data to a vector of numbers, represented
1490 as above (as an integer, or a cons of two 16 bit integers.)
1491 */
1492 else if (format == 16)
1493 {
1494 int i;
1495 Lisp_Object v = Fmake_vector (size / 4, 0);
1496 for (i = 0; i < size / 4; i++)
1497 {
1498 int j = (int) ((unsigned short *) data) [i];
1499 Faset (v, i, make_number (j));
1500 }
1501 return v;
1502 }
1503 else
1504 {
1505 int i;
1506 Lisp_Object v = Fmake_vector (size / 4, 0);
1507 for (i = 0; i < size / 4; i++)
1508 {
1509 unsigned long j = ((unsigned long *) data) [i];
1510 Faset (v, i, long_to_cons (j));
1511 }
1512 return v;
1513 }
1514}
1515
1516
002bbc0e 1517/* Use free, not XFree, to free the data obtained with this function. */
0158abbc 1518
ede4db72
RS
1519static void
1520lisp_data_to_selection_data (display, obj,
aca39f42
RS
1521 data_ret, type_ret, size_ret,
1522 format_ret, nofree_ret)
ede4db72
RS
1523 Display *display;
1524 Lisp_Object obj;
1525 unsigned char **data_ret;
1526 Atom *type_ret;
1527 unsigned int *size_ret;
1528 int *format_ret;
aca39f42 1529 int *nofree_ret;
ede4db72
RS
1530{
1531 Lisp_Object type = Qnil;
5c3a351a 1532 struct x_display_info *dpyinfo = x_display_info_for_display (display);
aca39f42
RS
1533
1534 *nofree_ret = 0;
1535
ede4db72
RS
1536 if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
1537 {
1538 type = XCONS (obj)->car;
1539 obj = XCONS (obj)->cdr;
1540 if (CONSP (obj) && NILP (XCONS (obj)->cdr))
1541 obj = XCONS (obj)->car;
1542 }
1543
1544 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1545 { /* This is not the same as declining */
1546 *format_ret = 32;
1547 *size_ret = 0;
1548 *data_ret = 0;
1549 type = QNULL;
1550 }
1551 else if (STRINGP (obj))
1552 {
1553 *format_ret = 8;
1554 *size_ret = XSTRING (obj)->size;
aca39f42
RS
1555 *data_ret = XSTRING (obj)->data;
1556 *nofree_ret = 1;
ede4db72
RS
1557 if (NILP (type)) type = QSTRING;
1558 }
1559 else if (SYMBOLP (obj))
1560 {
1561 *format_ret = 32;
1562 *size_ret = 1;
1563 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1564 (*data_ret) [sizeof (Atom)] = 0;
5c3a351a 1565 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
ede4db72
RS
1566 if (NILP (type)) type = QATOM;
1567 }
7da64e5c 1568 else if (INTEGERP (obj)
ede4db72
RS
1569 && XINT (obj) < 0xFFFF
1570 && XINT (obj) > -0xFFFF)
1571 {
1572 *format_ret = 16;
1573 *size_ret = 1;
1574 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1575 (*data_ret) [sizeof (short)] = 0;
1576 (*(short **) data_ret) [0] = (short) XINT (obj);
1577 if (NILP (type)) type = QINTEGER;
1578 }
a87ed99c
RS
1579 else if (INTEGERP (obj)
1580 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
1581 && (INTEGERP (XCONS (obj)->cdr)
1582 || (CONSP (XCONS (obj)->cdr)
1583 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
ede4db72
RS
1584 {
1585 *format_ret = 32;
1586 *size_ret = 1;
1587 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1588 (*data_ret) [sizeof (long)] = 0;
1589 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1590 if (NILP (type)) type = QINTEGER;
1591 }
1592 else if (VECTORP (obj))
1593 {
1594 /* Lisp_Vectors may represent a set of ATOMs;
1595 a set of 16 or 32 bit INTEGERs;
1596 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1597 */
1598 int i;
1599
1600 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1601 /* This vector is an ATOM set */
1602 {
1603 if (NILP (type)) type = QATOM;
1604 *size_ret = XVECTOR (obj)->size;
1605 *format_ret = 32;
1606 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1607 for (i = 0; i < *size_ret; i++)
1608 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1609 (*(Atom **) data_ret) [i]
5c3a351a 1610 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
ede4db72
RS
1611 else
1612 Fsignal (Qerror, /* Qselection_error */
1613 Fcons (build_string
1614 ("all elements of selection vector must have same type"),
1615 Fcons (obj, Qnil)));
1616 }
1617#if 0 /* #### MULTIPLE doesn't work yet */
1618 else if (VECTORP (XVECTOR (obj)->contents [0]))
1619 /* This vector is an ATOM_PAIR set */
1620 {
1621 if (NILP (type)) type = QATOM_PAIR;
1622 *size_ret = XVECTOR (obj)->size;
1623 *format_ret = 32;
1624 *data_ret = (unsigned char *)
1625 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1626 for (i = 0; i < *size_ret; i++)
1627 if (VECTORP (XVECTOR (obj)->contents [i]))
1628 {
1629 Lisp_Object pair = XVECTOR (obj)->contents [i];
1630 if (XVECTOR (pair)->size != 2)
1631 Fsignal (Qerror,
1632 Fcons (build_string
1633 ("elements of the vector must be vectors of exactly two elements"),
1634 Fcons (pair, Qnil)));
1635
1636 (*(Atom **) data_ret) [i * 2]
5c3a351a
RS
1637 = symbol_to_x_atom (dpyinfo, display,
1638 XVECTOR (pair)->contents [0]);
ede4db72 1639 (*(Atom **) data_ret) [(i * 2) + 1]
5c3a351a
RS
1640 = symbol_to_x_atom (dpyinfo, display,
1641 XVECTOR (pair)->contents [1]);
ede4db72
RS
1642 }
1643 else
1644 Fsignal (Qerror,
1645 Fcons (build_string
1646 ("all elements of the vector must be of the same type"),
1647 Fcons (obj, Qnil)));
1648
1649 }
1650#endif
1651 else
1652 /* This vector is an INTEGER set, or something like it */
1653 {
1654 *size_ret = XVECTOR (obj)->size;
1655 if (NILP (type)) type = QINTEGER;
1656 *format_ret = 16;
1657 for (i = 0; i < *size_ret; i++)
1658 if (CONSP (XVECTOR (obj)->contents [i]))
1659 *format_ret = 32;
7da64e5c 1660 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
ede4db72
RS
1661 Fsignal (Qerror, /* Qselection_error */
1662 Fcons (build_string
1663 ("elements of selection vector must be integers or conses of integers"),
1664 Fcons (obj, Qnil)));
1665
1666 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1667 for (i = 0; i < *size_ret; i++)
1668 if (*format_ret == 32)
1669 (*((unsigned long **) data_ret)) [i]
1670 = cons_to_long (XVECTOR (obj)->contents [i]);
1671 else
1672 (*((unsigned short **) data_ret)) [i]
1673 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1674 }
1675 }
1676 else
1677 Fsignal (Qerror, /* Qselection_error */
1678 Fcons (build_string ("unrecognised selection data"),
1679 Fcons (obj, Qnil)));
1680
5c3a351a 1681 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
ede4db72
RS
1682}
1683
1684static Lisp_Object
1685clean_local_selection_data (obj)
1686 Lisp_Object obj;
1687{
1688 if (CONSP (obj)
7da64e5c 1689 && INTEGERP (XCONS (obj)->car)
ede4db72 1690 && CONSP (XCONS (obj)->cdr)
7da64e5c 1691 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
ede4db72
RS
1692 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
1693 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
1694
1695 if (CONSP (obj)
7da64e5c
RS
1696 && INTEGERP (XCONS (obj)->car)
1697 && INTEGERP (XCONS (obj)->cdr))
ede4db72
RS
1698 {
1699 if (XINT (XCONS (obj)->car) == 0)
1700 return XCONS (obj)->cdr;
1701 if (XINT (XCONS (obj)->car) == -1)
1702 return make_number (- XINT (XCONS (obj)->cdr));
1703 }
1704 if (VECTORP (obj))
1705 {
1706 int i;
1707 int size = XVECTOR (obj)->size;
1708 Lisp_Object copy;
1709 if (size == 1)
1710 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1711 copy = Fmake_vector (size, Qnil);
1712 for (i = 0; i < size; i++)
1713 XVECTOR (copy)->contents [i]
1714 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1715 return copy;
1716 }
1717 return obj;
1718}
1719\f
1720/* Called from XTread_socket to handle SelectionNotify events.
606140dd
KH
1721 If it's the selection we are waiting for, stop waiting
1722 by setting the car of reading_selection_reply to non-nil.
1723 We store t there if the reply is successful, lambda if not. */
ede4db72
RS
1724
1725void
1726x_handle_selection_notify (event)
1727 XSelectionEvent *event;
1728{
5d0ba25b 1729 if (event->requestor != reading_selection_window)
ede4db72
RS
1730 return;
1731 if (event->selection != reading_which_selection)
1732 return;
1733
606140dd
KH
1734 XCONS (reading_selection_reply)->car
1735 = (event->property != 0 ? Qt : Qlambda);
ede4db72
RS
1736}
1737
1738\f
1739DEFUN ("x-own-selection-internal",
1740 Fx_own_selection_internal, Sx_own_selection_internal,
1741 2, 2, 0,
1742 "Assert an X selection of the given TYPE with the given VALUE.\n\
1743TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1744\(Those are literal upper-case symbol names, since that's what X expects.)\n\
1745VALUE is typically a string, or a cons of two markers, but may be\n\
a87ed99c 1746anything that the functions on `selection-converter-alist' know about.")
ede4db72
RS
1747 (selection_name, selection_value)
1748 Lisp_Object selection_name, selection_value;
1749{
703e0710 1750 check_x ();
ede4db72 1751 CHECK_SYMBOL (selection_name, 0);
606140dd 1752 if (NILP (selection_value)) error ("selection-value may not be nil");
ede4db72
RS
1753 x_own_selection (selection_name, selection_value);
1754 return selection_value;
1755}
1756
1757
1758/* Request the selection value from the owner. If we are the owner,
1759 simply return our selection value. If we are not the owner, this
1760 will block until all of the data has arrived. */
1761
1762DEFUN ("x-get-selection-internal",
1763 Fx_get_selection_internal, Sx_get_selection_internal, 2, 2, 0,
1764 "Return text selected from some X window.\n\
1765SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1766\(Those are literal upper-case symbol names, since that's what X expects.)\n\
a87ed99c 1767TYPE is the type of data desired, typically `STRING'.")
ede4db72
RS
1768 (selection_symbol, target_type)
1769 Lisp_Object selection_symbol, target_type;
1770{
1771 Lisp_Object val = Qnil;
1772 struct gcpro gcpro1, gcpro2;
1773 GCPRO2 (target_type, val); /* we store newly consed data into these */
703e0710 1774 check_x ();
ede4db72
RS
1775 CHECK_SYMBOL (selection_symbol, 0);
1776
1777#if 0 /* #### MULTIPLE doesn't work yet */
1778 if (CONSP (target_type)
1779 && XCONS (target_type)->car == QMULTIPLE)
1780 {
1781 CHECK_VECTOR (XCONS (target_type)->cdr, 0);
1782 /* So we don't destructively modify this... */
1783 target_type = copy_multiple_data (target_type);
1784 }
1785 else
1786#endif
1787 CHECK_SYMBOL (target_type, 0);
1788
1789 val = x_get_local_selection (selection_symbol, target_type);
1790
1791 if (NILP (val))
1792 {
1793 val = x_get_foreign_selection (selection_symbol, target_type);
1794 goto DONE;
1795 }
1796
1797 if (CONSP (val)
1798 && SYMBOLP (XCONS (val)->car))
1799 {
1800 val = XCONS (val)->cdr;
1801 if (CONSP (val) && NILP (XCONS (val)->cdr))
1802 val = XCONS (val)->car;
1803 }
1804 val = clean_local_selection_data (val);
1805 DONE:
1806 UNGCPRO;
1807 return val;
1808}
1809
1810DEFUN ("x-disown-selection-internal",
1811 Fx_disown_selection_internal, Sx_disown_selection_internal, 1, 2, 0,
a87ed99c
RS
1812 "If we own the selection SELECTION, disown it.\n\
1813Disowning it means there is no such selection.")
ede4db72
RS
1814 (selection, time)
1815 Lisp_Object selection;
1816 Lisp_Object time;
1817{
ede4db72
RS
1818 Time timestamp;
1819 Atom selection_atom;
1820 XSelectionClearEvent event;
3834c318 1821 Display *display;
5c3a351a 1822 struct x_display_info *dpyinfo;
ede4db72 1823
703e0710 1824 check_x ();
3834c318 1825 display = FRAME_X_DISPLAY (selected_frame);
5c3a351a 1826 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
ede4db72
RS
1827 CHECK_SYMBOL (selection, 0);
1828 if (NILP (time))
7da64e5c 1829 timestamp = last_event_timestamp;
ede4db72
RS
1830 else
1831 timestamp = cons_to_long (time);
1832
1833 if (NILP (assq_no_quit (selection, Vselection_alist)))
1834 return Qnil; /* Don't disown the selection when we're not the owner. */
1835
5c3a351a 1836 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
ede4db72
RS
1837
1838 BLOCK_INPUT;
1839 XSetSelectionOwner (display, selection_atom, None, timestamp);
1840 UNBLOCK_INPUT;
1841
eb8c3be9 1842 /* It doesn't seem to be guaranteed that a SelectionClear event will be
ede4db72
RS
1843 generated for a window which owns the selection when that window sets
1844 the selection owner to None. The NCD server does, the MIT Sun4 server
1845 doesn't. So we synthesize one; this means we might get two, but
1846 that's ok, because the second one won't have any effect. */
8d47f8c4
RS
1847 SELECTION_EVENT_DISPLAY (&event) = display;
1848 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1849 SELECTION_EVENT_TIME (&event) = timestamp;
ede4db72
RS
1850 x_handle_selection_clear (&event);
1851
1852 return Qt;
1853}
1854
a87ed99c
RS
1855/* Get rid of all the selections in buffer BUFFER.
1856 This is used when we kill a buffer. */
1857
1858void
1859x_disown_buffer_selections (buffer)
1860 Lisp_Object buffer;
1861{
1862 Lisp_Object tail;
1863 struct buffer *buf = XBUFFER (buffer);
1864
1865 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1866 {
1867 Lisp_Object elt, value;
1868 elt = XCONS (tail)->car;
1869 value = XCONS (elt)->cdr;
1870 if (CONSP (value) && MARKERP (XCONS (value)->car)
1871 && XMARKER (XCONS (value)->car)->buffer == buf)
1872 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
1873 }
1874}
ede4db72
RS
1875
1876DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1877 0, 1, 0,
a87ed99c 1878 "Whether the current Emacs process owns the given X Selection.\n\
ede4db72
RS
1879The arg should be the name of the selection in question, typically one of\n\
1880the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1881\(Those are literal upper-case symbol names, since that's what X expects.)\n\
1882For convenience, the symbol nil is the same as `PRIMARY',\n\
1883and t is the same as `SECONDARY'.)")
1884 (selection)
1885 Lisp_Object selection;
1886{
703e0710 1887 check_x ();
ede4db72
RS
1888 CHECK_SYMBOL (selection, 0);
1889 if (EQ (selection, Qnil)) selection = QPRIMARY;
1890 if (EQ (selection, Qt)) selection = QSECONDARY;
1891
1892 if (NILP (Fassq (selection, Vselection_alist)))
1893 return Qnil;
1894 return Qt;
1895}
1896
1897DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
1898 0, 1, 0,
1899 "Whether there is an owner for the given X Selection.\n\
1900The arg should be the name of the selection in question, typically one of\n\
1901the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1902\(Those are literal upper-case symbol names, since that's what X expects.)\n\
1903For convenience, the symbol nil is the same as `PRIMARY',\n\
1904and t is the same as `SECONDARY'.)")
1905 (selection)
1906 Lisp_Object selection;
1907{
1908 Window owner;
356ba514 1909 Atom atom;
3834c318
RS
1910 Display *dpy;
1911
b8c70430 1912 /* It should be safe to call this before we have an X frame. */
c6423dc1 1913 if (! FRAME_X_P (selected_frame))
b8c70430
RS
1914 return Qnil;
1915
3834c318 1916 dpy = FRAME_X_DISPLAY (selected_frame);
ede4db72
RS
1917 CHECK_SYMBOL (selection, 0);
1918 if (!NILP (Fx_selection_owner_p (selection)))
1919 return Qt;
356ba514
RS
1920 if (EQ (selection, Qnil)) selection = QPRIMARY;
1921 if (EQ (selection, Qt)) selection = QSECONDARY;
5c3a351a
RS
1922 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
1923 dpy, selection);
356ba514
RS
1924 if (atom == 0)
1925 return Qnil;
ede4db72 1926 BLOCK_INPUT;
356ba514 1927 owner = XGetSelectionOwner (dpy, atom);
ede4db72
RS
1928 UNBLOCK_INPUT;
1929 return (owner ? Qt : Qnil);
1930}
1931
1932\f
1933#ifdef CUT_BUFFER_SUPPORT
1934
ede4db72
RS
1935/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
1936static void
1937initialize_cut_buffers (display, window)
1938 Display *display;
1939 Window window;
1940{
1941 unsigned char *data = (unsigned char *) "";
1942 BLOCK_INPUT;
1943#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
1944 PropModeAppend, data, 0)
1945 FROB (XA_CUT_BUFFER0);
1946 FROB (XA_CUT_BUFFER1);
1947 FROB (XA_CUT_BUFFER2);
1948 FROB (XA_CUT_BUFFER3);
1949 FROB (XA_CUT_BUFFER4);
1950 FROB (XA_CUT_BUFFER5);
1951 FROB (XA_CUT_BUFFER6);
1952 FROB (XA_CUT_BUFFER7);
1953#undef FROB
1954 UNBLOCK_INPUT;
ede4db72
RS
1955}
1956
1957
a87ed99c 1958#define CHECK_CUT_BUFFER(symbol,n) \
ede4db72
RS
1959 { CHECK_SYMBOL ((symbol), (n)); \
1960 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
1961 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
1962 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
1963 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
1964 Fsignal (Qerror, \
a87ed99c 1965 Fcons (build_string ("doesn't name a cut buffer"), \
ede4db72
RS
1966 Fcons ((symbol), Qnil))); \
1967 }
1968
a87ed99c
RS
1969DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
1970 Sx_get_cut_buffer_internal, 1, 1, 0,
1971 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
ede4db72
RS
1972 (buffer)
1973 Lisp_Object buffer;
1974{
3834c318 1975 Window window;
ede4db72
RS
1976 Atom buffer_atom;
1977 unsigned char *data;
1978 int bytes;
1979 Atom type;
1980 int format;
1981 unsigned long size;
1982 Lisp_Object ret;
3834c318 1983 Display *display;
5c3a351a 1984 struct x_display_info *dpyinfo;
ede4db72 1985
703e0710 1986 check_x ();
3834c318 1987 display = FRAME_X_DISPLAY (selected_frame);
5c3a351a 1988 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
3834c318 1989 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
a87ed99c 1990 CHECK_CUT_BUFFER (buffer, 0);
5c3a351a 1991 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
ede4db72
RS
1992
1993 x_get_window_property (display, window, buffer_atom, &data, &bytes,
1994 &type, &format, &size, 0);
1995 if (!data) return Qnil;
1996
1997 if (format != 8 || type != XA_STRING)
1998 Fsignal (Qerror,
1999 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
5c3a351a 2000 Fcons (x_atom_to_symbol (dpyinfo, display, type),
ede4db72
RS
2001 Fcons (make_number (format), Qnil))));
2002
2003 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
002bbc0e 2004 /* Use free, not XFree, because x_get_window_property
0158abbc 2005 calls xmalloc itself. */
002bbc0e 2006 free (data);
ede4db72
RS
2007 return ret;
2008}
2009
2010
a87ed99c
RS
2011DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2012 Sx_store_cut_buffer_internal, 2, 2, 0,
2013 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
ede4db72
RS
2014 (buffer, string)
2015 Lisp_Object buffer, string;
2016{
3834c318 2017 Window window;
ede4db72
RS
2018 Atom buffer_atom;
2019 unsigned char *data;
2020 int bytes;
2021 int bytes_remaining;
3834c318
RS
2022 int max_bytes;
2023 Display *display;
ede4db72 2024
703e0710 2025 check_x ();
3834c318
RS
2026 display = FRAME_X_DISPLAY (selected_frame);
2027 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2028
2029 max_bytes = SELECTION_QUANTUM (display);
2030 if (max_bytes > MAX_SELECTION_QUANTUM)
2031 max_bytes = MAX_SELECTION_QUANTUM;
2032
a87ed99c 2033 CHECK_CUT_BUFFER (buffer, 0);
ede4db72 2034 CHECK_STRING (string, 0);
5c3a351a
RS
2035 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
2036 display, buffer);
ede4db72
RS
2037 data = (unsigned char *) XSTRING (string)->data;
2038 bytes = XSTRING (string)->size;
2039 bytes_remaining = bytes;
2040
04649dbc
KH
2041 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2042 {
2043 initialize_cut_buffers (display, window);
2044 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2045 }
ede4db72
RS
2046
2047 BLOCK_INPUT;
10608c8c
RS
2048
2049 /* Don't mess up with an empty value. */
2050 if (!bytes_remaining)
2051 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2052 PropModeReplace, data, 0);
2053
ede4db72
RS
2054 while (bytes_remaining)
2055 {
2056 int chunk = (bytes_remaining < max_bytes
2057 ? bytes_remaining : max_bytes);
2058 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2059 (bytes_remaining == bytes
2060 ? PropModeReplace
2061 : PropModeAppend),
2062 data, chunk);
2063 data += chunk;
2064 bytes_remaining -= chunk;
2065 }
2066 UNBLOCK_INPUT;
2067 return string;
2068}
2069
2070
a87ed99c
RS
2071DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2072 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2073 "Rotate the values of the cut buffers by the given number of steps;\n\
ede4db72
RS
2074positive means move values forward, negative means backward.")
2075 (n)
2076 Lisp_Object n;
2077{
3834c318
RS
2078 Window window;
2079 Atom props[8];
2080 Display *display;
ede4db72 2081
703e0710 2082 check_x ();
3834c318
RS
2083 display = FRAME_X_DISPLAY (selected_frame);
2084 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
7da64e5c 2085 CHECK_NUMBER (n, 0);
3834c318
RS
2086 if (XINT (n) == 0)
2087 return n;
04649dbc
KH
2088 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2089 {
2090 initialize_cut_buffers (display, window);
2091 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2092 }
3834c318 2093
ede4db72
RS
2094 props[0] = XA_CUT_BUFFER0;
2095 props[1] = XA_CUT_BUFFER1;
2096 props[2] = XA_CUT_BUFFER2;
2097 props[3] = XA_CUT_BUFFER3;
2098 props[4] = XA_CUT_BUFFER4;
2099 props[5] = XA_CUT_BUFFER5;
2100 props[6] = XA_CUT_BUFFER6;
2101 props[7] = XA_CUT_BUFFER7;
2102 BLOCK_INPUT;
2103 XRotateWindowProperties (display, window, props, 8, XINT (n));
2104 UNBLOCK_INPUT;
2105 return n;
2106}
2107
2108#endif
2109\f
ede4db72
RS
2110void
2111syms_of_xselect ()
2112{
ede4db72
RS
2113 defsubr (&Sx_get_selection_internal);
2114 defsubr (&Sx_own_selection_internal);
2115 defsubr (&Sx_disown_selection_internal);
2116 defsubr (&Sx_selection_owner_p);
2117 defsubr (&Sx_selection_exists_p);
2118
2119#ifdef CUT_BUFFER_SUPPORT
a87ed99c
RS
2120 defsubr (&Sx_get_cut_buffer_internal);
2121 defsubr (&Sx_store_cut_buffer_internal);
2122 defsubr (&Sx_rotate_cut_buffers_internal);
ede4db72
RS
2123#endif
2124
2125 reading_selection_reply = Fcons (Qnil, Qnil);
2126 staticpro (&reading_selection_reply);
2127 reading_selection_window = 0;
2128 reading_which_selection = 0;
2129
2130 property_change_wait_list = 0;
2f65feb6 2131 prop_location_identifier = 0;
ede4db72
RS
2132 property_change_reply = Fcons (Qnil, Qnil);
2133 staticpro (&property_change_reply);
2134
2135 Vselection_alist = Qnil;
2136 staticpro (&Vselection_alist);
2137
2138 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2139 "An alist associating X Windows selection-types with functions.\n\
2140These functions are called to convert the selection, with three args:\n\
2141the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2142a desired type to which the selection should be converted;\n\
2143and the local selection value (whatever was given to `x-own-selection').\n\
2144\n\
2145The function should return the value to send to the X server\n\
2146\(typically a string). A return value of nil\n\
2147means that the conversion could not be done.\n\
2148A return value which is the symbol `NULL'\n\
2149means that a side-effect was executed,\n\
2150and there is no meaningful selection value.");
2151 Vselection_converter_alist = Qnil;
2152
2153 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2154 "A list of functions to be called when Emacs loses an X selection.\n\
2155\(This happens when some other X client makes its own selection\n\
2156or when a Lisp program explicitly clears the selection.)\n\
2157The functions are called with one argument, the selection type\n\
d31b6237 2158\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
ede4db72
RS
2159 Vx_lost_selection_hooks = Qnil;
2160
2161 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2162 "A list of functions to be called when Emacs answers a selection request.\n\
2163The functions are called with four arguments:\n\
2164 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2165 - the selection-type which Emacs was asked to convert the\n\
2166 selection into before sending (for example, `STRING' or `LENGTH');\n\
2167 - a flag indicating success or failure for responding to the request.\n\
2168We might have failed (and declined the request) for any number of reasons,\n\
2169including being asked for a selection that we no longer own, or being asked\n\
2170to convert into a type that we don't know about or that is inappropriate.\n\
2171This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2172it merely informs you that they have happened.");
2173 Vx_sent_selection_hooks = Qnil;
2174
2175 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
80da0190 2176 "Number of milliseconds to wait for a selection reply.\n\
2a1a4c9d 2177If the selection owner doesn't reply in this time, we give up.\n\
ede4db72 2178A value of 0 means wait as long as necessary. This is initialized from the\n\
80da0190 2179\"*selectionTimeout\" resource.");
ede4db72
RS
2180 x_selection_timeout = 0;
2181
2182 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2183 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2184 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2185 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2186 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2187 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2188 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2189 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2190 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2191 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2192 QINCR = intern ("INCR"); staticpro (&QINCR);
2193 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2194 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2195 QATOM = intern ("ATOM"); staticpro (&QATOM);
2196 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2197 QNULL = intern ("NULL"); staticpro (&QNULL);
2198
2199#ifdef CUT_BUFFER_SUPPORT
2200 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2201 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2202 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2203 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2204 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2205 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2206 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2207 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2208#endif
2209
2210}