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