1 /* X Selection processing for Emacs.
2 Copyright (C) 1993, 1994, 1995, 1996, 1997, 2000, 2001, 2003, 2004
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
,
60 static void x_get_window_property
P_ ((Display
*, Window
, Atom
,
61 unsigned char **, int *,
62 Atom
*, int *, unsigned long *, int));
63 static void receive_incremental_selection
P_ ((Display
*, Window
, Atom
,
64 Lisp_Object
, unsigned,
65 unsigned char **, int *,
66 Atom
*, int *, unsigned long *));
67 static Lisp_Object x_get_window_property_as_lisp_data
P_ ((Display
*,
70 static Lisp_Object selection_data_to_lisp_data
P_ ((Display
*, unsigned char *,
72 static void lisp_data_to_selection_data
P_ ((Display
*, Lisp_Object
,
73 unsigned char **, Atom
*,
74 unsigned *, int *, int *));
75 static Lisp_Object clean_local_selection_data
P_ ((Lisp_Object
));
76 static void initialize_cut_buffers
P_ ((Display
*, Window
));
79 /* Printing traces to stderr. */
81 #ifdef TRACE_SELECTION
83 fprintf (stderr, "%d: " fmt "\n", getpid ())
84 #define TRACE1(fmt, a0) \
85 fprintf (stderr, "%d: " fmt "\n", getpid (), a0)
86 #define TRACE2(fmt, a0, a1) \
87 fprintf (stderr, "%d: " fmt "\n", getpid (), a0, a1)
89 #define TRACE0(fmt) (void) 0
90 #define TRACE1(fmt, a0) (void) 0
91 #define TRACE2(fmt, a0, a1) (void) 0
95 #define CUT_BUFFER_SUPPORT
97 Lisp_Object QPRIMARY
, QSECONDARY
, QSTRING
, QINTEGER
, QCLIPBOARD
, QTIMESTAMP
,
98 QTEXT
, QDELETE
, QMULTIPLE
, QINCR
, QEMACS_TMP
, QTARGETS
, QATOM
, QNULL
,
101 Lisp_Object QCOMPOUND_TEXT
; /* This is a type of selection. */
102 Lisp_Object QUTF8_STRING
; /* This is a type of selection. */
104 Lisp_Object Qcompound_text_with_extensions
;
106 #ifdef CUT_BUFFER_SUPPORT
107 Lisp_Object QCUT_BUFFER0
, QCUT_BUFFER1
, QCUT_BUFFER2
, QCUT_BUFFER3
,
108 QCUT_BUFFER4
, QCUT_BUFFER5
, QCUT_BUFFER6
, QCUT_BUFFER7
;
111 static Lisp_Object Vx_lost_selection_hooks
;
112 static Lisp_Object Vx_sent_selection_hooks
;
113 /* Coding system for communicating with other X clients via cutbuffer,
114 selection, and clipboard. */
115 static Lisp_Object Vselection_coding_system
;
117 /* Coding system for the next communicating with other X clients. */
118 static Lisp_Object Vnext_selection_coding_system
;
120 static Lisp_Object Qforeign_selection
;
122 /* If this is a smaller number than the max-request-size of the display,
123 emacs will use INCR selection transfer when the selection is larger
124 than this. The max-request-size is usually around 64k, so if you want
125 emacs to use incremental selection transfers when the selection is
126 smaller than that, set this. I added this mostly for debugging the
127 incremental transfer stuff, but it might improve server performance. */
128 #define MAX_SELECTION_QUANTUM 0xFFFFFF
131 #define SELECTION_QUANTUM(dpy) ((XMaxRequestSize(dpy) << 2) - 100)
133 #define SELECTION_QUANTUM(dpy) (((dpy)->max_request_size << 2) - 100)
136 /* The timestamp of the last input event Emacs received from the X server. */
137 /* Defined in keyboard.c. */
138 extern unsigned long last_event_timestamp
;
140 /* This is an association list whose elements are of the form
141 ( SELECTION-NAME SELECTION-VALUE SELECTION-TIMESTAMP FRAME)
142 SELECTION-NAME is a lisp symbol, whose name is the name of an X Atom.
143 SELECTION-VALUE is the value that emacs owns for that selection.
144 It may be any kind of Lisp object.
145 SELECTION-TIMESTAMP is the time at which emacs began owning this selection,
146 as a cons of two 16-bit numbers (making a 32 bit time.)
147 FRAME is the frame for which we made the selection.
148 If there is an entry in this alist, then it can be assumed that Emacs owns
150 The only (eq) parts of this list that are visible from Lisp are the
152 static Lisp_Object Vselection_alist
;
154 /* This is an alist whose CARs are selection-types (whose names are the same
155 as the names of X Atoms) and whose CDRs are the names of Lisp functions to
156 call to convert the given Emacs selection value to a string representing
157 the given selection type. This is for Lisp-level extension of the emacs
158 selection handling. */
159 static Lisp_Object Vselection_converter_alist
;
161 /* If the selection owner takes too long to reply to a selection request,
162 we give up on it. This is in milliseconds (0 = no timeout.) */
163 static EMACS_INT x_selection_timeout
;
165 /* Utility functions */
167 static void lisp_data_to_selection_data ();
168 static Lisp_Object
selection_data_to_lisp_data ();
169 static Lisp_Object
x_get_window_property_as_lisp_data ();
171 /* This converts a Lisp symbol to a server Atom, avoiding a server
172 roundtrip whenever possible. */
175 symbol_to_x_atom (dpyinfo
, display
, sym
)
176 struct x_display_info
*dpyinfo
;
181 if (NILP (sym
)) return 0;
182 if (EQ (sym
, QPRIMARY
)) return XA_PRIMARY
;
183 if (EQ (sym
, QSECONDARY
)) return XA_SECONDARY
;
184 if (EQ (sym
, QSTRING
)) return XA_STRING
;
185 if (EQ (sym
, QINTEGER
)) return XA_INTEGER
;
186 if (EQ (sym
, QATOM
)) return XA_ATOM
;
187 if (EQ (sym
, QCLIPBOARD
)) return dpyinfo
->Xatom_CLIPBOARD
;
188 if (EQ (sym
, QTIMESTAMP
)) return dpyinfo
->Xatom_TIMESTAMP
;
189 if (EQ (sym
, QTEXT
)) return dpyinfo
->Xatom_TEXT
;
190 if (EQ (sym
, QCOMPOUND_TEXT
)) return dpyinfo
->Xatom_COMPOUND_TEXT
;
191 if (EQ (sym
, QUTF8_STRING
)) return dpyinfo
->Xatom_UTF8_STRING
;
192 if (EQ (sym
, QDELETE
)) return dpyinfo
->Xatom_DELETE
;
193 if (EQ (sym
, QMULTIPLE
)) return dpyinfo
->Xatom_MULTIPLE
;
194 if (EQ (sym
, QINCR
)) return dpyinfo
->Xatom_INCR
;
195 if (EQ (sym
, QEMACS_TMP
)) return dpyinfo
->Xatom_EMACS_TMP
;
196 if (EQ (sym
, QTARGETS
)) return dpyinfo
->Xatom_TARGETS
;
197 if (EQ (sym
, QNULL
)) return dpyinfo
->Xatom_NULL
;
198 #ifdef CUT_BUFFER_SUPPORT
199 if (EQ (sym
, QCUT_BUFFER0
)) return XA_CUT_BUFFER0
;
200 if (EQ (sym
, QCUT_BUFFER1
)) return XA_CUT_BUFFER1
;
201 if (EQ (sym
, QCUT_BUFFER2
)) return XA_CUT_BUFFER2
;
202 if (EQ (sym
, QCUT_BUFFER3
)) return XA_CUT_BUFFER3
;
203 if (EQ (sym
, QCUT_BUFFER4
)) return XA_CUT_BUFFER4
;
204 if (EQ (sym
, QCUT_BUFFER5
)) return XA_CUT_BUFFER5
;
205 if (EQ (sym
, QCUT_BUFFER6
)) return XA_CUT_BUFFER6
;
206 if (EQ (sym
, QCUT_BUFFER7
)) return XA_CUT_BUFFER7
;
208 if (!SYMBOLP (sym
)) abort ();
210 TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym
)));
212 val
= XInternAtom (display
, (char *) SDATA (SYMBOL_NAME (sym
)), False
);
218 /* This converts a server Atom to a Lisp symbol, avoiding server roundtrips
219 and calls to intern whenever possible. */
222 x_atom_to_symbol (dpy
, atom
)
226 struct x_display_info
*dpyinfo
;
245 #ifdef CUT_BUFFER_SUPPORT
265 dpyinfo
= x_display_info_for_display (dpy
);
266 if (atom
== dpyinfo
->Xatom_CLIPBOARD
)
268 if (atom
== dpyinfo
->Xatom_TIMESTAMP
)
270 if (atom
== dpyinfo
->Xatom_TEXT
)
272 if (atom
== dpyinfo
->Xatom_COMPOUND_TEXT
)
273 return QCOMPOUND_TEXT
;
274 if (atom
== dpyinfo
->Xatom_UTF8_STRING
)
276 if (atom
== dpyinfo
->Xatom_DELETE
)
278 if (atom
== dpyinfo
->Xatom_MULTIPLE
)
280 if (atom
== dpyinfo
->Xatom_INCR
)
282 if (atom
== dpyinfo
->Xatom_EMACS_TMP
)
284 if (atom
== dpyinfo
->Xatom_TARGETS
)
286 if (atom
== dpyinfo
->Xatom_NULL
)
290 str
= XGetAtomName (dpy
, atom
);
292 TRACE1 ("XGetAtomName --> %s", str
);
293 if (! str
) return Qnil
;
296 /* This was allocated by Xlib, so use XFree. */
302 /* Do protocol to assert ourself as a selection owner.
303 Update the Vselection_alist so that we can reply to later requests for
307 x_own_selection (selection_name
, selection_value
)
308 Lisp_Object selection_name
, selection_value
;
310 struct frame
*sf
= SELECTED_FRAME ();
311 Window selecting_window
= FRAME_X_WINDOW (sf
);
312 Display
*display
= FRAME_X_DISPLAY (sf
);
313 Time time
= last_event_timestamp
;
315 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
318 CHECK_SYMBOL (selection_name
);
319 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_name
);
322 count
= x_catch_errors (display
);
323 XSetSelectionOwner (display
, selection_atom
, selecting_window
, time
);
324 x_check_errors (display
, "Can't set selection: %s");
325 x_uncatch_errors (display
, count
);
328 /* Now update the local cache */
330 Lisp_Object selection_time
;
331 Lisp_Object selection_data
;
332 Lisp_Object prev_value
;
334 selection_time
= long_to_cons ((unsigned long) time
);
335 selection_data
= Fcons (selection_name
,
336 Fcons (selection_value
,
337 Fcons (selection_time
,
338 Fcons (selected_frame
, Qnil
))));
339 prev_value
= assq_no_quit (selection_name
, Vselection_alist
);
341 Vselection_alist
= Fcons (selection_data
, Vselection_alist
);
343 /* If we already owned the selection, remove the old selection data.
344 Perhaps we should destructively modify it instead.
345 Don't use Fdelq as that may QUIT. */
346 if (!NILP (prev_value
))
348 Lisp_Object rest
; /* we know it's not the CAR, so it's easy. */
349 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
350 if (EQ (prev_value
, Fcar (XCDR (rest
))))
352 XSETCDR (rest
, Fcdr (XCDR (rest
)));
359 /* Given a selection-name and desired type, look up our local copy of
360 the selection value and convert it to the type.
361 The value is nil or a string.
362 This function is used both for remote requests (LOCAL_REQUEST is zero)
363 and for local x-get-selection-internal (LOCAL_REQUEST is nonzero).
365 This calls random Lisp code, and may signal or gc. */
368 x_get_local_selection (selection_symbol
, target_type
, local_request
)
369 Lisp_Object selection_symbol
, target_type
;
372 Lisp_Object local_value
;
373 Lisp_Object handler_fn
, value
, type
, check
;
376 local_value
= assq_no_quit (selection_symbol
, Vselection_alist
);
378 if (NILP (local_value
)) return Qnil
;
380 /* TIMESTAMP and MULTIPLE are special cases 'cause that's easiest. */
381 if (EQ (target_type
, QTIMESTAMP
))
384 value
= XCAR (XCDR (XCDR (local_value
)));
387 else if (EQ (target_type
, QDELETE
))
390 Fx_disown_selection_internal
392 XCAR (XCDR (XCDR (local_value
))));
397 #if 0 /* #### MULTIPLE doesn't work yet */
398 else if (CONSP (target_type
)
399 && XCAR (target_type
) == QMULTIPLE
)
404 pairs
= XCDR (target_type
);
405 size
= XVECTOR (pairs
)->size
;
406 /* If the target is MULTIPLE, then target_type looks like
407 (MULTIPLE . [[SELECTION1 TARGET1] [SELECTION2 TARGET2] ... ])
408 We modify the second element of each pair in the vector and
409 return it as [[SELECTION1 <value1>] [SELECTION2 <value2>] ... ]
411 for (i
= 0; i
< size
; i
++)
414 pair
= XVECTOR (pairs
)->contents
[i
];
415 XVECTOR (pair
)->contents
[1]
416 = x_get_local_selection (XVECTOR (pair
)->contents
[0],
417 XVECTOR (pair
)->contents
[1],
425 /* Don't allow a quit within the converter.
426 When the user types C-g, he would be surprised
427 if by luck it came during a converter. */
428 count
= SPECPDL_INDEX ();
429 specbind (Qinhibit_quit
, Qt
);
431 CHECK_SYMBOL (target_type
);
432 handler_fn
= Fcdr (Fassq (target_type
, Vselection_converter_alist
));
433 /* gcpro is not needed here since nothing but HANDLER_FN
434 is live, and that ought to be a symbol. */
436 if (!NILP (handler_fn
))
437 value
= call3 (handler_fn
,
438 selection_symbol
, (local_request
? Qnil
: target_type
),
439 XCAR (XCDR (local_value
)));
442 unbind_to (count
, Qnil
);
445 /* Make sure this value is of a type that we could transmit
446 to another X client. */
450 && SYMBOLP (XCAR (value
)))
452 check
= XCDR (value
);
460 /* Check for a value that cons_to_long could handle. */
461 else if (CONSP (check
)
462 && INTEGERP (XCAR (check
))
463 && (INTEGERP (XCDR (check
))
465 (CONSP (XCDR (check
))
466 && INTEGERP (XCAR (XCDR (check
)))
467 && NILP (XCDR (XCDR (check
))))))
472 Fcons (build_string ("invalid data returned by selection-conversion function"),
473 Fcons (handler_fn
, Fcons (value
, Qnil
))));
476 /* Subroutines of x_reply_selection_request. */
478 /* Send a SelectionNotify event to the requestor with property=None,
479 meaning we were unable to do what they wanted. */
482 x_decline_selection_request (event
)
483 struct input_event
*event
;
485 XSelectionEvent reply
;
488 reply
.type
= SelectionNotify
;
489 reply
.display
= SELECTION_EVENT_DISPLAY (event
);
490 reply
.requestor
= SELECTION_EVENT_REQUESTOR (event
);
491 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
492 reply
.time
= SELECTION_EVENT_TIME (event
);
493 reply
.target
= SELECTION_EVENT_TARGET (event
);
494 reply
.property
= None
;
496 /* The reason for the error may be that the receiver has
497 died in the meantime. Handle that case. */
499 count
= x_catch_errors (reply
.display
);
500 XSendEvent (reply
.display
, reply
.requestor
, False
, 0L, (XEvent
*) &reply
);
501 XFlush (reply
.display
);
502 x_uncatch_errors (reply
.display
, count
);
506 /* This is the selection request currently being processed.
507 It is set to zero when the request is fully processed. */
508 static struct input_event
*x_selection_current_request
;
510 /* Display info in x_selection_request. */
512 static struct x_display_info
*selection_request_dpyinfo
;
514 /* Used as an unwind-protect clause so that, if a selection-converter signals
515 an error, we tell the requester that we were unable to do what they wanted
516 before we throw to top-level or go into the debugger or whatever. */
519 x_selection_request_lisp_error (ignore
)
522 if (x_selection_current_request
!= 0
523 && selection_request_dpyinfo
->display
)
524 x_decline_selection_request (x_selection_current_request
);
529 /* This stuff is so that INCR selections are reentrant (that is, so we can
530 be servicing multiple INCR selection requests simultaneously.) I haven't
531 actually tested that yet. */
533 /* Keep a list of the property changes that are awaited. */
543 struct prop_location
*next
;
546 static struct prop_location
*expect_property_change ();
547 static void wait_for_property_change ();
548 static void unexpect_property_change ();
549 static int waiting_for_other_props_on_window ();
551 static int prop_location_identifier
;
553 static Lisp_Object property_change_reply
;
555 static struct prop_location
*property_change_reply_object
;
557 static struct prop_location
*property_change_wait_list
;
560 queue_selection_requests_unwind (frame
)
563 FRAME_PTR f
= XFRAME (frame
);
566 x_stop_queuing_selection_requests (FRAME_X_DISPLAY (f
));
570 /* Return some frame whose display info is DPYINFO.
571 Return nil if there is none. */
574 some_frame_on_display (dpyinfo
)
575 struct x_display_info
*dpyinfo
;
577 Lisp_Object list
, frame
;
579 FOR_EACH_FRAME (list
, frame
)
581 if (FRAME_X_DISPLAY_INFO (XFRAME (frame
)) == dpyinfo
)
588 /* Send the reply to a selection request event EVENT.
589 TYPE is the type of selection data requested.
590 DATA and SIZE describe the data to send, already converted.
591 FORMAT is the unit-size (in bits) of the data to be transmitted. */
594 x_reply_selection_request (event
, format
, data
, size
, type
)
595 struct input_event
*event
;
600 XSelectionEvent reply
;
601 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
602 Window window
= SELECTION_EVENT_REQUESTOR (event
);
604 int format_bytes
= format
/8;
605 int max_bytes
= SELECTION_QUANTUM (display
);
606 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
609 if (max_bytes
> MAX_SELECTION_QUANTUM
)
610 max_bytes
= MAX_SELECTION_QUANTUM
;
612 reply
.type
= SelectionNotify
;
613 reply
.display
= display
;
614 reply
.requestor
= window
;
615 reply
.selection
= SELECTION_EVENT_SELECTION (event
);
616 reply
.time
= SELECTION_EVENT_TIME (event
);
617 reply
.target
= SELECTION_EVENT_TARGET (event
);
618 reply
.property
= SELECTION_EVENT_PROPERTY (event
);
619 if (reply
.property
== None
)
620 reply
.property
= reply
.target
;
622 /* #### XChangeProperty can generate BadAlloc, and we must handle it! */
624 count
= x_catch_errors (display
);
626 /* Store the data on the requested property.
627 If the selection is large, only store the first N bytes of it.
629 bytes_remaining
= size
* format_bytes
;
630 if (bytes_remaining
<= max_bytes
)
632 /* Send all the data at once, with minimal handshaking. */
633 TRACE1 ("Sending all %d bytes", bytes_remaining
);
634 XChangeProperty (display
, window
, reply
.property
, type
, format
,
635 PropModeReplace
, data
, size
);
636 /* At this point, the selection was successfully stored; ack it. */
637 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
641 /* Send an INCR selection. */
642 struct prop_location
*wait_object
;
646 frame
= some_frame_on_display (dpyinfo
);
648 /* If the display no longer has frames, we can't expect
649 to get many more selection requests from it, so don't
650 bother trying to queue them. */
653 x_start_queuing_selection_requests (display
);
655 record_unwind_protect (queue_selection_requests_unwind
,
659 if (x_window_to_frame (dpyinfo
, window
)) /* #### debug */
660 error ("Attempt to transfer an INCR to ourself!");
662 TRACE2 ("Start sending %d bytes incrementally (%s)",
663 bytes_remaining
, XGetAtomName (display
, reply
.property
));
664 wait_object
= expect_property_change (display
, window
, reply
.property
,
667 TRACE1 ("Set %s to number of bytes to send",
668 XGetAtomName (display
, reply
.property
));
669 XChangeProperty (display
, window
, reply
.property
, dpyinfo
->Xatom_INCR
,
671 (unsigned char *) &bytes_remaining
, 1);
672 XSelectInput (display
, window
, PropertyChangeMask
);
674 /* Tell 'em the INCR data is there... */
675 TRACE0 ("Send SelectionNotify event");
676 XSendEvent (display
, window
, False
, 0L, (XEvent
*) &reply
);
679 had_errors
= x_had_errors_p (display
);
682 /* First, wait for the requester to ack by deleting the property.
683 This can run random lisp code (process handlers) or signal. */
686 TRACE1 ("Waiting for ACK (deletion of %s)",
687 XGetAtomName (display
, reply
.property
));
688 wait_for_property_change (wait_object
);
692 while (bytes_remaining
)
694 int i
= ((bytes_remaining
< max_bytes
)
701 = expect_property_change (display
, window
, reply
.property
,
704 TRACE1 ("Sending increment of %d bytes", i
);
705 TRACE1 ("Set %s to increment data",
706 XGetAtomName (display
, reply
.property
));
708 /* Append the next chunk of data to the property. */
709 XChangeProperty (display
, window
, reply
.property
, type
, format
,
710 PropModeAppend
, data
, i
/ format_bytes
);
711 bytes_remaining
-= i
;
714 had_errors
= x_had_errors_p (display
);
720 /* Now wait for the requester to ack this chunk by deleting the
721 property. This can run random lisp code or signal. */
722 TRACE1 ("Waiting for increment ACK (deletion of %s)",
723 XGetAtomName (display
, reply
.property
));
724 wait_for_property_change (wait_object
);
727 /* Now write a zero-length chunk to the property to tell the
728 requester that we're done. */
730 if (! waiting_for_other_props_on_window (display
, window
))
731 XSelectInput (display
, window
, 0L);
733 TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
734 XGetAtomName (display
, reply
.property
));
735 XChangeProperty (display
, window
, reply
.property
, type
, format
,
736 PropModeReplace
, data
, 0);
737 TRACE0 ("Done sending incrementally");
740 /* rms, 2003-01-03: I think I have fixed this bug. */
741 /* The window we're communicating with may have been deleted
742 in the meantime (that's a real situation from a bug report).
743 In this case, there may be events in the event queue still
744 refering to the deleted window, and we'll get a BadWindow error
745 in XTread_socket when processing the events. I don't have
746 an idea how to fix that. gerd, 2001-01-98. */
748 x_uncatch_errors (display
, count
);
752 /* Handle a SelectionRequest event EVENT.
753 This is called from keyboard.c when such an event is found in the queue. */
756 x_handle_selection_request (event
)
757 struct input_event
*event
;
759 struct gcpro gcpro1
, gcpro2
, gcpro3
;
760 Lisp_Object local_selection_data
;
761 Lisp_Object selection_symbol
;
762 Lisp_Object target_symbol
;
763 Lisp_Object converted_selection
;
764 Time local_selection_time
;
765 Lisp_Object successful_p
;
767 struct x_display_info
*dpyinfo
768 = x_display_info_for_display (SELECTION_EVENT_DISPLAY (event
));
770 local_selection_data
= Qnil
;
771 target_symbol
= Qnil
;
772 converted_selection
= Qnil
;
775 GCPRO3 (local_selection_data
, converted_selection
, target_symbol
);
777 selection_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
778 SELECTION_EVENT_SELECTION (event
));
780 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
782 if (NILP (local_selection_data
))
784 /* Someone asked for the selection, but we don't have it any more.
786 x_decline_selection_request (event
);
790 local_selection_time
= (Time
)
791 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
793 if (SELECTION_EVENT_TIME (event
) != CurrentTime
794 && local_selection_time
> SELECTION_EVENT_TIME (event
))
796 /* Someone asked for the selection, and we have one, but not the one
799 x_decline_selection_request (event
);
803 x_selection_current_request
= event
;
804 count
= SPECPDL_INDEX ();
805 selection_request_dpyinfo
= dpyinfo
;
806 record_unwind_protect (x_selection_request_lisp_error
, Qnil
);
808 target_symbol
= x_atom_to_symbol (SELECTION_EVENT_DISPLAY (event
),
809 SELECTION_EVENT_TARGET (event
));
811 #if 0 /* #### MULTIPLE doesn't work yet */
812 if (EQ (target_symbol
, QMULTIPLE
))
813 target_symbol
= fetch_multiple_target (event
);
816 /* Convert lisp objects back into binary data */
819 = x_get_local_selection (selection_symbol
, target_symbol
, 0);
821 if (! NILP (converted_selection
))
829 lisp_data_to_selection_data (SELECTION_EVENT_DISPLAY (event
),
831 &data
, &type
, &size
, &format
, &nofree
);
833 x_reply_selection_request (event
, format
, data
, size
, type
);
836 /* Indicate we have successfully processed this event. */
837 x_selection_current_request
= 0;
839 /* Use xfree, not XFree, because lisp_data_to_selection_data
840 calls xmalloc itself. */
844 unbind_to (count
, Qnil
);
848 /* Let random lisp code notice that the selection has been asked for. */
851 rest
= Vx_sent_selection_hooks
;
852 if (!EQ (rest
, Qunbound
))
853 for (; CONSP (rest
); rest
= Fcdr (rest
))
854 call3 (Fcar (rest
), selection_symbol
, target_symbol
, successful_p
);
860 /* Handle a SelectionClear event EVENT, which indicates that some
861 client cleared out our previously asserted selection.
862 This is called from keyboard.c when such an event is found in the queue. */
865 x_handle_selection_clear (event
)
866 struct input_event
*event
;
868 Display
*display
= SELECTION_EVENT_DISPLAY (event
);
869 Atom selection
= SELECTION_EVENT_SELECTION (event
);
870 Time changed_owner_time
= SELECTION_EVENT_TIME (event
);
872 Lisp_Object selection_symbol
, local_selection_data
;
873 Time local_selection_time
;
874 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
875 struct x_display_info
*t_dpyinfo
;
877 /* If the new selection owner is also Emacs,
878 don't clear the new selection. */
880 /* Check each display on the same terminal,
881 to see if this Emacs job now owns the selection
882 through that display. */
883 for (t_dpyinfo
= x_display_list
; t_dpyinfo
; t_dpyinfo
= t_dpyinfo
->next
)
884 if (t_dpyinfo
->kboard
== dpyinfo
->kboard
)
887 = XGetSelectionOwner (t_dpyinfo
->display
, selection
);
888 if (x_window_to_frame (t_dpyinfo
, owner_window
) != 0)
896 selection_symbol
= x_atom_to_symbol (display
, selection
);
898 local_selection_data
= assq_no_quit (selection_symbol
, Vselection_alist
);
900 /* Well, we already believe that we don't own it, so that's just fine. */
901 if (NILP (local_selection_data
)) return;
903 local_selection_time
= (Time
)
904 cons_to_long (XCAR (XCDR (XCDR (local_selection_data
))));
906 /* This SelectionClear is for a selection that we no longer own, so we can
907 disregard it. (That is, we have reasserted the selection since this
908 request was generated.) */
910 if (changed_owner_time
!= CurrentTime
911 && local_selection_time
> changed_owner_time
)
914 /* Otherwise, we're really honest and truly being told to drop it.
915 Don't use Fdelq as that may QUIT;. */
917 if (EQ (local_selection_data
, Fcar (Vselection_alist
)))
918 Vselection_alist
= Fcdr (Vselection_alist
);
922 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
923 if (EQ (local_selection_data
, Fcar (XCDR (rest
))))
925 XSETCDR (rest
, Fcdr (XCDR (rest
)));
930 /* Let random lisp code notice that the selection has been stolen. */
934 rest
= Vx_lost_selection_hooks
;
935 if (!EQ (rest
, Qunbound
))
937 for (; CONSP (rest
); rest
= Fcdr (rest
))
938 call1 (Fcar (rest
), selection_symbol
);
939 prepare_menu_bars ();
940 redisplay_preserve_echo_area (20);
945 /* Clear all selections that were made from frame F.
946 We do this when about to delete a frame. */
949 x_clear_frame_selections (f
)
955 XSETFRAME (frame
, f
);
957 /* Otherwise, we're really honest and truly being told to drop it.
958 Don't use Fdelq as that may QUIT;. */
960 /* Delete elements from the beginning of Vselection_alist. */
961 while (!NILP (Vselection_alist
)
962 && EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (Vselection_alist
)))))))
964 /* Let random Lisp code notice that the selection has been stolen. */
965 Lisp_Object hooks
, selection_symbol
;
967 hooks
= Vx_lost_selection_hooks
;
968 selection_symbol
= Fcar (Fcar (Vselection_alist
));
970 if (!EQ (hooks
, Qunbound
))
972 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
973 call1 (Fcar (hooks
), selection_symbol
);
974 #if 0 /* This can crash when deleting a frame
975 from x_connection_closed. Anyway, it seems unnecessary;
976 something else should cause a redisplay. */
977 redisplay_preserve_echo_area (21);
981 Vselection_alist
= Fcdr (Vselection_alist
);
984 /* Delete elements after the beginning of Vselection_alist. */
985 for (rest
= Vselection_alist
; !NILP (rest
); rest
= Fcdr (rest
))
986 if (EQ (frame
, Fcar (Fcdr (Fcdr (Fcdr (Fcar (XCDR (rest
))))))))
988 /* Let random Lisp code notice that the selection has been stolen. */
989 Lisp_Object hooks
, selection_symbol
;
991 hooks
= Vx_lost_selection_hooks
;
992 selection_symbol
= Fcar (Fcar (XCDR (rest
)));
994 if (!EQ (hooks
, Qunbound
))
996 for (; CONSP (hooks
); hooks
= Fcdr (hooks
))
997 call1 (Fcar (hooks
), selection_symbol
);
998 #if 0 /* See above */
999 redisplay_preserve_echo_area (22);
1002 XSETCDR (rest
, Fcdr (XCDR (rest
)));
1007 /* Nonzero if any properties for DISPLAY and WINDOW
1008 are on the list of what we are waiting for. */
1011 waiting_for_other_props_on_window (display
, window
)
1015 struct prop_location
*rest
= property_change_wait_list
;
1017 if (rest
->display
== display
&& rest
->window
== window
)
1024 /* Add an entry to the list of property changes we are waiting for.
1025 DISPLAY, WINDOW, PROPERTY, STATE describe what we will wait for.
1026 The return value is a number that uniquely identifies
1027 this awaited property change. */
1029 static struct prop_location
*
1030 expect_property_change (display
, window
, property
, state
)
1036 struct prop_location
*pl
= (struct prop_location
*) xmalloc (sizeof *pl
);
1037 pl
->identifier
= ++prop_location_identifier
;
1038 pl
->display
= display
;
1039 pl
->window
= window
;
1040 pl
->property
= property
;
1041 pl
->desired_state
= state
;
1042 pl
->next
= property_change_wait_list
;
1044 property_change_wait_list
= pl
;
1048 /* Delete an entry from the list of property changes we are waiting for.
1049 IDENTIFIER is the number that uniquely identifies the entry. */
1052 unexpect_property_change (location
)
1053 struct prop_location
*location
;
1055 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1058 if (rest
== location
)
1061 prev
->next
= rest
->next
;
1063 property_change_wait_list
= rest
->next
;
1072 /* Remove the property change expectation element for IDENTIFIER. */
1075 wait_for_property_change_unwind (identifierval
)
1076 Lisp_Object identifierval
;
1078 unexpect_property_change ((struct prop_location
*)
1079 (XFASTINT (XCAR (identifierval
)) << 16
1080 | XFASTINT (XCDR (identifierval
))));
1084 /* Actually wait for a property change.
1085 IDENTIFIER should be the value that expect_property_change returned. */
1088 wait_for_property_change (location
)
1089 struct prop_location
*location
;
1092 int count
= SPECPDL_INDEX ();
1095 tem
= Fcons (Qnil
, Qnil
);
1096 XSETCARFASTINT (tem
, (EMACS_UINT
)location
>> 16);
1097 XSETCDRFASTINT (tem
, (EMACS_UINT
)location
& 0xffff);
1099 /* Make sure to do unexpect_property_change if we quit or err. */
1100 record_unwind_protect (wait_for_property_change_unwind
, tem
);
1102 XSETCAR (property_change_reply
, Qnil
);
1104 property_change_reply_object
= location
;
1105 /* If the event we are waiting for arrives beyond here, it will set
1106 property_change_reply, because property_change_reply_object says so. */
1107 if (! location
->arrived
)
1109 secs
= x_selection_timeout
/ 1000;
1110 usecs
= (x_selection_timeout
% 1000) * 1000;
1111 TRACE2 (" Waiting %d secs, %d usecs", secs
, usecs
);
1112 wait_reading_process_output (secs
, usecs
, 0, 0,
1113 property_change_reply
, NULL
, 0);
1115 if (NILP (XCAR (property_change_reply
)))
1117 TRACE0 (" Timed out");
1118 error ("Timed out waiting for property-notify event");
1122 unbind_to (count
, Qnil
);
1125 /* Called from XTread_socket in response to a PropertyNotify event. */
1128 x_handle_property_notify (event
)
1129 XPropertyEvent
*event
;
1131 struct prop_location
*prev
= 0, *rest
= property_change_wait_list
;
1135 if (rest
->property
== event
->atom
1136 && rest
->window
== event
->window
1137 && rest
->display
== event
->display
1138 && rest
->desired_state
== event
->state
)
1140 TRACE2 ("Expected %s of property %s",
1141 (event
->state
== PropertyDelete
? "deletion" : "change"),
1142 XGetAtomName (event
->display
, event
->atom
));
1146 /* If this is the one wait_for_property_change is waiting for,
1147 tell it to wake up. */
1148 if (rest
== property_change_reply_object
)
1149 XSETCAR (property_change_reply
, Qt
);
1152 prev
->next
= rest
->next
;
1154 property_change_wait_list
= rest
->next
;
1166 #if 0 /* #### MULTIPLE doesn't work yet */
1169 fetch_multiple_target (event
)
1170 XSelectionRequestEvent
*event
;
1172 Display
*display
= event
->display
;
1173 Window window
= event
->requestor
;
1174 Atom target
= event
->target
;
1175 Atom selection_atom
= event
->selection
;
1180 x_get_window_property_as_lisp_data (display
, window
, target
,
1181 QMULTIPLE
, selection_atom
));
1185 copy_multiple_data (obj
)
1192 return Fcons (XCAR (obj
), copy_multiple_data (XCDR (obj
)));
1195 vec
= Fmake_vector (size
= XVECTOR (obj
)->size
, Qnil
);
1196 for (i
= 0; i
< size
; i
++)
1198 Lisp_Object vec2
= XVECTOR (obj
)->contents
[i
];
1199 CHECK_VECTOR (vec2
);
1200 if (XVECTOR (vec2
)->size
!= 2)
1201 /* ??? Confusing error message */
1202 Fsignal (Qerror
, Fcons (build_string ("vectors must be of length 2"),
1203 Fcons (vec2
, Qnil
)));
1204 XVECTOR (vec
)->contents
[i
] = Fmake_vector (2, Qnil
);
1205 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[0]
1206 = XVECTOR (vec2
)->contents
[0];
1207 XVECTOR (XVECTOR (vec
)->contents
[i
])->contents
[1]
1208 = XVECTOR (vec2
)->contents
[1];
1216 /* Variables for communication with x_handle_selection_notify. */
1217 static Atom reading_which_selection
;
1218 static Lisp_Object reading_selection_reply
;
1219 static Window reading_selection_window
;
1221 /* Do protocol to read selection-data from the server.
1222 Converts this to Lisp data and returns it. */
1225 x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
)
1226 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1228 struct frame
*sf
= SELECTED_FRAME ();
1229 Window requestor_window
= FRAME_X_WINDOW (sf
);
1230 Display
*display
= FRAME_X_DISPLAY (sf
);
1231 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
1232 Time requestor_time
= last_event_timestamp
;
1233 Atom target_property
= dpyinfo
->Xatom_EMACS_TMP
;
1234 Atom selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection_symbol
);
1240 if (CONSP (target_type
))
1241 type_atom
= symbol_to_x_atom (dpyinfo
, display
, XCAR (target_type
));
1243 type_atom
= symbol_to_x_atom (dpyinfo
, display
, target_type
);
1245 if (! NILP (time_stamp
))
1247 if (CONSP (time_stamp
))
1248 requestor_time
= (Time
) cons_to_long (time_stamp
);
1249 else if (INTEGERP (time_stamp
))
1250 requestor_time
= (Time
) XUINT (time_stamp
);
1251 else if (FLOATP (time_stamp
))
1252 requestor_time
= (Time
) XFLOAT (time_stamp
);
1254 error ("TIME_STAMP must be cons or number");
1259 count
= x_catch_errors (display
);
1261 TRACE2 ("Get selection %s, type %s",
1262 XGetAtomName (display
, type_atom
),
1263 XGetAtomName (display
, target_property
));
1265 XConvertSelection (display
, selection_atom
, type_atom
, target_property
,
1266 requestor_window
, requestor_time
);
1269 /* Prepare to block until the reply has been read. */
1270 reading_selection_window
= requestor_window
;
1271 reading_which_selection
= selection_atom
;
1272 XSETCAR (reading_selection_reply
, Qnil
);
1274 frame
= some_frame_on_display (dpyinfo
);
1276 /* If the display no longer has frames, we can't expect
1277 to get many more selection requests from it, so don't
1278 bother trying to queue them. */
1281 x_start_queuing_selection_requests (display
);
1283 record_unwind_protect (queue_selection_requests_unwind
,
1288 /* This allows quits. Also, don't wait forever. */
1289 secs
= x_selection_timeout
/ 1000;
1290 usecs
= (x_selection_timeout
% 1000) * 1000;
1291 TRACE1 (" Start waiting %d secs for SelectionNotify", secs
);
1292 wait_reading_process_output (secs
, usecs
, 0, 0,
1293 reading_selection_reply
, NULL
, 0);
1294 TRACE1 (" Got event = %d", !NILP (XCAR (reading_selection_reply
)));
1297 x_check_errors (display
, "Cannot get selection: %s");
1298 x_uncatch_errors (display
, count
);
1301 if (NILP (XCAR (reading_selection_reply
)))
1302 error ("Timed out waiting for reply from selection owner");
1303 if (EQ (XCAR (reading_selection_reply
), Qlambda
))
1304 error ("No `%s' selection", SDATA (SYMBOL_NAME (selection_symbol
)));
1306 /* Otherwise, the selection is waiting for us on the requested property. */
1308 x_get_window_property_as_lisp_data (display
, requestor_window
,
1309 target_property
, target_type
,
1313 /* Subroutines of x_get_window_property_as_lisp_data */
1315 /* Use xfree, not XFree, to free the data obtained with this function. */
1318 x_get_window_property (display
, window
, property
, data_ret
, bytes_ret
,
1319 actual_type_ret
, actual_format_ret
, actual_size_ret
,
1324 unsigned char **data_ret
;
1326 Atom
*actual_type_ret
;
1327 int *actual_format_ret
;
1328 unsigned long *actual_size_ret
;
1332 unsigned long bytes_remaining
;
1334 unsigned char *tmp_data
= 0;
1336 int buffer_size
= SELECTION_QUANTUM (display
);
1338 if (buffer_size
> MAX_SELECTION_QUANTUM
)
1339 buffer_size
= MAX_SELECTION_QUANTUM
;
1343 /* First probe the thing to find out how big it is. */
1344 result
= XGetWindowProperty (display
, window
, property
,
1345 0L, 0L, False
, AnyPropertyType
,
1346 actual_type_ret
, actual_format_ret
,
1348 &bytes_remaining
, &tmp_data
);
1349 if (result
!= Success
)
1357 /* This was allocated by Xlib, so use XFree. */
1358 XFree ((char *) tmp_data
);
1360 if (*actual_type_ret
== None
|| *actual_format_ret
== 0)
1366 total_size
= bytes_remaining
+ 1;
1367 *data_ret
= (unsigned char *) xmalloc (total_size
);
1369 /* Now read, until we've gotten it all. */
1370 while (bytes_remaining
)
1372 #ifdef TRACE_SELECTION
1373 int last
= bytes_remaining
;
1376 = XGetWindowProperty (display
, window
, property
,
1377 (long)offset
/4, (long)buffer_size
/4,
1380 actual_type_ret
, actual_format_ret
,
1381 actual_size_ret
, &bytes_remaining
, &tmp_data
);
1383 TRACE2 ("Read %ld bytes from property %s",
1384 last
- bytes_remaining
,
1385 XGetAtomName (display
, property
));
1387 /* If this doesn't return Success at this point, it means that
1388 some clod deleted the selection while we were in the midst of
1389 reading it. Deal with that, I guess.... */
1390 if (result
!= Success
)
1392 *actual_size_ret
*= *actual_format_ret
/ 8;
1393 bcopy (tmp_data
, (*data_ret
) + offset
, *actual_size_ret
);
1394 offset
+= *actual_size_ret
;
1396 /* This was allocated by Xlib, so use XFree. */
1397 XFree ((char *) tmp_data
);
1402 *bytes_ret
= offset
;
1405 /* Use xfree, not XFree, to free the data obtained with this function. */
1408 receive_incremental_selection (display
, window
, property
, target_type
,
1409 min_size_bytes
, data_ret
, size_bytes_ret
,
1410 type_ret
, format_ret
, size_ret
)
1414 Lisp_Object target_type
; /* for error messages only */
1415 unsigned int min_size_bytes
;
1416 unsigned char **data_ret
;
1417 int *size_bytes_ret
;
1419 unsigned long *size_ret
;
1423 struct prop_location
*wait_object
;
1424 *size_bytes_ret
= min_size_bytes
;
1425 *data_ret
= (unsigned char *) xmalloc (*size_bytes_ret
);
1427 TRACE1 ("Read %d bytes incrementally", min_size_bytes
);
1429 /* At this point, we have read an INCR property.
1430 Delete the property to ack it.
1431 (But first, prepare to receive the next event in this handshake.)
1433 Now, we must loop, waiting for the sending window to put a value on
1434 that property, then reading the property, then deleting it to ack.
1435 We are done when the sender places a property of length 0.
1438 XSelectInput (display
, window
, STANDARD_EVENT_SET
| PropertyChangeMask
);
1439 TRACE1 (" Delete property %s",
1440 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1441 XDeleteProperty (display
, window
, property
);
1442 TRACE1 (" Expect new value of property %s",
1443 XSYMBOL (x_atom_to_symbol (display
, property
))->name
->data
);
1444 wait_object
= expect_property_change (display
, window
, property
,
1451 unsigned char *tmp_data
;
1454 TRACE0 (" Wait for property change");
1455 wait_for_property_change (wait_object
);
1457 /* expect it again immediately, because x_get_window_property may
1458 .. no it won't, I don't get it.
1459 .. Ok, I get it now, the Xt code that implements INCR is broken. */
1460 TRACE0 (" Get property value");
1461 x_get_window_property (display
, window
, property
,
1462 &tmp_data
, &tmp_size_bytes
,
1463 type_ret
, format_ret
, size_ret
, 1);
1465 TRACE1 (" Read increment of %d bytes", tmp_size_bytes
);
1467 if (tmp_size_bytes
== 0) /* we're done */
1469 TRACE0 ("Done reading incrementally");
1471 if (! waiting_for_other_props_on_window (display
, window
))
1472 XSelectInput (display
, window
, STANDARD_EVENT_SET
);
1473 unexpect_property_change (wait_object
);
1474 /* Use xfree, not XFree, because x_get_window_property
1475 calls xmalloc itself. */
1476 if (tmp_data
) xfree (tmp_data
);
1481 TRACE1 (" ACK by deleting property %s",
1482 XGetAtomName (display
, property
));
1483 XDeleteProperty (display
, window
, property
);
1484 wait_object
= expect_property_change (display
, window
, property
,
1489 if (*size_bytes_ret
< offset
+ tmp_size_bytes
)
1491 *size_bytes_ret
= offset
+ tmp_size_bytes
;
1492 *data_ret
= (unsigned char *) xrealloc (*data_ret
, *size_bytes_ret
);
1495 bcopy (tmp_data
, (*data_ret
) + offset
, tmp_size_bytes
);
1496 offset
+= tmp_size_bytes
;
1498 /* Use xfree, not XFree, because x_get_window_property
1499 calls xmalloc itself. */
1505 /* Once a requested selection is "ready" (we got a SelectionNotify event),
1506 fetch value from property PROPERTY of X window WINDOW on display DISPLAY.
1507 TARGET_TYPE and SELECTION_ATOM are used in error message if this fails. */
1510 x_get_window_property_as_lisp_data (display
, window
, property
, target_type
,
1515 Lisp_Object target_type
; /* for error messages only */
1516 Atom selection_atom
; /* for error messages only */
1520 unsigned long actual_size
;
1521 unsigned char *data
= 0;
1524 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1526 TRACE0 ("Reading selection data");
1528 x_get_window_property (display
, window
, property
, &data
, &bytes
,
1529 &actual_type
, &actual_format
, &actual_size
, 1);
1532 int there_is_a_selection_owner
;
1534 there_is_a_selection_owner
1535 = XGetSelectionOwner (display
, selection_atom
);
1538 there_is_a_selection_owner
1539 ? Fcons (build_string ("selection owner couldn't convert"),
1541 ? Fcons (target_type
,
1542 Fcons (x_atom_to_symbol (display
,
1545 : Fcons (target_type
, Qnil
))
1546 : Fcons (build_string ("no selection"),
1547 Fcons (x_atom_to_symbol (display
,
1552 if (actual_type
== dpyinfo
->Xatom_INCR
)
1554 /* That wasn't really the data, just the beginning. */
1556 unsigned int min_size_bytes
= * ((unsigned int *) data
);
1558 /* Use xfree, not XFree, because x_get_window_property
1559 calls xmalloc itself. */
1560 xfree ((char *) data
);
1562 receive_incremental_selection (display
, window
, property
, target_type
,
1563 min_size_bytes
, &data
, &bytes
,
1564 &actual_type
, &actual_format
,
1569 TRACE1 (" Delete property %s", XGetAtomName (display
, property
));
1570 XDeleteProperty (display
, window
, property
);
1574 /* It's been read. Now convert it to a lisp object in some semi-rational
1576 val
= selection_data_to_lisp_data (display
, data
, bytes
,
1577 actual_type
, actual_format
);
1579 /* Use xfree, not XFree, because x_get_window_property
1580 calls xmalloc itself. */
1581 xfree ((char *) data
);
1585 /* These functions convert from the selection data read from the server into
1586 something that we can use from Lisp, and vice versa.
1588 Type: Format: Size: Lisp Type:
1589 ----- ------- ----- -----------
1592 ATOM 32 > 1 Vector of Symbols
1594 * 16 > 1 Vector of Integers
1595 * 32 1 if <=16 bits: Integer
1596 if > 16 bits: Cons of top16, bot16
1597 * 32 > 1 Vector of the above
1599 When converting a Lisp number to C, it is assumed to be of format 16 if
1600 it is an integer, and of format 32 if it is a cons of two integers.
1602 When converting a vector of numbers from Lisp to C, it is assumed to be
1603 of format 16 if every element in the vector is an integer, and is assumed
1604 to be of format 32 if any element is a cons of two integers.
1606 When converting an object to C, it may be of the form (SYMBOL . <data>)
1607 where SYMBOL is what we should claim that the type is. Format and
1608 representation are as above. */
1613 selection_data_to_lisp_data (display
, data
, size
, type
, format
)
1615 unsigned char *data
;
1619 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1621 if (type
== dpyinfo
->Xatom_NULL
)
1624 /* Convert any 8-bit data to a string, for compactness. */
1625 else if (format
== 8)
1627 Lisp_Object str
, lispy_type
;
1629 str
= make_unibyte_string ((char *) data
, size
);
1630 /* Indicate that this string is from foreign selection by a text
1631 property `foreign-selection' so that the caller of
1632 x-get-selection-internal (usually x-get-selection) can know
1633 that the string must be decode. */
1634 if (type
== dpyinfo
->Xatom_COMPOUND_TEXT
)
1635 lispy_type
= QCOMPOUND_TEXT
;
1636 else if (type
== dpyinfo
->Xatom_UTF8_STRING
)
1637 lispy_type
= QUTF8_STRING
;
1639 lispy_type
= QSTRING
;
1640 Fput_text_property (make_number (0), make_number (size
),
1641 Qforeign_selection
, lispy_type
, str
);
1644 /* Convert a single atom to a Lisp_Symbol. Convert a set of atoms to
1645 a vector of symbols.
1647 else if (type
== XA_ATOM
)
1650 if (size
== sizeof (Atom
))
1651 return x_atom_to_symbol (display
, *((Atom
*) data
));
1654 Lisp_Object v
= Fmake_vector (make_number (size
/ sizeof (Atom
)),
1656 for (i
= 0; i
< size
/ sizeof (Atom
); i
++)
1657 Faset (v
, make_number (i
),
1658 x_atom_to_symbol (display
, ((Atom
*) data
) [i
]));
1663 /* Convert a single 16 or small 32 bit number to a Lisp_Int.
1664 If the number is > 16 bits, convert it to a cons of integers,
1665 16 bits in each half.
1667 else if (format
== 32 && size
== sizeof (int))
1668 return long_to_cons (((unsigned int *) data
) [0]);
1669 else if (format
== 16 && size
== sizeof (short))
1670 return make_number ((int) (((unsigned short *) data
) [0]));
1672 /* Convert any other kind of data to a vector of numbers, represented
1673 as above (as an integer, or a cons of two 16 bit integers.)
1675 else if (format
== 16)
1679 v
= Fmake_vector (make_number (size
/ 2), make_number (0));
1680 for (i
= 0; i
< size
/ 2; i
++)
1682 int j
= (int) ((unsigned short *) data
) [i
];
1683 Faset (v
, make_number (i
), make_number (j
));
1690 Lisp_Object v
= Fmake_vector (make_number (size
/ 4), make_number (0));
1691 for (i
= 0; i
< size
/ 4; i
++)
1693 unsigned int j
= ((unsigned int *) data
) [i
];
1694 Faset (v
, make_number (i
), long_to_cons (j
));
1701 /* Use xfree, not XFree, to free the data obtained with this function. */
1704 lisp_data_to_selection_data (display
, obj
,
1705 data_ret
, type_ret
, size_ret
,
1706 format_ret
, nofree_ret
)
1709 unsigned char **data_ret
;
1711 unsigned int *size_ret
;
1715 Lisp_Object type
= Qnil
;
1716 struct x_display_info
*dpyinfo
= x_display_info_for_display (display
);
1720 if (CONSP (obj
) && SYMBOLP (XCAR (obj
)))
1724 if (CONSP (obj
) && NILP (XCDR (obj
)))
1728 if (EQ (obj
, QNULL
) || (EQ (type
, QNULL
)))
1729 { /* This is not the same as declining */
1735 else if (STRINGP (obj
))
1737 xassert (! STRING_MULTIBYTE (obj
));
1741 *size_ret
= SBYTES (obj
);
1742 *data_ret
= SDATA (obj
);
1745 else if (SYMBOLP (obj
))
1749 *data_ret
= (unsigned char *) xmalloc (sizeof (Atom
) + 1);
1750 (*data_ret
) [sizeof (Atom
)] = 0;
1751 (*(Atom
**) data_ret
) [0] = symbol_to_x_atom (dpyinfo
, display
, obj
);
1752 if (NILP (type
)) type
= QATOM
;
1754 else if (INTEGERP (obj
)
1755 && XINT (obj
) < 0xFFFF
1756 && XINT (obj
) > -0xFFFF)
1760 *data_ret
= (unsigned char *) xmalloc (sizeof (short) + 1);
1761 (*data_ret
) [sizeof (short)] = 0;
1762 (*(short **) data_ret
) [0] = (short) XINT (obj
);
1763 if (NILP (type
)) type
= QINTEGER
;
1765 else if (INTEGERP (obj
)
1766 || (CONSP (obj
) && INTEGERP (XCAR (obj
))
1767 && (INTEGERP (XCDR (obj
))
1768 || (CONSP (XCDR (obj
))
1769 && INTEGERP (XCAR (XCDR (obj
)))))))
1773 *data_ret
= (unsigned char *) xmalloc (sizeof (long) + 1);
1774 (*data_ret
) [sizeof (long)] = 0;
1775 (*(unsigned long **) data_ret
) [0] = cons_to_long (obj
);
1776 if (NILP (type
)) type
= QINTEGER
;
1778 else if (VECTORP (obj
))
1780 /* Lisp_Vectors may represent a set of ATOMs;
1781 a set of 16 or 32 bit INTEGERs;
1782 or a set of ATOM_PAIRs (represented as [[A1 A2] [A3 A4] ...]
1786 if (SYMBOLP (XVECTOR (obj
)->contents
[0]))
1787 /* This vector is an ATOM set */
1789 if (NILP (type
)) type
= QATOM
;
1790 *size_ret
= XVECTOR (obj
)->size
;
1792 *data_ret
= (unsigned char *) xmalloc ((*size_ret
) * sizeof (Atom
));
1793 for (i
= 0; i
< *size_ret
; i
++)
1794 if (SYMBOLP (XVECTOR (obj
)->contents
[i
]))
1795 (*(Atom
**) data_ret
) [i
]
1796 = symbol_to_x_atom (dpyinfo
, display
, XVECTOR (obj
)->contents
[i
]);
1798 Fsignal (Qerror
, /* Qselection_error */
1800 ("all elements of selection vector must have same type"),
1801 Fcons (obj
, Qnil
)));
1803 #if 0 /* #### MULTIPLE doesn't work yet */
1804 else if (VECTORP (XVECTOR (obj
)->contents
[0]))
1805 /* This vector is an ATOM_PAIR set */
1807 if (NILP (type
)) type
= QATOM_PAIR
;
1808 *size_ret
= XVECTOR (obj
)->size
;
1810 *data_ret
= (unsigned char *)
1811 xmalloc ((*size_ret
) * sizeof (Atom
) * 2);
1812 for (i
= 0; i
< *size_ret
; i
++)
1813 if (VECTORP (XVECTOR (obj
)->contents
[i
]))
1815 Lisp_Object pair
= XVECTOR (obj
)->contents
[i
];
1816 if (XVECTOR (pair
)->size
!= 2)
1819 ("elements of the vector must be vectors of exactly two elements"),
1820 Fcons (pair
, Qnil
)));
1822 (*(Atom
**) data_ret
) [i
* 2]
1823 = symbol_to_x_atom (dpyinfo
, display
,
1824 XVECTOR (pair
)->contents
[0]);
1825 (*(Atom
**) data_ret
) [(i
* 2) + 1]
1826 = symbol_to_x_atom (dpyinfo
, display
,
1827 XVECTOR (pair
)->contents
[1]);
1832 ("all elements of the vector must be of the same type"),
1833 Fcons (obj
, Qnil
)));
1838 /* This vector is an INTEGER set, or something like it */
1840 *size_ret
= XVECTOR (obj
)->size
;
1841 if (NILP (type
)) type
= QINTEGER
;
1843 for (i
= 0; i
< *size_ret
; i
++)
1844 if (CONSP (XVECTOR (obj
)->contents
[i
]))
1846 else if (!INTEGERP (XVECTOR (obj
)->contents
[i
]))
1847 Fsignal (Qerror
, /* Qselection_error */
1849 ("elements of selection vector must be integers or conses of integers"),
1850 Fcons (obj
, Qnil
)));
1852 *data_ret
= (unsigned char *) xmalloc (*size_ret
* (*format_ret
/8));
1853 for (i
= 0; i
< *size_ret
; i
++)
1854 if (*format_ret
== 32)
1855 (*((unsigned long **) data_ret
)) [i
]
1856 = cons_to_long (XVECTOR (obj
)->contents
[i
]);
1858 (*((unsigned short **) data_ret
)) [i
]
1859 = (unsigned short) cons_to_long (XVECTOR (obj
)->contents
[i
]);
1863 Fsignal (Qerror
, /* Qselection_error */
1864 Fcons (build_string ("unrecognised selection data"),
1865 Fcons (obj
, Qnil
)));
1867 *type_ret
= symbol_to_x_atom (dpyinfo
, display
, type
);
1871 clean_local_selection_data (obj
)
1875 && INTEGERP (XCAR (obj
))
1876 && CONSP (XCDR (obj
))
1877 && INTEGERP (XCAR (XCDR (obj
)))
1878 && NILP (XCDR (XCDR (obj
))))
1879 obj
= Fcons (XCAR (obj
), XCDR (obj
));
1882 && INTEGERP (XCAR (obj
))
1883 && INTEGERP (XCDR (obj
)))
1885 if (XINT (XCAR (obj
)) == 0)
1887 if (XINT (XCAR (obj
)) == -1)
1888 return make_number (- XINT (XCDR (obj
)));
1893 int size
= XVECTOR (obj
)->size
;
1896 return clean_local_selection_data (XVECTOR (obj
)->contents
[0]);
1897 copy
= Fmake_vector (make_number (size
), Qnil
);
1898 for (i
= 0; i
< size
; i
++)
1899 XVECTOR (copy
)->contents
[i
]
1900 = clean_local_selection_data (XVECTOR (obj
)->contents
[i
]);
1906 /* Called from XTread_socket to handle SelectionNotify events.
1907 If it's the selection we are waiting for, stop waiting
1908 by setting the car of reading_selection_reply to non-nil.
1909 We store t there if the reply is successful, lambda if not. */
1912 x_handle_selection_notify (event
)
1913 XSelectionEvent
*event
;
1915 if (event
->requestor
!= reading_selection_window
)
1917 if (event
->selection
!= reading_which_selection
)
1920 TRACE0 ("Received SelectionNotify");
1921 XSETCAR (reading_selection_reply
,
1922 (event
->property
!= 0 ? Qt
: Qlambda
));
1926 DEFUN ("x-own-selection-internal", Fx_own_selection_internal
,
1927 Sx_own_selection_internal
, 2, 2, 0,
1928 doc
: /* Assert an X selection of the given TYPE with the given VALUE.
1929 TYPE is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1930 \(Those are literal upper-case symbol names, since that's what X expects.)
1931 VALUE is typically a string, or a cons of two markers, but may be
1932 anything that the functions on `selection-converter-alist' know about. */)
1933 (selection_name
, selection_value
)
1934 Lisp_Object selection_name
, selection_value
;
1937 CHECK_SYMBOL (selection_name
);
1938 if (NILP (selection_value
)) error ("selection-value may not be nil");
1939 x_own_selection (selection_name
, selection_value
);
1940 return selection_value
;
1944 /* Request the selection value from the owner. If we are the owner,
1945 simply return our selection value. If we are not the owner, this
1946 will block until all of the data has arrived. */
1948 DEFUN ("x-get-selection-internal", Fx_get_selection_internal
,
1949 Sx_get_selection_internal
, 2, 3, 0,
1950 doc
: /* Return text selected from some X window.
1951 SELECTION is a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'.
1952 \(Those are literal upper-case symbol names, since that's what X expects.)
1953 TYPE is the type of data desired, typically `STRING'.
1954 TIME_STAMP is the time to use in the XConvertSelection call for foreign
1955 selections. If omitted, defaults to the time for the last event. */)
1956 (selection_symbol
, target_type
, time_stamp
)
1957 Lisp_Object selection_symbol
, target_type
, time_stamp
;
1959 Lisp_Object val
= Qnil
;
1960 struct gcpro gcpro1
, gcpro2
;
1961 GCPRO2 (target_type
, val
); /* we store newly consed data into these */
1963 CHECK_SYMBOL (selection_symbol
);
1965 #if 0 /* #### MULTIPLE doesn't work yet */
1966 if (CONSP (target_type
)
1967 && XCAR (target_type
) == QMULTIPLE
)
1969 CHECK_VECTOR (XCDR (target_type
));
1970 /* So we don't destructively modify this... */
1971 target_type
= copy_multiple_data (target_type
);
1975 CHECK_SYMBOL (target_type
);
1977 val
= x_get_local_selection (selection_symbol
, target_type
, 1);
1981 val
= x_get_foreign_selection (selection_symbol
, target_type
, time_stamp
);
1986 && SYMBOLP (XCAR (val
)))
1989 if (CONSP (val
) && NILP (XCDR (val
)))
1992 val
= clean_local_selection_data (val
);
1998 DEFUN ("x-disown-selection-internal", Fx_disown_selection_internal
,
1999 Sx_disown_selection_internal
, 1, 2, 0,
2000 doc
: /* If we own the selection SELECTION, disown it.
2001 Disowning it means there is no such selection. */)
2003 Lisp_Object selection
;
2007 Atom selection_atom
;
2008 struct selection_input_event event
;
2010 struct x_display_info
*dpyinfo
;
2011 struct frame
*sf
= SELECTED_FRAME ();
2014 display
= FRAME_X_DISPLAY (sf
);
2015 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2016 CHECK_SYMBOL (selection
);
2018 timestamp
= last_event_timestamp
;
2020 timestamp
= cons_to_long (time
);
2022 if (NILP (assq_no_quit (selection
, Vselection_alist
)))
2023 return Qnil
; /* Don't disown the selection when we're not the owner. */
2025 selection_atom
= symbol_to_x_atom (dpyinfo
, display
, selection
);
2028 XSetSelectionOwner (display
, selection_atom
, None
, timestamp
);
2031 /* It doesn't seem to be guaranteed that a SelectionClear event will be
2032 generated for a window which owns the selection when that window sets
2033 the selection owner to None. The NCD server does, the MIT Sun4 server
2034 doesn't. So we synthesize one; this means we might get two, but
2035 that's ok, because the second one won't have any effect. */
2036 SELECTION_EVENT_DISPLAY (&event
) = display
;
2037 SELECTION_EVENT_SELECTION (&event
) = selection_atom
;
2038 SELECTION_EVENT_TIME (&event
) = timestamp
;
2039 x_handle_selection_clear ((struct input_event
*) &event
);
2044 /* Get rid of all the selections in buffer BUFFER.
2045 This is used when we kill a buffer. */
2048 x_disown_buffer_selections (buffer
)
2052 struct buffer
*buf
= XBUFFER (buffer
);
2054 for (tail
= Vselection_alist
; CONSP (tail
); tail
= XCDR (tail
))
2056 Lisp_Object elt
, value
;
2059 if (CONSP (value
) && MARKERP (XCAR (value
))
2060 && XMARKER (XCAR (value
))->buffer
== buf
)
2061 Fx_disown_selection_internal (XCAR (elt
), Qnil
);
2065 DEFUN ("x-selection-owner-p", Fx_selection_owner_p
, Sx_selection_owner_p
,
2067 doc
: /* Whether the current Emacs process owns the given X Selection.
2068 The arg should be the name of the selection in question, typically one of
2069 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2070 \(Those are literal upper-case symbol names, since that's what X expects.)
2071 For convenience, the symbol nil is the same as `PRIMARY',
2072 and t is the same as `SECONDARY'. */)
2074 Lisp_Object selection
;
2077 CHECK_SYMBOL (selection
);
2078 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2079 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2081 if (NILP (Fassq (selection
, Vselection_alist
)))
2086 DEFUN ("x-selection-exists-p", Fx_selection_exists_p
, Sx_selection_exists_p
,
2088 doc
: /* Whether there is an owner for the given X Selection.
2089 The arg should be the name of the selection in question, typically one of
2090 the symbols `PRIMARY', `SECONDARY', or `CLIPBOARD'.
2091 \(Those are literal upper-case symbol names, since that's what X expects.)
2092 For convenience, the symbol nil is the same as `PRIMARY',
2093 and t is the same as `SECONDARY'. */)
2095 Lisp_Object selection
;
2100 struct frame
*sf
= SELECTED_FRAME ();
2102 /* It should be safe to call this before we have an X frame. */
2103 if (! FRAME_X_P (sf
))
2106 dpy
= FRAME_X_DISPLAY (sf
);
2107 CHECK_SYMBOL (selection
);
2108 if (!NILP (Fx_selection_owner_p (selection
)))
2110 if (EQ (selection
, Qnil
)) selection
= QPRIMARY
;
2111 if (EQ (selection
, Qt
)) selection
= QSECONDARY
;
2112 atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
), dpy
, selection
);
2116 owner
= XGetSelectionOwner (dpy
, atom
);
2118 return (owner
? Qt
: Qnil
);
2122 #ifdef CUT_BUFFER_SUPPORT
2124 /* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */
2126 initialize_cut_buffers (display
, window
)
2130 unsigned char *data
= (unsigned char *) "";
2132 #define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \
2133 PropModeAppend, data, 0)
2134 FROB (XA_CUT_BUFFER0
);
2135 FROB (XA_CUT_BUFFER1
);
2136 FROB (XA_CUT_BUFFER2
);
2137 FROB (XA_CUT_BUFFER3
);
2138 FROB (XA_CUT_BUFFER4
);
2139 FROB (XA_CUT_BUFFER5
);
2140 FROB (XA_CUT_BUFFER6
);
2141 FROB (XA_CUT_BUFFER7
);
2147 #define CHECK_CUT_BUFFER(symbol) \
2148 { CHECK_SYMBOL ((symbol)); \
2149 if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \
2150 && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \
2151 && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \
2152 && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \
2154 Fcons (build_string ("doesn't name a cut buffer"), \
2155 Fcons ((symbol), Qnil))); \
2158 DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal
,
2159 Sx_get_cut_buffer_internal
, 1, 1, 0,
2160 doc
: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */)
2166 unsigned char *data
;
2173 struct x_display_info
*dpyinfo
;
2174 struct frame
*sf
= SELECTED_FRAME ();
2177 display
= FRAME_X_DISPLAY (sf
);
2178 dpyinfo
= FRAME_X_DISPLAY_INFO (sf
);
2179 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2180 CHECK_CUT_BUFFER (buffer
);
2181 buffer_atom
= symbol_to_x_atom (dpyinfo
, display
, buffer
);
2183 x_get_window_property (display
, window
, buffer_atom
, &data
, &bytes
,
2184 &type
, &format
, &size
, 0);
2185 if (!data
|| !format
)
2188 if (format
!= 8 || type
!= XA_STRING
)
2190 Fcons (build_string ("cut buffer doesn't contain 8-bit data"),
2191 Fcons (x_atom_to_symbol (display
, type
),
2192 Fcons (make_number (format
), Qnil
))));
2194 ret
= (bytes
? make_string ((char *) data
, bytes
) : Qnil
);
2195 /* Use xfree, not XFree, because x_get_window_property
2196 calls xmalloc itself. */
2202 DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal
,
2203 Sx_store_cut_buffer_internal
, 2, 2, 0,
2204 doc
: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */)
2206 Lisp_Object buffer
, string
;
2210 unsigned char *data
;
2212 int bytes_remaining
;
2215 struct frame
*sf
= SELECTED_FRAME ();
2218 display
= FRAME_X_DISPLAY (sf
);
2219 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2221 max_bytes
= SELECTION_QUANTUM (display
);
2222 if (max_bytes
> MAX_SELECTION_QUANTUM
)
2223 max_bytes
= MAX_SELECTION_QUANTUM
;
2225 CHECK_CUT_BUFFER (buffer
);
2226 CHECK_STRING (string
);
2227 buffer_atom
= symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf
),
2229 data
= (unsigned char *) SDATA (string
);
2230 bytes
= SBYTES (string
);
2231 bytes_remaining
= bytes
;
2233 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2235 initialize_cut_buffers (display
, window
);
2236 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2241 /* Don't mess up with an empty value. */
2242 if (!bytes_remaining
)
2243 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2244 PropModeReplace
, data
, 0);
2246 while (bytes_remaining
)
2248 int chunk
= (bytes_remaining
< max_bytes
2249 ? bytes_remaining
: max_bytes
);
2250 XChangeProperty (display
, window
, buffer_atom
, XA_STRING
, 8,
2251 (bytes_remaining
== bytes
2256 bytes_remaining
-= chunk
;
2263 DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal
,
2264 Sx_rotate_cut_buffers_internal
, 1, 1, 0,
2265 doc
: /* Rotate the values of the cut buffers by the given number of step.
2266 Positive means shift the values forward, negative means backward. */)
2273 struct frame
*sf
= SELECTED_FRAME ();
2276 display
= FRAME_X_DISPLAY (sf
);
2277 window
= RootWindow (display
, 0); /* Cut buffers are on screen 0 */
2281 if (! FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
)
2283 initialize_cut_buffers (display
, window
);
2284 FRAME_X_DISPLAY_INFO (sf
)->cut_buffers_initialized
= 1;
2287 props
[0] = XA_CUT_BUFFER0
;
2288 props
[1] = XA_CUT_BUFFER1
;
2289 props
[2] = XA_CUT_BUFFER2
;
2290 props
[3] = XA_CUT_BUFFER3
;
2291 props
[4] = XA_CUT_BUFFER4
;
2292 props
[5] = XA_CUT_BUFFER5
;
2293 props
[6] = XA_CUT_BUFFER6
;
2294 props
[7] = XA_CUT_BUFFER7
;
2296 XRotateWindowProperties (display
, window
, props
, 8, XINT (n
));
2303 /***********************************************************************
2304 Drag and drop support
2305 ***********************************************************************/
2306 /* Check that lisp values are of correct type for x_fill_property_data.
2307 That is, number, string or a cons with two numbers (low and high 16
2308 bit parts of a 32 bit number). */
2311 x_check_property_data (data
)
2317 for (iter
= data
; CONSP (iter
) && size
!= -1; iter
= XCDR (iter
), ++size
)
2319 Lisp_Object o
= XCAR (iter
);
2321 if (! NUMBERP (o
) && ! STRINGP (o
) && ! CONSP (o
))
2323 else if (CONSP (o
) &&
2324 (! NUMBERP (XCAR (o
)) || ! NUMBERP (XCDR (o
))))
2331 /* Convert lisp values to a C array. Values may be a number, a string
2332 which is taken as an X atom name and converted to the atom value, or
2333 a cons containing the two 16 bit parts of a 32 bit number.
2335 DPY is the display use to look up X atoms.
2336 DATA is a Lisp list of values to be converted.
2337 RET is the C array that contains the converted values. It is assumed
2338 it is big enough to hol all values.
2339 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2340 be stored in RET. */
2343 x_fill_property_data (dpy
, data
, ret
, format
)
2350 CARD32
*d32
= (CARD32
*) ret
;
2351 CARD16
*d16
= (CARD16
*) ret
;
2352 CARD8
*d08
= (CARD8
*) ret
;
2355 for (iter
= data
; CONSP (iter
); iter
= XCDR (iter
))
2357 Lisp_Object o
= XCAR (iter
);
2360 val
= (CARD32
) XFASTINT (o
);
2361 else if (FLOATP (o
))
2362 val
= (CARD32
) XFLOAT (o
);
2364 val
= (CARD32
) cons_to_long (o
);
2365 else if (STRINGP (o
))
2368 val
= XInternAtom (dpy
, (char *) SDATA (o
), False
);
2372 error ("Wrong type, must be string, number or cons");
2375 *d08
++ = (CARD8
) val
;
2376 else if (format
== 16)
2377 *d16
++ = (CARD16
) val
;
2383 /* Convert an array of C values to a Lisp list.
2384 F is the frame to be used to look up X atoms if the TYPE is XA_ATOM.
2385 DATA is a C array of values to be converted.
2386 TYPE is the type of the data. Only XA_ATOM is special, it converts
2387 each number in DATA to its corresponfing X atom as a symbol.
2388 FORMAT is 8, 16 or 32 and gives the size in bits for each C value to
2390 SIZE is the number of elements in DATA.
2392 Also see comment for selection_data_to_lisp_data above. */
2395 x_property_data_to_lisp (f
, data
, type
, format
, size
)
2397 unsigned char *data
;
2402 return selection_data_to_lisp_data (FRAME_X_DISPLAY (f
),
2403 data
, size
*format
/8, type
, format
);
2406 /* Get the mouse position frame relative coordinates. */
2409 mouse_position_for_drop (f
, x
, y
)
2414 Window root
, dummy_window
;
2419 XQueryPointer (FRAME_X_DISPLAY (f
),
2420 DefaultRootWindow (FRAME_X_DISPLAY (f
)),
2422 /* The root window which contains the pointer. */
2425 /* Window pointer is on, not used */
2428 /* The position on that root window. */
2431 /* x/y in dummy_window coordinates, not used. */
2434 /* Modifier keys and pointer buttons, about which
2436 (unsigned int *) &dummy
);
2439 /* Absolute to relative. */
2440 *x
-= f
->left_pos
+ FRAME_OUTER_TO_INNER_DIFF_X (f
);
2441 *y
-= f
->top_pos
+ FRAME_OUTER_TO_INNER_DIFF_Y (f
);
2446 DEFUN ("x-get-atom-name", Fx_get_atom_name
,
2447 Sx_get_atom_name
, 1, 2, 0,
2448 doc
: /* Return the X atom name for VALUE as a string.
2449 VALUE may be a number or a cons where the car is the upper 16 bits and
2450 the cdr is the lower 16 bits of a 32 bit value.
2451 Use the display for FRAME or the current frame if FRAME is not given or nil.
2453 If the value is 0 or the atom is not known, return the empty string. */)
2455 Lisp_Object value
, frame
;
2457 struct frame
*f
= check_x_frame (frame
);
2459 Lisp_Object ret
= Qnil
;
2461 Display
*dpy
= FRAME_X_DISPLAY (f
);
2464 if (INTEGERP (value
))
2465 atom
= (Atom
) XUINT (value
);
2466 else if (FLOATP (value
))
2467 atom
= (Atom
) XFLOAT (value
);
2468 else if (CONSP (value
))
2469 atom
= (Atom
) cons_to_long (value
);
2471 error ("Wrong type, value must be number or cons");
2474 count
= x_catch_errors (dpy
);
2476 name
= atom
? XGetAtomName (dpy
, atom
) : "";
2478 if (! x_had_errors_p (dpy
))
2479 ret
= make_string (name
, strlen (name
));
2481 x_uncatch_errors (dpy
, count
);
2483 if (atom
&& name
) XFree (name
);
2484 if (NILP (ret
)) ret
= make_string ("", 0);
2491 /* Convert an XClientMessageEvent to a Lisp event of type DRAG_N_DROP_EVENT.
2492 TODO: Check if this client event really is a DND event? */
2495 x_handle_dnd_message (f
, event
, dpyinfo
, bufp
)
2497 XClientMessageEvent
*event
;
2498 struct x_display_info
*dpyinfo
;
2499 struct input_event
*bufp
;
2503 unsigned long size
= (8*sizeof (event
->data
))/event
->format
;
2506 XSETFRAME (frame
, f
);
2508 vec
= Fmake_vector (make_number (4), Qnil
);
2509 AREF (vec
, 0) = SYMBOL_NAME (x_atom_to_symbol (FRAME_X_DISPLAY (f
),
2510 event
->message_type
));
2511 AREF (vec
, 1) = frame
;
2512 AREF (vec
, 2) = make_number (event
->format
);
2513 AREF (vec
, 3) = x_property_data_to_lisp (f
,
2515 event
->message_type
,
2519 mouse_position_for_drop (f
, &x
, &y
);
2520 bufp
->kind
= DRAG_N_DROP_EVENT
;
2521 bufp
->frame_or_window
= Fcons (frame
, vec
);
2522 bufp
->timestamp
= CurrentTime
;
2523 bufp
->x
= make_number (x
);
2524 bufp
->y
= make_number (y
);
2526 bufp
->modifiers
= 0;
2531 DEFUN ("x-send-client-message", Fx_send_client_event
,
2532 Sx_send_client_message
, 6, 6, 0,
2533 doc
: /* Send a client message of MESSAGE-TYPE to window DEST on DISPLAY.
2535 For DISPLAY, specify either a frame or a display name (a string).
2536 If DISPLAY is nil, that stands for the selected frame's display.
2537 DEST may be a number, in which case it is a Window id. The value 0 may
2538 be used to send to the root window of the DISPLAY.
2539 If DEST is a cons, it is converted to a 32 bit number
2540 with the high 16 bits from the car and the lower 16 bit from the cdr. That
2541 number is then used as a window id.
2542 If DEST is a frame the event is sent to the outer window of that frame.
2543 Nil means the currently selected frame.
2544 If DEST is the string "PointerWindow" the event is sent to the window that
2545 contains the pointer. If DEST is the string "InputFocus" the event is
2546 sent to the window that has the input focus.
2547 FROM is the frame sending the event. Use nil for currently selected frame.
2548 MESSAGE-TYPE is the name of an Atom as a string.
2549 FORMAT must be one of 8, 16 or 32 and determines the size of the values in
2550 bits. VALUES is a list of numbers, cons and/or strings containing the values
2551 to send. If a value is a string, it is converted to an Atom and the value of
2552 the Atom is sent. If a value is a cons, it is converted to a 32 bit number
2553 with the high 16 bits from the car and the lower 16 bit from the cdr.
2554 If more values than fits into the event is given, the excessive values
2556 (display
, dest
, from
, message_type
, format
, values
)
2557 Lisp_Object display
, dest
, from
, message_type
, format
, values
;
2559 struct x_display_info
*dpyinfo
= check_x_display_info (display
);
2564 struct frame
*f
= check_x_frame (from
);
2568 CHECK_STRING (message_type
);
2569 CHECK_NUMBER (format
);
2570 CHECK_CONS (values
);
2572 if (x_check_property_data (values
) == -1)
2573 error ("Bad data in VALUES, must be number, cons or string");
2575 event
.xclient
.type
= ClientMessage
;
2576 event
.xclient
.format
= XFASTINT (format
);
2578 if (event
.xclient
.format
!= 8 && event
.xclient
.format
!= 16
2579 && event
.xclient
.format
!= 32)
2580 error ("FORMAT must be one of 8, 16 or 32");
2582 if (FRAMEP (dest
) || NILP (dest
))
2584 struct frame
*fdest
= check_x_frame (dest
);
2585 wdest
= FRAME_OUTER_WINDOW (fdest
);
2587 else if (STRINGP (dest
))
2589 if (strcmp (SDATA (dest
), "PointerWindow") == 0)
2590 wdest
= PointerWindow
;
2591 else if (strcmp (SDATA (dest
), "InputFocus") == 0)
2594 error ("DEST as a string must be one of PointerWindow or InputFocus");
2596 else if (INTEGERP (dest
))
2597 wdest
= (Window
) XFASTINT (dest
);
2598 else if (FLOATP (dest
))
2599 wdest
= (Window
) XFLOAT (dest
);
2600 else if (CONSP (dest
))
2602 if (! NUMBERP (XCAR (dest
)) || ! NUMBERP (XCDR (dest
)))
2603 error ("Both car and cdr for DEST must be numbers");
2605 wdest
= (Window
) cons_to_long (dest
);
2608 error ("DEST must be a frame, nil, string, number or cons");
2610 if (wdest
== 0) wdest
= dpyinfo
->root_window
;
2611 to_root
= wdest
== dpyinfo
->root_window
;
2613 for (cons
= values
, size
= 0; CONSP (cons
); cons
= XCDR (cons
), ++size
)
2618 event
.xclient
.message_type
2619 = XInternAtom (dpyinfo
->display
, SDATA (message_type
), False
);
2620 event
.xclient
.display
= dpyinfo
->display
;
2622 /* Some clients (metacity for example) expects sending window to be here
2623 when sending to the root window. */
2624 event
.xclient
.window
= to_root
? FRAME_OUTER_WINDOW (f
) : wdest
;
2626 memset (event
.xclient
.data
.b
, 0, sizeof (event
.xclient
.data
.b
));
2627 x_fill_property_data (dpyinfo
->display
, values
, event
.xclient
.data
.b
,
2628 event
.xclient
.format
);
2630 /* If event mask is 0 the event is sent to the client that created
2631 the destination window. But if we are sending to the root window,
2632 there is no such client. Then we set the event mask to 0xffff. The
2633 event then goes to clients selecting for events on the root window. */
2634 count
= x_catch_errors (dpyinfo
->display
);
2636 int propagate
= to_root
? False
: True
;
2637 unsigned mask
= to_root
? 0xffff : 0;
2638 XSendEvent (dpyinfo
->display
, wdest
, propagate
, mask
, &event
);
2639 XFlush (dpyinfo
->display
);
2641 x_uncatch_errors (dpyinfo
->display
, count
);
2651 defsubr (&Sx_get_selection_internal
);
2652 defsubr (&Sx_own_selection_internal
);
2653 defsubr (&Sx_disown_selection_internal
);
2654 defsubr (&Sx_selection_owner_p
);
2655 defsubr (&Sx_selection_exists_p
);
2657 #ifdef CUT_BUFFER_SUPPORT
2658 defsubr (&Sx_get_cut_buffer_internal
);
2659 defsubr (&Sx_store_cut_buffer_internal
);
2660 defsubr (&Sx_rotate_cut_buffers_internal
);
2663 defsubr (&Sx_get_atom_name
);
2664 defsubr (&Sx_send_client_message
);
2666 reading_selection_reply
= Fcons (Qnil
, Qnil
);
2667 staticpro (&reading_selection_reply
);
2668 reading_selection_window
= 0;
2669 reading_which_selection
= 0;
2671 property_change_wait_list
= 0;
2672 prop_location_identifier
= 0;
2673 property_change_reply
= Fcons (Qnil
, Qnil
);
2674 staticpro (&property_change_reply
);
2676 Vselection_alist
= Qnil
;
2677 staticpro (&Vselection_alist
);
2679 DEFVAR_LISP ("selection-converter-alist", &Vselection_converter_alist
,
2680 doc
: /* An alist associating X Windows selection-types with functions.
2681 These functions are called to convert the selection, with three args:
2682 the name of the selection (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2683 a desired type to which the selection should be converted;
2684 and the local selection value (whatever was given to `x-own-selection').
2686 The function should return the value to send to the X server
2687 \(typically a string). A return value of nil
2688 means that the conversion could not be done.
2689 A return value which is the symbol `NULL'
2690 means that a side-effect was executed,
2691 and there is no meaningful selection value. */);
2692 Vselection_converter_alist
= Qnil
;
2694 DEFVAR_LISP ("x-lost-selection-hooks", &Vx_lost_selection_hooks
,
2695 doc
: /* A list of functions to be called when Emacs loses an X selection.
2696 \(This happens when some other X client makes its own selection
2697 or when a Lisp program explicitly clears the selection.)
2698 The functions are called with one argument, the selection type
2699 \(a symbol, typically `PRIMARY', `SECONDARY', or `CLIPBOARD'). */);
2700 Vx_lost_selection_hooks
= Qnil
;
2702 DEFVAR_LISP ("x-sent-selection-hooks", &Vx_sent_selection_hooks
,
2703 doc
: /* A list of functions to be called when Emacs answers a selection request.
2704 The functions are called with four arguments:
2705 - the selection name (typically `PRIMARY', `SECONDARY', or `CLIPBOARD');
2706 - the selection-type which Emacs was asked to convert the
2707 selection into before sending (for example, `STRING' or `LENGTH');
2708 - a flag indicating success or failure for responding to the request.
2709 We might have failed (and declined the request) for any number of reasons,
2710 including being asked for a selection that we no longer own, or being asked
2711 to convert into a type that we don't know about or that is inappropriate.
2712 This hook doesn't let you change the behavior of Emacs's selection replies,
2713 it merely informs you that they have happened. */);
2714 Vx_sent_selection_hooks
= Qnil
;
2716 DEFVAR_LISP ("selection-coding-system", &Vselection_coding_system
,
2717 doc
: /* Coding system for communicating with other X clients.
2718 When sending or receiving text via cut_buffer, selection, and clipboard,
2719 the text is encoded or decoded by this coding system.
2720 The default value is `compound-text-with-extensions'. */);
2721 Vselection_coding_system
= intern ("compound-text-with-extensions");
2723 DEFVAR_LISP ("next-selection-coding-system", &Vnext_selection_coding_system
,
2724 doc
: /* Coding system for the next communication with other X clients.
2725 Usually, `selection-coding-system' is used for communicating with
2726 other X clients. But, if this variable is set, it is used for the
2727 next communication only. After the communication, this variable is
2729 Vnext_selection_coding_system
= Qnil
;
2731 DEFVAR_INT ("x-selection-timeout", &x_selection_timeout
,
2732 doc
: /* Number of milliseconds to wait for a selection reply.
2733 If the selection owner doesn't reply in this time, we give up.
2734 A value of 0 means wait as long as necessary. This is initialized from the
2735 \"*selectionTimeout\" resource. */);
2736 x_selection_timeout
= 0;
2738 QPRIMARY
= intern ("PRIMARY"); staticpro (&QPRIMARY
);
2739 QSECONDARY
= intern ("SECONDARY"); staticpro (&QSECONDARY
);
2740 QSTRING
= intern ("STRING"); staticpro (&QSTRING
);
2741 QINTEGER
= intern ("INTEGER"); staticpro (&QINTEGER
);
2742 QCLIPBOARD
= intern ("CLIPBOARD"); staticpro (&QCLIPBOARD
);
2743 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2744 QTEXT
= intern ("TEXT"); staticpro (&QTEXT
);
2745 QCOMPOUND_TEXT
= intern ("COMPOUND_TEXT"); staticpro (&QCOMPOUND_TEXT
);
2746 QUTF8_STRING
= intern ("UTF8_STRING"); staticpro (&QUTF8_STRING
);
2747 QTIMESTAMP
= intern ("TIMESTAMP"); staticpro (&QTIMESTAMP
);
2748 QDELETE
= intern ("DELETE"); staticpro (&QDELETE
);
2749 QMULTIPLE
= intern ("MULTIPLE"); staticpro (&QMULTIPLE
);
2750 QINCR
= intern ("INCR"); staticpro (&QINCR
);
2751 QEMACS_TMP
= intern ("_EMACS_TMP_"); staticpro (&QEMACS_TMP
);
2752 QTARGETS
= intern ("TARGETS"); staticpro (&QTARGETS
);
2753 QATOM
= intern ("ATOM"); staticpro (&QATOM
);
2754 QATOM_PAIR
= intern ("ATOM_PAIR"); staticpro (&QATOM_PAIR
);
2755 QNULL
= intern ("NULL"); staticpro (&QNULL
);
2756 Qcompound_text_with_extensions
= intern ("compound-text-with-extensions");
2757 staticpro (&Qcompound_text_with_extensions
);
2759 #ifdef CUT_BUFFER_SUPPORT
2760 QCUT_BUFFER0
= intern ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0
);
2761 QCUT_BUFFER1
= intern ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1
);
2762 QCUT_BUFFER2
= intern ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2
);
2763 QCUT_BUFFER3
= intern ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3
);
2764 QCUT_BUFFER4
= intern ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4
);
2765 QCUT_BUFFER5
= intern ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5
);
2766 QCUT_BUFFER6
= intern ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6
);
2767 QCUT_BUFFER7
= intern ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7
);
2770 Qforeign_selection
= intern ("foreign-selection");
2771 staticpro (&Qforeign_selection
);
2774 /* arch-tag: 7c293b0f-9918-4f69-8ac7-03e142307236
2775 (do not change this comment) */