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