1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 /* Rewritten by jwz */
26 #include <stdio.h> /* termhooks.h needs this */
28 #include "xterm.h" /* for all of the X includes */
29 #include "dispextern.h" /* frame.h seems to want this */
30 #include "frame.h" /* Need this to get the X window of selected_frame */
31 #include "blockinput.h"
34 #include "termhooks.h"
36 #include <X11/Xproto.h>
40 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
41 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
43 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
44 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
45 static void x_decline_selection_request
P_ ((struct input_event
*));
46 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
47 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
48 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
49 static void x_reply_selection_request
P_ ((struct input_event
*, int,
50 unsigned char *, int, Atom
));
51 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
52 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
54 static void unexpect_property_change
P_ ((struct prop_location
*));
55 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
56 static void wait_for_property_change
P_ ((struct prop_location
*));
57 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
, Lisp_Object
));
58 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
59 unsigned char **, int *,
60 Atom
*, int *, unsigned long *, int));
61 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
62 Lisp_Object
, unsigned,
63 unsigned char **, int *,
64 Atom
*, int *, unsigned long *));
65 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
68 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
70 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
71 unsigned char **, Atom
*,
72 unsigned *, int *, int *));
73 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
74 static void initialize_cut_buffers
P_ ((Display
*, Window
));
77 /* Printing traces to stderr. */
79 #ifdef TRACE_SELECTION
81 fprintf (stderr, "%d: " fmt "\n", getpid ())
82 #define TRACE1(fmt, a0) \
83 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
84 #define TRACE2(fmt, a0, a1) \
85 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
87 #define TRACE0(fmt) (void) 0
88 #define TRACE1(fmt, a0) (void) 0
89 #define TRACE2(fmt, a0, a1) (void) 0
93 #define CUT_BUFFER_SUPPORT
95 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
96 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
99 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
100 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
102 Lisp_Object Qcompound_text_with_extensions
;
104 #ifdef CUT_BUFFER_SUPPORT
105 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
106 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
109 static Lisp_Object Vx_lost_selection_hooks
;
110 static Lisp_Object Vx_sent_selection_hooks
;
111 /* Coding system for communicating with other X clients via cutbuffer,
112 selection, and clipboard. */
113 static Lisp_Object Vselection_coding_system
;
115 /* Coding system for the next communicating with other X clients. */
116 static Lisp_Object Vnext_selection_coding_system
;
118 static Lisp_Object Qforeign_selection
;
120 /* If this is a smaller number than the max-request-size of the display,
121 emacs will use INCR selection transfer when the selection is larger
122 than this. The max-request-size is usually around 64k, so if you want
123 emacs to use incremental selection transfers when the selection is
124 smaller than that, set this. I added this mostly for debugging the
125 incremental transfer stuff, but it might improve server performance. */
126 #define MAX_SELECTION_QUANTUM 0xFFFFFF
129 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
131 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
134 /* The timestamp of the last input event Emacs received from the X server. */
135 /* Defined in keyboard.c. */
136 extern unsigned long last_event_timestamp
;
138 /* This is an association list whose elements are of the form
139 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
140 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
141 SELECTION-VALUE is the value that emacs owns for that selection.
142 It may be any kind of Lisp object.
143 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
144 as a cons of two 16-bit numbers (making a 32 bit time.)
145 FRAME is the frame for which we made the selection.
146 If there is an entry in this alist, then it can be assumed that Emacs owns
148 The only (eq) parts of this list that are visible from Lisp are the
150 static Lisp_Object Vselection_alist
;
152 /* This is an alist whose CARs are selection-types (whose names are the same
153 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
154 call to convert the given Emacs selection value to a string representing
155 the given selection type. This is for Lisp-level extension of the emacs
156 selection handling. */
157 static Lisp_Object Vselection_converter_alist
;
159 /* If the selection owner takes too long to reply to a selection request,
160 we give up on it. This is in milliseconds (0 = no timeout.) */
161 static EMACS_INT x_selection_timeout
;
163 /* Utility functions */
165 static void lisp_data_to_selection_data ();
166 static Lisp_Object
selection_data_to_lisp_data ();
167 static Lisp_Object
x_get_window_property_as_lisp_data ();
169 /* This converts a Lisp symbol to a server Atom, avoiding a server
170 roundtrip whenever possible. */
173 symbol_to_x_atom (dpyinfo
, display
, sym
)
174 struct x_display_info
*dpyinfo
;
179 if (NILP (sym
)) return 0;
180 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
181 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
182 if (EQ (sym
, QSTRING
)) return XA_STRING
;
183 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
184 if (EQ (sym
, QATOM
)) return XA_ATOM
;
185 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
186 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
187 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
188 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
189 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
190 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
191 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
192 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
193 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
194 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
195 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
196 #ifdef CUT_BUFFER_SUPPORT
197 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
198 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
199 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
200 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
201 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
202 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
203 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
204 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
206 if (!SYMBOLP (sym
)) abort ();
208 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
210 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
216 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
217 and calls to intern whenever possible. */
220 x_atom_to_symbol (dpy
, atom
)
224 struct x_display_info
*dpyinfo
;
243 #ifdef CUT_BUFFER_SUPPORT
263 dpyinfo
= x_display_info_for_display (dpy
);
264 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
266 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
268 if (atom
== dpyinfo
->Xatom_TEXT
)
270 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
271 return QCOMPOUND_TEXT
;
272 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
274 if (atom
== dpyinfo
->Xatom_DELETE
)
276 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
278 if (atom
== dpyinfo
->Xatom_INCR
)
280 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
282 if (atom
== dpyinfo
->Xatom_TARGETS
)
284 if (atom
== dpyinfo
->Xatom_NULL
)
288 str
= XGetAtomName (dpy
, atom
);
290 TRACE1 ("XGetAtomName --> %s", str
);
291 if (! str
) return Qnil
;
294 /* This was allocated by Xlib, so use XFree. */
300 /* Do protocol to assert ourself as a selection owner.
301 Update the Vselection_alist so that we can reply to later requests for
305 x_own_selection (selection_name
, selection_value
)
306 Lisp_Object selection_name
, selection_value
;
308 struct frame
*sf
= SELECTED_FRAME ();
309 Window selecting_window
= FRAME_X_WINDOW (sf
);
310 Display
*display
= FRAME_X_DISPLAY (sf
);
311 Time time
= last_event_timestamp
;
313 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
316 CHECK_SYMBOL (selection_name
);
317 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
320 count
= x_catch_errors (display
);
321 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
322 x_check_errors (display
, "Can't set selection: %s");
323 x_uncatch_errors (display
, count
);
326 /* Now update the local cache */
328 Lisp_Object selection_time
;
329 Lisp_Object selection_data
;
330 Lisp_Object prev_value
;
332 selection_time
= long_to_cons ((unsigned long) time
);
333 selection_data
= Fcons (selection_name
,
334 Fcons (selection_value
,
335 Fcons (selection_time
,
336 Fcons (selected_frame
, Qnil
))));
337 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
339 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
341 /* If we already owned the selection, remove the old selection data.
342 Perhaps we should destructively modify it instead.
343 Don't use Fdelq as that may QUIT. */
344 if (!NILP (prev_value
))
346 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
347 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
348 if (EQ (prev_value
, Fcar (XCDR (rest
))))
350 XSETCDR (rest
, Fcdr (XCDR (rest
)));
357 /* Given a selection-name and desired type, look up our local copy of
358 the selection value and convert it to the type.
359 The value is nil or a string.
360 This function is used both for remote requests (LOCAL_REQUEST is zero)
361 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
363 This calls random Lisp code, and may signal or gc. */
366 x_get_local_selection (selection_symbol
, target_type
, local_request
)
367 Lisp_Object selection_symbol
, target_type
;
370 Lisp_Object local_value
;
371 Lisp_Object handler_fn
, value
, type
, check
;
374 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
376 if (NILP (local_value
)) return Qnil
;
378 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
379 if (EQ (target_type
, QTIMESTAMP
))
382 value
= XCAR (XCDR (XCDR (local_value
)));
385 else if (EQ (target_type
, QDELETE
))
388 Fx_disown_selection_internal
390 XCAR (XCDR (XCDR (local_value
))));
395 #if 0 /* #### MULTIPLE doesn't work yet */
396 else if (CONSP (target_type
)
397 && XCAR (target_type
) == QMULTIPLE
)
402 pairs
= XCDR (target_type
);
403 size
= XVECTOR (pairs
)->size
;
404 /* If the target is MULTIPLE, then target_type looks like
405 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
406 We modify the second element of each pair in the vector and
407 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
409 for (i
= 0; i
< size
; i
++)
412 pair
= XVECTOR (pairs
)->contents
[i
];
413 XVECTOR (pair
)->contents
[1]
414 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
415 XVECTOR (pair
)->contents
[1],
423 /* Don't allow a quit within the converter.
424 When the user types C-g, he would be surprised
425 if by luck it came during a converter. */
426 count
= SPECPDL_INDEX ();
427 specbind (Qinhibit_quit
, Qt
);
429 CHECK_SYMBOL (target_type
);
430 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
431 /* gcpro is not needed here since nothing but HANDLER_FN
432 is live, and that ought to be a symbol. */
434 if (!NILP (handler_fn
))
435 value
= call3 (handler_fn
,
436 selection_symbol
, (local_request
? Qnil
: target_type
),
437 XCAR (XCDR (local_value
)));
440 unbind_to (count
, Qnil
);
443 /* Make sure this value is of a type that we could transmit
444 to another X client. */
448 && SYMBOLP (XCAR (value
)))
450 check
= XCDR (value
);
458 /* Check for a value that cons_to_long could handle. */
459 else if (CONSP (check
)
460 && INTEGERP (XCAR (check
))
461 && (INTEGERP (XCDR (check
))
463 (CONSP (XCDR (check
))
464 && INTEGERP (XCAR (XCDR (check
)))
465 && NILP (XCDR (XCDR (check
))))))
470 Fcons (build_string ("invalid data returned by selection-conversion function"),
471 Fcons (handler_fn
, Fcons (value
, Qnil
))));
474 /* Subroutines of x_reply_selection_request. */
476 /* Send a SelectionNotify event to the requestor with property=None,
477 meaning we were unable to do what they wanted. */
480 x_decline_selection_request (event
)
481 struct input_event
*event
;
483 XSelectionEvent reply
;
486 reply
.type
= SelectionNotify
;
487 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
488 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
489 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
490 reply
.time
= SELECTION_EVENT_TIME (event
);
491 reply
.target
= SELECTION_EVENT_TARGET (event
);
492 reply
.property
= None
;
494 /* The reason for the error may be that the receiver has
495 died in the meantime. Handle that case. */
497 count
= x_catch_errors (reply
.display
);
498 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
499 XFlush (reply
.display
);
500 x_uncatch_errors (reply
.display
, count
);
504 /* This is the selection request currently being processed.
505 It is set to zero when the request is fully processed. */
506 static struct input_event
*x_selection_current_request
;
508 /* Display info in x_selection_request. */
510 static struct x_display_info
*selection_request_dpyinfo
;
512 /* Used as an unwind-protect clause so that, if a selection-converter signals
513 an error, we tell the requester that we were unable to do what they wanted
514 before we throw to top-level or go into the debugger or whatever. */
517 x_selection_request_lisp_error (ignore
)
520 if (x_selection_current_request
!= 0
521 && selection_request_dpyinfo
->display
)
522 x_decline_selection_request (x_selection_current_request
);
527 /* This stuff is so that INCR selections are reentrant (that is, so we can
528 be servicing multiple INCR selection requests simultaneously.) I haven't
529 actually tested that yet. */
531 /* Keep a list of the property changes that are awaited. */
541 struct prop_location
*next
;
544 static struct prop_location
*expect_property_change ();
545 static void wait_for_property_change ();
546 static void unexpect_property_change ();
547 static int waiting_for_other_props_on_window ();
549 static int prop_location_identifier
;
551 static Lisp_Object property_change_reply
;
553 static struct prop_location
*property_change_reply_object
;
555 static struct prop_location
*property_change_wait_list
;
558 queue_selection_requests_unwind (frame
)
561 FRAME_PTR f
= XFRAME (frame
);
564 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
568 /* Return some frame whose display info is DPYINFO.
569 Return nil if there is none. */
572 some_frame_on_display (dpyinfo
)
573 struct x_display_info
*dpyinfo
;
575 Lisp_Object list
, frame
;
577 FOR_EACH_FRAME (list
, frame
)
579 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
586 /* Send the reply to a selection request event EVENT.
587 TYPE is the type of selection data requested.
588 DATA and SIZE describe the data to send, already converted.
589 FORMAT is the unit-size (in bits) of the data to be transmitted. */
592 x_reply_selection_request (event
, format
, data
, size
, type
)
593 struct input_event
*event
;
598 XSelectionEvent reply
;
599 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
600 Window window
= SELECTION_EVENT_REQUESTOR (event
);
602 int format_bytes
= format
/8;
603 int max_bytes
= SELECTION_QUANTUM (display
);
604 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
607 if (max_bytes
> MAX_SELECTION_QUANTUM
)
608 max_bytes
= MAX_SELECTION_QUANTUM
;
610 reply
.type
= SelectionNotify
;
611 reply
.display
= display
;
612 reply
.requestor
= window
;
613 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
614 reply
.time
= SELECTION_EVENT_TIME (event
);
615 reply
.target
= SELECTION_EVENT_TARGET (event
);
616 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
617 if (reply
.property
== None
)
618 reply
.property
= reply
.target
;
620 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
622 count
= x_catch_errors (display
);
624 /* Store the data on the requested property.
625 If the selection is large, only store the first N bytes of it.
627 bytes_remaining
= size
* format_bytes
;
628 if (bytes_remaining
<= max_bytes
)
630 /* Send all the data at once, with minimal handshaking. */
631 TRACE1 ("Sending all %d bytes", bytes_remaining
);
632 XChangeProperty (display
, window
, reply
.property
, type
, format
,
633 PropModeReplace
, data
, size
);
634 /* At this point, the selection was successfully stored; ack it. */
635 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
639 /* Send an INCR selection. */
640 struct prop_location
*wait_object
;
644 frame
= some_frame_on_display (dpyinfo
);
646 /* If the display no longer has frames, we can't expect
647 to get many more selection requests from it, so don't
648 bother trying to queue them. */
651 x_start_queuing_selection_requests (display
);
653 record_unwind_protect (queue_selection_requests_unwind
,
657 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
658 error ("Attempt to transfer an INCR to ourself!");
660 TRACE2 ("Start sending %d bytes incrementally (%s)",
661 bytes_remaining
, XGetAtomName (display
, reply
.property
));
662 wait_object
= expect_property_change (display
, window
, reply
.property
,
665 TRACE1 ("Set %s to number of bytes to send",
666 XGetAtomName (display
, reply
.property
));
667 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
669 (unsigned char *) &bytes_remaining
, 1);
670 XSelectInput (display
, window
, PropertyChangeMask
);
672 /* Tell 'em the INCR data is there... */
673 TRACE0 ("Send SelectionNotify event");
674 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
677 had_errors
= x_had_errors_p (display
);
680 /* First, wait for the requester to ack by deleting the property.
681 This can run random lisp code (process handlers) or signal. */
684 TRACE1 ("Waiting for ACK (deletion of %s)",
685 XGetAtomName (display
, reply
.property
));
686 wait_for_property_change (wait_object
);
690 while (bytes_remaining
)
692 int i
= ((bytes_remaining
< max_bytes
)
699 = expect_property_change (display
, window
, reply
.property
,
702 TRACE1 ("Sending increment of %d bytes", i
);
703 TRACE1 ("Set %s to increment data",
704 XGetAtomName (display
, reply
.property
));
706 /* Append the next chunk of data to the property. */
707 XChangeProperty (display
, window
, reply
.property
, type
, format
,
708 PropModeAppend
, data
, i
/ format_bytes
);
709 bytes_remaining
-= i
;
712 had_errors
= x_had_errors_p (display
);
718 /* Now wait for the requester to ack this chunk by deleting the
719 property. This can run random lisp code or signal. */
720 TRACE1 ("Waiting for increment ACK (deletion of %s)",
721 XGetAtomName (display
, reply
.property
));
722 wait_for_property_change (wait_object
);
725 /* Now write a zero-length chunk to the property to tell the
726 requester that we're done. */
728 if (! waiting_for_other_props_on_window (display
, window
))
729 XSelectInput (display
, window
, 0L);
731 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
732 XGetAtomName (display
, reply
.property
));
733 XChangeProperty (display
, window
, reply
.property
, type
, format
,
734 PropModeReplace
, data
, 0);
735 TRACE0 ("Done sending incrementally");
738 /* rms, 2003-01-03: I think I have fixed this bug. */
739 /* The window we're communicating with may have been deleted
740 in the meantime (that's a real situation from a bug report).
741 In this case, there may be events in the event queue still
742 refering to the deleted window, and we'll get a BadWindow error
743 in XTread_socket when processing the events. I don't have
744 an idea how to fix that. gerd, 2001-01-98. */
746 x_uncatch_errors (display
, count
);
750 /* Handle a SelectionRequest event EVENT.
751 This is called from keyboard.c when such an event is found in the queue. */
754 x_handle_selection_request (event
)
755 struct input_event
*event
;
757 struct gcpro gcpro1
, gcpro2
, gcpro3
;
758 Lisp_Object local_selection_data
;
759 Lisp_Object selection_symbol
;
760 Lisp_Object target_symbol
;
761 Lisp_Object converted_selection
;
762 Time local_selection_time
;
763 Lisp_Object successful_p
;
765 struct x_display_info
*dpyinfo
766 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
768 local_selection_data
= Qnil
;
769 target_symbol
= Qnil
;
770 converted_selection
= Qnil
;
773 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
775 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
776 SELECTION_EVENT_SELECTION (event
));
778 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
780 if (NILP (local_selection_data
))
782 /* Someone asked for the selection, but we don't have it any more.
784 x_decline_selection_request (event
);
788 local_selection_time
= (Time
)
789 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
791 if (SELECTION_EVENT_TIME (event
) != CurrentTime
792 && local_selection_time
> SELECTION_EVENT_TIME (event
))
794 /* Someone asked for the selection, and we have one, but not the one
797 x_decline_selection_request (event
);
801 x_selection_current_request
= event
;
802 count
= SPECPDL_INDEX ();
803 selection_request_dpyinfo
= dpyinfo
;
804 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
806 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
807 SELECTION_EVENT_TARGET (event
));
809 #if 0 /* #### MULTIPLE doesn't work yet */
810 if (EQ (target_symbol
, QMULTIPLE
))
811 target_symbol
= fetch_multiple_target (event
);
814 /* Convert lisp objects back into binary data */
817 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
819 if (! NILP (converted_selection
))
827 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
829 &data
, &type
, &size
, &format
, &nofree
);
831 x_reply_selection_request (event
, format
, data
, size
, type
);
834 /* Indicate we have successfully processed this event. */
835 x_selection_current_request
= 0;
837 /* Use xfree, not XFree, because lisp_data_to_selection_data
838 calls xmalloc itself. */
842 unbind_to (count
, Qnil
);
846 /* Let random lisp code notice that the selection has been asked for. */
849 rest
= Vx_sent_selection_hooks
;
850 if (!EQ (rest
, Qunbound
))
851 for (; CONSP (rest
); rest
= Fcdr (rest
))
852 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
858 /* Handle a SelectionClear event EVENT, which indicates that some
859 client cleared out our previously asserted selection.
860 This is called from keyboard.c when such an event is found in the queue. */
863 x_handle_selection_clear (event
)
864 struct input_event
*event
;
866 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
867 Atom selection
= SELECTION_EVENT_SELECTION (event
);
868 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
870 Lisp_Object selection_symbol
, local_selection_data
;
871 Time local_selection_time
;
872 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
873 struct x_display_info
*t_dpyinfo
;
875 /* If the new selection owner is also Emacs,
876 don't clear the new selection. */
878 /* Check each display on the same terminal,
879 to see if this Emacs job now owns the selection
880 through that display. */
881 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
882 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
885 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
886 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
894 selection_symbol
= x_atom_to_symbol (display
, selection
);
896 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
898 /* Well, we already believe that we don't own it, so that's just fine. */
899 if (NILP (local_selection_data
)) return;
901 local_selection_time
= (Time
)
902 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
904 /* This SelectionClear is for a selection that we no longer own, so we can
905 disregard it. (That is, we have reasserted the selection since this
906 request was generated.) */
908 if (changed_owner_time
!= CurrentTime
909 && local_selection_time
> changed_owner_time
)
912 /* Otherwise, we're really honest and truly being told to drop it.
913 Don't use Fdelq as that may QUIT;. */
915 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
916 Vselection_alist
= Fcdr (Vselection_alist
);
920 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
921 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
923 XSETCDR (rest
, Fcdr (XCDR (rest
)));
928 /* Let random lisp code notice that the selection has been stolen. */
932 rest
= Vx_lost_selection_hooks
;
933 if (!EQ (rest
, Qunbound
))
935 for (; CONSP (rest
); rest
= Fcdr (rest
))
936 call1 (Fcar (rest
), selection_symbol
);
937 prepare_menu_bars ();
938 redisplay_preserve_echo_area (20);
943 /* Clear all selections that were made from frame F.
944 We do this when about to delete a frame. */
947 x_clear_frame_selections (f
)
953 XSETFRAME (frame
, f
);
955 /* Otherwise, we're really honest and truly being told to drop it.
956 Don't use Fdelq as that may QUIT;. */
958 /* Delete elements from the beginning of Vselection_alist. */
959 while (!NILP (Vselection_alist
)
960 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
962 /* Let random Lisp code notice that the selection has been stolen. */
963 Lisp_Object hooks
, selection_symbol
;
965 hooks
= Vx_lost_selection_hooks
;
966 selection_symbol
= Fcar (Fcar (Vselection_alist
));
968 if (!EQ (hooks
, Qunbound
))
970 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
971 call1 (Fcar (hooks
), selection_symbol
);
972 #if 0 /* This can crash when deleting a frame
973 from x_connection_closed. Anyway, it seems unnecessary;
974 something else should cause a redisplay. */
975 redisplay_preserve_echo_area (21);
979 Vselection_alist
= Fcdr (Vselection_alist
);
982 /* Delete elements after the beginning of Vselection_alist. */
983 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
984 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
986 /* Let random Lisp code notice that the selection has been stolen. */
987 Lisp_Object hooks
, selection_symbol
;
989 hooks
= Vx_lost_selection_hooks
;
990 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
992 if (!EQ (hooks
, Qunbound
))
994 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
995 call1 (Fcar (hooks
), selection_symbol
);
996 #if 0 /* See above */
997 redisplay_preserve_echo_area (22);
1000 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1005 /* Nonzero if any properties for DISPLAY and WINDOW
1006 are on the list of what we are waiting for. */
1009 waiting_for_other_props_on_window (display
, window
)
1013 struct prop_location
*rest
= property_change_wait_list
;
1015 if (rest
->display
== display
&& rest
->window
== window
)
1022 /* Add an entry to the list of property changes we are waiting for.
1023 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1024 The return value is a number that uniquely identifies
1025 this awaited property change. */
1027 static struct prop_location
*
1028 expect_property_change (display
, window
, property
, state
)
1034 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1035 pl
->identifier
= ++prop_location_identifier
;
1036 pl
->display
= display
;
1037 pl
->window
= window
;
1038 pl
->property
= property
;
1039 pl
->desired_state
= state
;
1040 pl
->next
= property_change_wait_list
;
1042 property_change_wait_list
= pl
;
1046 /* Delete an entry from the list of property changes we are waiting for.
1047 IDENTIFIER is the number that uniquely identifies the entry. */
1050 unexpect_property_change (location
)
1051 struct prop_location
*location
;
1053 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1056 if (rest
== location
)
1059 prev
->next
= rest
->next
;
1061 property_change_wait_list
= rest
->next
;
1070 /* Remove the property change expectation element for IDENTIFIER. */
1073 wait_for_property_change_unwind (identifierval
)
1074 Lisp_Object identifierval
;
1076 unexpect_property_change ((struct prop_location
*)
1077 (XFASTINT (XCAR (identifierval
)) << 16
1078 | XFASTINT (XCDR (identifierval
))));
1082 /* Actually wait for a property change.
1083 IDENTIFIER should be the value that expect_property_change returned. */
1086 wait_for_property_change (location
)
1087 struct prop_location
*location
;
1090 int count
= SPECPDL_INDEX ();
1093 tem
= Fcons (Qnil
, Qnil
);
1094 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1095 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1097 /* Make sure to do unexpect_property_change if we quit or err. */
1098 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1100 XSETCAR (property_change_reply
, Qnil
);
1102 property_change_reply_object
= location
;
1103 /* If the event we are waiting for arrives beyond here, it will set
1104 property_change_reply, because property_change_reply_object says so. */
1105 if (! location
->arrived
)
1107 secs
= x_selection_timeout
/ 1000;
1108 usecs
= (x_selection_timeout
% 1000) * 1000;
1109 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1110 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1112 if (NILP (XCAR (property_change_reply
)))
1114 TRACE0 (" Timed out");
1115 error ("Timed out waiting for property-notify event");
1119 unbind_to (count
, Qnil
);
1122 /* Called from XTread_socket in response to a PropertyNotify event. */
1125 x_handle_property_notify (event
)
1126 XPropertyEvent
*event
;
1128 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1132 if (rest
->property
== event
->atom
1133 && rest
->window
== event
->window
1134 && rest
->display
== event
->display
1135 && rest
->desired_state
== event
->state
)
1137 TRACE2 ("Expected %s of property %s",
1138 (event
->state
== PropertyDelete
? "deletion" : "change"),
1139 XGetAtomName (event
->display
, event
->atom
));
1143 /* If this is the one wait_for_property_change is waiting for,
1144 tell it to wake up. */
1145 if (rest
== property_change_reply_object
)
1146 XSETCAR (property_change_reply
, Qt
);
1149 prev
->next
= rest
->next
;
1151 property_change_wait_list
= rest
->next
;
1163 #if 0 /* #### MULTIPLE doesn't work yet */
1166 fetch_multiple_target (event
)
1167 XSelectionRequestEvent
*event
;
1169 Display
*display
= event
->display
;
1170 Window window
= event
->requestor
;
1171 Atom target
= event
->target
;
1172 Atom selection_atom
= event
->selection
;
1177 x_get_window_property_as_lisp_data (display
, window
, target
,
1178 QMULTIPLE
, selection_atom
));
1182 copy_multiple_data (obj
)
1189 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1192 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1193 for (i
= 0; i
< size
; i
++)
1195 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1196 CHECK_VECTOR (vec2
);
1197 if (XVECTOR (vec2
)->size
!= 2)
1198 /* ??? Confusing error message */
1199 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1200 Fcons (vec2
, Qnil
)));
1201 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1202 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1203 = XVECTOR (vec2
)->contents
[0];
1204 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1205 = XVECTOR (vec2
)->contents
[1];
1213 /* Variables for communication with x_handle_selection_notify. */
1214 static Atom reading_which_selection
;
1215 static Lisp_Object reading_selection_reply
;
1216 static Window reading_selection_window
;
1218 /* Do protocol to read selection-data from the server.
1219 Converts this to Lisp data and returns it. */
1222 x_get_foreign_selection (selection_symbol
, target_type
)
1223 Lisp_Object selection_symbol
, target_type
;
1225 struct frame
*sf
= SELECTED_FRAME ();
1226 Window requestor_window
= FRAME_X_WINDOW (sf
);
1227 Display
*display
= FRAME_X_DISPLAY (sf
);
1228 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1229 Time requestor_time
= last_event_timestamp
;
1230 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1231 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1237 if (CONSP (target_type
))
1238 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1240 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1244 count
= x_catch_errors (display
);
1246 TRACE2 ("Get selection %s, type %s",
1247 XGetAtomName (display
, type_atom
),
1248 XGetAtomName (display
, target_property
));
1250 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1251 requestor_window
, requestor_time
);
1254 /* Prepare to block until the reply has been read. */
1255 reading_selection_window
= requestor_window
;
1256 reading_which_selection
= selection_atom
;
1257 XSETCAR (reading_selection_reply
, Qnil
);
1259 frame
= some_frame_on_display (dpyinfo
);
1261 /* If the display no longer has frames, we can't expect
1262 to get many more selection requests from it, so don't
1263 bother trying to queue them. */
1266 x_start_queuing_selection_requests (display
);
1268 record_unwind_protect (queue_selection_requests_unwind
,
1273 /* This allows quits. Also, don't wait forever. */
1274 secs
= x_selection_timeout
/ 1000;
1275 usecs
= (x_selection_timeout
% 1000) * 1000;
1276 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1277 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1278 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1281 x_check_errors (display
, "Cannot get selection: %s");
1282 x_uncatch_errors (display
, count
);
1285 if (NILP (XCAR (reading_selection_reply
)))
1286 error ("Timed out waiting for reply from selection owner");
1287 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1288 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1290 /* Otherwise, the selection is waiting for us on the requested property. */
1292 x_get_window_property_as_lisp_data (display
, requestor_window
,
1293 target_property
, target_type
,
1297 /* Subroutines of x_get_window_property_as_lisp_data */
1299 /* Use xfree, not XFree, to free the data obtained with this function. */
1302 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1303 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1308 unsigned char **data_ret
;
1310 Atom
*actual_type_ret
;
1311 int *actual_format_ret
;
1312 unsigned long *actual_size_ret
;
1316 unsigned long bytes_remaining
;
1318 unsigned char *tmp_data
= 0;
1320 int buffer_size
= SELECTION_QUANTUM (display
);
1322 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1323 buffer_size
= MAX_SELECTION_QUANTUM
;
1327 /* First probe the thing to find out how big it is. */
1328 result
= XGetWindowProperty (display
, window
, property
,
1329 0L, 0L, False
, AnyPropertyType
,
1330 actual_type_ret
, actual_format_ret
,
1332 &bytes_remaining
, &tmp_data
);
1333 if (result
!= Success
)
1341 /* This was allocated by Xlib, so use XFree. */
1342 XFree ((char *) tmp_data
);
1344 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1350 total_size
= bytes_remaining
+ 1;
1351 *data_ret
= (unsigned char *) xmalloc (total_size
);
1353 /* Now read, until we've gotten it all. */
1354 while (bytes_remaining
)
1356 #ifdef TRACE_SELECTION
1357 int last
= bytes_remaining
;
1360 = XGetWindowProperty (display
, window
, property
,
1361 (long)offset
/4, (long)buffer_size
/4,
1364 actual_type_ret
, actual_format_ret
,
1365 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1367 TRACE2 ("Read %ld bytes from property %s",
1368 last
- bytes_remaining
,
1369 XGetAtomName (display
, property
));
1371 /* If this doesn't return Success at this point, it means that
1372 some clod deleted the selection while we were in the midst of
1373 reading it. Deal with that, I guess.... */
1374 if (result
!= Success
)
1376 *actual_size_ret
*= *actual_format_ret
/ 8;
1377 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1378 offset
+= *actual_size_ret
;
1380 /* This was allocated by Xlib, so use XFree. */
1381 XFree ((char *) tmp_data
);
1386 *bytes_ret
= offset
;
1389 /* Use xfree, not XFree, to free the data obtained with this function. */
1392 receive_incremental_selection (display
, window
, property
, target_type
,
1393 min_size_bytes
, data_ret
, size_bytes_ret
,
1394 type_ret
, format_ret
, size_ret
)
1398 Lisp_Object target_type
; /* for error messages only */
1399 unsigned int min_size_bytes
;
1400 unsigned char **data_ret
;
1401 int *size_bytes_ret
;
1403 unsigned long *size_ret
;
1407 struct prop_location
*wait_object
;
1408 *size_bytes_ret
= min_size_bytes
;
1409 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1411 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1413 /* At this point, we have read an INCR property.
1414 Delete the property to ack it.
1415 (But first, prepare to receive the next event in this handshake.)
1417 Now, we must loop, waiting for the sending window to put a value on
1418 that property, then reading the property, then deleting it to ack.
1419 We are done when the sender places a property of length 0.
1422 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1423 TRACE1 (" Delete property %s",
1424 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1425 XDeleteProperty (display
, window
, property
);
1426 TRACE1 (" Expect new value of property %s",
1427 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1428 wait_object
= expect_property_change (display
, window
, property
,
1435 unsigned char *tmp_data
;
1438 TRACE0 (" Wait for property change");
1439 wait_for_property_change (wait_object
);
1441 /* expect it again immediately, because x_get_window_property may
1442 .. no it won't, I don't get it.
1443 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1444 TRACE0 (" Get property value");
1445 x_get_window_property (display
, window
, property
,
1446 &tmp_data
, &tmp_size_bytes
,
1447 type_ret
, format_ret
, size_ret
, 1);
1449 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1451 if (tmp_size_bytes
== 0) /* we're done */
1453 TRACE0 ("Done reading incrementally");
1455 if (! waiting_for_other_props_on_window (display
, window
))
1456 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1457 unexpect_property_change (wait_object
);
1458 /* Use xfree, not XFree, because x_get_window_property
1459 calls xmalloc itself. */
1460 if (tmp_data
) xfree (tmp_data
);
1465 TRACE1 (" ACK by deleting property %s",
1466 XGetAtomName (display
, property
));
1467 XDeleteProperty (display
, window
, property
);
1468 wait_object
= expect_property_change (display
, window
, property
,
1473 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1475 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1476 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1479 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1480 offset
+= tmp_size_bytes
;
1482 /* Use xfree, not XFree, because x_get_window_property
1483 calls xmalloc itself. */
1489 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1490 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1491 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1494 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1499 Lisp_Object target_type
; /* for error messages only */
1500 Atom selection_atom
; /* for error messages only */
1504 unsigned long actual_size
;
1505 unsigned char *data
= 0;
1508 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1510 TRACE0 ("Reading selection data");
1512 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1513 &actual_type
, &actual_format
, &actual_size
, 1);
1516 int there_is_a_selection_owner
;
1518 there_is_a_selection_owner
1519 = XGetSelectionOwner (display
, selection_atom
);
1522 there_is_a_selection_owner
1523 ? Fcons (build_string ("selection owner couldn't convert"),
1525 ? Fcons (target_type
,
1526 Fcons (x_atom_to_symbol (display
,
1529 : Fcons (target_type
, Qnil
))
1530 : Fcons (build_string ("no selection"),
1531 Fcons (x_atom_to_symbol (display
,
1536 if (actual_type
== dpyinfo
->Xatom_INCR
)
1538 /* That wasn't really the data, just the beginning. */
1540 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1542 /* Use xfree, not XFree, because x_get_window_property
1543 calls xmalloc itself. */
1544 xfree ((char *) data
);
1546 receive_incremental_selection (display
, window
, property
, target_type
,
1547 min_size_bytes
, &data
, &bytes
,
1548 &actual_type
, &actual_format
,
1553 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1554 XDeleteProperty (display
, window
, property
);
1558 /* It's been read. Now convert it to a lisp object in some semi-rational
1560 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1561 actual_type
, actual_format
);
1563 /* Use xfree, not XFree, because x_get_window_property
1564 calls xmalloc itself. */
1565 xfree ((char *) data
);
1569 /* These functions convert from the selection data read from the server into
1570 something that we can use from Lisp, and vice versa.
1572 Type: Format: Size: Lisp Type:
1573 ----- ------- ----- -----------
1576 ATOM 32 > 1 Vector of Symbols
1578 * 16 > 1 Vector of Integers
1579 * 32 1 if <=16 bits: Integer
1580 if > 16 bits: Cons of top16, bot16
1581 * 32 > 1 Vector of the above
1583 When converting a Lisp number to C, it is assumed to be of format 16 if
1584 it is an integer, and of format 32 if it is a cons of two integers.
1586 When converting a vector of numbers from Lisp to C, it is assumed to be
1587 of format 16 if every element in the vector is an integer, and is assumed
1588 to be of format 32 if any element is a cons of two integers.
1590 When converting an object to C, it may be of the form (SYMBOL . <data>)
1591 where SYMBOL is what we should claim that the type is. Format and
1592 representation are as above. */
1597 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1599 unsigned char *data
;
1603 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1605 if (type
== dpyinfo
->Xatom_NULL
)
1608 /* Convert any 8-bit data to a string, for compactness. */
1609 else if (format
== 8)
1611 Lisp_Object str
, lispy_type
;
1613 str
= make_unibyte_string ((char *) data
, size
);
1614 /* Indicate that this string is from foreign selection by a text
1615 property `foreign-selection' so that the caller of
1616 x-get-selection-internal (usually x-get-selection) can know
1617 that the string must be decode. */
1618 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1619 lispy_type
= QCOMPOUND_TEXT
;
1620 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1621 lispy_type
= QUTF8_STRING
;
1623 lispy_type
= QSTRING
;
1624 Fput_text_property (make_number (0), make_number (size
),
1625 Qforeign_selection
, lispy_type
, str
);
1628 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1629 a vector of symbols.
1631 else if (type
== XA_ATOM
)
1634 if (size
== sizeof (Atom
))
1635 return x_atom_to_symbol (display
, *((Atom
*) data
));
1638 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1640 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1641 Faset (v
, make_number (i
),
1642 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1647 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1648 If the number is > 16 bits, convert it to a cons of integers,
1649 16 bits in each half.
1651 else if (format
== 32 && size
== sizeof (int))
1652 return long_to_cons (((unsigned int *) data
) [0]);
1653 else if (format
== 16 && size
== sizeof (short))
1654 return make_number ((int) (((unsigned short *) data
) [0]));
1656 /* Convert any other kind of data to a vector of numbers, represented
1657 as above (as an integer, or a cons of two 16 bit integers.)
1659 else if (format
== 16)
1663 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1664 for (i
= 0; i
< size
/ 2; i
++)
1666 int j
= (int) ((unsigned short *) data
) [i
];
1667 Faset (v
, make_number (i
), make_number (j
));
1674 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1675 for (i
= 0; i
< size
/ 4; i
++)
1677 unsigned int j
= ((unsigned int *) data
) [i
];
1678 Faset (v
, make_number (i
), long_to_cons (j
));
1685 /* Use xfree, not XFree, to free the data obtained with this function. */
1688 lisp_data_to_selection_data (display
, obj
,
1689 data_ret
, type_ret
, size_ret
,
1690 format_ret
, nofree_ret
)
1693 unsigned char **data_ret
;
1695 unsigned int *size_ret
;
1699 Lisp_Object type
= Qnil
;
1700 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1704 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1708 if (CONSP (obj
) && NILP (XCDR (obj
)))
1712 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1713 { /* This is not the same as declining */
1719 else if (STRINGP (obj
))
1721 xassert (! STRING_MULTIBYTE (obj
));
1725 *size_ret
= SBYTES (obj
);
1726 *data_ret
= SDATA (obj
);
1729 else if (SYMBOLP (obj
))
1733 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1734 (*data_ret
) [sizeof (Atom
)] = 0;
1735 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1736 if (NILP (type
)) type
= QATOM
;
1738 else if (INTEGERP (obj
)
1739 && XINT (obj
) < 0xFFFF
1740 && XINT (obj
) > -0xFFFF)
1744 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1745 (*data_ret
) [sizeof (short)] = 0;
1746 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1747 if (NILP (type
)) type
= QINTEGER
;
1749 else if (INTEGERP (obj
)
1750 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1751 && (INTEGERP (XCDR (obj
))
1752 || (CONSP (XCDR (obj
))
1753 && INTEGERP (XCAR (XCDR (obj
)))))))
1757 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1758 (*data_ret
) [sizeof (long)] = 0;
1759 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1760 if (NILP (type
)) type
= QINTEGER
;
1762 else if (VECTORP (obj
))
1764 /* Lisp_Vectors may represent a set of ATOMs;
1765 a set of 16 or 32 bit INTEGERs;
1766 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1770 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1771 /* This vector is an ATOM set */
1773 if (NILP (type
)) type
= QATOM
;
1774 *size_ret
= XVECTOR (obj
)->size
;
1776 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1777 for (i
= 0; i
< *size_ret
; i
++)
1778 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1779 (*(Atom
**) data_ret
) [i
]
1780 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1782 Fsignal (Qerror
, /* Qselection_error */
1784 ("all elements of selection vector must have same type"),
1785 Fcons (obj
, Qnil
)));
1787 #if 0 /* #### MULTIPLE doesn't work yet */
1788 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1789 /* This vector is an ATOM_PAIR set */
1791 if (NILP (type
)) type
= QATOM_PAIR
;
1792 *size_ret
= XVECTOR (obj
)->size
;
1794 *data_ret
= (unsigned char *)
1795 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1796 for (i
= 0; i
< *size_ret
; i
++)
1797 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1799 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1800 if (XVECTOR (pair
)->size
!= 2)
1803 ("elements of the vector must be vectors of exactly two elements"),
1804 Fcons (pair
, Qnil
)));
1806 (*(Atom
**) data_ret
) [i
* 2]
1807 = symbol_to_x_atom (dpyinfo
, display
,
1808 XVECTOR (pair
)->contents
[0]);
1809 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1810 = symbol_to_x_atom (dpyinfo
, display
,
1811 XVECTOR (pair
)->contents
[1]);
1816 ("all elements of the vector must be of the same type"),
1817 Fcons (obj
, Qnil
)));
1822 /* This vector is an INTEGER set, or something like it */
1824 *size_ret
= XVECTOR (obj
)->size
;
1825 if (NILP (type
)) type
= QINTEGER
;
1827 for (i
= 0; i
< *size_ret
; i
++)
1828 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1830 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1831 Fsignal (Qerror
, /* Qselection_error */
1833 ("elements of selection vector must be integers or conses of integers"),
1834 Fcons (obj
, Qnil
)));
1836 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1837 for (i
= 0; i
< *size_ret
; i
++)
1838 if (*format_ret
== 32)
1839 (*((unsigned long **) data_ret
)) [i
]
1840 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1842 (*((unsigned short **) data_ret
)) [i
]
1843 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1847 Fsignal (Qerror
, /* Qselection_error */
1848 Fcons (build_string ("unrecognised selection data"),
1849 Fcons (obj
, Qnil
)));
1851 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1855 clean_local_selection_data (obj
)
1859 && INTEGERP (XCAR (obj
))
1860 && CONSP (XCDR (obj
))
1861 && INTEGERP (XCAR (XCDR (obj
)))
1862 && NILP (XCDR (XCDR (obj
))))
1863 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1866 && INTEGERP (XCAR (obj
))
1867 && INTEGERP (XCDR (obj
)))
1869 if (XINT (XCAR (obj
)) == 0)
1871 if (XINT (XCAR (obj
)) == -1)
1872 return make_number (- XINT (XCDR (obj
)));
1877 int size
= XVECTOR (obj
)->size
;
1880 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1881 copy
= Fmake_vector (make_number (size
), Qnil
);
1882 for (i
= 0; i
< size
; i
++)
1883 XVECTOR (copy
)->contents
[i
]
1884 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1890 /* Called from XTread_socket to handle SelectionNotify events.
1891 If it's the selection we are waiting for, stop waiting
1892 by setting the car of reading_selection_reply to non-nil.
1893 We store t there if the reply is successful, lambda if not. */
1896 x_handle_selection_notify (event
)
1897 XSelectionEvent
*event
;
1899 if (event
->requestor
!= reading_selection_window
)
1901 if (event
->selection
!= reading_which_selection
)
1904 TRACE0 ("Received SelectionNotify");
1905 XSETCAR (reading_selection_reply
,
1906 (event
->property
!= 0 ? Qt
: Qlambda
));
1910 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1911 Sx_own_selection_internal
, 2, 2, 0,
1912 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1913 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1914 \(Those are literal upper-case symbol names, since that's what X expects.)
1915 VALUE is typically a string, or a cons of two markers, but may be
1916 anything that the functions on `selection-converter-alist' know about. */)
1917 (selection_name
, selection_value
)
1918 Lisp_Object selection_name
, selection_value
;
1921 CHECK_SYMBOL (selection_name
);
1922 if (NILP (selection_value
)) error ("selection-value may not be nil");
1923 x_own_selection (selection_name
, selection_value
);
1924 return selection_value
;
1928 /* Request the selection value from the owner. If we are the owner,
1929 simply return our selection value. If we are not the owner, this
1930 will block until all of the data has arrived. */
1932 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1933 Sx_get_selection_internal
, 2, 2, 0,
1934 doc
: /* Return text selected from some X window.
1935 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1936 \(Those are literal upper-case symbol names, since that's what X expects.)
1937 TYPE is the type of data desired, typically `STRING'. */)
1938 (selection_symbol
, target_type
)
1939 Lisp_Object selection_symbol
, target_type
;
1941 Lisp_Object val
= Qnil
;
1942 struct gcpro gcpro1
, gcpro2
;
1943 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1945 CHECK_SYMBOL (selection_symbol
);
1947 #if 0 /* #### MULTIPLE doesn't work yet */
1948 if (CONSP (target_type
)
1949 && XCAR (target_type
) == QMULTIPLE
)
1951 CHECK_VECTOR (XCDR (target_type
));
1952 /* So we don't destructively modify this... */
1953 target_type
= copy_multiple_data (target_type
);
1957 CHECK_SYMBOL (target_type
);
1959 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
1963 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1968 && SYMBOLP (XCAR (val
)))
1971 if (CONSP (val
) && NILP (XCDR (val
)))
1974 val
= clean_local_selection_data (val
);
1980 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
1981 Sx_disown_selection_internal
, 1, 2, 0,
1982 doc
: /* If we own the selection SELECTION, disown it.
1983 Disowning it means there is no such selection. */)
1985 Lisp_Object selection
;
1989 Atom selection_atom
;
1990 struct selection_input_event event
;
1992 struct x_display_info
*dpyinfo
;
1993 struct frame
*sf
= SELECTED_FRAME ();
1996 display
= FRAME_X_DISPLAY (sf
);
1997 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1998 CHECK_SYMBOL (selection
);
2000 timestamp
= last_event_timestamp
;
2002 timestamp
= cons_to_long (time
);
2004 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2005 return Qnil
; /* Don't disown the selection when we're not the owner. */
2007 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2010 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2013 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2014 generated for a window which owns the selection when that window sets
2015 the selection owner to None. The NCD server does, the MIT Sun4 server
2016 doesn't. So we synthesize one; this means we might get two, but
2017 that's ok, because the second one won't have any effect. */
2018 SELECTION_EVENT_DISPLAY (&event
) = display
;
2019 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2020 SELECTION_EVENT_TIME (&event
) = timestamp
;
2021 x_handle_selection_clear ((struct input_event
*) &event
);
2026 /* Get rid of all the selections in buffer BUFFER.
2027 This is used when we kill a buffer. */
2030 x_disown_buffer_selections (buffer
)
2034 struct buffer
*buf
= XBUFFER (buffer
);
2036 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2038 Lisp_Object elt
, value
;
2041 if (CONSP (value
) && MARKERP (XCAR (value
))
2042 && XMARKER (XCAR (value
))->buffer
== buf
)
2043 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2047 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2049 doc
: /* Whether the current Emacs process owns the given X Selection.
2050 The arg should be the name of the selection in question, typically one of
2051 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2052 \(Those are literal upper-case symbol names, since that's what X expects.)
2053 For convenience, the symbol nil is the same as `PRIMARY',
2054 and t is the same as `SECONDARY'. */)
2056 Lisp_Object selection
;
2059 CHECK_SYMBOL (selection
);
2060 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2061 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2063 if (NILP (Fassq (selection
, Vselection_alist
)))
2068 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2070 doc
: /* Whether there is an owner for the given X Selection.
2071 The arg should be the name of the selection in question, typically one of
2072 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2073 \(Those are literal upper-case symbol names, since that's what X expects.)
2074 For convenience, the symbol nil is the same as `PRIMARY',
2075 and t is the same as `SECONDARY'. */)
2077 Lisp_Object selection
;
2082 struct frame
*sf
= SELECTED_FRAME ();
2084 /* It should be safe to call this before we have an X frame. */
2085 if (! FRAME_X_P (sf
))
2088 dpy
= FRAME_X_DISPLAY (sf
);
2089 CHECK_SYMBOL (selection
);
2090 if (!NILP (Fx_selection_owner_p (selection
)))
2092 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2093 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2094 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2098 owner
= XGetSelectionOwner (dpy
, atom
);
2100 return (owner
? Qt
: Qnil
);
2104 #ifdef CUT_BUFFER_SUPPORT
2106 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2108 initialize_cut_buffers (display
, window
)
2112 unsigned char *data
= (unsigned char *) "";
2114 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2115 PropModeAppend, data, 0)
2116 FROB (XA_CUT_BUFFER0
);
2117 FROB (XA_CUT_BUFFER1
);
2118 FROB (XA_CUT_BUFFER2
);
2119 FROB (XA_CUT_BUFFER3
);
2120 FROB (XA_CUT_BUFFER4
);
2121 FROB (XA_CUT_BUFFER5
);
2122 FROB (XA_CUT_BUFFER6
);
2123 FROB (XA_CUT_BUFFER7
);
2129 #define CHECK_CUT_BUFFER(symbol) \
2130 { CHECK_SYMBOL ((symbol)); \
2131 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2132 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2133 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2134 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2136 Fcons (build_string ("doesn't name a cut buffer"), \
2137 Fcons ((symbol), Qnil))); \
2140 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2141 Sx_get_cut_buffer_internal
, 1, 1, 0,
2142 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2148 unsigned char *data
;
2155 struct x_display_info
*dpyinfo
;
2156 struct frame
*sf
= SELECTED_FRAME ();
2159 display
= FRAME_X_DISPLAY (sf
);
2160 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2161 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2162 CHECK_CUT_BUFFER (buffer
);
2163 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2165 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2166 &type
, &format
, &size
, 0);
2167 if (!data
|| !format
)
2170 if (format
!= 8 || type
!= XA_STRING
)
2172 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2173 Fcons (x_atom_to_symbol (display
, type
),
2174 Fcons (make_number (format
), Qnil
))));
2176 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2177 /* Use xfree, not XFree, because x_get_window_property
2178 calls xmalloc itself. */
2184 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2185 Sx_store_cut_buffer_internal
, 2, 2, 0,
2186 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2188 Lisp_Object buffer
, string
;
2192 unsigned char *data
;
2194 int bytes_remaining
;
2197 struct frame
*sf
= SELECTED_FRAME ();
2200 display
= FRAME_X_DISPLAY (sf
);
2201 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2203 max_bytes
= SELECTION_QUANTUM (display
);
2204 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2205 max_bytes
= MAX_SELECTION_QUANTUM
;
2207 CHECK_CUT_BUFFER (buffer
);
2208 CHECK_STRING (string
);
2209 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2211 data
= (unsigned char *) SDATA (string
);
2212 bytes
= SBYTES (string
);
2213 bytes_remaining
= bytes
;
2215 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2217 initialize_cut_buffers (display
, window
);
2218 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2223 /* Don't mess up with an empty value. */
2224 if (!bytes_remaining
)
2225 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2226 PropModeReplace
, data
, 0);
2228 while (bytes_remaining
)
2230 int chunk
= (bytes_remaining
< max_bytes
2231 ? bytes_remaining
: max_bytes
);
2232 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2233 (bytes_remaining
== bytes
2238 bytes_remaining
-= chunk
;
2245 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2246 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2247 doc
: /* Rotate the values of the cut buffers by the given number of step.
2248 Positive means shift the values forward, negative means backward. */)
2255 struct frame
*sf
= SELECTED_FRAME ();
2258 display
= FRAME_X_DISPLAY (sf
);
2259 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2263 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2265 initialize_cut_buffers (display
, window
);
2266 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2269 props
[0] = XA_CUT_BUFFER0
;
2270 props
[1] = XA_CUT_BUFFER1
;
2271 props
[2] = XA_CUT_BUFFER2
;
2272 props
[3] = XA_CUT_BUFFER3
;
2273 props
[4] = XA_CUT_BUFFER4
;
2274 props
[5] = XA_CUT_BUFFER5
;
2275 props
[6] = XA_CUT_BUFFER6
;
2276 props
[7] = XA_CUT_BUFFER7
;
2278 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2285 /***********************************************************************
2286 Drag and drop support
2287 ***********************************************************************/
2288 /* Check that lisp values are of correct type for x_fill_property_data.
2289 That is, number, string or a cons with two numbers (low and high 16
2290 bit parts of a 32 bit number). */
2293 x_check_property_data (data
)
2299 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2301 Lisp_Object o
= XCAR (iter
);
2303 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2305 else if (CONSP (o
) &&
2306 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2313 /* Convert lisp values to a C array. Values may be a number, a string
2314 which is taken as an X atom name and converted to the atom value, or
2315 a cons containing the two 16 bit parts of a 32 bit number.
2317 DPY is the display use to look up X atoms.
2318 DATA is a Lisp list of values to be converted.
2319 RET is the C array that contains the converted values. It is assumed
2320 it is big enough to hol all values.
2321 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2322 be stored in RET. */
2325 x_fill_property_data (dpy
, data
, ret
, format
)
2332 CARD32
*d32
= (CARD32
*) ret
;
2333 CARD16
*d16
= (CARD16
*) ret
;
2334 CARD8
*d08
= (CARD8
*) ret
;
2337 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2339 Lisp_Object o
= XCAR (iter
);
2342 val
= (CARD32
) XFASTINT (o
);
2343 else if (FLOATP (o
))
2344 val
= (CARD32
) XFLOAT (o
);
2346 val
= (CARD32
) cons_to_long (o
);
2347 else if (STRINGP (o
))
2350 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2354 error ("Wrong type, must be string, number or cons");
2357 *d08
++ = (CARD8
) val
;
2358 else if (format
== 16)
2359 *d16
++ = (CARD16
) val
;
2365 /* Convert an array of C values to a Lisp list.
2366 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2367 DATA is a C array of values to be converted.
2368 TYPE is the type of the data. Only XA_ATOM is special, it converts
2369 each number in DATA to its corresponfing X atom as a symbol.
2370 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2372 SIZE is the number of elements in DATA.
2374 Also see comment for selection_data_to_lisp_data above. */
2377 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2379 unsigned char *data
;
2384 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2385 data
, size
*format
/8, type
, format
);
2388 /* Get the mouse position frame relative coordinates. */
2391 mouse_position_for_drop (f
, x
, y
)
2396 Window root
, dummy_window
;
2401 XQueryPointer (FRAME_X_DISPLAY (f
),
2402 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2404 /* The root window which contains the pointer. */
2407 /* Window pointer is on, not used */
2410 /* The position on that root window. */
2413 /* x/y in dummy_window coordinates, not used. */
2416 /* Modifier keys and pointer buttons, about which
2418 (unsigned int *) &dummy
);
2421 /* Absolute to relative. */
2422 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2423 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2428 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2429 Sx_get_atom_name
, 1, 2, 0,
2430 doc
: /* Return the X atom name for VALUE as a string.
2431 VALUE may be a number or a cons where the car is the upper 16 bits and
2432 the cdr is the lower 16 bits of a 32 bit value.
2433 Use the display for FRAME or the current frame if FRAME is not given or nil.
2435 If the value is 0 or the atom is not known, return the empty string. */)
2437 Lisp_Object value
, frame
;
2439 struct frame
*f
= check_x_frame (frame
);
2441 Lisp_Object ret
= Qnil
;
2443 Display
*dpy
= FRAME_X_DISPLAY (f
);
2446 if (INTEGERP (value
))
2447 atom
= (Atom
) XUINT (value
);
2448 else if (FLOATP (value
))
2449 atom
= (Atom
) XFLOAT (value
);
2450 else if (CONSP (value
))
2451 atom
= (Atom
) cons_to_long (value
);
2453 error ("Wrong type, value must be number or cons");
2456 count
= x_catch_errors (dpy
);
2458 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2460 if (! x_had_errors_p (dpy
))
2461 ret
= make_string (name
, strlen (name
));
2463 x_uncatch_errors (dpy
, count
);
2465 if (atom
&& name
) XFree (name
);
2466 if (NILP (ret
)) ret
= make_string ("", 0);
2473 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2474 TODO: Check if this client event really is a DND event? */
2477 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2479 XClientMessageEvent
*event
;
2480 struct x_display_info
*dpyinfo
;
2481 struct input_event
*bufp
;
2485 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2488 XSETFRAME (frame
, f
);
2490 vec
= Fmake_vector (4, Qnil
);
2491 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2492 event
->message_type
));
2493 AREF (vec
, 1) = frame
;
2494 AREF (vec
, 2) = XFASTINT (event
->format
);
2495 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2497 event
->message_type
,
2501 mouse_position_for_drop (f
, &x
, &y
);
2502 bufp
->kind
= DRAG_N_DROP_EVENT
;
2503 bufp
->frame_or_window
= Fcons (frame
, vec
);
2504 bufp
->timestamp
= CurrentTime
;
2505 bufp
->x
= make_number (x
);
2506 bufp
->y
= make_number (y
);
2508 bufp
->modifiers
= 0;
2513 DEFUN ("x-send-client-message", Fx_send_client_event
,
2514 Sx_send_client_message
, 6, 6, 0,
2515 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2517 For DISPLAY, specify either a frame or a display name (a string).
2518 If DISPLAY is nil, that stands for the selected frame's display.
2519 DEST may be a number, in which case it is a Window id. The value 0 may
2520 be used to send to the root window of the DISPLAY.
2521 If DEST is a cons, it is converted to a 32 bit number
2522 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2523 number is then used as a window id.
2524 If DEST is a frame the event is sent to the outer window of that frame.
2525 Nil means the currently selected frame.
2526 If DEST is the string "PointerWindow" the event is sent to the window that
2527 contains the pointer. If DEST is the string "InputFocus" the event is
2528 sent to the window that has the input focus.
2529 FROM is the frame sending the event. Use nil for currently selected frame.
2530 MESSAGE-TYPE is the name of an Atom as a string.
2531 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2532 bits. VALUES is a list of numbers, cons and/or strings containing the values
2533 to send. If a value is a string, it is converted to an Atom and the value of
2534 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2535 with the high 16 bits from the car and the lower 16 bit from the cdr.
2536 If more values than fits into the event is given, the excessive values
2538 (display
, dest
, from
, message_type
, format
, values
)
2539 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2541 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2546 struct frame
*f
= check_x_frame (from
);
2550 CHECK_STRING (message_type
);
2551 CHECK_NUMBER (format
);
2552 CHECK_CONS (values
);
2554 if (x_check_property_data (values
) == -1)
2555 error ("Bad data in VALUES, must be number, cons or string");
2557 event
.xclient
.type
= ClientMessage
;
2558 event
.xclient
.format
= XFASTINT (format
);
2560 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2561 && event
.xclient
.format
!= 32)
2562 error ("FORMAT must be one of 8, 16 or 32");
2564 if (FRAMEP (dest
) || NILP (dest
))
2566 struct frame
*fdest
= check_x_frame (dest
);
2567 wdest
= FRAME_OUTER_WINDOW (fdest
);
2569 else if (STRINGP (dest
))
2571 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2572 wdest
= PointerWindow
;
2573 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2576 error ("DEST as a string must be one of PointerWindow or InputFocus");
2578 else if (INTEGERP (dest
))
2579 wdest
= (Window
) XFASTINT (dest
);
2580 else if (FLOATP (dest
))
2581 wdest
= (Window
) XFLOAT (dest
);
2582 else if (CONSP (dest
))
2584 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2585 error ("Both car and cdr for DEST must be numbers");
2587 wdest
= (Window
) cons_to_long (dest
);
2590 error ("DEST must be a frame, nil, string, number or cons");
2592 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2593 to_root
= wdest
== dpyinfo
->root_window
;
2595 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2600 event
.xclient
.message_type
2601 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2602 event
.xclient
.display
= dpyinfo
->display
;
2604 /* Some clients (metacity for example) expects sending window to be here
2605 when sending to the root window. */
2606 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2608 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2609 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2610 event
.xclient
.format
);
2612 /* If event mask is 0 the event is sent to the client that created
2613 the destination window. But if we are sending to the root window,
2614 there is no such client. Then we set the event mask to 0xffff. The
2615 event then goes to clients selecting for events on the root window. */
2616 count
= x_catch_errors (dpyinfo
->display
);
2618 int propagate
= to_root
? False
: True
;
2619 unsigned mask
= to_root
? 0xffff : 0;
2620 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2621 XFlush (dpyinfo
->display
);
2623 x_uncatch_errors (dpyinfo
->display
, count
);
2633 defsubr (&Sx_get_selection_internal
);
2634 defsubr (&Sx_own_selection_internal
);
2635 defsubr (&Sx_disown_selection_internal
);
2636 defsubr (&Sx_selection_owner_p
);
2637 defsubr (&Sx_selection_exists_p
);
2639 #ifdef CUT_BUFFER_SUPPORT
2640 defsubr (&Sx_get_cut_buffer_internal
);
2641 defsubr (&Sx_store_cut_buffer_internal
);
2642 defsubr (&Sx_rotate_cut_buffers_internal
);
2645 defsubr (&Sx_get_atom_name
);
2646 defsubr (&Sx_send_client_message
);
2648 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2649 staticpro (&reading_selection_reply
);
2650 reading_selection_window
= 0;
2651 reading_which_selection
= 0;
2653 property_change_wait_list
= 0;
2654 prop_location_identifier
= 0;
2655 property_change_reply
= Fcons (Qnil
, Qnil
);
2656 staticpro (&property_change_reply
);
2658 Vselection_alist
= Qnil
;
2659 staticpro (&Vselection_alist
);
2661 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2662 doc
: /* An alist associating X Windows selection-types with functions.
2663 These functions are called to convert the selection, with three args:
2664 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2665 a desired type to which the selection should be converted;
2666 and the local selection value (whatever was given to `x-own-selection').
2668 The function should return the value to send to the X server
2669 \(typically a string). A return value of nil
2670 means that the conversion could not be done.
2671 A return value which is the symbol `NULL'
2672 means that a side-effect was executed,
2673 and there is no meaningful selection value. */);
2674 Vselection_converter_alist
= Qnil
;
2676 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2677 doc
: /* A list of functions to be called when Emacs loses an X selection.
2678 \(This happens when some other X client makes its own selection
2679 or when a Lisp program explicitly clears the selection.)
2680 The functions are called with one argument, the selection type
2681 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2682 Vx_lost_selection_hooks
= Qnil
;
2684 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2685 doc
: /* A list of functions to be called when Emacs answers a selection request.
2686 The functions are called with four arguments:
2687 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2688 - the selection-type which Emacs was asked to convert the
2689 selection into before sending (for example, `STRING' or `LENGTH');
2690 - a flag indicating success or failure for responding to the request.
2691 We might have failed (and declined the request) for any number of reasons,
2692 including being asked for a selection that we no longer own, or being asked
2693 to convert into a type that we don't know about or that is inappropriate.
2694 This hook doesn't let you change the behavior of Emacs's selection replies,
2695 it merely informs you that they have happened. */);
2696 Vx_sent_selection_hooks
= Qnil
;
2698 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2699 doc
: /* Coding system for communicating with other X clients.
2700 When sending or receiving text via cut_buffer, selection, and clipboard,
2701 the text is encoded or decoded by this coding system.
2702 The default value is `compound-text-with-extensions'. */);
2703 Vselection_coding_system
= intern ("compound-text-with-extensions");
2705 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2706 doc
: /* Coding system for the next communication with other X clients.
2707 Usually, `selection-coding-system' is used for communicating with
2708 other X clients. But, if this variable is set, it is used for the
2709 next communication only. After the communication, this variable is
2711 Vnext_selection_coding_system
= Qnil
;
2713 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2714 doc
: /* Number of milliseconds to wait for a selection reply.
2715 If the selection owner doesn't reply in this time, we give up.
2716 A value of 0 means wait as long as necessary. This is initialized from the
2717 \"*selectionTimeout\" resource. */);
2718 x_selection_timeout
= 0;
2720 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2721 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2722 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2723 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2724 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2725 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2726 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2727 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2728 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2729 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2730 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2731 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2732 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2733 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2734 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2735 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2736 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2737 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2738 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2739 staticpro (&Qcompound_text_with_extensions
);
2741 #ifdef CUT_BUFFER_SUPPORT
2742 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2743 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2744 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2745 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2746 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2747 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2748 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2749 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2752 Qforeign_selection
= intern ("foreign-selection");
2753 staticpro (&Qforeign_selection
);
2756 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2757 (do not change this comment) */