(do-auto-fill): Check enable-kinsoku and enable-multibyte-characters.
[emacs.git] / src / xselect.c
blobcf2fe19a4ae41100e817c95ba808a8389aa3ed16
1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 /* Rewritten by jwz */
24 #include <config.h>
25 #include "lisp.h"
26 #include "xterm.h" /* for all of the X includes */
27 #include "dispextern.h" /* frame.h seems to want this */
28 #include "frame.h" /* Need this to get the X window of selected_frame */
29 #include "blockinput.h"
30 #include "charset.h"
31 #include "coding.h"
33 #define CUT_BUFFER_SUPPORT
35 Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP,
36 QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL,
37 QATOM_PAIR;
39 Lisp_Object QCOMPOUND_TEXT; /* This is a type of selection. */
41 #ifdef CUT_BUFFER_SUPPORT
42 Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3,
43 QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7;
44 #endif
46 static Lisp_Object Vx_lost_selection_hooks;
47 static Lisp_Object Vx_sent_selection_hooks;
49 /* If this is a smaller number than the max-request-size of the display,
50 emacs will use INCR selection transfer when the selection is larger
51 than this. The max-request-size is usually around 64k, so if you want
52 emacs to use incremental selection transfers when the selection is
53 smaller than that, set this. I added this mostly for debugging the
54 incremental transfer stuff, but it might improve server performance. */
55 #define MAX_SELECTION_QUANTUM 0xFFFFFF
57 #ifdef HAVE_X11R4
58 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
59 #else
60 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
61 #endif
63 /* The timestamp of the last input event Emacs received from the X server. */
64 /* Defined in keyboard.c. */
65 extern unsigned long last_event_timestamp;
67 /* This is an association list whose elements are of the form
68 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
69 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
70 SELECTION-VALUE is the value that emacs owns for that selection.
71 It may be any kind of Lisp object.
72 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
73 as a cons of two 16-bit numbers (making a 32 bit time.)
74 FRAME is the frame for which we made the selection.
75 If there is an entry in this alist, then it can be assumed that Emacs owns
76 that selection.
77 The only (eq) parts of this list that are visible from Lisp are the
78 selection-values. */
79 static Lisp_Object Vselection_alist;
81 /* This is an alist whose CARs are selection-types (whose names are the same
82 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
83 call to convert the given Emacs selection value to a string representing
84 the given selection type. This is for Lisp-level extension of the emacs
85 selection handling. */
86 static Lisp_Object Vselection_converter_alist;
88 /* If the selection owner takes too long to reply to a selection request,
89 we give up on it. This is in milliseconds (0 = no timeout.) */
90 static int x_selection_timeout;
92 /* Utility functions */
94 static void lisp_data_to_selection_data ();
95 static Lisp_Object selection_data_to_lisp_data ();
96 static Lisp_Object x_get_window_property_as_lisp_data ();
98 /* This converts a Lisp symbol to a server Atom, avoiding a server
99 roundtrip whenever possible. */
101 static Atom
102 symbol_to_x_atom (dpyinfo, display, sym)
103 struct x_display_info *dpyinfo;
104 Display *display;
105 Lisp_Object sym;
107 Atom val;
108 if (NILP (sym)) return 0;
109 if (EQ (sym, QPRIMARY)) return XA_PRIMARY;
110 if (EQ (sym, QSECONDARY)) return XA_SECONDARY;
111 if (EQ (sym, QSTRING)) return XA_STRING;
112 if (EQ (sym, QINTEGER)) return XA_INTEGER;
113 if (EQ (sym, QATOM)) return XA_ATOM;
114 if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD;
115 if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP;
116 if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT;
117 if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT;
118 if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE;
119 if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE;
120 if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR;
121 if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP;
122 if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS;
123 if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL;
124 #ifdef CUT_BUFFER_SUPPORT
125 if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0;
126 if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1;
127 if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2;
128 if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3;
129 if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4;
130 if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5;
131 if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6;
132 if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7;
133 #endif
134 if (!SYMBOLP (sym)) abort ();
136 #if 0
137 fprintf (stderr, " XInternAtom %s\n", (char *) XSYMBOL (sym)->name->data);
138 #endif
139 BLOCK_INPUT;
140 val = XInternAtom (display, (char *) XSYMBOL (sym)->name->data, False);
141 UNBLOCK_INPUT;
142 return val;
146 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
147 and calls to intern whenever possible. */
149 static Lisp_Object
150 x_atom_to_symbol (dpyinfo, display, atom)
151 struct x_display_info *dpyinfo;
152 Display *display;
153 Atom atom;
155 char *str;
156 Lisp_Object val;
157 if (! atom) return Qnil;
158 switch (atom)
160 case XA_PRIMARY:
161 return QPRIMARY;
162 case XA_SECONDARY:
163 return QSECONDARY;
164 case XA_STRING:
165 return QSTRING;
166 case XA_INTEGER:
167 return QINTEGER;
168 case XA_ATOM:
169 return QATOM;
170 #ifdef CUT_BUFFER_SUPPORT
171 case XA_CUT_BUFFER0:
172 return QCUT_BUFFER0;
173 case XA_CUT_BUFFER1:
174 return QCUT_BUFFER1;
175 case XA_CUT_BUFFER2:
176 return QCUT_BUFFER2;
177 case XA_CUT_BUFFER3:
178 return QCUT_BUFFER3;
179 case XA_CUT_BUFFER4:
180 return QCUT_BUFFER4;
181 case XA_CUT_BUFFER5:
182 return QCUT_BUFFER5;
183 case XA_CUT_BUFFER6:
184 return QCUT_BUFFER6;
185 case XA_CUT_BUFFER7:
186 return QCUT_BUFFER7;
187 #endif
190 if (atom == dpyinfo->Xatom_CLIPBOARD)
191 return QCLIPBOARD;
192 if (atom == dpyinfo->Xatom_TIMESTAMP)
193 return QTIMESTAMP;
194 if (atom == dpyinfo->Xatom_TEXT)
195 return QTEXT;
196 if (atom == dpyinfo->Xatom_COMPOUND_TEXT)
197 return QCOMPOUND_TEXT;
198 if (atom == dpyinfo->Xatom_DELETE)
199 return QDELETE;
200 if (atom == dpyinfo->Xatom_MULTIPLE)
201 return QMULTIPLE;
202 if (atom == dpyinfo->Xatom_INCR)
203 return QINCR;
204 if (atom == dpyinfo->Xatom_EMACS_TMP)
205 return QEMACS_TMP;
206 if (atom == dpyinfo->Xatom_TARGETS)
207 return QTARGETS;
208 if (atom == dpyinfo->Xatom_NULL)
209 return QNULL;
211 BLOCK_INPUT;
212 str = XGetAtomName (display, atom);
213 UNBLOCK_INPUT;
214 #if 0
215 fprintf (stderr, " XGetAtomName --> %s\n", str);
216 #endif
217 if (! str) return Qnil;
218 val = intern (str);
219 BLOCK_INPUT;
220 /* This was allocated by Xlib, so use XFree. */
221 XFree (str);
222 UNBLOCK_INPUT;
223 return val;
226 /* Do protocol to assert ourself as a selection owner.
227 Update the Vselection_alist so that we can reply to later requests for
228 our selection. */
230 static void
231 x_own_selection (selection_name, selection_value)
232 Lisp_Object selection_name, selection_value;
234 Window selecting_window = FRAME_X_WINDOW (selected_frame);
235 Display *display = FRAME_X_DISPLAY (selected_frame);
236 Time time = last_event_timestamp;
237 Atom selection_atom;
238 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
239 int count;
241 CHECK_SYMBOL (selection_name, 0);
242 selection_atom = symbol_to_x_atom (dpyinfo, display, selection_name);
244 BLOCK_INPUT;
245 count = x_catch_errors (display);
246 XSetSelectionOwner (display, selection_atom, selecting_window, time);
247 x_check_errors (display, "Can't set selection: %s");
248 x_uncatch_errors (display, count);
249 UNBLOCK_INPUT;
251 /* Now update the local cache */
253 Lisp_Object selection_time;
254 Lisp_Object selection_data;
255 Lisp_Object prev_value;
257 selection_time = long_to_cons ((unsigned long) time);
258 selection_data = Fcons (selection_name,
259 Fcons (selection_value,
260 Fcons (selection_time,
261 Fcons (Fselected_frame (), Qnil))));
262 prev_value = assq_no_quit (selection_name, Vselection_alist);
264 Vselection_alist = Fcons (selection_data, Vselection_alist);
266 /* If we already owned the selection, remove the old selection data.
267 Perhaps we should destructively modify it instead.
268 Don't use Fdelq as that may QUIT. */
269 if (!NILP (prev_value))
271 Lisp_Object rest; /* we know it's not the CAR, so it's easy. */
272 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
273 if (EQ (prev_value, Fcar (XCONS (rest)->cdr)))
275 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
276 break;
282 /* Given a selection-name and desired type, look up our local copy of
283 the selection value and convert it to the type.
284 The value is nil or a string.
285 This function is used both for remote requests
286 and for local x-get-selection-internal.
288 This calls random Lisp code, and may signal or gc. */
290 static Lisp_Object
291 x_get_local_selection (selection_symbol, target_type)
292 Lisp_Object selection_symbol, target_type;
294 Lisp_Object local_value;
295 Lisp_Object handler_fn, value, type, check;
296 int count;
298 local_value = assq_no_quit (selection_symbol, Vselection_alist);
300 if (NILP (local_value)) return Qnil;
302 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
303 if (EQ (target_type, QTIMESTAMP))
305 handler_fn = Qnil;
306 value = XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car;
308 #if 0
309 else if (EQ (target_type, QDELETE))
311 handler_fn = Qnil;
312 Fx_disown_selection_internal
313 (selection_symbol,
314 XCONS (XCONS (XCONS (local_value)->cdr)->cdr)->car);
315 value = QNULL;
317 #endif
319 #if 0 /* #### MULTIPLE doesn't work yet */
320 else if (CONSP (target_type)
321 && XCONS (target_type)->car == QMULTIPLE)
323 Lisp_Object pairs;
324 int size;
325 int i;
326 pairs = XCONS (target_type)->cdr;
327 size = XVECTOR (pairs)->size;
328 /* If the target is MULTIPLE, then target_type looks like
329 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
330 We modify the second element of each pair in the vector and
331 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
333 for (i = 0; i < size; i++)
335 Lisp_Object pair;
336 pair = XVECTOR (pairs)->contents [i];
337 XVECTOR (pair)->contents [1]
338 = x_get_local_selection (XVECTOR (pair)->contents [0],
339 XVECTOR (pair)->contents [1]);
341 return pairs;
343 #endif
344 else
346 /* Don't allow a quit within the converter.
347 When the user types C-g, he would be surprised
348 if by luck it came during a converter. */
349 count = specpdl_ptr - specpdl;
350 specbind (Qinhibit_quit, Qt);
352 CHECK_SYMBOL (target_type, 0);
353 handler_fn = Fcdr (Fassq (target_type, Vselection_converter_alist));
354 if (!NILP (handler_fn))
355 value = call3 (handler_fn,
356 selection_symbol, target_type,
357 XCONS (XCONS (local_value)->cdr)->car);
358 else
359 value = Qnil;
360 unbind_to (count, Qnil);
363 /* Make sure this value is of a type that we could transmit
364 to another X client. */
366 check = value;
367 if (CONSP (value)
368 && SYMBOLP (XCONS (value)->car))
369 type = XCONS (value)->car,
370 check = XCONS (value)->cdr;
372 if (STRINGP (check)
373 || VECTORP (check)
374 || SYMBOLP (check)
375 || INTEGERP (check)
376 || NILP (value))
377 return value;
378 /* Check for a value that cons_to_long could handle. */
379 else if (CONSP (check)
380 && INTEGERP (XCONS (check)->car)
381 && (INTEGERP (XCONS (check)->cdr)
383 (CONSP (XCONS (check)->cdr)
384 && INTEGERP (XCONS (XCONS (check)->cdr)->car)
385 && NILP (XCONS (XCONS (check)->cdr)->cdr))))
386 return value;
387 else
388 return
389 Fsignal (Qerror,
390 Fcons (build_string ("invalid data returned by selection-conversion function"),
391 Fcons (handler_fn, Fcons (value, Qnil))));
394 /* Subroutines of x_reply_selection_request. */
396 /* Send a SelectionNotify event to the requestor with property=None,
397 meaning we were unable to do what they wanted. */
399 static void
400 x_decline_selection_request (event)
401 struct input_event *event;
403 XSelectionEvent reply;
404 reply.type = SelectionNotify;
405 reply.display = SELECTION_EVENT_DISPLAY (event);
406 reply.requestor = SELECTION_EVENT_REQUESTOR (event);
407 reply.selection = SELECTION_EVENT_SELECTION (event);
408 reply.time = SELECTION_EVENT_TIME (event);
409 reply.target = SELECTION_EVENT_TARGET (event);
410 reply.property = None;
412 BLOCK_INPUT;
413 XSendEvent (reply.display, reply.requestor, False, 0L,
414 (XEvent *) &reply);
415 XFlush (reply.display);
416 UNBLOCK_INPUT;
419 /* This is the selection request currently being processed.
420 It is set to zero when the request is fully processed. */
421 static struct input_event *x_selection_current_request;
423 /* Used as an unwind-protect clause so that, if a selection-converter signals
424 an error, we tell the requester that we were unable to do what they wanted
425 before we throw to top-level or go into the debugger or whatever. */
427 static Lisp_Object
428 x_selection_request_lisp_error (ignore)
429 Lisp_Object ignore;
431 if (x_selection_current_request != 0)
432 x_decline_selection_request (x_selection_current_request);
433 return Qnil;
437 /* This stuff is so that INCR selections are reentrant (that is, so we can
438 be servicing multiple INCR selection requests simultaneously.) I haven't
439 actually tested that yet. */
441 /* Keep a list of the property changes that are awaited. */
443 struct prop_location
445 int identifier;
446 Display *display;
447 Window window;
448 Atom property;
449 int desired_state;
450 int arrived;
451 struct prop_location *next;
454 static struct prop_location *expect_property_change ();
455 static void wait_for_property_change ();
456 static void unexpect_property_change ();
457 static int waiting_for_other_props_on_window ();
459 static int prop_location_identifier;
461 static Lisp_Object property_change_reply;
463 static struct prop_location *property_change_reply_object;
465 static struct prop_location *property_change_wait_list;
467 static Lisp_Object
468 queue_selection_requests_unwind (frame)
469 Lisp_Object frame;
471 FRAME_PTR f = XFRAME (frame);
473 if (! NILP (frame))
474 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f));
475 return Qnil;
478 /* Return some frame whose display info is DPYINFO.
479 Return nil if there is none. */
481 static Lisp_Object
482 some_frame_on_display (dpyinfo)
483 struct x_display_info *dpyinfo;
485 Lisp_Object list, frame;
487 FOR_EACH_FRAME (list, frame)
489 if (FRAME_X_DISPLAY_INFO (XFRAME (frame)) == dpyinfo)
490 return frame;
493 return Qnil;
496 /* Send the reply to a selection request event EVENT.
497 TYPE is the type of selection data requested.
498 DATA and SIZE describe the data to send, already converted.
499 FORMAT is the unit-size (in bits) of the data to be transmitted. */
501 static void
502 x_reply_selection_request (event, format, data, size, type)
503 struct input_event *event;
504 int format, size;
505 unsigned char *data;
506 Atom type;
508 XSelectionEvent reply;
509 Display *display = SELECTION_EVENT_DISPLAY (event);
510 Window window = SELECTION_EVENT_REQUESTOR (event);
511 int bytes_remaining;
512 int format_bytes = format/8;
513 int max_bytes = SELECTION_QUANTUM (display);
514 struct x_display_info *dpyinfo = x_display_info_for_display (display);
515 int count;
517 if (max_bytes > MAX_SELECTION_QUANTUM)
518 max_bytes = MAX_SELECTION_QUANTUM;
520 reply.type = SelectionNotify;
521 reply.display = display;
522 reply.requestor = window;
523 reply.selection = SELECTION_EVENT_SELECTION (event);
524 reply.time = SELECTION_EVENT_TIME (event);
525 reply.target = SELECTION_EVENT_TARGET (event);
526 reply.property = SELECTION_EVENT_PROPERTY (event);
527 if (reply.property == None)
528 reply.property = reply.target;
530 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
531 BLOCK_INPUT;
532 count = x_catch_errors (display);
534 /* Store the data on the requested property.
535 If the selection is large, only store the first N bytes of it.
537 bytes_remaining = size * format_bytes;
538 if (bytes_remaining <= max_bytes)
540 /* Send all the data at once, with minimal handshaking. */
541 #if 0
542 fprintf (stderr,"\nStoring all %d\n", bytes_remaining);
543 #endif
544 XChangeProperty (display, window, reply.property, type, format,
545 PropModeReplace, data, size);
546 /* At this point, the selection was successfully stored; ack it. */
547 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
549 else
551 /* Send an INCR selection. */
552 struct prop_location *wait_object;
553 int had_errors;
554 Lisp_Object frame;
556 frame = some_frame_on_display (dpyinfo);
558 /* If the display no longer has frames, we can't expect
559 to get many more selection requests from it, so don't
560 bother trying to queue them. */
561 if (!NILP (frame))
563 x_start_queuing_selection_requests (display);
565 record_unwind_protect (queue_selection_requests_unwind,
566 frame);
569 if (x_window_to_frame (dpyinfo, window)) /* #### debug */
570 error ("Attempt to transfer an INCR to ourself!");
571 #if 0
572 fprintf (stderr, "\nINCR %d\n", bytes_remaining);
573 #endif
574 wait_object = expect_property_change (display, window, reply.property,
575 PropertyDelete);
577 XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
578 32, PropModeReplace,
579 (unsigned char *) &bytes_remaining, 1);
580 XSelectInput (display, window, PropertyChangeMask);
581 /* Tell 'em the INCR data is there... */
582 XSendEvent (display, window, False, 0L, (XEvent *) &reply);
583 XFlush (display);
585 had_errors = x_had_errors_p (display);
586 UNBLOCK_INPUT;
588 /* First, wait for the requester to ack by deleting the property.
589 This can run random lisp code (process handlers) or signal. */
590 if (! had_errors)
591 wait_for_property_change (wait_object);
593 while (bytes_remaining)
595 int i = ((bytes_remaining < max_bytes)
596 ? bytes_remaining
597 : max_bytes);
599 BLOCK_INPUT;
601 wait_object
602 = expect_property_change (display, window, reply.property,
603 PropertyDelete);
604 #if 0
605 fprintf (stderr," INCR adding %d\n", i);
606 #endif
607 /* Append the next chunk of data to the property. */
608 XChangeProperty (display, window, reply.property, type, format,
609 PropModeAppend, data, i / format_bytes);
610 bytes_remaining -= i;
611 data += i;
612 XFlush (display);
613 had_errors = x_had_errors_p (display);
614 UNBLOCK_INPUT;
616 if (had_errors)
617 break;
619 /* Now wait for the requester to ack this chunk by deleting the
620 property. This can run random lisp code or signal.
622 wait_for_property_change (wait_object);
624 /* Now write a zero-length chunk to the property to tell the requester
625 that we're done. */
626 #if 0
627 fprintf (stderr," INCR done\n");
628 #endif
629 BLOCK_INPUT;
630 if (! waiting_for_other_props_on_window (display, window))
631 XSelectInput (display, window, 0L);
633 XChangeProperty (display, window, reply.property, type, format,
634 PropModeReplace, data, 0);
637 XFlush (display);
638 x_uncatch_errors (display, count);
639 UNBLOCK_INPUT;
642 /* Handle a SelectionRequest event EVENT.
643 This is called from keyboard.c when such an event is found in the queue. */
645 void
646 x_handle_selection_request (event)
647 struct input_event *event;
649 struct gcpro gcpro1, gcpro2, gcpro3;
650 Lisp_Object local_selection_data;
651 Lisp_Object selection_symbol;
652 Lisp_Object target_symbol;
653 Lisp_Object converted_selection;
654 Time local_selection_time;
655 Lisp_Object successful_p;
656 int count;
657 struct x_display_info *dpyinfo
658 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event));
660 local_selection_data = Qnil;
661 target_symbol = Qnil;
662 converted_selection = Qnil;
663 successful_p = Qnil;
665 GCPRO3 (local_selection_data, converted_selection, target_symbol);
667 selection_symbol = x_atom_to_symbol (dpyinfo,
668 SELECTION_EVENT_DISPLAY (event),
669 SELECTION_EVENT_SELECTION (event));
671 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
673 if (NILP (local_selection_data))
675 /* Someone asked for the selection, but we don't have it any more.
677 x_decline_selection_request (event);
678 goto DONE;
681 local_selection_time = (Time)
682 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
684 if (SELECTION_EVENT_TIME (event) != CurrentTime
685 && local_selection_time > SELECTION_EVENT_TIME (event))
687 /* Someone asked for the selection, and we have one, but not the one
688 they're looking for.
690 x_decline_selection_request (event);
691 goto DONE;
694 count = specpdl_ptr - specpdl;
695 x_selection_current_request = event;
696 record_unwind_protect (x_selection_request_lisp_error, Qnil);
698 target_symbol = x_atom_to_symbol (dpyinfo, SELECTION_EVENT_DISPLAY (event),
699 SELECTION_EVENT_TARGET (event));
701 #if 0 /* #### MULTIPLE doesn't work yet */
702 if (EQ (target_symbol, QMULTIPLE))
703 target_symbol = fetch_multiple_target (event);
704 #endif
706 /* Convert lisp objects back into binary data */
708 converted_selection
709 = x_get_local_selection (selection_symbol, target_symbol);
711 if (! NILP (converted_selection))
713 unsigned char *data;
714 unsigned int size;
715 int format;
716 Atom type;
717 int nofree;
719 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event),
720 converted_selection,
721 &data, &type, &size, &format, &nofree);
723 x_reply_selection_request (event, format, data, size, type);
724 successful_p = Qt;
726 /* Indicate we have successfully processed this event. */
727 x_selection_current_request = 0;
729 /* Use free, not XFree, because lisp_data_to_selection_data
730 calls xmalloc itself. */
731 if (!nofree)
732 free (data);
734 unbind_to (count, Qnil);
736 DONE:
738 UNGCPRO;
740 /* Let random lisp code notice that the selection has been asked for. */
742 Lisp_Object rest;
743 rest = Vx_sent_selection_hooks;
744 if (!EQ (rest, Qunbound))
745 for (; CONSP (rest); rest = Fcdr (rest))
746 call3 (Fcar (rest), selection_symbol, target_symbol, successful_p);
750 /* Handle a SelectionClear event EVENT, which indicates that some other
751 client cleared out our previously asserted selection.
752 This is called from keyboard.c when such an event is found in the queue. */
754 void
755 x_handle_selection_clear (event)
756 struct input_event *event;
758 Display *display = SELECTION_EVENT_DISPLAY (event);
759 Atom selection = SELECTION_EVENT_SELECTION (event);
760 Time changed_owner_time = SELECTION_EVENT_TIME (event);
762 Lisp_Object selection_symbol, local_selection_data;
763 Time local_selection_time;
764 struct x_display_info *dpyinfo = x_display_info_for_display (display);
766 selection_symbol = x_atom_to_symbol (dpyinfo, display, selection);
768 local_selection_data = assq_no_quit (selection_symbol, Vselection_alist);
770 /* Well, we already believe that we don't own it, so that's just fine. */
771 if (NILP (local_selection_data)) return;
773 local_selection_time = (Time)
774 cons_to_long (XCONS (XCONS (XCONS (local_selection_data)->cdr)->cdr)->car);
776 /* This SelectionClear is for a selection that we no longer own, so we can
777 disregard it. (That is, we have reasserted the selection since this
778 request was generated.) */
780 if (changed_owner_time != CurrentTime
781 && local_selection_time > changed_owner_time)
782 return;
784 /* Otherwise, we're really honest and truly being told to drop it.
785 Don't use Fdelq as that may QUIT;. */
787 if (EQ (local_selection_data, Fcar (Vselection_alist)))
788 Vselection_alist = Fcdr (Vselection_alist);
789 else
791 Lisp_Object rest;
792 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
793 if (EQ (local_selection_data, Fcar (XCONS (rest)->cdr)))
795 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
796 break;
800 /* Let random lisp code notice that the selection has been stolen. */
803 Lisp_Object rest;
804 rest = Vx_lost_selection_hooks;
805 if (!EQ (rest, Qunbound))
807 for (; CONSP (rest); rest = Fcdr (rest))
808 call1 (Fcar (rest), selection_symbol);
809 prepare_menu_bars ();
810 redisplay_preserve_echo_area ();
815 /* Clear all selections that were made from frame F.
816 We do this when about to delete a frame. */
818 void
819 x_clear_frame_selections (f)
820 FRAME_PTR f;
822 Lisp_Object frame;
823 Lisp_Object rest;
825 XSETFRAME (frame, f);
827 /* Otherwise, we're really honest and truly being told to drop it.
828 Don't use Fdelq as that may QUIT;. */
830 /* Delete elements from the beginning of Vselection_alist. */
831 while (!NILP (Vselection_alist)
832 && EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist)))))))
834 /* Let random Lisp code notice that the selection has been stolen. */
835 Lisp_Object hooks, selection_symbol;
837 hooks = Vx_lost_selection_hooks;
838 selection_symbol = Fcar (Fcar (Vselection_alist));
840 if (!EQ (hooks, Qunbound))
842 for (; CONSP (hooks); hooks = Fcdr (hooks))
843 call1 (Fcar (hooks), selection_symbol);
844 #if 0 /* This can crash when deleting a frame
845 from x_connection_closed. Anyway, it seems unnecessary;
846 something else should cause a redisplay. */
847 redisplay_preserve_echo_area ();
848 #endif
851 Vselection_alist = Fcdr (Vselection_alist);
854 /* Delete elements after the beginning of Vselection_alist. */
855 for (rest = Vselection_alist; !NILP (rest); rest = Fcdr (rest))
856 if (EQ (frame, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCONS (rest)->cdr)))))))
858 /* Let random Lisp code notice that the selection has been stolen. */
859 Lisp_Object hooks, selection_symbol;
861 hooks = Vx_lost_selection_hooks;
862 selection_symbol = Fcar (Fcar (XCONS (rest)->cdr));
864 if (!EQ (hooks, Qunbound))
866 for (; CONSP (hooks); hooks = Fcdr (hooks))
867 call1 (Fcar (hooks), selection_symbol);
868 #if 0 /* See above */
869 redisplay_preserve_echo_area ();
870 #endif
872 XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr);
873 break;
877 /* Nonzero if any properties for DISPLAY and WINDOW
878 are on the list of what we are waiting for. */
880 static int
881 waiting_for_other_props_on_window (display, window)
882 Display *display;
883 Window window;
885 struct prop_location *rest = property_change_wait_list;
886 while (rest)
887 if (rest->display == display && rest->window == window)
888 return 1;
889 else
890 rest = rest->next;
891 return 0;
894 /* Add an entry to the list of property changes we are waiting for.
895 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
896 The return value is a number that uniquely identifies
897 this awaited property change. */
899 static struct prop_location *
900 expect_property_change (display, window, property, state)
901 Display *display;
902 Window window;
903 Atom property;
904 int state;
906 struct prop_location *pl
907 = (struct prop_location *) xmalloc (sizeof (struct prop_location));
908 pl->identifier = ++prop_location_identifier;
909 pl->display = display;
910 pl->window = window;
911 pl->property = property;
912 pl->desired_state = state;
913 pl->next = property_change_wait_list;
914 pl->arrived = 0;
915 property_change_wait_list = pl;
916 return pl;
919 /* Delete an entry from the list of property changes we are waiting for.
920 IDENTIFIER is the number that uniquely identifies the entry. */
922 static void
923 unexpect_property_change (location)
924 struct prop_location *location;
926 struct prop_location *prev = 0, *rest = property_change_wait_list;
927 while (rest)
929 if (rest == location)
931 if (prev)
932 prev->next = rest->next;
933 else
934 property_change_wait_list = rest->next;
935 free (rest);
936 return;
938 prev = rest;
939 rest = rest->next;
943 /* Remove the property change expectation element for IDENTIFIER. */
945 static Lisp_Object
946 wait_for_property_change_unwind (identifierval)
947 Lisp_Object identifierval;
949 unexpect_property_change ((struct prop_location *)
950 (XFASTINT (XCONS (identifierval)->car) << 16
951 | XFASTINT (XCONS (identifierval)->cdr)));
952 return Qnil;
955 /* Actually wait for a property change.
956 IDENTIFIER should be the value that expect_property_change returned. */
958 static void
959 wait_for_property_change (location)
960 struct prop_location *location;
962 int secs, usecs;
963 int count = specpdl_ptr - specpdl;
964 Lisp_Object tem;
966 tem = Fcons (Qnil, Qnil);
967 XSETFASTINT (XCONS (tem)->car, (EMACS_UINT)location >> 16);
968 XSETFASTINT (XCONS (tem)->cdr, (EMACS_UINT)location & 0xffff);
970 /* Make sure to do unexpect_property_change if we quit or err. */
971 record_unwind_protect (wait_for_property_change_unwind, tem);
973 XCONS (property_change_reply)->car = Qnil;
975 property_change_reply_object = location;
976 /* If the event we are waiting for arrives beyond here, it will set
977 property_change_reply, because property_change_reply_object says so. */
978 if (! location->arrived)
980 secs = x_selection_timeout / 1000;
981 usecs = (x_selection_timeout % 1000) * 1000;
982 wait_reading_process_input (secs, usecs, property_change_reply, 0);
984 if (NILP (XCONS (property_change_reply)->car))
985 error ("Timed out waiting for property-notify event");
988 unbind_to (count, Qnil);
991 /* Called from XTread_socket in response to a PropertyNotify event. */
993 void
994 x_handle_property_notify (event)
995 XPropertyEvent *event;
997 struct prop_location *prev = 0, *rest = property_change_wait_list;
998 while (rest)
1000 if (rest->property == event->atom
1001 && rest->window == event->window
1002 && rest->display == event->display
1003 && rest->desired_state == event->state)
1005 #if 0
1006 fprintf (stderr, "Saw expected prop-%s on %s\n",
1007 (event->state == PropertyDelete ? "delete" : "change"),
1008 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo, event->display,
1009 event->atom))
1010 ->name->data);
1011 #endif
1013 rest->arrived = 1;
1015 /* If this is the one wait_for_property_change is waiting for,
1016 tell it to wake up. */
1017 if (rest == property_change_reply_object)
1018 XCONS (property_change_reply)->car = Qt;
1020 if (prev)
1021 prev->next = rest->next;
1022 else
1023 property_change_wait_list = rest->next;
1024 free (rest);
1025 return;
1027 prev = rest;
1028 rest = rest->next;
1030 #if 0
1031 fprintf (stderr, "Saw UNexpected prop-%s on %s\n",
1032 (event->state == PropertyDelete ? "delete" : "change"),
1033 (char *) XSYMBOL (x_atom_to_symbol (dpyinfo,
1034 event->display, event->atom))
1035 ->name->data);
1036 #endif
1041 #if 0 /* #### MULTIPLE doesn't work yet */
1043 static Lisp_Object
1044 fetch_multiple_target (event)
1045 XSelectionRequestEvent *event;
1047 Display *display = event->display;
1048 Window window = event->requestor;
1049 Atom target = event->target;
1050 Atom selection_atom = event->selection;
1051 int result;
1053 return
1054 Fcons (QMULTIPLE,
1055 x_get_window_property_as_lisp_data (display, window, target,
1056 QMULTIPLE, selection_atom));
1059 static Lisp_Object
1060 copy_multiple_data (obj)
1061 Lisp_Object obj;
1063 Lisp_Object vec;
1064 int i;
1065 int size;
1066 if (CONSP (obj))
1067 return Fcons (XCONS (obj)->car, copy_multiple_data (XCONS (obj)->cdr));
1069 CHECK_VECTOR (obj, 0);
1070 vec = Fmake_vector (size = XVECTOR (obj)->size, Qnil);
1071 for (i = 0; i < size; i++)
1073 Lisp_Object vec2 = XVECTOR (obj)->contents [i];
1074 CHECK_VECTOR (vec2, 0);
1075 if (XVECTOR (vec2)->size != 2)
1076 /* ??? Confusing error message */
1077 Fsignal (Qerror, Fcons (build_string ("vectors must be of length 2"),
1078 Fcons (vec2, Qnil)));
1079 XVECTOR (vec)->contents [i] = Fmake_vector (2, Qnil);
1080 XVECTOR (XVECTOR (vec)->contents [i])->contents [0]
1081 = XVECTOR (vec2)->contents [0];
1082 XVECTOR (XVECTOR (vec)->contents [i])->contents [1]
1083 = XVECTOR (vec2)->contents [1];
1085 return vec;
1088 #endif
1091 /* Variables for communication with x_handle_selection_notify. */
1092 static Atom reading_which_selection;
1093 static Lisp_Object reading_selection_reply;
1094 static Window reading_selection_window;
1096 /* Do protocol to read selection-data from the server.
1097 Converts this to Lisp data and returns it. */
1099 static Lisp_Object
1100 x_get_foreign_selection (selection_symbol, target_type)
1101 Lisp_Object selection_symbol, target_type;
1103 Window requestor_window = FRAME_X_WINDOW (selected_frame);
1104 Display *display = FRAME_X_DISPLAY (selected_frame);
1105 struct x_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1106 Time requestor_time = last_event_timestamp;
1107 Atom target_property = dpyinfo->Xatom_EMACS_TMP;
1108 Atom selection_atom = symbol_to_x_atom (dpyinfo, display, selection_symbol);
1109 Atom type_atom;
1110 int secs, usecs;
1111 int count;
1112 Lisp_Object frame;
1114 if (CONSP (target_type))
1115 type_atom = symbol_to_x_atom (dpyinfo, display, XCONS (target_type)->car);
1116 else
1117 type_atom = symbol_to_x_atom (dpyinfo, display, target_type);
1119 BLOCK_INPUT;
1120 count = x_catch_errors (display);
1121 XConvertSelection (display, selection_atom, type_atom, target_property,
1122 requestor_window, requestor_time);
1123 XFlush (display);
1125 /* Prepare to block until the reply has been read. */
1126 reading_selection_window = requestor_window;
1127 reading_which_selection = selection_atom;
1128 XCONS (reading_selection_reply)->car = Qnil;
1130 frame = some_frame_on_display (dpyinfo);
1132 /* If the display no longer has frames, we can't expect
1133 to get many more selection requests from it, so don't
1134 bother trying to queue them. */
1135 if (!NILP (frame))
1137 x_start_queuing_selection_requests (display);
1139 record_unwind_protect (queue_selection_requests_unwind,
1140 frame);
1142 UNBLOCK_INPUT;
1144 /* This allows quits. Also, don't wait forever. */
1145 secs = x_selection_timeout / 1000;
1146 usecs = (x_selection_timeout % 1000) * 1000;
1147 wait_reading_process_input (secs, usecs, reading_selection_reply, 0);
1149 BLOCK_INPUT;
1150 x_check_errors (display, "Cannot get selection: %s");
1151 x_uncatch_errors (display, count);
1152 UNBLOCK_INPUT;
1154 if (NILP (XCONS (reading_selection_reply)->car))
1155 error ("Timed out waiting for reply from selection owner");
1156 if (EQ (XCONS (reading_selection_reply)->car, Qlambda))
1157 error ("No `%s' selection", XSYMBOL (selection_symbol)->name->data);
1159 /* Otherwise, the selection is waiting for us on the requested property. */
1160 return
1161 x_get_window_property_as_lisp_data (display, requestor_window,
1162 target_property, target_type,
1163 selection_atom);
1166 /* Subroutines of x_get_window_property_as_lisp_data */
1168 /* Use free, not XFree, to free the data obtained with this function. */
1170 static void
1171 x_get_window_property (display, window, property, data_ret, bytes_ret,
1172 actual_type_ret, actual_format_ret, actual_size_ret,
1173 delete_p)
1174 Display *display;
1175 Window window;
1176 Atom property;
1177 unsigned char **data_ret;
1178 int *bytes_ret;
1179 Atom *actual_type_ret;
1180 int *actual_format_ret;
1181 unsigned long *actual_size_ret;
1182 int delete_p;
1184 int total_size;
1185 unsigned long bytes_remaining;
1186 int offset = 0;
1187 unsigned char *tmp_data = 0;
1188 int result;
1189 int buffer_size = SELECTION_QUANTUM (display);
1190 if (buffer_size > MAX_SELECTION_QUANTUM) buffer_size = MAX_SELECTION_QUANTUM;
1192 BLOCK_INPUT;
1193 /* First probe the thing to find out how big it is. */
1194 result = XGetWindowProperty (display, window, property,
1195 0L, 0L, False, AnyPropertyType,
1196 actual_type_ret, actual_format_ret,
1197 actual_size_ret,
1198 &bytes_remaining, &tmp_data);
1199 if (result != Success)
1201 UNBLOCK_INPUT;
1202 *data_ret = 0;
1203 *bytes_ret = 0;
1204 return;
1206 /* This was allocated by Xlib, so use XFree. */
1207 XFree ((char *) tmp_data);
1209 if (*actual_type_ret == None || *actual_format_ret == 0)
1211 UNBLOCK_INPUT;
1212 return;
1215 total_size = bytes_remaining + 1;
1216 *data_ret = (unsigned char *) xmalloc (total_size);
1218 /* Now read, until we've gotten it all. */
1219 while (bytes_remaining)
1221 #if 0
1222 int last = bytes_remaining;
1223 #endif
1224 result
1225 = XGetWindowProperty (display, window, property,
1226 (long)offset/4, (long)buffer_size/4,
1227 False,
1228 AnyPropertyType,
1229 actual_type_ret, actual_format_ret,
1230 actual_size_ret, &bytes_remaining, &tmp_data);
1231 #if 0
1232 fprintf (stderr, "<< read %d\n", last-bytes_remaining);
1233 #endif
1234 /* If this doesn't return Success at this point, it means that
1235 some clod deleted the selection while we were in the midst of
1236 reading it. Deal with that, I guess....
1238 if (result != Success) break;
1239 *actual_size_ret *= *actual_format_ret / 8;
1240 bcopy (tmp_data, (*data_ret) + offset, *actual_size_ret);
1241 offset += *actual_size_ret;
1242 /* This was allocated by Xlib, so use XFree. */
1243 XFree ((char *) tmp_data);
1246 XFlush (display);
1247 UNBLOCK_INPUT;
1248 *bytes_ret = offset;
1251 /* Use free, not XFree, to free the data obtained with this function. */
1253 static void
1254 receive_incremental_selection (display, window, property, target_type,
1255 min_size_bytes, data_ret, size_bytes_ret,
1256 type_ret, format_ret, size_ret)
1257 Display *display;
1258 Window window;
1259 Atom property;
1260 Lisp_Object target_type; /* for error messages only */
1261 unsigned int min_size_bytes;
1262 unsigned char **data_ret;
1263 int *size_bytes_ret;
1264 Atom *type_ret;
1265 unsigned long *size_ret;
1266 int *format_ret;
1268 int offset = 0;
1269 struct prop_location *wait_object;
1270 *size_bytes_ret = min_size_bytes;
1271 *data_ret = (unsigned char *) xmalloc (*size_bytes_ret);
1272 #if 0
1273 fprintf (stderr, "\nread INCR %d\n", min_size_bytes);
1274 #endif
1276 /* At this point, we have read an INCR property.
1277 Delete the property to ack it.
1278 (But first, prepare to receive the next event in this handshake.)
1280 Now, we must loop, waiting for the sending window to put a value on
1281 that property, then reading the property, then deleting it to ack.
1282 We are done when the sender places a property of length 0.
1284 BLOCK_INPUT;
1285 XSelectInput (display, window, STANDARD_EVENT_SET | PropertyChangeMask);
1286 XDeleteProperty (display, window, property);
1287 wait_object = expect_property_change (display, window, property,
1288 PropertyNewValue);
1289 XFlush (display);
1290 UNBLOCK_INPUT;
1292 while (1)
1294 unsigned char *tmp_data;
1295 int tmp_size_bytes;
1296 wait_for_property_change (wait_object);
1297 /* expect it again immediately, because x_get_window_property may
1298 .. no it won't, I don't get it.
1299 .. Ok, I get it now, the Xt code that implements INCR is broken.
1301 x_get_window_property (display, window, property,
1302 &tmp_data, &tmp_size_bytes,
1303 type_ret, format_ret, size_ret, 1);
1305 if (tmp_size_bytes == 0) /* we're done */
1307 #if 0
1308 fprintf (stderr, " read INCR done\n");
1309 #endif
1310 if (! waiting_for_other_props_on_window (display, window))
1311 XSelectInput (display, window, STANDARD_EVENT_SET);
1312 unexpect_property_change (wait_object);
1313 /* Use free, not XFree, because x_get_window_property
1314 calls xmalloc itself. */
1315 if (tmp_data) free (tmp_data);
1316 break;
1319 BLOCK_INPUT;
1320 XDeleteProperty (display, window, property);
1321 wait_object = expect_property_change (display, window, property,
1322 PropertyNewValue);
1323 XFlush (display);
1324 UNBLOCK_INPUT;
1326 #if 0
1327 fprintf (stderr, " read INCR %d\n", tmp_size_bytes);
1328 #endif
1329 if (*size_bytes_ret < offset + tmp_size_bytes)
1331 #if 0
1332 fprintf (stderr, " read INCR realloc %d -> %d\n",
1333 *size_bytes_ret, offset + tmp_size_bytes);
1334 #endif
1335 *size_bytes_ret = offset + tmp_size_bytes;
1336 *data_ret = (unsigned char *) xrealloc (*data_ret, *size_bytes_ret);
1338 bcopy (tmp_data, (*data_ret) + offset, tmp_size_bytes);
1339 offset += tmp_size_bytes;
1340 /* Use free, not XFree, because x_get_window_property
1341 calls xmalloc itself. */
1342 free (tmp_data);
1346 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1347 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1348 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1350 static Lisp_Object
1351 x_get_window_property_as_lisp_data (display, window, property, target_type,
1352 selection_atom)
1353 Display *display;
1354 Window window;
1355 Atom property;
1356 Lisp_Object target_type; /* for error messages only */
1357 Atom selection_atom; /* for error messages only */
1359 Atom actual_type;
1360 int actual_format;
1361 unsigned long actual_size;
1362 unsigned char *data = 0;
1363 int bytes = 0;
1364 Lisp_Object val;
1365 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1367 x_get_window_property (display, window, property, &data, &bytes,
1368 &actual_type, &actual_format, &actual_size, 1);
1369 if (! data)
1371 int there_is_a_selection_owner;
1372 BLOCK_INPUT;
1373 there_is_a_selection_owner
1374 = XGetSelectionOwner (display, selection_atom);
1375 UNBLOCK_INPUT;
1376 Fsignal (Qerror,
1377 there_is_a_selection_owner
1378 ? Fcons (build_string ("selection owner couldn't convert"),
1379 actual_type
1380 ? Fcons (target_type,
1381 Fcons (x_atom_to_symbol (dpyinfo, display,
1382 actual_type),
1383 Qnil))
1384 : Fcons (target_type, Qnil))
1385 : Fcons (build_string ("no selection"),
1386 Fcons (x_atom_to_symbol (dpyinfo, display,
1387 selection_atom),
1388 Qnil)));
1391 if (actual_type == dpyinfo->Xatom_INCR)
1393 /* That wasn't really the data, just the beginning. */
1395 unsigned int min_size_bytes = * ((unsigned int *) data);
1396 BLOCK_INPUT;
1397 /* Use free, not XFree, because x_get_window_property
1398 calls xmalloc itself. */
1399 free ((char *) data);
1400 UNBLOCK_INPUT;
1401 receive_incremental_selection (display, window, property, target_type,
1402 min_size_bytes, &data, &bytes,
1403 &actual_type, &actual_format,
1404 &actual_size);
1407 BLOCK_INPUT;
1408 XDeleteProperty (display, window, property);
1409 XFlush (display);
1410 UNBLOCK_INPUT;
1412 /* It's been read. Now convert it to a lisp object in some semi-rational
1413 manner. */
1414 val = selection_data_to_lisp_data (display, data, bytes,
1415 actual_type, actual_format);
1417 /* Use free, not XFree, because x_get_window_property
1418 calls xmalloc itself. */
1419 free ((char *) data);
1420 return val;
1423 /* These functions convert from the selection data read from the server into
1424 something that we can use from Lisp, and vice versa.
1426 Type: Format: Size: Lisp Type:
1427 ----- ------- ----- -----------
1428 * 8 * String
1429 ATOM 32 1 Symbol
1430 ATOM 32 > 1 Vector of Symbols
1431 * 16 1 Integer
1432 * 16 > 1 Vector of Integers
1433 * 32 1 if <=16 bits: Integer
1434 if > 16 bits: Cons of top16, bot16
1435 * 32 > 1 Vector of the above
1437 When converting a Lisp number to C, it is assumed to be of format 16 if
1438 it is an integer, and of format 32 if it is a cons of two integers.
1440 When converting a vector of numbers from Lisp to C, it is assumed to be
1441 of format 16 if every element in the vector is an integer, and is assumed
1442 to be of format 32 if any element is a cons of two integers.
1444 When converting an object to C, it may be of the form (SYMBOL . <data>)
1445 where SYMBOL is what we should claim that the type is. Format and
1446 representation are as above. */
1450 static Lisp_Object
1451 selection_data_to_lisp_data (display, data, size, type, format)
1452 Display *display;
1453 unsigned char *data;
1454 Atom type;
1455 int size, format;
1457 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1459 if (type == dpyinfo->Xatom_NULL)
1460 return QNULL;
1462 /* Convert any 8-bit data to a string, for compactness. */
1463 else if (format == 8)
1465 Lisp_Object str;
1466 int require_encoding = 0;
1468 /* If TYPE is `TEXT' or `COMPOUND_TEXT', we should decode DATA
1469 to Emacs internal format because DATA may be encoded in
1470 compound text format. In addtion, if TYPE is `STRING' and
1471 DATA contains any 8-bit Latin-1 code, we should also decode
1472 it. */
1473 if (type == dpyinfo->Xatom_TEXT || type == dpyinfo->Xatom_COMPOUND_TEXT)
1474 require_encoding = 1;
1475 else if (type == XA_STRING)
1477 int i;
1478 for (i = 0; i < size; i++)
1480 if (data[i] >= 0x80)
1482 require_encoding = 1;
1483 break;
1487 if (!require_encoding)
1488 str = make_string ((char *) data, size);
1489 else
1491 int bufsize, dummy;
1492 unsigned char *buf;
1493 struct coding_system coding;
1494 Lisp_Object sym = intern ("iso-8859-1");
1496 setup_coding_system (Fcheck_coding_system (sym), &coding);
1497 coding.last_block = 1;
1498 bufsize = decoding_buffer_size (&coding, size);
1499 buf = (unsigned char *) xmalloc (bufsize);
1500 size = decode_coding (&coding, data, buf, size, bufsize, &dummy);
1501 str = make_string ((char *) buf, size);
1502 xfree (buf);
1504 return str;
1506 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1507 a vector of symbols.
1509 else if (type == XA_ATOM)
1511 int i;
1512 if (size == sizeof (Atom))
1513 return x_atom_to_symbol (dpyinfo, display, *((Atom *) data));
1514 else
1516 Lisp_Object v = Fmake_vector (size / sizeof (Atom), 0);
1517 for (i = 0; i < size / sizeof (Atom); i++)
1518 Faset (v, i, x_atom_to_symbol (dpyinfo, display,
1519 ((Atom *) data) [i]));
1520 return v;
1524 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1525 If the number is > 16 bits, convert it to a cons of integers,
1526 16 bits in each half.
1528 else if (format == 32 && size == sizeof (long))
1529 return long_to_cons (((unsigned long *) data) [0]);
1530 else if (format == 16 && size == sizeof (short))
1531 return make_number ((int) (((unsigned short *) data) [0]));
1533 /* Convert any other kind of data to a vector of numbers, represented
1534 as above (as an integer, or a cons of two 16 bit integers.)
1536 else if (format == 16)
1538 int i;
1539 Lisp_Object v = Fmake_vector (size / 4, 0);
1540 for (i = 0; i < size / 4; i++)
1542 int j = (int) ((unsigned short *) data) [i];
1543 Faset (v, i, make_number (j));
1545 return v;
1547 else
1549 int i;
1550 Lisp_Object v = Fmake_vector (size / 4, 0);
1551 for (i = 0; i < size / 4; i++)
1553 unsigned long j = ((unsigned long *) data) [i];
1554 Faset (v, i, long_to_cons (j));
1556 return v;
1561 /* Use free, not XFree, to free the data obtained with this function. */
1563 static void
1564 lisp_data_to_selection_data (display, obj,
1565 data_ret, type_ret, size_ret,
1566 format_ret, nofree_ret)
1567 Display *display;
1568 Lisp_Object obj;
1569 unsigned char **data_ret;
1570 Atom *type_ret;
1571 unsigned int *size_ret;
1572 int *format_ret;
1573 int *nofree_ret;
1575 Lisp_Object type = Qnil;
1576 struct x_display_info *dpyinfo = x_display_info_for_display (display);
1578 *nofree_ret = 0;
1580 if (CONSP (obj) && SYMBOLP (XCONS (obj)->car))
1582 type = XCONS (obj)->car;
1583 obj = XCONS (obj)->cdr;
1584 if (CONSP (obj) && NILP (XCONS (obj)->cdr))
1585 obj = XCONS (obj)->car;
1588 if (EQ (obj, QNULL) || (EQ (type, QNULL)))
1589 { /* This is not the same as declining */
1590 *format_ret = 32;
1591 *size_ret = 0;
1592 *data_ret = 0;
1593 type = QNULL;
1595 else if (STRINGP (obj))
1597 /* Since we are now handling multilingual text, we must consider
1598 sending back compound text. */
1599 char charsets[MAX_CHARSET + 1];
1600 int num;
1602 *format_ret = 8;
1603 *size_ret = XSTRING (obj)->size;
1604 *data_ret = XSTRING (obj)->data;
1605 bzero (charsets, MAX_CHARSET + 1);
1606 num = ((*size_ret <= 1) /* Check the possibility of short cut. */
1608 : find_charset_in_str (*data_ret, *size_ret, charsets, Qnil));
1610 if (!num || (num == 1 && charsets[CHARSET_ASCII]))
1612 /* No multibyte character in OBJ. We need not encode it. */
1613 *nofree_ret = 1;
1614 if (NILP (type)) type = QSTRING;
1616 else
1618 /* We must encode contents of OBJ to compound text format.
1619 The format is compatible with what the target `STRING'
1620 expects if OBJ contains only ASCII and Latin-1
1621 characters. */
1622 int bufsize, dummy;
1623 unsigned char *buf;
1624 struct coding_system coding;
1625 Lisp_Object sym = intern ("iso-8859-1");
1627 setup_coding_system (Fcheck_coding_system (sym), &coding);
1628 coding.last_block = 1;
1629 bufsize = encoding_buffer_size (&coding, *size_ret);
1630 buf = (unsigned char *) xmalloc (bufsize);
1631 *size_ret = encode_coding (&coding, *data_ret, buf,
1632 *size_ret, bufsize, &dummy);
1633 *data_ret = buf;
1634 if (charsets[charset_latin_iso8859_1]
1635 && (num == 1 || (num == 2 && charsets[CHARSET_ASCII])))
1637 /* Ok, we can return it as `STRING'. */
1638 if (NILP (type)) type = QSTRING;
1640 else
1642 /* We must return it as `COMPOUND_TEXT'. */
1643 if (NILP (type)) type = QCOMPOUND_TEXT;
1647 else if (SYMBOLP (obj))
1649 *format_ret = 32;
1650 *size_ret = 1;
1651 *data_ret = (unsigned char *) xmalloc (sizeof (Atom) + 1);
1652 (*data_ret) [sizeof (Atom)] = 0;
1653 (*(Atom **) data_ret) [0] = symbol_to_x_atom (dpyinfo, display, obj);
1654 if (NILP (type)) type = QATOM;
1656 else if (INTEGERP (obj)
1657 && XINT (obj) < 0xFFFF
1658 && XINT (obj) > -0xFFFF)
1660 *format_ret = 16;
1661 *size_ret = 1;
1662 *data_ret = (unsigned char *) xmalloc (sizeof (short) + 1);
1663 (*data_ret) [sizeof (short)] = 0;
1664 (*(short **) data_ret) [0] = (short) XINT (obj);
1665 if (NILP (type)) type = QINTEGER;
1667 else if (INTEGERP (obj)
1668 || (CONSP (obj) && INTEGERP (XCONS (obj)->car)
1669 && (INTEGERP (XCONS (obj)->cdr)
1670 || (CONSP (XCONS (obj)->cdr)
1671 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)))))
1673 *format_ret = 32;
1674 *size_ret = 1;
1675 *data_ret = (unsigned char *) xmalloc (sizeof (long) + 1);
1676 (*data_ret) [sizeof (long)] = 0;
1677 (*(unsigned long **) data_ret) [0] = cons_to_long (obj);
1678 if (NILP (type)) type = QINTEGER;
1680 else if (VECTORP (obj))
1682 /* Lisp_Vectors may represent a set of ATOMs;
1683 a set of 16 or 32 bit INTEGERs;
1684 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1686 int i;
1688 if (SYMBOLP (XVECTOR (obj)->contents [0]))
1689 /* This vector is an ATOM set */
1691 if (NILP (type)) type = QATOM;
1692 *size_ret = XVECTOR (obj)->size;
1693 *format_ret = 32;
1694 *data_ret = (unsigned char *) xmalloc ((*size_ret) * sizeof (Atom));
1695 for (i = 0; i < *size_ret; i++)
1696 if (SYMBOLP (XVECTOR (obj)->contents [i]))
1697 (*(Atom **) data_ret) [i]
1698 = symbol_to_x_atom (dpyinfo, display, XVECTOR (obj)->contents [i]);
1699 else
1700 Fsignal (Qerror, /* Qselection_error */
1701 Fcons (build_string
1702 ("all elements of selection vector must have same type"),
1703 Fcons (obj, Qnil)));
1705 #if 0 /* #### MULTIPLE doesn't work yet */
1706 else if (VECTORP (XVECTOR (obj)->contents [0]))
1707 /* This vector is an ATOM_PAIR set */
1709 if (NILP (type)) type = QATOM_PAIR;
1710 *size_ret = XVECTOR (obj)->size;
1711 *format_ret = 32;
1712 *data_ret = (unsigned char *)
1713 xmalloc ((*size_ret) * sizeof (Atom) * 2);
1714 for (i = 0; i < *size_ret; i++)
1715 if (VECTORP (XVECTOR (obj)->contents [i]))
1717 Lisp_Object pair = XVECTOR (obj)->contents [i];
1718 if (XVECTOR (pair)->size != 2)
1719 Fsignal (Qerror,
1720 Fcons (build_string
1721 ("elements of the vector must be vectors of exactly two elements"),
1722 Fcons (pair, Qnil)));
1724 (*(Atom **) data_ret) [i * 2]
1725 = symbol_to_x_atom (dpyinfo, display,
1726 XVECTOR (pair)->contents [0]);
1727 (*(Atom **) data_ret) [(i * 2) + 1]
1728 = symbol_to_x_atom (dpyinfo, display,
1729 XVECTOR (pair)->contents [1]);
1731 else
1732 Fsignal (Qerror,
1733 Fcons (build_string
1734 ("all elements of the vector must be of the same type"),
1735 Fcons (obj, Qnil)));
1738 #endif
1739 else
1740 /* This vector is an INTEGER set, or something like it */
1742 *size_ret = XVECTOR (obj)->size;
1743 if (NILP (type)) type = QINTEGER;
1744 *format_ret = 16;
1745 for (i = 0; i < *size_ret; i++)
1746 if (CONSP (XVECTOR (obj)->contents [i]))
1747 *format_ret = 32;
1748 else if (!INTEGERP (XVECTOR (obj)->contents [i]))
1749 Fsignal (Qerror, /* Qselection_error */
1750 Fcons (build_string
1751 ("elements of selection vector must be integers or conses of integers"),
1752 Fcons (obj, Qnil)));
1754 *data_ret = (unsigned char *) xmalloc (*size_ret * (*format_ret/8));
1755 for (i = 0; i < *size_ret; i++)
1756 if (*format_ret == 32)
1757 (*((unsigned long **) data_ret)) [i]
1758 = cons_to_long (XVECTOR (obj)->contents [i]);
1759 else
1760 (*((unsigned short **) data_ret)) [i]
1761 = (unsigned short) cons_to_long (XVECTOR (obj)->contents [i]);
1764 else
1765 Fsignal (Qerror, /* Qselection_error */
1766 Fcons (build_string ("unrecognised selection data"),
1767 Fcons (obj, Qnil)));
1769 *type_ret = symbol_to_x_atom (dpyinfo, display, type);
1772 static Lisp_Object
1773 clean_local_selection_data (obj)
1774 Lisp_Object obj;
1776 if (CONSP (obj)
1777 && INTEGERP (XCONS (obj)->car)
1778 && CONSP (XCONS (obj)->cdr)
1779 && INTEGERP (XCONS (XCONS (obj)->cdr)->car)
1780 && NILP (XCONS (XCONS (obj)->cdr)->cdr))
1781 obj = Fcons (XCONS (obj)->car, XCONS (obj)->cdr);
1783 if (CONSP (obj)
1784 && INTEGERP (XCONS (obj)->car)
1785 && INTEGERP (XCONS (obj)->cdr))
1787 if (XINT (XCONS (obj)->car) == 0)
1788 return XCONS (obj)->cdr;
1789 if (XINT (XCONS (obj)->car) == -1)
1790 return make_number (- XINT (XCONS (obj)->cdr));
1792 if (VECTORP (obj))
1794 int i;
1795 int size = XVECTOR (obj)->size;
1796 Lisp_Object copy;
1797 if (size == 1)
1798 return clean_local_selection_data (XVECTOR (obj)->contents [0]);
1799 copy = Fmake_vector (size, Qnil);
1800 for (i = 0; i < size; i++)
1801 XVECTOR (copy)->contents [i]
1802 = clean_local_selection_data (XVECTOR (obj)->contents [i]);
1803 return copy;
1805 return obj;
1808 /* Called from XTread_socket to handle SelectionNotify events.
1809 If it's the selection we are waiting for, stop waiting
1810 by setting the car of reading_selection_reply to non-nil.
1811 We store t there if the reply is successful, lambda if not. */
1813 void
1814 x_handle_selection_notify (event)
1815 XSelectionEvent *event;
1817 if (event->requestor != reading_selection_window)
1818 return;
1819 if (event->selection != reading_which_selection)
1820 return;
1822 XCONS (reading_selection_reply)->car
1823 = (event->property != 0 ? Qt : Qlambda);
1827 DEFUN ("x-own-selection-internal", Fx_own_selection_internal,
1828 Sx_own_selection_internal, 2, 2, 0,
1829 "Assert an X selection of the given TYPE with the given VALUE.\n\
1830 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1831 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1832 VALUE is typically a string, or a cons of two markers, but may be\n\
1833 anything that the functions on `selection-converter-alist' know about.")
1834 (selection_name, selection_value)
1835 Lisp_Object selection_name, selection_value;
1837 check_x ();
1838 CHECK_SYMBOL (selection_name, 0);
1839 if (NILP (selection_value)) error ("selection-value may not be nil");
1840 x_own_selection (selection_name, selection_value);
1841 return selection_value;
1845 /* Request the selection value from the owner. If we are the owner,
1846 simply return our selection value. If we are not the owner, this
1847 will block until all of the data has arrived. */
1849 DEFUN ("x-get-selection-internal", Fx_get_selection_internal,
1850 Sx_get_selection_internal, 2, 2, 0,
1851 "Return text selected from some X window.\n\
1852 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1853 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1854 TYPE is the type of data desired, typically `STRING'.")
1855 (selection_symbol, target_type)
1856 Lisp_Object selection_symbol, target_type;
1858 Lisp_Object val = Qnil;
1859 struct gcpro gcpro1, gcpro2;
1860 GCPRO2 (target_type, val); /* we store newly consed data into these */
1861 check_x ();
1862 CHECK_SYMBOL (selection_symbol, 0);
1864 #if 0 /* #### MULTIPLE doesn't work yet */
1865 if (CONSP (target_type)
1866 && XCONS (target_type)->car == QMULTIPLE)
1868 CHECK_VECTOR (XCONS (target_type)->cdr, 0);
1869 /* So we don't destructively modify this... */
1870 target_type = copy_multiple_data (target_type);
1872 else
1873 #endif
1874 CHECK_SYMBOL (target_type, 0);
1876 val = x_get_local_selection (selection_symbol, target_type);
1878 if (NILP (val))
1880 val = x_get_foreign_selection (selection_symbol, target_type);
1881 goto DONE;
1884 if (CONSP (val)
1885 && SYMBOLP (XCONS (val)->car))
1887 val = XCONS (val)->cdr;
1888 if (CONSP (val) && NILP (XCONS (val)->cdr))
1889 val = XCONS (val)->car;
1891 val = clean_local_selection_data (val);
1892 DONE:
1893 UNGCPRO;
1894 return val;
1897 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal,
1898 Sx_disown_selection_internal, 1, 2, 0,
1899 "If we own the selection SELECTION, disown it.\n\
1900 Disowning it means there is no such selection.")
1901 (selection, time)
1902 Lisp_Object selection;
1903 Lisp_Object time;
1905 Time timestamp;
1906 Atom selection_atom;
1907 XSelectionClearEvent event;
1908 Display *display;
1909 struct x_display_info *dpyinfo;
1911 check_x ();
1912 display = FRAME_X_DISPLAY (selected_frame);
1913 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
1914 CHECK_SYMBOL (selection, 0);
1915 if (NILP (time))
1916 timestamp = last_event_timestamp;
1917 else
1918 timestamp = cons_to_long (time);
1920 if (NILP (assq_no_quit (selection, Vselection_alist)))
1921 return Qnil; /* Don't disown the selection when we're not the owner. */
1923 selection_atom = symbol_to_x_atom (dpyinfo, display, selection);
1925 BLOCK_INPUT;
1926 XSetSelectionOwner (display, selection_atom, None, timestamp);
1927 UNBLOCK_INPUT;
1929 /* It doesn't seem to be guaranteed that a SelectionClear event will be
1930 generated for a window which owns the selection when that window sets
1931 the selection owner to None. The NCD server does, the MIT Sun4 server
1932 doesn't. So we synthesize one; this means we might get two, but
1933 that's ok, because the second one won't have any effect. */
1934 SELECTION_EVENT_DISPLAY (&event) = display;
1935 SELECTION_EVENT_SELECTION (&event) = selection_atom;
1936 SELECTION_EVENT_TIME (&event) = timestamp;
1937 x_handle_selection_clear (&event);
1939 return Qt;
1942 /* Get rid of all the selections in buffer BUFFER.
1943 This is used when we kill a buffer. */
1945 void
1946 x_disown_buffer_selections (buffer)
1947 Lisp_Object buffer;
1949 Lisp_Object tail;
1950 struct buffer *buf = XBUFFER (buffer);
1952 for (tail = Vselection_alist; CONSP (tail); tail = XCONS (tail)->cdr)
1954 Lisp_Object elt, value;
1955 elt = XCONS (tail)->car;
1956 value = XCONS (elt)->cdr;
1957 if (CONSP (value) && MARKERP (XCONS (value)->car)
1958 && XMARKER (XCONS (value)->car)->buffer == buf)
1959 Fx_disown_selection_internal (XCONS (elt)->car, Qnil);
1963 DEFUN ("x-selection-owner-p", Fx_selection_owner_p, Sx_selection_owner_p,
1964 0, 1, 0,
1965 "Whether the current Emacs process owns the given X Selection.\n\
1966 The arg should be the name of the selection in question, typically one of\n\
1967 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1968 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1969 For convenience, the symbol nil is the same as `PRIMARY',\n\
1970 and t is the same as `SECONDARY'.)")
1971 (selection)
1972 Lisp_Object selection;
1974 check_x ();
1975 CHECK_SYMBOL (selection, 0);
1976 if (EQ (selection, Qnil)) selection = QPRIMARY;
1977 if (EQ (selection, Qt)) selection = QSECONDARY;
1979 if (NILP (Fassq (selection, Vselection_alist)))
1980 return Qnil;
1981 return Qt;
1984 DEFUN ("x-selection-exists-p", Fx_selection_exists_p, Sx_selection_exists_p,
1985 0, 1, 0,
1986 "Whether there is an owner for the given X Selection.\n\
1987 The arg should be the name of the selection in question, typically one of\n\
1988 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.\n\
1989 \(Those are literal upper-case symbol names, since that's what X expects.)\n\
1990 For convenience, the symbol nil is the same as `PRIMARY',\n\
1991 and t is the same as `SECONDARY'.)")
1992 (selection)
1993 Lisp_Object selection;
1995 Window owner;
1996 Atom atom;
1997 Display *dpy;
1999 /* It should be safe to call this before we have an X frame. */
2000 if (! FRAME_X_P (selected_frame))
2001 return Qnil;
2003 dpy = FRAME_X_DISPLAY (selected_frame);
2004 CHECK_SYMBOL (selection, 0);
2005 if (!NILP (Fx_selection_owner_p (selection)))
2006 return Qt;
2007 if (EQ (selection, Qnil)) selection = QPRIMARY;
2008 if (EQ (selection, Qt)) selection = QSECONDARY;
2009 atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
2010 dpy, selection);
2011 if (atom == 0)
2012 return Qnil;
2013 BLOCK_INPUT;
2014 owner = XGetSelectionOwner (dpy, atom);
2015 UNBLOCK_INPUT;
2016 return (owner ? Qt : Qnil);
2020 #ifdef CUT_BUFFER_SUPPORT
2022 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2023 static void
2024 initialize_cut_buffers (display, window)
2025 Display *display;
2026 Window window;
2028 unsigned char *data = (unsigned char *) "";
2029 BLOCK_INPUT;
2030 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2031 PropModeAppend, data, 0)
2032 FROB (XA_CUT_BUFFER0);
2033 FROB (XA_CUT_BUFFER1);
2034 FROB (XA_CUT_BUFFER2);
2035 FROB (XA_CUT_BUFFER3);
2036 FROB (XA_CUT_BUFFER4);
2037 FROB (XA_CUT_BUFFER5);
2038 FROB (XA_CUT_BUFFER6);
2039 FROB (XA_CUT_BUFFER7);
2040 #undef FROB
2041 UNBLOCK_INPUT;
2045 #define CHECK_CUT_BUFFER(symbol,n) \
2046 { CHECK_SYMBOL ((symbol), (n)); \
2047 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2048 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2049 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2050 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2051 Fsignal (Qerror, \
2052 Fcons (build_string ("doesn't name a cut buffer"), \
2053 Fcons ((symbol), Qnil))); \
2056 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal,
2057 Sx_get_cut_buffer_internal, 1, 1, 0,
2058 "Returns the value of the named cut buffer (typically CUT_BUFFER0).")
2059 (buffer)
2060 Lisp_Object buffer;
2062 Window window;
2063 Atom buffer_atom;
2064 unsigned char *data;
2065 int bytes;
2066 Atom type;
2067 int format;
2068 unsigned long size;
2069 Lisp_Object ret;
2070 Display *display;
2071 struct x_display_info *dpyinfo;
2073 check_x ();
2074 display = FRAME_X_DISPLAY (selected_frame);
2075 dpyinfo = FRAME_X_DISPLAY_INFO (selected_frame);
2076 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2077 CHECK_CUT_BUFFER (buffer, 0);
2078 buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer);
2080 x_get_window_property (display, window, buffer_atom, &data, &bytes,
2081 &type, &format, &size, 0);
2082 if (!data) return Qnil;
2084 if (format != 8 || type != XA_STRING)
2085 Fsignal (Qerror,
2086 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2087 Fcons (x_atom_to_symbol (dpyinfo, display, type),
2088 Fcons (make_number (format), Qnil))));
2090 ret = (bytes ? make_string ((char *) data, bytes) : Qnil);
2091 /* Use free, not XFree, because x_get_window_property
2092 calls xmalloc itself. */
2093 free (data);
2094 return ret;
2098 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal,
2099 Sx_store_cut_buffer_internal, 2, 2, 0,
2100 "Sets the value of the named cut buffer (typically CUT_BUFFER0).")
2101 (buffer, string)
2102 Lisp_Object buffer, string;
2104 Window window;
2105 Atom buffer_atom;
2106 unsigned char *data;
2107 int bytes;
2108 int bytes_remaining;
2109 int max_bytes;
2110 Display *display;
2112 check_x ();
2113 display = FRAME_X_DISPLAY (selected_frame);
2114 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2116 max_bytes = SELECTION_QUANTUM (display);
2117 if (max_bytes > MAX_SELECTION_QUANTUM)
2118 max_bytes = MAX_SELECTION_QUANTUM;
2120 CHECK_CUT_BUFFER (buffer, 0);
2121 CHECK_STRING (string, 0);
2122 buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (selected_frame),
2123 display, buffer);
2124 data = (unsigned char *) XSTRING (string)->data;
2125 bytes = XSTRING (string)->size;
2126 bytes_remaining = bytes;
2128 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2130 initialize_cut_buffers (display, window);
2131 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2134 BLOCK_INPUT;
2136 /* Don't mess up with an empty value. */
2137 if (!bytes_remaining)
2138 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2139 PropModeReplace, data, 0);
2141 while (bytes_remaining)
2143 int chunk = (bytes_remaining < max_bytes
2144 ? bytes_remaining : max_bytes);
2145 XChangeProperty (display, window, buffer_atom, XA_STRING, 8,
2146 (bytes_remaining == bytes
2147 ? PropModeReplace
2148 : PropModeAppend),
2149 data, chunk);
2150 data += chunk;
2151 bytes_remaining -= chunk;
2153 UNBLOCK_INPUT;
2154 return string;
2158 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal,
2159 Sx_rotate_cut_buffers_internal, 1, 1, 0,
2160 "Rotate the values of the cut buffers by the given number of steps;\n\
2161 positive means move values forward, negative means backward.")
2163 Lisp_Object n;
2165 Window window;
2166 Atom props[8];
2167 Display *display;
2169 check_x ();
2170 display = FRAME_X_DISPLAY (selected_frame);
2171 window = RootWindow (display, 0); /* Cut buffers are on screen 0 */
2172 CHECK_NUMBER (n, 0);
2173 if (XINT (n) == 0)
2174 return n;
2175 if (! FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized)
2177 initialize_cut_buffers (display, window);
2178 FRAME_X_DISPLAY_INFO (selected_frame)->cut_buffers_initialized = 1;
2181 props[0] = XA_CUT_BUFFER0;
2182 props[1] = XA_CUT_BUFFER1;
2183 props[2] = XA_CUT_BUFFER2;
2184 props[3] = XA_CUT_BUFFER3;
2185 props[4] = XA_CUT_BUFFER4;
2186 props[5] = XA_CUT_BUFFER5;
2187 props[6] = XA_CUT_BUFFER6;
2188 props[7] = XA_CUT_BUFFER7;
2189 BLOCK_INPUT;
2190 XRotateWindowProperties (display, window, props, 8, XINT (n));
2191 UNBLOCK_INPUT;
2192 return n;
2195 #endif
2197 void
2198 syms_of_xselect ()
2200 defsubr (&Sx_get_selection_internal);
2201 defsubr (&Sx_own_selection_internal);
2202 defsubr (&Sx_disown_selection_internal);
2203 defsubr (&Sx_selection_owner_p);
2204 defsubr (&Sx_selection_exists_p);
2206 #ifdef CUT_BUFFER_SUPPORT
2207 defsubr (&Sx_get_cut_buffer_internal);
2208 defsubr (&Sx_store_cut_buffer_internal);
2209 defsubr (&Sx_rotate_cut_buffers_internal);
2210 #endif
2212 reading_selection_reply = Fcons (Qnil, Qnil);
2213 staticpro (&reading_selection_reply);
2214 reading_selection_window = 0;
2215 reading_which_selection = 0;
2217 property_change_wait_list = 0;
2218 prop_location_identifier = 0;
2219 property_change_reply = Fcons (Qnil, Qnil);
2220 staticpro (&property_change_reply);
2222 Vselection_alist = Qnil;
2223 staticpro (&Vselection_alist);
2225 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist,
2226 "An alist associating X Windows selection-types with functions.\n\
2227 These functions are called to convert the selection, with three args:\n\
2228 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2229 a desired type to which the selection should be converted;\n\
2230 and the local selection value (whatever was given to `x-own-selection').\n\
2232 The function should return the value to send to the X server\n\
2233 \(typically a string). A return value of nil\n\
2234 means that the conversion could not be done.\n\
2235 A return value which is the symbol `NULL'\n\
2236 means that a side-effect was executed,\n\
2237 and there is no meaningful selection value.");
2238 Vselection_converter_alist = Qnil;
2240 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks,
2241 "A list of functions to be called when Emacs loses an X selection.\n\
2242 \(This happens when some other X client makes its own selection\n\
2243 or when a Lisp program explicitly clears the selection.)\n\
2244 The functions are called with one argument, the selection type\n\
2245 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD').");
2246 Vx_lost_selection_hooks = Qnil;
2248 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks,
2249 "A list of functions to be called when Emacs answers a selection request.\n\
2250 The functions are called with four arguments:\n\
2251 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');\n\
2252 - the selection-type which Emacs was asked to convert the\n\
2253 selection into before sending (for example, `STRING' or `LENGTH');\n\
2254 - a flag indicating success or failure for responding to the request.\n\
2255 We might have failed (and declined the request) for any number of reasons,\n\
2256 including being asked for a selection that we no longer own, or being asked\n\
2257 to convert into a type that we don't know about or that is inappropriate.\n\
2258 This hook doesn't let you change the behavior of Emacs's selection replies,\n\
2259 it merely informs you that they have happened.");
2260 Vx_sent_selection_hooks = Qnil;
2262 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout,
2263 "Number of milliseconds to wait for a selection reply.\n\
2264 If the selection owner doesn't reply in this time, we give up.\n\
2265 A value of 0 means wait as long as necessary. This is initialized from the\n\
2266 \"*selectionTimeout\" resource.");
2267 x_selection_timeout = 0;
2269 QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY);
2270 QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY);
2271 QSTRING = intern ("STRING"); staticpro (&QSTRING);
2272 QINTEGER = intern ("INTEGER"); staticpro (&QINTEGER);
2273 QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD);
2274 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2275 QTEXT = intern ("TEXT"); staticpro (&QTEXT);
2276 QCOMPOUND_TEXT = intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT);
2277 QTIMESTAMP = intern ("TIMESTAMP"); staticpro (&QTIMESTAMP);
2278 QDELETE = intern ("DELETE"); staticpro (&QDELETE);
2279 QMULTIPLE = intern ("MULTIPLE"); staticpro (&QMULTIPLE);
2280 QINCR = intern ("INCR"); staticpro (&QINCR);
2281 QEMACS_TMP = intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP);
2282 QTARGETS = intern ("TARGETS"); staticpro (&QTARGETS);
2283 QATOM = intern ("ATOM"); staticpro (&QATOM);
2284 QATOM_PAIR = intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR);
2285 QNULL = intern ("NULL"); staticpro (&QNULL);
2287 #ifdef CUT_BUFFER_SUPPORT
2288 QCUT_BUFFER0 = intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0);
2289 QCUT_BUFFER1 = intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1);
2290 QCUT_BUFFER2 = intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2);
2291 QCUT_BUFFER3 = intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3);
2292 QCUT_BUFFER4 = intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4);
2293 QCUT_BUFFER5 = intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5);
2294 QCUT_BUFFER6 = intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6);
2295 QCUT_BUFFER7 = intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7);
2296 #endif