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