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 */
27 #include "xterm.h" /* for all of the X includes */
28 #include "dispextern.h" /* frame.h seems to want this */
29 #include "frame.h" /* Need this to get the X window of selected_frame */
30 #include "blockinput.h"
33 #include "termhooks.h"
35 #include <X11/Xproto.h>
39 static Lisp_Object x_atom_to_symbol
P_ ((Display
*dpy
, Atom atom
));
40 static Atom symbol_to_x_atom
P_ ((struct x_display_info
*, Display
*,
42 static void x_own_selection
P_ ((Lisp_Object
, Lisp_Object
));
43 static Lisp_Object x_get_local_selection
P_ ((Lisp_Object
, Lisp_Object
, int));
44 static void x_decline_selection_request
P_ ((struct input_event
*));
45 static Lisp_Object x_selection_request_lisp_error
P_ ((Lisp_Object
));
46 static Lisp_Object queue_selection_requests_unwind
P_ ((Lisp_Object
));
47 static Lisp_Object some_frame_on_display
P_ ((struct x_display_info
*));
48 static void x_reply_selection_request
P_ ((struct input_event
*, int,
49 unsigned char *, int, Atom
));
50 static int waiting_for_other_props_on_window
P_ ((Display
*, Window
));
51 static struct prop_location
*expect_property_change
P_ ((Display
*, Window
,
53 static void unexpect_property_change
P_ ((struct prop_location
*));
54 static Lisp_Object wait_for_property_change_unwind
P_ ((Lisp_Object
));
55 static void wait_for_property_change
P_ ((struct prop_location
*));
56 static Lisp_Object x_get_foreign_selection
P_ ((Lisp_Object
, Lisp_Object
));
57 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
58 unsigned char **, int *,
59 Atom
*, int *, unsigned long *, int));
60 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
61 Lisp_Object
, unsigned,
62 unsigned char **, int *,
63 Atom
*, int *, unsigned long *));
64 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
67 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
69 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
70 unsigned char **, Atom
*,
71 unsigned *, int *, int *));
72 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
73 static void initialize_cut_buffers
P_ ((Display
*, Window
));
76 /* Printing traces to stderr. */
78 #ifdef TRACE_SELECTION
80 fprintf (stderr, "%d: " fmt "\n", getpid ())
81 #define TRACE1(fmt, a0) \
82 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
83 #define TRACE2(fmt, a0, a1) \
84 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
86 #define TRACE0(fmt) (void) 0
87 #define TRACE1(fmt, a0) (void) 0
88 #define TRACE2(fmt, a0, a1) (void) 0
92 #define CUT_BUFFER_SUPPORT
94 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
95 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
98 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
99 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
101 Lisp_Object Qcompound_text_with_extensions
;
103 #ifdef CUT_BUFFER_SUPPORT
104 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
105 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
108 static Lisp_Object Vx_lost_selection_hooks
;
109 static Lisp_Object Vx_sent_selection_hooks
;
110 /* Coding system for communicating with other X clients via cutbuffer,
111 selection, and clipboard. */
112 static Lisp_Object Vselection_coding_system
;
114 /* Coding system for the next communicating with other X clients. */
115 static Lisp_Object Vnext_selection_coding_system
;
117 static Lisp_Object Qforeign_selection
;
119 /* If this is a smaller number than the max-request-size of the display,
120 emacs will use INCR selection transfer when the selection is larger
121 than this. The max-request-size is usually around 64k, so if you want
122 emacs to use incremental selection transfers when the selection is
123 smaller than that, set this. I added this mostly for debugging the
124 incremental transfer stuff, but it might improve server performance. */
125 #define MAX_SELECTION_QUANTUM 0xFFFFFF
128 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
130 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
133 /* The timestamp of the last input event Emacs received from the X server. */
134 /* Defined in keyboard.c. */
135 extern unsigned long last_event_timestamp
;
137 /* This is an association list whose elements are of the form
138 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
139 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
140 SELECTION-VALUE is the value that emacs owns for that selection.
141 It may be any kind of Lisp object.
142 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
143 as a cons of two 16-bit numbers (making a 32 bit time.)
144 FRAME is the frame for which we made the selection.
145 If there is an entry in this alist, then it can be assumed that Emacs owns
147 The only (eq) parts of this list that are visible from Lisp are the
149 static Lisp_Object Vselection_alist
;
151 /* This is an alist whose CARs are selection-types (whose names are the same
152 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
153 call to convert the given Emacs selection value to a string representing
154 the given selection type. This is for Lisp-level extension of the emacs
155 selection handling. */
156 static Lisp_Object Vselection_converter_alist
;
158 /* If the selection owner takes too long to reply to a selection request,
159 we give up on it. This is in milliseconds (0 = no timeout.) */
160 static EMACS_INT x_selection_timeout
;
162 /* Utility functions */
164 static void lisp_data_to_selection_data ();
165 static Lisp_Object
selection_data_to_lisp_data ();
166 static Lisp_Object
x_get_window_property_as_lisp_data ();
168 /* This converts a Lisp symbol to a server Atom, avoiding a server
169 roundtrip whenever possible. */
172 symbol_to_x_atom (dpyinfo
, display
, sym
)
173 struct x_display_info
*dpyinfo
;
178 if (NILP (sym
)) return 0;
179 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
180 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
181 if (EQ (sym
, QSTRING
)) return XA_STRING
;
182 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
183 if (EQ (sym
, QATOM
)) return XA_ATOM
;
184 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
185 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
186 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
187 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
188 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
189 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
190 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
191 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
192 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
193 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
194 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
195 #ifdef CUT_BUFFER_SUPPORT
196 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
197 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
198 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
199 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
200 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
201 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
202 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
203 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
205 if (!SYMBOLP (sym
)) abort ();
207 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
209 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
215 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
216 and calls to intern whenever possible. */
219 x_atom_to_symbol (dpy
, atom
)
223 struct x_display_info
*dpyinfo
;
242 #ifdef CUT_BUFFER_SUPPORT
262 dpyinfo
= x_display_info_for_display (dpy
);
263 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
265 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
267 if (atom
== dpyinfo
->Xatom_TEXT
)
269 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
270 return QCOMPOUND_TEXT
;
271 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
273 if (atom
== dpyinfo
->Xatom_DELETE
)
275 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
277 if (atom
== dpyinfo
->Xatom_INCR
)
279 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
281 if (atom
== dpyinfo
->Xatom_TARGETS
)
283 if (atom
== dpyinfo
->Xatom_NULL
)
287 str
= XGetAtomName (dpy
, atom
);
289 TRACE1 ("XGetAtomName --> %s", str
);
290 if (! str
) return Qnil
;
293 /* This was allocated by Xlib, so use XFree. */
299 /* Do protocol to assert ourself as a selection owner.
300 Update the Vselection_alist so that we can reply to later requests for
304 x_own_selection (selection_name
, selection_value
)
305 Lisp_Object selection_name
, selection_value
;
307 struct frame
*sf
= SELECTED_FRAME ();
308 Window selecting_window
= FRAME_X_WINDOW (sf
);
309 Display
*display
= FRAME_X_DISPLAY (sf
);
310 Time time
= last_event_timestamp
;
312 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
315 CHECK_SYMBOL (selection_name
);
316 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
319 count
= x_catch_errors (display
);
320 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
321 x_check_errors (display
, "Can't set selection: %s");
322 x_uncatch_errors (display
, count
);
325 /* Now update the local cache */
327 Lisp_Object selection_time
;
328 Lisp_Object selection_data
;
329 Lisp_Object prev_value
;
331 selection_time
= long_to_cons ((unsigned long) time
);
332 selection_data
= Fcons (selection_name
,
333 Fcons (selection_value
,
334 Fcons (selection_time
,
335 Fcons (selected_frame
, Qnil
))));
336 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
338 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
340 /* If we already owned the selection, remove the old selection data.
341 Perhaps we should destructively modify it instead.
342 Don't use Fdelq as that may QUIT. */
343 if (!NILP (prev_value
))
345 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
346 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
347 if (EQ (prev_value
, Fcar (XCDR (rest
))))
349 XSETCDR (rest
, Fcdr (XCDR (rest
)));
356 /* Given a selection-name and desired type, look up our local copy of
357 the selection value and convert it to the type.
358 The value is nil or a string.
359 This function is used both for remote requests (LOCAL_REQUEST is zero)
360 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
362 This calls random Lisp code, and may signal or gc. */
365 x_get_local_selection (selection_symbol
, target_type
, local_request
)
366 Lisp_Object selection_symbol
, target_type
;
369 Lisp_Object local_value
;
370 Lisp_Object handler_fn
, value
, type
, check
;
373 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
375 if (NILP (local_value
)) return Qnil
;
377 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
378 if (EQ (target_type
, QTIMESTAMP
))
381 value
= XCAR (XCDR (XCDR (local_value
)));
384 else if (EQ (target_type
, QDELETE
))
387 Fx_disown_selection_internal
389 XCAR (XCDR (XCDR (local_value
))));
394 #if 0 /* #### MULTIPLE doesn't work yet */
395 else if (CONSP (target_type
)
396 && XCAR (target_type
) == QMULTIPLE
)
401 pairs
= XCDR (target_type
);
402 size
= XVECTOR (pairs
)->size
;
403 /* If the target is MULTIPLE, then target_type looks like
404 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
405 We modify the second element of each pair in the vector and
406 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
408 for (i
= 0; i
< size
; i
++)
411 pair
= XVECTOR (pairs
)->contents
[i
];
412 XVECTOR (pair
)->contents
[1]
413 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
414 XVECTOR (pair
)->contents
[1],
422 /* Don't allow a quit within the converter.
423 When the user types C-g, he would be surprised
424 if by luck it came during a converter. */
425 count
= SPECPDL_INDEX ();
426 specbind (Qinhibit_quit
, Qt
);
428 CHECK_SYMBOL (target_type
);
429 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
430 /* gcpro is not needed here since nothing but HANDLER_FN
431 is live, and that ought to be a symbol. */
433 if (!NILP (handler_fn
))
434 value
= call3 (handler_fn
,
435 selection_symbol
, (local_request
? Qnil
: target_type
),
436 XCAR (XCDR (local_value
)));
439 unbind_to (count
, Qnil
);
442 /* Make sure this value is of a type that we could transmit
443 to another X client. */
447 && SYMBOLP (XCAR (value
)))
449 check
= XCDR (value
);
457 /* Check for a value that cons_to_long could handle. */
458 else if (CONSP (check
)
459 && INTEGERP (XCAR (check
))
460 && (INTEGERP (XCDR (check
))
462 (CONSP (XCDR (check
))
463 && INTEGERP (XCAR (XCDR (check
)))
464 && NILP (XCDR (XCDR (check
))))))
469 Fcons (build_string ("invalid data returned by selection-conversion function"),
470 Fcons (handler_fn
, Fcons (value
, Qnil
))));
473 /* Subroutines of x_reply_selection_request. */
475 /* Send a SelectionNotify event to the requestor with property=None,
476 meaning we were unable to do what they wanted. */
479 x_decline_selection_request (event
)
480 struct input_event
*event
;
482 XSelectionEvent reply
;
485 reply
.type
= SelectionNotify
;
486 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
487 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
488 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
489 reply
.time
= SELECTION_EVENT_TIME (event
);
490 reply
.target
= SELECTION_EVENT_TARGET (event
);
491 reply
.property
= None
;
493 /* The reason for the error may be that the receiver has
494 died in the meantime. Handle that case. */
496 count
= x_catch_errors (reply
.display
);
497 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
498 XFlush (reply
.display
);
499 x_uncatch_errors (reply
.display
, count
);
503 /* This is the selection request currently being processed.
504 It is set to zero when the request is fully processed. */
505 static struct input_event
*x_selection_current_request
;
507 /* Display info in x_selection_request. */
509 static struct x_display_info
*selection_request_dpyinfo
;
511 /* Used as an unwind-protect clause so that, if a selection-converter signals
512 an error, we tell the requester that we were unable to do what they wanted
513 before we throw to top-level or go into the debugger or whatever. */
516 x_selection_request_lisp_error (ignore
)
519 if (x_selection_current_request
!= 0
520 && selection_request_dpyinfo
->display
)
521 x_decline_selection_request (x_selection_current_request
);
526 /* This stuff is so that INCR selections are reentrant (that is, so we can
527 be servicing multiple INCR selection requests simultaneously.) I haven't
528 actually tested that yet. */
530 /* Keep a list of the property changes that are awaited. */
540 struct prop_location
*next
;
543 static struct prop_location
*expect_property_change ();
544 static void wait_for_property_change ();
545 static void unexpect_property_change ();
546 static int waiting_for_other_props_on_window ();
548 static int prop_location_identifier
;
550 static Lisp_Object property_change_reply
;
552 static struct prop_location
*property_change_reply_object
;
554 static struct prop_location
*property_change_wait_list
;
557 queue_selection_requests_unwind (frame
)
560 FRAME_PTR f
= XFRAME (frame
);
563 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
567 /* Return some frame whose display info is DPYINFO.
568 Return nil if there is none. */
571 some_frame_on_display (dpyinfo
)
572 struct x_display_info
*dpyinfo
;
574 Lisp_Object list
, frame
;
576 FOR_EACH_FRAME (list
, frame
)
578 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
585 /* Send the reply to a selection request event EVENT.
586 TYPE is the type of selection data requested.
587 DATA and SIZE describe the data to send, already converted.
588 FORMAT is the unit-size (in bits) of the data to be transmitted. */
591 x_reply_selection_request (event
, format
, data
, size
, type
)
592 struct input_event
*event
;
597 XSelectionEvent reply
;
598 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
599 Window window
= SELECTION_EVENT_REQUESTOR (event
);
601 int format_bytes
= format
/8;
602 int max_bytes
= SELECTION_QUANTUM (display
);
603 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
606 if (max_bytes
> MAX_SELECTION_QUANTUM
)
607 max_bytes
= MAX_SELECTION_QUANTUM
;
609 reply
.type
= SelectionNotify
;
610 reply
.display
= display
;
611 reply
.requestor
= window
;
612 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
613 reply
.time
= SELECTION_EVENT_TIME (event
);
614 reply
.target
= SELECTION_EVENT_TARGET (event
);
615 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
616 if (reply
.property
== None
)
617 reply
.property
= reply
.target
;
619 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
621 count
= x_catch_errors (display
);
623 /* Store the data on the requested property.
624 If the selection is large, only store the first N bytes of it.
626 bytes_remaining
= size
* format_bytes
;
627 if (bytes_remaining
<= max_bytes
)
629 /* Send all the data at once, with minimal handshaking. */
630 TRACE1 ("Sending all %d bytes", bytes_remaining
);
631 XChangeProperty (display
, window
, reply
.property
, type
, format
,
632 PropModeReplace
, data
, size
);
633 /* At this point, the selection was successfully stored; ack it. */
634 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
638 /* Send an INCR selection. */
639 struct prop_location
*wait_object
;
643 frame
= some_frame_on_display (dpyinfo
);
645 /* If the display no longer has frames, we can't expect
646 to get many more selection requests from it, so don't
647 bother trying to queue them. */
650 x_start_queuing_selection_requests (display
);
652 record_unwind_protect (queue_selection_requests_unwind
,
656 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
657 error ("Attempt to transfer an INCR to ourself!");
659 TRACE2 ("Start sending %d bytes incrementally (%s)",
660 bytes_remaining
, XGetAtomName (display
, reply
.property
));
661 wait_object
= expect_property_change (display
, window
, reply
.property
,
664 TRACE1 ("Set %s to number of bytes to send",
665 XGetAtomName (display
, reply
.property
));
666 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
668 (unsigned char *) &bytes_remaining
, 1);
669 XSelectInput (display
, window
, PropertyChangeMask
);
671 /* Tell 'em the INCR data is there... */
672 TRACE0 ("Send SelectionNotify event");
673 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
676 had_errors
= x_had_errors_p (display
);
679 /* First, wait for the requester to ack by deleting the property.
680 This can run random lisp code (process handlers) or signal. */
683 TRACE1 ("Waiting for ACK (deletion of %s)",
684 XGetAtomName (display
, reply
.property
));
685 wait_for_property_change (wait_object
);
689 while (bytes_remaining
)
691 int i
= ((bytes_remaining
< max_bytes
)
698 = expect_property_change (display
, window
, reply
.property
,
701 TRACE1 ("Sending increment of %d bytes", i
);
702 TRACE1 ("Set %s to increment data",
703 XGetAtomName (display
, reply
.property
));
705 /* Append the next chunk of data to the property. */
706 XChangeProperty (display
, window
, reply
.property
, type
, format
,
707 PropModeAppend
, data
, i
/ format_bytes
);
708 bytes_remaining
-= i
;
711 had_errors
= x_had_errors_p (display
);
717 /* Now wait for the requester to ack this chunk by deleting the
718 property. This can run random lisp code or signal. */
719 TRACE1 ("Waiting for increment ACK (deletion of %s)",
720 XGetAtomName (display
, reply
.property
));
721 wait_for_property_change (wait_object
);
724 /* Now write a zero-length chunk to the property to tell the
725 requester that we're done. */
727 if (! waiting_for_other_props_on_window (display
, window
))
728 XSelectInput (display
, window
, 0L);
730 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
731 XGetAtomName (display
, reply
.property
));
732 XChangeProperty (display
, window
, reply
.property
, type
, format
,
733 PropModeReplace
, data
, 0);
734 TRACE0 ("Done sending incrementally");
737 /* rms, 2003-01-03: I think I have fixed this bug. */
738 /* The window we're communicating with may have been deleted
739 in the meantime (that's a real situation from a bug report).
740 In this case, there may be events in the event queue still
741 refering to the deleted window, and we'll get a BadWindow error
742 in XTread_socket when processing the events. I don't have
743 an idea how to fix that. gerd, 2001-01-98. */
745 x_uncatch_errors (display
, count
);
749 /* Handle a SelectionRequest event EVENT.
750 This is called from keyboard.c when such an event is found in the queue. */
753 x_handle_selection_request (event
)
754 struct input_event
*event
;
756 struct gcpro gcpro1
, gcpro2
, gcpro3
;
757 Lisp_Object local_selection_data
;
758 Lisp_Object selection_symbol
;
759 Lisp_Object target_symbol
;
760 Lisp_Object converted_selection
;
761 Time local_selection_time
;
762 Lisp_Object successful_p
;
764 struct x_display_info
*dpyinfo
765 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
767 local_selection_data
= Qnil
;
768 target_symbol
= Qnil
;
769 converted_selection
= Qnil
;
772 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
774 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
775 SELECTION_EVENT_SELECTION (event
));
777 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
779 if (NILP (local_selection_data
))
781 /* Someone asked for the selection, but we don't have it any more.
783 x_decline_selection_request (event
);
787 local_selection_time
= (Time
)
788 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
790 if (SELECTION_EVENT_TIME (event
) != CurrentTime
791 && local_selection_time
> SELECTION_EVENT_TIME (event
))
793 /* Someone asked for the selection, and we have one, but not the one
796 x_decline_selection_request (event
);
800 x_selection_current_request
= event
;
801 count
= SPECPDL_INDEX ();
802 selection_request_dpyinfo
= dpyinfo
;
803 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
805 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
806 SELECTION_EVENT_TARGET (event
));
808 #if 0 /* #### MULTIPLE doesn't work yet */
809 if (EQ (target_symbol
, QMULTIPLE
))
810 target_symbol
= fetch_multiple_target (event
);
813 /* Convert lisp objects back into binary data */
816 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
818 if (! NILP (converted_selection
))
826 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
828 &data
, &type
, &size
, &format
, &nofree
);
830 x_reply_selection_request (event
, format
, data
, size
, type
);
833 /* Indicate we have successfully processed this event. */
834 x_selection_current_request
= 0;
836 /* Use xfree, not XFree, because lisp_data_to_selection_data
837 calls xmalloc itself. */
841 unbind_to (count
, Qnil
);
845 /* Let random lisp code notice that the selection has been asked for. */
848 rest
= Vx_sent_selection_hooks
;
849 if (!EQ (rest
, Qunbound
))
850 for (; CONSP (rest
); rest
= Fcdr (rest
))
851 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
857 /* Handle a SelectionClear event EVENT, which indicates that some
858 client cleared out our previously asserted selection.
859 This is called from keyboard.c when such an event is found in the queue. */
862 x_handle_selection_clear (event
)
863 struct input_event
*event
;
865 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
866 Atom selection
= SELECTION_EVENT_SELECTION (event
);
867 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
869 Lisp_Object selection_symbol
, local_selection_data
;
870 Time local_selection_time
;
871 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
872 struct x_display_info
*t_dpyinfo
;
874 /* If the new selection owner is also Emacs,
875 don't clear the new selection. */
877 /* Check each display on the same terminal,
878 to see if this Emacs job now owns the selection
879 through that display. */
880 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
881 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
884 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
885 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
893 selection_symbol
= x_atom_to_symbol (display
, selection
);
895 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
897 /* Well, we already believe that we don't own it, so that's just fine. */
898 if (NILP (local_selection_data
)) return;
900 local_selection_time
= (Time
)
901 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
903 /* This SelectionClear is for a selection that we no longer own, so we can
904 disregard it. (That is, we have reasserted the selection since this
905 request was generated.) */
907 if (changed_owner_time
!= CurrentTime
908 && local_selection_time
> changed_owner_time
)
911 /* Otherwise, we're really honest and truly being told to drop it.
912 Don't use Fdelq as that may QUIT;. */
914 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
915 Vselection_alist
= Fcdr (Vselection_alist
);
919 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
920 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
922 XSETCDR (rest
, Fcdr (XCDR (rest
)));
927 /* Let random lisp code notice that the selection has been stolen. */
931 rest
= Vx_lost_selection_hooks
;
932 if (!EQ (rest
, Qunbound
))
934 for (; CONSP (rest
); rest
= Fcdr (rest
))
935 call1 (Fcar (rest
), selection_symbol
);
936 prepare_menu_bars ();
937 redisplay_preserve_echo_area (20);
942 /* Clear all selections that were made from frame F.
943 We do this when about to delete a frame. */
946 x_clear_frame_selections (f
)
952 XSETFRAME (frame
, f
);
954 /* Otherwise, we're really honest and truly being told to drop it.
955 Don't use Fdelq as that may QUIT;. */
957 /* Delete elements from the beginning of Vselection_alist. */
958 while (!NILP (Vselection_alist
)
959 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
961 /* Let random Lisp code notice that the selection has been stolen. */
962 Lisp_Object hooks
, selection_symbol
;
964 hooks
= Vx_lost_selection_hooks
;
965 selection_symbol
= Fcar (Fcar (Vselection_alist
));
967 if (!EQ (hooks
, Qunbound
))
969 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
970 call1 (Fcar (hooks
), selection_symbol
);
971 #if 0 /* This can crash when deleting a frame
972 from x_connection_closed. Anyway, it seems unnecessary;
973 something else should cause a redisplay. */
974 redisplay_preserve_echo_area (21);
978 Vselection_alist
= Fcdr (Vselection_alist
);
981 /* Delete elements after the beginning of Vselection_alist. */
982 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
983 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
985 /* Let random Lisp code notice that the selection has been stolen. */
986 Lisp_Object hooks
, selection_symbol
;
988 hooks
= Vx_lost_selection_hooks
;
989 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
991 if (!EQ (hooks
, Qunbound
))
993 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
994 call1 (Fcar (hooks
), selection_symbol
);
995 #if 0 /* See above */
996 redisplay_preserve_echo_area (22);
999 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1004 /* Nonzero if any properties for DISPLAY and WINDOW
1005 are on the list of what we are waiting for. */
1008 waiting_for_other_props_on_window (display
, window
)
1012 struct prop_location
*rest
= property_change_wait_list
;
1014 if (rest
->display
== display
&& rest
->window
== window
)
1021 /* Add an entry to the list of property changes we are waiting for.
1022 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1023 The return value is a number that uniquely identifies
1024 this awaited property change. */
1026 static struct prop_location
*
1027 expect_property_change (display
, window
, property
, state
)
1033 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1034 pl
->identifier
= ++prop_location_identifier
;
1035 pl
->display
= display
;
1036 pl
->window
= window
;
1037 pl
->property
= property
;
1038 pl
->desired_state
= state
;
1039 pl
->next
= property_change_wait_list
;
1041 property_change_wait_list
= pl
;
1045 /* Delete an entry from the list of property changes we are waiting for.
1046 IDENTIFIER is the number that uniquely identifies the entry. */
1049 unexpect_property_change (location
)
1050 struct prop_location
*location
;
1052 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1055 if (rest
== location
)
1058 prev
->next
= rest
->next
;
1060 property_change_wait_list
= rest
->next
;
1069 /* Remove the property change expectation element for IDENTIFIER. */
1072 wait_for_property_change_unwind (identifierval
)
1073 Lisp_Object identifierval
;
1075 unexpect_property_change ((struct prop_location
*)
1076 (XFASTINT (XCAR (identifierval
)) << 16
1077 | XFASTINT (XCDR (identifierval
))));
1081 /* Actually wait for a property change.
1082 IDENTIFIER should be the value that expect_property_change returned. */
1085 wait_for_property_change (location
)
1086 struct prop_location
*location
;
1089 int count
= SPECPDL_INDEX ();
1092 tem
= Fcons (Qnil
, Qnil
);
1093 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1094 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1096 /* Make sure to do unexpect_property_change if we quit or err. */
1097 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1099 XSETCAR (property_change_reply
, Qnil
);
1101 property_change_reply_object
= location
;
1102 /* If the event we are waiting for arrives beyond here, it will set
1103 property_change_reply, because property_change_reply_object says so. */
1104 if (! location
->arrived
)
1106 secs
= x_selection_timeout
/ 1000;
1107 usecs
= (x_selection_timeout
% 1000) * 1000;
1108 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1109 wait_reading_process_input (secs
, usecs
, property_change_reply
, 0);
1111 if (NILP (XCAR (property_change_reply
)))
1113 TRACE0 (" Timed out");
1114 error ("Timed out waiting for property-notify event");
1118 unbind_to (count
, Qnil
);
1121 /* Called from XTread_socket in response to a PropertyNotify event. */
1124 x_handle_property_notify (event
)
1125 XPropertyEvent
*event
;
1127 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1131 if (rest
->property
== event
->atom
1132 && rest
->window
== event
->window
1133 && rest
->display
== event
->display
1134 && rest
->desired_state
== event
->state
)
1136 TRACE2 ("Expected %s of property %s",
1137 (event
->state
== PropertyDelete
? "deletion" : "change"),
1138 XGetAtomName (event
->display
, event
->atom
));
1142 /* If this is the one wait_for_property_change is waiting for,
1143 tell it to wake up. */
1144 if (rest
== property_change_reply_object
)
1145 XSETCAR (property_change_reply
, Qt
);
1148 prev
->next
= rest
->next
;
1150 property_change_wait_list
= rest
->next
;
1162 #if 0 /* #### MULTIPLE doesn't work yet */
1165 fetch_multiple_target (event
)
1166 XSelectionRequestEvent
*event
;
1168 Display
*display
= event
->display
;
1169 Window window
= event
->requestor
;
1170 Atom target
= event
->target
;
1171 Atom selection_atom
= event
->selection
;
1176 x_get_window_property_as_lisp_data (display
, window
, target
,
1177 QMULTIPLE
, selection_atom
));
1181 copy_multiple_data (obj
)
1188 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1191 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1192 for (i
= 0; i
< size
; i
++)
1194 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1195 CHECK_VECTOR (vec2
);
1196 if (XVECTOR (vec2
)->size
!= 2)
1197 /* ??? Confusing error message */
1198 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1199 Fcons (vec2
, Qnil
)));
1200 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1201 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1202 = XVECTOR (vec2
)->contents
[0];
1203 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1204 = XVECTOR (vec2
)->contents
[1];
1212 /* Variables for communication with x_handle_selection_notify. */
1213 static Atom reading_which_selection
;
1214 static Lisp_Object reading_selection_reply
;
1215 static Window reading_selection_window
;
1217 /* Do protocol to read selection-data from the server.
1218 Converts this to Lisp data and returns it. */
1221 x_get_foreign_selection (selection_symbol
, target_type
)
1222 Lisp_Object selection_symbol
, target_type
;
1224 struct frame
*sf
= SELECTED_FRAME ();
1225 Window requestor_window
= FRAME_X_WINDOW (sf
);
1226 Display
*display
= FRAME_X_DISPLAY (sf
);
1227 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1228 Time requestor_time
= last_event_timestamp
;
1229 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1230 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1236 if (CONSP (target_type
))
1237 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1239 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1243 count
= x_catch_errors (display
);
1245 TRACE2 ("Get selection %s, type %s",
1246 XGetAtomName (display
, type_atom
),
1247 XGetAtomName (display
, target_property
));
1249 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1250 requestor_window
, requestor_time
);
1253 /* Prepare to block until the reply has been read. */
1254 reading_selection_window
= requestor_window
;
1255 reading_which_selection
= selection_atom
;
1256 XSETCAR (reading_selection_reply
, Qnil
);
1258 frame
= some_frame_on_display (dpyinfo
);
1260 /* If the display no longer has frames, we can't expect
1261 to get many more selection requests from it, so don't
1262 bother trying to queue them. */
1265 x_start_queuing_selection_requests (display
);
1267 record_unwind_protect (queue_selection_requests_unwind
,
1272 /* This allows quits. Also, don't wait forever. */
1273 secs
= x_selection_timeout
/ 1000;
1274 usecs
= (x_selection_timeout
% 1000) * 1000;
1275 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1276 wait_reading_process_input (secs
, usecs
, reading_selection_reply
, 0);
1277 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1280 x_check_errors (display
, "Cannot get selection: %s");
1281 x_uncatch_errors (display
, count
);
1284 if (NILP (XCAR (reading_selection_reply
)))
1285 error ("Timed out waiting for reply from selection owner");
1286 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1287 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1289 /* Otherwise, the selection is waiting for us on the requested property. */
1291 x_get_window_property_as_lisp_data (display
, requestor_window
,
1292 target_property
, target_type
,
1296 /* Subroutines of x_get_window_property_as_lisp_data */
1298 /* Use xfree, not XFree, to free the data obtained with this function. */
1301 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1302 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1307 unsigned char **data_ret
;
1309 Atom
*actual_type_ret
;
1310 int *actual_format_ret
;
1311 unsigned long *actual_size_ret
;
1315 unsigned long bytes_remaining
;
1317 unsigned char *tmp_data
= 0;
1319 int buffer_size
= SELECTION_QUANTUM (display
);
1321 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1322 buffer_size
= MAX_SELECTION_QUANTUM
;
1326 /* First probe the thing to find out how big it is. */
1327 result
= XGetWindowProperty (display
, window
, property
,
1328 0L, 0L, False
, AnyPropertyType
,
1329 actual_type_ret
, actual_format_ret
,
1331 &bytes_remaining
, &tmp_data
);
1332 if (result
!= Success
)
1340 /* This was allocated by Xlib, so use XFree. */
1341 XFree ((char *) tmp_data
);
1343 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1349 total_size
= bytes_remaining
+ 1;
1350 *data_ret
= (unsigned char *) xmalloc (total_size
);
1352 /* Now read, until we've gotten it all. */
1353 while (bytes_remaining
)
1355 #ifdef TRACE_SELECTION
1356 int last
= bytes_remaining
;
1359 = XGetWindowProperty (display
, window
, property
,
1360 (long)offset
/4, (long)buffer_size
/4,
1363 actual_type_ret
, actual_format_ret
,
1364 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1366 TRACE2 ("Read %ld bytes from property %s",
1367 last
- bytes_remaining
,
1368 XGetAtomName (display
, property
));
1370 /* If this doesn't return Success at this point, it means that
1371 some clod deleted the selection while we were in the midst of
1372 reading it. Deal with that, I guess.... */
1373 if (result
!= Success
)
1375 *actual_size_ret
*= *actual_format_ret
/ 8;
1376 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1377 offset
+= *actual_size_ret
;
1379 /* This was allocated by Xlib, so use XFree. */
1380 XFree ((char *) tmp_data
);
1385 *bytes_ret
= offset
;
1388 /* Use xfree, not XFree, to free the data obtained with this function. */
1391 receive_incremental_selection (display
, window
, property
, target_type
,
1392 min_size_bytes
, data_ret
, size_bytes_ret
,
1393 type_ret
, format_ret
, size_ret
)
1397 Lisp_Object target_type
; /* for error messages only */
1398 unsigned int min_size_bytes
;
1399 unsigned char **data_ret
;
1400 int *size_bytes_ret
;
1402 unsigned long *size_ret
;
1406 struct prop_location
*wait_object
;
1407 *size_bytes_ret
= min_size_bytes
;
1408 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1410 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1412 /* At this point, we have read an INCR property.
1413 Delete the property to ack it.
1414 (But first, prepare to receive the next event in this handshake.)
1416 Now, we must loop, waiting for the sending window to put a value on
1417 that property, then reading the property, then deleting it to ack.
1418 We are done when the sender places a property of length 0.
1421 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1422 TRACE1 (" Delete property %s",
1423 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1424 XDeleteProperty (display
, window
, property
);
1425 TRACE1 (" Expect new value of property %s",
1426 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1427 wait_object
= expect_property_change (display
, window
, property
,
1434 unsigned char *tmp_data
;
1437 TRACE0 (" Wait for property change");
1438 wait_for_property_change (wait_object
);
1440 /* expect it again immediately, because x_get_window_property may
1441 .. no it won't, I don't get it.
1442 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1443 TRACE0 (" Get property value");
1444 x_get_window_property (display
, window
, property
,
1445 &tmp_data
, &tmp_size_bytes
,
1446 type_ret
, format_ret
, size_ret
, 1);
1448 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1450 if (tmp_size_bytes
== 0) /* we're done */
1452 TRACE0 ("Done reading incrementally");
1454 if (! waiting_for_other_props_on_window (display
, window
))
1455 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1456 unexpect_property_change (wait_object
);
1457 /* Use xfree, not XFree, because x_get_window_property
1458 calls xmalloc itself. */
1459 if (tmp_data
) xfree (tmp_data
);
1464 TRACE1 (" ACK by deleting property %s",
1465 XGetAtomName (display
, property
));
1466 XDeleteProperty (display
, window
, property
);
1467 wait_object
= expect_property_change (display
, window
, property
,
1472 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1474 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1475 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1478 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1479 offset
+= tmp_size_bytes
;
1481 /* Use xfree, not XFree, because x_get_window_property
1482 calls xmalloc itself. */
1488 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1489 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1490 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1493 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1498 Lisp_Object target_type
; /* for error messages only */
1499 Atom selection_atom
; /* for error messages only */
1503 unsigned long actual_size
;
1504 unsigned char *data
= 0;
1507 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1509 TRACE0 ("Reading selection data");
1511 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1512 &actual_type
, &actual_format
, &actual_size
, 1);
1515 int there_is_a_selection_owner
;
1517 there_is_a_selection_owner
1518 = XGetSelectionOwner (display
, selection_atom
);
1521 there_is_a_selection_owner
1522 ? Fcons (build_string ("selection owner couldn't convert"),
1524 ? Fcons (target_type
,
1525 Fcons (x_atom_to_symbol (display
,
1528 : Fcons (target_type
, Qnil
))
1529 : Fcons (build_string ("no selection"),
1530 Fcons (x_atom_to_symbol (display
,
1535 if (actual_type
== dpyinfo
->Xatom_INCR
)
1537 /* That wasn't really the data, just the beginning. */
1539 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1541 /* Use xfree, not XFree, because x_get_window_property
1542 calls xmalloc itself. */
1543 xfree ((char *) data
);
1545 receive_incremental_selection (display
, window
, property
, target_type
,
1546 min_size_bytes
, &data
, &bytes
,
1547 &actual_type
, &actual_format
,
1552 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1553 XDeleteProperty (display
, window
, property
);
1557 /* It's been read. Now convert it to a lisp object in some semi-rational
1559 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1560 actual_type
, actual_format
);
1562 /* Use xfree, not XFree, because x_get_window_property
1563 calls xmalloc itself. */
1564 xfree ((char *) data
);
1568 /* These functions convert from the selection data read from the server into
1569 something that we can use from Lisp, and vice versa.
1571 Type: Format: Size: Lisp Type:
1572 ----- ------- ----- -----------
1575 ATOM 32 > 1 Vector of Symbols
1577 * 16 > 1 Vector of Integers
1578 * 32 1 if <=16 bits: Integer
1579 if > 16 bits: Cons of top16, bot16
1580 * 32 > 1 Vector of the above
1582 When converting a Lisp number to C, it is assumed to be of format 16 if
1583 it is an integer, and of format 32 if it is a cons of two integers.
1585 When converting a vector of numbers from Lisp to C, it is assumed to be
1586 of format 16 if every element in the vector is an integer, and is assumed
1587 to be of format 32 if any element is a cons of two integers.
1589 When converting an object to C, it may be of the form (SYMBOL . <data>)
1590 where SYMBOL is what we should claim that the type is. Format and
1591 representation are as above. */
1596 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1598 unsigned char *data
;
1602 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1604 if (type
== dpyinfo
->Xatom_NULL
)
1607 /* Convert any 8-bit data to a string, for compactness. */
1608 else if (format
== 8)
1610 Lisp_Object str
, lispy_type
;
1612 str
= make_unibyte_string ((char *) data
, size
);
1613 /* Indicate that this string is from foreign selection by a text
1614 property `foreign-selection' so that the caller of
1615 x-get-selection-internal (usually x-get-selection) can know
1616 that the string must be decode. */
1617 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1618 lispy_type
= QCOMPOUND_TEXT
;
1619 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1620 lispy_type
= QUTF8_STRING
;
1622 lispy_type
= QSTRING
;
1623 Fput_text_property (make_number (0), make_number (size
),
1624 Qforeign_selection
, lispy_type
, str
);
1627 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1628 a vector of symbols.
1630 else if (type
== XA_ATOM
)
1633 if (size
== sizeof (Atom
))
1634 return x_atom_to_symbol (display
, *((Atom
*) data
));
1637 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1639 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1640 Faset (v
, make_number (i
),
1641 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1646 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1647 If the number is > 16 bits, convert it to a cons of integers,
1648 16 bits in each half.
1650 else if (format
== 32 && size
== sizeof (int))
1651 return long_to_cons (((unsigned int *) data
) [0]);
1652 else if (format
== 16 && size
== sizeof (short))
1653 return make_number ((int) (((unsigned short *) data
) [0]));
1655 /* Convert any other kind of data to a vector of numbers, represented
1656 as above (as an integer, or a cons of two 16 bit integers.)
1658 else if (format
== 16)
1662 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1663 for (i
= 0; i
< size
/ 2; i
++)
1665 int j
= (int) ((unsigned short *) data
) [i
];
1666 Faset (v
, make_number (i
), make_number (j
));
1673 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1674 for (i
= 0; i
< size
/ 4; i
++)
1676 unsigned int j
= ((unsigned int *) data
) [i
];
1677 Faset (v
, make_number (i
), long_to_cons (j
));
1684 /* Use xfree, not XFree, to free the data obtained with this function. */
1687 lisp_data_to_selection_data (display
, obj
,
1688 data_ret
, type_ret
, size_ret
,
1689 format_ret
, nofree_ret
)
1692 unsigned char **data_ret
;
1694 unsigned int *size_ret
;
1698 Lisp_Object type
= Qnil
;
1699 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1703 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1707 if (CONSP (obj
) && NILP (XCDR (obj
)))
1711 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1712 { /* This is not the same as declining */
1718 else if (STRINGP (obj
))
1720 xassert (! STRING_MULTIBYTE (obj
));
1724 *size_ret
= SBYTES (obj
);
1725 *data_ret
= SDATA (obj
);
1728 else if (SYMBOLP (obj
))
1732 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1733 (*data_ret
) [sizeof (Atom
)] = 0;
1734 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1735 if (NILP (type
)) type
= QATOM
;
1737 else if (INTEGERP (obj
)
1738 && XINT (obj
) < 0xFFFF
1739 && XINT (obj
) > -0xFFFF)
1743 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1744 (*data_ret
) [sizeof (short)] = 0;
1745 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1746 if (NILP (type
)) type
= QINTEGER
;
1748 else if (INTEGERP (obj
)
1749 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1750 && (INTEGERP (XCDR (obj
))
1751 || (CONSP (XCDR (obj
))
1752 && INTEGERP (XCAR (XCDR (obj
)))))))
1756 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1757 (*data_ret
) [sizeof (long)] = 0;
1758 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1759 if (NILP (type
)) type
= QINTEGER
;
1761 else if (VECTORP (obj
))
1763 /* Lisp_Vectors may represent a set of ATOMs;
1764 a set of 16 or 32 bit INTEGERs;
1765 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1769 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1770 /* This vector is an ATOM set */
1772 if (NILP (type
)) type
= QATOM
;
1773 *size_ret
= XVECTOR (obj
)->size
;
1775 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1776 for (i
= 0; i
< *size_ret
; i
++)
1777 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1778 (*(Atom
**) data_ret
) [i
]
1779 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1781 Fsignal (Qerror
, /* Qselection_error */
1783 ("all elements of selection vector must have same type"),
1784 Fcons (obj
, Qnil
)));
1786 #if 0 /* #### MULTIPLE doesn't work yet */
1787 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1788 /* This vector is an ATOM_PAIR set */
1790 if (NILP (type
)) type
= QATOM_PAIR
;
1791 *size_ret
= XVECTOR (obj
)->size
;
1793 *data_ret
= (unsigned char *)
1794 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1795 for (i
= 0; i
< *size_ret
; i
++)
1796 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1798 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1799 if (XVECTOR (pair
)->size
!= 2)
1802 ("elements of the vector must be vectors of exactly two elements"),
1803 Fcons (pair
, Qnil
)));
1805 (*(Atom
**) data_ret
) [i
* 2]
1806 = symbol_to_x_atom (dpyinfo
, display
,
1807 XVECTOR (pair
)->contents
[0]);
1808 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1809 = symbol_to_x_atom (dpyinfo
, display
,
1810 XVECTOR (pair
)->contents
[1]);
1815 ("all elements of the vector must be of the same type"),
1816 Fcons (obj
, Qnil
)));
1821 /* This vector is an INTEGER set, or something like it */
1823 *size_ret
= XVECTOR (obj
)->size
;
1824 if (NILP (type
)) type
= QINTEGER
;
1826 for (i
= 0; i
< *size_ret
; i
++)
1827 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1829 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1830 Fsignal (Qerror
, /* Qselection_error */
1832 ("elements of selection vector must be integers or conses of integers"),
1833 Fcons (obj
, Qnil
)));
1835 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1836 for (i
= 0; i
< *size_ret
; i
++)
1837 if (*format_ret
== 32)
1838 (*((unsigned long **) data_ret
)) [i
]
1839 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1841 (*((unsigned short **) data_ret
)) [i
]
1842 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1846 Fsignal (Qerror
, /* Qselection_error */
1847 Fcons (build_string ("unrecognised selection data"),
1848 Fcons (obj
, Qnil
)));
1850 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1854 clean_local_selection_data (obj
)
1858 && INTEGERP (XCAR (obj
))
1859 && CONSP (XCDR (obj
))
1860 && INTEGERP (XCAR (XCDR (obj
)))
1861 && NILP (XCDR (XCDR (obj
))))
1862 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1865 && INTEGERP (XCAR (obj
))
1866 && INTEGERP (XCDR (obj
)))
1868 if (XINT (XCAR (obj
)) == 0)
1870 if (XINT (XCAR (obj
)) == -1)
1871 return make_number (- XINT (XCDR (obj
)));
1876 int size
= XVECTOR (obj
)->size
;
1879 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1880 copy
= Fmake_vector (make_number (size
), Qnil
);
1881 for (i
= 0; i
< size
; i
++)
1882 XVECTOR (copy
)->contents
[i
]
1883 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1889 /* Called from XTread_socket to handle SelectionNotify events.
1890 If it's the selection we are waiting for, stop waiting
1891 by setting the car of reading_selection_reply to non-nil.
1892 We store t there if the reply is successful, lambda if not. */
1895 x_handle_selection_notify (event
)
1896 XSelectionEvent
*event
;
1898 if (event
->requestor
!= reading_selection_window
)
1900 if (event
->selection
!= reading_which_selection
)
1903 TRACE0 ("Received SelectionNotify");
1904 XSETCAR (reading_selection_reply
,
1905 (event
->property
!= 0 ? Qt
: Qlambda
));
1909 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1910 Sx_own_selection_internal
, 2, 2, 0,
1911 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1912 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1913 \(Those are literal upper-case symbol names, since that's what X expects.)
1914 VALUE is typically a string, or a cons of two markers, but may be
1915 anything that the functions on `selection-converter-alist' know about. */)
1916 (selection_name
, selection_value
)
1917 Lisp_Object selection_name
, selection_value
;
1920 CHECK_SYMBOL (selection_name
);
1921 if (NILP (selection_value
)) error ("selection-value may not be nil");
1922 x_own_selection (selection_name
, selection_value
);
1923 return selection_value
;
1927 /* Request the selection value from the owner. If we are the owner,
1928 simply return our selection value. If we are not the owner, this
1929 will block until all of the data has arrived. */
1931 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1932 Sx_get_selection_internal
, 2, 2, 0,
1933 doc
: /* Return text selected from some X window.
1934 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1935 \(Those are literal upper-case symbol names, since that's what X expects.)
1936 TYPE is the type of data desired, typically `STRING'. */)
1937 (selection_symbol
, target_type
)
1938 Lisp_Object selection_symbol
, target_type
;
1940 Lisp_Object val
= Qnil
;
1941 struct gcpro gcpro1
, gcpro2
;
1942 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1944 CHECK_SYMBOL (selection_symbol
);
1946 #if 0 /* #### MULTIPLE doesn't work yet */
1947 if (CONSP (target_type
)
1948 && XCAR (target_type
) == QMULTIPLE
)
1950 CHECK_VECTOR (XCDR (target_type
));
1951 /* So we don't destructively modify this... */
1952 target_type
= copy_multiple_data (target_type
);
1956 CHECK_SYMBOL (target_type
);
1958 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
1962 val
= x_get_foreign_selection (selection_symbol
, target_type
);
1967 && SYMBOLP (XCAR (val
)))
1970 if (CONSP (val
) && NILP (XCDR (val
)))
1973 val
= clean_local_selection_data (val
);
1979 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
1980 Sx_disown_selection_internal
, 1, 2, 0,
1981 doc
: /* If we own the selection SELECTION, disown it.
1982 Disowning it means there is no such selection. */)
1984 Lisp_Object selection
;
1988 Atom selection_atom
;
1989 struct selection_input_event event
;
1991 struct x_display_info
*dpyinfo
;
1992 struct frame
*sf
= SELECTED_FRAME ();
1995 display
= FRAME_X_DISPLAY (sf
);
1996 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1997 CHECK_SYMBOL (selection
);
1999 timestamp
= last_event_timestamp
;
2001 timestamp
= cons_to_long (time
);
2003 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2004 return Qnil
; /* Don't disown the selection when we're not the owner. */
2006 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2009 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2012 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2013 generated for a window which owns the selection when that window sets
2014 the selection owner to None. The NCD server does, the MIT Sun4 server
2015 doesn't. So we synthesize one; this means we might get two, but
2016 that's ok, because the second one won't have any effect. */
2017 SELECTION_EVENT_DISPLAY (&event
) = display
;
2018 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2019 SELECTION_EVENT_TIME (&event
) = timestamp
;
2020 x_handle_selection_clear ((struct input_event
*) &event
);
2025 /* Get rid of all the selections in buffer BUFFER.
2026 This is used when we kill a buffer. */
2029 x_disown_buffer_selections (buffer
)
2033 struct buffer
*buf
= XBUFFER (buffer
);
2035 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2037 Lisp_Object elt
, value
;
2040 if (CONSP (value
) && MARKERP (XCAR (value
))
2041 && XMARKER (XCAR (value
))->buffer
== buf
)
2042 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2046 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2048 doc
: /* Whether the current Emacs process owns the given X Selection.
2049 The arg should be the name of the selection in question, typically one of
2050 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2051 \(Those are literal upper-case symbol names, since that's what X expects.)
2052 For convenience, the symbol nil is the same as `PRIMARY',
2053 and t is the same as `SECONDARY'. */)
2055 Lisp_Object selection
;
2058 CHECK_SYMBOL (selection
);
2059 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2060 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2062 if (NILP (Fassq (selection
, Vselection_alist
)))
2067 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2069 doc
: /* Whether there is an owner for the given X Selection.
2070 The arg should be the name of the selection in question, typically one of
2071 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2072 \(Those are literal upper-case symbol names, since that's what X expects.)
2073 For convenience, the symbol nil is the same as `PRIMARY',
2074 and t is the same as `SECONDARY'. */)
2076 Lisp_Object selection
;
2081 struct frame
*sf
= SELECTED_FRAME ();
2083 /* It should be safe to call this before we have an X frame. */
2084 if (! FRAME_X_P (sf
))
2087 dpy
= FRAME_X_DISPLAY (sf
);
2088 CHECK_SYMBOL (selection
);
2089 if (!NILP (Fx_selection_owner_p (selection
)))
2091 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2092 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2093 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2097 owner
= XGetSelectionOwner (dpy
, atom
);
2099 return (owner
? Qt
: Qnil
);
2103 #ifdef CUT_BUFFER_SUPPORT
2105 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2107 initialize_cut_buffers (display
, window
)
2111 unsigned char *data
= (unsigned char *) "";
2113 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2114 PropModeAppend, data, 0)
2115 FROB (XA_CUT_BUFFER0
);
2116 FROB (XA_CUT_BUFFER1
);
2117 FROB (XA_CUT_BUFFER2
);
2118 FROB (XA_CUT_BUFFER3
);
2119 FROB (XA_CUT_BUFFER4
);
2120 FROB (XA_CUT_BUFFER5
);
2121 FROB (XA_CUT_BUFFER6
);
2122 FROB (XA_CUT_BUFFER7
);
2128 #define CHECK_CUT_BUFFER(symbol) \
2129 { CHECK_SYMBOL ((symbol)); \
2130 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2131 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2132 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2133 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2135 Fcons (build_string ("doesn't name a cut buffer"), \
2136 Fcons ((symbol), Qnil))); \
2139 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2140 Sx_get_cut_buffer_internal
, 1, 1, 0,
2141 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2147 unsigned char *data
;
2154 struct x_display_info
*dpyinfo
;
2155 struct frame
*sf
= SELECTED_FRAME ();
2158 display
= FRAME_X_DISPLAY (sf
);
2159 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2160 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2161 CHECK_CUT_BUFFER (buffer
);
2162 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2164 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2165 &type
, &format
, &size
, 0);
2166 if (!data
|| !format
)
2169 if (format
!= 8 || type
!= XA_STRING
)
2171 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2172 Fcons (x_atom_to_symbol (display
, type
),
2173 Fcons (make_number (format
), Qnil
))));
2175 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2176 /* Use xfree, not XFree, because x_get_window_property
2177 calls xmalloc itself. */
2183 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2184 Sx_store_cut_buffer_internal
, 2, 2, 0,
2185 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2187 Lisp_Object buffer
, string
;
2191 unsigned char *data
;
2193 int bytes_remaining
;
2196 struct frame
*sf
= SELECTED_FRAME ();
2199 display
= FRAME_X_DISPLAY (sf
);
2200 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2202 max_bytes
= SELECTION_QUANTUM (display
);
2203 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2204 max_bytes
= MAX_SELECTION_QUANTUM
;
2206 CHECK_CUT_BUFFER (buffer
);
2207 CHECK_STRING (string
);
2208 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2210 data
= (unsigned char *) SDATA (string
);
2211 bytes
= SBYTES (string
);
2212 bytes_remaining
= bytes
;
2214 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2216 initialize_cut_buffers (display
, window
);
2217 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2222 /* Don't mess up with an empty value. */
2223 if (!bytes_remaining
)
2224 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2225 PropModeReplace
, data
, 0);
2227 while (bytes_remaining
)
2229 int chunk
= (bytes_remaining
< max_bytes
2230 ? bytes_remaining
: max_bytes
);
2231 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2232 (bytes_remaining
== bytes
2237 bytes_remaining
-= chunk
;
2244 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2245 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2246 doc
: /* Rotate the values of the cut buffers by the given number of step.
2247 Positive means shift the values forward, negative means backward. */)
2254 struct frame
*sf
= SELECTED_FRAME ();
2257 display
= FRAME_X_DISPLAY (sf
);
2258 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2262 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2264 initialize_cut_buffers (display
, window
);
2265 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2268 props
[0] = XA_CUT_BUFFER0
;
2269 props
[1] = XA_CUT_BUFFER1
;
2270 props
[2] = XA_CUT_BUFFER2
;
2271 props
[3] = XA_CUT_BUFFER3
;
2272 props
[4] = XA_CUT_BUFFER4
;
2273 props
[5] = XA_CUT_BUFFER5
;
2274 props
[6] = XA_CUT_BUFFER6
;
2275 props
[7] = XA_CUT_BUFFER7
;
2277 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2284 /***********************************************************************
2285 Drag and drop support
2286 ***********************************************************************/
2287 /* Check that lisp values are of correct type for x_fill_property_data.
2288 That is, number, string or a cons with two numbers (low and high 16
2289 bit parts of a 32 bit number). */
2292 x_check_property_data (data
)
2298 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2300 Lisp_Object o
= XCAR (iter
);
2302 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2304 else if (CONSP (o
) &&
2305 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2312 /* Convert lisp values to a C array. Values may be a number, a string
2313 which is taken as an X atom name and converted to the atom value, or
2314 a cons containing the two 16 bit parts of a 32 bit number.
2316 DPY is the display use to look up X atoms.
2317 DATA is a Lisp list of values to be converted.
2318 RET is the C array that contains the converted values. It is assumed
2319 it is big enough to hol all values.
2320 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2321 be stored in RET. */
2324 x_fill_property_data (dpy
, data
, ret
, format
)
2331 CARD32
*d32
= (CARD32
*) ret
;
2332 CARD16
*d16
= (CARD16
*) ret
;
2333 CARD8
*d08
= (CARD8
*) ret
;
2336 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2338 Lisp_Object o
= XCAR (iter
);
2341 val
= (CARD32
) XFASTINT (o
);
2342 else if (FLOATP (o
))
2343 val
= (CARD32
) XFLOAT (o
);
2345 val
= (CARD32
) cons_to_long (o
);
2346 else if (STRINGP (o
))
2349 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2353 error ("Wrong type, must be string, number or cons");
2356 *d08
++ = (CARD8
) val
;
2357 else if (format
== 16)
2358 *d16
++ = (CARD16
) val
;
2364 /* Convert an array of C values to a Lisp list.
2365 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2366 DATA is a C array of values to be converted.
2367 TYPE is the type of the data. Only XA_ATOM is special, it converts
2368 each number in DATA to its corresponfing X atom as a symbol.
2369 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2371 SIZE is the number of elements in DATA.
2373 Also see comment for selection_data_to_lisp_data above. */
2376 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2378 unsigned char *data
;
2383 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2384 data
, size
*format
/8, type
, format
);
2387 /* Get the mouse position frame relative coordinates. */
2390 mouse_position_for_drop (f
, x
, y
)
2395 Window root
, dummy_window
;
2400 XQueryPointer (FRAME_X_DISPLAY (f
),
2401 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2403 /* The root window which contains the pointer. */
2406 /* Window pointer is on, not used */
2409 /* The position on that root window. */
2412 /* x/y in dummy_window coordinates, not used. */
2415 /* Modifier keys and pointer buttons, about which
2417 (unsigned int *) &dummy
);
2420 /* Absolute to relative. */
2421 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2422 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2427 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2428 Sx_get_atom_name
, 1, 2, 0,
2429 doc
: /* Return the X atom name for VALUE as a string.
2430 VALUE may be a number or a cons where the car is the upper 16 bits and
2431 the cdr is the lower 16 bits of a 32 bit value.
2432 Use the display for FRAME or the current frame if FRAME is not given or nil.
2434 If the value is 0 or the atom is not known, return the empty string. */)
2436 Lisp_Object value
, frame
;
2438 struct frame
*f
= check_x_frame (frame
);
2440 Lisp_Object ret
= Qnil
;
2442 Display
*dpy
= FRAME_X_DISPLAY (f
);
2445 if (INTEGERP (value
))
2446 atom
= (Atom
) XUINT (value
);
2447 else if (FLOATP (value
))
2448 atom
= (Atom
) XFLOAT (value
);
2449 else if (CONSP (value
))
2450 atom
= (Atom
) cons_to_long (value
);
2452 error ("Wrong type, value must be number or cons");
2455 count
= x_catch_errors (dpy
);
2457 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2459 if (! x_had_errors_p (dpy
))
2460 ret
= make_string (name
, strlen (name
));
2462 x_uncatch_errors (dpy
, count
);
2464 if (atom
&& name
) XFree (name
);
2465 if (NILP (ret
)) ret
= make_string ("", 0);
2472 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2473 TODO: Check if this client event really is a DND event? */
2476 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2478 XClientMessageEvent
*event
;
2479 struct x_display_info
*dpyinfo
;
2480 struct input_event
*bufp
;
2484 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2487 XSETFRAME (frame
, f
);
2489 vec
= Fmake_vector (4, Qnil
);
2490 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2491 event
->message_type
));
2492 AREF (vec
, 1) = frame
;
2493 AREF (vec
, 2) = XFASTINT (event
->format
);
2494 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2496 event
->message_type
,
2500 mouse_position_for_drop (f
, &x
, &y
);
2501 bufp
->kind
= DRAG_N_DROP_EVENT
;
2502 bufp
->frame_or_window
= Fcons (frame
, vec
);
2503 bufp
->timestamp
= CurrentTime
;
2504 bufp
->x
= make_number (x
);
2505 bufp
->y
= make_number (y
);
2507 bufp
->modifiers
= 0;
2512 DEFUN ("x-send-client-message", Fx_send_client_event
,
2513 Sx_send_client_message
, 6, 6, 0,
2514 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2516 For DISPLAY, specify either a frame or a display name (a string).
2517 If DISPLAY is nil, that stands for the selected frame's display.
2518 DEST may be a number, in which case it is a Window id. The value 0 may
2519 be used to send to the root window of the DISPLAY.
2520 If DEST is a cons, it is converted to a 32 bit number
2521 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2522 number is then used as a window id.
2523 If DEST is a frame the event is sent to the outer window of that frame.
2524 Nil means the currently selected frame.
2525 If DEST is the string "PointerWindow" the event is sent to the window that
2526 contains the pointer. If DEST is the string "InputFocus" the event is
2527 sent to the window that has the input focus.
2528 FROM is the frame sending the event. Use nil for currently selected frame.
2529 MESSAGE-TYPE is the name of an Atom as a string.
2530 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2531 bits. VALUES is a list of numbers, cons and/or strings containing the values
2532 to send. If a value is a string, it is converted to an Atom and the value of
2533 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2534 with the high 16 bits from the car and the lower 16 bit from the cdr.
2535 If more values than fits into the event is given, the excessive values
2537 (display
, dest
, from
, message_type
, format
, values
)
2538 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2540 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2545 struct frame
*f
= check_x_frame (from
);
2549 CHECK_STRING (message_type
);
2550 CHECK_NUMBER (format
);
2551 CHECK_CONS (values
);
2553 if (x_check_property_data (values
) == -1)
2554 error ("Bad data in VALUES, must be number, cons or string");
2556 event
.xclient
.type
= ClientMessage
;
2557 event
.xclient
.format
= XFASTINT (format
);
2559 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2560 && event
.xclient
.format
!= 32)
2561 error ("FORMAT must be one of 8, 16 or 32");
2563 if (FRAMEP (dest
) || NILP (dest
))
2565 struct frame
*fdest
= check_x_frame (dest
);
2566 wdest
= FRAME_OUTER_WINDOW (fdest
);
2568 else if (STRINGP (dest
))
2570 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2571 wdest
= PointerWindow
;
2572 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2575 error ("DEST as a string must be one of PointerWindow or InputFocus");
2577 else if (INTEGERP (dest
))
2578 wdest
= (Window
) XFASTINT (dest
);
2579 else if (FLOATP (dest
))
2580 wdest
= (Window
) XFLOAT (dest
);
2581 else if (CONSP (dest
))
2583 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2584 error ("Both car and cdr for DEST must be numbers");
2586 wdest
= (Window
) cons_to_long (dest
);
2589 error ("DEST must be a frame, nil, string, number or cons");
2591 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2592 to_root
= wdest
== dpyinfo
->root_window
;
2594 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2599 event
.xclient
.message_type
2600 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2601 event
.xclient
.display
= dpyinfo
->display
;
2603 /* Some clients (metacity for example) expects sending window to be here
2604 when sending to the root window. */
2605 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2607 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2608 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2609 event
.xclient
.format
);
2611 /* If event mask is 0 the event is sent to the client that created
2612 the destination window. But if we are sending to the root window,
2613 there is no such client. Then we set the event mask to 0xffff. The
2614 event then goes to clients selecting for events on the root window. */
2615 count
= x_catch_errors (dpyinfo
->display
);
2617 int propagate
= to_root
? False
: True
;
2618 unsigned mask
= to_root
? 0xffff : 0;
2619 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2620 XFlush (dpyinfo
->display
);
2622 x_uncatch_errors (dpyinfo
->display
, count
);
2632 defsubr (&Sx_get_selection_internal
);
2633 defsubr (&Sx_own_selection_internal
);
2634 defsubr (&Sx_disown_selection_internal
);
2635 defsubr (&Sx_selection_owner_p
);
2636 defsubr (&Sx_selection_exists_p
);
2638 #ifdef CUT_BUFFER_SUPPORT
2639 defsubr (&Sx_get_cut_buffer_internal
);
2640 defsubr (&Sx_store_cut_buffer_internal
);
2641 defsubr (&Sx_rotate_cut_buffers_internal
);
2644 defsubr (&Sx_get_atom_name
);
2645 defsubr (&Sx_send_client_message
);
2647 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2648 staticpro (&reading_selection_reply
);
2649 reading_selection_window
= 0;
2650 reading_which_selection
= 0;
2652 property_change_wait_list
= 0;
2653 prop_location_identifier
= 0;
2654 property_change_reply
= Fcons (Qnil
, Qnil
);
2655 staticpro (&property_change_reply
);
2657 Vselection_alist
= Qnil
;
2658 staticpro (&Vselection_alist
);
2660 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2661 doc
: /* An alist associating X Windows selection-types with functions.
2662 These functions are called to convert the selection, with three args:
2663 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2664 a desired type to which the selection should be converted;
2665 and the local selection value (whatever was given to `x-own-selection').
2667 The function should return the value to send to the X server
2668 \(typically a string). A return value of nil
2669 means that the conversion could not be done.
2670 A return value which is the symbol `NULL'
2671 means that a side-effect was executed,
2672 and there is no meaningful selection value. */);
2673 Vselection_converter_alist
= Qnil
;
2675 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2676 doc
: /* A list of functions to be called when Emacs loses an X selection.
2677 \(This happens when some other X client makes its own selection
2678 or when a Lisp program explicitly clears the selection.)
2679 The functions are called with one argument, the selection type
2680 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2681 Vx_lost_selection_hooks
= Qnil
;
2683 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2684 doc
: /* A list of functions to be called when Emacs answers a selection request.
2685 The functions are called with four arguments:
2686 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2687 - the selection-type which Emacs was asked to convert the
2688 selection into before sending (for example, `STRING' or `LENGTH');
2689 - a flag indicating success or failure for responding to the request.
2690 We might have failed (and declined the request) for any number of reasons,
2691 including being asked for a selection that we no longer own, or being asked
2692 to convert into a type that we don't know about or that is inappropriate.
2693 This hook doesn't let you change the behavior of Emacs's selection replies,
2694 it merely informs you that they have happened. */);
2695 Vx_sent_selection_hooks
= Qnil
;
2697 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2698 doc
: /* Coding system for communicating with other X clients.
2699 When sending or receiving text via cut_buffer, selection, and clipboard,
2700 the text is encoded or decoded by this coding system.
2701 The default value is `compound-text-with-extensions'. */);
2702 Vselection_coding_system
= intern ("compound-text-with-extensions");
2704 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2705 doc
: /* Coding system for the next communication with other X clients.
2706 Usually, `selection-coding-system' is used for communicating with
2707 other X clients. But, if this variable is set, it is used for the
2708 next communication only. After the communication, this variable is
2710 Vnext_selection_coding_system
= Qnil
;
2712 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2713 doc
: /* Number of milliseconds to wait for a selection reply.
2714 If the selection owner doesn't reply in this time, we give up.
2715 A value of 0 means wait as long as necessary. This is initialized from the
2716 \"*selectionTimeout\" resource. */);
2717 x_selection_timeout
= 0;
2719 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2720 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2721 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2722 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2723 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2724 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2725 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2726 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2727 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2728 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2729 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2730 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2731 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2732 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2733 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2734 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2735 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2736 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2737 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2738 staticpro (&Qcompound_text_with_extensions
);
2740 #ifdef CUT_BUFFER_SUPPORT
2741 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2742 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2743 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2744 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2745 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2746 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2747 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2748 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2751 Qforeign_selection
= intern ("foreign-selection");
2752 staticpro (&Qforeign_selection
);
2755 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2756 (do not change this comment) */