(math-compose-tex-matrix): Add a latex option.
[bpt/emacs.git] / src / xselect.c
CommitLineData
2408b3a1 1/* X Selection processing for Emacs.
0b5538bd 2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2002, 2003,
aaef169d 3 2004, 2005, 2006 Free Software Foundation, Inc.
ede4db72
RS
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
19the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20Boston, MA 02110-1301, USA. */
ede4db72 21
c6c5df7f 22
ede4db72
RS
23/* Rewritten by jwz */
24
18160b98 25#include <config.h>
5b698285 26#include <stdio.h> /* termhooks.h needs this */
678b3958
KS
27
28#ifdef HAVE_SYS_TYPES_H
29#include <sys/types.h>
30#endif
31#ifdef HAVE_UNISTD_H
32#include <unistd.h>
33#endif
34
ede4db72
RS
35#include "lisp.h"
36#include "xterm.h" /* for all of the X includes */
7da64e5c
RS
37#include "dispextern.h" /* frame.h seems to want this */
38#include "frame.h" /* Need this to get the X window of selected_frame */
9ac0d9e0 39#include "blockinput.h"
5faa9b45 40#include "buffer.h"
dfcf069d 41#include "process.h"
1fb3821b 42#include "termhooks.h"
dd0fe424 43#include "keyboard.h"
1fb3821b
JD
44
45#include <X11/Xproto.h>
7da64e5c 46
d9c0d4a3
GM
47struct prop_location;
48
49static Lisp_Object x_atom_to_symbol P_ ((Display *dpy, Atom atom));
50static Atom symbol_to_x_atom P_ ((struct x_display_info *, Display *,
51 Lisp_Object));
52static void x_own_selection P_ ((Lisp_Object, Lisp_Object));
5109c8dd 53static Lisp_Object x_get_local_selection P_ ((Lisp_Object, Lisp_Object, int));
d9c0d4a3
GM
54static void x_decline_selection_request P_ ((struct input_event *));
55static Lisp_Object x_selection_request_lisp_error P_ ((Lisp_Object));
56static Lisp_Object queue_selection_requests_unwind P_ ((Lisp_Object));
57static Lisp_Object some_frame_on_display P_ ((struct x_display_info *));
58static void x_reply_selection_request P_ ((struct input_event *, int,
59 unsigned char *, int, Atom));
60static int waiting_for_other_props_on_window P_ ((Display *, Window));
61static struct prop_location *expect_property_change P_ ((Display *, Window,
62 Atom, int));
63static void unexpect_property_change P_ ((struct prop_location *));
64static Lisp_Object wait_for_property_change_unwind P_ ((Lisp_Object));
65static void wait_for_property_change P_ ((struct prop_location *));
3a42401d
JD
66static Lisp_Object x_get_foreign_selection P_ ((Lisp_Object,
67 Lisp_Object,
68 Lisp_Object));
d9c0d4a3
GM
69static void x_get_window_property P_ ((Display *, Window, Atom,
70 unsigned char **, int *,
71 Atom *, int *, unsigned long *, int));
72static void receive_incremental_selection P_ ((Display *, Window, Atom,
73 Lisp_Object, unsigned,
74 unsigned char **, int *,
75 Atom *, int *, unsigned long *));
76static Lisp_Object x_get_window_property_as_lisp_data P_ ((Display *,
77 Window, Atom,
78 Lisp_Object, Atom));
79static Lisp_Object selection_data_to_lisp_data P_ ((Display *, unsigned char *,
80 int, Atom, int));
81static void lisp_data_to_selection_data P_ ((Display *, Lisp_Object,
82 unsigned char **, Atom *,
83 unsigned *, int *, int *));
84static Lisp_Object clean_local_selection_data P_ ((Lisp_Object));
85static void initialize_cut_buffers P_ ((Display *, Window));
86
87
88/* Printing traces to stderr. */
89
90#ifdef TRACE_SELECTION
91#define TRACE0(fmt) \
92 fprintf (stderr, "%d: " fmt "\n", getpid ())
93#define TRACE1(fmt, a0) \
94 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
95#define TRACE2(fmt, a0, a1) \
96 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
9c3ad9e1
JD
97#define TRACE3(fmt, a0, a1, a2) \
98 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1, a2)
d9c0d4a3
GM
99#else
100#define TRACE0(fmt) (void) 0
101#define TRACE1(fmt, a0) (void) 0
102#define TRACE2(fmt, a0, a1) (void) 0
9c3ad9e1 103#define TRACE3(fmt, a0, a1) (void) 0
d9c0d4a3
GM
104#endif
105
106
ede4db72
RS
107#define CUT_BUFFER_SUPPORT
108
ede4db72
RS
109Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
110 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
111 QATOM_PAIR;
112
e6c7c988 113Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
5109c8dd 114Lisp_Object QUTF8_STRING; /* This is a type of selection. */
e6c7c988 115
5a79ea57 116Lisp_Object Qcompound_text_with_extensions;
fbbe0ace 117
ede4db72
RS
118#ifdef CUT_BUFFER_SUPPORT
119Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
120 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
121#endif
122
c917a8de
SM
123static Lisp_Object Vx_lost_selection_functions;
124static Lisp_Object Vx_sent_selection_functions;
2584c9ec
KH
125/* Coding system for communicating with other X clients via cutbuffer,
126 selection, and clipboard. */
93e4ce1b 127static Lisp_Object Vselection_coding_system;
ede4db72 128
16cd5029
KH
129/* Coding system for the next communicating with other X clients. */
130static Lisp_Object Vnext_selection_coding_system;
131
e57ad4d8
KH
132static Lisp_Object Qforeign_selection;
133
ede4db72
RS
134/* If this is a smaller number than the max-request-size of the display,
135 emacs will use INCR selection transfer when the selection is larger
136 than this. The max-request-size is usually around 64k, so if you want
1b65481e 137 emacs to use incremental selection transfers when the selection is
ede4db72 138 smaller than that, set this. I added this mostly for debugging the
8f4f023f 139 incremental transfer stuff, but it might improve server performance. */
ede4db72
RS
140#define MAX_SELECTION_QUANTUM 0xFFFFFF
141
c3498e64
JB
142#ifdef HAVE_X11R4
143#define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
144#else
145#define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
146#endif
ede4db72 147
7da64e5c 148/* The timestamp of the last input event Emacs received from the X server. */
29674445
KH
149/* Defined in keyboard.c. */
150extern unsigned long last_event_timestamp;
ede4db72
RS
151
152/* This is an association list whose elements are of the form
118bd841
RS
153 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
154 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
155 SELECTION-VALUE is the value that emacs owns for that selection.
ede4db72 156 It may be any kind of Lisp object.
118bd841 157 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
ede4db72 158 as a cons of two 16-bit numbers (making a 32 bit time.)
118bd841
RS
159 FRAME is the frame for which we made the selection.
160 If there is an entry in this alist, then it can be assumed that Emacs owns
ede4db72
RS
161 that selection.
162 The only (eq) parts of this list that are visible from Lisp are the
8f4f023f
RS
163 selection-values. */
164static Lisp_Object Vselection_alist;
ede4db72
RS
165
166/* This is an alist whose CARs are selection-types (whose names are the same
167 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
1b65481e 168 call to convert the given Emacs selection value to a string representing
ede4db72 169 the given selection type. This is for Lisp-level extension of the emacs
8f4f023f
RS
170 selection handling. */
171static Lisp_Object Vselection_converter_alist;
ede4db72
RS
172
173/* If the selection owner takes too long to reply to a selection request,
8f4f023f 174 we give up on it. This is in milliseconds (0 = no timeout.) */
31ade731 175static EMACS_INT x_selection_timeout;
ede4db72 176
dd0fe424
KS
177
178\f
678b3958
KS
179/* Define a queue to save up SELECTION_REQUEST_EVENT events for later
180 handling. */
dd0fe424
KS
181
182struct selection_event_queue
183 {
184 struct input_event event;
185 struct selection_event_queue *next;
186 };
187
188static struct selection_event_queue *selection_queue;
189
678b3958 190/* Nonzero means queue up SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
191
192static int x_queue_selection_requests;
193
678b3958 194/* Queue up an SELECTION_REQUEST_EVENT *EVENT, to be processed later. */
dd0fe424
KS
195
196static void
197x_queue_event (event)
198 struct input_event *event;
199{
200 struct selection_event_queue *queue_tmp;
201
678b3958
KS
202 /* Don't queue repeated requests.
203 This only happens for large requests which uses the incremental protocol. */
dd0fe424
KS
204 for (queue_tmp = selection_queue; queue_tmp; queue_tmp = queue_tmp->next)
205 {
206 if (!bcmp (&queue_tmp->event, event, sizeof (*event)))
207 {
678b3958
KS
208 TRACE1 ("DECLINE DUP SELECTION EVENT %08lx", (unsigned long)queue_tmp);
209 x_decline_selection_request (event);
dd0fe424
KS
210 return;
211 }
212 }
213
214 queue_tmp
215 = (struct selection_event_queue *) xmalloc (sizeof (struct selection_event_queue));
216
217 if (queue_tmp != NULL)
218 {
678b3958 219 TRACE1 ("QUEUE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
dd0fe424
KS
220 queue_tmp->event = *event;
221 queue_tmp->next = selection_queue;
222 selection_queue = queue_tmp;
223 }
224}
225
678b3958 226/* Start queuing SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
227
228static void
229x_start_queuing_selection_requests ()
230{
231 if (x_queue_selection_requests)
232 abort ();
233
234 x_queue_selection_requests++;
235 TRACE1 ("x_start_queuing_selection_requests %d", x_queue_selection_requests);
236}
237
678b3958 238/* Stop queuing SELECTION_REQUEST_EVENT events. */
dd0fe424
KS
239
240static void
241x_stop_queuing_selection_requests ()
242{
243 TRACE1 ("x_stop_queuing_selection_requests %d", x_queue_selection_requests);
244 --x_queue_selection_requests;
245
246 /* Take all the queued events and put them back
247 so that they get processed afresh. */
248
249 while (selection_queue != NULL)
250 {
251 struct selection_event_queue *queue_tmp = selection_queue;
678b3958 252 TRACE1 ("RESTORE SELECTION EVENT %08lx", (unsigned long)queue_tmp);
dd0fe424
KS
253 kbd_buffer_unget_event (&queue_tmp->event);
254 selection_queue = queue_tmp->next;
255 xfree ((char *)queue_tmp);
256 }
257}
258\f
259
1b65481e 260/* This converts a Lisp symbol to a server Atom, avoiding a server
ede4db72
RS
261 roundtrip whenever possible. */
262
263static Atom
5c3a351a
RS
264symbol_to_x_atom (dpyinfo, display, sym)
265 struct x_display_info *dpyinfo;
ede4db72
RS
266 Display *display;
267 Lisp_Object sym;
268{
269 Atom val;
270 if (NILP (sym)) return 0;
271 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
272 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
273 if (EQ (sym, QSTRING)) return XA_STRING;
274 if (EQ (sym, QINTEGER)) return XA_INTEGER;
275 if (EQ (sym, QATOM)) return XA_ATOM;
5c3a351a
RS
276 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
277 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
278 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
e6c7c988 279 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
5109c8dd 280 if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING;
5c3a351a
RS
281 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
282 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
283 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
284 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
285 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
286 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
ede4db72
RS
287#ifdef CUT_BUFFER_SUPPORT
288 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
289 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
290 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
291 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
292 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
293 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
294 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
295 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
296#endif
297 if (!SYMBOLP (sym)) abort ();
298
d5db4077 299 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym)));
ede4db72 300 BLOCK_INPUT;
d5db4077 301 val = XInternAtom (display, (char *) SDATA (SYMBOL_NAME (sym)), False);
ede4db72
RS
302 UNBLOCK_INPUT;
303 return val;
304}
305
306
307/* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
308 and calls to intern whenever possible. */
309
310static Lisp_Object
d9c0d4a3
GM
311x_atom_to_symbol (dpy, atom)
312 Display *dpy;
ede4db72
RS
313 Atom atom;
314{
d9c0d4a3 315 struct x_display_info *dpyinfo;
ede4db72
RS
316 char *str;
317 Lisp_Object val;
1b65481e 318
d9c0d4a3
GM
319 if (! atom)
320 return Qnil;
1b65481e 321
7da64e5c
RS
322 switch (atom)
323 {
324 case XA_PRIMARY:
325 return QPRIMARY;
326 case XA_SECONDARY:
327 return QSECONDARY;
328 case XA_STRING:
329 return QSTRING;
330 case XA_INTEGER:
331 return QINTEGER;
332 case XA_ATOM:
333 return QATOM;
ede4db72 334#ifdef CUT_BUFFER_SUPPORT
7da64e5c
RS
335 case XA_CUT_BUFFER0:
336 return QCUT_BUFFER0;
337 case XA_CUT_BUFFER1:
338 return QCUT_BUFFER1;
339 case XA_CUT_BUFFER2:
340 return QCUT_BUFFER2;
341 case XA_CUT_BUFFER3:
342 return QCUT_BUFFER3;
343 case XA_CUT_BUFFER4:
344 return QCUT_BUFFER4;
345 case XA_CUT_BUFFER5:
346 return QCUT_BUFFER5;
347 case XA_CUT_BUFFER6:
348 return QCUT_BUFFER6;
349 case XA_CUT_BUFFER7:
350 return QCUT_BUFFER7;
ede4db72 351#endif
7da64e5c
RS
352 }
353
d9c0d4a3 354 dpyinfo = x_display_info_for_display (dpy);
5c3a351a 355 if (atom == dpyinfo->Xatom_CLIPBOARD)
7da64e5c 356 return QCLIPBOARD;
5c3a351a 357 if (atom == dpyinfo->Xatom_TIMESTAMP)
7da64e5c 358 return QTIMESTAMP;
5c3a351a 359 if (atom == dpyinfo->Xatom_TEXT)
7da64e5c 360 return QTEXT;
e6c7c988
KH
361 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
362 return QCOMPOUND_TEXT;
5109c8dd
KH
363 if (atom == dpyinfo->Xatom_UTF8_STRING)
364 return QUTF8_STRING;
5c3a351a 365 if (atom == dpyinfo->Xatom_DELETE)
7da64e5c 366 return QDELETE;
5c3a351a 367 if (atom == dpyinfo->Xatom_MULTIPLE)
7da64e5c 368 return QMULTIPLE;
5c3a351a 369 if (atom == dpyinfo->Xatom_INCR)
7da64e5c 370 return QINCR;
5c3a351a 371 if (atom == dpyinfo->Xatom_EMACS_TMP)
7da64e5c 372 return QEMACS_TMP;
5c3a351a 373 if (atom == dpyinfo->Xatom_TARGETS)
7da64e5c 374 return QTARGETS;
5c3a351a 375 if (atom == dpyinfo->Xatom_NULL)
7da64e5c 376 return QNULL;
ede4db72
RS
377
378 BLOCK_INPUT;
d9c0d4a3 379 str = XGetAtomName (dpy, atom);
ede4db72 380 UNBLOCK_INPUT;
d9c0d4a3 381 TRACE1 ("XGetAtomName --> %s", str);
ede4db72
RS
382 if (! str) return Qnil;
383 val = intern (str);
384 BLOCK_INPUT;
0158abbc 385 /* This was allocated by Xlib, so use XFree. */
ede4db72
RS
386 XFree (str);
387 UNBLOCK_INPUT;
388 return val;
389}
8a89415e 390\f
ede4db72 391/* Do protocol to assert ourself as a selection owner.
1b65481e 392 Update the Vselection_alist so that we can reply to later requests for
ede4db72
RS
393 our selection. */
394
395static void
396x_own_selection (selection_name, selection_value)
397 Lisp_Object selection_name, selection_value;
398{
378c33ca
GM
399 struct frame *sf = SELECTED_FRAME ();
400 Window selecting_window = FRAME_X_WINDOW (sf);
401 Display *display = FRAME_X_DISPLAY (sf);
7da64e5c 402 Time time = last_event_timestamp;
ede4db72 403 Atom selection_atom;
378c33ca 404 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
ede4db72 405
b7826503 406 CHECK_SYMBOL (selection_name);
5c3a351a 407 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
ede4db72
RS
408
409 BLOCK_INPUT;
9ba8e10d 410 x_catch_errors (display);
ede4db72 411 XSetSelectionOwner (display, selection_atom, selecting_window, time);
a7b24d46 412 x_check_errors (display, "Can't set selection: %s");
4545fa20 413 x_uncatch_errors ();
ede4db72
RS
414 UNBLOCK_INPUT;
415
416 /* Now update the local cache */
417 {
418 Lisp_Object selection_time;
419 Lisp_Object selection_data;
420 Lisp_Object prev_value;
421
422 selection_time = long_to_cons ((unsigned long) time);
423 selection_data = Fcons (selection_name,
424 Fcons (selection_value,
118bd841 425 Fcons (selection_time,
378c33ca 426 Fcons (selected_frame, Qnil))));
ede4db72
RS
427 prev_value = assq_no_quit (selection_name, Vselection_alist);
428
429 Vselection_alist = Fcons (selection_data, Vselection_alist);
430
431 /* If we already owned the selection, remove the old selection data.
432 Perhaps we should destructively modify it instead.
433 Don't use Fdelq as that may QUIT. */
434 if (!NILP (prev_value))
435 {
436 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
437 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
8e713be6 438 if (EQ (prev_value, Fcar (XCDR (rest))))
ede4db72 439 {
f3fbd155 440 XSETCDR (rest, Fcdr (XCDR (rest)));
ede4db72
RS
441 break;
442 }
443 }
444 }
445}
446\f
447/* Given a selection-name and desired type, look up our local copy of
448 the selection value and convert it to the type.
449 The value is nil or a string.
5109c8dd
KH
450 This function is used both for remote requests (LOCAL_REQUEST is zero)
451 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
ede4db72
RS
452
453 This calls random Lisp code, and may signal or gc. */
454
455static Lisp_Object
5109c8dd 456x_get_local_selection (selection_symbol, target_type, local_request)
ede4db72 457 Lisp_Object selection_symbol, target_type;
5109c8dd 458 int local_request;
ede4db72
RS
459{
460 Lisp_Object local_value;
461 Lisp_Object handler_fn, value, type, check;
462 int count;
463
464 local_value = assq_no_quit (selection_symbol, Vselection_alist);
465
466 if (NILP (local_value)) return Qnil;
467
468 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
469 if (EQ (target_type, QTIMESTAMP))
470 {
471 handler_fn = Qnil;
8e713be6 472 value = XCAR (XCDR (XCDR (local_value)));
ede4db72
RS
473 }
474#if 0
475 else if (EQ (target_type, QDELETE))
476 {
477 handler_fn = Qnil;
478 Fx_disown_selection_internal
479 (selection_symbol,
8e713be6 480 XCAR (XCDR (XCDR (local_value))));
ede4db72
RS
481 value = QNULL;
482 }
483#endif
484
485#if 0 /* #### MULTIPLE doesn't work yet */
486 else if (CONSP (target_type)
8e713be6 487 && XCAR (target_type) == QMULTIPLE)
ede4db72 488 {
9d2d1dd8
KH
489 Lisp_Object pairs;
490 int size;
ede4db72 491 int i;
8e713be6 492 pairs = XCDR (target_type);
9d2d1dd8 493 size = XVECTOR (pairs)->size;
ede4db72
RS
494 /* If the target is MULTIPLE, then target_type looks like
495 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
496 We modify the second element of each pair in the vector and
497 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
498 */
499 for (i = 0; i < size; i++)
500 {
9d2d1dd8
KH
501 Lisp_Object pair;
502 pair = XVECTOR (pairs)->contents [i];
ede4db72
RS
503 XVECTOR (pair)->contents [1]
504 = x_get_local_selection (XVECTOR (pair)->contents [0],
5109c8dd
KH
505 XVECTOR (pair)->contents [1],
506 local_request);
ede4db72
RS
507 }
508 return pairs;
509 }
510#endif
511 else
512 {
513 /* Don't allow a quit within the converter.
514 When the user types C-g, he would be surprised
515 if by luck it came during a converter. */
aed13378 516 count = SPECPDL_INDEX ();
ede4db72
RS
517 specbind (Qinhibit_quit, Qt);
518
b7826503 519 CHECK_SYMBOL (target_type);
ede4db72 520 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
4f06187f
RS
521 /* gcpro is not needed here since nothing but HANDLER_FN
522 is live, and that ought to be a symbol. */
523
1eb4d468
RS
524 if (!NILP (handler_fn))
525 value = call3 (handler_fn,
5109c8dd 526 selection_symbol, (local_request ? Qnil : target_type),
8e713be6 527 XCAR (XCDR (local_value)));
1eb4d468
RS
528 else
529 value = Qnil;
ede4db72
RS
530 unbind_to (count, Qnil);
531 }
532
533 /* Make sure this value is of a type that we could transmit
534 to another X client. */
a87ed99c 535
ede4db72
RS
536 check = value;
537 if (CONSP (value)
8e713be6
KR
538 && SYMBOLP (XCAR (value)))
539 type = XCAR (value),
540 check = XCDR (value);
1b65481e 541
ede4db72
RS
542 if (STRINGP (check)
543 || VECTORP (check)
544 || SYMBOLP (check)
7da64e5c 545 || INTEGERP (check)
ede4db72
RS
546 || NILP (value))
547 return value;
a87ed99c 548 /* Check for a value that cons_to_long could handle. */
ede4db72 549 else if (CONSP (check)
8e713be6
KR
550 && INTEGERP (XCAR (check))
551 && (INTEGERP (XCDR (check))
ede4db72 552 ||
8e713be6
KR
553 (CONSP (XCDR (check))
554 && INTEGERP (XCAR (XCDR (check)))
555 && NILP (XCDR (XCDR (check))))))
ede4db72
RS
556 return value;
557 else
558 return
559 Fsignal (Qerror,
a87ed99c 560 Fcons (build_string ("invalid data returned by selection-conversion function"),
ede4db72
RS
561 Fcons (handler_fn, Fcons (value, Qnil))));
562}
563\f
564/* Subroutines of x_reply_selection_request. */
565
5d0ba25b 566/* Send a SelectionNotify event to the requestor with property=None,
ede4db72
RS
567 meaning we were unable to do what they wanted. */
568
569static void
570x_decline_selection_request (event)
571 struct input_event *event;
572{
573 XSelectionEvent reply;
1b65481e 574
ede4db72
RS
575 reply.type = SelectionNotify;
576 reply.display = SELECTION_EVENT_DISPLAY (event);
5d0ba25b 577 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
ede4db72
RS
578 reply.selection = SELECTION_EVENT_SELECTION (event);
579 reply.time = SELECTION_EVENT_TIME (event);
580 reply.target = SELECTION_EVENT_TARGET (event);
581 reply.property = None;
582
d9c0d4a3
GM
583 /* The reason for the error may be that the receiver has
584 died in the meantime. Handle that case. */
ede4db72 585 BLOCK_INPUT;
9ba8e10d 586 x_catch_errors (reply.display);
d9c0d4a3 587 XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
5c3a351a 588 XFlush (reply.display);
4545fa20 589 x_uncatch_errors ();
ede4db72
RS
590 UNBLOCK_INPUT;
591}
592
593/* This is the selection request currently being processed.
594 It is set to zero when the request is fully processed. */
595static struct input_event *x_selection_current_request;
596
ca29f2b8
GM
597/* Display info in x_selection_request. */
598
599static struct x_display_info *selection_request_dpyinfo;
600
ede4db72 601/* Used as an unwind-protect clause so that, if a selection-converter signals
2a1a4c9d 602 an error, we tell the requester that we were unable to do what they wanted
ede4db72
RS
603 before we throw to top-level or go into the debugger or whatever. */
604
605static Lisp_Object
606x_selection_request_lisp_error (ignore)
607 Lisp_Object ignore;
608{
ca29f2b8
GM
609 if (x_selection_current_request != 0
610 && selection_request_dpyinfo->display)
ede4db72
RS
611 x_decline_selection_request (x_selection_current_request);
612 return Qnil;
613}
614\f
d1f21a66
RS
615
616/* This stuff is so that INCR selections are reentrant (that is, so we can
617 be servicing multiple INCR selection requests simultaneously.) I haven't
618 actually tested that yet. */
619
620/* Keep a list of the property changes that are awaited. */
621
622struct prop_location
623{
624 int identifier;
625 Display *display;
626 Window window;
627 Atom property;
628 int desired_state;
629 int arrived;
630 struct prop_location *next;
631};
632
633static struct prop_location *expect_property_change ();
634static void wait_for_property_change ();
635static void unexpect_property_change ();
636static int waiting_for_other_props_on_window ();
637
638static int prop_location_identifier;
639
640static Lisp_Object property_change_reply;
641
642static struct prop_location *property_change_reply_object;
643
644static struct prop_location *property_change_wait_list;
55b2d45d
RS
645
646static Lisp_Object
dd0fe424
KS
647queue_selection_requests_unwind (tem)
648 Lisp_Object tem;
55b2d45d 649{
dd0fe424 650 x_stop_queuing_selection_requests ();
ab552306 651 return Qnil;
55b2d45d
RS
652}
653
654/* Return some frame whose display info is DPYINFO.
655 Return nil if there is none. */
656
657static Lisp_Object
658some_frame_on_display (dpyinfo)
659 struct x_display_info *dpyinfo;
660{
661 Lisp_Object list, frame;
662
663 FOR_EACH_FRAME (list, frame)
664 {
665 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
666 return frame;
667 }
668
669 return Qnil;
670}
d1f21a66 671\f
ede4db72
RS
672/* Send the reply to a selection request event EVENT.
673 TYPE is the type of selection data requested.
674 DATA and SIZE describe the data to send, already converted.
675 FORMAT is the unit-size (in bits) of the data to be transmitted. */
676
677static void
678x_reply_selection_request (event, format, data, size, type)
679 struct input_event *event;
680 int format, size;
681 unsigned char *data;
682 Atom type;
683{
684 XSelectionEvent reply;
685 Display *display = SELECTION_EVENT_DISPLAY (event);
5d0ba25b 686 Window window = SELECTION_EVENT_REQUESTOR (event);
ede4db72
RS
687 int bytes_remaining;
688 int format_bytes = format/8;
689 int max_bytes = SELECTION_QUANTUM (display);
5c3a351a 690 struct x_display_info *dpyinfo = x_display_info_for_display (display);
9ba8e10d 691 int count = SPECPDL_INDEX ();
ede4db72
RS
692
693 if (max_bytes > MAX_SELECTION_QUANTUM)
694 max_bytes = MAX_SELECTION_QUANTUM;
695
696 reply.type = SelectionNotify;
697 reply.display = display;
5d0ba25b 698 reply.requestor = window;
ede4db72
RS
699 reply.selection = SELECTION_EVENT_SELECTION (event);
700 reply.time = SELECTION_EVENT_TIME (event);
701 reply.target = SELECTION_EVENT_TARGET (event);
702 reply.property = SELECTION_EVENT_PROPERTY (event);
703 if (reply.property == None)
704 reply.property = reply.target;
705
706 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
afe1529d 707 BLOCK_INPUT;
9ba8e10d 708 x_catch_errors (display);
ede4db72 709
9c3ad9e1
JD
710#ifdef TRACE_SELECTION
711 {
712 static int cnt;
713 char *sel = XGetAtomName (display, reply.selection);
714 char *tgt = XGetAtomName (display, reply.target);
715 TRACE3 ("%s, target %s (%d)", sel, tgt, ++cnt);
716 if (sel) XFree (sel);
717 if (tgt) XFree (tgt);
718 }
719#endif /* TRACE_SELECTION */
720
ede4db72
RS
721 /* Store the data on the requested property.
722 If the selection is large, only store the first N bytes of it.
723 */
724 bytes_remaining = size * format_bytes;
725 if (bytes_remaining <= max_bytes)
726 {
727 /* Send all the data at once, with minimal handshaking. */
d9c0d4a3 728 TRACE1 ("Sending all %d bytes", bytes_remaining);
ede4db72
RS
729 XChangeProperty (display, window, reply.property, type, format,
730 PropModeReplace, data, size);
731 /* At this point, the selection was successfully stored; ack it. */
2f65feb6 732 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
ede4db72
RS
733 }
734 else
735 {
736 /* Send an INCR selection. */
d1f21a66 737 struct prop_location *wait_object;
afe1529d 738 int had_errors;
55b2d45d 739 Lisp_Object frame;
ede4db72 740
55b2d45d
RS
741 frame = some_frame_on_display (dpyinfo);
742
743 /* If the display no longer has frames, we can't expect
744 to get many more selection requests from it, so don't
745 bother trying to queue them. */
746 if (!NILP (frame))
747 {
dd0fe424 748 x_start_queuing_selection_requests ();
55b2d45d
RS
749
750 record_unwind_protect (queue_selection_requests_unwind,
dd0fe424 751 Qnil);
55b2d45d 752 }
2f65feb6 753
19126e11 754 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
606140dd 755 error ("Attempt to transfer an INCR to ourself!");
1b65481e 756
d9c0d4a3
GM
757 TRACE2 ("Start sending %d bytes incrementally (%s)",
758 bytes_remaining, XGetAtomName (display, reply.property));
d1f21a66
RS
759 wait_object = expect_property_change (display, window, reply.property,
760 PropertyDelete);
ede4db72 761
d9c0d4a3
GM
762 TRACE1 ("Set %s to number of bytes to send",
763 XGetAtomName (display, reply.property));
e22cf39c
JD
764 {
765 /* XChangeProperty expects an array of long even if long is more than
766 32 bits. */
767 long value[1];
768
769 value[0] = bytes_remaining;
770 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
771 32, PropModeReplace,
772 (unsigned char *) value, 1);
773 }
774
ede4db72 775 XSelectInput (display, window, PropertyChangeMask);
1b65481e 776
ede4db72 777 /* Tell 'em the INCR data is there... */
d9c0d4a3 778 TRACE0 ("Send SelectionNotify event");
55b2d45d 779 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
5c3a351a 780 XFlush (display);
afe1529d
RS
781
782 had_errors = x_had_errors_p (display);
2f65feb6 783 UNBLOCK_INPUT;
ede4db72 784
2a1a4c9d 785 /* First, wait for the requester to ack by deleting the property.
ede4db72 786 This can run random lisp code (process handlers) or signal. */
afe1529d 787 if (! had_errors)
d9c0d4a3
GM
788 {
789 TRACE1 ("Waiting for ACK (deletion of %s)",
790 XGetAtomName (display, reply.property));
791 wait_for_property_change (wait_object);
792 }
dd0fe424
KS
793 else
794 unexpect_property_change (wait_object);
ede4db72 795
d9c0d4a3 796 TRACE0 ("Got ACK");
ede4db72
RS
797 while (bytes_remaining)
798 {
e22cf39c
JD
799 int i = ((bytes_remaining < max_bytes)
800 ? bytes_remaining
801 : max_bytes);
2f65feb6
RS
802
803 BLOCK_INPUT;
804
d1f21a66
RS
805 wait_object
806 = expect_property_change (display, window, reply.property,
807 PropertyDelete);
d9c0d4a3
GM
808
809 TRACE1 ("Sending increment of %d bytes", i);
810 TRACE1 ("Set %s to increment data",
811 XGetAtomName (display, reply.property));
1b65481e 812
ede4db72
RS
813 /* Append the next chunk of data to the property. */
814 XChangeProperty (display, window, reply.property, type, format,
815 PropModeAppend, data, i / format_bytes);
816 bytes_remaining -= i;
817 data += i;
5c3a351a 818 XFlush (display);
afe1529d 819 had_errors = x_had_errors_p (display);
2f65feb6 820 UNBLOCK_INPUT;
ede4db72 821
afe1529d
RS
822 if (had_errors)
823 break;
824
2a1a4c9d 825 /* Now wait for the requester to ack this chunk by deleting the
d9c0d4a3
GM
826 property. This can run random lisp code or signal. */
827 TRACE1 ("Waiting for increment ACK (deletion of %s)",
828 XGetAtomName (display, reply.property));
d1f21a66 829 wait_for_property_change (wait_object);
ede4db72 830 }
1b65481e 831
d9c0d4a3
GM
832 /* Now write a zero-length chunk to the property to tell the
833 requester that we're done. */
2f65feb6 834 BLOCK_INPUT;
ede4db72
RS
835 if (! waiting_for_other_props_on_window (display, window))
836 XSelectInput (display, window, 0L);
837
d9c0d4a3
GM
838 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
839 XGetAtomName (display, reply.property));
ede4db72
RS
840 XChangeProperty (display, window, reply.property, type, format,
841 PropModeReplace, data, 0);
d9c0d4a3 842 TRACE0 ("Done sending incrementally");
ede4db72 843 }
afe1529d 844
ceabd272 845 /* rms, 2003-01-03: I think I have fixed this bug. */
47a6ac17
GM
846 /* The window we're communicating with may have been deleted
847 in the meantime (that's a real situation from a bug report).
848 In this case, there may be events in the event queue still
849 refering to the deleted window, and we'll get a BadWindow error
850 in XTread_socket when processing the events. I don't have
851 an idea how to fix that. gerd, 2001-01-98. */
844fc085
JD
852 /* 2004-09-10: XSync and UNBLOCK so that possible protocol errors are
853 delivered before uncatch errors. */
854 XSync (display, False);
afe1529d 855 UNBLOCK_INPUT;
0608b1a0
JD
856
857 /* GTK queues events in addition to the queue in Xlib. So we
858 UNBLOCK to enter the event loop and get possible errors delivered,
859 and then BLOCK again because x_uncatch_errors requires it. */
860 BLOCK_INPUT;
9ba8e10d
CY
861
862 unbind_to (count, Qnil);
4545fa20 863 x_uncatch_errors ();
0608b1a0 864 UNBLOCK_INPUT;
ede4db72
RS
865}
866\f
867/* Handle a SelectionRequest event EVENT.
868 This is called from keyboard.c when such an event is found in the queue. */
869
dd0fe424 870static void
ede4db72
RS
871x_handle_selection_request (event)
872 struct input_event *event;
873{
874 struct gcpro gcpro1, gcpro2, gcpro3;
9d2d1dd8 875 Lisp_Object local_selection_data;
ede4db72 876 Lisp_Object selection_symbol;
9d2d1dd8
KH
877 Lisp_Object target_symbol;
878 Lisp_Object converted_selection;
ede4db72 879 Time local_selection_time;
9d2d1dd8 880 Lisp_Object successful_p;
ede4db72 881 int count;
5c3a351a
RS
882 struct x_display_info *dpyinfo
883 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
ede4db72 884
678b3958
KS
885 TRACE2 ("x_handle_selection_request, from=0x%08lx time=%lu",
886 (unsigned long) SELECTION_EVENT_REQUESTOR (event),
887 (unsigned long) SELECTION_EVENT_TIME (event));
dd0fe424 888
9d2d1dd8
KH
889 local_selection_data = Qnil;
890 target_symbol = Qnil;
891 converted_selection = Qnil;
892 successful_p = Qnil;
893
ede4db72
RS
894 GCPRO3 (local_selection_data, converted_selection, target_symbol);
895
d9c0d4a3 896 selection_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
ede4db72
RS
897 SELECTION_EVENT_SELECTION (event));
898
899 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
ede4db72
RS
900
901 if (NILP (local_selection_data))
902 {
903 /* Someone asked for the selection, but we don't have it any more.
904 */
905 x_decline_selection_request (event);
906 goto DONE;
907 }
908
909 local_selection_time = (Time)
8e713be6 910 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
ede4db72
RS
911
912 if (SELECTION_EVENT_TIME (event) != CurrentTime
7da64e5c 913 && local_selection_time > SELECTION_EVENT_TIME (event))
ede4db72
RS
914 {
915 /* Someone asked for the selection, and we have one, but not the one
916 they're looking for.
917 */
918 x_decline_selection_request (event);
919 goto DONE;
920 }
921
ede4db72 922 x_selection_current_request = event;
331379bf 923 count = SPECPDL_INDEX ();
ca29f2b8 924 selection_request_dpyinfo = dpyinfo;
ede4db72
RS
925 record_unwind_protect (x_selection_request_lisp_error, Qnil);
926
d9c0d4a3 927 target_symbol = x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event),
ede4db72
RS
928 SELECTION_EVENT_TARGET (event));
929
930#if 0 /* #### MULTIPLE doesn't work yet */
931 if (EQ (target_symbol, QMULTIPLE))
932 target_symbol = fetch_multiple_target (event);
933#endif
1b65481e 934
ede4db72 935 /* Convert lisp objects back into binary data */
1b65481e 936
ede4db72 937 converted_selection
5109c8dd 938 = x_get_local_selection (selection_symbol, target_symbol, 0);
1b65481e 939
ede4db72
RS
940 if (! NILP (converted_selection))
941 {
942 unsigned char *data;
943 unsigned int size;
944 int format;
945 Atom type;
aca39f42
RS
946 int nofree;
947
2f65feb6
RS
948 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
949 converted_selection,
aca39f42 950 &data, &type, &size, &format, &nofree);
1b65481e 951
ede4db72
RS
952 x_reply_selection_request (event, format, data, size, type);
953 successful_p = Qt;
954
955 /* Indicate we have successfully processed this event. */
7da64e5c 956 x_selection_current_request = 0;
ede4db72 957
4feb31b2 958 /* Use xfree, not XFree, because lisp_data_to_selection_data
0158abbc 959 calls xmalloc itself. */
aca39f42 960 if (!nofree)
4feb31b2 961 xfree (data);
ede4db72
RS
962 }
963 unbind_to (count, Qnil);
964
965 DONE:
966
ede4db72
RS
967 /* Let random lisp code notice that the selection has been asked for. */
968 {
9d2d1dd8 969 Lisp_Object rest;
c917a8de 970 rest = Vx_sent_selection_functions;
ede4db72
RS
971 if (!EQ (rest, Qunbound))
972 for (; CONSP (rest); rest = Fcdr (rest))
973 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
974 }
4f06187f
RS
975
976 UNGCPRO;
ede4db72
RS
977}
978\f
e18e6130 979/* Handle a SelectionClear event EVENT, which indicates that some
ede4db72
RS
980 client cleared out our previously asserted selection.
981 This is called from keyboard.c when such an event is found in the queue. */
982
dd0fe424 983static void
ede4db72
RS
984x_handle_selection_clear (event)
985 struct input_event *event;
986{
987 Display *display = SELECTION_EVENT_DISPLAY (event);
988 Atom selection = SELECTION_EVENT_SELECTION (event);
989 Time changed_owner_time = SELECTION_EVENT_TIME (event);
1b65481e 990
ede4db72
RS
991 Lisp_Object selection_symbol, local_selection_data;
992 Time local_selection_time;
5c3a351a 993 struct x_display_info *dpyinfo = x_display_info_for_display (display);
e18e6130
RS
994 struct x_display_info *t_dpyinfo;
995
dd0fe424
KS
996 TRACE0 ("x_handle_selection_clear");
997
e18e6130
RS
998 /* If the new selection owner is also Emacs,
999 don't clear the new selection. */
1000 BLOCK_INPUT;
1001 /* Check each display on the same terminal,
1002 to see if this Emacs job now owns the selection
1003 through that display. */
1004 for (t_dpyinfo = x_display_list; t_dpyinfo; t_dpyinfo = t_dpyinfo->next)
1005 if (t_dpyinfo->kboard == dpyinfo->kboard)
1006 {
1007 Window owner_window
1008 = XGetSelectionOwner (t_dpyinfo->display, selection);
1009 if (x_window_to_frame (t_dpyinfo, owner_window) != 0)
1010 {
1011 UNBLOCK_INPUT;
1012 return;
1013 }
1014 }
1015 UNBLOCK_INPUT;
ede4db72 1016
d9c0d4a3 1017 selection_symbol = x_atom_to_symbol (display, selection);
ede4db72
RS
1018
1019 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
1020
1021 /* Well, we already believe that we don't own it, so that's just fine. */
1022 if (NILP (local_selection_data)) return;
1023
1024 local_selection_time = (Time)
8e713be6 1025 cons_to_long (XCAR (XCDR (XCDR (local_selection_data))));
ede4db72
RS
1026
1027 /* This SelectionClear is for a selection that we no longer own, so we can
1028 disregard it. (That is, we have reasserted the selection since this
1029 request was generated.) */
1030
1031 if (changed_owner_time != CurrentTime
1032 && local_selection_time > changed_owner_time)
1033 return;
1034
1035 /* Otherwise, we're really honest and truly being told to drop it.
1036 Don't use Fdelq as that may QUIT;. */
1037
1038 if (EQ (local_selection_data, Fcar (Vselection_alist)))
1039 Vselection_alist = Fcdr (Vselection_alist);
1040 else
1041 {
1042 Lisp_Object rest;
1043 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
8e713be6 1044 if (EQ (local_selection_data, Fcar (XCDR (rest))))
ede4db72 1045 {
f3fbd155 1046 XSETCDR (rest, Fcdr (XCDR (rest)));
ede4db72
RS
1047 break;
1048 }
1049 }
1050
1051 /* Let random lisp code notice that the selection has been stolen. */
1052
1053 {
d1f21a66 1054 Lisp_Object rest;
c917a8de 1055 rest = Vx_lost_selection_functions;
ede4db72 1056 if (!EQ (rest, Qunbound))
d1f21a66
RS
1057 {
1058 for (; CONSP (rest); rest = Fcdr (rest))
1059 call1 (Fcar (rest), selection_symbol);
7c6b2ea4 1060 prepare_menu_bars ();
3007ebfb 1061 redisplay_preserve_echo_area (20);
d1f21a66 1062 }
ede4db72
RS
1063 }
1064}
1065
dd0fe424
KS
1066void
1067x_handle_selection_event (event)
1068 struct input_event *event;
1069{
1070 TRACE0 ("x_handle_selection_event");
1071
1072 if (event->kind == SELECTION_REQUEST_EVENT)
1073 {
1074 if (x_queue_selection_requests)
1075 x_queue_event (event);
1076 else
1077 x_handle_selection_request (event);
1078 }
1079 else
1080 x_handle_selection_clear (event);
1081}
1082
1083
118bd841
RS
1084/* Clear all selections that were made from frame F.
1085 We do this when about to delete a frame. */
1086
1087void
1088x_clear_frame_selections (f)
1089 FRAME_PTR f;
1090{
1091 Lisp_Object frame;
1092 Lisp_Object rest;
1093
90851bbe 1094 XSETFRAME (frame, f);
118bd841
RS
1095
1096 /* Otherwise, we're really honest and truly being told to drop it.
1097 Don't use Fdelq as that may QUIT;. */
1098
0d199f9c
RS
1099 /* Delete elements from the beginning of Vselection_alist. */
1100 while (!NILP (Vselection_alist)
1101 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
1102 {
1103 /* Let random Lisp code notice that the selection has been stolen. */
1104 Lisp_Object hooks, selection_symbol;
1105
c917a8de 1106 hooks = Vx_lost_selection_functions;
0d199f9c
RS
1107 selection_symbol = Fcar (Fcar (Vselection_alist));
1108
1109 if (!EQ (hooks, Qunbound))
1110 {
1111 for (; CONSP (hooks); hooks = Fcdr (hooks))
1112 call1 (Fcar (hooks), selection_symbol);
996b804d
MB
1113#if 0 /* This can crash when deleting a frame
1114 from x_connection_closed. Anyway, it seems unnecessary;
1115 something else should cause a redisplay. */
3007ebfb 1116 redisplay_preserve_echo_area (21);
996b804d 1117#endif
0d199f9c
RS
1118 }
1119
1120 Vselection_alist = Fcdr (Vselection_alist);
1121 }
1122
1123 /* Delete elements after the beginning of Vselection_alist. */
118bd841 1124 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
8e713be6 1125 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest))))))))
118bd841
RS
1126 {
1127 /* Let random Lisp code notice that the selection has been stolen. */
1128 Lisp_Object hooks, selection_symbol;
1129
c917a8de 1130 hooks = Vx_lost_selection_functions;
8e713be6 1131 selection_symbol = Fcar (Fcar (XCDR (rest)));
118bd841
RS
1132
1133 if (!EQ (hooks, Qunbound))
1134 {
1135 for (; CONSP (hooks); hooks = Fcdr (hooks))
1136 call1 (Fcar (hooks), selection_symbol);
996b804d 1137#if 0 /* See above */
3007ebfb 1138 redisplay_preserve_echo_area (22);
996b804d 1139#endif
118bd841 1140 }
f3fbd155 1141 XSETCDR (rest, Fcdr (XCDR (rest)));
118bd841
RS
1142 break;
1143 }
1144}
ede4db72 1145\f
ede4db72
RS
1146/* Nonzero if any properties for DISPLAY and WINDOW
1147 are on the list of what we are waiting for. */
1148
1149static int
1150waiting_for_other_props_on_window (display, window)
1151 Display *display;
1152 Window window;
1153{
1154 struct prop_location *rest = property_change_wait_list;
1155 while (rest)
1156 if (rest->display == display && rest->window == window)
1157 return 1;
1158 else
1159 rest = rest->next;
1160 return 0;
1161}
1162
1163/* Add an entry to the list of property changes we are waiting for.
1164 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1165 The return value is a number that uniquely identifies
1166 this awaited property change. */
1167
d1f21a66 1168static struct prop_location *
ede4db72
RS
1169expect_property_change (display, window, property, state)
1170 Display *display;
1171 Window window;
6c070502 1172 Atom property;
ede4db72
RS
1173 int state;
1174{
d9c0d4a3 1175 struct prop_location *pl = (struct prop_location *) xmalloc (sizeof *pl);
2f65feb6 1176 pl->identifier = ++prop_location_identifier;
ede4db72
RS
1177 pl->display = display;
1178 pl->window = window;
1179 pl->property = property;
1180 pl->desired_state = state;
1181 pl->next = property_change_wait_list;
d1f21a66 1182 pl->arrived = 0;
ede4db72 1183 property_change_wait_list = pl;
d1f21a66 1184 return pl;
ede4db72
RS
1185}
1186
1187/* Delete an entry from the list of property changes we are waiting for.
2f65feb6 1188 IDENTIFIER is the number that uniquely identifies the entry. */
ede4db72
RS
1189
1190static void
d1f21a66
RS
1191unexpect_property_change (location)
1192 struct prop_location *location;
ede4db72
RS
1193{
1194 struct prop_location *prev = 0, *rest = property_change_wait_list;
1195 while (rest)
1196 {
d1f21a66 1197 if (rest == location)
ede4db72
RS
1198 {
1199 if (prev)
1200 prev->next = rest->next;
1201 else
1202 property_change_wait_list = rest->next;
4feb31b2 1203 xfree (rest);
ede4db72
RS
1204 return;
1205 }
1206 prev = rest;
1207 rest = rest->next;
1208 }
1209}
1210
2f65feb6
RS
1211/* Remove the property change expectation element for IDENTIFIER. */
1212
1213static Lisp_Object
dd0fe424
KS
1214wait_for_property_change_unwind (loc)
1215 Lisp_Object loc;
2f65feb6 1216{
dd0fe424
KS
1217 struct prop_location *location = XSAVE_VALUE (loc)->pointer;
1218
1219 unexpect_property_change (location);
1220 if (location == property_change_reply_object)
1221 property_change_reply_object = 0;
ab552306 1222 return Qnil;
2f65feb6
RS
1223}
1224
ede4db72 1225/* Actually wait for a property change.
2f65feb6 1226 IDENTIFIER should be the value that expect_property_change returned. */
ede4db72
RS
1227
1228static void
d1f21a66
RS
1229wait_for_property_change (location)
1230 struct prop_location *location;
ede4db72 1231{
2f65feb6 1232 int secs, usecs;
aed13378 1233 int count = SPECPDL_INDEX ();
d1f21a66 1234
dd0fe424
KS
1235 if (property_change_reply_object)
1236 abort ();
2f65feb6
RS
1237
1238 /* Make sure to do unexpect_property_change if we quit or err. */
dd0fe424
KS
1239 record_unwind_protect (wait_for_property_change_unwind,
1240 make_save_value (location, 0));
2f65feb6 1241
f3fbd155 1242 XSETCAR (property_change_reply, Qnil);
afe1529d 1243 property_change_reply_object = location;
dd0fe424 1244
afe1529d
RS
1245 /* If the event we are waiting for arrives beyond here, it will set
1246 property_change_reply, because property_change_reply_object says so. */
d1f21a66
RS
1247 if (! location->arrived)
1248 {
d1f21a66
RS
1249 secs = x_selection_timeout / 1000;
1250 usecs = (x_selection_timeout % 1000) * 1000;
d9c0d4a3 1251 TRACE2 (" Waiting %d secs, %d usecs", secs, usecs);
d64b707c
KS
1252 wait_reading_process_output (secs, usecs, 0, 0,
1253 property_change_reply, NULL, 0);
d1f21a66 1254
8e713be6 1255 if (NILP (XCAR (property_change_reply)))
d9c0d4a3
GM
1256 {
1257 TRACE0 (" Timed out");
1258 error ("Timed out waiting for property-notify event");
1259 }
d1f21a66 1260 }
2f65feb6
RS
1261
1262 unbind_to (count, Qnil);
ede4db72
RS
1263}
1264
1265/* Called from XTread_socket in response to a PropertyNotify event. */
1266
1267void
1268x_handle_property_notify (event)
1269 XPropertyEvent *event;
1270{
1271 struct prop_location *prev = 0, *rest = property_change_wait_list;
d9c0d4a3 1272
ede4db72
RS
1273 while (rest)
1274 {
dd0fe424
KS
1275 if (!rest->arrived
1276 && rest->property == event->atom
ede4db72
RS
1277 && rest->window == event->window
1278 && rest->display == event->display
1279 && rest->desired_state == event->state)
1280 {
d9c0d4a3
GM
1281 TRACE2 ("Expected %s of property %s",
1282 (event->state == PropertyDelete ? "deletion" : "change"),
1283 XGetAtomName (event->display, event->atom));
ede4db72 1284
d1f21a66
RS
1285 rest->arrived = 1;
1286
ede4db72
RS
1287 /* If this is the one wait_for_property_change is waiting for,
1288 tell it to wake up. */
d1f21a66 1289 if (rest == property_change_reply_object)
f3fbd155 1290 XSETCAR (property_change_reply, Qt);
ede4db72 1291
ede4db72
RS
1292 return;
1293 }
1b65481e 1294
ede4db72
RS
1295 prev = rest;
1296 rest = rest->next;
1297 }
ede4db72
RS
1298}
1299
1300
1301\f
1302#if 0 /* #### MULTIPLE doesn't work yet */
1303
1304static Lisp_Object
1305fetch_multiple_target (event)
1306 XSelectionRequestEvent *event;
1307{
1308 Display *display = event->display;
5d0ba25b 1309 Window window = event->requestor;
ede4db72
RS
1310 Atom target = event->target;
1311 Atom selection_atom = event->selection;
1312 int result;
1313
1314 return
1315 Fcons (QMULTIPLE,
1316 x_get_window_property_as_lisp_data (display, window, target,
1317 QMULTIPLE, selection_atom));
1318}
1319
1320static Lisp_Object
1321copy_multiple_data (obj)
1322 Lisp_Object obj;
1323{
1324 Lisp_Object vec;
1325 int i;
1326 int size;
1327 if (CONSP (obj))
8e713be6 1328 return Fcons (XCAR (obj), copy_multiple_data (XCDR (obj)));
1b65481e 1329
b7826503 1330 CHECK_VECTOR (obj);
ede4db72
RS
1331 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1332 for (i = 0; i < size; i++)
1333 {
1334 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
b7826503 1335 CHECK_VECTOR (vec2);
ede4db72
RS
1336 if (XVECTOR (vec2)->size != 2)
1337 /* ??? Confusing error message */
1338 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1339 Fcons (vec2, Qnil)));
1340 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1341 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1342 = XVECTOR (vec2)->contents [0];
1343 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1344 = XVECTOR (vec2)->contents [1];
1345 }
1346 return vec;
1347}
1348
1349#endif
1350
1351\f
1352/* Variables for communication with x_handle_selection_notify. */
1353static Atom reading_which_selection;
1354static Lisp_Object reading_selection_reply;
1355static Window reading_selection_window;
1356
1357/* Do protocol to read selection-data from the server.
1358 Converts this to Lisp data and returns it. */
1359
1360static Lisp_Object
3a42401d
JD
1361x_get_foreign_selection (selection_symbol, target_type, time_stamp)
1362 Lisp_Object selection_symbol, target_type, time_stamp;
ede4db72 1363{
378c33ca
GM
1364 struct frame *sf = SELECTED_FRAME ();
1365 Window requestor_window = FRAME_X_WINDOW (sf);
1366 Display *display = FRAME_X_DISPLAY (sf);
1367 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (sf);
5d0ba25b 1368 Time requestor_time = last_event_timestamp;
5c3a351a
RS
1369 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1370 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
ede4db72 1371 Atom type_atom;
80da0190 1372 int secs, usecs;
5a499696 1373 int count;
55b2d45d 1374 Lisp_Object frame;
ede4db72
RS
1375
1376 if (CONSP (target_type))
8e713be6 1377 type_atom = symbol_to_x_atom (dpyinfo, display, XCAR (target_type));
ede4db72 1378 else
5c3a351a 1379 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
ede4db72 1380
3a42401d
JD
1381 if (! NILP (time_stamp))
1382 {
1383 if (CONSP (time_stamp))
1384 requestor_time = (Time) cons_to_long (time_stamp);
1385 else if (INTEGERP (time_stamp))
1386 requestor_time = (Time) XUINT (time_stamp);
1387 else if (FLOATP (time_stamp))
ff59904a 1388 requestor_time = (Time) XFLOAT_DATA (time_stamp);
3a42401d
JD
1389 else
1390 error ("TIME_STAMP must be cons or number");
1391 }
1392
ede4db72 1393 BLOCK_INPUT;
1b65481e 1394
9ba8e10d 1395 x_catch_errors (display);
1b65481e 1396
d9c0d4a3
GM
1397 TRACE2 ("Get selection %s, type %s",
1398 XGetAtomName (display, type_atom),
1399 XGetAtomName (display, target_property));
1400
ede4db72 1401 XConvertSelection (display, selection_atom, type_atom, target_property,
5d0ba25b 1402 requestor_window, requestor_time);
5c3a351a 1403 XFlush (display);
ede4db72
RS
1404
1405 /* Prepare to block until the reply has been read. */
5d0ba25b 1406 reading_selection_window = requestor_window;
ede4db72 1407 reading_which_selection = selection_atom;
f3fbd155 1408 XSETCAR (reading_selection_reply, Qnil);
55b2d45d
RS
1409
1410 frame = some_frame_on_display (dpyinfo);
1411
9ba8e10d
CY
1412 count = SPECPDL_INDEX ();
1413
55b2d45d
RS
1414 /* If the display no longer has frames, we can't expect
1415 to get many more selection requests from it, so don't
1416 bother trying to queue them. */
1417 if (!NILP (frame))
1418 {
dd0fe424 1419 x_start_queuing_selection_requests ();
55b2d45d
RS
1420
1421 record_unwind_protect (queue_selection_requests_unwind,
dd0fe424 1422 Qnil);
55b2d45d 1423 }
ede4db72
RS
1424 UNBLOCK_INPUT;
1425
80da0190
RS
1426 /* This allows quits. Also, don't wait forever. */
1427 secs = x_selection_timeout / 1000;
1428 usecs = (x_selection_timeout % 1000) * 1000;
d9c0d4a3 1429 TRACE1 (" Start waiting %d secs for SelectionNotify", secs);
d64b707c
KS
1430 wait_reading_process_output (secs, usecs, 0, 0,
1431 reading_selection_reply, NULL, 0);
d9c0d4a3 1432 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply)));
ede4db72 1433
7c6b2ea4 1434 BLOCK_INPUT;
9ba8e10d 1435 unbind_to (count, Qnil);
a7b24d46 1436 x_check_errors (display, "Cannot get selection: %s");
4545fa20 1437 x_uncatch_errors ();
7c6b2ea4
RS
1438 UNBLOCK_INPUT;
1439
8e713be6 1440 if (NILP (XCAR (reading_selection_reply)))
606140dd 1441 error ("Timed out waiting for reply from selection owner");
8e713be6 1442 if (EQ (XCAR (reading_selection_reply), Qlambda))
d5db4077 1443 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol)));
ede4db72
RS
1444
1445 /* Otherwise, the selection is waiting for us on the requested property. */
1446 return
5d0ba25b 1447 x_get_window_property_as_lisp_data (display, requestor_window,
ede4db72
RS
1448 target_property, target_type,
1449 selection_atom);
1450}
1451\f
1452/* Subroutines of x_get_window_property_as_lisp_data */
1453
4feb31b2 1454/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1455
ede4db72
RS
1456static void
1457x_get_window_property (display, window, property, data_ret, bytes_ret,
1458 actual_type_ret, actual_format_ret, actual_size_ret,
1459 delete_p)
1460 Display *display;
1461 Window window;
1462 Atom property;
1463 unsigned char **data_ret;
1464 int *bytes_ret;
1465 Atom *actual_type_ret;
1466 int *actual_format_ret;
1467 unsigned long *actual_size_ret;
1468 int delete_p;
1469{
1470 int total_size;
1471 unsigned long bytes_remaining;
1472 int offset = 0;
1473 unsigned char *tmp_data = 0;
1474 int result;
1475 int buffer_size = SELECTION_QUANTUM (display);
1b65481e 1476
d9c0d4a3
GM
1477 if (buffer_size > MAX_SELECTION_QUANTUM)
1478 buffer_size = MAX_SELECTION_QUANTUM;
1b65481e 1479
ede4db72 1480 BLOCK_INPUT;
1b65481e 1481
ede4db72
RS
1482 /* First probe the thing to find out how big it is. */
1483 result = XGetWindowProperty (display, window, property,
137edb72 1484 0L, 0L, False, AnyPropertyType,
ede4db72
RS
1485 actual_type_ret, actual_format_ret,
1486 actual_size_ret,
1487 &bytes_remaining, &tmp_data);
ede4db72
RS
1488 if (result != Success)
1489 {
2f65feb6 1490 UNBLOCK_INPUT;
ede4db72
RS
1491 *data_ret = 0;
1492 *bytes_ret = 0;
1493 return;
1494 }
1b65481e 1495
0158abbc
RS
1496 /* This was allocated by Xlib, so use XFree. */
1497 XFree ((char *) tmp_data);
1b65481e 1498
ede4db72
RS
1499 if (*actual_type_ret == None || *actual_format_ret == 0)
1500 {
2f65feb6 1501 UNBLOCK_INPUT;
ede4db72
RS
1502 return;
1503 }
1504
1505 total_size = bytes_remaining + 1;
1506 *data_ret = (unsigned char *) xmalloc (total_size);
1b65481e 1507
2a1a4c9d 1508 /* Now read, until we've gotten it all. */
ede4db72
RS
1509 while (bytes_remaining)
1510 {
d9c0d4a3 1511#ifdef TRACE_SELECTION
ede4db72
RS
1512 int last = bytes_remaining;
1513#endif
1514 result
1515 = XGetWindowProperty (display, window, property,
137edb72 1516 (long)offset/4, (long)buffer_size/4,
2f65feb6 1517 False,
ede4db72
RS
1518 AnyPropertyType,
1519 actual_type_ret, actual_format_ret,
1520 actual_size_ret, &bytes_remaining, &tmp_data);
d9c0d4a3
GM
1521
1522 TRACE2 ("Read %ld bytes from property %s",
1523 last - bytes_remaining,
1524 XGetAtomName (display, property));
1525
ede4db72
RS
1526 /* If this doesn't return Success at this point, it means that
1527 some clod deleted the selection while we were in the midst of
d9c0d4a3
GM
1528 reading it. Deal with that, I guess.... */
1529 if (result != Success)
1530 break;
e22cf39c
JD
1531
1532 /* The man page for XGetWindowProperty says:
1533 "If the returned format is 32, the returned data is represented
1534 as a long array and should be cast to that type to obtain the
1535 elements."
1536 This applies even if long is more than 32 bits, the X library
1537 converts from 32 bit elements received from the X server to long
1538 and passes the long array to us. Thus, for that case bcopy can not
1539 be used. We convert to a 32 bit type here, because so much code
1540 assume on that.
1541
1542 The bytes and offsets passed to XGetWindowProperty refers to the
1543 property and those are indeed in 32 bit quantities if format is 32. */
1544
1545 if (*actual_format_ret == 32 && *actual_format_ret < BITS_PER_LONG)
1546 {
1547 unsigned long i;
1548 int *idata = (int *) ((*data_ret) + offset);
1549 long *ldata = (long *) tmp_data;
1550
1551 for (i = 0; i < *actual_size_ret; ++i)
1552 {
1553 idata[i]= (int) ldata[i];
1554 offset += 4;
1555 }
1556 }
1557 else
1558 {
1559 *actual_size_ret *= *actual_format_ret / 8;
1560 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1561 offset += *actual_size_ret;
1562 }
1b65481e 1563
0158abbc
RS
1564 /* This was allocated by Xlib, so use XFree. */
1565 XFree ((char *) tmp_data);
ede4db72 1566 }
2f65feb6 1567
5c3a351a 1568 XFlush (display);
ede4db72
RS
1569 UNBLOCK_INPUT;
1570 *bytes_ret = offset;
1571}
1572\f
4feb31b2 1573/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1574
ede4db72
RS
1575static void
1576receive_incremental_selection (display, window, property, target_type,
1577 min_size_bytes, data_ret, size_bytes_ret,
1578 type_ret, format_ret, size_ret)
1579 Display *display;
1580 Window window;
1581 Atom property;
1582 Lisp_Object target_type; /* for error messages only */
1583 unsigned int min_size_bytes;
1584 unsigned char **data_ret;
1585 int *size_bytes_ret;
1586 Atom *type_ret;
1587 unsigned long *size_ret;
1588 int *format_ret;
1589{
1590 int offset = 0;
d1f21a66 1591 struct prop_location *wait_object;
ede4db72
RS
1592 *size_bytes_ret = min_size_bytes;
1593 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
d9c0d4a3
GM
1594
1595 TRACE1 ("Read %d bytes incrementally", min_size_bytes);
2f65feb6
RS
1596
1597 /* At this point, we have read an INCR property.
1598 Delete the property to ack it.
1599 (But first, prepare to receive the next event in this handshake.)
ede4db72
RS
1600
1601 Now, we must loop, waiting for the sending window to put a value on
1602 that property, then reading the property, then deleting it to ack.
1603 We are done when the sender places a property of length 0.
1604 */
2f65feb6
RS
1605 BLOCK_INPUT;
1606 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
d9c0d4a3 1607 TRACE1 (" Delete property %s",
dd0fe424 1608 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
2f65feb6 1609 XDeleteProperty (display, window, property);
d9c0d4a3 1610 TRACE1 (" Expect new value of property %s",
dd0fe424 1611 SDATA (SYMBOL_NAME (x_atom_to_symbol (display, property))));
d1f21a66
RS
1612 wait_object = expect_property_change (display, window, property,
1613 PropertyNewValue);
5c3a351a 1614 XFlush (display);
2f65feb6
RS
1615 UNBLOCK_INPUT;
1616
ede4db72
RS
1617 while (1)
1618 {
1619 unsigned char *tmp_data;
1620 int tmp_size_bytes;
d9c0d4a3
GM
1621
1622 TRACE0 (" Wait for property change");
d1f21a66 1623 wait_for_property_change (wait_object);
1b65481e 1624
ede4db72 1625 /* expect it again immediately, because x_get_window_property may
2a1a4c9d 1626 .. no it won't, I don't get it.
d9c0d4a3
GM
1627 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1628 TRACE0 (" Get property value");
ede4db72
RS
1629 x_get_window_property (display, window, property,
1630 &tmp_data, &tmp_size_bytes,
1631 type_ret, format_ret, size_ret, 1);
1632
d9c0d4a3
GM
1633 TRACE1 (" Read increment of %d bytes", tmp_size_bytes);
1634
ede4db72
RS
1635 if (tmp_size_bytes == 0) /* we're done */
1636 {
d9c0d4a3
GM
1637 TRACE0 ("Done reading incrementally");
1638
2f65feb6
RS
1639 if (! waiting_for_other_props_on_window (display, window))
1640 XSelectInput (display, window, STANDARD_EVENT_SET);
4feb31b2 1641 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1642 calls xmalloc itself. */
4feb31b2 1643 if (tmp_data) xfree (tmp_data);
ede4db72
RS
1644 break;
1645 }
2f65feb6
RS
1646
1647 BLOCK_INPUT;
d9c0d4a3
GM
1648 TRACE1 (" ACK by deleting property %s",
1649 XGetAtomName (display, property));
2f65feb6 1650 XDeleteProperty (display, window, property);
d1f21a66
RS
1651 wait_object = expect_property_change (display, window, property,
1652 PropertyNewValue);
5c3a351a 1653 XFlush (display);
2f65feb6
RS
1654 UNBLOCK_INPUT;
1655
ede4db72
RS
1656 if (*size_bytes_ret < offset + tmp_size_bytes)
1657 {
ede4db72
RS
1658 *size_bytes_ret = offset + tmp_size_bytes;
1659 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1660 }
1b65481e 1661
018cfa07 1662 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
ede4db72 1663 offset += tmp_size_bytes;
1b65481e 1664
4feb31b2 1665 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1666 calls xmalloc itself. */
4feb31b2 1667 xfree (tmp_data);
ede4db72
RS
1668 }
1669}
d9c0d4a3 1670
ede4db72
RS
1671\f
1672/* Once a requested selection is "ready" (we got a SelectionNotify event),
1673 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1674 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1675
1676static Lisp_Object
1677x_get_window_property_as_lisp_data (display, window, property, target_type,
1678 selection_atom)
1679 Display *display;
1680 Window window;
1681 Atom property;
1682 Lisp_Object target_type; /* for error messages only */
1683 Atom selection_atom; /* for error messages only */
1684{
1685 Atom actual_type;
1686 int actual_format;
1687 unsigned long actual_size;
1688 unsigned char *data = 0;
1689 int bytes = 0;
1690 Lisp_Object val;
5c3a351a 1691 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1692
d9c0d4a3
GM
1693 TRACE0 ("Reading selection data");
1694
ede4db72
RS
1695 x_get_window_property (display, window, property, &data, &bytes,
1696 &actual_type, &actual_format, &actual_size, 1);
1697 if (! data)
1698 {
1699 int there_is_a_selection_owner;
1700 BLOCK_INPUT;
1701 there_is_a_selection_owner
1702 = XGetSelectionOwner (display, selection_atom);
1703 UNBLOCK_INPUT;
5a499696
RS
1704 Fsignal (Qerror,
1705 there_is_a_selection_owner
1706 ? Fcons (build_string ("selection owner couldn't convert"),
ede4db72
RS
1707 actual_type
1708 ? Fcons (target_type,
d9c0d4a3 1709 Fcons (x_atom_to_symbol (display,
5c3a351a 1710 actual_type),
ede4db72
RS
1711 Qnil))
1712 : Fcons (target_type, Qnil))
5a499696 1713 : Fcons (build_string ("no selection"),
d9c0d4a3 1714 Fcons (x_atom_to_symbol (display,
5a499696
RS
1715 selection_atom),
1716 Qnil)));
ede4db72 1717 }
1b65481e 1718
5c3a351a 1719 if (actual_type == dpyinfo->Xatom_INCR)
ede4db72
RS
1720 {
1721 /* That wasn't really the data, just the beginning. */
1722
1723 unsigned int min_size_bytes = * ((unsigned int *) data);
1724 BLOCK_INPUT;
4feb31b2 1725 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1726 calls xmalloc itself. */
4feb31b2 1727 xfree ((char *) data);
ede4db72
RS
1728 UNBLOCK_INPUT;
1729 receive_incremental_selection (display, window, property, target_type,
1730 min_size_bytes, &data, &bytes,
1731 &actual_type, &actual_format,
1732 &actual_size);
1733 }
1734
2f65feb6 1735 BLOCK_INPUT;
d9c0d4a3 1736 TRACE1 (" Delete property %s", XGetAtomName (display, property));
2f65feb6 1737 XDeleteProperty (display, window, property);
5c3a351a 1738 XFlush (display);
2f65feb6
RS
1739 UNBLOCK_INPUT;
1740
ede4db72
RS
1741 /* It's been read. Now convert it to a lisp object in some semi-rational
1742 manner. */
1743 val = selection_data_to_lisp_data (display, data, bytes,
1744 actual_type, actual_format);
1b65481e 1745
4feb31b2 1746 /* Use xfree, not XFree, because x_get_window_property
0158abbc 1747 calls xmalloc itself. */
4feb31b2 1748 xfree ((char *) data);
ede4db72
RS
1749 return val;
1750}
1751\f
1752/* These functions convert from the selection data read from the server into
1753 something that we can use from Lisp, and vice versa.
1754
1755 Type: Format: Size: Lisp Type:
1756 ----- ------- ----- -----------
1757 * 8 * String
1758 ATOM 32 1 Symbol
1759 ATOM 32 > 1 Vector of Symbols
1760 * 16 1 Integer
1761 * 16 > 1 Vector of Integers
1762 * 32 1 if <=16 bits: Integer
1763 if > 16 bits: Cons of top16, bot16
1764 * 32 > 1 Vector of the above
1765
1766 When converting a Lisp number to C, it is assumed to be of format 16 if
1767 it is an integer, and of format 32 if it is a cons of two integers.
1768
1769 When converting a vector of numbers from Lisp to C, it is assumed to be
1770 of format 16 if every element in the vector is an integer, and is assumed
1771 to be of format 32 if any element is a cons of two integers.
1772
1773 When converting an object to C, it may be of the form (SYMBOL . <data>)
1774 where SYMBOL is what we should claim that the type is. Format and
b8d6f4af
JD
1775 representation are as above.
1776
1777 Important: When format is 32, data should contain an array of int,
1778 not an array of long as the X library returns. This makes a difference
1779 when sizeof(long) != sizeof(int). */
ede4db72
RS
1780
1781
1782
1783static Lisp_Object
1784selection_data_to_lisp_data (display, data, size, type, format)
1785 Display *display;
1786 unsigned char *data;
1787 Atom type;
1788 int size, format;
1789{
5c3a351a 1790 struct x_display_info *dpyinfo = x_display_info_for_display (display);
ede4db72 1791
5c3a351a 1792 if (type == dpyinfo->Xatom_NULL)
ede4db72
RS
1793 return QNULL;
1794
1795 /* Convert any 8-bit data to a string, for compactness. */
1796 else if (format == 8)
e6c7c988 1797 {
e57ad4d8
KH
1798 Lisp_Object str, lispy_type;
1799
1800 str = make_unibyte_string ((char *) data, size);
1801 /* Indicate that this string is from foreign selection by a text
1802 property `foreign-selection' so that the caller of
1803 x-get-selection-internal (usually x-get-selection) can know
1804 that the string must be decode. */
1805 if (type == dpyinfo->Xatom_COMPOUND_TEXT)
1806 lispy_type = QCOMPOUND_TEXT;
1807 else if (type == dpyinfo->Xatom_UTF8_STRING)
1808 lispy_type = QUTF8_STRING;
e6c7c988 1809 else
e57ad4d8
KH
1810 lispy_type = QSTRING;
1811 Fput_text_property (make_number (0), make_number (size),
1812 Qforeign_selection, lispy_type, str);
e6c7c988
KH
1813 return str;
1814 }
ede4db72
RS
1815 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1816 a vector of symbols.
1817 */
1818 else if (type == XA_ATOM)
1819 {
1820 int i;
b8d6f4af
JD
1821 /* On a 64 bit machine sizeof(Atom) == sizeof(long) == 8.
1822 But the callers of these function has made sure the data for
1823 format == 32 is an array of int. Thus, use int instead
1824 of Atom. */
1825 int *idata = (int *) data;
1826
1827 if (size == sizeof (int))
1828 return x_atom_to_symbol (display, (Atom) idata[0]);
ede4db72
RS
1829 else
1830 {
b8d6f4af 1831 Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
e607a484 1832 make_number (0));
b8d6f4af 1833 for (i = 0; i < size / sizeof (int); i++)
e607a484 1834 Faset (v, make_number (i),
b8d6f4af 1835 x_atom_to_symbol (display, (Atom) idata[i]));
ede4db72
RS
1836 return v;
1837 }
1838 }
1839
1840 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1841 If the number is > 16 bits, convert it to a cons of integers,
1842 16 bits in each half.
1843 */
2f51feb8
AS
1844 else if (format == 32 && size == sizeof (int))
1845 return long_to_cons (((unsigned int *) data) [0]);
ede4db72
RS
1846 else if (format == 16 && size == sizeof (short))
1847 return make_number ((int) (((unsigned short *) data) [0]));
1848
1849 /* Convert any other kind of data to a vector of numbers, represented
1850 as above (as an integer, or a cons of two 16 bit integers.)
1851 */
1852 else if (format == 16)
1853 {
1854 int i;
937a3875
RS
1855 Lisp_Object v;
1856 v = Fmake_vector (make_number (size / 2), make_number (0));
1857 for (i = 0; i < size / 2; i++)
ede4db72
RS
1858 {
1859 int j = (int) ((unsigned short *) data) [i];
e607a484 1860 Faset (v, make_number (i), make_number (j));
ede4db72
RS
1861 }
1862 return v;
1863 }
1864 else
1865 {
1866 int i;
e607a484 1867 Lisp_Object v = Fmake_vector (make_number (size / 4), make_number (0));
ede4db72
RS
1868 for (i = 0; i < size / 4; i++)
1869 {
2f51feb8 1870 unsigned int j = ((unsigned int *) data) [i];
e607a484 1871 Faset (v, make_number (i), long_to_cons (j));
ede4db72
RS
1872 }
1873 return v;
1874 }
1875}
1876
1877
4feb31b2 1878/* Use xfree, not XFree, to free the data obtained with this function. */
0158abbc 1879
ede4db72
RS
1880static void
1881lisp_data_to_selection_data (display, obj,
aca39f42
RS
1882 data_ret, type_ret, size_ret,
1883 format_ret, nofree_ret)
ede4db72
RS
1884 Display *display;
1885 Lisp_Object obj;
1886 unsigned char **data_ret;
1887 Atom *type_ret;
1888 unsigned int *size_ret;
1889 int *format_ret;
aca39f42 1890 int *nofree_ret;
ede4db72
RS
1891{
1892 Lisp_Object type = Qnil;
5c3a351a 1893 struct x_display_info *dpyinfo = x_display_info_for_display (display);
aca39f42
RS
1894
1895 *nofree_ret = 0;
1896
8e713be6 1897 if (CONSP (obj) && SYMBOLP (XCAR (obj)))
ede4db72 1898 {
8e713be6
KR
1899 type = XCAR (obj);
1900 obj = XCDR (obj);
1901 if (CONSP (obj) && NILP (XCDR (obj)))
1902 obj = XCAR (obj);
ede4db72
RS
1903 }
1904
1905 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1906 { /* This is not the same as declining */
1907 *format_ret = 32;
1908 *size_ret = 0;
1909 *data_ret = 0;
1910 type = QNULL;
1911 }
1912 else if (STRINGP (obj))
1913 {
1bd70c6e
KH
1914 if (SCHARS (obj) < SBYTES (obj))
1915 /* OBJ is a multibyte string containing a non-ASCII char. */
1916 Fsignal (Qerror, /* Qselection_error */
1917 Fcons (build_string
1918 ("Non-ASCII string must be encoded in advance"),
1919 Fcons (obj, Qnil)));
7b9ae523 1920 if (NILP (type))
5109c8dd
KH
1921 type = QSTRING;
1922 *format_ret = 8;
1923 *size_ret = SBYTES (obj);
1924 *data_ret = SDATA (obj);
1925 *nofree_ret = 1;
ede4db72
RS
1926 }
1927 else if (SYMBOLP (obj))
1928 {
1929 *format_ret = 32;
1930 *size_ret = 1;
1931 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1932 (*data_ret) [sizeof (Atom)] = 0;
5c3a351a 1933 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
ede4db72
RS
1934 if (NILP (type)) type = QATOM;
1935 }
7da64e5c 1936 else if (INTEGERP (obj)
ede4db72
RS
1937 && XINT (obj) < 0xFFFF
1938 && XINT (obj) > -0xFFFF)
1939 {
1940 *format_ret = 16;
1941 *size_ret = 1;
1942 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1943 (*data_ret) [sizeof (short)] = 0;
1944 (*(short **) data_ret) [0] = (short) XINT (obj);
1945 if (NILP (type)) type = QINTEGER;
1946 }
a87ed99c 1947 else if (INTEGERP (obj)
8e713be6
KR
1948 || (CONSP (obj) && INTEGERP (XCAR (obj))
1949 && (INTEGERP (XCDR (obj))
1950 || (CONSP (XCDR (obj))
1951 && INTEGERP (XCAR (XCDR (obj)))))))
ede4db72
RS
1952 {
1953 *format_ret = 32;
1954 *size_ret = 1;
1955 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1956 (*data_ret) [sizeof (long)] = 0;
1957 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1958 if (NILP (type)) type = QINTEGER;
1959 }
1960 else if (VECTORP (obj))
1961 {
1962 /* Lisp_Vectors may represent a set of ATOMs;
1963 a set of 16 or 32 bit INTEGERs;
1964 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1965 */
1966 int i;
1967
1968 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1969 /* This vector is an ATOM set */
1970 {
1971 if (NILP (type)) type = QATOM;
1972 *size_ret = XVECTOR (obj)->size;
1973 *format_ret = 32;
1974 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1975 for (i = 0; i < *size_ret; i++)
1976 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1977 (*(Atom **) data_ret) [i]
5c3a351a 1978 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
ede4db72
RS
1979 else
1980 Fsignal (Qerror, /* Qselection_error */
1981 Fcons (build_string
1982 ("all elements of selection vector must have same type"),
1983 Fcons (obj, Qnil)));
1984 }
1985#if 0 /* #### MULTIPLE doesn't work yet */
1986 else if (VECTORP (XVECTOR (obj)->contents [0]))
1987 /* This vector is an ATOM_PAIR set */
1988 {
1989 if (NILP (type)) type = QATOM_PAIR;
1990 *size_ret = XVECTOR (obj)->size;
1991 *format_ret = 32;
1992 *data_ret = (unsigned char *)
1993 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1994 for (i = 0; i < *size_ret; i++)
1995 if (VECTORP (XVECTOR (obj)->contents [i]))
1996 {
1997 Lisp_Object pair = XVECTOR (obj)->contents [i];
1998 if (XVECTOR (pair)->size != 2)
1999 Fsignal (Qerror,
1b65481e 2000 Fcons (build_string
ede4db72
RS
2001 ("elements of the vector must be vectors of exactly two elements"),
2002 Fcons (pair, Qnil)));
1b65481e 2003
ede4db72 2004 (*(Atom **) data_ret) [i * 2]
5c3a351a
RS
2005 = symbol_to_x_atom (dpyinfo, display,
2006 XVECTOR (pair)->contents [0]);
ede4db72 2007 (*(Atom **) data_ret) [(i * 2) + 1]
5c3a351a
RS
2008 = symbol_to_x_atom (dpyinfo, display,
2009 XVECTOR (pair)->contents [1]);
ede4db72
RS
2010 }
2011 else
2012 Fsignal (Qerror,
2013 Fcons (build_string
2014 ("all elements of the vector must be of the same type"),
2015 Fcons (obj, Qnil)));
1b65481e 2016
ede4db72
RS
2017 }
2018#endif
2019 else
2020 /* This vector is an INTEGER set, or something like it */
2021 {
e22cf39c 2022 int data_size = 2;
ede4db72
RS
2023 *size_ret = XVECTOR (obj)->size;
2024 if (NILP (type)) type = QINTEGER;
2025 *format_ret = 16;
2026 for (i = 0; i < *size_ret; i++)
2027 if (CONSP (XVECTOR (obj)->contents [i]))
2028 *format_ret = 32;
7da64e5c 2029 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
ede4db72
RS
2030 Fsignal (Qerror, /* Qselection_error */
2031 Fcons (build_string
2032 ("elements of selection vector must be integers or conses of integers"),
2033 Fcons (obj, Qnil)));
2034
e22cf39c
JD
2035 /* Use sizeof(long) even if it is more than 32 bits. See comment
2036 in x_get_window_property and x_fill_property_data. */
6e816df5 2037
e22cf39c
JD
2038 if (*format_ret == 32) data_size = sizeof(long);
2039 *data_ret = (unsigned char *) xmalloc (*size_ret * data_size);
ede4db72
RS
2040 for (i = 0; i < *size_ret; i++)
2041 if (*format_ret == 32)
2042 (*((unsigned long **) data_ret)) [i]
2043 = cons_to_long (XVECTOR (obj)->contents [i]);
2044 else
2045 (*((unsigned short **) data_ret)) [i]
2046 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
2047 }
2048 }
2049 else
2050 Fsignal (Qerror, /* Qselection_error */
6e816df5 2051 Fcons (build_string ("unrecognized selection data"),
ede4db72
RS
2052 Fcons (obj, Qnil)));
2053
5c3a351a 2054 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
ede4db72
RS
2055}
2056
2057static Lisp_Object
2058clean_local_selection_data (obj)
2059 Lisp_Object obj;
2060{
2061 if (CONSP (obj)
8e713be6
KR
2062 && INTEGERP (XCAR (obj))
2063 && CONSP (XCDR (obj))
2064 && INTEGERP (XCAR (XCDR (obj)))
2065 && NILP (XCDR (XCDR (obj))))
2066 obj = Fcons (XCAR (obj), XCDR (obj));
ede4db72
RS
2067
2068 if (CONSP (obj)
8e713be6
KR
2069 && INTEGERP (XCAR (obj))
2070 && INTEGERP (XCDR (obj)))
ede4db72 2071 {
8e713be6
KR
2072 if (XINT (XCAR (obj)) == 0)
2073 return XCDR (obj);
2074 if (XINT (XCAR (obj)) == -1)
2075 return make_number (- XINT (XCDR (obj)));
ede4db72
RS
2076 }
2077 if (VECTORP (obj))
2078 {
2079 int i;
2080 int size = XVECTOR (obj)->size;
2081 Lisp_Object copy;
2082 if (size == 1)
2083 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
e607a484 2084 copy = Fmake_vector (make_number (size), Qnil);
ede4db72
RS
2085 for (i = 0; i < size; i++)
2086 XVECTOR (copy)->contents [i]
2087 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
2088 return copy;
2089 }
2090 return obj;
2091}
2092\f
2093/* Called from XTread_socket to handle SelectionNotify events.
606140dd
KH
2094 If it's the selection we are waiting for, stop waiting
2095 by setting the car of reading_selection_reply to non-nil.
2096 We store t there if the reply is successful, lambda if not. */
ede4db72
RS
2097
2098void
2099x_handle_selection_notify (event)
2100 XSelectionEvent *event;
2101{
5d0ba25b 2102 if (event->requestor != reading_selection_window)
ede4db72
RS
2103 return;
2104 if (event->selection != reading_which_selection)
2105 return;
2106
d9c0d4a3 2107 TRACE0 ("Received SelectionNotify");
f3fbd155
KR
2108 XSETCAR (reading_selection_reply,
2109 (event->property != 0 ? Qt : Qlambda));
ede4db72
RS
2110}
2111
2112\f
a0d76c27 2113DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
8c1a1077
PJ
2114 Sx_own_selection_internal, 2, 2, 0,
2115 doc: /* Assert an X selection of the given TYPE with the given VALUE.
2116TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2117\(Those are literal upper-case symbol names, since that's what X expects.)
2118VALUE is typically a string, or a cons of two markers, but may be
2119anything that the functions on `selection-converter-alist' know about. */)
2120 (selection_name, selection_value)
ede4db72
RS
2121 Lisp_Object selection_name, selection_value;
2122{
703e0710 2123 check_x ();
b7826503 2124 CHECK_SYMBOL (selection_name);
253b2298 2125 if (NILP (selection_value)) error ("SELECTION-VALUE may not be nil");
ede4db72
RS
2126 x_own_selection (selection_name, selection_value);
2127 return selection_value;
2128}
2129
2130
2131/* Request the selection value from the owner. If we are the owner,
2132 simply return our selection value. If we are not the owner, this
2133 will block until all of the data has arrived. */
2134
a0d76c27 2135DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
3a42401d 2136 Sx_get_selection_internal, 2, 3, 0,
8c1a1077
PJ
2137 doc: /* Return text selected from some X window.
2138SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2139\(Those are literal upper-case symbol names, since that's what X expects.)
3a42401d
JD
2140TYPE is the type of data desired, typically `STRING'.
2141TIME_STAMP is the time to use in the XConvertSelection call for foreign
2142selections. If omitted, defaults to the time for the last event. */)
2143 (selection_symbol, target_type, time_stamp)
2144 Lisp_Object selection_symbol, target_type, time_stamp;
ede4db72
RS
2145{
2146 Lisp_Object val = Qnil;
2147 struct gcpro gcpro1, gcpro2;
2148 GCPRO2 (target_type, val); /* we store newly consed data into these */
703e0710 2149 check_x ();
b7826503 2150 CHECK_SYMBOL (selection_symbol);
ede4db72
RS
2151
2152#if 0 /* #### MULTIPLE doesn't work yet */
2153 if (CONSP (target_type)
8e713be6 2154 && XCAR (target_type) == QMULTIPLE)
ede4db72 2155 {
b7826503 2156 CHECK_VECTOR (XCDR (target_type));
ede4db72
RS
2157 /* So we don't destructively modify this... */
2158 target_type = copy_multiple_data (target_type);
2159 }
2160 else
2161#endif
b7826503 2162 CHECK_SYMBOL (target_type);
ede4db72 2163
5109c8dd 2164 val = x_get_local_selection (selection_symbol, target_type, 1);
ede4db72
RS
2165
2166 if (NILP (val))
2167 {
3a42401d 2168 val = x_get_foreign_selection (selection_symbol, target_type, time_stamp);
ede4db72
RS
2169 goto DONE;
2170 }
2171
2172 if (CONSP (val)
8e713be6 2173 && SYMBOLP (XCAR (val)))
ede4db72 2174 {
8e713be6
KR
2175 val = XCDR (val);
2176 if (CONSP (val) && NILP (XCDR (val)))
2177 val = XCAR (val);
ede4db72
RS
2178 }
2179 val = clean_local_selection_data (val);
2180 DONE:
2181 UNGCPRO;
2182 return val;
2183}
2184
a0d76c27 2185DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
8c1a1077
PJ
2186 Sx_disown_selection_internal, 1, 2, 0,
2187 doc: /* If we own the selection SELECTION, disown it.
2188Disowning it means there is no such selection. */)
2189 (selection, time)
ede4db72
RS
2190 Lisp_Object selection;
2191 Lisp_Object time;
2192{
ede4db72
RS
2193 Time timestamp;
2194 Atom selection_atom;
31df61d6
AS
2195 union {
2196 struct selection_input_event sie;
2197 struct input_event ie;
2198 } event;
3834c318 2199 Display *display;
5c3a351a 2200 struct x_display_info *dpyinfo;
378c33ca 2201 struct frame *sf = SELECTED_FRAME ();
ede4db72 2202
703e0710 2203 check_x ();
378c33ca
GM
2204 display = FRAME_X_DISPLAY (sf);
2205 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
b7826503 2206 CHECK_SYMBOL (selection);
ede4db72 2207 if (NILP (time))
7da64e5c 2208 timestamp = last_event_timestamp;
ede4db72
RS
2209 else
2210 timestamp = cons_to_long (time);
2211
2212 if (NILP (assq_no_quit (selection, Vselection_alist)))
2213 return Qnil; /* Don't disown the selection when we're not the owner. */
2214
5c3a351a 2215 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
ede4db72
RS
2216
2217 BLOCK_INPUT;
2218 XSetSelectionOwner (display, selection_atom, None, timestamp);
2219 UNBLOCK_INPUT;
2220
eb8c3be9 2221 /* It doesn't seem to be guaranteed that a SelectionClear event will be
ede4db72
RS
2222 generated for a window which owns the selection when that window sets
2223 the selection owner to None. The NCD server does, the MIT Sun4 server
2224 doesn't. So we synthesize one; this means we might get two, but
2225 that's ok, because the second one won't have any effect. */
31df61d6
AS
2226 SELECTION_EVENT_DISPLAY (&event.sie) = display;
2227 SELECTION_EVENT_SELECTION (&event.sie) = selection_atom;
2228 SELECTION_EVENT_TIME (&event.sie) = timestamp;
2229 x_handle_selection_clear (&event.ie);
ede4db72
RS
2230
2231 return Qt;
2232}
2233
a87ed99c
RS
2234/* Get rid of all the selections in buffer BUFFER.
2235 This is used when we kill a buffer. */
2236
2237void
2238x_disown_buffer_selections (buffer)
2239 Lisp_Object buffer;
2240{
2241 Lisp_Object tail;
2242 struct buffer *buf = XBUFFER (buffer);
2243
8e713be6 2244 for (tail = Vselection_alist; CONSP (tail); tail = XCDR (tail))
a87ed99c
RS
2245 {
2246 Lisp_Object elt, value;
8e713be6
KR
2247 elt = XCAR (tail);
2248 value = XCDR (elt);
2249 if (CONSP (value) && MARKERP (XCAR (value))
2250 && XMARKER (XCAR (value))->buffer == buf)
2251 Fx_disown_selection_internal (XCAR (elt), Qnil);
a87ed99c
RS
2252 }
2253}
ede4db72
RS
2254
2255DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
8c1a1077
PJ
2256 0, 1, 0,
2257 doc: /* Whether the current Emacs process owns the given X Selection.
2258The arg should be the name of the selection in question, typically one of
2259the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2260\(Those are literal upper-case symbol names, since that's what X expects.)
2261For convenience, the symbol nil is the same as `PRIMARY',
2262and t is the same as `SECONDARY'. */)
2263 (selection)
ede4db72
RS
2264 Lisp_Object selection;
2265{
703e0710 2266 check_x ();
b7826503 2267 CHECK_SYMBOL (selection);
ede4db72
RS
2268 if (EQ (selection, Qnil)) selection = QPRIMARY;
2269 if (EQ (selection, Qt)) selection = QSECONDARY;
1b65481e 2270
ede4db72
RS
2271 if (NILP (Fassq (selection, Vselection_alist)))
2272 return Qnil;
2273 return Qt;
2274}
2275
2276DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
8c1a1077
PJ
2277 0, 1, 0,
2278 doc: /* Whether there is an owner for the given X Selection.
2279The arg should be the name of the selection in question, typically one of
2280the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2281\(Those are literal upper-case symbol names, since that's what X expects.)
2282For convenience, the symbol nil is the same as `PRIMARY',
2283and t is the same as `SECONDARY'. */)
2284 (selection)
ede4db72
RS
2285 Lisp_Object selection;
2286{
2287 Window owner;
356ba514 2288 Atom atom;
3834c318 2289 Display *dpy;
378c33ca 2290 struct frame *sf = SELECTED_FRAME ();
3834c318 2291
b8c70430 2292 /* It should be safe to call this before we have an X frame. */
378c33ca 2293 if (! FRAME_X_P (sf))
b8c70430
RS
2294 return Qnil;
2295
378c33ca 2296 dpy = FRAME_X_DISPLAY (sf);
b7826503 2297 CHECK_SYMBOL (selection);
ede4db72
RS
2298 if (!NILP (Fx_selection_owner_p (selection)))
2299 return Qt;
356ba514
RS
2300 if (EQ (selection, Qnil)) selection = QPRIMARY;
2301 if (EQ (selection, Qt)) selection = QSECONDARY;
378c33ca 2302 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), dpy, selection);
356ba514
RS
2303 if (atom == 0)
2304 return Qnil;
ede4db72 2305 BLOCK_INPUT;
356ba514 2306 owner = XGetSelectionOwner (dpy, atom);
ede4db72
RS
2307 UNBLOCK_INPUT;
2308 return (owner ? Qt : Qnil);
2309}
2310
2311\f
2312#ifdef CUT_BUFFER_SUPPORT
2313
ede4db72
RS
2314/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2315static void
2316initialize_cut_buffers (display, window)
2317 Display *display;
2318 Window window;
2319{
2320 unsigned char *data = (unsigned char *) "";
2321 BLOCK_INPUT;
2322#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2323 PropModeAppend, data, 0)
2324 FROB (XA_CUT_BUFFER0);
2325 FROB (XA_CUT_BUFFER1);
2326 FROB (XA_CUT_BUFFER2);
2327 FROB (XA_CUT_BUFFER3);
2328 FROB (XA_CUT_BUFFER4);
2329 FROB (XA_CUT_BUFFER5);
2330 FROB (XA_CUT_BUFFER6);
2331 FROB (XA_CUT_BUFFER7);
2332#undef FROB
2333 UNBLOCK_INPUT;
ede4db72
RS
2334}
2335
2336
b7826503
PJ
2337#define CHECK_CUT_BUFFER(symbol) \
2338 { CHECK_SYMBOL ((symbol)); \
ede4db72
RS
2339 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2340 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2341 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2342 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2343 Fsignal (Qerror, \
a87ed99c 2344 Fcons (build_string ("doesn't name a cut buffer"), \
ede4db72
RS
2345 Fcons ((symbol), Qnil))); \
2346 }
2347
a87ed99c 2348DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
8c1a1077
PJ
2349 Sx_get_cut_buffer_internal, 1, 1, 0,
2350 doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2351 (buffer)
ede4db72
RS
2352 Lisp_Object buffer;
2353{
3834c318 2354 Window window;
ede4db72
RS
2355 Atom buffer_atom;
2356 unsigned char *data;
2357 int bytes;
2358 Atom type;
2359 int format;
2360 unsigned long size;
2361 Lisp_Object ret;
3834c318 2362 Display *display;
5c3a351a 2363 struct x_display_info *dpyinfo;
378c33ca 2364 struct frame *sf = SELECTED_FRAME ();
ede4db72 2365
703e0710 2366 check_x ();
378c33ca
GM
2367 display = FRAME_X_DISPLAY (sf);
2368 dpyinfo = FRAME_X_DISPLAY_INFO (sf);
3834c318 2369 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
b7826503 2370 CHECK_CUT_BUFFER (buffer);
5c3a351a 2371 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
ede4db72
RS
2372
2373 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2374 &type, &format, &size, 0);
22e00739
RS
2375 if (!data || !format)
2376 return Qnil;
1b65481e 2377
ede4db72
RS
2378 if (format != 8 || type != XA_STRING)
2379 Fsignal (Qerror,
2380 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
d9c0d4a3 2381 Fcons (x_atom_to_symbol (display, type),
ede4db72
RS
2382 Fcons (make_number (format), Qnil))));
2383
3f6b532c 2384 ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil);
4feb31b2 2385 /* Use xfree, not XFree, because x_get_window_property
0158abbc 2386 calls xmalloc itself. */
4feb31b2 2387 xfree (data);
ede4db72
RS
2388 return ret;
2389}
2390
2391
a87ed99c 2392DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
8c1a1077
PJ
2393 Sx_store_cut_buffer_internal, 2, 2, 0,
2394 doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2395 (buffer, string)
ede4db72
RS
2396 Lisp_Object buffer, string;
2397{
3834c318 2398 Window window;
ede4db72
RS
2399 Atom buffer_atom;
2400 unsigned char *data;
2401 int bytes;
2402 int bytes_remaining;
3834c318
RS
2403 int max_bytes;
2404 Display *display;
378c33ca 2405 struct frame *sf = SELECTED_FRAME ();
ede4db72 2406
703e0710 2407 check_x ();
378c33ca 2408 display = FRAME_X_DISPLAY (sf);
3834c318
RS
2409 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2410
2411 max_bytes = SELECTION_QUANTUM (display);
2412 if (max_bytes > MAX_SELECTION_QUANTUM)
2413 max_bytes = MAX_SELECTION_QUANTUM;
2414
b7826503
PJ
2415 CHECK_CUT_BUFFER (buffer);
2416 CHECK_STRING (string);
378c33ca 2417 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf),
5c3a351a 2418 display, buffer);
d5db4077
KR
2419 data = (unsigned char *) SDATA (string);
2420 bytes = SBYTES (string);
ede4db72
RS
2421 bytes_remaining = bytes;
2422
378c33ca 2423 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
04649dbc
KH
2424 {
2425 initialize_cut_buffers (display, window);
378c33ca 2426 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
04649dbc 2427 }
ede4db72
RS
2428
2429 BLOCK_INPUT;
10608c8c
RS
2430
2431 /* Don't mess up with an empty value. */
2432 if (!bytes_remaining)
2433 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2434 PropModeReplace, data, 0);
2435
ede4db72
RS
2436 while (bytes_remaining)
2437 {
2438 int chunk = (bytes_remaining < max_bytes
2439 ? bytes_remaining : max_bytes);
2440 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2441 (bytes_remaining == bytes
2442 ? PropModeReplace
2443 : PropModeAppend),
2444 data, chunk);
2445 data += chunk;
2446 bytes_remaining -= chunk;
2447 }
2448 UNBLOCK_INPUT;
2449 return string;
2450}
2451
2452
a87ed99c 2453DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
8c1a1077
PJ
2454 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2455 doc: /* Rotate the values of the cut buffers by the given number of step.
2456Positive means shift the values forward, negative means backward. */)
2457 (n)
ede4db72
RS
2458 Lisp_Object n;
2459{
3834c318
RS
2460 Window window;
2461 Atom props[8];
2462 Display *display;
378c33ca 2463 struct frame *sf = SELECTED_FRAME ();
ede4db72 2464
703e0710 2465 check_x ();
378c33ca 2466 display = FRAME_X_DISPLAY (sf);
3834c318 2467 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
b7826503 2468 CHECK_NUMBER (n);
3834c318
RS
2469 if (XINT (n) == 0)
2470 return n;
378c33ca 2471 if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized)
04649dbc
KH
2472 {
2473 initialize_cut_buffers (display, window);
378c33ca 2474 FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1;
04649dbc 2475 }
3834c318 2476
ede4db72
RS
2477 props[0] = XA_CUT_BUFFER0;
2478 props[1] = XA_CUT_BUFFER1;
2479 props[2] = XA_CUT_BUFFER2;
2480 props[3] = XA_CUT_BUFFER3;
2481 props[4] = XA_CUT_BUFFER4;
2482 props[5] = XA_CUT_BUFFER5;
2483 props[6] = XA_CUT_BUFFER6;
2484 props[7] = XA_CUT_BUFFER7;
2485 BLOCK_INPUT;
2486 XRotateWindowProperties (display, window, props, 8, XINT (n));
2487 UNBLOCK_INPUT;
2488 return n;
2489}
2490
2491#endif
2492\f
1fb3821b
JD
2493/***********************************************************************
2494 Drag and drop support
2495***********************************************************************/
2496/* Check that lisp values are of correct type for x_fill_property_data.
2497 That is, number, string or a cons with two numbers (low and high 16
2498 bit parts of a 32 bit number). */
2499
2500int
2501x_check_property_data (data)
2502 Lisp_Object data;
2503{
2504 Lisp_Object iter;
2505 int size = 0;
2506
2507 for (iter = data; CONSP (iter) && size != -1; iter = XCDR (iter), ++size)
2508 {
2509 Lisp_Object o = XCAR (iter);
2510
2511 if (! NUMBERP (o) && ! STRINGP (o) && ! CONSP (o))
2512 size = -1;
2513 else if (CONSP (o) &&
2514 (! NUMBERP (XCAR (o)) || ! NUMBERP (XCDR (o))))
2515 size = -1;
2516 }
2517
2518 return size;
2519}
2520
2521/* Convert lisp values to a C array. Values may be a number, a string
2522 which is taken as an X atom name and converted to the atom value, or
2523 a cons containing the two 16 bit parts of a 32 bit number.
2524
2525 DPY is the display use to look up X atoms.
2526 DATA is a Lisp list of values to be converted.
2527 RET is the C array that contains the converted values. It is assumed
ff59904a 2528 it is big enough to hold all values.
e22cf39c
JD
2529 FORMAT is 8, 16 or 32 and denotes char/short/long for each C value to
2530 be stored in RET. Note that long is used for 32 even if long is more
2531 than 32 bits (see man pages for XChangeProperty, XGetWindowProperty and
2532 XClientMessageEvent). */
1fb3821b
JD
2533
2534void
2535x_fill_property_data (dpy, data, ret, format)
2536 Display *dpy;
2537 Lisp_Object data;
2538 void *ret;
2539 int format;
2540{
e22cf39c
JD
2541 long val;
2542 long *d32 = (long *) ret;
2543 short *d16 = (short *) ret;
2544 char *d08 = (char *) ret;
1fb3821b
JD
2545 Lisp_Object iter;
2546
2547 for (iter = data; CONSP (iter); iter = XCDR (iter))
2548 {
2549 Lisp_Object o = XCAR (iter);
2550
2551 if (INTEGERP (o))
e22cf39c 2552 val = (long) XFASTINT (o);
1fb3821b 2553 else if (FLOATP (o))
e22cf39c 2554 val = (long) XFLOAT_DATA (o);
1fb3821b 2555 else if (CONSP (o))
e22cf39c 2556 val = (long) cons_to_long (o);
1fb3821b
JD
2557 else if (STRINGP (o))
2558 {
2559 BLOCK_INPUT;
e22cf39c 2560 val = (long) XInternAtom (dpy, (char *) SDATA (o), False);
1fb3821b
JD
2561 UNBLOCK_INPUT;
2562 }
2563 else
2564 error ("Wrong type, must be string, number or cons");
2565
2566 if (format == 8)
e22cf39c 2567 *d08++ = (char) val;
1fb3821b 2568 else if (format == 16)
e22cf39c 2569 *d16++ = (short) val;
1fb3821b
JD
2570 else
2571 *d32++ = val;
2572 }
2573}
2574
2575/* Convert an array of C values to a Lisp list.
2576 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2577 DATA is a C array of values to be converted.
2578 TYPE is the type of the data. Only XA_ATOM is special, it converts
2579 each number in DATA to its corresponfing X atom as a symbol.
2580 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2581 be stored in RET.
2582 SIZE is the number of elements in DATA.
2583
b8d6f4af
JD
2584 Important: When format is 32, data should contain an array of int,
2585 not an array of long as the X library returns. This makes a difference
2586 when sizeof(long) != sizeof(int).
2587
1fb3821b
JD
2588 Also see comment for selection_data_to_lisp_data above. */
2589
2590Lisp_Object
2591x_property_data_to_lisp (f, data, type, format, size)
2592 struct frame *f;
2593 unsigned char *data;
2594 Atom type;
2595 int format;
2596 unsigned long size;
2597{
2598 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f),
2599 data, size*format/8, type, format);
2600}
2601
31f16913 2602/* Get the mouse position in frame relative coordinates. */
1fb3821b
JD
2603
2604static void
2605mouse_position_for_drop (f, x, y)
2606 FRAME_PTR f;
2607 int *x;
2608 int *y;
2609{
2610 Window root, dummy_window;
2611 int dummy;
2612
2613 BLOCK_INPUT;
2614
2615 XQueryPointer (FRAME_X_DISPLAY (f),
2616 DefaultRootWindow (FRAME_X_DISPLAY (f)),
2617
2618 /* The root window which contains the pointer. */
2619 &root,
2620
2621 /* Window pointer is on, not used */
2622 &dummy_window,
2623
2624 /* The position on that root window. */
2625 x, y,
2626
2627 /* x/y in dummy_window coordinates, not used. */
2628 &dummy, &dummy,
2629
2630 /* Modifier keys and pointer buttons, about which
2631 we don't care. */
2632 (unsigned int *) &dummy);
2633
2634
2635 /* Absolute to relative. */
2636 *x -= f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
2637 *y -= f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
2638
2639 UNBLOCK_INPUT;
2640}
2641
2642DEFUN ("x-get-atom-name", Fx_get_atom_name,
2643 Sx_get_atom_name, 1, 2, 0,
2644 doc: /* Return the X atom name for VALUE as a string.
2645VALUE may be a number or a cons where the car is the upper 16 bits and
2646the cdr is the lower 16 bits of a 32 bit value.
2647Use the display for FRAME or the current frame if FRAME is not given or nil.
2648
2649If the value is 0 or the atom is not known, return the empty string. */)
2650 (value, frame)
2651 Lisp_Object value, frame;
2652{
2653 struct frame *f = check_x_frame (frame);
2654 char *name = 0;
2655 Lisp_Object ret = Qnil;
1fb3821b
JD
2656 Display *dpy = FRAME_X_DISPLAY (f);
2657 Atom atom;
2658
2659 if (INTEGERP (value))
2660 atom = (Atom) XUINT (value);
2661 else if (FLOATP (value))
ff59904a 2662 atom = (Atom) XFLOAT_DATA (value);
1fb3821b
JD
2663 else if (CONSP (value))
2664 atom = (Atom) cons_to_long (value);
2665 else
2666 error ("Wrong type, value must be number or cons");
2667
2668 BLOCK_INPUT;
9ba8e10d 2669 x_catch_errors (dpy);
1fb3821b
JD
2670
2671 name = atom ? XGetAtomName (dpy, atom) : "";
2672
2673 if (! x_had_errors_p (dpy))
2674 ret = make_string (name, strlen (name));
2675
4545fa20 2676 x_uncatch_errors ();
1fb3821b
JD
2677
2678 if (atom && name) XFree (name);
2679 if (NILP (ret)) ret = make_string ("", 0);
2680
2681 UNBLOCK_INPUT;
2682
2683 return ret;
2684}
2685
2686/* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2687 TODO: Check if this client event really is a DND event? */
2688
2689int
2690x_handle_dnd_message (f, event, dpyinfo, bufp)
2691 struct frame *f;
2692 XClientMessageEvent *event;
2693 struct x_display_info *dpyinfo;
2694 struct input_event *bufp;
2695{
2696 Lisp_Object vec;
2697 Lisp_Object frame;
e22cf39c
JD
2698 /* format 32 => size 5, format 16 => size 10, format 8 => size 20 */
2699 unsigned long size = 160/event->format;
1fb3821b 2700 int x, y;
31f16913
JD
2701 unsigned char *data = (unsigned char *) event->data.b;
2702 int idata[5];
1fb3821b
JD
2703
2704 XSETFRAME (frame, f);
2705
31f16913
JD
2706 /* On a 64 bit machine, the event->data.l array members are 64 bits (long),
2707 but the x_property_data_to_lisp (or rather selection_data_to_lisp_data)
2708 function expects them to be of size int (i.e. 32). So to be able to
2709 use that function, put the data in the form it expects if format is 32. */
2710
2711 if (event->format == 32 && event->format < BITS_PER_LONG)
2712 {
2713 int i;
2714 for (i = 0; i < 5; ++i) /* There are only 5 longs in a ClientMessage. */
2715 idata[i] = (int) event->data.l[i];
2716 data = (unsigned char *) idata;
2717 }
2718
d2f14999 2719 vec = Fmake_vector (make_number (4), Qnil);
1fb3821b
JD
2720 AREF (vec, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f),
2721 event->message_type));
2722 AREF (vec, 1) = frame;
d2f14999 2723 AREF (vec, 2) = make_number (event->format);
1fb3821b 2724 AREF (vec, 3) = x_property_data_to_lisp (f,
31f16913 2725 data,
1fb3821b
JD
2726 event->message_type,
2727 event->format,
2728 size);
2729
2730 mouse_position_for_drop (f, &x, &y);
2731 bufp->kind = DRAG_N_DROP_EVENT;
862c94ca 2732 bufp->frame_or_window = frame;
1fb3821b
JD
2733 bufp->timestamp = CurrentTime;
2734 bufp->x = make_number (x);
2735 bufp->y = make_number (y);
862c94ca 2736 bufp->arg = vec;
1fb3821b
JD
2737 bufp->modifiers = 0;
2738
2739 return 1;
2740}
2741
2742DEFUN ("x-send-client-message", Fx_send_client_event,
2743 Sx_send_client_message, 6, 6, 0,
2744 doc: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2745
2746For DISPLAY, specify either a frame or a display name (a string).
2747If DISPLAY is nil, that stands for the selected frame's display.
2748DEST may be a number, in which case it is a Window id. The value 0 may
2749be used to send to the root window of the DISPLAY.
2750If DEST is a cons, it is converted to a 32 bit number
2751with the high 16 bits from the car and the lower 16 bit from the cdr. That
2752number is then used as a window id.
2753If DEST is a frame the event is sent to the outer window of that frame.
2754Nil means the currently selected frame.
2755If DEST is the string "PointerWindow" the event is sent to the window that
2756contains the pointer. If DEST is the string "InputFocus" the event is
2757sent to the window that has the input focus.
2758FROM is the frame sending the event. Use nil for currently selected frame.
2759MESSAGE-TYPE is the name of an Atom as a string.
2760FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2761bits. VALUES is a list of numbers, cons and/or strings containing the values
2762to send. If a value is a string, it is converted to an Atom and the value of
2763the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2764with the high 16 bits from the car and the lower 16 bit from the cdr.
2765If more values than fits into the event is given, the excessive values
2766are ignored. */)
2767 (display, dest, from, message_type, format, values)
2768 Lisp_Object display, dest, from, message_type, format, values;
2769{
2770 struct x_display_info *dpyinfo = check_x_display_info (display);
2771 Window wdest;
2772 XEvent event;
2773 Lisp_Object cons;
2774 int size;
2775 struct frame *f = check_x_frame (from);
1fb3821b
JD
2776 int to_root;
2777
2778 CHECK_STRING (message_type);
2779 CHECK_NUMBER (format);
2780 CHECK_CONS (values);
2781
2782 if (x_check_property_data (values) == -1)
2783 error ("Bad data in VALUES, must be number, cons or string");
2784
2785 event.xclient.type = ClientMessage;
2786 event.xclient.format = XFASTINT (format);
2787
2788 if (event.xclient.format != 8 && event.xclient.format != 16
2789 && event.xclient.format != 32)
2790 error ("FORMAT must be one of 8, 16 or 32");
a0ecb2ac 2791
1fb3821b
JD
2792 if (FRAMEP (dest) || NILP (dest))
2793 {
2794 struct frame *fdest = check_x_frame (dest);
2795 wdest = FRAME_OUTER_WINDOW (fdest);
2796 }
2797 else if (STRINGP (dest))
2798 {
2799 if (strcmp (SDATA (dest), "PointerWindow") == 0)
2800 wdest = PointerWindow;
2801 else if (strcmp (SDATA (dest), "InputFocus") == 0)
2802 wdest = InputFocus;
2803 else
2804 error ("DEST as a string must be one of PointerWindow or InputFocus");
2805 }
2806 else if (INTEGERP (dest))
2807 wdest = (Window) XFASTINT (dest);
2808 else if (FLOATP (dest))
ff59904a 2809 wdest = (Window) XFLOAT_DATA (dest);
1fb3821b
JD
2810 else if (CONSP (dest))
2811 {
2812 if (! NUMBERP (XCAR (dest)) || ! NUMBERP (XCDR (dest)))
2813 error ("Both car and cdr for DEST must be numbers");
2814 else
2815 wdest = (Window) cons_to_long (dest);
2816 }
2817 else
2818 error ("DEST must be a frame, nil, string, number or cons");
2819
2820 if (wdest == 0) wdest = dpyinfo->root_window;
2821 to_root = wdest == dpyinfo->root_window;
2822
2823 for (cons = values, size = 0; CONSP (cons); cons = XCDR (cons), ++size)
2824 ;
2825
2826 BLOCK_INPUT;
2827
2828 event.xclient.message_type
2829 = XInternAtom (dpyinfo->display, SDATA (message_type), False);
2830 event.xclient.display = dpyinfo->display;
2831
2832 /* Some clients (metacity for example) expects sending window to be here
2833 when sending to the root window. */
2834 event.xclient.window = to_root ? FRAME_OUTER_WINDOW (f) : wdest;
2835
6e816df5 2836
e22cf39c
JD
2837 memset (event.xclient.data.b, 0, sizeof (event.xclient.data.b));
2838 x_fill_property_data (dpyinfo->display, values, event.xclient.data.b,
2839 event.xclient.format);
31f16913 2840
1fb3821b
JD
2841 /* If event mask is 0 the event is sent to the client that created
2842 the destination window. But if we are sending to the root window,
2843 there is no such client. Then we set the event mask to 0xffff. The
2844 event then goes to clients selecting for events on the root window. */
9ba8e10d 2845 x_catch_errors (dpyinfo->display);
1fb3821b
JD
2846 {
2847 int propagate = to_root ? False : True;
2848 unsigned mask = to_root ? 0xffff : 0;
2849 XSendEvent (dpyinfo->display, wdest, propagate, mask, &event);
2850 XFlush (dpyinfo->display);
2851 }
4545fa20 2852 x_uncatch_errors ();
1fb3821b
JD
2853 UNBLOCK_INPUT;
2854
2855 return Qnil;
2856}
2857
2858\f
ede4db72
RS
2859void
2860syms_of_xselect ()
2861{
ede4db72
RS
2862 defsubr (&Sx_get_selection_internal);
2863 defsubr (&Sx_own_selection_internal);
2864 defsubr (&Sx_disown_selection_internal);
2865 defsubr (&Sx_selection_owner_p);
2866 defsubr (&Sx_selection_exists_p);
2867
2868#ifdef CUT_BUFFER_SUPPORT
a87ed99c
RS
2869 defsubr (&Sx_get_cut_buffer_internal);
2870 defsubr (&Sx_store_cut_buffer_internal);
2871 defsubr (&Sx_rotate_cut_buffers_internal);
ede4db72
RS
2872#endif
2873
1fb3821b
JD
2874 defsubr (&Sx_get_atom_name);
2875 defsubr (&Sx_send_client_message);
2876
ede4db72
RS
2877 reading_selection_reply = Fcons (Qnil, Qnil);
2878 staticpro (&reading_selection_reply);
2879 reading_selection_window = 0;
2880 reading_which_selection = 0;
2881
2882 property_change_wait_list = 0;
2f65feb6 2883 prop_location_identifier = 0;
ede4db72
RS
2884 property_change_reply = Fcons (Qnil, Qnil);
2885 staticpro (&property_change_reply);
2886
2887 Vselection_alist = Qnil;
2888 staticpro (&Vselection_alist);
2889
2890 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
8c1a1077
PJ
2891 doc: /* An alist associating X Windows selection-types with functions.
2892These functions are called to convert the selection, with three args:
2893the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2894a desired type to which the selection should be converted;
2895and the local selection value (whatever was given to `x-own-selection').
2896
2897The function should return the value to send to the X server
2898\(typically a string). A return value of nil
2899means that the conversion could not be done.
2900A return value which is the symbol `NULL'
2901means that a side-effect was executed,
2902and there is no meaningful selection value. */);
ede4db72
RS
2903 Vselection_converter_alist = Qnil;
2904
c917a8de 2905 DEFVAR_LISP ("x-lost-selection-functions", &Vx_lost_selection_functions,
8c1a1077
PJ
2906 doc: /* A list of functions to be called when Emacs loses an X selection.
2907\(This happens when some other X client makes its own selection
2908or when a Lisp program explicitly clears the selection.)
2909The functions are called with one argument, the selection type
2910\(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
c917a8de 2911 Vx_lost_selection_functions = Qnil;
ede4db72 2912
c917a8de 2913 DEFVAR_LISP ("x-sent-selection-functions", &Vx_sent_selection_functions,
8c1a1077
PJ
2914 doc: /* A list of functions to be called when Emacs answers a selection request.
2915The functions are called with four arguments:
2916 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2917 - the selection-type which Emacs was asked to convert the
2918 selection into before sending (for example, `STRING' or `LENGTH');
2919 - a flag indicating success or failure for responding to the request.
2920We might have failed (and declined the request) for any number of reasons,
2921including being asked for a selection that we no longer own, or being asked
2922to convert into a type that we don't know about or that is inappropriate.
2923This hook doesn't let you change the behavior of Emacs's selection replies,
2924it merely informs you that they have happened. */);
c917a8de 2925 Vx_sent_selection_functions = Qnil;
ede4db72 2926
93e4ce1b 2927 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system,
8c1a1077
PJ
2928 doc: /* Coding system for communicating with other X clients.
2929When sending or receiving text via cut_buffer, selection, and clipboard,
2930the text is encoded or decoded by this coding system.
5a79ea57
EZ
2931The default value is `compound-text-with-extensions'. */);
2932 Vselection_coding_system = intern ("compound-text-with-extensions");
2584c9ec 2933
16cd5029 2934 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system,
8c1a1077
PJ
2935 doc: /* Coding system for the next communication with other X clients.
2936Usually, `selection-coding-system' is used for communicating with
f8f8d464
JB
2937other X clients. But, if this variable is set, it is used for the
2938next communication only. After the communication, this variable is
8c1a1077 2939set to nil. */);
16cd5029
KH
2940 Vnext_selection_coding_system = Qnil;
2941
ede4db72 2942 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
8c1a1077
PJ
2943 doc: /* Number of milliseconds to wait for a selection reply.
2944If the selection owner doesn't reply in this time, we give up.
2945A value of 0 means wait as long as necessary. This is initialized from the
2946\"*selectionTimeout\" resource. */);
ede4db72
RS
2947 x_selection_timeout = 0;
2948
2949 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2950 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2951 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2952 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2953 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2954 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2955 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
e6c7c988 2956 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
5109c8dd 2957 QUTF8_STRING = intern ("UTF8_STRING"); staticpro (&QUTF8_STRING);
ede4db72
RS
2958 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2959 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2960 QINCR = intern ("INCR"); staticpro (&QINCR);
2961 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2962 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2963 QATOM = intern ("ATOM"); staticpro (&QATOM);
2964 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2965 QNULL = intern ("NULL"); staticpro (&QNULL);
5a79ea57
EZ
2966 Qcompound_text_with_extensions = intern ("compound-text-with-extensions");
2967 staticpro (&Qcompound_text_with_extensions);
ede4db72
RS
2968
2969#ifdef CUT_BUFFER_SUPPORT
2970 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2971 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2972 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2973 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2974 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2975 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2976 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2977 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2978#endif
2979
e57ad4d8
KH
2980 Qforeign_selection = intern ("foreign-selection");
2981 staticpro (&Qforeign_selection);
ede4db72 2982}
ab5796a9
MB
2983
2984/* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2985 (do not change this comment) */